diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 0a3a0f37..5a920625 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -3,8 +3,8 @@ name: DIRAC-CASPT2-CI-test on: push: paths: - # Ref : https://mzqvis6akmakplpmcjx3.hatenablog.com/entry/2021/02/07/134133 - # Run CI when only source code, build configuration, test files or files related to CI are modified. + # Ref : https://mzqvis6akmakplpmcjx3.hatenablog.com/entry/2021/02/07/134133 + # Run CI when only source code, build configuration, test files or files related to CI are modified. - "**.f90" - "**.F90" - "**.cmake" @@ -16,8 +16,8 @@ on: branches: - "main" paths: - # Ref : https://mzqvis6akmakplpmcjx3.hatenablog.com/entry/2021/02/07/134133 - # Run CI when only source code, build configuration, test files or files related to CI are modified. + # Ref : https://mzqvis6akmakplpmcjx3.hatenablog.com/entry/2021/02/07/134133 + # Run CI when only source code, build configuration, test files or files related to CI are modified. - "**.f90" - "**.F90" - "**.cmake" @@ -34,12 +34,14 @@ defaults: run: shell: bash jobs: - test-linux-mpiifort: + test-linux-intel-mpi: timeout-minutes: 60 # Max execution time (min) runs-on: ubuntu-latest + strategy: + matrix: + fc: [mpiifort, mpiifx] env: KEYVERSION: v1 # If you don't want to cache (intel fortran), you should change KEYVERSION. - FC: mpiifort # MPI-Intel-Fortran steps: - uses: actions/checkout@v3 - name: cache install @@ -65,11 +67,12 @@ jobs: sudo apt-get install -y intel-oneapi-compiler-fortran intel-oneapi-openmp intel-oneapi-mpi intel-oneapi-mpi-devel intel-oneapi-mkl - name: Set Intel oneAPI environments run: | - source /opt/intel/oneapi/setvars.sh + source /opt/intel/oneapi/setvars.sh --force printenv >> $GITHUB_ENV - name: Install cmake run: | sudo apt-get install -y cmake + - run: ${{ matrix.fc }} --version - name: Install python uses: actions/setup-python@v4 with: @@ -79,7 +82,7 @@ jobs: run: python -m pip install pytest - name: Build source code (parallel) run: | - ./setup --mpi --omp -j --build + ./setup --mpi --omp -j --build --fc ${{ matrix.fc }} - name: Run unittest(parallel, run slowonly tests, pull_request) if: ${{ github.event_name == 'pull_request' }} run: | @@ -133,7 +136,7 @@ jobs: run: | source /opt/intel/oneapi/setvars.sh printenv >> $GITHUB_ENV - - uses: awvwgk/setup-fortran@10d482ae709dc07adfb4ff5d152dc315ec5abbe9 # Fix the commit hash to avoid breaking changes. + - uses: fortran-lang/setup-fortran@v1.3 id: setup-fortran with: compiler: ${{ matrix.compiler }} @@ -158,7 +161,7 @@ jobs: - name: Run unittest(serial, run normal and slow tests, push to other than main branch) if: ${{ github.ref_name != 'main' && github.event_name == 'push' }} run: | - pytest + pytest --omp=2 - name: Run unittest(serial, run all tests, push to main branch) if: ${{ github.ref_name == 'main' && github.event_name == 'push' }} run: | diff --git a/.vscode/extensions.json b/.vscode/extensions.json index a8295e3e..12f3d29f 100644 --- a/.vscode/extensions.json +++ b/.vscode/extensions.json @@ -26,6 +26,7 @@ "EditorConfig.EditorConfig", // Python "ms-python.python", - "ms-python.vscode-pylance" + "charliermarsh.ruff", + "ms-python.black-formatter" ] } diff --git a/.vscode/settings.json b/.vscode/settings.json index 8b39bd09..2b3bbc8f 100644 --- a/.vscode/settings.json +++ b/.vscode/settings.json @@ -44,4 +44,23 @@ ], "python.testing.unittestEnabled": false, "python.testing.pytestEnabled": true, + "[python]": { + "editor.codeActionsOnSave": { + "source.organizeImports": true + }, + "editor.defaultFormatter": "ms-python.black-formatter", + "editor.formatOnSave": true + }, + "black-formatter.args": [ + "--line-length=180" + ], + "ruff.lint.args": [ + "--line-length=180", + // FBT001: boolean-type-hint-positional-argument https://docs.astral.sh/ruff/rules/boolean-type-hint-positional-argument/ + // T201: print https://docs.astral.sh/ruff/rules/print/ + // PLR2004: magic-value-comparison https://docs.astral.sh/ruff/rules/magic-value-comparison/ + // S101: use-of-assert https://docs.astral.sh/ruff/rules/use-of-assert/ + // S603: subprocess-without-shell-equals-true https://docs.astral.sh/ruff/rules/subprocess-without-shell-equals-true/ + "--ignore=FBT001,T201,PLR2004,S101,S603" + ] } diff --git a/CMakeLists.txt b/CMakeLists.txt index cab02fb6..95ab4d7a 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -10,6 +10,7 @@ option(MKL "Enable MKL?" ON) set(EXECUTABLE_OUTPUT_PATH ${CMAKE_CURRENT_SOURCE_DIR}/bin) # Set executable output path set(CMAKE_Fortran_MODULE_DIRECTORY ${PROJECT_BINARY_DIR}/modules) # Set module output path + # Deny In-source build ( Ref : https://github.com/eigenteam/eigen-git-mirror/blob/36b95962756c1fce8e29b1f8bc45967f30773c00/CMakeLists.txt#L7-L9) if(${PROJECT_SOURCE_DIR} STREQUAL ${PROJECT_BINARY_DIR}) message(FATAL_ERROR "In-source builds not allowed. Please make a new directory (called a build directory) and run CMake from there. You may need to remove CMakeCache.txt. ") @@ -25,14 +26,20 @@ if(MPI) add_compile_options(-DHAVE_MPI) # Add MPI preprocessor flag endif() -if(CMAKE_Fortran_COMPILER_ID STREQUAL Intel) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DINTEL -g -traceback -cpp -i8 -I$ENV{MKLROOT}/include -pad -mp1 -integer-size 64 -unroll -warn nounused -nogen-interface") # "-warn nounused" means "-warn all -warn nounused" +if(CMAKE_Fortran_COMPILER_ID STREQUAL Intel OR CMAKE_Fortran_COMPILER_ID STREQUAL IntelLLVM) + if(CMAKE_Fortran_COMPILER_ID STREQUAL Intel) + set(CMAKE_Fortran_FLAGS "-mp1") + endif() + + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DINTEL -g -traceback -cpp -i8 -I$ENV{MKLROOT}/include -pad -integer-size 64 -unroll -warn nounused -nogen-interface") set(CMAKE_Fortran_FLAGS_DEBUG "-O0 -check -debug extended -debug-parameters -warn") set(CMAKE_Fortran_FLAGS_RELEASE "-O3") link_libraries(-i8) + if(MKL) link_libraries(-L$ENV{MKLROOT}/lib/intel64 -lmkl_intel_ilp64 -lmkl_intel_thread -lmkl_core -liomp5 -lpthread -lm -ldl) endif() + if(OPENMP) find_package(OpenMP REQUIRED) add_compile_options(-qopenmp) @@ -40,17 +47,21 @@ if(CMAKE_Fortran_COMPILER_ID STREQUAL Intel) endif() elseif(CMAKE_Fortran_COMPILER_ID STREQUAL GNU) set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DGNU -g -fbacktrace -cpp -fdefault-integer-8 -m64 -I$ENV{MKLROOT}/include -Wall -Wno-unused-variable") + # if gfortran version >= 10.0, Use -fallow-argument-mismatch option to treat the mismatch between the actual and dummy arguments as a warning instead of an error. # (Ref: https://gcc.gnu.org/gcc-10/changes.html#:~:text=Use%20the%20new%20option%20%2Dfallow%2Dargument%2Dmismatch%20to%20turn%20these%20errors%20into%20warnings) if(CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10.0) set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fallow-argument-mismatch") endif() + set(CMAKE_Fortran_FLAGS_DEBUG "-O0 -Wall -Wextra -Wimplicit-interface -fPIC -fmax-errors=1 -fcheck=all") set(CMAKE_Fortran_FLAGS_RELEASE "-O3") link_libraries(-fdefault-integer-8 -m64) + if(MKL) link_libraries(-L$ENV{MKLROOT}/lib/intel64 -Wl,--no-as-needed -lmkl_gf_ilp64 -lmkl_core -lmkl_gnu_thread -lgomp -lpthread -lm -ldl) endif() + if(OPENMP) find_package(OpenMP REQUIRED) add_compile_options(-fopenmp) @@ -59,6 +70,7 @@ elseif(CMAKE_Fortran_COMPILER_ID STREQUAL GNU) else() message(FATAL_ERROR "Unsupported Fortran compiler: ${CMAKE_Fortran_COMPILER_ID}") endif() + add_subdirectory(src) add_subdirectory(test) configure_file(${PROJECT_SOURCE_DIR}/tools/dcaspt2_input ${EXECUTABLE_OUTPUT_PATH}/dcaspt2 COPYONLY) diff --git a/README.ja.md b/README.ja.md index 79d86cc6..c77a80d8 100644 --- a/README.ja.md +++ b/README.ja.md @@ -42,6 +42,7 @@ git clone --depth=1 https://github.com/kohei-noda-qcrg/dirac_caspt2.git - [GNU Fortran](https://gcc.gnu.org/fortran/) or [Intel Fortran](https://www.intel.com/content/www/us/en/developer/tools/oneapi/fortran-compiler.html) compiler (並列計算をするために並列コンパイラを使うこともできます) - [CMake(version ≧ 3.14)](https://cmake.org/) - CMakeが計算機に入っていないか、バージョンが古い場合[CMakeのGithub](https://github.com/Kitware/CMake/releases)からビルドするもしくはビルド済みのファイルを解凍して使用してください + - ifx又はmpiifxをFortranコンパイラとして使用する場合、[CMakeが3.20.2からifx,mpiifxをサポートしたので](https://cmake.org/cmake/help/latest/release/3.20.html#id3:~:text=The%20Intel%20oneAPI%20Fortran%20compiler%20is%20now%20identified%20as%20IntelLLVM)バージョン3.20.2以上を使用してください - [Intel MKL(Math Kernel Library)](https://www.intel.com/content/www/us/en/developer/tools/oneapi/onemkl.html) - MKLをリンクするため環境変数\$MKLROOTが設定されている必要があります \$MKLROOTが設定されているか確認するには、以下のコマンドを実行して環境変数\$MKLROOTが設定されているか確認してください diff --git a/README.md b/README.md index 60c68527..3d62dd0c 100644 --- a/README.md +++ b/README.md @@ -40,6 +40,7 @@ If you want to build this program, you need to have the following compilers, too - [GNU Fortran](https://gcc.gnu.org/fortran/) or [Intel Fortran](https://www.intel.com/content/www/us/en/developer/tools/oneapi/fortran-compiler.html) compiler (You can use the MPI compiler for parallel calculation) - [CMake(version >= 3.14)](https://cmake.org/) - If CMake is not installed on your machine or the version is too old, please build CMake or use the pre-built CMake binary from [CMake Github](https://github.com/Kitware/CMake/releases). + - If you use ifx or mpiifx as the Fortran compiler, CMake version >= 3.20.2 is required because [CMake supports ifx and mpiifx from version 3.20.2.](https://cmake.org/cmake/help/latest/release/3.20.html#id3:~:text=The%20Intel%20oneAPI%20Fortran%20compiler%20is%20now%20identified%20as%20IntelLLVM) - [Intel MKL(Math Kernel Library)](https://www.intel.com/content/www/us/en/developer/tools/oneapi/onemkl.html) - You need to configure the environment variable \$MKLROOT to link MKL. To verify that \$MKLROOT is configured, run the following command diff --git a/src/diag.f90 b/src/diag.f90 index 7b88aedf..4a91e3fd 100644 --- a/src/diag.f90 +++ b/src/diag.f90 @@ -214,7 +214,7 @@ SUBROUTINE rdiag0(n, n0, n1, fa, w) do j = n0, n1 do i = n0, n1 if (i /= j .and. (ABS(mat(i, j)) > 1.0d-10)) then - print '(2E13.5,2I3)', mat(i, j), i, j + print '(E13.5,2I3)', mat(i, j), i, j end if end do end do diff --git a/src/fock_matrix_of_hf.f90 b/src/fock_matrix_of_hf.f90 index 175f3367..2631c316 100644 --- a/src/fock_matrix_of_hf.f90 +++ b/src/fock_matrix_of_hf.f90 @@ -28,7 +28,8 @@ SUBROUTINE fock_matrix_of_hf_complex ! TO CALCULATE FOCK MATRIX OF HF STATE, A T n = 0 fock_cmplx = 0.0d+00 -!$OMP parallel do private(j,k) +!$OMP parallel private(i,j,k) +!$OMP do do i = rank + 1, global_act_end, nprocs ! MPI parallelization (Distributed loop: static scheduling, per nprocs) do j = i, global_act_end fock_cmplx(i, j) = DCMPLX(one_elec_int_r(i, j), one_elec_int_i(i, j)) @@ -42,8 +43,8 @@ SUBROUTINE fock_matrix_of_hf_complex ! TO CALCULATE FOCK MATRIX OF HF STATE, A T fock_cmplx(j, i) = DCONJG(fock_cmplx(i, j)) End do ! j End do ! i - -!$OMP parallel do private(j,k) +!$OMP end do +!$OMP do do i = rank + global_sec_start, global_sec_end, nprocs ! MPI parallelization (Distributed loop: static scheduling, per nprocs) do j = i, global_sec_end fock_cmplx(i, j) = DCMPLX(one_elec_int_r(i, j), one_elec_int_i(i, j)) @@ -58,6 +59,9 @@ SUBROUTINE fock_matrix_of_hf_complex ! TO CALCULATE FOCK MATRIX OF HF STATE, A T End do ! j End do ! i +!$OMP end do +!$OMP end parallel + #ifdef HAVE_MPI call allreduce_wrapper(mat=fock_cmplx(1:nmo, 1:nmo)) #endif @@ -115,7 +119,8 @@ SUBROUTINE fock_matrix_of_hf_real ! TO CALCULATE FOCK MATRIX OF HF STATE, A TEST n = 0 fock_real = 0.0d+00 -!$OMP parallel do private(j,k) +!$OMP parallel private(i,j,k) +!$OMP do do i = rank + 1, global_act_end, nprocs ! MPI parallelization (Distributed loop: static scheduling, per nprocs) do j = i, global_act_end fock_real(i, j) = one_elec_int_r(i, j) @@ -129,8 +134,8 @@ SUBROUTINE fock_matrix_of_hf_real ! TO CALCULATE FOCK MATRIX OF HF STATE, A TEST fock_real(j, i) = fock_real(i, j) End do ! j End do ! i - -!$OMP parallel do private(j,k) +!$OMP end do +!$OMP do do i = rank + global_sec_start, global_sec_end, nprocs ! MPI parallelization (Distributed loop: static scheduling, per nprocs) do j = i, global_sec_end fock_real(i, j) = one_elec_int_r(i, j) @@ -145,6 +150,9 @@ SUBROUTINE fock_matrix_of_hf_real ! TO CALCULATE FOCK MATRIX OF HF STATE, A TEST End do ! j End do ! i +!$OMP end do +!$OMP end parallel + #ifdef HAVE_MPI call allreduce_wrapper(mat=fock_real(1:nmo, 1:nmo)) #endif diff --git a/src/fockcasci.f90 b/src/fockcasci.f90 index 20f4ede9..3dae3cdb 100644 --- a/src/fockcasci.f90 +++ b/src/fockcasci.f90 @@ -36,7 +36,7 @@ SUBROUTINE fockcasci_complex ! TO MAKE FOCK MATRIX for CASCI state fock_cmplx(:, :) = 0.0d+00 if (rank == 0) print *, 'enter building fock matrix' -!$OMP parallel private(i,j,k,l,dr,di,dens) +!$OMP parallel private(i,j,k,l,dr,di,dens,kact,lact) !$OMP do schedule(dynamic,2) do i = rank + 1, global_act_end, nprocs ! MPI parallelization (Distributed loop: static scheduling, per nprocs) do j = i, global_act_end @@ -135,7 +135,7 @@ SUBROUTINE fockcasci_real ! TO MAKE FOCK MATRIX for CASCI state fock_real(:, :) = 0.0d+00 if (rank == 0) print *, 'enter building fock matrix' -!$OMP parallel private(i,j,k,l,dr) +!$OMP parallel private(i,j,k,l,dr,kact,lact) !$OMP do schedule(dynamic,2) do i = rank + 1, global_act_end, nprocs ! MPI parallelization (Distributed loop: static scheduling, per nprocs) do j = i, global_act_end diff --git a/src/module_intra.f90 b/src/module_intra.f90 index 5d3ffe7b..ee7416bd 100644 --- a/src/module_intra.f90 +++ b/src/module_intra.f90 @@ -272,10 +272,10 @@ SUBROUTINE intra_1_complex(spi, spj, spk, spl, fname) call open_unformatted_file(unit=unit_int2_subspace, file=trim(fname), status='old', optional_action='write') call write_traint2_to_disk_fourth(ii, ie, ji, je, ki, ke, li, le, traint2, cutoff_threshold, unit_int2_subspace) close (unit_int2_subspace) - deallocate (traint2); Call memminus(KIND(traint2), SIZE(traint2), 2) + Call memminus(KIND(traint2), SIZE(traint2), 2); deallocate (traint2) - deallocate (indsym); Call memminus(KIND(indsym), SIZE(indsym), 1) - deallocate (nsym); Call memminus(KIND(nsym), SIZE(nsym), 1) + Call memminus(KIND(indsym), SIZE(indsym), 1); deallocate (indsym) + Call memminus(KIND(nsym), SIZE(nsym), 1); deallocate (nsym) end subroutine intra_1_complex @@ -502,10 +502,10 @@ SUBROUTINE intra_1_real(spi, spj, spk, spl, fname) call open_unformatted_file(unit=unit_int2_subspace, file=trim(fname), status='old', optional_action='write') call write_traint2_to_disk_fourth(ii, ie, ji, je, ki, ke, li, le, traint2, cutoff_threshold, unit_int2_subspace) close (unit_int2_subspace) - deallocate (traint2); Call memminus(KIND(traint2), SIZE(traint2), 1) + Call memminus(KIND(traint2), SIZE(traint2), 1); deallocate (traint2) - deallocate (indsym); Call memminus(KIND(indsym), SIZE(indsym), 1) - deallocate (nsym); Call memminus(KIND(nsym), SIZE(nsym), 1) + Call memminus(KIND(indsym), SIZE(indsym), 1); deallocate (indsym) + Call memminus(KIND(nsym), SIZE(nsym), 1); deallocate (nsym) end subroutine intra_1_real @@ -771,9 +771,9 @@ SUBROUTINE intra_2_complex(spi, spj, spk, spl, fname) call open_unformatted_file(unit=unit_int2_subspace, file=trim(fname), status='old', optional_action='write') call write_traint2_to_disk_fourth(ii, ie, ji, je, ki, ke, li, le, traint2, cutoff_threshold, unit_int2_subspace) close (unit_int2_subspace) - deallocate (traint2); Call memminus(KIND(traint2), SIZE(traint2), 2) - deallocate (indsym); Call memminus(KIND(indsym), SIZE(indsym), 1) - deallocate (nsym); Call memminus(KIND(nsym), SIZE(nsym), 1) + Call memminus(KIND(traint2), SIZE(traint2), 2); deallocate (traint2) + Call memminus(KIND(indsym), SIZE(indsym), 1); deallocate (indsym) + Call memminus(KIND(nsym), SIZE(nsym), 1); deallocate (nsym) end subroutine intra_2_complex @@ -1039,9 +1039,9 @@ SUBROUTINE intra_2_real(spi, spj, spk, spl, fname) call open_unformatted_file(unit=unit_int2_subspace, file=trim(fname), status='old', optional_action='write') call write_traint2_to_disk_fourth(ii, ie, ji, je, ki, ke, li, le, traint2, cutoff_threshold, unit_int2_subspace) close (unit_int2_subspace) - deallocate (traint2); Call memminus(KIND(traint2), SIZE(traint2), 1) - deallocate (indsym); Call memminus(KIND(indsym), SIZE(indsym), 1) - deallocate (nsym); Call memminus(KIND(nsym), SIZE(nsym), 1) + Call memminus(KIND(traint2), SIZE(traint2), 1); deallocate (traint2) + Call memminus(KIND(indsym), SIZE(indsym), 1); deallocate (indsym) + Call memminus(KIND(nsym), SIZE(nsym), 1); deallocate (nsym) end subroutine intra_2_real @@ -1309,9 +1309,9 @@ SUBROUTINE intra_3_complex(spi, spj, spk, spl, fname) close (unit_int2_subspace) if (rank == 0) print *, 'read and write file properly. filename : ', trim(fname) - deallocate (traint2); Call memminus(KIND(traint2), SIZE(traint2), 2) - deallocate (indsym); Call memminus(KIND(indsym), SIZE(indsym), 1) - deallocate (nsym); Call memminus(KIND(nsym), SIZE(nsym), 1) + Call memminus(KIND(traint2), SIZE(traint2), 2); deallocate (traint2) + Call memminus(KIND(indsym), SIZE(indsym), 1); deallocate (indsym) + Call memminus(KIND(nsym), SIZE(nsym), 1); deallocate (nsym) end subroutine intra_3_complex @@ -1579,9 +1579,9 @@ SUBROUTINE intra_3_real(spi, spj, spk, spl, fname) close (unit_int2_subspace) if (rank == 0) print *, 'read and write file properly. filename : ', trim(fname) - deallocate (traint2); Call memminus(KIND(traint2), SIZE(traint2), 1) - deallocate (indsym); Call memminus(KIND(indsym), SIZE(indsym), 1) - deallocate (nsym); Call memminus(KIND(nsym), SIZE(nsym), 1) + Call memminus(KIND(traint2), SIZE(traint2), 1); deallocate (traint2) + Call memminus(KIND(indsym), SIZE(indsym), 1); deallocate (indsym) + Call memminus(KIND(nsym), SIZE(nsym), 1); deallocate (nsym) end subroutine intra_3_real diff --git a/src/solve_A_subspace.f90 b/src/solve_A_subspace.f90 index 42f746a8..a0218084 100644 --- a/src/solve_A_subspace.f90 +++ b/src/solve_A_subspace.f90 @@ -18,32 +18,32 @@ SUBROUTINE solve_A_subspace(e0, e2a) ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE solve_A_subspace_complex () + SUBROUTINE solve_A_subspace_complex() ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - use module_global_variables - use module_index_utils, only: convert_active_to_global_idx + use module_global_variables + use module_index_utils, only: convert_active_to_global_idx - Implicit NONE + Implicit NONE - integer :: dimn, dimm, dammy + integer :: dimn, dimm, dammy - integer, allocatable :: indsym(:, :) + integer, allocatable :: indsym(:, :) - real(8), allocatable :: wsnew(:), ws(:), wb(:) - real(8) :: e2(2*nsymrpa), alpha + real(8), allocatable :: wsnew(:), ws(:), wb(:) + real(8) :: e2(2*nsymrpa), alpha - complex*16, allocatable :: sc(:, :), uc(:, :), sc0(:, :) - complex*16, allocatable :: bc(:, :) - complex*16, allocatable :: bc0(:, :), bc1(:, :), v(:, :, :, :), vc(:), vc1(:) + complex*16, allocatable :: sc(:, :), uc(:, :), sc0(:, :) + complex*16, allocatable :: bc(:, :) + complex*16, allocatable :: bc0(:, :), bc1(:, :), v(:, :, :, :), vc(:), vc1(:) - integer :: i, j, syma, symb, isym, sym1 - integer :: ix, iy, iz, ii, dimi, ixyz - integer :: jx, jy, jz, it - integer :: datetmp0, datetmp1 - real(8) :: tsectmp0, tsectmp1 + integer :: i, j, syma, symb, isym, sym1 + integer :: ix, iy, iz, ii, dimi, ixyz + integer :: jx, jy, jz, it + integer :: datetmp0, datetmp1 + real(8) :: tsectmp0, tsectmp1 ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= @@ -76,185 +76,185 @@ SUBROUTINE solve_A_subspace_complex () ! ! E2 = SIGUMA_i, dimm |Vc1(dimm,i)|^2|/{(alpha(i) + wb(dimm)} - e2 = 0.0d+00 - e2a = 0.0d+00 - dimi = 0 - dimn = 0 - syma = 0 - datetmp1 = date0; datetmp0 = date0 - Call timing(date0, tsec0, datetmp0, tsectmp0) - tsectmp1 = tsectmp0 - if (rank == 0) then - print *, ' ENTER solv A part' - print *, ' nsymrpa', nsymrpa - end if + e2 = 0.0d+00 + e2a = 0.0d+00 + dimi = 0 + dimn = 0 + syma = 0 + datetmp1 = date0; datetmp0 = date0 + Call timing(date0, tsec0, datetmp0, tsectmp0) + tsectmp1 = tsectmp0 + if (rank == 0) then + print *, ' ENTER solv A part' + print *, ' nsymrpa', nsymrpa + end if - Allocate (v(ninact, nact, nact, nact)) - Call memplus(KIND(v), SIZE(v), 2) + Allocate (v(ninact, nact, nact, nact)) + Call memplus(KIND(v), SIZE(v), 2) - if (rank == 0) print *, 'before vAmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call vAmat_complex (v) - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 + if (rank == 0) print *, 'before vAmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call vAmat_complex(v) + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 ! ExjEyz - Do isym = 1, nsymrpa - - ixyz = 0 - Do ix = 1, nact - Do iy = 1, nact - Do iz = 1, nact - jx = convert_active_to_global_idx(ix) - jy = convert_active_to_global_idx(iy) - jz = convert_active_to_global_idx(iz) - if (nsymrpa /= 1) then - syma = MULTB_D(irpamo(jx), isym) - symb = MULTB_D(irpamo(jy), irpamo(jz)) - syma = MULTB_S(syma, symb) - end if - If (nsymrpa == 1 .or. (nsymrpa /= 1 .and. (syma == 1))) then - ixyz = ixyz + 1 - End if - End do + Do isym = 1, nsymrpa + + ixyz = 0 + Do ix = 1, nact + Do iy = 1, nact + Do iz = 1, nact + jx = convert_active_to_global_idx(ix) + jy = convert_active_to_global_idx(iy) + jz = convert_active_to_global_idx(iz) + if (nsymrpa /= 1) then + syma = MULTB_D(irpamo(jx), isym) + symb = MULTB_D(irpamo(jy), irpamo(jz)) + syma = MULTB_S(syma, symb) + end if + If (nsymrpa == 1 .or. (nsymrpa /= 1 .and. (syma == 1))) then + ixyz = ixyz + 1 + End if End do End do + End do - dimn = ixyz + dimn = ixyz - If (dimn == 0) cycle ! Go to the next isym. + If (dimn == 0) cycle ! Go to the next isym. - Allocate (indsym(3, dimn)); Call memplus(KIND(indsym), SIZE(indsym), 1) + Allocate (indsym(3, dimn)); Call memplus(KIND(indsym), SIZE(indsym), 1) - ixyz = 0 + ixyz = 0 - Do ix = 1, nact - Do iy = 1, nact - Do iz = 1, nact - jx = convert_active_to_global_idx(ix) - jy = convert_active_to_global_idx(iy) - jz = convert_active_to_global_idx(iz) - if (nsymrpa /= 1) then - syma = MULTB_D(irpamo(jx), isym) - symb = MULTB_D(irpamo(jy), irpamo(jz)) - syma = MULTB_S(syma, symb) - end if + Do ix = 1, nact + Do iy = 1, nact + Do iz = 1, nact + jx = convert_active_to_global_idx(ix) + jy = convert_active_to_global_idx(iy) + jz = convert_active_to_global_idx(iz) + if (nsymrpa /= 1) then + syma = MULTB_D(irpamo(jx), isym) + symb = MULTB_D(irpamo(jy), irpamo(jz)) + syma = MULTB_S(syma, symb) + end if - If (nsymrpa == 1 .or. (nsymrpa /= 1 .and. (syma == 1))) then - ixyz = ixyz + 1 - indsym(1, ixyz) = ix - indsym(2, ixyz) = iy - indsym(3, ixyz) = iz - End if - End do + If (nsymrpa == 1 .or. (nsymrpa /= 1 .and. (syma == 1))) then + ixyz = ixyz + 1 + indsym(1, ixyz) = ix + indsym(2, ixyz) = iy + indsym(3, ixyz) = iz + End if End do End do + End do - if (rank == 0) print *, 'isym, dimn', isym, dimn - Allocate (sc(dimn, dimn)); Call memplus(KIND(sc), SIZE(sc), 2) + if (rank == 0) print *, 'isym, dimn', isym, dimn + Allocate (sc(dimn, dimn)); Call memplus(KIND(sc), SIZE(sc), 2) - sc = 0.0d+00 ! sr N*N - if (rank == 0) print *, 'before sAmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call sAmat_complex (dimn, indsym, sc) + sc = 0.0d+00 ! sr N*N + if (rank == 0) print *, 'before sAmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call sAmat_complex(dimn, indsym, sc) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'sc matrix is obtained normally' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (ws(dimn)); Call memplus(KIND(ws), SIZE(ws), 1) + if (rank == 0) print *, 'sc matrix is obtained normally' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Allocate (ws(dimn)); Call memplus(KIND(ws), SIZE(ws), 1) - Allocate (sc0(dimn, dimn)); Call memplus(KIND(sc0), SIZE(sc0), 2) - sc0 = sc - if (rank == 0) print *, 'before cdiag' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call cdiag(sc, dimn, dimm, ws, smat_lin_dep_threshold) + Allocate (sc0(dimn, dimn)); Call memplus(KIND(sc0), SIZE(sc0), 2) + sc0 = sc + if (rank == 0) print *, 'before cdiag' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call cdiag(sc, dimn, dimm, ws, smat_lin_dep_threshold) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'after sc cdiag' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 + if (rank == 0) print *, 'after sc cdiag' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 - If (dimm == 0) then - Call memminus(KIND(indsym), SIZE(indsym), 1); deallocate (indsym) - Call memminus(KIND(sc0), SIZE(sc0), 2); deallocate (sc0) - Call memminus(KIND(sc), SIZE(sc), 2); deallocate (sc) - Call memminus(KIND(ws), SIZE(ws), 1); deallocate (ws) - cycle ! Go to the next isym. - End if + If (dimm == 0) then + Call memminus(KIND(indsym), SIZE(indsym), 1); deallocate (indsym) + Call memminus(KIND(sc0), SIZE(sc0), 2); deallocate (sc0) + Call memminus(KIND(sc), SIZE(sc), 2); deallocate (sc) + Call memminus(KIND(ws), SIZE(ws), 1); deallocate (ws) + cycle ! Go to the next isym. + End if - If (debug) then - if (rank == 0) print *, 'Check whether U*SU is diagonal' - Call checkdgc(dimn, sc0, sc, ws) - if (rank == 0) print *, 'Check whether U*SU is diagonal END' - End if + If (debug) then + if (rank == 0) print *, 'Check whether U*SU is diagonal' + Call checkdgc(dimn, sc0, sc, ws) + if (rank == 0) print *, 'Check whether U*SU is diagonal END' + End if - if (rank == 0) print *, 'OK cdiag', dimn, dimm + if (rank == 0) print *, 'OK cdiag', dimn, dimm - Allocate (bc(dimn, dimn)); Call memplus(KIND(bc), SIZE(bc), 2) ! br N*N - bc = 0.0d+00 - if (rank == 0) print *, 'before bAmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call bAmat_complex (dimn, sc0, indsym, bc) + Allocate (bc(dimn, dimn)); Call memplus(KIND(bc), SIZE(bc), 2) ! br N*N + bc = 0.0d+00 + if (rank == 0) print *, 'before bAmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call bAmat_complex(dimn, sc0, indsym, bc) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'bc matrix is obtained normally' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call memminus(KIND(sc0), SIZE(sc0), 2); deallocate (sc0) + if (rank == 0) print *, 'bc matrix is obtained normally' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call memminus(KIND(sc0), SIZE(sc0), 2); deallocate (sc0) - Allocate (uc(dimn, dimm)); Call memplus(KIND(uc), SIZE(uc), 2) ! uc N*M - Allocate (wsnew(dimm)); Call memplus(KIND(wsnew), SIZE(wsnew), 1) ! wnew M - uc(:, :) = 0.0d+00 - wsnew(:) = 0.0d+00 + Allocate (uc(dimn, dimm)); Call memplus(KIND(uc), SIZE(uc), 2) ! uc N*M + Allocate (wsnew(dimm)); Call memplus(KIND(wsnew), SIZE(wsnew), 1) ! wnew M + uc(:, :) = 0.0d+00 + wsnew(:) = 0.0d+00 - if (rank == 0) print *, 'before ccutoff' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call ccutoff(sc, ws, dimn, dimm, smat_lin_dep_threshold, uc, wsnew) + if (rank == 0) print *, 'before ccutoff' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call ccutoff(sc, ws, dimn, dimm, smat_lin_dep_threshold, uc, wsnew) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'OK ccutoff' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call memminus(KIND(sc), SIZE(sc), 2); deallocate (sc) - Call memminus(KIND(ws), SIZE(ws), 1); deallocate (ws) + if (rank == 0) print *, 'OK ccutoff' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call memminus(KIND(sc), SIZE(sc), 2); deallocate (sc) + Call memminus(KIND(ws), SIZE(ws), 1); deallocate (ws) - if (rank == 0) print *, 'before ulambda_s_half' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call ulambda_s_half(uc, wsnew, dimn, dimm) ! uc N*M matrix rewritten as uramda^(-1/2) + if (rank == 0) print *, 'before ulambda_s_half' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call ulambda_s_half(uc, wsnew, dimn, dimm) ! uc N*M matrix rewritten as uramda^(-1/2) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - Call memminus(KIND(wsnew), SIZE(wsnew), 1); deallocate (wsnew) + Call memminus(KIND(wsnew), SIZE(wsnew), 1); deallocate (wsnew) - if (rank == 0) print *, 'ucrams half OK' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (bc0(dimm, dimn)); Call memplus(KIND(bc0), SIZE(bc0), 2) ! bc0 M*N - bc0 = 0.0d+00 - bc0 = MATMUL(TRANSPOSE(DCONJG(uc)), bc) - - Allocate (bc1(dimm, dimm)); Call memplus(KIND(bc1), SIZE(bc1), 2) ! bc1 M*M - bc1 = 0.0d+00 - bc1 = MATMUL(bc0, uc) - - If (debug) then - if (rank == 0) then - print *, 'Check whether bc1 is hermite or not' - Do i = 1, dimm - Do j = i, dimm - if (ABS(bc1(i, j) - DCONJG(bc1(j, i))) > 1.0d-6) then + if (rank == 0) print *, 'ucrams half OK' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Allocate (bc0(dimm, dimn)); Call memplus(KIND(bc0), SIZE(bc0), 2) ! bc0 M*N + bc0 = 0.0d+00 + bc0 = MATMUL(TRANSPOSE(DCONJG(uc)), bc) + + Allocate (bc1(dimm, dimm)); Call memplus(KIND(bc1), SIZE(bc1), 2) ! bc1 M*M + bc1 = 0.0d+00 + bc1 = MATMUL(bc0, uc) + + If (debug) then + if (rank == 0) then + print *, 'Check whether bc1 is hermite or not' + Do i = 1, dimm + Do j = i, dimm + if (ABS(bc1(i, j) - DCONJG(bc1(j, i))) > 1.0d-6) then print '(2I4,2E15.7)', i, j, bc1(i, j) - bc1(j, i) End if End do @@ -284,17 +284,17 @@ SUBROUTINE solve_A_subspace_complex () datetmp1 = datetmp0 tsectmp1 = tsectmp0 - If (debug) then - if (rank == 0) print *, 'Check whether bc is really diagonalized or not' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call checkdgc(dimm, bc0, bc1, wb) - if (rank == 0) print *, 'Check whether bc is really diagonalized or not END' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - End if + If (debug) then + if (rank == 0) print *, 'Check whether bc is really diagonalized or not' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call checkdgc(dimm, bc0, bc1, wb) + if (rank == 0) print *, 'Check whether bc is really diagonalized or not END' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + End if Call memminus(KIND(bc0), SIZE(bc0), 2); deallocate (bc0) if (rank == 0) print *, 'bC1 matrix is diagonalized!' @@ -353,7 +353,7 @@ end subroutine solve_A_subspace_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! - SUBROUTINE sAmat_complex (dimn, indsym, sc) ! Assume C1 molecule, overlap matrix S in space A + SUBROUTINE sAmat_complex(dimn, indsym, sc) ! Assume C1 molecule, overlap matrix S in space A ! ! S(xyz,tuv) = - <0|EzyEtxEuv|0> + d(tx)<0|EzyEuv|0> ! @@ -409,7 +409,7 @@ End subroutine sAmat_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE bAmat_complex (dimn, sc, indsym, bc) ! Assume C1 molecule, overlap matrix B in space A + SUBROUTINE bAmat_complex(dimn, sc, indsym, bc) ! Assume C1 molecule, overlap matrix B in space A ! ! B(xyz,tuv) = Siguma_w eps(w){-<0|EzyEtxEuvEww|0> + d(tx)<0|EzyEuvEww|0>} ! @@ -497,7 +497,7 @@ End subroutine bAmat_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! - SUBROUTINE vAmat_complex (v) + SUBROUTINE vAmat_complex(v) ! ! Assume C1 molecule, V=<0|H|i> matrix in space A ! @@ -774,32 +774,32 @@ end subroutine vAmat_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE solve_A_subspace_real () + SUBROUTINE solve_A_subspace_real() ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - use module_global_variables - use module_index_utils, only: convert_active_to_global_idx + use module_global_variables + use module_index_utils, only: convert_active_to_global_idx - Implicit NONE + Implicit NONE - integer :: dimn, dimm, dammy + integer :: dimn, dimm, dammy - integer, allocatable :: indsym(:, :) + integer, allocatable :: indsym(:, :) - real(8), allocatable :: wsnew(:), ws(:), wb(:) - real(8) :: e2(2*nsymrpa), alpha + real(8), allocatable :: wsnew(:), ws(:), wb(:) + real(8) :: e2(2*nsymrpa), alpha - real(8), allocatable :: sc(:, :), uc(:, :), sc0(:, :) - real(8), allocatable :: bc(:, :) - real(8), allocatable :: bc0(:, :), bc1(:, :), v(:, :, :, :), vc(:), vc1(:) + real(8), allocatable :: sc(:, :), uc(:, :), sc0(:, :) + real(8), allocatable :: bc(:, :) + real(8), allocatable :: bc0(:, :), bc1(:, :), v(:, :, :, :), vc(:), vc1(:) - integer :: i, j, syma, symb, isym, sym1 - integer :: ix, iy, iz, ii, dimi, ixyz - integer :: jx, jy, jz, it - integer :: datetmp0, datetmp1 - real(8) :: tsectmp0, tsectmp1 + integer :: i, j, syma, symb, isym, sym1 + integer :: ix, iy, iz, ii, dimi, ixyz + integer :: jx, jy, jz, it + integer :: datetmp0, datetmp1 + real(8) :: tsectmp0, tsectmp1 ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= @@ -832,180 +832,179 @@ SUBROUTINE solve_A_subspace_real () ! ! E2 = SIGUMA_i, dimm |Vc1(dimm,i)|^2|/{(alpha(i) + wb(dimm)} - e2 = 0.0d+00 - e2a = 0.0d+00 - dimi = 0 - dimn = 0 - syma = 0 - datetmp1 = date0; datetmp0 = date0 - Call timing(date0, tsec0, datetmp0, tsectmp0) - tsectmp1 = tsectmp0 - if (rank == 0) then - print *, ' ENTER solv A part' - print *, ' nsymrpa', nsymrpa - end if + e2 = 0.0d+00 + e2a = 0.0d+00 + dimi = 0 + dimn = 0 + syma = 0 + datetmp1 = date0; datetmp0 = date0 + Call timing(date0, tsec0, datetmp0, tsectmp0) + tsectmp1 = tsectmp0 + if (rank == 0) then + print *, ' ENTER solv A part' + print *, ' nsymrpa', nsymrpa + end if - Allocate (v(ninact, nact, nact, nact)) - Call memplus(KIND(v), SIZE(v), 2) + Allocate (v(ninact, nact, nact, nact)) + Call memplus(KIND(v), SIZE(v), 2) - if (rank == 0) print *, 'before vAmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call vAmat_real (v) - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 + if (rank == 0) print *, 'before vAmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call vAmat_real(v) + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 ! ExjEyz - Do isym = 1, nsymrpa - - ixyz = 0 - Do ix = 1, nact - Do iy = 1, nact - Do iz = 1, nact - jx = convert_active_to_global_idx(ix) - jy = convert_active_to_global_idx(iy) - jz = convert_active_to_global_idx(iz) - if (nsymrpa /= 1) then - syma = MULTB_D(irpamo(jx), isym) - symb = MULTB_D(irpamo(jy), irpamo(jz)) - syma = MULTB_S(syma, symb) - end if - If (nsymrpa == 1 .or. (nsymrpa /= 1 .and. (syma == 1))) then - ixyz = ixyz + 1 - End if - End do + Do isym = 1, nsymrpa + + ixyz = 0 + Do ix = 1, nact + Do iy = 1, nact + Do iz = 1, nact + jx = convert_active_to_global_idx(ix) + jy = convert_active_to_global_idx(iy) + jz = convert_active_to_global_idx(iz) + if (nsymrpa /= 1) then + syma = MULTB_D(irpamo(jx), isym) + symb = MULTB_D(irpamo(jy), irpamo(jz)) + syma = MULTB_S(syma, symb) + end if + If (nsymrpa == 1 .or. (nsymrpa /= 1 .and. (syma == 1))) then + ixyz = ixyz + 1 + End if End do End do + End do - dimn = ixyz + dimn = ixyz - If (dimn == 0) cycle ! Go to the next isym. + If (dimn == 0) cycle ! Go to the next isym. - Allocate (indsym(3, dimn)); Call memplus(KIND(indsym), SIZE(indsym), 1) + Allocate (indsym(3, dimn)); Call memplus(KIND(indsym), SIZE(indsym), 1) - ixyz = 0 + ixyz = 0 - Do ix = 1, nact - Do iy = 1, nact - Do iz = 1, nact - jx = convert_active_to_global_idx(ix) - jy = convert_active_to_global_idx(iy) - jz = convert_active_to_global_idx(iz) - if (nsymrpa /= 1) then - syma = MULTB_D(irpamo(jx), isym) - symb = MULTB_D(irpamo(jy), irpamo(jz)) - syma = MULTB_S(syma, symb) - end if + Do ix = 1, nact + Do iy = 1, nact + Do iz = 1, nact + jx = convert_active_to_global_idx(ix) + jy = convert_active_to_global_idx(iy) + jz = convert_active_to_global_idx(iz) + if (nsymrpa /= 1) then + syma = MULTB_D(irpamo(jx), isym) + symb = MULTB_D(irpamo(jy), irpamo(jz)) + syma = MULTB_S(syma, symb) + end if - If (nsymrpa == 1 .or. (nsymrpa /= 1 .and. (syma == 1))) then - ixyz = ixyz + 1 - indsym(1, ixyz) = ix - indsym(2, ixyz) = iy - indsym(3, ixyz) = iz - End if - End do + If (nsymrpa == 1 .or. (nsymrpa /= 1 .and. (syma == 1))) then + ixyz = ixyz + 1 + indsym(1, ixyz) = ix + indsym(2, ixyz) = iy + indsym(3, ixyz) = iz + End if End do End do + End do - if (rank == 0) print *, 'isym, dimn', isym, dimn - Allocate (sc(dimn, dimn)); Call memplus(KIND(sc), SIZE(sc), 2) + if (rank == 0) print *, 'isym, dimn', isym, dimn + Allocate (sc(dimn, dimn)); Call memplus(KIND(sc), SIZE(sc), 2) - sc = 0.0d+00 ! sr N*N - if (rank == 0) print *, 'before sAmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call sAmat_real (dimn, indsym, sc) + sc = 0.0d+00 ! sr N*N + if (rank == 0) print *, 'before sAmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call sAmat_real(dimn, indsym, sc) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'sc matrix is obtained normally' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (ws(dimn)); Call memplus(KIND(ws), SIZE(ws), 1) + if (rank == 0) print *, 'sc matrix is obtained normally' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Allocate (ws(dimn)); Call memplus(KIND(ws), SIZE(ws), 1) - Allocate (sc0(dimn, dimn)); Call memplus(KIND(sc0), SIZE(sc0), 2) - sc0 = sc - if (rank == 0) print *, 'before cdiag' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call rdiag(sc, dimn, dimm, ws, smat_lin_dep_threshold) + Allocate (sc0(dimn, dimn)); Call memplus(KIND(sc0), SIZE(sc0), 2) + sc0 = sc + if (rank == 0) print *, 'before cdiag' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call rdiag(sc, dimn, dimm, ws, smat_lin_dep_threshold) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'after sc cdiag' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - - If (dimm == 0) then - Call memminus(KIND(indsym), SIZE(indsym), 1); deallocate (indsym) - Call memminus(KIND(sc0), SIZE(sc0), 2); deallocate (sc0) - Call memminus(KIND(sc), SIZE(sc), 2); deallocate (sc) - Call memminus(KIND(ws), SIZE(ws), 1); deallocate (ws) - cycle ! Go to the next isym. - End if + if (rank == 0) print *, 'after sc cdiag' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + If (dimm == 0) then + Call memminus(KIND(indsym), SIZE(indsym), 1); deallocate (indsym) + Call memminus(KIND(sc0), SIZE(sc0), 2); deallocate (sc0) + Call memminus(KIND(sc), SIZE(sc), 2); deallocate (sc) + Call memminus(KIND(ws), SIZE(ws), 1); deallocate (ws) + cycle ! Go to the next isym. + End if - if (rank == 0) print *, 'OK cdiag', dimn, dimm + if (rank == 0) print *, 'OK cdiag', dimn, dimm - Allocate (bc(dimn, dimn)); Call memplus(KIND(bc), SIZE(bc), 2) ! br N*N - bc = 0.0d+00 - if (rank == 0) print *, 'before bAmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call bAmat_real (dimn, sc0, indsym, bc) + Allocate (bc(dimn, dimn)); Call memplus(KIND(bc), SIZE(bc), 2) ! br N*N + bc = 0.0d+00 + if (rank == 0) print *, 'before bAmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call bAmat_real(dimn, sc0, indsym, bc) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'bc matrix is obtained normally' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call memminus(KIND(sc0), SIZE(sc0), 2); deallocate (sc0) + if (rank == 0) print *, 'bc matrix is obtained normally' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call memminus(KIND(sc0), SIZE(sc0), 2); deallocate (sc0) - Allocate (uc(dimn, dimm)); Call memplus(KIND(uc), SIZE(uc), 2) ! uc N*M - Allocate (wsnew(dimm)); Call memplus(KIND(wsnew), SIZE(wsnew), 1) ! wnew M - uc(:, :) = 0.0d+00 - wsnew(:) = 0.0d+00 + Allocate (uc(dimn, dimm)); Call memplus(KIND(uc), SIZE(uc), 2) ! uc N*M + Allocate (wsnew(dimm)); Call memplus(KIND(wsnew), SIZE(wsnew), 1) ! wnew M + uc(:, :) = 0.0d+00 + wsnew(:) = 0.0d+00 - if (rank == 0) print *, 'before ccutoff' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call rcutoff(sc, ws, dimn, dimm, smat_lin_dep_threshold, uc, wsnew) + if (rank == 0) print *, 'before ccutoff' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call rcutoff(sc, ws, dimn, dimm, smat_lin_dep_threshold, uc, wsnew) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'OK ccutoff' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call memminus(KIND(sc), SIZE(sc), 2); deallocate (sc) - Call memminus(KIND(ws), SIZE(ws), 1); deallocate (ws) + if (rank == 0) print *, 'OK ccutoff' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call memminus(KIND(sc), SIZE(sc), 2); deallocate (sc) + Call memminus(KIND(ws), SIZE(ws), 1); deallocate (ws) - if (rank == 0) print *, 'before ulambda_s_half' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call ulambda_s_half(uc, wsnew, dimn, dimm) ! uc N*M matrix rewritten as uramda^(-1/2) + if (rank == 0) print *, 'before ulambda_s_half' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call ulambda_s_half(uc, wsnew, dimn, dimm) ! uc N*M matrix rewritten as uramda^(-1/2) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - Call memminus(KIND(wsnew), SIZE(wsnew), 1); deallocate (wsnew) + Call memminus(KIND(wsnew), SIZE(wsnew), 1); deallocate (wsnew) - if (rank == 0) print *, 'ucrams half OK' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (bc0(dimm, dimn)); Call memplus(KIND(bc0), SIZE(bc0), 2) ! bc0 M*N - bc0 = 0.0d+00 - bc0 = MATMUL(TRANSPOSE(uc), bc) - - Allocate (bc1(dimm, dimm)); Call memplus(KIND(bc1), SIZE(bc1), 2) ! bc1 M*M - bc1 = 0.0d+00 - bc1 = MATMUL(bc0, uc) - - If (debug) then - if (rank == 0) then - print *, 'Check whether bc1 is hermite or not' - Do i = 1, dimm - Do j = i, dimm - if (ABS(bc1(i, j) - bc1(j, i)) > 1.0d-6) then + if (rank == 0) print *, 'ucrams half OK' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Allocate (bc0(dimm, dimn)); Call memplus(KIND(bc0), SIZE(bc0), 2) ! bc0 M*N + bc0 = 0.0d+00 + bc0 = MATMUL(TRANSPOSE(uc), bc) + + Allocate (bc1(dimm, dimm)); Call memplus(KIND(bc1), SIZE(bc1), 2) ! bc1 M*M + bc1 = 0.0d+00 + bc1 = MATMUL(bc0, uc) + + If (debug) then + if (rank == 0) then + print *, 'Check whether bc1 is hermite or not' + Do i = 1, dimm + Do j = i, dimm + if (ABS(bc1(i, j) - bc1(j, i)) > 1.0d-6) then print '(2I4,2E15.7)', i, j, bc1(i, j) - bc1(j, i) End if End do @@ -1093,7 +1092,7 @@ end subroutine solve_A_subspace_real ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! - SUBROUTINE sAmat_real (dimn, indsym, sc) ! Assume C1 molecule, overlap matrix S in space A + SUBROUTINE sAmat_real(dimn, indsym, sc) ! Assume C1 molecule, overlap matrix S in space A ! ! S(xyz,tuv) = - <0|EzyEtxEuv|0> + d(tx)<0|EzyEuv|0> ! @@ -1149,7 +1148,7 @@ End subroutine sAmat_real ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE bAmat_real (dimn, sc, indsym, bc) ! Assume C1 molecule, overlap matrix B in space A + SUBROUTINE bAmat_real(dimn, sc, indsym, bc) ! Assume C1 molecule, overlap matrix B in space A ! ! B(xyz,tuv) = Siguma_w eps(w){-<0|EzyEtxEuvEww|0> + d(tx)<0|EzyEuvEww|0>} ! @@ -1237,7 +1236,7 @@ End subroutine bAmat_real ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! - SUBROUTINE vAmat_real (v) + SUBROUTINE vAmat_real(v) ! ! Assume C1 molecule, V=<0|H|i> matrix in space A ! diff --git a/src/solve_B_subspace.f90 b/src/solve_B_subspace.f90 index af12abf7..b5ce95bc 100644 --- a/src/solve_B_subspace.f90 +++ b/src/solve_B_subspace.f90 @@ -18,33 +18,33 @@ SUBROUTINE solve_B_subspace(e0, e2b) ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE solve_B_subspace_complex () + SUBROUTINE solve_B_subspace_complex() ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - use module_global_variables - use module_index_utils, only: convert_active_to_global_idx + use module_global_variables + use module_index_utils, only: convert_active_to_global_idx - Implicit NONE + Implicit NONE #ifdef HAVE_MPI - include 'mpif.h' + include 'mpif.h' #endif - integer :: dimn, dimm, dammy - integer, allocatable :: indsym(:, :) - real(8), allocatable :: wsnew(:), ws(:), wb(:) - real(8) :: e2(2*nsymrpa), e, alpha - complex*16, allocatable :: sc(:, :), uc(:, :), sc0(:, :) - complex*16, allocatable :: bc(:, :) - complex*16, allocatable :: bc0(:, :), bc1(:, :), v(:, :, :), vc(:), vc1(:) - integer, allocatable :: ii0(:), ij0(:), iij(:, :) - integer :: nij - logical :: cutoff - integer :: j, i, syma, isym, i0 - integer :: ij, it, ii, iu, jj, jt, ji, ju - integer :: datetmp0, datetmp1 - real(8) :: tsectmp0, tsectmp1 + integer :: dimn, dimm, dammy + integer, allocatable :: indsym(:, :) + real(8), allocatable :: wsnew(:), ws(:), wb(:) + real(8) :: e2(2*nsymrpa), e, alpha + complex*16, allocatable :: sc(:, :), uc(:, :), sc0(:, :) + complex*16, allocatable :: bc(:, :) + complex*16, allocatable :: bc0(:, :), bc1(:, :), v(:, :, :), vc(:), vc1(:) + integer, allocatable :: ii0(:), ij0(:), iij(:, :) + integer :: nij + logical :: cutoff + integer :: j, i, syma, isym, i0 + integer :: ij, it, ii, iu, jj, jt, ji, ju + integer :: datetmp0, datetmp1 + real(8) :: tsectmp0, tsectmp1 ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= @@ -77,181 +77,181 @@ SUBROUTINE solve_B_subspace_complex () ! ! E2 = SIGUMA_a,i, dimm |V1(dimm,ai)|^2|/{(alpha(ai) + wb(dimm)} - e2 = 0.0d+00 - e2b = 0.0d+00 - dimn = 0 - datetmp1 = date0; datetmp0 = date0 - Call timing(date0, tsec0, datetmp0, tsectmp0) - tsectmp1 = tsectmp0 - if (rank == 0) then - print *, ' ENTER solv B part' - print *, ' nsymrpa', nsymrpa - end if - Allocate (iij(ninact, ninact)); Call memplus(KIND(iij), SIZE(iij), 1) - iij = 0 + e2 = 0.0d+00 + e2b = 0.0d+00 + dimn = 0 + datetmp1 = date0; datetmp0 = date0 + Call timing(date0, tsec0, datetmp0, tsectmp0) + tsectmp1 = tsectmp0 + if (rank == 0) then + print *, ' ENTER solv B part' + print *, ' nsymrpa', nsymrpa + end if + Allocate (iij(ninact, ninact)); Call memplus(KIND(iij), SIZE(iij), 1) + iij = 0 ! (ninact*(ninact-1))/2 means the number of (ii,ij) pairs (ii>ij) - nij = (ninact*(ninact - 1))/2 - Allocate (ii0(nij)); Call memplus(KIND(ii0), SIZE(ii0), 1) - Allocate (ij0(nij)); Call memplus(KIND(ii0), SIZE(ii0), 1) - - i0 = 0 - Do ii = 1, ninact - Do ij = 1, ii - 1 - i0 = i0 + 1 - iij(ii, ij) = i0 - iij(ij, ii) = i0 - ii0(i0) = ii - ij0(i0) = ij - End do + nij = (ninact*(ninact - 1))/2 + Allocate (ii0(nij)); Call memplus(KIND(ii0), SIZE(ii0), 1) + Allocate (ij0(nij)); Call memplus(KIND(ii0), SIZE(ii0), 1) + + i0 = 0 + Do ii = 1, ninact + Do ij = 1, ii - 1 + i0 = i0 + 1 + iij(ii, ij) = i0 + iij(ij, ii) = i0 + ii0(i0) = ii + ij0(i0) = ij End do - Allocate (v(nij, nact, nact)) - Call memplus(KIND(v), SIZE(v), 2) - v = 0.0d+00 - if (rank == 0) print *, 'end before v matrices' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call vBmat_complex (nij, iij, v) - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 + End do + Allocate (v(nij, nact, nact)) + Call memplus(KIND(v), SIZE(v), 2) + v = 0.0d+00 + if (rank == 0) print *, 'end before v matrices' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call vBmat_complex(nij, iij, v) + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 ! EtiEuj|0> - Do isym = 1, nsymrpa + Do isym = 1, nsymrpa - dimn = 0 - Do it = 1, nact - jt = convert_active_to_global_idx(it) - Do iu = 1, it - 1 - ju = convert_active_to_global_idx(iu) + dimn = 0 + Do it = 1, nact + jt = convert_active_to_global_idx(it) + Do iu = 1, it - 1 + ju = convert_active_to_global_idx(iu) - if (nsymrpa /= 1) syma = MULTB_D(irpamo(jt), irpamo(ju) - (-1)**(mod(irpamo(ju), 2))) + if (nsymrpa /= 1) syma = MULTB_D(irpamo(jt), irpamo(ju) - (-1)**(mod(irpamo(ju), 2))) - if (nsymrpa == 1 .or. (nsymrpa /= 1 .and. syma == isym)) then - dimn = dimn + 1 - End if - End do + if (nsymrpa == 1 .or. (nsymrpa /= 1 .and. syma == isym)) then + dimn = dimn + 1 + End if End do + End do - if (rank == 0) print *, 'isym, dimn', isym, dimn - If (dimn == 0) cycle ! Go to the next isym. + if (rank == 0) print *, 'isym, dimn', isym, dimn + If (dimn == 0) cycle ! Go to the next isym. - Allocate (indsym(2, dimn)); Call memplus(KIND(indsym), SIZE(indsym), 1) + Allocate (indsym(2, dimn)); Call memplus(KIND(indsym), SIZE(indsym), 1) - dimn = 0 - Do it = 1, nact - jt = convert_active_to_global_idx(it) - Do iu = 1, it - 1 - ju = convert_active_to_global_idx(iu) + dimn = 0 + Do it = 1, nact + jt = convert_active_to_global_idx(it) + Do iu = 1, it - 1 + ju = convert_active_to_global_idx(iu) - if (nsymrpa /= 1) syma = MULTB_D(irpamo(jt), irpamo(ju) - (-1)**(mod(irpamo(ju), 2))) + if (nsymrpa /= 1) syma = MULTB_D(irpamo(jt), irpamo(ju) - (-1)**(mod(irpamo(ju), 2))) - if (nsymrpa == 1 .or. (nsymrpa /= 1 .and. syma == isym)) then - dimn = dimn + 1 - indsym(1, dimn) = it - indsym(2, dimn) = iu - End if - End do + if (nsymrpa == 1 .or. (nsymrpa /= 1 .and. syma == isym)) then + dimn = dimn + 1 + indsym(1, dimn) = it + indsym(2, dimn) = iu + End if End do + End do - Allocate (sc(dimn, dimn)); Call memplus(KIND(sc), SIZE(sc), 2) - sc = 0.0d+00 ! sc N*N - if (rank == 0) print *, 'before sBmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call sBmat_complex (dimn, indsym, sc) + Allocate (sc(dimn, dimn)); Call memplus(KIND(sc), SIZE(sc), 2) + sc = 0.0d+00 ! sc N*N + if (rank == 0) print *, 'before sBmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call sBmat_complex(dimn, indsym, sc) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'sc matrix is obtained normally' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (ws(dimn)); Call memplus(KIND(ws), SIZE(ws), 1) - - Allocate (sc0(dimn, dimn)); Call memplus(KIND(sc0), SIZE(sc0), 2) - sc0 = sc - if (rank == 0) print *, 'before cdiag' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call cdiag(sc, dimn, dimm, ws, smat_lin_dep_threshold) -! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'after s cdiag, new dimension is', dimm - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - If (dimm == 0) then - Call memminus(KIND(indsym), SIZE(indsym), 1); deallocate (indsym) - Call memminus(KIND(sc0), SIZE(sc0), 2); deallocate (sc0) - Call memminus(KIND(sc), SIZE(sc), 2); deallocate (sc) - Call memminus(KIND(ws), SIZE(ws), 1); deallocate (ws) - cycle ! Go to the next isym. - End if + if (rank == 0) print *, 'sc matrix is obtained normally' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Allocate (ws(dimn)); Call memplus(KIND(ws), SIZE(ws), 1) - Allocate (bc(dimn, dimn)); Call memplus(KIND(bc), SIZE(bc), 2) ! br N*N - bc = 0.0d+00 - if (rank == 0) print *, 'before bBmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call bBmat_complex (dimn, sc0, indsym, bc) + Allocate (sc0(dimn, dimn)); Call memplus(KIND(sc0), SIZE(sc0), 2) + sc0 = sc + if (rank == 0) print *, 'before cdiag' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call cdiag(sc, dimn, dimm, ws, smat_lin_dep_threshold) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - if (rank == 0) print *, 'bc matrix is obtained normally' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - If (debug) then - if (rank == 0) print *, 'Check whether U*SU is diagonal' - Call checkdgc(dimn, sc0, sc, ws) - if (rank == 0) print *, 'Check whether U*SU is diagonal END' - End if + if (rank == 0) print *, 'after s cdiag, new dimension is', dimm + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + If (dimm == 0) then + Call memminus(KIND(indsym), SIZE(indsym), 1); deallocate (indsym) Call memminus(KIND(sc0), SIZE(sc0), 2); deallocate (sc0) - - if (rank == 0) print *, 'OK cdiag', dimn, dimm - Allocate (uc(dimn, dimm)); Call memplus(KIND(uc), SIZE(uc), 2) ! uc N*M - Allocate (wsnew(dimm)); Call memplus(KIND(wsnew), SIZE(wsnew), 1) ! wnew M - uc(:, :) = 0.0d+00 - wsnew(:) = 0.0d+00 - if (rank == 0) print *, 'before ccutoff' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call ccutoff(sc, ws, dimn, dimm, smat_lin_dep_threshold, uc, wsnew) -! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'OK ccutoff' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 Call memminus(KIND(sc), SIZE(sc), 2); deallocate (sc) Call memminus(KIND(ws), SIZE(ws), 1); deallocate (ws) - if (rank == 0) print *, 'before ulambda_s_half' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call ulambda_s_half(uc, wsnew, dimn, dimm) ! uc N*M matrix rewritten as uramda^(-1/2) + cycle ! Go to the next isym. + End if + + Allocate (bc(dimn, dimn)); Call memplus(KIND(bc), SIZE(bc), 2) ! br N*N + bc = 0.0d+00 + if (rank == 0) print *, 'before bBmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call bBmat_complex(dimn, sc0, indsym, bc) +! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + if (rank == 0) print *, 'bc matrix is obtained normally' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + If (debug) then + if (rank == 0) print *, 'Check whether U*SU is diagonal' + Call checkdgc(dimn, sc0, sc, ws) + if (rank == 0) print *, 'Check whether U*SU is diagonal END' + End if + Call memminus(KIND(sc0), SIZE(sc0), 2); deallocate (sc0) + + if (rank == 0) print *, 'OK cdiag', dimn, dimm + Allocate (uc(dimn, dimm)); Call memplus(KIND(uc), SIZE(uc), 2) ! uc N*M + Allocate (wsnew(dimm)); Call memplus(KIND(wsnew), SIZE(wsnew), 1) ! wnew M + uc(:, :) = 0.0d+00 + wsnew(:) = 0.0d+00 + if (rank == 0) print *, 'before ccutoff' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call ccutoff(sc, ws, dimn, dimm, smat_lin_dep_threshold, uc, wsnew) +! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + if (rank == 0) print *, 'OK ccutoff' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call memminus(KIND(sc), SIZE(sc), 2); deallocate (sc) + Call memminus(KIND(ws), SIZE(ws), 1); deallocate (ws) + if (rank == 0) print *, 'before ulambda_s_half' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call ulambda_s_half(uc, wsnew, dimn, dimm) ! uc N*M matrix rewritten as uramda^(-1/2) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - Call memminus(KIND(wsnew), SIZE(wsnew), 1); deallocate (wsnew) - if (rank == 0) print *, 'ucrams half OK' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (bc0(dimm, dimn)); Call memplus(KIND(bc0), SIZE(bc0), 2) ! bc0 M*N - bc0 = 0.0d+00 - bc0 = MATMUL(TRANSPOSE(DCONJG(uc)), bc) - - Allocate (bc1(dimm, dimm)); Call memplus(KIND(bc1), SIZE(bc1), 2) ! bc1 M*M - bc1 = 0.0d+00 - bc1 = MATMUL(bc0, uc) - - If (debug) then - - if (rank == 0) print *, 'Check whether bc1 is hermite or not' - Do i = 1, dimm - Do j = i, dimm - if (ABS(bc1(i, j) - DCONJG(bc1(j, i))) > 1.0d-6) then + Call memminus(KIND(wsnew), SIZE(wsnew), 1); deallocate (wsnew) + if (rank == 0) print *, 'ucrams half OK' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Allocate (bc0(dimm, dimn)); Call memplus(KIND(bc0), SIZE(bc0), 2) ! bc0 M*N + bc0 = 0.0d+00 + bc0 = MATMUL(TRANSPOSE(DCONJG(uc)), bc) + + Allocate (bc1(dimm, dimm)); Call memplus(KIND(bc1), SIZE(bc1), 2) ! bc1 M*M + bc1 = 0.0d+00 + bc1 = MATMUL(bc0, uc) + + If (debug) then + + if (rank == 0) print *, 'Check whether bc1 is hermite or not' + Do i = 1, dimm + Do j = i, dimm + if (ABS(bc1(i, j) - DCONJG(bc1(j, i))) > 1.0d-6) then if (rank == 0) print '(2I4,2E15.7)', i, j, bc1(i, j) - bc1(j, i) End if End do @@ -279,13 +279,13 @@ SUBROUTINE solve_B_subspace_complex () Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) datetmp1 = datetmp0 tsectmp1 = tsectmp0 - If (debug) then + If (debug) then - if (rank == 0) print *, 'Check whether bc is really diagonalized or not' - Call checkdgc(dimm, bc0, bc1, wb) + if (rank == 0) print *, 'Check whether bc is really diagonalized or not' + Call checkdgc(dimm, bc0, bc1, wb) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'Check whether bc is really diagonalized or not END' - End if + if (rank == 0) print *, 'Check whether bc is really diagonalized or not END' + End if Call memminus(KIND(bc0), SIZE(bc0), 2); deallocate (bc0) @@ -360,7 +360,7 @@ end subroutine solve_B_subspace_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE sBmat_complex (dimn, indsym, sc) ! Assume C1 molecule, overlap matrix S in space B + SUBROUTINE sBmat_complex(dimn, indsym, sc) ! Assume C1 molecule, overlap matrix S in space B ! S(xy, tu) = <0|EtxEuy|0> -d(tx)<0|Euy|0> -d(uy)<0|Etx|0> -d(ty)<0|Eux|0> +d(tx)d(uy)-d(ty)d(ux) ! @@ -383,7 +383,7 @@ SUBROUTINE sBmat_complex (dimn, indsym, sc) ! Assume C1 molecule, overlap matrix sc = 0.0d+00 -!$OMP parallel do schedule(dynamic,1) private(ix,iy,j,it,iu,a,b) +!$OMP parallel do schedule(dynamic,1) private(i,ix,iy,j,it,iu,a,b) Do i = rank + 1, dimn, nprocs ! MPI parallelization (Distributed loop: static scheduling, per nprocs) ix = indsym(1, i) @@ -432,7 +432,7 @@ End subroutine sBmat_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE bBmat_complex (dimn, sc, indsym, bc) ! Assume C1 molecule, overlap matrix B in space B + SUBROUTINE bBmat_complex(dimn, sc, indsym, bc) ! Assume C1 molecule, overlap matrix B in space B ! ! B(xy,tu) = Siguma_w [eps(w){<0|EtxEuyEww|0>-d(tx)<0|EuyEww|0> -d(uy)<0|EtxEww|0> -d(ty)<0|EuxEww|0>] ! @@ -463,7 +463,7 @@ SUBROUTINE bBmat_complex (dimn, sc, indsym, bc) ! Assume C1 molecule, overlap ma if (rank == 0) print *, 'B space Bmat iroot=', iroot -!$OMP parallel do schedule(dynamic,1) private(ix,iy,jx,jy,it,iu,jt,ju,e,j,iw,jw,denr,deni,den) +!$OMP parallel do schedule(dynamic,1) private(i,ix,iy,jx,jy,it,iu,jt,ju,e,j,iw,jw,denr,deni,den) Do i = rank + 1, dimn, nprocs ! MPI parallelization (Distributed loop: static scheduling, per nprocs) ix = indsym(1, i) @@ -533,7 +533,7 @@ End subroutine bBmat_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE vBmat_complex (nij, iij, v) + SUBROUTINE vBmat_complex(nij, iij, v) ! ! ! V(i,j) = SIGUMA_p,q:active <0|EptEqu|0>(pi|qj) @@ -619,8 +619,7 @@ SUBROUTINE vBmat_complex (nij, iij, v) ! Term 2 ! + SIGUMA_p:active[<0|Ept|0> {(ui|pj) - (pi|uj)} - <0|Epu|0> (ti|pj)] ! =========================== ================ ! loop for t loop for u(variable u is renamed to t) -!!$OMP parallel -!!$OMP do schedule(dynamic,1) private(dr,di,dens,iu) +!!$OMP parallel do schedule(dynamic,1) private(it,dr,di,dens) Do it = 1, nact Call dim1_density(k, it, dr, di) @@ -632,9 +631,9 @@ SUBROUTINE vBmat_complex (nij, iij, v) dens = DCMPLX(dr, di) v(tij, it, k) = v(tij, it, k) - cint2*dens end do -!!$OMP end do +!!$OMP end parallel do isym = multb_s_reverse(j, l) -!!$OMP do schedule(dynamic,1) private(it,iu,dr,di,dens) +!!$OMP parallel do schedule(dynamic,1) private(i0,it,iu,dr,di,dens) do i0 = 1, pattern_tu_count(isym) it = pattern_t(i0, isym) iu = pattern_u(i0, isym) @@ -647,8 +646,7 @@ SUBROUTINE vBmat_complex (nij, iij, v) v(tij, it, iu) = v(tij, it, iu) + cint2*dens End do -!!$OMP end do -!!$OMP end parallel +!!$OMP end parallel do end do close (unit_int2) @@ -661,33 +659,33 @@ end subroutine vBmat_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE solve_B_subspace_real () + SUBROUTINE solve_B_subspace_real() ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - use module_global_variables - use module_index_utils, only: convert_active_to_global_idx + use module_global_variables + use module_index_utils, only: convert_active_to_global_idx - Implicit NONE + Implicit NONE #ifdef HAVE_MPI - include 'mpif.h' + include 'mpif.h' #endif - integer :: dimn, dimm, dammy - integer, allocatable :: indsym(:, :) - real(8), allocatable :: wsnew(:), ws(:), wb(:) - real(8) :: e2(2*nsymrpa), e, alpha - real(8), allocatable :: sc(:, :), uc(:, :), sc0(:, :) - real(8), allocatable :: bc(:, :) - real(8), allocatable :: bc0(:, :), bc1(:, :), v(:, :, :), vc(:), vc1(:) - integer, allocatable :: ii0(:), ij0(:), iij(:, :) - integer :: nij - logical :: cutoff - integer :: j, i, syma, isym, i0 - integer :: ij, it, ii, iu, jj, jt, ji, ju - integer :: datetmp0, datetmp1 - real(8) :: tsectmp0, tsectmp1 + integer :: dimn, dimm, dammy + integer, allocatable :: indsym(:, :) + real(8), allocatable :: wsnew(:), ws(:), wb(:) + real(8) :: e2(2*nsymrpa), e, alpha + real(8), allocatable :: sc(:, :), uc(:, :), sc0(:, :) + real(8), allocatable :: bc(:, :) + real(8), allocatable :: bc0(:, :), bc1(:, :), v(:, :, :), vc(:), vc1(:) + integer, allocatable :: ii0(:), ij0(:), iij(:, :) + integer :: nij + logical :: cutoff + integer :: j, i, syma, isym, i0 + integer :: ij, it, ii, iu, jj, jt, ji, ju + integer :: datetmp0, datetmp1 + real(8) :: tsectmp0, tsectmp1 ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= @@ -720,176 +718,176 @@ SUBROUTINE solve_B_subspace_real () ! ! E2 = SIGUMA_a,i, dimm |V1(dimm,ai)|^2|/{(alpha(ai) + wb(dimm)} - e2 = 0.0d+00 - e2b = 0.0d+00 - dimn = 0 - datetmp1 = date0; datetmp0 = date0 - Call timing(date0, tsec0, datetmp0, tsectmp0) - tsectmp1 = tsectmp0 - if (rank == 0) then - print *, ' ENTER solv B part' - print *, ' nsymrpa', nsymrpa - end if - Allocate (iij(ninact, ninact)); Call memplus(KIND(iij), SIZE(iij), 1) - iij = 0 + e2 = 0.0d+00 + e2b = 0.0d+00 + dimn = 0 + datetmp1 = date0; datetmp0 = date0 + Call timing(date0, tsec0, datetmp0, tsectmp0) + tsectmp1 = tsectmp0 + if (rank == 0) then + print *, ' ENTER solv B part' + print *, ' nsymrpa', nsymrpa + end if + Allocate (iij(ninact, ninact)); Call memplus(KIND(iij), SIZE(iij), 1) + iij = 0 ! (ninact*(ninact-1))/2 means the number of (ii,ij) pairs (ii>ij) - nij = (ninact*(ninact - 1))/2 - Allocate (ii0(nij)); Call memplus(KIND(ii0), SIZE(ii0), 1) - Allocate (ij0(nij)); Call memplus(KIND(ii0), SIZE(ii0), 1) - - i0 = 0 - Do ii = 1, ninact - Do ij = 1, ii - 1 - i0 = i0 + 1 - iij(ii, ij) = i0 - iij(ij, ii) = i0 - ii0(i0) = ii - ij0(i0) = ij - End do + nij = (ninact*(ninact - 1))/2 + Allocate (ii0(nij)); Call memplus(KIND(ii0), SIZE(ii0), 1) + Allocate (ij0(nij)); Call memplus(KIND(ii0), SIZE(ii0), 1) + + i0 = 0 + Do ii = 1, ninact + Do ij = 1, ii - 1 + i0 = i0 + 1 + iij(ii, ij) = i0 + iij(ij, ii) = i0 + ii0(i0) = ii + ij0(i0) = ij End do - Allocate (v(nij, nact, nact)) - Call memplus(KIND(v), SIZE(v), 2) - v = 0.0d+00 - if (rank == 0) print *, 'end before v matrices' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call vBmat_real (nij, iij, v) - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 + End do + Allocate (v(nij, nact, nact)) + Call memplus(KIND(v), SIZE(v), 2) + v = 0.0d+00 + if (rank == 0) print *, 'end before v matrices' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call vBmat_real(nij, iij, v) + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 ! EtiEuj|0> - Do isym = 1, nsymrpa + Do isym = 1, nsymrpa - dimn = 0 - Do it = 1, nact - jt = convert_active_to_global_idx(it) - Do iu = 1, it - 1 - ju = convert_active_to_global_idx(iu) + dimn = 0 + Do it = 1, nact + jt = convert_active_to_global_idx(it) + Do iu = 1, it - 1 + ju = convert_active_to_global_idx(iu) - if (nsymrpa /= 1) syma = MULTB_D(irpamo(jt), irpamo(ju) - (-1)**(mod(irpamo(ju), 2))) + if (nsymrpa /= 1) syma = MULTB_D(irpamo(jt), irpamo(ju) - (-1)**(mod(irpamo(ju), 2))) - if (nsymrpa == 1 .or. (nsymrpa /= 1 .and. syma == isym)) then - dimn = dimn + 1 - End if - End do + if (nsymrpa == 1 .or. (nsymrpa /= 1 .and. syma == isym)) then + dimn = dimn + 1 + End if End do + End do - if (rank == 0) print *, 'isym, dimn', isym, dimn - If (dimn == 0) cycle ! Go to the next isym. + if (rank == 0) print *, 'isym, dimn', isym, dimn + If (dimn == 0) cycle ! Go to the next isym. - Allocate (indsym(2, dimn)); Call memplus(KIND(indsym), SIZE(indsym), 1) + Allocate (indsym(2, dimn)); Call memplus(KIND(indsym), SIZE(indsym), 1) - dimn = 0 - Do it = 1, nact - jt = convert_active_to_global_idx(it) - Do iu = 1, it - 1 - ju = convert_active_to_global_idx(iu) + dimn = 0 + Do it = 1, nact + jt = convert_active_to_global_idx(it) + Do iu = 1, it - 1 + ju = convert_active_to_global_idx(iu) - if (nsymrpa /= 1) syma = MULTB_D(irpamo(jt), irpamo(ju) - (-1)**(mod(irpamo(ju), 2))) + if (nsymrpa /= 1) syma = MULTB_D(irpamo(jt), irpamo(ju) - (-1)**(mod(irpamo(ju), 2))) - if (nsymrpa == 1 .or. (nsymrpa /= 1 .and. syma == isym)) then - dimn = dimn + 1 - indsym(1, dimn) = it - indsym(2, dimn) = iu - End if - End do + if (nsymrpa == 1 .or. (nsymrpa /= 1 .and. syma == isym)) then + dimn = dimn + 1 + indsym(1, dimn) = it + indsym(2, dimn) = iu + End if End do + End do - Allocate (sc(dimn, dimn)); Call memplus(KIND(sc), SIZE(sc), 2) - sc = 0.0d+00 ! sc N*N - if (rank == 0) print *, 'before sBmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call sBmat_real (dimn, indsym, sc) + Allocate (sc(dimn, dimn)); Call memplus(KIND(sc), SIZE(sc), 2) + sc = 0.0d+00 ! sc N*N + if (rank == 0) print *, 'before sBmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call sBmat_real(dimn, indsym, sc) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'sc matrix is obtained normally' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (ws(dimn)); Call memplus(KIND(ws), SIZE(ws), 1) - - Allocate (sc0(dimn, dimn)); Call memplus(KIND(sc0), SIZE(sc0), 2) - sc0 = sc - if (rank == 0) print *, 'before cdiag' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call rdiag(sc, dimn, dimm, ws, smat_lin_dep_threshold) -! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'after s cdiag, new dimension is', dimm - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - If (dimm == 0) then - Call memminus(KIND(indsym), SIZE(indsym), 1); deallocate (indsym) - Call memminus(KIND(sc0), SIZE(sc0), 2); deallocate (sc0) - Call memminus(KIND(sc), SIZE(sc), 2); deallocate (sc) - Call memminus(KIND(ws), SIZE(ws), 1); deallocate (ws) - cycle ! Go to the next isym. - End if + if (rank == 0) print *, 'sc matrix is obtained normally' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Allocate (ws(dimn)); Call memplus(KIND(ws), SIZE(ws), 1) - Allocate (bc(dimn, dimn)); Call memplus(KIND(bc), SIZE(bc), 2) ! br N*N - bc = 0.0d+00 - if (rank == 0) print *, 'before bBmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call bBmat_real (dimn, sc0, indsym, bc) + Allocate (sc0(dimn, dimn)); Call memplus(KIND(sc0), SIZE(sc0), 2) + sc0 = sc + if (rank == 0) print *, 'before cdiag' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call rdiag(sc, dimn, dimm, ws, smat_lin_dep_threshold) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - if (rank == 0) print *, 'bc matrix is obtained normally' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 + if (rank == 0) print *, 'after s cdiag, new dimension is', dimm + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + If (dimm == 0) then + Call memminus(KIND(indsym), SIZE(indsym), 1); deallocate (indsym) Call memminus(KIND(sc0), SIZE(sc0), 2); deallocate (sc0) - - if (rank == 0) print *, 'OK cdiag', dimn, dimm - Allocate (uc(dimn, dimm)); Call memplus(KIND(uc), SIZE(uc), 2) ! uc N*M - Allocate (wsnew(dimm)); Call memplus(KIND(wsnew), SIZE(wsnew), 1) ! wnew M - uc(:, :) = 0.0d+00 - wsnew(:) = 0.0d+00 - if (rank == 0) print *, 'before ccutoff' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call rcutoff(sc, ws, dimn, dimm, smat_lin_dep_threshold, uc, wsnew) -! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'OK ccutoff' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 Call memminus(KIND(sc), SIZE(sc), 2); deallocate (sc) Call memminus(KIND(ws), SIZE(ws), 1); deallocate (ws) - if (rank == 0) print *, 'before ulambda_s_half' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call ulambda_s_half(uc, wsnew, dimn, dimm) ! uc N*M matrix rewritten as uramda^(-1/2) + cycle ! Go to the next isym. + End if + + Allocate (bc(dimn, dimn)); Call memplus(KIND(bc), SIZE(bc), 2) ! br N*N + bc = 0.0d+00 + if (rank == 0) print *, 'before bBmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call bBmat_real(dimn, sc0, indsym, bc) +! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + if (rank == 0) print *, 'bc matrix is obtained normally' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call memminus(KIND(sc0), SIZE(sc0), 2); deallocate (sc0) + + if (rank == 0) print *, 'OK cdiag', dimn, dimm + Allocate (uc(dimn, dimm)); Call memplus(KIND(uc), SIZE(uc), 2) ! uc N*M + Allocate (wsnew(dimm)); Call memplus(KIND(wsnew), SIZE(wsnew), 1) ! wnew M + uc(:, :) = 0.0d+00 + wsnew(:) = 0.0d+00 + if (rank == 0) print *, 'before ccutoff' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call rcutoff(sc, ws, dimn, dimm, smat_lin_dep_threshold, uc, wsnew) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - Call memminus(KIND(wsnew), SIZE(wsnew), 1); deallocate (wsnew) - if (rank == 0) print *, 'ucrams half OK' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (bc0(dimm, dimn)); Call memplus(KIND(bc0), SIZE(bc0), 2) ! bc0 M*N - bc0 = 0.0d+00 - bc0 = MATMUL(TRANSPOSE(uc), bc) - - Allocate (bc1(dimm, dimm)); Call memplus(KIND(bc1), SIZE(bc1), 2) ! bc1 M*M - bc1 = 0.0d+00 - bc1 = MATMUL(bc0, uc) - - If (debug) then - - if (rank == 0) print *, 'Check whether bc1 is hermite or not' - Do i = 1, dimm - Do j = i, dimm - if (ABS(bc1(i, j) - bc1(j, i)) > 1.0d-6) then + if (rank == 0) print *, 'OK ccutoff' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call memminus(KIND(sc), SIZE(sc), 2); deallocate (sc) + Call memminus(KIND(ws), SIZE(ws), 1); deallocate (ws) + if (rank == 0) print *, 'before ulambda_s_half' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call ulambda_s_half(uc, wsnew, dimn, dimm) ! uc N*M matrix rewritten as uramda^(-1/2) +! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + Call memminus(KIND(wsnew), SIZE(wsnew), 1); deallocate (wsnew) + if (rank == 0) print *, 'ucrams half OK' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Allocate (bc0(dimm, dimn)); Call memplus(KIND(bc0), SIZE(bc0), 2) ! bc0 M*N + bc0 = 0.0d+00 + bc0 = MATMUL(TRANSPOSE(uc), bc) + + Allocate (bc1(dimm, dimm)); Call memplus(KIND(bc1), SIZE(bc1), 2) ! bc1 M*M + bc1 = 0.0d+00 + bc1 = MATMUL(bc0, uc) + + If (debug) then + + if (rank == 0) print *, 'Check whether bc1 is hermite or not' + Do i = 1, dimm + Do j = i, dimm + if (ABS(bc1(i, j) - bc1(j, i)) > 1.0d-6) then if (rank == 0) print '(2I4,2E15.7)', i, j, bc1(i, j) - bc1(j, i) End if End do @@ -991,7 +989,7 @@ end subroutine solve_B_subspace_real ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE sBmat_real (dimn, indsym, sc) ! Assume C1 molecule, overlap matrix S in space B + SUBROUTINE sBmat_real(dimn, indsym, sc) ! Assume C1 molecule, overlap matrix S in space B ! S(xy, tu) = <0|EtxEuy|0> -d(tx)<0|Euy|0> -d(uy)<0|Etx|0> -d(ty)<0|Eux|0> +d(tx)d(uy)-d(ty)d(ux) ! @@ -1014,7 +1012,7 @@ SUBROUTINE sBmat_real (dimn, indsym, sc) ! Assume C1 molecule, overlap matrix S sc = 0.0d+00 -!$OMP parallel do schedule(dynamic,1) private(ix,iy,j,it,iu,a,b) +!$OMP parallel do schedule(dynamic,1) private(i,ix,iy,j,it,iu,a,b) Do i = rank + 1, dimn, nprocs ! MPI parallelization (Distributed loop: static scheduling, per nprocs) ix = indsym(1, i) @@ -1063,7 +1061,7 @@ End subroutine sBmat_real ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE bBmat_real (dimn, sc, indsym, bc) ! Assume C1 molecule, overlap matrix B in space B + SUBROUTINE bBmat_real(dimn, sc, indsym, bc) ! Assume C1 molecule, overlap matrix B in space B ! ! B(xy,tu) = Siguma_w [eps(w){<0|EtxEuyEww|0>-d(tx)<0|EuyEww|0> -d(uy)<0|EtxEww|0> -d(ty)<0|EuxEww|0>] ! @@ -1094,7 +1092,7 @@ SUBROUTINE bBmat_real (dimn, sc, indsym, bc) ! Assume C1 molecule, overlap matri if (rank == 0) print *, 'B space Bmat iroot=', iroot -!$OMP parallel do schedule(dynamic,1) private(ix,iy,jx,jy,it,iu,jt,ju,e,j,iw,jw,denr,deni,den) +!$OMP parallel do schedule(dynamic,1) private(i,ix,iy,jx,jy,it,iu,jt,ju,e,j,iw,jw,denr,deni,den) Do i = rank + 1, dimn, nprocs ! MPI parallelization (Distributed loop: static scheduling, per nprocs) ix = indsym(1, i) @@ -1164,7 +1162,7 @@ End subroutine bBmat_real ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE vBmat_real (nij, iij, v) + SUBROUTINE vBmat_real(nij, iij, v) ! ! ! V(i,j) = SIGUMA_p,q:active <0|EptEqu|0>(pi|qj) @@ -1250,8 +1248,7 @@ SUBROUTINE vBmat_real (nij, iij, v) ! Term 2 ! + SIGUMA_p:active[<0|Ept|0> {(ui|pj) - (pi|uj)} - <0|Epu|0> (ti|pj)] ! =========================== ================ ! loop for t loop for u(variable u is renamed to t) -!!$OMP parallel -!!$OMP do schedule(dynamic,1) private(dr,di,dens,iu) +!!$OMP parallel do private(iu,dr,di,dens) Do it = 1, nact Call dim1_density(k, it, dr, di) @@ -1263,9 +1260,9 @@ SUBROUTINE vBmat_real (nij, iij, v) dens = dr v(tij, it, k) = v(tij, it, k) - cint2*dens end do -!!$OMP end do +!!$OMP end parallel do isym = multb_s_reverse(j, l) -!!$OMP do schedule(dynamic,1) private(it,iu,dr,di,dens) +!!$OMP parallel do private(it,iu,dr,di,dens) do i0 = 1, pattern_tu_count(isym) it = pattern_t(i0, isym) iu = pattern_u(i0, isym) @@ -1278,8 +1275,7 @@ SUBROUTINE vBmat_real (nij, iij, v) v(tij, it, iu) = v(tij, it, iu) + cint2*dens End do -!!$OMP end do -!!$OMP end parallel +!!$OMP end parallel do end do close (unit_int2) @@ -1290,31 +1286,31 @@ SUBROUTINE vBmat_real (nij, iij, v) #endif end subroutine vBmat_real -subroutine create_multb_s_reverse_b_subspace(multb_s_reverse) + subroutine create_multb_s_reverse_b_subspace(multb_s_reverse) !======================================================================================================== ! This subroutine creates multb_s_reverse ! ! multb_s_reverse(i, j) returns the symmetry of MULTB_D(irpamo(jt), irpamo(ju) - (-1)**(mod(irpamo(ju), 2))) !======================================================================================================== - use module_global_variables, only: nsymrpa, ninact, irpamo, MULTB_D, MULTB_S - implicit none - integer :: ii, ij, isym, syma - integer, intent(inout) :: multb_s_reverse(:, :) - - if (nsymrpa == 1) then - multb_s_reverse(:, :) = 1 - else - do ii = 1, ninact - do ij = 1, ii - 1 - syma = MULTB_D(irpamo(ii) - (-1)**(mod(irpamo(ii), 2)), irpamo(ij)) - do isym = 1, nsymrpa - if (MULTB_S(syma, isym) == 1) then - multb_s_reverse(ii, ij) = isym - exit - end if + use module_global_variables, only: nsymrpa, ninact, irpamo, MULTB_D, MULTB_S + implicit none + integer :: ii, ij, isym, syma + integer, intent(inout) :: multb_s_reverse(:, :) + + if (nsymrpa == 1) then + multb_s_reverse(:, :) = 1 + else + do ii = 1, ninact + do ij = 1, ii - 1 + syma = MULTB_D(irpamo(ii) - (-1)**(mod(irpamo(ii), 2)), irpamo(ij)) + do isym = 1, nsymrpa + if (MULTB_S(syma, isym) == 1) then + multb_s_reverse(ii, ij) = isym + exit + end if + end do end do end do - end do - end if -end subroutine create_multb_s_reverse_b_subspace + end if + end subroutine create_multb_s_reverse_b_subspace end SUBROUTINE solve_B_subspace diff --git a/src/solve_C_subspace.f90 b/src/solve_C_subspace.f90 index a64cccca..ea21e479 100644 --- a/src/solve_C_subspace.f90 +++ b/src/solve_C_subspace.f90 @@ -17,36 +17,36 @@ SUBROUTINE solve_C_subspace(e0, e2c) ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE solve_C_subspace_complex () + SUBROUTINE solve_C_subspace_complex() ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - use module_global_variables - use module_index_utils, only: convert_active_to_global_idx, convert_secondary_to_global_idx + use module_global_variables + use module_index_utils, only: convert_active_to_global_idx, convert_secondary_to_global_idx - Implicit NONE + Implicit NONE #ifdef HAVE_MPI - include 'mpif.h' + include 'mpif.h' #endif - integer :: dimn, dimm, dammy + integer :: dimn, dimm, dammy - integer, allocatable :: indsym(:, :) + integer, allocatable :: indsym(:, :) - real(8), allocatable :: wsnew(:), ws(:), wb(:) - real(8) :: e2(nsymrpa), alpha + real(8), allocatable :: wsnew(:), ws(:), wb(:) + real(8) :: e2(nsymrpa), alpha - complex*16, allocatable :: sc(:, :), uc(:, :), sc0(:, :) - complex*16, allocatable :: bc(:, :) - complex*16, allocatable :: bc0(:, :), bc1(:, :), v(:, :, :, :), vc(:), vc1(:) + complex*16, allocatable :: sc(:, :), uc(:, :), sc0(:, :) + complex*16, allocatable :: bc(:, :) + complex*16, allocatable :: bc0(:, :), bc1(:, :), v(:, :, :, :), vc(:), vc1(:) - integer :: j, i, syma, symb, isym - integer :: ix, iy, iz, ia, dima, ixyz - integer :: jx, jy, jz, ja, it + integer :: j, i, syma, symb, isym + integer :: ix, iy, iz, ia, dima, ixyz + integer :: jx, jy, jz, ja, it - integer :: datetmp0, datetmp1 - real(8) :: tsectmp0, tsectmp1 + integer :: datetmp0, datetmp1 + real(8) :: tsectmp0, tsectmp1 ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= @@ -73,190 +73,190 @@ SUBROUTINE solve_C_subspace_complex () ! ! E2 = SIGUMA_a, dimm |V1(dimm,a)|^2|/{(a(a) + wb(dimm)} - e2 = 0.0d+00 - e2c = 0.0d+00 - dima = 0 - dimn = 0 - syma = 0 - datetmp1 = date0; datetmp0 = date0 - Call timing(date0, tsec0, datetmp0, tsectmp0) - tsectmp1 = tsectmp0 - if (rank == 0) then - print *, ' ENTER solv C part' - print *, ' nsymrpa', nsymrpa - end if - Allocate (v(nsec, nact, nact, nact)) - if (rank == 0) print *, 'end before v matrices' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call vCmat_complex (v) - if (rank == 0) print *, 'come' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Do isym = 1, nsymrpa + e2 = 0.0d+00 + e2c = 0.0d+00 + dima = 0 + dimn = 0 + syma = 0 + datetmp1 = date0; datetmp0 = date0 + Call timing(date0, tsec0, datetmp0, tsectmp0) + tsectmp1 = tsectmp0 + if (rank == 0) then + print *, ' ENTER solv C part' + print *, ' nsymrpa', nsymrpa + end if + Allocate (v(nsec, nact, nact, nact)) + if (rank == 0) print *, 'end before v matrices' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call vCmat_complex(v) + if (rank == 0) print *, 'come' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Do isym = 1, nsymrpa - ixyz = 0 + ixyz = 0 ! EatEuv|0> ! EaxEyz|0> - Do ix = 1, nact - Do iy = 1, nact - Do iz = 1, nact - - jx = convert_active_to_global_idx(ix) - jy = convert_active_to_global_idx(iy) - jz = convert_active_to_global_idx(iz) - if (nsymrpa /= 1) then - syma = MULTB_D(isym, irpamo(jx)) - symb = MULTB_D(irpamo(jy), irpamo(jz)) - syma = MULTB_S(syma, symb) - end if - If (nsymrpa == 1 .or. (nsymrpa /= 1 .and. (syma == 1))) then - ixyz = ixyz + 1 - End if + Do ix = 1, nact + Do iy = 1, nact + Do iz = 1, nact + + jx = convert_active_to_global_idx(ix) + jy = convert_active_to_global_idx(iy) + jz = convert_active_to_global_idx(iz) + if (nsymrpa /= 1) then + syma = MULTB_D(isym, irpamo(jx)) + symb = MULTB_D(irpamo(jy), irpamo(jz)) + syma = MULTB_S(syma, symb) + end if + If (nsymrpa == 1 .or. (nsymrpa /= 1 .and. (syma == 1))) then + ixyz = ixyz + 1 + End if - End do End do End do + End do - dimn = ixyz + dimn = ixyz - If (dimn == 0) cycle ! Go to the next isym + If (dimn == 0) cycle ! Go to the next isym - Allocate (indsym(3, dimn)) - indsym = 0 - ixyz = 0 + Allocate (indsym(3, dimn)) + indsym = 0 + ixyz = 0 - Do ix = 1, nact - Do iy = 1, nact - Do iz = 1, nact + Do ix = 1, nact + Do iy = 1, nact + Do iz = 1, nact - jx = convert_active_to_global_idx(ix) - jy = convert_active_to_global_idx(iy) - jz = convert_active_to_global_idx(iz) - if (nsymrpa /= 1) then - syma = MULTB_D(isym, irpamo(jx)) - symb = MULTB_D(irpamo(jy), irpamo(jz)) - syma = MULTB_S(syma, symb) - end if - If (nsymrpa == 1 .or. (nsymrpa /= 1 .and. (syma == 1))) then + jx = convert_active_to_global_idx(ix) + jy = convert_active_to_global_idx(iy) + jz = convert_active_to_global_idx(iz) + if (nsymrpa /= 1) then + syma = MULTB_D(isym, irpamo(jx)) + symb = MULTB_D(irpamo(jy), irpamo(jz)) + syma = MULTB_S(syma, symb) + end if + If (nsymrpa == 1 .or. (nsymrpa /= 1 .and. (syma == 1))) then - ixyz = ixyz + 1 - indsym(1, ixyz) = ix - indsym(2, ixyz) = iy - indsym(3, ixyz) = iz - End if + ixyz = ixyz + 1 + indsym(1, ixyz) = ix + indsym(2, ixyz) = iy + indsym(3, ixyz) = iz + End if - End do End do End do + End do - if (rank == 0) print *, 'isym, dimn', isym, dimn - Allocate (sc(dimn, dimn)) - sc = 0.0d+00 ! sr N*N - if (rank == 0) print *, 'before sCmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call sCmat_complex (dimn, indsym, sc) + if (rank == 0) print *, 'isym, dimn', isym, dimn + Allocate (sc(dimn, dimn)) + sc = 0.0d+00 ! sr N*N + if (rank == 0) print *, 'before sCmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call sCmat_complex(dimn, indsym, sc) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'sC matrix is obtained normally' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (ws(dimn)) - ws = 0.0d+00 - - Allocate (sc0(dimn, dimn)) - sc0 = 0.0d+00 - sc0 = sc - if (rank == 0) print *, 'before cdiag' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call cdiag(sc, dimn, dimm, ws, smat_lin_dep_threshold) + if (rank == 0) print *, 'sC matrix is obtained normally' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Allocate (ws(dimn)) + ws = 0.0d+00 + + Allocate (sc0(dimn, dimn)) + sc0 = 0.0d+00 + sc0 = sc + if (rank == 0) print *, 'before cdiag' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call cdiag(sc, dimn, dimm, ws, smat_lin_dep_threshold) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) then - print *, 'after sc cdiag' - print *, 'after s cdiag, new dimension is', dimm - end if - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - If (dimm == 0) then - deallocate (indsym) - deallocate (sc0) - deallocate (sc) - deallocate (ws) - cycle ! Go to the next isym - End if + if (rank == 0) then + print *, 'after sc cdiag' + print *, 'after s cdiag, new dimension is', dimm + end if + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + If (dimm == 0) then + deallocate (indsym) + deallocate (sc0) + deallocate (sc) + deallocate (ws) + cycle ! Go to the next isym + End if - If (debug) then - if (rank == 0) print *, 'Check whether U*SU is diagonal' - Call checkdgc(dimn, sc0, sc, ws) - if (rank == 0) print *, 'Check whether U*SU is diagonal END' - End if - if (rank == 0) print *, 'OK cdiag', dimn, dimm - Allocate (bc(dimn, dimn)) ! br N*N - bc = 0.0d+00 - if (rank == 0) print *, 'before bCmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call bCmat_complex (dimn, sc0, indsym, bc) + If (debug) then + if (rank == 0) print *, 'Check whether U*SU is diagonal' + Call checkdgc(dimn, sc0, sc, ws) + if (rank == 0) print *, 'Check whether U*SU is diagonal END' + End if + if (rank == 0) print *, 'OK cdiag', dimn, dimm + Allocate (bc(dimn, dimn)) ! br N*N + bc = 0.0d+00 + if (rank == 0) print *, 'before bCmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call bCmat_complex(dimn, sc0, indsym, bc) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - deallocate (sc0) + deallocate (sc0) - if (rank == 0) print *, 'bC matrix is obtained normally' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (uc(dimn, dimm)) ! uc N*M - Allocate (wsnew(dimm)) ! wnew M - uc(:, :) = 0.0d+00 - wsnew(:) = 0.0d+00 - if (rank == 0) print *, 'before ccutoff' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call ccutoff(sc, ws, dimn, dimm, smat_lin_dep_threshold, uc, wsnew) + if (rank == 0) print *, 'bC matrix is obtained normally' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Allocate (uc(dimn, dimm)) ! uc N*M + Allocate (wsnew(dimm)) ! wnew M + uc(:, :) = 0.0d+00 + wsnew(:) = 0.0d+00 + if (rank == 0) print *, 'before ccutoff' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call ccutoff(sc, ws, dimn, dimm, smat_lin_dep_threshold, uc, wsnew) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'OK ccutoff' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - deallocate (ws) - deallocate (sc) - if (rank == 0) print *, 'before ulambda_s_half' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call ulambda_s_half(uc, wsnew, dimn, dimm) ! uc N*M matrix rewritten as uramda^(-1/2) + if (rank == 0) print *, 'OK ccutoff' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + deallocate (ws) + deallocate (sc) + if (rank == 0) print *, 'before ulambda_s_half' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call ulambda_s_half(uc, wsnew, dimn, dimm) ! uc N*M matrix rewritten as uramda^(-1/2) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - deallocate (wsnew) - - if (rank == 0) print *, 'ucrams half OK' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (bc0(dimm, dimn)) ! bc0 M*N - bc0 = 0.0d+00 - bc0 = MATMUL(TRANSPOSE(DCONJG(uc)), bc) - Allocate (bc1(dimm, dimm)) ! bc1 M*M - bc1 = 0.0d+00 - bc1 = MATMUL(bc0, uc) - - If (debug) then - if (rank == 0) then - print *, 'Check whether bc1 is hermite or not' - Do i = 1, dimm - Do j = i, dimm - if (ABS(bc1(i, j) - DCONJG(bc1(j, i))) > 1.0d-6) then + deallocate (wsnew) + + if (rank == 0) print *, 'ucrams half OK' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Allocate (bc0(dimm, dimn)) ! bc0 M*N + bc0 = 0.0d+00 + bc0 = MATMUL(TRANSPOSE(DCONJG(uc)), bc) + Allocate (bc1(dimm, dimm)) ! bc1 M*M + bc1 = 0.0d+00 + bc1 = MATMUL(bc0, uc) + + If (debug) then + if (rank == 0) then + print *, 'Check whether bc1 is hermite or not' + Do i = 1, dimm + Do j = i, dimm + if (ABS(bc1(i, j) - DCONJG(bc1(j, i))) > 1.0d-6) then print '(2I4,2E15.7)', i, j, bc1(i, j) - bc1(j, i) End if End do @@ -284,13 +284,13 @@ SUBROUTINE solve_C_subspace_complex () Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) datetmp1 = datetmp0 tsectmp1 = tsectmp0 - If (debug) then + If (debug) then - if (rank == 0) print *, 'Check whether bc is really diagonalized or not' - Call checkdgc(dimm, bc0, bc1, wb) + if (rank == 0) print *, 'Check whether bc is really diagonalized or not' + Call checkdgc(dimm, bc0, bc1, wb) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'Check whether bc is really diagonalized or not END' - End if + if (rank == 0) print *, 'Check whether bc is really diagonalized or not END' + End if deallocate (bc0) if (rank == 0) print *, 'bC1 matrix is diagonalized!' @@ -349,7 +349,7 @@ end subroutine solve_C_subspace_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE sCmat_complex (dimn, indsym, sc) ! Assume C1 molecule, overlap matrix S in space C + SUBROUTINE sCmat_complex(dimn, indsym, sc) ! Assume C1 molecule, overlap matrix S in space C ! S(xyz,tuv) = <0|EzyExtEuv|0> ! x > z, t > v @@ -407,7 +407,7 @@ End subroutine sCmat_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE bCmat_complex (dimn, sc, indsym, bc) + SUBROUTINE bCmat_complex(dimn, sc, indsym, bc) ! ! Indices are restricted as t > v, x > z ! So the dimension of (xyz) is (norb**3+norb**2)/2 @@ -490,7 +490,7 @@ End subroutine bCmat_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE vCmat_complex (v) + SUBROUTINE vCmat_complex(v) ! Assume C1 molecule, V=<0|H|i> matrix in space C ! @@ -748,36 +748,36 @@ end subroutine vCmat_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE solve_C_subspace_real () + SUBROUTINE solve_C_subspace_real() ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - use module_global_variables - use module_index_utils, only: convert_active_to_global_idx, convert_secondary_to_global_idx + use module_global_variables + use module_index_utils, only: convert_active_to_global_idx, convert_secondary_to_global_idx - Implicit NONE + Implicit NONE #ifdef HAVE_MPI - include 'mpif.h' + include 'mpif.h' #endif - integer :: dimn, dimm, dammy + integer :: dimn, dimm, dammy - integer, allocatable :: indsym(:, :) + integer, allocatable :: indsym(:, :) - real(8), allocatable :: wsnew(:), ws(:), wb(:) - real(8) :: e2(nsymrpa), alpha + real(8), allocatable :: wsnew(:), ws(:), wb(:) + real(8) :: e2(nsymrpa), alpha - real(8), allocatable :: sc(:, :), uc(:, :), sc0(:, :) - real(8), allocatable :: bc(:, :) - real(8), allocatable :: bc0(:, :), bc1(:, :), v(:, :, :, :), vc(:), vc1(:) + real(8), allocatable :: sc(:, :), uc(:, :), sc0(:, :) + real(8), allocatable :: bc(:, :) + real(8), allocatable :: bc0(:, :), bc1(:, :), v(:, :, :, :), vc(:), vc1(:) - integer :: j, i, syma, symb, isym - integer :: ix, iy, iz, ia, dima, ixyz - integer :: jx, jy, jz, ja, it + integer :: j, i, syma, symb, isym + integer :: ix, iy, iz, ia, dima, ixyz + integer :: jx, jy, jz, ja, it - integer :: datetmp0, datetmp1 - real(8) :: tsectmp0, tsectmp1 + integer :: datetmp0, datetmp1 + real(8) :: tsectmp0, tsectmp1 ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= @@ -804,185 +804,185 @@ SUBROUTINE solve_C_subspace_real () ! ! E2 = SIGUMA_a, dimm |V1(dimm,a)|^2|/{(a(a) + wb(dimm)} - e2 = 0.0d+00 - e2c = 0.0d+00 - dima = 0 - dimn = 0 - syma = 0 - datetmp1 = date0; datetmp0 = date0 - Call timing(date0, tsec0, datetmp0, tsectmp0) - tsectmp1 = tsectmp0 - if (rank == 0) then - print *, ' ENTER solv C part' - print *, ' nsymrpa', nsymrpa - end if - Allocate (v(nsec, nact, nact, nact)) - if (rank == 0) print *, 'end before v matrices' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call vCmat_real (v) - if (rank == 0) print *, 'come' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Do isym = 1, nsymrpa + e2 = 0.0d+00 + e2c = 0.0d+00 + dima = 0 + dimn = 0 + syma = 0 + datetmp1 = date0; datetmp0 = date0 + Call timing(date0, tsec0, datetmp0, tsectmp0) + tsectmp1 = tsectmp0 + if (rank == 0) then + print *, ' ENTER solv C part' + print *, ' nsymrpa', nsymrpa + end if + Allocate (v(nsec, nact, nact, nact)) + if (rank == 0) print *, 'end before v matrices' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call vCmat_real(v) + if (rank == 0) print *, 'come' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Do isym = 1, nsymrpa - ixyz = 0 + ixyz = 0 ! EatEuv|0> ! EaxEyz|0> - Do ix = 1, nact - Do iy = 1, nact - Do iz = 1, nact - - jx = convert_active_to_global_idx(ix) - jy = convert_active_to_global_idx(iy) - jz = convert_active_to_global_idx(iz) - if (nsymrpa /= 1) then - syma = MULTB_D(isym, irpamo(jx)) - symb = MULTB_D(irpamo(jy), irpamo(jz)) - syma = MULTB_S(syma, symb) - end if - If (nsymrpa == 1 .or. (nsymrpa /= 1 .and. (syma == 1))) then - ixyz = ixyz + 1 - End if + Do ix = 1, nact + Do iy = 1, nact + Do iz = 1, nact + + jx = convert_active_to_global_idx(ix) + jy = convert_active_to_global_idx(iy) + jz = convert_active_to_global_idx(iz) + if (nsymrpa /= 1) then + syma = MULTB_D(isym, irpamo(jx)) + symb = MULTB_D(irpamo(jy), irpamo(jz)) + syma = MULTB_S(syma, symb) + end if + If (nsymrpa == 1 .or. (nsymrpa /= 1 .and. (syma == 1))) then + ixyz = ixyz + 1 + End if - End do End do End do + End do - dimn = ixyz + dimn = ixyz - If (dimn == 0) cycle ! Go to the next isym + If (dimn == 0) cycle ! Go to the next isym - Allocate (indsym(3, dimn)) - indsym = 0 - ixyz = 0 + Allocate (indsym(3, dimn)) + indsym = 0 + ixyz = 0 - Do ix = 1, nact - Do iy = 1, nact - Do iz = 1, nact + Do ix = 1, nact + Do iy = 1, nact + Do iz = 1, nact - jx = convert_active_to_global_idx(ix) - jy = convert_active_to_global_idx(iy) - jz = convert_active_to_global_idx(iz) - if (nsymrpa /= 1) then - syma = MULTB_D(isym, irpamo(jx)) - symb = MULTB_D(irpamo(jy), irpamo(jz)) - syma = MULTB_S(syma, symb) - end if - If (nsymrpa == 1 .or. (nsymrpa /= 1 .and. (syma == 1))) then + jx = convert_active_to_global_idx(ix) + jy = convert_active_to_global_idx(iy) + jz = convert_active_to_global_idx(iz) + if (nsymrpa /= 1) then + syma = MULTB_D(isym, irpamo(jx)) + symb = MULTB_D(irpamo(jy), irpamo(jz)) + syma = MULTB_S(syma, symb) + end if + If (nsymrpa == 1 .or. (nsymrpa /= 1 .and. (syma == 1))) then - ixyz = ixyz + 1 - indsym(1, ixyz) = ix - indsym(2, ixyz) = iy - indsym(3, ixyz) = iz - End if + ixyz = ixyz + 1 + indsym(1, ixyz) = ix + indsym(2, ixyz) = iy + indsym(3, ixyz) = iz + End if - End do End do End do + End do - if (rank == 0) print *, 'isym, dimn', isym, dimn - Allocate (sc(dimn, dimn)) - sc = 0.0d+00 ! sr N*N - if (rank == 0) print *, 'before sCmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call sCmat_real (dimn, indsym, sc) + if (rank == 0) print *, 'isym, dimn', isym, dimn + Allocate (sc(dimn, dimn)) + sc = 0.0d+00 ! sr N*N + if (rank == 0) print *, 'before sCmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call sCmat_real(dimn, indsym, sc) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'sC matrix is obtained normally' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (ws(dimn)) - ws = 0.0d+00 - - Allocate (sc0(dimn, dimn)) - sc0 = 0.0d+00 - sc0 = sc - if (rank == 0) print *, 'before cdiag' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call rdiag(sc, dimn, dimm, ws, smat_lin_dep_threshold) + if (rank == 0) print *, 'sC matrix is obtained normally' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Allocate (ws(dimn)) + ws = 0.0d+00 + + Allocate (sc0(dimn, dimn)) + sc0 = 0.0d+00 + sc0 = sc + if (rank == 0) print *, 'before cdiag' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call rdiag(sc, dimn, dimm, ws, smat_lin_dep_threshold) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) then - print *, 'after sc cdiag' - print *, 'after s cdiag, new dimension is', dimm - end if - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - If (dimm == 0) then - deallocate (indsym) - deallocate (sc0) - deallocate (sc) - deallocate (ws) - cycle ! Go to the next isym - End if + if (rank == 0) then + print *, 'after sc cdiag' + print *, 'after s cdiag, new dimension is', dimm + end if + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + If (dimm == 0) then + deallocate (indsym) + deallocate (sc0) + deallocate (sc) + deallocate (ws) + cycle ! Go to the next isym + End if - if (rank == 0) print *, 'OK cdiag', dimn, dimm - Allocate (bc(dimn, dimn)) ! br N*N - bc = 0.0d+00 - if (rank == 0) print *, 'before bCmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call bCmat_real (dimn, sc0, indsym, bc) + if (rank == 0) print *, 'OK cdiag', dimn, dimm + Allocate (bc(dimn, dimn)) ! br N*N + bc = 0.0d+00 + if (rank == 0) print *, 'before bCmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call bCmat_real(dimn, sc0, indsym, bc) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - deallocate (sc0) + deallocate (sc0) - if (rank == 0) print *, 'bC matrix is obtained normally' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (uc(dimn, dimm)) ! uc N*M - Allocate (wsnew(dimm)) ! wnew M - uc(:, :) = 0.0d+00 - wsnew(:) = 0.0d+00 - if (rank == 0) print *, 'before ccutoff' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call rcutoff(sc, ws, dimn, dimm, smat_lin_dep_threshold, uc, wsnew) + if (rank == 0) print *, 'bC matrix is obtained normally' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Allocate (uc(dimn, dimm)) ! uc N*M + Allocate (wsnew(dimm)) ! wnew M + uc(:, :) = 0.0d+00 + wsnew(:) = 0.0d+00 + if (rank == 0) print *, 'before ccutoff' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call rcutoff(sc, ws, dimn, dimm, smat_lin_dep_threshold, uc, wsnew) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'OK ccutoff' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - deallocate (ws) - deallocate (sc) - if (rank == 0) print *, 'before ulambda_s_half' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call ulambda_s_half(uc, wsnew, dimn, dimm) ! uc N*M matrix rewritten as uramda^(-1/2) + if (rank == 0) print *, 'OK ccutoff' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + deallocate (ws) + deallocate (sc) + if (rank == 0) print *, 'before ulambda_s_half' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call ulambda_s_half(uc, wsnew, dimn, dimm) ! uc N*M matrix rewritten as uramda^(-1/2) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - deallocate (wsnew) - - if (rank == 0) print *, 'ucrams half OK' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (bc0(dimm, dimn)) ! bc0 M*N - bc0 = 0.0d+00 - bc0 = MATMUL(TRANSPOSE(uc), bc) - Allocate (bc1(dimm, dimm)) ! bc1 M*M - bc1 = 0.0d+00 - bc1 = MATMUL(bc0, uc) - - If (debug) then - if (rank == 0) then - print *, 'Check whether bc1 is hermite or not' - Do i = 1, dimm - Do j = i, dimm - if (ABS(bc1(i, j) - bc1(j, i)) > 1.0d-6) then + deallocate (wsnew) + + if (rank == 0) print *, 'ucrams half OK' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Allocate (bc0(dimm, dimn)) ! bc0 M*N + bc0 = 0.0d+00 + bc0 = MATMUL(TRANSPOSE(uc), bc) + Allocate (bc1(dimm, dimm)) ! bc1 M*M + bc1 = 0.0d+00 + bc1 = MATMUL(bc0, uc) + + If (debug) then + if (rank == 0) then + print *, 'Check whether bc1 is hermite or not' + Do i = 1, dimm + Do j = i, dimm + if (ABS(bc1(i, j) - bc1(j, i)) > 1.0d-6) then print '(2I4,2E15.7)', i, j, bc1(i, j) - bc1(j, i) End if End do @@ -1068,7 +1068,7 @@ end subroutine solve_C_subspace_real ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE sCmat_real (dimn, indsym, sc) ! Assume C1 molecule, overlap matrix S in space C + SUBROUTINE sCmat_real(dimn, indsym, sc) ! Assume C1 molecule, overlap matrix S in space C ! S(xyz,tuv) = <0|EzyExtEuv|0> ! x > z, t > v @@ -1126,7 +1126,7 @@ End subroutine sCmat_real ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE bCmat_real (dimn, sc, indsym, bc) + SUBROUTINE bCmat_real(dimn, sc, indsym, bc) ! ! Indices are restricted as t > v, x > z ! So the dimension of (xyz) is (norb**3+norb**2)/2 @@ -1209,7 +1209,7 @@ End subroutine bCmat_real ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE vCmat_real (v) + SUBROUTINE vCmat_real(v) ! Assume C1 molecule, V=<0|H|i> matrix in space C ! diff --git a/src/solve_D_subspace.f90 b/src/solve_D_subspace.f90 index f258a90e..9d6dbdbb 100644 --- a/src/solve_D_subspace.f90 +++ b/src/solve_D_subspace.f90 @@ -16,34 +16,34 @@ SUBROUTINE solve_D_subspace(e0, e2d) ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE solve_D_subspace_complex () + SUBROUTINE solve_D_subspace_complex() ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - use module_global_variables - use module_index_utils, only: convert_active_to_global_idx, convert_secondary_to_global_idx - use module_ulambda_s_half, only: ulambda_s_half + use module_global_variables + use module_index_utils, only: convert_active_to_global_idx, convert_secondary_to_global_idx + use module_ulambda_s_half, only: ulambda_s_half - Implicit NONE + Implicit NONE #ifdef HAVE_MPI - include 'mpif.h' + include 'mpif.h' #endif - integer :: dimn, dimm, dammy - integer, allocatable :: indsym(:, :) - real(8), allocatable :: wsnew(:), ws(:), wb(:) - real(8) :: e2(nsymrpa*2), e, alpha - complex*16, allocatable :: sc(:, :), uc(:, :), sc0(:, :) - complex*16, allocatable :: bc(:, :) - complex*16, allocatable :: bc0(:, :), bc1(:, :), v(:, :, :), vc(:), vc1(:) - integer, allocatable :: ia0(:), ii0(:), iai(:, :) - integer :: nai - integer :: j, i, syma, isym, i0 - integer :: ia, it, ii, iu - integer :: ja, jt, ji, ju - integer :: datetmp0, datetmp1 - real(8) :: tsectmp0, tsectmp1 + integer :: dimn, dimm, dammy + integer, allocatable :: indsym(:, :) + real(8), allocatable :: wsnew(:), ws(:), wb(:) + real(8) :: e2(nsymrpa*2), e, alpha + complex*16, allocatable :: sc(:, :), uc(:, :), sc0(:, :) + complex*16, allocatable :: bc(:, :) + complex*16, allocatable :: bc0(:, :), bc1(:, :), v(:, :, :), vc(:), vc1(:) + integer, allocatable :: ia0(:), ii0(:), iai(:, :) + integer :: nai + integer :: j, i, syma, isym, i0 + integer :: ia, it, ii, iu + integer :: ja, jt, ji, ju + integer :: datetmp0, datetmp1 + real(8) :: tsectmp0, tsectmp1 ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= @@ -77,190 +77,190 @@ SUBROUTINE solve_D_subspace_complex () ! ! E2 = SIGUMA_a,i, dimm |V1(dimm,ai)|^2|/{(alpha(ai) + wb(dimm)} - if (rank == 0) then - print *, ' ENTER solv D part' - print *, ' nsymrpa', nsymrpa - end if - datetmp1 = date0; datetmp0 = date0 - Call timing(date0, tsec0, datetmp0, tsectmp0) - tsectmp1 = tsectmp0 + if (rank == 0) then + print *, ' ENTER solv D part' + print *, ' nsymrpa', nsymrpa + end if + datetmp1 = date0; datetmp0 = date0 + Call timing(date0, tsec0, datetmp0, tsectmp0) + tsectmp1 = tsectmp0 - e2 = 0.0d+00 - e2d = 0.0d+00 - dimn = 0 - syma = 0 + e2 = 0.0d+00 + e2d = 0.0d+00 + dimn = 0 + syma = 0 - i0 = 0 - Do ia = 1, nsec - Do ii = 1, ninact - i0 = i0 + 1 - End do + i0 = 0 + Do ia = 1, nsec + Do ii = 1, ninact + i0 = i0 + 1 End do + End do - nai = i0 - Allocate (iai(nsec, ninact)) - iai = 0 - Allocate (ia0(nai)) - Allocate (ii0(nai)) - - i0 = 0 - Do ia = 1, nsec - Do ii = 1, ninact - i0 = i0 + 1 - iai(ia, ii) = i0 - ia0(i0) = convert_secondary_to_global_idx(ia) ! Secondary - ii0(i0) = ii ! inactive - End do + nai = i0 + Allocate (iai(nsec, ninact)) + iai = 0 + Allocate (ia0(nai)) + Allocate (ii0(nai)) + + i0 = 0 + Do ia = 1, nsec + Do ii = 1, ninact + i0 = i0 + 1 + iai(ia, ii) = i0 + ia0(i0) = convert_secondary_to_global_idx(ia) ! Secondary + ii0(i0) = ii ! inactive End do - Allocate (v(nai, nact, nact)) - v = 0.0d+00 - if (rank == 0) print *, 'end before v matrices' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call vDmat_complex (nai, iai, v) - if (rank == 0) print *, 'end after vDmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - if (rank == 0) print *, 'come' + End do + Allocate (v(nai, nact, nact)) + v = 0.0d+00 + if (rank == 0) print *, 'end before v matrices' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call vDmat_complex(nai, iai, v) + if (rank == 0) print *, 'end after vDmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + if (rank == 0) print *, 'come' - Do isym = 1, nsymrpa + Do isym = 1, nsymrpa - dimn = 0 - Do it = 1, nact - jt = convert_active_to_global_idx(it) - Do iu = 1, nact - ju = convert_active_to_global_idx(iu) - if (nsymrpa /= 1) syma = MULTB_D(irpamo(jt), irpamo(ju)) - if (nsymrpa == 1 .or. (nsymrpa /= 1 .and. syma == isym)) then - dimn = dimn + 1 - End if - End do + dimn = 0 + Do it = 1, nact + jt = convert_active_to_global_idx(it) + Do iu = 1, nact + ju = convert_active_to_global_idx(iu) + if (nsymrpa /= 1) syma = MULTB_D(irpamo(jt), irpamo(ju)) + if (nsymrpa == 1 .or. (nsymrpa /= 1 .and. syma == isym)) then + dimn = dimn + 1 + End if End do + End do - if (rank == 0) print *, 'isym, dimn', isym, dimn + if (rank == 0) print *, 'isym, dimn', isym, dimn - If (dimn == 0) cycle ! Go to the next isym + If (dimn == 0) cycle ! Go to the next isym - Allocate (indsym(2, dimn)) - indsym = 0 - dimn = 0 + Allocate (indsym(2, dimn)) + indsym = 0 + dimn = 0 - Do it = 1, nact - jt = convert_active_to_global_idx(it) - Do iu = 1, nact - ju = convert_active_to_global_idx(iu) + Do it = 1, nact + jt = convert_active_to_global_idx(it) + Do iu = 1, nact + ju = convert_active_to_global_idx(iu) - if (nsymrpa /= 1) syma = MULTB_D(irpamo(jt), irpamo(ju)) + if (nsymrpa /= 1) syma = MULTB_D(irpamo(jt), irpamo(ju)) - if (nsymrpa == 1 .or. (nsymrpa /= 1 .and. syma == isym)) then - dimn = dimn + 1 - indsym(1, dimn) = it - indsym(2, dimn) = iu - End if - End do + if (nsymrpa == 1 .or. (nsymrpa /= 1 .and. syma == isym)) then + dimn = dimn + 1 + indsym(1, dimn) = it + indsym(2, dimn) = iu + End if End do + End do - Allocate (sc(dimn, dimn)) - sc = 0.0d+00 ! sc N*N - if (rank == 0) print *, 'before sDmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call sDmat_complex (dimn, indsym, sc) + Allocate (sc(dimn, dimn)) + sc = 0.0d+00 ! sc N*N + if (rank == 0) print *, 'before sDmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call sDmat_complex(dimn, indsym, sc) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'sc matrix is obtained normally' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (ws(dimn)) - ws = 0.0d+00 - - Allocate (sc0(dimn, dimn)) - sc0 = sc - if (rank == 0) print *, 'before cdiag' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call cdiag(sc, dimn, dimm, ws, smat_lin_dep_threshold) -! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'after s cdiag' - - If (dimm == 0) then - deallocate (indsym) - deallocate (sc0) - deallocate (sc) - deallocate (ws) - cycle ! Go to the next isym - End if - - If (debug) then - if (rank == 0) print *, 'Check whether U*SU is diagonal' - Call checkdgc(dimn, sc0, sc, ws) - if (rank == 0) print *, 'Check whether U*SU is diagonal END' - End if + if (rank == 0) print *, 'sc matrix is obtained normally' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Allocate (ws(dimn)) + ws = 0.0d+00 - Allocate (bc(dimn, dimn)) ! bc N*N - bc = 0.0d+00 - if (rank == 0) print *, 'before bDmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call bDmat_complex (dimn, sc0, indsym, bc) + Allocate (sc0(dimn, dimn)) + sc0 = sc + if (rank == 0) print *, 'before cdiag' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call cdiag(sc, dimn, dimm, ws, smat_lin_dep_threshold) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + if (rank == 0) print *, 'after s cdiag' - if (rank == 0) print *, 'bc matrix is obtained normally' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 + If (dimm == 0) then + deallocate (indsym) deallocate (sc0) + deallocate (sc) + deallocate (ws) + cycle ! Go to the next isym + End if + + If (debug) then + if (rank == 0) print *, 'Check whether U*SU is diagonal' + Call checkdgc(dimn, sc0, sc, ws) + if (rank == 0) print *, 'Check whether U*SU is diagonal END' + End if + + Allocate (bc(dimn, dimn)) ! bc N*N + bc = 0.0d+00 + if (rank == 0) print *, 'before bDmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call bDmat_complex(dimn, sc0, indsym, bc) +! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + if (rank == 0) print *, 'bc matrix is obtained normally' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + deallocate (sc0) + + if (rank == 0) print *, 'OK cdiag', dimn, dimm - if (rank == 0) print *, 'OK cdiag', dimn, dimm - - Allocate (uc(dimn, dimm)) ! uc N*M - Allocate (wsnew(dimm)) ! wnew M - uc(:, :) = 0.0d+00 - wsnew(:) = 0.0d+00 - if (rank == 0) print *, 'before ccutoff' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call ccutoff(sc, ws, dimn, dimm, smat_lin_dep_threshold, uc, wsnew) + Allocate (uc(dimn, dimm)) ! uc N*M + Allocate (wsnew(dimm)) ! wnew M + uc(:, :) = 0.0d+00 + wsnew(:) = 0.0d+00 + if (rank == 0) print *, 'before ccutoff' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call ccutoff(sc, ws, dimn, dimm, smat_lin_dep_threshold, uc, wsnew) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'OK ccutoff' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - deallocate (ws) - deallocate (sc) - if (rank == 0) print *, 'before ulambda_s_half' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call ulambda_s_half(uc, wsnew, dimn, dimm) ! uc N*M matrix rewritten as uramda^(-1/2) + if (rank == 0) print *, 'OK ccutoff' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + deallocate (ws) + deallocate (sc) + if (rank == 0) print *, 'before ulambda_s_half' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call ulambda_s_half(uc, wsnew, dimn, dimm) ! uc N*M matrix rewritten as uramda^(-1/2) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - deallocate (wsnew) - - if (rank == 0) print *, 'ucrams half OK' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (bc0(dimm, dimn)) ! bc0 M*N - bc0 = 0.0d+00 - bc0 = MATMUL(TRANSPOSE(DCONJG(uc)), bc) - Allocate (bc1(dimm, dimm)) ! bc1 M*M - bc1 = 0.0d+00 - bc1 = MATMUL(bc0, uc) - - if (rank == 0) then - IF (debug) then - - print *, 'Check whether bc1 is hermite or not' - Do i = 1, dimm - Do j = i, dimm - if (ABS(bc1(i, j) - DCONJG(bc1(j, i))) > 1.0d-6) then + deallocate (wsnew) + + if (rank == 0) print *, 'ucrams half OK' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Allocate (bc0(dimm, dimn)) ! bc0 M*N + bc0 = 0.0d+00 + bc0 = MATMUL(TRANSPOSE(DCONJG(uc)), bc) + Allocate (bc1(dimm, dimm)) ! bc1 M*M + bc1 = 0.0d+00 + bc1 = MATMUL(bc0, uc) + + if (rank == 0) then + IF (debug) then + + print *, 'Check whether bc1 is hermite or not' + Do i = 1, dimm + Do j = i, dimm + if (ABS(bc1(i, j) - DCONJG(bc1(j, i))) > 1.0d-6) then print '(2I4,2E15.7)', i, j, bc1(i, j) - bc1(j, i) End if End do @@ -289,13 +289,13 @@ SUBROUTINE solve_D_subspace_complex () Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) datetmp1 = datetmp0 tsectmp1 = tsectmp0 - If (debug) then + If (debug) then - if (rank == 0) print *, 'Check whether bc is really diagonalized or not' - Call checkdgc(dimm, bc0, bc1, wb) + if (rank == 0) print *, 'Check whether bc is really diagonalized or not' + Call checkdgc(dimm, bc0, bc1, wb) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'Check whether bc is really diagonalized or not END' - End if + if (rank == 0) print *, 'Check whether bc is really diagonalized or not END' + End if deallocate (bc0) @@ -367,7 +367,7 @@ end subroutine solve_D_subspace_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE sDmat_complex (dimn, indsym, sc) ! Assume C1 molecule, overlap matrix S in space D + SUBROUTINE sDmat_complex(dimn, indsym, sc) ! Assume C1 molecule, overlap matrix S in space D ! S(xy, tu) = <0|EyxEtu|0> ! @@ -415,7 +415,7 @@ End subroutine sDmat_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE bDmat_complex (dimn, sc, indsym, bc) ! Assume C1 molecule, overlap matrix B in space D + SUBROUTINE bDmat_complex(dimn, sc, indsym, bc) ! Assume C1 molecule, overlap matrix B in space D ! ! B(xy,tu) = Siguma_w [eps(w)<0|EyxEtuEww|0>+S(xy,tu)(eps(t)-eps(u))] ! @@ -486,7 +486,7 @@ End subroutine bDmat_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! - SUBROUTINE vDmat_complex (nai, iai, v) + SUBROUTINE vDmat_complex(nai, iai, v) ! ! ! V(a,i) = SIGUMA_pq:active <0|EutEpq|0>{(ai|pq) - (aq|pi)} @@ -705,34 +705,34 @@ end subroutine vDmat_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE solve_D_subspace_real () + SUBROUTINE solve_D_subspace_real() ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - use module_global_variables - use module_index_utils, only: convert_active_to_global_idx, convert_secondary_to_global_idx - use module_ulambda_s_half, only: ulambda_s_half + use module_global_variables + use module_index_utils, only: convert_active_to_global_idx, convert_secondary_to_global_idx + use module_ulambda_s_half, only: ulambda_s_half - Implicit NONE + Implicit NONE #ifdef HAVE_MPI - include 'mpif.h' + include 'mpif.h' #endif - integer :: dimn, dimm, dammy - integer, allocatable :: indsym(:, :) - real(8), allocatable :: wsnew(:), ws(:), wb(:) - real(8) :: e2(nsymrpa*2), e, alpha - real(8), allocatable :: sc(:, :), uc(:, :), sc0(:, :) - real(8), allocatable :: bc(:, :) - real(8), allocatable :: bc0(:, :), bc1(:, :), v(:, :, :), vc(:), vc1(:) - integer, allocatable :: ia0(:), ii0(:), iai(:, :) - integer :: nai - integer :: j, i, syma, isym, i0 - integer :: ia, it, ii, iu - integer :: ja, jt, ji, ju - integer :: datetmp0, datetmp1 - real(8) :: tsectmp0, tsectmp1 + integer :: dimn, dimm, dammy + integer, allocatable :: indsym(:, :) + real(8), allocatable :: wsnew(:), ws(:), wb(:) + real(8) :: e2(nsymrpa*2), e, alpha + real(8), allocatable :: sc(:, :), uc(:, :), sc0(:, :) + real(8), allocatable :: bc(:, :) + real(8), allocatable :: bc0(:, :), bc1(:, :), v(:, :, :), vc(:), vc1(:) + integer, allocatable :: ia0(:), ii0(:), iai(:, :) + integer :: nai + integer :: j, i, syma, isym, i0 + integer :: ia, it, ii, iu + integer :: ja, jt, ji, ju + integer :: datetmp0, datetmp1 + real(8) :: tsectmp0, tsectmp1 ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= @@ -766,185 +766,184 @@ SUBROUTINE solve_D_subspace_real () ! ! E2 = SIGUMA_a,i, dimm |V1(dimm,ai)|^2|/{(alpha(ai) + wb(dimm)} - if (rank == 0) then - print *, ' ENTER solv D part' - print *, ' nsymrpa', nsymrpa - end if - datetmp1 = date0; datetmp0 = date0 - Call timing(date0, tsec0, datetmp0, tsectmp0) - tsectmp1 = tsectmp0 + if (rank == 0) then + print *, ' ENTER solv D part' + print *, ' nsymrpa', nsymrpa + end if + datetmp1 = date0; datetmp0 = date0 + Call timing(date0, tsec0, datetmp0, tsectmp0) + tsectmp1 = tsectmp0 - e2 = 0.0d+00 - e2d = 0.0d+00 - dimn = 0 - syma = 0 + e2 = 0.0d+00 + e2d = 0.0d+00 + dimn = 0 + syma = 0 - i0 = 0 - Do ia = 1, nsec - Do ii = 1, ninact - i0 = i0 + 1 - End do + i0 = 0 + Do ia = 1, nsec + Do ii = 1, ninact + i0 = i0 + 1 End do + End do - nai = i0 - Allocate (iai(nsec, ninact)) - iai = 0 - Allocate (ia0(nai)) - Allocate (ii0(nai)) - - i0 = 0 - Do ia = 1, nsec - Do ii = 1, ninact - i0 = i0 + 1 - iai(ia, ii) = i0 - ia0(i0) = convert_secondary_to_global_idx(ia) ! Secondary - ii0(i0) = ii ! inactive - End do + nai = i0 + Allocate (iai(nsec, ninact)) + iai = 0 + Allocate (ia0(nai)) + Allocate (ii0(nai)) + + i0 = 0 + Do ia = 1, nsec + Do ii = 1, ninact + i0 = i0 + 1 + iai(ia, ii) = i0 + ia0(i0) = convert_secondary_to_global_idx(ia) ! Secondary + ii0(i0) = ii ! inactive End do - Allocate (v(nai, nact, nact)) - v = 0.0d+00 - if (rank == 0) print *, 'end before v matrices' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call vDmat_real (nai, iai, v) - if (rank == 0) print *, 'end after vDmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - if (rank == 0) print *, 'come' + End do + Allocate (v(nai, nact, nact)) + v = 0.0d+00 + if (rank == 0) print *, 'end before v matrices' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call vDmat_real(nai, iai, v) + if (rank == 0) print *, 'end after vDmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + if (rank == 0) print *, 'come' - Do isym = 1, nsymrpa + Do isym = 1, nsymrpa - dimn = 0 - Do it = 1, nact - jt = convert_active_to_global_idx(it) - Do iu = 1, nact - ju = convert_active_to_global_idx(iu) - if (nsymrpa /= 1) syma = MULTB_D(irpamo(jt), irpamo(ju)) - if (nsymrpa == 1 .or. (nsymrpa /= 1 .and. syma == isym)) then - dimn = dimn + 1 - End if - End do + dimn = 0 + Do it = 1, nact + jt = convert_active_to_global_idx(it) + Do iu = 1, nact + ju = convert_active_to_global_idx(iu) + if (nsymrpa /= 1) syma = MULTB_D(irpamo(jt), irpamo(ju)) + if (nsymrpa == 1 .or. (nsymrpa /= 1 .and. syma == isym)) then + dimn = dimn + 1 + End if End do + End do - if (rank == 0) print *, 'isym, dimn', isym, dimn + if (rank == 0) print *, 'isym, dimn', isym, dimn - If (dimn == 0) cycle ! Go to the next isym + If (dimn == 0) cycle ! Go to the next isym - Allocate (indsym(2, dimn)) - indsym = 0 - dimn = 0 + Allocate (indsym(2, dimn)) + indsym = 0 + dimn = 0 - Do it = 1, nact - jt = convert_active_to_global_idx(it) - Do iu = 1, nact - ju = convert_active_to_global_idx(iu) + Do it = 1, nact + jt = convert_active_to_global_idx(it) + Do iu = 1, nact + ju = convert_active_to_global_idx(iu) - if (nsymrpa /= 1) syma = MULTB_D(irpamo(jt), irpamo(ju)) + if (nsymrpa /= 1) syma = MULTB_D(irpamo(jt), irpamo(ju)) - if (nsymrpa == 1 .or. (nsymrpa /= 1 .and. syma == isym)) then - dimn = dimn + 1 - indsym(1, dimn) = it - indsym(2, dimn) = iu - End if - End do + if (nsymrpa == 1 .or. (nsymrpa /= 1 .and. syma == isym)) then + dimn = dimn + 1 + indsym(1, dimn) = it + indsym(2, dimn) = iu + End if End do + End do - Allocate (sc(dimn, dimn)) - sc = 0.0d+00 ! sc N*N - if (rank == 0) print *, 'before sDmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call sDmat_real (dimn, indsym, sc) + Allocate (sc(dimn, dimn)) + sc = 0.0d+00 ! sc N*N + if (rank == 0) print *, 'before sDmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call sDmat_real(dimn, indsym, sc) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'sc matrix is obtained normally' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (ws(dimn)) - ws = 0.0d+00 - - Allocate (sc0(dimn, dimn)) - sc0 = sc - if (rank == 0) print *, 'before cdiag' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call rdiag(sc, dimn, dimm, ws, smat_lin_dep_threshold) + if (rank == 0) print *, 'sc matrix is obtained normally' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Allocate (ws(dimn)) + ws = 0.0d+00 + + Allocate (sc0(dimn, dimn)) + sc0 = sc + if (rank == 0) print *, 'before cdiag' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call rdiag(sc, dimn, dimm, ws, smat_lin_dep_threshold) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'after s cdiag' - - If (dimm == 0) then - deallocate (indsym) - deallocate (sc0) - deallocate (sc) - deallocate (ws) - cycle ! Go to the next isym - End if + if (rank == 0) print *, 'after s cdiag' + If (dimm == 0) then + deallocate (indsym) + deallocate (sc0) + deallocate (sc) + deallocate (ws) + cycle ! Go to the next isym + End if - Allocate (bc(dimn, dimn)) ! bc N*N - bc = 0.0d+00 - if (rank == 0) print *, 'before bDmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call bDmat_real (dimn, sc0, indsym, bc) + Allocate (bc(dimn, dimn)) ! bc N*N + bc = 0.0d+00 + if (rank == 0) print *, 'before bDmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call bDmat_real(dimn, sc0, indsym, bc) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'bc matrix is obtained normally' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - deallocate (sc0) + if (rank == 0) print *, 'bc matrix is obtained normally' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + deallocate (sc0) + + if (rank == 0) print *, 'OK cdiag', dimn, dimm - if (rank == 0) print *, 'OK cdiag', dimn, dimm - - Allocate (uc(dimn, dimm)) ! uc N*M - Allocate (wsnew(dimm)) ! wnew M - uc(:, :) = 0.0d+00 - wsnew(:) = 0.0d+00 - if (rank == 0) print *, 'before ccutoff' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call rcutoff(sc, ws, dimn, dimm, smat_lin_dep_threshold, uc, wsnew) + Allocate (uc(dimn, dimm)) ! uc N*M + Allocate (wsnew(dimm)) ! wnew M + uc(:, :) = 0.0d+00 + wsnew(:) = 0.0d+00 + if (rank == 0) print *, 'before ccutoff' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call rcutoff(sc, ws, dimn, dimm, smat_lin_dep_threshold, uc, wsnew) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'OK ccutoff' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - deallocate (ws) - deallocate (sc) - if (rank == 0) print *, 'before ulambda_s_half' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call ulambda_s_half(uc, wsnew, dimn, dimm) ! uc N*M matrix rewritten as uramda^(-1/2) + if (rank == 0) print *, 'OK ccutoff' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + deallocate (ws) + deallocate (sc) + if (rank == 0) print *, 'before ulambda_s_half' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call ulambda_s_half(uc, wsnew, dimn, dimm) ! uc N*M matrix rewritten as uramda^(-1/2) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - deallocate (wsnew) - - if (rank == 0) print *, 'ucrams half OK' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (bc0(dimm, dimn)) ! bc0 M*N - bc0 = 0.0d+00 - bc0 = MATMUL(TRANSPOSE(uc), bc) - Allocate (bc1(dimm, dimm)) ! bc1 M*M - bc1 = 0.0d+00 - bc1 = MATMUL(bc0, uc) - - if (rank == 0) then - IF (debug) then - - print *, 'Check whether bc1 is hermite or not' - Do i = 1, dimm - Do j = i, dimm - if (ABS(bc1(i, j) - bc1(j, i)) > 1.0d-6) then + deallocate (wsnew) + + if (rank == 0) print *, 'ucrams half OK' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Allocate (bc0(dimm, dimn)) ! bc0 M*N + bc0 = 0.0d+00 + bc0 = MATMUL(TRANSPOSE(uc), bc) + Allocate (bc1(dimm, dimm)) ! bc1 M*M + bc1 = 0.0d+00 + bc1 = MATMUL(bc0, uc) + + if (rank == 0) then + IF (debug) then + + print *, 'Check whether bc1 is hermite or not' + Do i = 1, dimm + Do j = i, dimm + if (ABS(bc1(i, j) - bc1(j, i)) > 1.0d-6) then print '(2I4,2E15.7)', i, j, bc1(i, j) - bc1(j, i) End if End do @@ -1044,7 +1043,7 @@ end subroutine solve_D_subspace_real ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE sDmat_real (dimn, indsym, sc) ! Assume C1 molecule, overlap matrix S in space D + SUBROUTINE sDmat_real(dimn, indsym, sc) ! Assume C1 molecule, overlap matrix S in space D ! S(xy, tu) = <0|EyxEtu|0> ! @@ -1092,7 +1091,7 @@ End subroutine sDmat_real ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE bDmat_real (dimn, sc, indsym, bc) ! Assume C1 molecule, overlap matrix B in space D + SUBROUTINE bDmat_real(dimn, sc, indsym, bc) ! Assume C1 molecule, overlap matrix B in space D ! ! B(xy,tu) = Siguma_w [eps(w)<0|EyxEtuEww|0>+S(xy,tu)(eps(t)-eps(u))] ! @@ -1163,7 +1162,7 @@ End subroutine bDmat_real ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! - SUBROUTINE vDmat_real (nai, iai, v) + SUBROUTINE vDmat_real(nai, iai, v) ! ! ! V(a,i) = SIGUMA_pq:active <0|EutEpq|0>{(ai|pq) - (aq|pi)} diff --git a/src/solve_E_subspace.f90 b/src/solve_E_subspace.f90 index 509c73e0..42526130 100644 --- a/src/solve_E_subspace.f90 +++ b/src/solve_E_subspace.f90 @@ -17,31 +17,31 @@ SUBROUTINE solve_E_subspace(e0, e2e) ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE solve_E_subspace_complex () + SUBROUTINE solve_E_subspace_complex() ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - use module_global_variables - use module_index_utils, only: convert_active_to_global_idx, convert_secondary_to_global_idx + use module_global_variables + use module_index_utils, only: convert_active_to_global_idx, convert_secondary_to_global_idx - Implicit NONE + Implicit NONE #ifdef HAVE_MPI - include 'mpif.h' + include 'mpif.h' #endif - integer :: dimn, dimm, dammy - real(8), allocatable :: wsnew(:), ws(:), wb(:) - real(8) :: e2(2*nsymrpa), alpha, e - complex*16, allocatable :: sc(:, :), uc(:, :), sc0(:, :) - complex*16, allocatable :: bc(:, :) - complex*16, allocatable :: bc0(:, :), bc1(:, :), v(:, :), vc(:), vc1(:) - integer :: j, i, syma, symb, isym, indt(1:nact) - integer :: ia, it, ij, ii, ja, jt, jj, ji - integer :: i0 - integer, allocatable :: ia0(:), ii0(:), ij0(:), iaij(:, :, :) - integer :: naij - integer :: datetmp0, datetmp1 - real(8) :: tsectmp0, tsectmp1 + integer :: dimn, dimm, dammy + real(8), allocatable :: wsnew(:), ws(:), wb(:) + real(8) :: e2(2*nsymrpa), alpha, e + complex*16, allocatable :: sc(:, :), uc(:, :), sc0(:, :) + complex*16, allocatable :: bc(:, :) + complex*16, allocatable :: bc0(:, :), bc1(:, :), v(:, :), vc(:), vc1(:) + integer :: j, i, syma, symb, isym, indt(1:nact) + integer :: ia, it, ij, ii, ja, jt, jj, ji + integer :: i0 + integer, allocatable :: ia0(:), ii0(:), ij0(:), iaij(:, :, :) + integer :: naij + integer :: datetmp0, datetmp1 + real(8) :: tsectmp0, tsectmp1 ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= @@ -72,165 +72,165 @@ SUBROUTINE solve_E_subspace_complex () ! ! E2 = SIGUMA_iab, dimm |V1(t,ija)|^2|/{(alpha(ija) + wb(t)} ! - e2 = 0.0d+00 - e2e = 0.0d+00 - dimn = 0 - syma = 0 - indt = 0 - datetmp1 = date0; datetmp0 = date0 - Call timing(date0, tsec0, datetmp0, tsectmp0) - tsectmp1 = tsectmp0 - if (rank == 0) then - print *, ' ENTER solv E part' - print *, ' nsymrpa', nsymrpa - end if + e2 = 0.0d+00 + e2e = 0.0d+00 + dimn = 0 + syma = 0 + indt = 0 + datetmp1 = date0; datetmp0 = date0 + Call timing(date0, tsec0, datetmp0, tsectmp0) + tsectmp1 = tsectmp0 + if (rank == 0) then + print *, ' ENTER solv E part' + print *, ' nsymrpa', nsymrpa + end if ! (ninact*(ninact-1))/2 means the number of (ii,ij) pairs (ii>ij) - i0 = nsec*(ninact*(ninact - 1))/2 - naij = i0 - Allocate (iaij(nsec, ninact, ninact)) - iaij = 0 - Allocate (ia0(naij)) - Allocate (ii0(naij)) - Allocate (ij0(naij)) - - i0 = 0 - Do ii = 1, ninact - Do ij = 1, ii - 1 ! i > j - Do ia = 1, nsec - i0 = i0 + 1 - iaij(ia, ii, ij) = i0 - iaij(ia, ij, ii) = i0 - ia0(i0) = convert_secondary_to_global_idx(ia) ! secondary - ii0(i0) = ii ! inactive - ij0(i0) = ij ! inactive - End do + i0 = nsec*(ninact*(ninact - 1))/2 + naij = i0 + Allocate (iaij(nsec, ninact, ninact)) + iaij = 0 + Allocate (ia0(naij)) + Allocate (ii0(naij)) + Allocate (ij0(naij)) + + i0 = 0 + Do ii = 1, ninact + Do ij = 1, ii - 1 ! i > j + Do ia = 1, nsec + i0 = i0 + 1 + iaij(ia, ii, ij) = i0 + iaij(ia, ij, ii) = i0 + ia0(i0) = convert_secondary_to_global_idx(ia) ! secondary + ii0(i0) = ii ! inactive + ij0(i0) = ij ! inactive End do End do + End do - Allocate (v(naij, nact)) - v = 0.0d+00 - if (rank == 0) print *, 'end before v matrices' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call vEmat_complex (naij, iaij, v) - if (rank == 0) print *, 'come' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 + Allocate (v(naij, nact)) + v = 0.0d+00 + if (rank == 0) print *, 'end before v matrices' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call vEmat_complex(naij, iaij, v) + if (rank == 0) print *, 'come' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 - Do isym = 1, nsymrpa + Do isym = 1, nsymrpa - dimn = 0 - Do it = 1, nact - jt = convert_active_to_global_idx(it) - if (irpamo(jt) == isym) then - dimn = dimn + 1 - indt(dimn) = it - End if - End do + dimn = 0 + Do it = 1, nact + jt = convert_active_to_global_idx(it) + if (irpamo(jt) == isym) then + dimn = dimn + 1 + indt(dimn) = it + End if + End do - if (rank == 0) print *, 'isym, dimn', isym, dimn - If (dimn == 0) cycle ! Go to the next isym + if (rank == 0) print *, 'isym, dimn', isym, dimn + If (dimn == 0) cycle ! Go to the next isym - Allocate (sc(dimn, dimn)) - sc = 0.0d+00 ! sc N*N - if (rank == 0) print *, 'before sEmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call sEmat_complex (dimn, indt(1:dimn), sc) + Allocate (sc(dimn, dimn)) + sc = 0.0d+00 ! sc N*N + if (rank == 0) print *, 'before sEmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call sEmat_complex(dimn, indt(1:dimn), sc) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'sc matrix is obtained normally' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (ws(dimn)) - Allocate (sc0(dimn, dimn)) - sc0 = sc - if (rank == 0) print *, 'before cdiag' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call cdiag(sc, dimn, dimm, ws, smat_lin_dep_threshold) + if (rank == 0) print *, 'sc matrix is obtained normally' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Allocate (ws(dimn)) + Allocate (sc0(dimn, dimn)) + sc0 = sc + if (rank == 0) print *, 'before cdiag' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call cdiag(sc, dimn, dimm, ws, smat_lin_dep_threshold) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'after s cdiag, new dimension is', dimm - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - If (dimm == 0) then - deallocate (sc0) - deallocate (sc) - deallocate (ws) - cycle ! Go to the next isym - End if + if (rank == 0) print *, 'after s cdiag, new dimension is', dimm + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + If (dimm == 0) then + deallocate (sc0) + deallocate (sc) + deallocate (ws) + cycle ! Go to the next isym + End if - If (debug) then + If (debug) then - if (rank == 0) print *, 'Check whether U*SU is diagonal' - Call checkdgc(dimn, sc0, sc, ws) + if (rank == 0) print *, 'Check whether U*SU is diagonal' + Call checkdgc(dimn, sc0, sc, ws) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'Check whether U*SU is diagonal END' - End if - - Allocate (bc(dimn, dimn)) ! bc N*N - bc = 0.0d+00 - if (rank == 0) print *, 'before bEmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call bEmat_complex (dimn, sc0, indt(1:dimn), bc) -! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'bc matrix is obtained normally' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - deallocate (sc0) + if (rank == 0) print *, 'Check whether U*SU is diagonal END' + End if - if (rank == 0) print *, 'OK cdiag', dimn, dimm - Allocate (uc(dimn, dimm)) ! uc N*M - Allocate (wsnew(dimm)) ! wnew M - uc(:, :) = 0.0d+00 - wsnew(:) = 0.0d+00 - if (rank == 0) print *, 'before ccutoff' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call ccutoff(sc, ws, dimn, dimm, smat_lin_dep_threshold, uc, wsnew) + Allocate (bc(dimn, dimn)) ! bc N*N + bc = 0.0d+00 + if (rank == 0) print *, 'before bEmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call bEmat_complex(dimn, sc0, indt(1:dimn), bc) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'OK ccutoff' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - deallocate (ws) - deallocate (sc) - if (rank == 0) print *, 'before ulambda_s_half' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call ulambda_s_half(uc, wsnew, dimn, dimm) ! uc N*M matrix rewritten as uramda^(-1/2) + if (rank == 0) print *, 'bc matrix is obtained normally' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + deallocate (sc0) + + if (rank == 0) print *, 'OK cdiag', dimn, dimm + Allocate (uc(dimn, dimm)) ! uc N*M + Allocate (wsnew(dimm)) ! wnew M + uc(:, :) = 0.0d+00 + wsnew(:) = 0.0d+00 + if (rank == 0) print *, 'before ccutoff' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call ccutoff(sc, ws, dimn, dimm, smat_lin_dep_threshold, uc, wsnew) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - deallocate (wsnew) - - if (rank == 0) print *, 'ucrams half OK' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (bc0(dimm, dimn)) ! bc0 M*N - bc0 = 0.0d+00 - bc0 = MATMUL(TRANSPOSE(DCONJG(uc)), bc) - Allocate (bc1(dimm, dimm)) ! bc1 M*M - bc1 = 0.0d+00 - bc1 = MATMUL(bc0, uc) - - If (debug) then - - if (rank == 0) then - print *, 'Check whether bc1 is hermite or not' - Do i = 1, dimm - Do j = i, dimm - if (ABS(bc1(i, j) - DCONJG(bc1(j, i))) > 1.0d-6) then + if (rank == 0) print *, 'OK ccutoff' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + deallocate (ws) + deallocate (sc) + if (rank == 0) print *, 'before ulambda_s_half' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call ulambda_s_half(uc, wsnew, dimn, dimm) ! uc N*M matrix rewritten as uramda^(-1/2) +! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + deallocate (wsnew) + + if (rank == 0) print *, 'ucrams half OK' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Allocate (bc0(dimm, dimn)) ! bc0 M*N + bc0 = 0.0d+00 + bc0 = MATMUL(TRANSPOSE(DCONJG(uc)), bc) + Allocate (bc1(dimm, dimm)) ! bc1 M*M + bc1 = 0.0d+00 + bc1 = MATMUL(bc0, uc) + + If (debug) then + + if (rank == 0) then + print *, 'Check whether bc1 is hermite or not' + Do i = 1, dimm + Do j = i, dimm + if (ABS(bc1(i, j) - DCONJG(bc1(j, i))) > 1.0d-6) then print '(2I4,2E15.7)', i, j, bc1(i, j) - bc1(j, i) End if End do @@ -258,12 +258,12 @@ SUBROUTINE solve_E_subspace_complex () Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) datetmp1 = datetmp0 tsectmp1 = tsectmp0 - If (debug) then - if (rank == 0) print *, 'Check whether bc is really diagonalized or not' - Call checkdgc(dimm, bc0, bc1, wb) + If (debug) then + if (rank == 0) print *, 'Check whether bc is really diagonalized or not' + Call checkdgc(dimm, bc0, bc1, wb) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'Check whether bc is really diagonalized or not END' - End if + if (rank == 0) print *, 'Check whether bc is really diagonalized or not END' + End if deallocate (bc0) @@ -343,7 +343,7 @@ end subroutine solve_E_subspace_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE sEmat_complex (dimn, indt, sc) ! Assume C1 molecule, overlap matrix S in space E + SUBROUTINE sEmat_complex(dimn, indt, sc) ! Assume C1 molecule, overlap matrix S in space E ! S(u,t) = d(ut) - <0|Etu|0> ! @@ -397,7 +397,7 @@ End subroutine sEmat_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE bEmat_complex (dimn, sc, indt, bc) ! Assume C1 molecule, overlap matrix B in space E + SUBROUTINE bEmat_complex(dimn, sc, indt, bc) ! Assume C1 molecule, overlap matrix B in space E ! ! ! S(u,t) = d(ut) - <0|Etu|0> @@ -469,7 +469,7 @@ End subroutine bEmat_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE vEmat_complex (naij, iaij, v) + SUBROUTINE vEmat_complex(naij, iaij, v) ! ! V(t,ija) =[SIGUMA_p:active <0|Ept|0>{(ai|pj) - (aj|pi)}] + (aj|ti) - (ai|tj) ! @@ -551,31 +551,31 @@ end subroutine vEmat_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE solve_E_subspace_real () + SUBROUTINE solve_E_subspace_real() ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - use module_global_variables - use module_index_utils, only: convert_active_to_global_idx, convert_secondary_to_global_idx + use module_global_variables + use module_index_utils, only: convert_active_to_global_idx, convert_secondary_to_global_idx - Implicit NONE + Implicit NONE #ifdef HAVE_MPI - include 'mpif.h' + include 'mpif.h' #endif - integer :: dimn, dimm, dammy - real(8), allocatable :: wsnew(:), ws(:), wb(:) - real(8) :: e2(2*nsymrpa), alpha, e - real(8), allocatable :: sc(:, :), uc(:, :), sc0(:, :) - real(8), allocatable :: bc(:, :) - real(8), allocatable :: bc0(:, :), bc1(:, :), v(:, :), vc(:), vc1(:) - integer :: j, i, syma, symb, isym, indt(1:nact) - integer :: ia, it, ij, ii, ja, jt, jj, ji - integer :: i0 - integer, allocatable :: ia0(:), ii0(:), ij0(:), iaij(:, :, :) - integer :: naij - integer :: datetmp0, datetmp1 - real(8) :: tsectmp0, tsectmp1 + integer :: dimn, dimm, dammy + real(8), allocatable :: wsnew(:), ws(:), wb(:) + real(8) :: e2(2*nsymrpa), alpha, e + real(8), allocatable :: sc(:, :), uc(:, :), sc0(:, :) + real(8), allocatable :: bc(:, :) + real(8), allocatable :: bc0(:, :), bc1(:, :), v(:, :), vc(:), vc1(:) + integer :: j, i, syma, symb, isym, indt(1:nact) + integer :: ia, it, ij, ii, ja, jt, jj, ji + integer :: i0 + integer, allocatable :: ia0(:), ii0(:), ij0(:), iaij(:, :, :) + integer :: naij + integer :: datetmp0, datetmp1 + real(8) :: tsectmp0, tsectmp1 ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= @@ -606,158 +606,157 @@ SUBROUTINE solve_E_subspace_real () ! ! E2 = SIGUMA_iab, dimm |V1(t,ija)|^2|/{(alpha(ija) + wb(t)} ! - e2 = 0.0d+00 - e2e = 0.0d+00 - dimn = 0 - syma = 0 - indt = 0 - datetmp1 = date0; datetmp0 = date0 - Call timing(date0, tsec0, datetmp0, tsectmp0) - tsectmp1 = tsectmp0 - if (rank == 0) then - print *, ' ENTER solv E part' - print *, ' nsymrpa', nsymrpa - end if + e2 = 0.0d+00 + e2e = 0.0d+00 + dimn = 0 + syma = 0 + indt = 0 + datetmp1 = date0; datetmp0 = date0 + Call timing(date0, tsec0, datetmp0, tsectmp0) + tsectmp1 = tsectmp0 + if (rank == 0) then + print *, ' ENTER solv E part' + print *, ' nsymrpa', nsymrpa + end if ! (ninact*(ninact-1))/2 means the number of (ii,ij) pairs (ii>ij) - i0 = nsec*(ninact*(ninact - 1))/2 - naij = i0 - Allocate (iaij(nsec, ninact, ninact)) - iaij = 0 - Allocate (ia0(naij)) - Allocate (ii0(naij)) - Allocate (ij0(naij)) - - i0 = 0 - Do ii = 1, ninact - Do ij = 1, ii - 1 ! i > j - Do ia = 1, nsec - i0 = i0 + 1 - iaij(ia, ii, ij) = i0 - iaij(ia, ij, ii) = i0 - ia0(i0) = convert_secondary_to_global_idx(ia) ! secondary - ii0(i0) = ii ! inactive - ij0(i0) = ij ! inactive - End do + i0 = nsec*(ninact*(ninact - 1))/2 + naij = i0 + Allocate (iaij(nsec, ninact, ninact)) + iaij = 0 + Allocate (ia0(naij)) + Allocate (ii0(naij)) + Allocate (ij0(naij)) + + i0 = 0 + Do ii = 1, ninact + Do ij = 1, ii - 1 ! i > j + Do ia = 1, nsec + i0 = i0 + 1 + iaij(ia, ii, ij) = i0 + iaij(ia, ij, ii) = i0 + ia0(i0) = convert_secondary_to_global_idx(ia) ! secondary + ii0(i0) = ii ! inactive + ij0(i0) = ij ! inactive End do End do + End do - Allocate (v(naij, nact)) - v = 0.0d+00 - if (rank == 0) print *, 'end before v matrices' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call vEmat_real (naij, iaij, v) - if (rank == 0) print *, 'come' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 + Allocate (v(naij, nact)) + v = 0.0d+00 + if (rank == 0) print *, 'end before v matrices' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call vEmat_real(naij, iaij, v) + if (rank == 0) print *, 'come' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 - Do isym = 1, nsymrpa + Do isym = 1, nsymrpa - dimn = 0 - Do it = 1, nact - jt = convert_active_to_global_idx(it) - if (irpamo(jt) == isym) then - dimn = dimn + 1 - indt(dimn) = it - End if - End do + dimn = 0 + Do it = 1, nact + jt = convert_active_to_global_idx(it) + if (irpamo(jt) == isym) then + dimn = dimn + 1 + indt(dimn) = it + End if + End do - if (rank == 0) print *, 'isym, dimn', isym, dimn - If (dimn == 0) cycle ! Go to the next isym + if (rank == 0) print *, 'isym, dimn', isym, dimn + If (dimn == 0) cycle ! Go to the next isym - Allocate (sc(dimn, dimn)) - sc = 0.0d+00 ! sc N*N - if (rank == 0) print *, 'before sEmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call sEmat_real (dimn, indt(1:dimn), sc) + Allocate (sc(dimn, dimn)) + sc = 0.0d+00 ! sc N*N + if (rank == 0) print *, 'before sEmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call sEmat_real(dimn, indt(1:dimn), sc) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'sc matrix is obtained normally' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (ws(dimn)) - Allocate (sc0(dimn, dimn)) - sc0 = sc - if (rank == 0) print *, 'before cdiag' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call rdiag(sc, dimn, dimm, ws, smat_lin_dep_threshold) -! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'after s cdiag, new dimension is', dimm - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - If (dimm == 0) then - deallocate (sc0) - deallocate (sc) - deallocate (ws) - cycle ! Go to the next isym - End if - - - Allocate (bc(dimn, dimn)) ! bc N*N - bc = 0.0d+00 - if (rank == 0) print *, 'before bEmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call bEmat_real (dimn, sc0, indt(1:dimn), bc) + if (rank == 0) print *, 'sc matrix is obtained normally' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Allocate (ws(dimn)) + Allocate (sc0(dimn, dimn)) + sc0 = sc + if (rank == 0) print *, 'before cdiag' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call rdiag(sc, dimn, dimm, ws, smat_lin_dep_threshold) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'bc matrix is obtained normally' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 + if (rank == 0) print *, 'after s cdiag, new dimension is', dimm + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + If (dimm == 0) then deallocate (sc0) + deallocate (sc) + deallocate (ws) + cycle ! Go to the next isym + End if - if (rank == 0) print *, 'OK cdiag', dimn, dimm - Allocate (uc(dimn, dimm)) ! uc N*M - Allocate (wsnew(dimm)) ! wnew M - uc(:, :) = 0.0d+00 - wsnew(:) = 0.0d+00 - if (rank == 0) print *, 'before ccutoff' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call rcutoff(sc, ws, dimn, dimm, smat_lin_dep_threshold, uc, wsnew) + Allocate (bc(dimn, dimn)) ! bc N*N + bc = 0.0d+00 + if (rank == 0) print *, 'before bEmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call bEmat_real(dimn, sc0, indt(1:dimn), bc) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'OK ccutoff' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - deallocate (ws) - deallocate (sc) - if (rank == 0) print *, 'before ulambda_s_half' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call ulambda_s_half(uc, wsnew, dimn, dimm) ! uc N*M matrix rewritten as uramda^(-1/2) + if (rank == 0) print *, 'bc matrix is obtained normally' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + deallocate (sc0) + + if (rank == 0) print *, 'OK cdiag', dimn, dimm + Allocate (uc(dimn, dimm)) ! uc N*M + Allocate (wsnew(dimm)) ! wnew M + uc(:, :) = 0.0d+00 + wsnew(:) = 0.0d+00 + if (rank == 0) print *, 'before ccutoff' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call rcutoff(sc, ws, dimn, dimm, smat_lin_dep_threshold, uc, wsnew) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - deallocate (wsnew) - - if (rank == 0) print *, 'ucrams half OK' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (bc0(dimm, dimn)) ! bc0 M*N - bc0 = 0.0d+00 - bc0 = MATMUL(TRANSPOSE(uc), bc) - Allocate (bc1(dimm, dimm)) ! bc1 M*M - bc1 = 0.0d+00 - bc1 = MATMUL(bc0, uc) - - If (debug) then - - if (rank == 0) then - print *, 'Check whether bc1 is hermite or not' - Do i = 1, dimm - Do j = i, dimm - if (ABS(bc1(i, j) - bc1(j, i)) > 1.0d-6) then + if (rank == 0) print *, 'OK ccutoff' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + deallocate (ws) + deallocate (sc) + if (rank == 0) print *, 'before ulambda_s_half' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call ulambda_s_half(uc, wsnew, dimn, dimm) ! uc N*M matrix rewritten as uramda^(-1/2) +! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + deallocate (wsnew) + + if (rank == 0) print *, 'ucrams half OK' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Allocate (bc0(dimm, dimn)) ! bc0 M*N + bc0 = 0.0d+00 + bc0 = MATMUL(TRANSPOSE(uc), bc) + Allocate (bc1(dimm, dimm)) ! bc1 M*M + bc1 = 0.0d+00 + bc1 = MATMUL(bc0, uc) + + If (debug) then + + if (rank == 0) then + print *, 'Check whether bc1 is hermite or not' + Do i = 1, dimm + Do j = i, dimm + if (ABS(bc1(i, j) - bc1(j, i)) > 1.0d-6) then print '(2I4,2E15.7)', i, j, bc1(i, j) - bc1(j, i) End if End do @@ -864,7 +863,7 @@ end subroutine solve_E_subspace_real ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE sEmat_real (dimn, indt, sc) ! Assume C1 molecule, overlap matrix S in space E + SUBROUTINE sEmat_real(dimn, indt, sc) ! Assume C1 molecule, overlap matrix S in space E ! S(u,t) = d(ut) - <0|Etu|0> ! @@ -918,7 +917,7 @@ End subroutine sEmat_real ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE bEmat_real (dimn, sc, indt, bc) ! Assume C1 molecule, overlap matrix B in space E + SUBROUTINE bEmat_real(dimn, sc, indt, bc) ! Assume C1 molecule, overlap matrix B in space E ! ! ! S(u,t) = d(ut) - <0|Etu|0> @@ -990,7 +989,7 @@ End subroutine bEmat_real ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE vEmat_real (naij, iaij, v) + SUBROUTINE vEmat_real(naij, iaij, v) ! ! V(t,ija) =[SIGUMA_p:active <0|Ept|0>{(ai|pj) - (aj|pi)}] + (aj|ti) - (ai|tj) ! diff --git a/src/solve_F_subspace.f90 b/src/solve_F_subspace.f90 index fabd87e9..2e8dfa6e 100644 --- a/src/solve_F_subspace.f90 +++ b/src/solve_F_subspace.f90 @@ -17,31 +17,31 @@ SUBROUTINE solve_F_subspace(e0, e2f) ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE solve_F_subspace_complex () + SUBROUTINE solve_F_subspace_complex() ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - use module_global_variables - use module_index_utils, only: convert_active_to_global_idx, convert_secondary_to_global_idx + use module_global_variables + use module_index_utils, only: convert_active_to_global_idx, convert_secondary_to_global_idx - Implicit NONE + Implicit NONE #ifdef HAVE_MPI - include 'mpif.h' + include 'mpif.h' #endif - integer :: dimn, dimm, dammy - integer, allocatable :: indsym(:, :) - real(8), allocatable :: wsnew(:), ws(:), wb(:) - real(8) :: e2(2*nsymrpa), alpha, e - complex*16, allocatable :: sc(:, :), uc(:, :), sc0(:, :) - complex*16, allocatable :: bc(:, :) - complex*16, allocatable :: bc0(:, :), bc1(:, :), v(:, :, :), vc(:), vc1(:) - integer :: j, i, syma, isym, i0 - integer :: ia, it, ib, iu, ja, jt, jb, ju - integer, allocatable :: ia0(:), ib0(:), iab(:, :) - integer :: nab - integer :: datetmp0, datetmp1 - real(8) :: tsectmp0, tsectmp1 + integer :: dimn, dimm, dammy + integer, allocatable :: indsym(:, :) + real(8), allocatable :: wsnew(:), ws(:), wb(:) + real(8) :: e2(2*nsymrpa), alpha, e + complex*16, allocatable :: sc(:, :), uc(:, :), sc0(:, :) + complex*16, allocatable :: bc(:, :) + complex*16, allocatable :: bc0(:, :), bc1(:, :), v(:, :, :), vc(:), vc1(:) + integer :: j, i, syma, isym, i0 + integer :: ia, it, ib, iu, ja, jt, jb, ju + integer, allocatable :: ia0(:), ib0(:), iab(:, :) + integer :: nab + integer :: datetmp0, datetmp1 + real(8) :: tsectmp0, tsectmp1 ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= @@ -70,193 +70,193 @@ SUBROUTINE solve_F_subspace_complex () ! ! E2 = SIGUMA_iab,t:dimm |V1(t,ab)|^2|/{(alpha(ab) + wb(t)} ! - e2 = 0.0d+00 - e2f = 0.0d+00 - dimn = 0 - syma = 0 - if (rank == 0) print *, ' ENTER solv F part' - datetmp1 = date0; datetmp0 = date0 - Call timing(date0, tsec0, datetmp0, tsectmp0) - tsectmp1 = tsectmp0 - i0 = 0 - Do ia = 1, nsec - Do ib = 1, ia - 1 - i0 = i0 + 1 - End do + e2 = 0.0d+00 + e2f = 0.0d+00 + dimn = 0 + syma = 0 + if (rank == 0) print *, ' ENTER solv F part' + datetmp1 = date0; datetmp0 = date0 + Call timing(date0, tsec0, datetmp0, tsectmp0) + tsectmp1 = tsectmp0 + i0 = 0 + Do ia = 1, nsec + Do ib = 1, ia - 1 + i0 = i0 + 1 End do + End do - nab = i0 - Allocate (iab(nsec, nsec)) - iab = 0 - Allocate (ia0(nab)) - Allocate (ib0(nab)) + nab = i0 + Allocate (iab(nsec, nsec)) + iab = 0 + Allocate (ia0(nab)) + Allocate (ib0(nab)) - i0 = 0 - Do ia = 1, nsec - ja = convert_secondary_to_global_idx(ia) - Do ib = 1, ia - 1 - jb = convert_secondary_to_global_idx(ib) - i0 = i0 + 1 - iab(ia, ib) = i0 - iab(ib, ia) = i0 - ia0(i0) = convert_secondary_to_global_idx(ia) ! secondary - ib0(i0) = convert_secondary_to_global_idx(ib) ! secondary - End do + i0 = 0 + Do ia = 1, nsec + ja = convert_secondary_to_global_idx(ia) + Do ib = 1, ia - 1 + jb = convert_secondary_to_global_idx(ib) + i0 = i0 + 1 + iab(ia, ib) = i0 + iab(ib, ia) = i0 + ia0(i0) = convert_secondary_to_global_idx(ia) ! secondary + ib0(i0) = convert_secondary_to_global_idx(ib) ! secondary End do + End do - Allocate (v(nab, nact, nact)) - v = 0.0d+00 - if (rank == 0) print *, 'end before v matrices' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call vFmat_complex (nab, iab, v) - if (rank == 0) print *, 'end after vFmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Do isym = 1, nsymrpa + Allocate (v(nab, nact, nact)) + v = 0.0d+00 + if (rank == 0) print *, 'end before v matrices' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call vFmat_complex(nab, iab, v) + if (rank == 0) print *, 'end after vFmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Do isym = 1, nsymrpa - dimn = 0 - Do it = 1, nact - jt = convert_active_to_global_idx(it) - Do iu = 1, it - 1 - ju = convert_active_to_global_idx(iu) + dimn = 0 + Do it = 1, nact + jt = convert_active_to_global_idx(it) + Do iu = 1, it - 1 + ju = convert_active_to_global_idx(iu) ! EatEbu|0> - if (nsymrpa /= 1) syma = MULTB_D(irpamo(ju) - (-1)**(mod(irpamo(ju), 2)), irpamo(jt)) + if (nsymrpa /= 1) syma = MULTB_D(irpamo(ju) - (-1)**(mod(irpamo(ju), 2)), irpamo(jt)) - if (nsymrpa == 1 .or. (nsymrpa /= 1 .and. syma == isym)) then - dimn = dimn + 1 - End if - End do + if (nsymrpa == 1 .or. (nsymrpa /= 1 .and. syma == isym)) then + dimn = dimn + 1 + End if End do + End do - if (rank == 0) print *, 'isym, dimn', isym, dimn - If (dimn == 0) cycle ! Go to the next isym if dimn (dimention of matrix) is zero + if (rank == 0) print *, 'isym, dimn', isym, dimn + If (dimn == 0) cycle ! Go to the next isym if dimn (dimention of matrix) is zero - Allocate (indsym(2, dimn)) + Allocate (indsym(2, dimn)) - dimn = 0 - Do it = 1, nact - jt = convert_active_to_global_idx(it) - Do iu = 1, it - 1 - ju = convert_active_to_global_idx(iu) + dimn = 0 + Do it = 1, nact + jt = convert_active_to_global_idx(it) + Do iu = 1, it - 1 + ju = convert_active_to_global_idx(iu) ! EatEbu|0> - if (nsymrpa /= 1) syma = MULTB_D(irpamo(ju) - (-1)**(mod(irpamo(ju), 2)), irpamo(jt)) + if (nsymrpa /= 1) syma = MULTB_D(irpamo(ju) - (-1)**(mod(irpamo(ju), 2)), irpamo(jt)) - if (nsymrpa == 1 .or. (nsymrpa /= 1 .and. syma == isym)) then - dimn = dimn + 1 - indsym(1, dimn) = it - indsym(2, dimn) = iu - End if - End do + if (nsymrpa == 1 .or. (nsymrpa /= 1 .and. syma == isym)) then + dimn = dimn + 1 + indsym(1, dimn) = it + indsym(2, dimn) = iu + End if End do + End do - Allocate (sc(dimn, dimn)) - sc = 0.0d+00 ! sc N*N - if (rank == 0) print *, 'before sFmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call sFmat_complex (dimn, indsym, sc) + Allocate (sc(dimn, dimn)) + sc = 0.0d+00 ! sc N*N + if (rank == 0) print *, 'before sFmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call sFmat_complex(dimn, indsym, sc) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'sc matrix is obtained normally' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (ws(dimn)) - - Allocate (sc0(dimn, dimn)) - sc0 = sc - if (rank == 0) print *, 'before cdiag' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call cdiag(sc, dimn, dimm, ws, smat_lin_dep_threshold) + if (rank == 0) print *, 'sc matrix is obtained normally' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Allocate (ws(dimn)) + + Allocate (sc0(dimn, dimn)) + sc0 = sc + if (rank == 0) print *, 'before cdiag' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call cdiag(sc, dimn, dimm, ws, smat_lin_dep_threshold) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'after s cdiag, new dimension is', dimm - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - If (dimm == 0) then - deallocate (indsym) - deallocate (sc0) - deallocate (sc) - deallocate (ws) - cycle ! Go to the next isym if dimm (dimention of matrix) is zero - End if + if (rank == 0) print *, 'after s cdiag, new dimension is', dimm + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + If (dimm == 0) then + deallocate (indsym) + deallocate (sc0) + deallocate (sc) + deallocate (ws) + cycle ! Go to the next isym if dimm (dimention of matrix) is zero + End if - If (debug) then + If (debug) then - if (rank == 0) print *, 'Check whether U*SU is diagonal' - Call checkdgc(dimn, sc0, sc, ws) + if (rank == 0) print *, 'Check whether U*SU is diagonal' + Call checkdgc(dimn, sc0, sc, ws) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'Check whether U*SU is diagonal END' - End if + if (rank == 0) print *, 'Check whether U*SU is diagonal END' + End if - Allocate (bc(dimn, dimn)) ! bc N*N - bc = 0.0d+00 - if (rank == 0) print *, 'before bFmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call bFmat_complex (dimn, sc0, indsym, bc) + Allocate (bc(dimn, dimn)) ! bc N*N + bc = 0.0d+00 + if (rank == 0) print *, 'before bFmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call bFmat_complex(dimn, sc0, indsym, bc) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'bc matrix is obtained normally' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - deallocate (sc0) - - if (rank == 0) print *, 'OK cdiag', dimn, dimm - Allocate (uc(dimn, dimm)) ! uc N*M - Allocate (wsnew(dimm)) ! wnew M - uc(:, :) = 0.0d+00 - wsnew(:) = 0.0d+00 - if (rank == 0) print *, 'before ccutoff' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call ccutoff(sc, ws, dimn, dimm, smat_lin_dep_threshold, uc, wsnew) + if (rank == 0) print *, 'bc matrix is obtained normally' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + deallocate (sc0) + + if (rank == 0) print *, 'OK cdiag', dimn, dimm + Allocate (uc(dimn, dimm)) ! uc N*M + Allocate (wsnew(dimm)) ! wnew M + uc(:, :) = 0.0d+00 + wsnew(:) = 0.0d+00 + if (rank == 0) print *, 'before ccutoff' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call ccutoff(sc, ws, dimn, dimm, smat_lin_dep_threshold, uc, wsnew) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'OK ccutoff' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - deallocate (ws) - deallocate (sc) - if (rank == 0) print *, 'before ulambda_s_half' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call ulambda_s_half(uc, wsnew, dimn, dimm) ! uc N*M matrix rewritten as uramda^(-1/2) + if (rank == 0) print *, 'OK ccutoff' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + deallocate (ws) + deallocate (sc) + if (rank == 0) print *, 'before ulambda_s_half' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call ulambda_s_half(uc, wsnew, dimn, dimm) ! uc N*M matrix rewritten as uramda^(-1/2) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - deallocate (wsnew) - - if (rank == 0) print *, 'ucrams half OK' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (bc0(dimm, dimn)) ! bc0 M*N - bc0 = 0.0d+00 - bc0 = MATMUL(TRANSPOSE(DCONJG(uc)), bc) - Allocate (bc1(dimm, dimm)) ! bc1 M*M - bc1 = 0.0d+00 - bc1 = MATMUL(bc0, uc) - - If (debug) then - - if (rank == 0) then - print *, 'Check whether bc1 is hermite or not' - Do i = 1, dimm - Do j = i, dimm - if (ABS(bc1(i, j) - DCONJG(bc1(j, i))) > 1.0d-6) then + deallocate (wsnew) + + if (rank == 0) print *, 'ucrams half OK' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Allocate (bc0(dimm, dimn)) ! bc0 M*N + bc0 = 0.0d+00 + bc0 = MATMUL(TRANSPOSE(DCONJG(uc)), bc) + Allocate (bc1(dimm, dimm)) ! bc1 M*M + bc1 = 0.0d+00 + bc1 = MATMUL(bc0, uc) + + If (debug) then + + if (rank == 0) then + print *, 'Check whether bc1 is hermite or not' + Do i = 1, dimm + Do j = i, dimm + if (ABS(bc1(i, j) - DCONJG(bc1(j, i))) > 1.0d-6) then print '(2I4,2E15.7)', i, j, bc1(i, j) - bc1(j, i) End if End do @@ -283,13 +283,13 @@ SUBROUTINE solve_F_subspace_complex () Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) datetmp1 = datetmp0 tsectmp1 = tsectmp0 - If (debug) then + If (debug) then - if (rank == 0) print *, 'Check whether bc is really diagonalized or not' - Call checkdgc(dimm, bc0, bc1, wb) + if (rank == 0) print *, 'Check whether bc is really diagonalized or not' + Call checkdgc(dimm, bc0, bc1, wb) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'Check whether bc is really diagonalized or not END' - End if + if (rank == 0) print *, 'Check whether bc is really diagonalized or not END' + End if deallocate (bc0) @@ -362,7 +362,7 @@ end subroutine solve_F_subspace_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE sFmat_complex (dimn, indsym, sc) ! Assume C1 molecule, overlap matrix S in space F + SUBROUTINE sFmat_complex(dimn, indsym, sc) ! Assume C1 molecule, overlap matrix S in space F ! S(vx, tu) = <0|EvtExu|0> - d(xt)<0|Evu|0> ! @@ -418,7 +418,7 @@ End subroutine sFmat_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE bFmat_complex (dimn, sc, indsym, bc) ! Assume C1 molecule, overlap matrix B in space F + SUBROUTINE bFmat_complex(dimn, sc, indsym, bc) ! Assume C1 molecule, overlap matrix B in space F ! ! B(vx, tu) = Siguma_w [eps(w){ <0|EvtExuEww|0> - d(xt)<0|EvuEww|0>}] + S(u,t){-eps(u)-eps(t)} ! @@ -499,7 +499,7 @@ End subroutine bFmat_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE vFmat_complex (nab, iab, v) + SUBROUTINE vFmat_complex(nab, iab, v) ! ! V(tu, ab) = SIGUMA_p,q:active <0|EtpEuq|0>(ap|bq) - SIGUMA_p:active <0|Etp|0>(au|bp) ! @@ -614,31 +614,31 @@ end subroutine vFmat_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE solve_F_subspace_real () + SUBROUTINE solve_F_subspace_real() ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - use module_global_variables - use module_index_utils, only: convert_active_to_global_idx, convert_secondary_to_global_idx + use module_global_variables + use module_index_utils, only: convert_active_to_global_idx, convert_secondary_to_global_idx - Implicit NONE + Implicit NONE #ifdef HAVE_MPI - include 'mpif.h' + include 'mpif.h' #endif - integer :: dimn, dimm, dammy - integer, allocatable :: indsym(:, :) - real(8), allocatable :: wsnew(:), ws(:), wb(:) - real(8) :: e2(2*nsymrpa), alpha, e - real(8), allocatable :: sc(:, :), uc(:, :), sc0(:, :) - real(8), allocatable :: bc(:, :) - real(8), allocatable :: bc0(:, :), bc1(:, :), v(:, :, :), vc(:), vc1(:) - integer :: j, i, syma, isym, i0 - integer :: ia, it, ib, iu, ja, jt, jb, ju - integer, allocatable :: ia0(:), ib0(:), iab(:, :) - integer :: nab - integer :: datetmp0, datetmp1 - real(8) :: tsectmp0, tsectmp1 + integer :: dimn, dimm, dammy + integer, allocatable :: indsym(:, :) + real(8), allocatable :: wsnew(:), ws(:), wb(:) + real(8) :: e2(2*nsymrpa), alpha, e + real(8), allocatable :: sc(:, :), uc(:, :), sc0(:, :) + real(8), allocatable :: bc(:, :) + real(8), allocatable :: bc0(:, :), bc1(:, :), v(:, :, :), vc(:), vc1(:) + integer :: j, i, syma, isym, i0 + integer :: ia, it, ib, iu, ja, jt, jb, ju + integer, allocatable :: ia0(:), ib0(:), iab(:, :) + integer :: nab + integer :: datetmp0, datetmp1 + real(8) :: tsectmp0, tsectmp1 ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= @@ -667,186 +667,185 @@ SUBROUTINE solve_F_subspace_real () ! ! E2 = SIGUMA_iab,t:dimm |V1(t,ab)|^2|/{(alpha(ab) + wb(t)} ! - e2 = 0.0d+00 - e2f = 0.0d+00 - dimn = 0 - syma = 0 - if (rank == 0) print *, ' ENTER solv F part' - datetmp1 = date0; datetmp0 = date0 - Call timing(date0, tsec0, datetmp0, tsectmp0) - tsectmp1 = tsectmp0 - i0 = 0 - Do ia = 1, nsec - Do ib = 1, ia - 1 - i0 = i0 + 1 - End do + e2 = 0.0d+00 + e2f = 0.0d+00 + dimn = 0 + syma = 0 + if (rank == 0) print *, ' ENTER solv F part' + datetmp1 = date0; datetmp0 = date0 + Call timing(date0, tsec0, datetmp0, tsectmp0) + tsectmp1 = tsectmp0 + i0 = 0 + Do ia = 1, nsec + Do ib = 1, ia - 1 + i0 = i0 + 1 End do + End do - nab = i0 - Allocate (iab(nsec, nsec)) - iab = 0 - Allocate (ia0(nab)) - Allocate (ib0(nab)) + nab = i0 + Allocate (iab(nsec, nsec)) + iab = 0 + Allocate (ia0(nab)) + Allocate (ib0(nab)) - i0 = 0 - Do ia = 1, nsec - ja = convert_secondary_to_global_idx(ia) - Do ib = 1, ia - 1 - jb = convert_secondary_to_global_idx(ib) - i0 = i0 + 1 - iab(ia, ib) = i0 - iab(ib, ia) = i0 - ia0(i0) = convert_secondary_to_global_idx(ia) ! secondary - ib0(i0) = convert_secondary_to_global_idx(ib) ! secondary - End do + i0 = 0 + Do ia = 1, nsec + ja = convert_secondary_to_global_idx(ia) + Do ib = 1, ia - 1 + jb = convert_secondary_to_global_idx(ib) + i0 = i0 + 1 + iab(ia, ib) = i0 + iab(ib, ia) = i0 + ia0(i0) = convert_secondary_to_global_idx(ia) ! secondary + ib0(i0) = convert_secondary_to_global_idx(ib) ! secondary End do + End do - Allocate (v(nab, nact, nact)) - v = 0.0d+00 - if (rank == 0) print *, 'end before v matrices' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call vFmat_real (nab, iab, v) - if (rank == 0) print *, 'end after vFmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Do isym = 1, nsymrpa + Allocate (v(nab, nact, nact)) + v = 0.0d+00 + if (rank == 0) print *, 'end before v matrices' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call vFmat_real(nab, iab, v) + if (rank == 0) print *, 'end after vFmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Do isym = 1, nsymrpa - dimn = 0 - Do it = 1, nact - jt = convert_active_to_global_idx(it) - Do iu = 1, it - 1 - ju = convert_active_to_global_idx(iu) + dimn = 0 + Do it = 1, nact + jt = convert_active_to_global_idx(it) + Do iu = 1, it - 1 + ju = convert_active_to_global_idx(iu) ! EatEbu|0> - if (nsymrpa /= 1) syma = MULTB_D(irpamo(ju) - (-1)**(mod(irpamo(ju), 2)), irpamo(jt)) + if (nsymrpa /= 1) syma = MULTB_D(irpamo(ju) - (-1)**(mod(irpamo(ju), 2)), irpamo(jt)) - if (nsymrpa == 1 .or. (nsymrpa /= 1 .and. syma == isym)) then - dimn = dimn + 1 - End if - End do + if (nsymrpa == 1 .or. (nsymrpa /= 1 .and. syma == isym)) then + dimn = dimn + 1 + End if End do + End do - if (rank == 0) print *, 'isym, dimn', isym, dimn - If (dimn == 0) cycle ! Go to the next isym if dimn (dimention of matrix) is zero + if (rank == 0) print *, 'isym, dimn', isym, dimn + If (dimn == 0) cycle ! Go to the next isym if dimn (dimention of matrix) is zero - Allocate (indsym(2, dimn)) + Allocate (indsym(2, dimn)) - dimn = 0 - Do it = 1, nact - jt = convert_active_to_global_idx(it) - Do iu = 1, it - 1 - ju = convert_active_to_global_idx(iu) + dimn = 0 + Do it = 1, nact + jt = convert_active_to_global_idx(it) + Do iu = 1, it - 1 + ju = convert_active_to_global_idx(iu) ! EatEbu|0> - if (nsymrpa /= 1) syma = MULTB_D(irpamo(ju) - (-1)**(mod(irpamo(ju), 2)), irpamo(jt)) + if (nsymrpa /= 1) syma = MULTB_D(irpamo(ju) - (-1)**(mod(irpamo(ju), 2)), irpamo(jt)) - if (nsymrpa == 1 .or. (nsymrpa /= 1 .and. syma == isym)) then - dimn = dimn + 1 - indsym(1, dimn) = it - indsym(2, dimn) = iu - End if - End do + if (nsymrpa == 1 .or. (nsymrpa /= 1 .and. syma == isym)) then + dimn = dimn + 1 + indsym(1, dimn) = it + indsym(2, dimn) = iu + End if End do + End do - Allocate (sc(dimn, dimn)) - sc = 0.0d+00 ! sc N*N - if (rank == 0) print *, 'before sFmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call sFmat_real (dimn, indsym, sc) + Allocate (sc(dimn, dimn)) + sc = 0.0d+00 ! sc N*N + if (rank == 0) print *, 'before sFmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call sFmat_real(dimn, indsym, sc) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'sc matrix is obtained normally' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (ws(dimn)) - - Allocate (sc0(dimn, dimn)) - sc0 = sc - if (rank == 0) print *, 'before cdiag' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call rdiag(sc, dimn, dimm, ws, smat_lin_dep_threshold) -! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'after s cdiag, new dimension is', dimm - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - If (dimm == 0) then - deallocate (indsym) - deallocate (sc0) - deallocate (sc) - deallocate (ws) - cycle ! Go to the next isym if dimm (dimention of matrix) is zero - End if - + if (rank == 0) print *, 'sc matrix is obtained normally' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Allocate (ws(dimn)) - Allocate (bc(dimn, dimn)) ! bc N*N - bc = 0.0d+00 - if (rank == 0) print *, 'before bFmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call bFmat_real (dimn, sc0, indsym, bc) + Allocate (sc0(dimn, dimn)) + sc0 = sc + if (rank == 0) print *, 'before cdiag' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call rdiag(sc, dimn, dimm, ws, smat_lin_dep_threshold) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - if (rank == 0) print *, 'bc matrix is obtained normally' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 + if (rank == 0) print *, 'after s cdiag, new dimension is', dimm + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + If (dimm == 0) then + deallocate (indsym) deallocate (sc0) + deallocate (sc) + deallocate (ws) + cycle ! Go to the next isym if dimm (dimention of matrix) is zero + End if - if (rank == 0) print *, 'OK cdiag', dimn, dimm - Allocate (uc(dimn, dimm)) ! uc N*M - Allocate (wsnew(dimm)) ! wnew M - uc(:, :) = 0.0d+00 - wsnew(:) = 0.0d+00 - if (rank == 0) print *, 'before ccutoff' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call rcutoff(sc, ws, dimn, dimm, smat_lin_dep_threshold, uc, wsnew) + Allocate (bc(dimn, dimn)) ! bc N*N + bc = 0.0d+00 + if (rank == 0) print *, 'before bFmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call bFmat_real(dimn, sc0, indsym, bc) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'OK ccutoff' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - deallocate (ws) - deallocate (sc) - if (rank == 0) print *, 'before ulambda_s_half' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call ulambda_s_half(uc, wsnew, dimn, dimm) ! uc N*M matrix rewritten as uramda^(-1/2) + + if (rank == 0) print *, 'bc matrix is obtained normally' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + deallocate (sc0) + + if (rank == 0) print *, 'OK cdiag', dimn, dimm + Allocate (uc(dimn, dimm)) ! uc N*M + Allocate (wsnew(dimm)) ! wnew M + uc(:, :) = 0.0d+00 + wsnew(:) = 0.0d+00 + if (rank == 0) print *, 'before ccutoff' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call rcutoff(sc, ws, dimn, dimm, smat_lin_dep_threshold, uc, wsnew) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - deallocate (wsnew) - - if (rank == 0) print *, 'ucrams half OK' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (bc0(dimm, dimn)) ! bc0 M*N - bc0 = 0.0d+00 - bc0 = MATMUL(TRANSPOSE(uc), bc) - Allocate (bc1(dimm, dimm)) ! bc1 M*M - bc1 = 0.0d+00 - bc1 = MATMUL(bc0, uc) - - If (debug) then - - if (rank == 0) then - print *, 'Check whether bc1 is hermite or not' - Do i = 1, dimm - Do j = i, dimm - if (ABS(bc1(i, j) - bc1(j, i)) > 1.0d-6) then + if (rank == 0) print *, 'OK ccutoff' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + deallocate (ws) + deallocate (sc) + if (rank == 0) print *, 'before ulambda_s_half' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call ulambda_s_half(uc, wsnew, dimn, dimm) ! uc N*M matrix rewritten as uramda^(-1/2) +! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + deallocate (wsnew) + + if (rank == 0) print *, 'ucrams half OK' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Allocate (bc0(dimm, dimn)) ! bc0 M*N + bc0 = 0.0d+00 + bc0 = MATMUL(TRANSPOSE(uc), bc) + Allocate (bc1(dimm, dimm)) ! bc1 M*M + bc1 = 0.0d+00 + bc1 = MATMUL(bc0, uc) + + If (debug) then + + if (rank == 0) then + print *, 'Check whether bc1 is hermite or not' + Do i = 1, dimm + Do j = i, dimm + if (ABS(bc1(i, j) - bc1(j, i)) > 1.0d-6) then print '(2I4,2E15.7)', i, j, bc1(i, j) - bc1(j, i) End if End do @@ -945,7 +944,7 @@ end subroutine solve_F_subspace_real ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE sFmat_real (dimn, indsym, sc) ! Assume C1 molecule, overlap matrix S in space F + SUBROUTINE sFmat_real(dimn, indsym, sc) ! Assume C1 molecule, overlap matrix S in space F ! S(vx, tu) = <0|EvtExu|0> - d(xt)<0|Evu|0> ! @@ -1001,7 +1000,7 @@ End subroutine sFmat_real ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE bFmat_real (dimn, sc, indsym, bc) ! Assume C1 molecule, overlap matrix B in space F + SUBROUTINE bFmat_real(dimn, sc, indsym, bc) ! Assume C1 molecule, overlap matrix B in space F ! ! B(vx, tu) = Siguma_w [eps(w){ <0|EvtExuEww|0> - d(xt)<0|EvuEww|0>}] + S(u,t){-eps(u)-eps(t)} ! @@ -1082,7 +1081,7 @@ End subroutine bFmat_real ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE vFmat_real (nab, iab, v) + SUBROUTINE vFmat_real(nab, iab, v) ! ! V(tu, ab) = SIGUMA_p,q:active <0|EtpEuq|0>(ap|bq) - SIGUMA_p:active <0|Etp|0>(au|bp) ! @@ -1194,34 +1193,34 @@ SUBROUTINE vFmat_real (nab, iab, v) tsectmp1 = tsectmp0 end subroutine vFmat_real -subroutine create_multb_s_reverse(multb_s_reverse) + subroutine create_multb_s_reverse(multb_s_reverse) !======================================================================================================== ! This subroutine creates multb_s_reverse ! ! multb_s_reverse(i, j) returns the symmetry of MULTB_D(irpamo(ju) - (-1)**(mod(irpamo(ju), 2)), irpamo(jt)) !======================================================================================================== - use module_index_utils, only: convert_secondary_to_global_idx - implicit none - integer, intent(inout) :: multb_s_reverse(:, :) - integer :: ia, ib, ja, jb - integer :: isym, syma - - if (nsymrpa == 1) then - multb_s_reverse(:, :) = 1 - else - do ia = 1, nsec - ja = convert_secondary_to_global_idx(ia) - do ib = 1, ia - 1 - jb = convert_secondary_to_global_idx(ib) - syma = MULTB_D(irpamo(ja), irpamo(jb) - (-1)**(mod(irpamo(jb), 2))) - do isym = 1, nsymrpa - if (MULTB_S(syma, isym) == 1) then - multb_s_reverse(ia, ib) = isym - exit - end if + use module_index_utils, only: convert_secondary_to_global_idx + implicit none + integer, intent(inout) :: multb_s_reverse(:, :) + integer :: ia, ib, ja, jb + integer :: isym, syma + + if (nsymrpa == 1) then + multb_s_reverse(:, :) = 1 + else + do ia = 1, nsec + ja = convert_secondary_to_global_idx(ia) + do ib = 1, ia - 1 + jb = convert_secondary_to_global_idx(ib) + syma = MULTB_D(irpamo(ja), irpamo(jb) - (-1)**(mod(irpamo(jb), 2))) + do isym = 1, nsymrpa + if (MULTB_S(syma, isym) == 1) then + multb_s_reverse(ia, ib) = isym + exit + end if + end do end do end do - end do - end if -end subroutine create_multb_s_reverse + end if + end subroutine create_multb_s_reverse end subroutine solve_F_subspace diff --git a/src/solve_G_subspace.f90 b/src/solve_G_subspace.f90 index a41f821b..28c7ce5c 100644 --- a/src/solve_G_subspace.f90 +++ b/src/solve_G_subspace.f90 @@ -17,31 +17,31 @@ SUBROUTINE solve_G_subspace(e0, e2g) ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE solve_G_subspace_complex () + SUBROUTINE solve_G_subspace_complex() ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - use module_global_variables - use module_index_utils, only: convert_active_to_global_idx, convert_secondary_to_global_idx + use module_global_variables + use module_index_utils, only: convert_active_to_global_idx, convert_secondary_to_global_idx - Implicit NONE + Implicit NONE #ifdef HAVE_MPI - include 'mpif.h' + include 'mpif.h' #endif - integer :: dimn, dimm, dammy - real(8), allocatable :: wsnew(:), ws(:), wb(:) - real(8) :: e2(2*nsymrpa), alpha, e - complex*16, allocatable :: sc(:, :), uc(:, :), sc0(:, :) - complex*16, allocatable :: bc(:, :) - complex*16, allocatable :: bc0(:, :), bc1(:, :), v(:, :), vc(:), vc1(:) - integer :: j, i, i0, syma, symb, isym, indt(1:nact) - integer :: ia, it, ib, ii, ja, jt, jb, ji - integer, allocatable :: ia0(:), ib0(:), ii0(:), iabi(:, :, :) - integer :: nabi - integer :: datetmp0, datetmp1 - real(8) :: tsectmp0, tsectmp1 + integer :: dimn, dimm, dammy + real(8), allocatable :: wsnew(:), ws(:), wb(:) + real(8) :: e2(2*nsymrpa), alpha, e + complex*16, allocatable :: sc(:, :), uc(:, :), sc0(:, :) + complex*16, allocatable :: bc(:, :) + complex*16, allocatable :: bc0(:, :), bc1(:, :), v(:, :), vc(:), vc1(:) + integer :: j, i, i0, syma, symb, isym, indt(1:nact) + integer :: ia, it, ib, ii, ja, jt, jb, ji + integer, allocatable :: ia0(:), ib0(:), ii0(:), iabi(:, :, :) + integer :: nabi + integer :: datetmp0, datetmp1 + real(8) :: tsectmp0, tsectmp1 ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= @@ -71,182 +71,182 @@ SUBROUTINE solve_G_subspace_complex () ! ! E2 = SIGUMA_iab, dimm |V1(t,iab)|^2|/{(alpha(iab) + wb(t)} ! - if (rank == 0) then - print *, ' ENTER solv G part' - print *, ' nsymrpa', nsymrpa - end if - datetmp1 = date0; datetmp0 = date0 + if (rank == 0) then + print *, ' ENTER solv G part' + print *, ' nsymrpa', nsymrpa + end if + datetmp1 = date0; datetmp0 = date0 - Call timing(date0, tsec0, datetmp0, tsectmp0) - tsectmp1 = tsectmp0 + Call timing(date0, tsec0, datetmp0, tsectmp0) + tsectmp1 = tsectmp0 - e2 = 0.0d+00 - e2g = 0.0d+00 - dimn = 0 - indt = 0 - - i0 = 0 - Do ia = 1, nsec - ja = convert_secondary_to_global_idx(ia) - Do ib = 1, ia - 1 - jb = convert_secondary_to_global_idx(ib) - Do ii = 1, ninact - ji = ii - i0 = i0 + 1 - End do + e2 = 0.0d+00 + e2g = 0.0d+00 + dimn = 0 + indt = 0 + + i0 = 0 + Do ia = 1, nsec + ja = convert_secondary_to_global_idx(ia) + Do ib = 1, ia - 1 + jb = convert_secondary_to_global_idx(ib) + Do ii = 1, ninact + ji = ii + i0 = i0 + 1 End do End do + End do - nabi = i0 - Allocate (iabi(nsec, nsec, ninact)) - iabi = 0 - Allocate (ia0(nabi)) - Allocate (ib0(nabi)) - Allocate (ii0(nabi)) - - i0 = 0 - Do ia = 1, nsec - ja = convert_secondary_to_global_idx(ia) - Do ib = 1, ia - 1 - jb = convert_secondary_to_global_idx(ib) - Do ii = 1, ninact - ji = ii - i0 = i0 + 1 - iabi(ia, ib, ii) = i0 - iabi(ib, ia, ii) = i0 - ia0(i0) = convert_secondary_to_global_idx(ia) ! secondary - ib0(i0) = convert_secondary_to_global_idx(ib) ! secondary - ii0(i0) = ii - End do + nabi = i0 + Allocate (iabi(nsec, nsec, ninact)) + iabi = 0 + Allocate (ia0(nabi)) + Allocate (ib0(nabi)) + Allocate (ii0(nabi)) + + i0 = 0 + Do ia = 1, nsec + ja = convert_secondary_to_global_idx(ia) + Do ib = 1, ia - 1 + jb = convert_secondary_to_global_idx(ib) + Do ii = 1, ninact + ji = ii + i0 = i0 + 1 + iabi(ia, ib, ii) = i0 + iabi(ib, ia, ii) = i0 + ia0(i0) = convert_secondary_to_global_idx(ia) ! secondary + ib0(i0) = convert_secondary_to_global_idx(ib) ! secondary + ii0(i0) = ii End do End do + End do - Allocate (v(nabi, nact)) - v = 0.0d+00 - if (rank == 0) print *, 'end before v matrices' + Allocate (v(nabi, nact)) + v = 0.0d+00 + if (rank == 0) print *, 'end before v matrices' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call vGmat_complex(nabi, iabi, v) + if (rank == 0) print *, 'end after vGmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + + Do isym = 1, nsymrpa + + dimn = 0 + Do it = 1, nact + jt = convert_active_to_global_idx(it) + if (irpamo(jt) == isym) then + dimn = dimn + 1 + indt(dimn) = it + End if + End do + + if (rank == 0) print *, 'isym, dimn', isym, dimn + If (dimn == 0) cycle ! Go to the next isym + + Allocate (sc(dimn, dimn)) + sc = 0.0d+00 ! sc N*N + if (rank == 0) print *, 'before sGmat' Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) datetmp1 = datetmp0 tsectmp1 = tsectmp0 - Call vGmat_complex (nabi, iabi, v) - if (rank == 0) print *, 'end after vGmat' + Call sGmat_complex(dimn, indt(1:dimn), sc) +! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + if (rank == 0) print *, 'sG matrix is obtained normally' Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) datetmp1 = datetmp0 tsectmp1 = tsectmp0 - - Do isym = 1, nsymrpa - - dimn = 0 - Do it = 1, nact - jt = convert_active_to_global_idx(it) - if (irpamo(jt) == isym) then - dimn = dimn + 1 - indt(dimn) = it - End if - End do - - if (rank == 0) print *, 'isym, dimn', isym, dimn - If (dimn == 0) cycle ! Go to the next isym - - Allocate (sc(dimn, dimn)) - sc = 0.0d+00 ! sc N*N - if (rank == 0) print *, 'before sGmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call sGmat_complex (dimn, indt(1:dimn), sc) -! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'sG matrix is obtained normally' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (ws(dimn)) - Allocate (sc0(dimn, dimn)) - sc0 = sc - if (rank == 0) print *, 'before cdiag' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call cdiag(sc, dimn, dimm, ws, smat_lin_dep_threshold) + Allocate (ws(dimn)) + Allocate (sc0(dimn, dimn)) + sc0 = sc + if (rank == 0) print *, 'before cdiag' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call cdiag(sc, dimn, dimm, ws, smat_lin_dep_threshold) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'after s cdiag, new dimension is', dimm - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - If (dimm == 0) then - deallocate (sc0) - deallocate (sc) - deallocate (ws) - cycle ! Go to the next isym - End if + if (rank == 0) print *, 'after s cdiag, new dimension is', dimm + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + If (dimm == 0) then + deallocate (sc0) + deallocate (sc) + deallocate (ws) + cycle ! Go to the next isym + End if - If (debug) then + If (debug) then - if (rank == 0) print *, 'Check whether U*SU is diagonal' + if (rank == 0) print *, 'Check whether U*SU is diagonal' - Call checkdgc(dimn, sc0, sc, ws) + Call checkdgc(dimn, sc0, sc, ws) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'Check whether U*SU is diagonal END' + if (rank == 0) print *, 'Check whether U*SU is diagonal END' - End if + End if - Allocate (bc(dimn, dimn)) ! bc N*N - bc = 0.0d+00 - if (rank == 0) print *, 'before bGmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call bGmat_complex (dimn, sc0, indt(1:dimn), bc) + Allocate (bc(dimn, dimn)) ! bc N*N + bc = 0.0d+00 + if (rank == 0) print *, 'before bGmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call bGmat_complex(dimn, sc0, indt(1:dimn), bc) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'bC matrix is obtained normally' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - deallocate (sc0) - - if (rank == 0) print *, 'OK cdiag', dimn, dimm - Allocate (uc(dimn, dimm)) ! uc N*M - Allocate (wsnew(dimm)) ! wnew M - uc(:, :) = 0.0d+00 - wsnew(:) = 0.0d+00 - if (rank == 0) print *, 'before ccutoff' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call ccutoff(sc, ws, dimn, dimm, smat_lin_dep_threshold, uc, wsnew) + if (rank == 0) print *, 'bC matrix is obtained normally' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + deallocate (sc0) + + if (rank == 0) print *, 'OK cdiag', dimn, dimm + Allocate (uc(dimn, dimm)) ! uc N*M + Allocate (wsnew(dimm)) ! wnew M + uc(:, :) = 0.0d+00 + wsnew(:) = 0.0d+00 + if (rank == 0) print *, 'before ccutoff' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call ccutoff(sc, ws, dimn, dimm, smat_lin_dep_threshold, uc, wsnew) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'OK ccutoff' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - deallocate (ws) - deallocate (sc) - if (rank == 0) print *, 'before ulambda_s_half' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call ulambda_s_half(uc, wsnew, dimn, dimm) ! uc N*M matrix rewritten as uramda^(-1/2) + if (rank == 0) print *, 'OK ccutoff' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + deallocate (ws) + deallocate (sc) + if (rank == 0) print *, 'before ulambda_s_half' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call ulambda_s_half(uc, wsnew, dimn, dimm) ! uc N*M matrix rewritten as uramda^(-1/2) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - deallocate (wsnew) - - if (rank == 0) print *, 'ucrams half OK' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (bc0(dimm, dimn)) ! bc0 M*N - bc0 = 0.0d+00 - bc0 = MATMUL(TRANSPOSE(DCONJG(uc)), bc) - Allocate (bc1(dimm, dimm)) ! bc1 M*M - bc1 = 0.0d+00 - bc1 = MATMUL(bc0, uc) - - If (debug) then - - if (rank == 0) then - print *, 'Check whether bc1 is hermite or not' - Do i = 1, dimm - Do j = i, dimm - if (ABS(bc1(i, j) - DCONJG(bc1(j, i))) > 1.0d-6) then + deallocate (wsnew) + + if (rank == 0) print *, 'ucrams half OK' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Allocate (bc0(dimm, dimn)) ! bc0 M*N + bc0 = 0.0d+00 + bc0 = MATMUL(TRANSPOSE(DCONJG(uc)), bc) + Allocate (bc1(dimm, dimm)) ! bc1 M*M + bc1 = 0.0d+00 + bc1 = MATMUL(bc0, uc) + + If (debug) then + + if (rank == 0) then + print *, 'Check whether bc1 is hermite or not' + Do i = 1, dimm + Do j = i, dimm + if (ABS(bc1(i, j) - DCONJG(bc1(j, i))) > 1.0d-6) then print '(2I4,2E15.7)', i, j, bc1(i, j) - bc1(j, i) End if End do @@ -273,14 +273,14 @@ SUBROUTINE solve_G_subspace_complex () Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) datetmp1 = datetmp0 tsectmp1 = tsectmp0 - If (debug) then + If (debug) then - if (rank == 0) print *, 'Check whether bc is really diagonalized or not' - Call checkdgc(dimm, bc0, bc1, wb) + if (rank == 0) print *, 'Check whether bc is really diagonalized or not' + Call checkdgc(dimm, bc0, bc1, wb) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'Check whether bc is really diagonalized or not END' + if (rank == 0) print *, 'Check whether bc is really diagonalized or not END' - End if + End if deallocate (bc0) @@ -360,7 +360,7 @@ end subroutine solve_G_subspace_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE sGmat_complex (dimn, indt, sc) ! Assume C1 molecule, overlap matrix S in space C + SUBROUTINE sGmat_complex(dimn, indt, sc) ! Assume C1 molecule, overlap matrix S in space C ! S(u,t) = <0|Eut|0> ! @@ -406,7 +406,7 @@ End subroutine sGmat_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE bGmat_complex (dimn, sc, indt, bc) ! Assume C1 molecule, overlap matrix B in space C + SUBROUTINE bGmat_complex(dimn, sc, indt, bc) ! Assume C1 molecule, overlap matrix B in space C ! ! ! S(u,t) = <0|Eut|0> @@ -474,7 +474,7 @@ End subroutine bGmat_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE vGmat_complex (nabi, iabi, v) + SUBROUTINE vGmat_complex(nabi, iabi, v) ! ! V(t,iab) = [SIGUMA_p:active <0|Etp|0>{(ai|bp)-(ap|bi)}] ! @@ -546,31 +546,31 @@ end subroutine vGmat_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE solve_G_subspace_real () + SUBROUTINE solve_G_subspace_real() ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - use module_global_variables - use module_index_utils, only: convert_active_to_global_idx, convert_secondary_to_global_idx + use module_global_variables + use module_index_utils, only: convert_active_to_global_idx, convert_secondary_to_global_idx - Implicit NONE + Implicit NONE #ifdef HAVE_MPI - include 'mpif.h' + include 'mpif.h' #endif - integer :: dimn, dimm, dammy - real(8), allocatable :: wsnew(:), ws(:), wb(:) - real(8) :: e2(2*nsymrpa), alpha, e - real(8), allocatable :: sc(:, :), uc(:, :), sc0(:, :) - real(8), allocatable :: bc(:, :) - real(8), allocatable :: bc0(:, :), bc1(:, :), v(:, :), vc(:), vc1(:) - integer :: j, i, i0, syma, symb, isym, indt(1:nact) - integer :: ia, it, ib, ii, ja, jt, jb, ji - integer, allocatable :: ia0(:), ib0(:), ii0(:), iabi(:, :, :) - integer :: nabi - integer :: datetmp0, datetmp1 - real(8) :: tsectmp0, tsectmp1 + integer :: dimn, dimm, dammy + real(8), allocatable :: wsnew(:), ws(:), wb(:) + real(8) :: e2(2*nsymrpa), alpha, e + real(8), allocatable :: sc(:, :), uc(:, :), sc0(:, :) + real(8), allocatable :: bc(:, :) + real(8), allocatable :: bc0(:, :), bc1(:, :), v(:, :), vc(:), vc1(:) + integer :: j, i, i0, syma, symb, isym, indt(1:nact) + integer :: ia, it, ib, ii, ja, jt, jb, ji + integer, allocatable :: ia0(:), ib0(:), ii0(:), iabi(:, :, :) + integer :: nabi + integer :: datetmp0, datetmp1 + real(8) :: tsectmp0, tsectmp1 ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= @@ -600,173 +600,172 @@ SUBROUTINE solve_G_subspace_real () ! ! E2 = SIGUMA_iab, dimm |V1(t,iab)|^2|/{(alpha(iab) + wb(t)} ! - if (rank == 0) then - print *, ' ENTER solv G part' - print *, ' nsymrpa', nsymrpa - end if - datetmp1 = date0; datetmp0 = date0 + if (rank == 0) then + print *, ' ENTER solv G part' + print *, ' nsymrpa', nsymrpa + end if + datetmp1 = date0; datetmp0 = date0 - Call timing(date0, tsec0, datetmp0, tsectmp0) - tsectmp1 = tsectmp0 + Call timing(date0, tsec0, datetmp0, tsectmp0) + tsectmp1 = tsectmp0 - e2 = 0.0d+00 - e2g = 0.0d+00 - dimn = 0 - indt = 0 - - i0 = 0 - Do ia = 1, nsec - ja = convert_secondary_to_global_idx(ia) - Do ib = 1, ia - 1 - jb = convert_secondary_to_global_idx(ib) - Do ii = 1, ninact - ji = ii - i0 = i0 + 1 - End do + e2 = 0.0d+00 + e2g = 0.0d+00 + dimn = 0 + indt = 0 + + i0 = 0 + Do ia = 1, nsec + ja = convert_secondary_to_global_idx(ia) + Do ib = 1, ia - 1 + jb = convert_secondary_to_global_idx(ib) + Do ii = 1, ninact + ji = ii + i0 = i0 + 1 End do End do + End do - nabi = i0 - Allocate (iabi(nsec, nsec, ninact)) - iabi = 0 - Allocate (ia0(nabi)) - Allocate (ib0(nabi)) - Allocate (ii0(nabi)) - - i0 = 0 - Do ia = 1, nsec - ja = convert_secondary_to_global_idx(ia) - Do ib = 1, ia - 1 - jb = convert_secondary_to_global_idx(ib) - Do ii = 1, ninact - ji = ii - i0 = i0 + 1 - iabi(ia, ib, ii) = i0 - iabi(ib, ia, ii) = i0 - ia0(i0) = convert_secondary_to_global_idx(ia) ! secondary - ib0(i0) = convert_secondary_to_global_idx(ib) ! secondary - ii0(i0) = ii - End do + nabi = i0 + Allocate (iabi(nsec, nsec, ninact)) + iabi = 0 + Allocate (ia0(nabi)) + Allocate (ib0(nabi)) + Allocate (ii0(nabi)) + + i0 = 0 + Do ia = 1, nsec + ja = convert_secondary_to_global_idx(ia) + Do ib = 1, ia - 1 + jb = convert_secondary_to_global_idx(ib) + Do ii = 1, ninact + ji = ii + i0 = i0 + 1 + iabi(ia, ib, ii) = i0 + iabi(ib, ia, ii) = i0 + ia0(i0) = convert_secondary_to_global_idx(ia) ! secondary + ib0(i0) = convert_secondary_to_global_idx(ib) ! secondary + ii0(i0) = ii End do End do + End do - Allocate (v(nabi, nact)) - v = 0.0d+00 - if (rank == 0) print *, 'end before v matrices' + Allocate (v(nabi, nact)) + v = 0.0d+00 + if (rank == 0) print *, 'end before v matrices' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call vGmat_real(nabi, iabi, v) + if (rank == 0) print *, 'end after vGmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + + Do isym = 1, nsymrpa + + dimn = 0 + Do it = 1, nact + jt = convert_active_to_global_idx(it) + if (irpamo(jt) == isym) then + dimn = dimn + 1 + indt(dimn) = it + End if + End do + + if (rank == 0) print *, 'isym, dimn', isym, dimn + If (dimn == 0) cycle ! Go to the next isym + + Allocate (sc(dimn, dimn)) + sc = 0.0d+00 ! sc N*N + if (rank == 0) print *, 'before sGmat' Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) datetmp1 = datetmp0 tsectmp1 = tsectmp0 - Call vGmat_real (nabi, iabi, v) - if (rank == 0) print *, 'end after vGmat' + Call sGmat_real(dimn, indt(1:dimn), sc) +! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + if (rank == 0) print *, 'sG matrix is obtained normally' Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) datetmp1 = datetmp0 tsectmp1 = tsectmp0 - - Do isym = 1, nsymrpa - - dimn = 0 - Do it = 1, nact - jt = convert_active_to_global_idx(it) - if (irpamo(jt) == isym) then - dimn = dimn + 1 - indt(dimn) = it - End if - End do - - if (rank == 0) print *, 'isym, dimn', isym, dimn - If (dimn == 0) cycle ! Go to the next isym - - Allocate (sc(dimn, dimn)) - sc = 0.0d+00 ! sc N*N - if (rank == 0) print *, 'before sGmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call sGmat_real (dimn, indt(1:dimn), sc) -! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'sG matrix is obtained normally' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (ws(dimn)) - Allocate (sc0(dimn, dimn)) - sc0 = sc - if (rank == 0) print *, 'before cdiag' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call rdiag(sc, dimn, dimm, ws, smat_lin_dep_threshold) + Allocate (ws(dimn)) + Allocate (sc0(dimn, dimn)) + sc0 = sc + if (rank == 0) print *, 'before cdiag' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call rdiag(sc, dimn, dimm, ws, smat_lin_dep_threshold) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'after s cdiag, new dimension is', dimm - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - If (dimm == 0) then - deallocate (sc0) - deallocate (sc) - deallocate (ws) - cycle ! Go to the next isym - End if - + if (rank == 0) print *, 'after s cdiag, new dimension is', dimm + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + If (dimm == 0) then + deallocate (sc0) + deallocate (sc) + deallocate (ws) + cycle ! Go to the next isym + End if - Allocate (bc(dimn, dimn)) ! bc N*N - bc = 0.0d+00 - if (rank == 0) print *, 'before bGmat' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call bGmat_real (dimn, sc0, indt(1:dimn), bc) + Allocate (bc(dimn, dimn)) ! bc N*N + bc = 0.0d+00 + if (rank == 0) print *, 'before bGmat' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call bGmat_real(dimn, sc0, indt(1:dimn), bc) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'bC matrix is obtained normally' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - deallocate (sc0) - - if (rank == 0) print *, 'OK cdiag', dimn, dimm - Allocate (uc(dimn, dimm)) ! uc N*M - Allocate (wsnew(dimm)) ! wnew M - uc(:, :) = 0.0d+00 - wsnew(:) = 0.0d+00 - if (rank == 0) print *, 'before ccutoff' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call rcutoff(sc, ws, dimn, dimm, smat_lin_dep_threshold, uc, wsnew) + if (rank == 0) print *, 'bC matrix is obtained normally' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + deallocate (sc0) + + if (rank == 0) print *, 'OK cdiag', dimn, dimm + Allocate (uc(dimn, dimm)) ! uc N*M + Allocate (wsnew(dimm)) ! wnew M + uc(:, :) = 0.0d+00 + wsnew(:) = 0.0d+00 + if (rank == 0) print *, 'before ccutoff' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call rcutoff(sc, ws, dimn, dimm, smat_lin_dep_threshold, uc, wsnew) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - if (rank == 0) print *, 'OK ccutoff' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - deallocate (ws) - deallocate (sc) - if (rank == 0) print *, 'before ulambda_s_half' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Call ulambda_s_half(uc, wsnew, dimn, dimm) ! uc N*M matrix rewritten as uramda^(-1/2) + if (rank == 0) print *, 'OK ccutoff' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + deallocate (ws) + deallocate (sc) + if (rank == 0) print *, 'before ulambda_s_half' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Call ulambda_s_half(uc, wsnew, dimn, dimm) ! uc N*M matrix rewritten as uramda^(-1/2) ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - deallocate (wsnew) - - if (rank == 0) print *, 'ucrams half OK' - Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) - datetmp1 = datetmp0 - tsectmp1 = tsectmp0 - Allocate (bc0(dimm, dimn)) ! bc0 M*N - bc0 = 0.0d+00 - bc0 = MATMUL(TRANSPOSE(uc), bc) - Allocate (bc1(dimm, dimm)) ! bc1 M*M - bc1 = 0.0d+00 - bc1 = MATMUL(bc0, uc) - - If (debug) then - - if (rank == 0) then - print *, 'Check whether bc1 is hermite or not' - Do i = 1, dimm - Do j = i, dimm - if (ABS(bc1(i, j) - bc1(j, i)) > 1.0d-6) then + deallocate (wsnew) + + if (rank == 0) print *, 'ucrams half OK' + Call timing(datetmp1, tsectmp1, datetmp0, tsectmp0) + datetmp1 = datetmp0 + tsectmp1 = tsectmp0 + Allocate (bc0(dimm, dimn)) ! bc0 M*N + bc0 = 0.0d+00 + bc0 = MATMUL(TRANSPOSE(uc), bc) + Allocate (bc1(dimm, dimm)) ! bc1 M*M + bc1 = 0.0d+00 + bc1 = MATMUL(bc0, uc) + + If (debug) then + + if (rank == 0) then + print *, 'Check whether bc1 is hermite or not' + Do i = 1, dimm + Do j = i, dimm + if (ABS(bc1(i, j) - bc1(j, i)) > 1.0d-6) then print '(2I4,2E15.7)', i, j, bc1(i, j) - bc1(j, i) End if End do @@ -872,7 +871,7 @@ end subroutine solve_G_subspace_real ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE sGmat_real (dimn, indt, sc) ! Assume C1 molecule, overlap matrix S in space C + SUBROUTINE sGmat_real(dimn, indt, sc) ! Assume C1 molecule, overlap matrix S in space C ! S(u,t) = <0|Eut|0> ! @@ -918,7 +917,7 @@ End subroutine sGmat_real ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE bGmat_real (dimn, sc, indt, bc) ! Assume C1 molecule, overlap matrix B in space C + SUBROUTINE bGmat_real(dimn, sc, indt, bc) ! Assume C1 molecule, overlap matrix B in space C ! ! ! S(u,t) = <0|Eut|0> @@ -986,7 +985,7 @@ End subroutine bGmat_real ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE vGmat_real (nabi, iabi, v) + SUBROUTINE vGmat_real(nabi, iabi, v) ! ! V(t,iab) = [SIGUMA_p:active <0|Etp|0>{(ai|bp)-(ap|bi)}] ! diff --git a/src/solve_H_subspace.f90 b/src/solve_H_subspace.f90 index 7bc6f396..dba5f15b 100644 --- a/src/solve_H_subspace.f90 +++ b/src/solve_H_subspace.f90 @@ -16,26 +16,26 @@ SUBROUTINE solve_H_subspace(e0, e2h) ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE solve_H_subspace_complex () + SUBROUTINE solve_H_subspace_complex() ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - use module_file_manager, only: open_unformatted_file, check_iostat - use module_global_variables - use module_index_utils, only: convert_secondary_to_global_idx + use module_file_manager, only: open_unformatted_file, check_iostat + use module_global_variables + use module_index_utils, only: convert_secondary_to_global_idx #ifdef HAVE_MPI - use module_mpi + use module_mpi #endif - Implicit NONE + Implicit NONE - Integer :: ia, ib, ii, ij, syma, symb, i, j, k, l - Integer :: i0, j0, tab, nab, tij, nij, iostat, unit_int2 - Integer, allocatable :: ia0(:), ib0(:), ii0(:), ij0(:), iab(:, :), iij(:, :) - complex*16 :: cint2 - complex*16, allocatable :: v(:, :) - real(8) :: e - logical :: is_end_of_file + Integer :: ia, ib, ii, ij, syma, symb, i, j, k, l + Integer :: i0, j0, tab, nab, tij, nij, iostat, unit_int2 + Integer, allocatable :: ia0(:), ib0(:), ii0(:), ij0(:), iab(:, :), iij(:, :) + complex*16 :: cint2 + complex*16, allocatable :: v(:, :) + real(8) :: e + logical :: is_end_of_file ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= @@ -54,163 +54,163 @@ SUBROUTINE solve_H_subspace_complex () ! V(aibj) = (ai|bj) - (aj|bi) ! ! E2h = V(aibj)/e(a,b,i,j) - if (rank == 0) then - print *, ' ENTER solve H part' - print *, ' nsymrpa', nsymrpa - end if - e2h = 0.0d+00 - e = 0.0d+00 - - i0 = 0 - Do ia = global_sec_start, global_sec_end - Do ib = global_sec_start, ia - 1 - i0 = i0 + 1 - End do + if (rank == 0) then + print *, ' ENTER solve H part' + print *, ' nsymrpa', nsymrpa + end if + e2h = 0.0d+00 + e = 0.0d+00 + + i0 = 0 + Do ia = global_sec_start, global_sec_end + Do ib = global_sec_start, ia - 1 + i0 = i0 + 1 End do - - nab = i0 - - Allocate (iab(nsec, nsec)) - Allocate (ia0(nab)) - Allocate (ib0(nab)) - iab = 0 - - i0 = 0 - Do ia = 1, nsec - Do ib = 1, ia - 1 - i0 = i0 + 1 - iab(ia, ib) = i0 - iab(ib, ia) = i0 - ia0(i0) = convert_secondary_to_global_idx(ia) ! secondary - ib0(i0) = convert_secondary_to_global_idx(ib) ! secondary - End do + End do + + nab = i0 + + Allocate (iab(nsec, nsec)) + Allocate (ia0(nab)) + Allocate (ib0(nab)) + iab = 0 + + i0 = 0 + Do ia = 1, nsec + Do ib = 1, ia - 1 + i0 = i0 + 1 + iab(ia, ib) = i0 + iab(ib, ia) = i0 + ia0(i0) = convert_secondary_to_global_idx(ia) ! secondary + ib0(i0) = convert_secondary_to_global_idx(ib) ! secondary End do + End do - i0 = 0 - Do ii = 1, ninact - Do ij = 1, ii - 1 - i0 = i0 + 1 - End do + i0 = 0 + Do ii = 1, ninact + Do ij = 1, ii - 1 + i0 = i0 + 1 End do - - nij = i0 - Allocate (iij(1:ninact, 1:ninact)) - Allocate (ii0(nij)) - Allocate (ij0(nij)) - iij = 0 - - i0 = 0 - Do ii = 1, ninact - Do ij = 1, ii - 1 - i0 = i0 + 1 - iij(ii, ij) = i0 - iij(ij, ii) = i0 - ii0(i0) = ii - ij0(i0) = ij - End do + End do + + nij = i0 + Allocate (iij(1:ninact, 1:ninact)) + Allocate (ii0(nij)) + Allocate (ij0(nij)) + iij = 0 + + i0 = 0 + Do ii = 1, ninact + Do ij = 1, ii - 1 + i0 = i0 + 1 + iij(ii, ij) = i0 + iij(ij, ii) = i0 + ii0(i0) = ii + ij0(i0) = ij End do + End do - Allocate (v(nab, nij)) - v = 0.0d+00 + Allocate (v(nab, nij)) + v = 0.0d+00 - call open_unformatted_file(unit=unit_int2, file=hint, status='old', optional_action='read') - do - read (unit_int2, iostat=iostat) i, j, k, l, cint2 - call check_iostat(iostat=iostat, file=hint, end_of_file_reached=is_end_of_file) - if (is_end_of_file) then - exit - end if - if (i <= k .or. j == l) cycle ! Read the next line if i <= k or j == l + call open_unformatted_file(unit=unit_int2, file=hint, status='old', optional_action='read') + do + read (unit_int2, iostat=iostat) i, j, k, l, cint2 + call check_iostat(iostat=iostat, file=hint, end_of_file_reached=is_end_of_file) + if (is_end_of_file) then + exit + end if + if (i <= k .or. j == l) cycle ! Read the next line if i <= k or j == l - tab = iab(i, k) - tij = iij(j, l) + tab = iab(i, k) + tij = iij(j, l) - if (i > k .and. j > l) then - v(tab, tij) = v(tab, tij) + cint2 + if (i > k .and. j > l) then + v(tab, tij) = v(tab, tij) + cint2 - elseif (i > k .and. j < l) then - v(tab, tij) = v(tab, tij) - cint2 + elseif (i > k .and. j < l) then + v(tab, tij) = v(tab, tij) - cint2 - elseif (i < k .and. j > l) then ! (kl|ij) l > j + ; l < j - - v(tab, tij) = v(tab, tij) - cint2 + elseif (i < k .and. j > l) then ! (kl|ij) l > j + ; l < j - + v(tab, tij) = v(tab, tij) - cint2 - elseif (i < k .and. j < l) then - v(tab, tij) = v(tab, tij) + cint2 + elseif (i < k .and. j < l) then + v(tab, tij) = v(tab, tij) + cint2 - end if + end if - end do - close (unit_int2) + end do + close (unit_int2) #ifdef HAVE_MPI - call allreduce_wrapper(mat=v) + call allreduce_wrapper(mat=v) #endif - if (rank == 0) print *, 'reading Hint is over' + if (rank == 0) print *, 'reading Hint is over' - Do i0 = 1, nab - ia = ia0(i0) - ib = ib0(i0) + Do i0 = 1, nab + ia = ia0(i0) + ib = ib0(i0) ! EaiEbj|0> a > b, i > j - Do j0 = 1, nij - ii = ii0(j0) - ij = ij0(j0) - syma = MULTB_D(irpamo(ia), irpamo(ii)) - symb = MULTB_D(irpamo(ib), irpamo(ij)) - syma = MULTB_S(syma, symb) - if (syma == 1) then + Do j0 = 1, nij + ii = ii0(j0) + ij = ij0(j0) + syma = MULTB_D(irpamo(ia), irpamo(ii)) + symb = MULTB_D(irpamo(ib), irpamo(ij)) + syma = MULTB_S(syma, symb) + if (syma == 1) then - e = eps(ia) + eps(ib) - eps(ii) - eps(ij) + eshift ! For Level Shift (2007/2/9) + e = eps(ia) + eps(ib) - eps(ii) - eps(ij) + eshift ! For Level Shift (2007/2/9) - coeff1 = v(i0, j0)/e - sumc2local = sumc2local + ABS(coeff1)**2 + coeff1 = v(i0, j0)/e + sumc2local = sumc2local + ABS(coeff1)**2 - e2h = e2h - DBLE(DCONJG(v(i0, j0))*v(i0, j0)/e) - end if - End do + e2h = e2h - DBLE(DCONJG(v(i0, j0))*v(i0, j0)/e) + end if End do + End do - if (rank == 0) then - print '("e2h = ",E20.10," a.u.")', e2h - print '("sumc2,h = ",E20.10)', sumc2local - end if - sumc2 = sumc2 + sumc2local + if (rank == 0) then + print '("e2h = ",E20.10," a.u.")', e2h + print '("sumc2,h = ",E20.10)', sumc2local + end if + sumc2 = sumc2 + sumc2local - deallocate (v) - deallocate (iab) - deallocate (ia0) - deallocate (ib0) - deallocate (iij) - deallocate (ii0) - deallocate (ij0) + deallocate (v) + deallocate (iab) + deallocate (ia0) + deallocate (ib0) + deallocate (iij) + deallocate (ii0) + deallocate (ij0) - if (rank == 0) print *, 'end solve_H_subspace' - End SUBROUTINE solve_H_subspace_complex + if (rank == 0) print *, 'end solve_H_subspace' + End SUBROUTINE solve_H_subspace_complex ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - SUBROUTINE solve_H_subspace_real () + SUBROUTINE solve_H_subspace_real() ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= - use module_file_manager, only: open_unformatted_file, check_iostat - use module_global_variables - use module_index_utils, only: convert_secondary_to_global_idx + use module_file_manager, only: open_unformatted_file, check_iostat + use module_global_variables + use module_index_utils, only: convert_secondary_to_global_idx #ifdef HAVE_MPI - use module_mpi + use module_mpi #endif - Implicit NONE + Implicit NONE - Integer :: ia, ib, ii, ij, syma, symb, i, j, k, l - Integer :: i0, j0, tab, nab, tij, nij, iostat, unit_int2 - Integer, allocatable :: ia0(:), ib0(:), ii0(:), ij0(:), iab(:, :), iij(:, :) - real(8) :: cint2 - real(8), allocatable :: v(:, :) - real(8) :: e - logical :: is_end_of_file + Integer :: ia, ib, ii, ij, syma, symb, i, j, k, l + Integer :: i0, j0, tab, nab, tij, nij, iostat, unit_int2 + Integer, allocatable :: ia0(:), ib0(:), ii0(:), ij0(:), iab(:, :), iij(:, :) + real(8) :: cint2 + real(8), allocatable :: v(:, :) + real(8) :: e + logical :: is_end_of_file ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= @@ -229,138 +229,138 @@ SUBROUTINE solve_H_subspace_real () ! V(aibj) = (ai|bj) - (aj|bi) ! ! E2h = V(aibj)/e(a,b,i,j) - if (rank == 0) then - print *, ' ENTER solve H part' - print *, ' nsymrpa', nsymrpa - end if - e2h = 0.0d+00 - e = 0.0d+00 - - i0 = 0 - Do ia = global_sec_start, global_sec_end - Do ib = global_sec_start, ia - 1 - i0 = i0 + 1 - End do + if (rank == 0) then + print *, ' ENTER solve H part' + print *, ' nsymrpa', nsymrpa + end if + e2h = 0.0d+00 + e = 0.0d+00 + + i0 = 0 + Do ia = global_sec_start, global_sec_end + Do ib = global_sec_start, ia - 1 + i0 = i0 + 1 End do - - nab = i0 - - Allocate (iab(nsec, nsec)) - Allocate (ia0(nab)) - Allocate (ib0(nab)) - iab = 0 - - i0 = 0 - Do ia = 1, nsec - Do ib = 1, ia - 1 - i0 = i0 + 1 - iab(ia, ib) = i0 - iab(ib, ia) = i0 - ia0(i0) = convert_secondary_to_global_idx(ia) ! secondary - ib0(i0) = convert_secondary_to_global_idx(ib) ! secondary - End do + End do + + nab = i0 + + Allocate (iab(nsec, nsec)) + Allocate (ia0(nab)) + Allocate (ib0(nab)) + iab = 0 + + i0 = 0 + Do ia = 1, nsec + Do ib = 1, ia - 1 + i0 = i0 + 1 + iab(ia, ib) = i0 + iab(ib, ia) = i0 + ia0(i0) = convert_secondary_to_global_idx(ia) ! secondary + ib0(i0) = convert_secondary_to_global_idx(ib) ! secondary End do + End do - i0 = 0 - Do ii = 1, ninact - Do ij = 1, ii - 1 - i0 = i0 + 1 - End do + i0 = 0 + Do ii = 1, ninact + Do ij = 1, ii - 1 + i0 = i0 + 1 End do - - nij = i0 - Allocate (iij(1:ninact, 1:ninact)) - Allocate (ii0(nij)) - Allocate (ij0(nij)) - iij = 0 - - i0 = 0 - Do ii = 1, ninact - Do ij = 1, ii - 1 - i0 = i0 + 1 - iij(ii, ij) = i0 - iij(ij, ii) = i0 - ii0(i0) = ii - ij0(i0) = ij - End do + End do + + nij = i0 + Allocate (iij(1:ninact, 1:ninact)) + Allocate (ii0(nij)) + Allocate (ij0(nij)) + iij = 0 + + i0 = 0 + Do ii = 1, ninact + Do ij = 1, ii - 1 + i0 = i0 + 1 + iij(ii, ij) = i0 + iij(ij, ii) = i0 + ii0(i0) = ii + ij0(i0) = ij End do + End do - Allocate (v(nab, nij)) - v = 0.0d+00 + Allocate (v(nab, nij)) + v = 0.0d+00 - call open_unformatted_file(unit=unit_int2, file=hint, status='old', optional_action='read') - do - read (unit_int2, iostat=iostat) i, j, k, l, cint2 - call check_iostat(iostat=iostat, file=hint, end_of_file_reached=is_end_of_file) - if (is_end_of_file) then - exit - end if - if (i <= k .or. j == l) cycle ! Read the next line if i <= k or j == l + call open_unformatted_file(unit=unit_int2, file=hint, status='old', optional_action='read') + do + read (unit_int2, iostat=iostat) i, j, k, l, cint2 + call check_iostat(iostat=iostat, file=hint, end_of_file_reached=is_end_of_file) + if (is_end_of_file) then + exit + end if + if (i <= k .or. j == l) cycle ! Read the next line if i <= k or j == l - tab = iab(i, k) - tij = iij(j, l) + tab = iab(i, k) + tij = iij(j, l) - if (i > k .and. j > l) then - v(tab, tij) = v(tab, tij) + cint2 + if (i > k .and. j > l) then + v(tab, tij) = v(tab, tij) + cint2 - elseif (i > k .and. j < l) then - v(tab, tij) = v(tab, tij) - cint2 + elseif (i > k .and. j < l) then + v(tab, tij) = v(tab, tij) - cint2 - elseif (i < k .and. j > l) then ! (kl|ij) l > j + ; l < j - - v(tab, tij) = v(tab, tij) - cint2 + elseif (i < k .and. j > l) then ! (kl|ij) l > j + ; l < j - + v(tab, tij) = v(tab, tij) - cint2 - elseif (i < k .and. j < l) then - v(tab, tij) = v(tab, tij) + cint2 + elseif (i < k .and. j < l) then + v(tab, tij) = v(tab, tij) + cint2 - end if + end if - end do - close (unit_int2) + end do + close (unit_int2) #ifdef HAVE_MPI - call allreduce_wrapper(mat=v) + call allreduce_wrapper(mat=v) #endif - if (rank == 0) print *, 'reading Hint is over' + if (rank == 0) print *, 'reading Hint is over' - Do i0 = 1, nab - ia = ia0(i0) - ib = ib0(i0) + Do i0 = 1, nab + ia = ia0(i0) + ib = ib0(i0) ! EaiEbj|0> a > b, i > j - Do j0 = 1, nij - ii = ii0(j0) - ij = ij0(j0) - syma = MULTB_D(irpamo(ia), irpamo(ii)) - symb = MULTB_D(irpamo(ib), irpamo(ij)) - syma = MULTB_S(syma, symb) - if (syma == 1) then + Do j0 = 1, nij + ii = ii0(j0) + ij = ij0(j0) + syma = MULTB_D(irpamo(ia), irpamo(ii)) + symb = MULTB_D(irpamo(ib), irpamo(ij)) + syma = MULTB_S(syma, symb) + if (syma == 1) then - e = eps(ia) + eps(ib) - eps(ii) - eps(ij) + eshift ! For Level Shift (2007/2/9) + e = eps(ia) + eps(ib) - eps(ii) - eps(ij) + eshift ! For Level Shift (2007/2/9) - coeff1 = v(i0, j0)/e - sumc2local = sumc2local + ABS(coeff1)**2 + coeff1 = v(i0, j0)/e + sumc2local = sumc2local + ABS(coeff1)**2 - e2h = e2h - DBLE(v(i0, j0)**2.0d+00/e) - end if - End do + e2h = e2h - DBLE(v(i0, j0)**2.0d+00/e) + end if End do - - if (rank == 0) then - print '("e2h = ",E20.10," a.u.")', e2h - print '("sumc2,h = ",E20.10)', sumc2local - end if - sumc2 = sumc2 + sumc2local - - deallocate (v) - deallocate (iab) - deallocate (ia0) - deallocate (ib0) - deallocate (iij) - deallocate (ii0) - deallocate (ij0) - - if (rank == 0) print *, 'end solve_H_subspace' - End SUBROUTINE solve_H_subspace_real + End do + + if (rank == 0) then + print '("e2h = ",E20.10," a.u.")', e2h + print '("sumc2,h = ",E20.10)', sumc2local + end if + sumc2 = sumc2 + sumc2local + + deallocate (v) + deallocate (iab) + deallocate (ia0) + deallocate (ib0) + deallocate (iij) + deallocate (ii0) + deallocate (ij0) + + if (rank == 0) print *, 'end solve_H_subspace' + End SUBROUTINE solve_H_subspace_real end subroutine solve_H_subspace diff --git a/test/conftest.py b/test/conftest.py index f2bb5036..44c8722d 100644 --- a/test/conftest.py +++ b/test/conftest.py @@ -1,14 +1,18 @@ -import pytest import glob import os import shutil +from pathlib import Path +from typing import List, Tuple + +import pytest +from module_testing import create_test_command_dcaspt2 slow_only_option = "--slowonly" dev_option = "--dev" runall_option = "--all" -def pytest_addoption(parser): +def pytest_addoption(parser: pytest.Parser) -> None: parser.addoption(slow_only_option, action="store_true", default=False, help="run only very slow tests") parser.addoption(dev_option, action="store_true", default=False, help="run tests for development") parser.addoption(runall_option, action="store_true", default=False, help="run all tests") @@ -28,26 +32,90 @@ def pytest_addoption(parser): @pytest.fixture -def mpi_num_process(request): +def mpi_num_process(request: pytest.FixtureRequest): return request.config.getoption("--mpi") @pytest.fixture -def omp_num_threads(request): +def omp_num_threads(request: pytest.FixtureRequest): return request.config.getoption("--omp") @pytest.fixture -def save(request): +def save(request: pytest.FixtureRequest): return request.config.getoption("--save") -def pytest_configure(config): +@pytest.fixture(scope="function") +def env_setup_caspt2(request: pytest.FixtureRequest, mpi_num_process: int, omp_num_threads: int, save: bool) -> Tuple[Path, Path, Path, Path, str]: + root_path = Path(__file__).parent.parent + test_path = Path(request.fspath).parent + # test_name is the name of the test file without the extension and the first test_. + # (e.g.) /path/to/test/slow/c1_methane_slow/test_c1_methane_slow.py -> c1_methane_slow + test_name = Path(request.fspath).stem[5:] + + input_file = "active.inp" + ref_output_file = f"reference.{test_name}.out" + output_filename = f"{test_name}.caspt2.out" + latest_passed_output = f"latest_passed.{test_name}.caspt2.out" + + input_path = test_path / input_file + ref_output_path = test_path / ref_output_file + output_path = test_path / output_filename + latest_passed_path = test_path / latest_passed_output + dcaspt2 = root_path / "bin/dcaspt2" + test_command = create_test_command_dcaspt2(dcaspt2, mpi_num_process, omp_num_threads, input_path, output_path, test_path, save) + + return ( + test_path, + ref_output_path, + output_path, + latest_passed_path, + test_command, + ) + + +@pytest.fixture(scope="function") +def env_setup_ivo(request: pytest.FixtureRequest, mpi_num_process: int, omp_num_threads: int, save: bool) -> Tuple[Path, Path, Path, Path, str]: + root_path = Path(__file__).parent.parent + test_path = Path(request.fspath).parent + # test_name is the name of the test file without the extension and the first test_. + # (e.g.) /path/to/test/dev/ivo_c32h_n2_dev_dirac22/test_ivo_c32h_n2_dev_dirac22.py -> ivo_c32h_n2_dev_dirac22 + test_name = Path(request.fspath).stem[5:] + + input_file = "active.ivo.inp" + DFPCMONEW_file = "DFPCMONEW" + ref_DFPCMONEW_file = "reference.DFPCMONEW" + output_filename = f"{test_name}.ivo.out" + latest_passed_output = f"latest_passed.{test_name}.ivo.out" + + input_path = test_path / input_file + DFPCMONEW_path = test_path / DFPCMONEW_file + ref_DFPCMONEW_path = test_path / ref_DFPCMONEW_file + latest_passed_DFPCMONEW_path = test_path / latest_passed_output + output_path = test_path / output_filename + latest_passed_output_path = test_path / latest_passed_output + dcaspt2 = root_path / "bin/dcaspt2" + is_ivo = True + test_command = create_test_command_dcaspt2(dcaspt2, mpi_num_process, omp_num_threads, input_path, output_path, test_path, save, is_ivo) + + return ( + test_path, + DFPCMONEW_path, + ref_DFPCMONEW_path, + latest_passed_DFPCMONEW_path, + output_path, + latest_passed_output_path, + test_command, + ) + + +def pytest_configure(config: pytest.Config) -> None: config.addinivalue_line("markers", "slowonly: mark test as slow to run") config.addinivalue_line("markers", "dev: mark test as for development") -def pytest_collection_modifyitems(config, items): +def pytest_collection_modifyitems(config: pytest.Config, items: List[pytest.Item]) -> None: skip_slow = pytest.mark.skip(reason=f"need {runall_option} or {slow_only_option} option to run. REASON: slow test") skip_tests_because_dev = pytest.mark.skip(reason=f"need no option or {runall_option} option to run. REASON: --dev was activated") skip_fast_dev = pytest.mark.skip(reason=f"need no option or {dev_option} or {runall_option} option or to run. REASON: --slowonly was activated") diff --git a/test/dev/c1_methane_dev/test_c1_methane_dev.py b/test/dev/c1_methane_dev/test_c1_methane_dev.py index 97d310c7..14edce04 100644 --- a/test/dev/c1_methane_dev/test_c1_methane_dev.py +++ b/test/dev/c1_methane_dev/test_c1_methane_dev.py @@ -1,49 +1,27 @@ import os import shutil + import pytest from module_testing import ( - create_test_command_dcaspt2, get_caspt2_energy_from_output_file, run_test_dcaspt2, ) @pytest.mark.dev -def test_c1_methane_dev(mpi_num_process: int, omp_num_threads: int, save: bool) -> None: - - # Set file names - input_file = "active.inp" # Input - ref_output_file = "reference.c1_methane_dev.out" # Reference - output_filename = "c1_methane_dev.caspt2.out" # Output (This file is compared with Reference) - latest_passed_output = "latest_passed.c1_methane_dev.caspt2.out" # latest passed output (After test, the output file is moved to this) +def test_c1_methane_dev(env_setup_caspt2) -> None: + (test_path, ref_output_path, output_path, latest_passed_path, test_command) = env_setup_caspt2 # Get this files path and change directory to this path - test_path = os.path.dirname(os.path.abspath(__file__)) # The path of this file os.chdir(test_path) # Change directory to the path of this file print(test_path, "test start") # Debug output - # Set file paths - ref_output_file_path = os.path.abspath(os.path.join(test_path, ref_output_file)) - output_file_path = os.path.abspath(os.path.join(test_path, output_filename)) - latest_passed_file_path = os.path.abspath(os.path.join(test_path, latest_passed_output)) - binary_dir = os.path.abspath(os.path.join(test_path, "../../../bin")) # Set the Built binary directory - dcaspt2 = os.path.abspath(os.path.join(binary_dir, "dcaspt2")) # Set the dcaspt2 script path - - test_command = create_test_command_dcaspt2( - dcaspt2, - mpi_num_process, - omp_num_threads, - input_file, - output_file_path, - test_path, - save, - ) with open("execution_command.txt", "w") as f: print(f"TEST COMMAND: {test_command}", file=f) run_test_dcaspt2(test_command) - ref_energy = get_caspt2_energy_from_output_file(ref_output_file_path) - test_energy = get_caspt2_energy_from_output_file(output_file_path) + ref_energy = get_caspt2_energy_from_output_file(ref_output_path) + test_energy = get_caspt2_energy_from_output_file(output_path) # Check whether the output of test run # matches the reference to 7th decimal places. @@ -51,4 +29,4 @@ def test_c1_methane_dev(mpi_num_process: int, omp_num_threads: int, save: bool) # If it reaches this point, the result of assert is true. # The latest passed output file is overwritten by the current output file if assert is True. - shutil.copy(output_file_path, latest_passed_file_path) + shutil.copy(output_path, latest_passed_path) diff --git a/test/dev/c2_h2o_dev/test_c2_h2o_dev.py b/test/dev/c2_h2o_dev/test_c2_h2o_dev.py index 2eea665a..67a1d39f 100644 --- a/test/dev/c2_h2o_dev/test_c2_h2o_dev.py +++ b/test/dev/c2_h2o_dev/test_c2_h2o_dev.py @@ -3,37 +3,20 @@ import pytest from module_testing import ( run_test_dcaspt2, - create_test_command_dcaspt2, get_caspt2_energy_from_output_file, ) @pytest.mark.dev -def test_c2_h2o_dev(mpi_num_process: int, omp_num_threads: int, save: bool) -> None: - - # Set file names - input_file = "active.inp" # Input - ref_output_file = "reference.c2_h2o_dev.out" # Reference - output_filename = "c2_h2o_dev.caspt2.out" # Output (This file is compared with Reference) - latest_passed_output = "latest_passed.c2_h2o_dev.caspt2.out" # latest passed output (After test, the output file is moved to this) - - # Get this files path and change directory to this path - test_path = os.path.dirname(os.path.abspath(__file__)) # The path of this file +def test_c2_h2o_dev(env_setup_caspt2) -> None: + (test_path, ref_output_path, output_path, latest_passed_path, test_command) = env_setup_caspt2 os.chdir(test_path) # Change directory to the path of this file print(test_path, "test start") # Debug output - # Set file paths - ref_output_file_path = os.path.abspath(os.path.join(test_path, ref_output_file)) - output_file_path = os.path.abspath(os.path.join(test_path, output_filename)) - latest_passed_file_path = os.path.abspath(os.path.join(test_path, latest_passed_output)) - binary_dir = os.path.abspath(os.path.join(test_path, "../../../bin")) # Set the Built binary directory - dcaspt2 = os.path.join(binary_dir, "dcaspt2") # Set the dcaspt2 binary path - - test_command = create_test_command_dcaspt2(dcaspt2, mpi_num_process, omp_num_threads, input_file, output_file_path, test_path, save) run_test_dcaspt2(test_command) - ref_energy = get_caspt2_energy_from_output_file(ref_output_file_path) - test_energy = get_caspt2_energy_from_output_file(output_file_path) + ref_energy = get_caspt2_energy_from_output_file(ref_output_path) + test_energy = get_caspt2_energy_from_output_file(output_path) # Check whether the output of test run # matches the reference to 7th decimal places. @@ -41,4 +24,4 @@ def test_c2_h2o_dev(mpi_num_process: int, omp_num_threads: int, save: bool) -> N # If it reaches this point, the result of assert is true. # The latest passed output file is overwritten by the current output file if assert is True. - shutil.copy(output_file_path, latest_passed_file_path) + shutil.copy(output_path, latest_passed_path) diff --git a/test/dev/c32_co_dev/test_c32_co_dev.py b/test/dev/c32_co_dev/test_c32_co_dev.py index fa1290e9..58075d8a 100644 --- a/test/dev/c32_co_dev/test_c32_co_dev.py +++ b/test/dev/c32_co_dev/test_c32_co_dev.py @@ -1,39 +1,24 @@ import os import shutil + import pytest from module_testing import ( - run_test_dcaspt2, - create_test_command_dcaspt2, get_caspt2_energy_from_output_file, + run_test_dcaspt2, ) @pytest.mark.dev -def test_c32_co_dev(mpi_num_process: int, omp_num_threads: int, save: bool) -> None: +def test_c32_co_dev(env_setup_caspt2) -> None: + (test_path, ref_output_path, output_path, latest_passed_path, test_command) = env_setup_caspt2 - # Set file names - input_file = "active.inp" # Input - ref_output_file = "reference.c32_co_dev.out" # Reference - output_filename = "c32_co_dev.caspt2.out" # Output (This file is compared with Reference) - latest_passed_output = "latest_passed.c32_co_dev.caspt2.out" # latest passed output (After test, the output file is moved to this) - - # Get this files path and change directory to this path - test_path = os.path.dirname(os.path.abspath(__file__)) # The path of this file os.chdir(test_path) # Change directory to the path of this file print(test_path, "test start") # Debug output - # Set file paths - ref_output_file_path = os.path.abspath(os.path.join(test_path, ref_output_file)) - output_file_path = os.path.abspath(os.path.join(test_path, output_filename)) - latest_passed_file_path = os.path.abspath(os.path.join(test_path, latest_passed_output)) - binary_dir = os.path.abspath(os.path.join(test_path, "../../../bin")) # Set the Built binary directory - dcaspt2 = os.path.join(binary_dir, "dcaspt2") # Set the dcaspt2 binary path - - test_command = create_test_command_dcaspt2(dcaspt2, mpi_num_process, omp_num_threads, input_file, output_file_path, test_path, save) run_test_dcaspt2(test_command) - ref_energy = get_caspt2_energy_from_output_file(ref_output_file_path) - test_energy = get_caspt2_energy_from_output_file(output_file_path) + ref_energy = get_caspt2_energy_from_output_file(ref_output_path) + test_energy = get_caspt2_energy_from_output_file(output_path) # Check whether the output of test run # matches the reference to 7th decimal places. @@ -41,4 +26,4 @@ def test_c32_co_dev(mpi_num_process: int, omp_num_threads: int, save: bool) -> N # If it reaches this point, the result of assert is true. # The latest passed output file is overwritten by the current output file if assert is True. - shutil.copy(output_file_path, latest_passed_file_path) + shutil.copy(output_path, latest_passed_path) diff --git a/test/dev/c32h_n2_dev/test_c32h_n2_dev.py b/test/dev/c32h_n2_dev/test_c32h_n2_dev.py index 9ca384c8..b8583cfc 100644 --- a/test/dev/c32h_n2_dev/test_c32h_n2_dev.py +++ b/test/dev/c32h_n2_dev/test_c32h_n2_dev.py @@ -3,38 +3,23 @@ import pytest from module_testing import ( run_test_dcaspt2, - create_test_command_dcaspt2, get_caspt2_energy_from_output_file, ) @pytest.mark.dev -def test_c32h_n2_dev(mpi_num_process: int, omp_num_threads: int, save: bool) -> None: +def test_c32h_n2_dev(env_setup_caspt2) -> None: - # Set file names - input_file = "active.inp" # Input - ref_output_file = "reference.c32h_n2_dev.out" # Reference - output_filename = "c32h_n2_dev.caspt2.out" # Output (This file is compared with Reference) - latest_passed_output = "latest_passed.c32h_n2_dev.caspt2.out" # latest passed output (After test, the output file is moved to this) + (test_path, ref_output_path, output_path, latest_passed_path, test_command) = env_setup_caspt2 # Get this files path and change directory to this path - test_path = os.path.dirname(os.path.abspath(__file__)) # The path of this file os.chdir(test_path) # Change directory to the path of this file print(test_path, "test start") # Debug output - # Set file paths - ref_output_file_path = os.path.abspath(os.path.join(test_path, ref_output_file)) - output_file_path = os.path.abspath(os.path.join(test_path, output_filename)) - latest_passed_file_path = os.path.abspath(os.path.join(test_path, latest_passed_output)) - binary_dir = os.path.abspath(os.path.join(test_path, "../../../bin")) # Set the Built binary directory - dcaspt2 = os.path.join(binary_dir, "dcaspt2") # Set the dcaspt2 binary path - - test_command = create_test_command_dcaspt2(dcaspt2, mpi_num_process, omp_num_threads, input_file, output_file_path, test_path, save) - run_test_dcaspt2(test_command) - ref_energy = get_caspt2_energy_from_output_file(ref_output_file_path) - test_energy = get_caspt2_energy_from_output_file(output_file_path) + ref_energy = get_caspt2_energy_from_output_file(ref_output_path) + test_energy = get_caspt2_energy_from_output_file(output_path) # Check whether the output of test run # matches the reference to 7th decimal places. @@ -42,4 +27,4 @@ def test_c32h_n2_dev(mpi_num_process: int, omp_num_threads: int, save: bool) -> # If it reaches this point, the result of assert is true. # The latest passed output file is overwritten by the current output file if assert is True. - shutil.copy(output_file_path, latest_passed_file_path) + shutil.copy(output_path, latest_passed_path) diff --git a/test/dev/ivo_c2_h2o/.gitignore b/test/dev/ivo_c2_h2o_dev/.gitignore similarity index 66% rename from test/dev/ivo_c2_h2o/.gitignore rename to test/dev/ivo_c2_h2o_dev/.gitignore index 0f98fc68..e0f8c767 100644 --- a/test/dev/ivo_c2_h2o/.gitignore +++ b/test/dev/ivo_c2_h2o_dev/.gitignore @@ -1,4 +1,4 @@ *DFPCMONEW* -c2_h2o_dev.*.out +ivo_c2_h2o_dev.*.out latest_passed.* !reference.* diff --git a/test/dev/ivo_c2_h2o/DFPCMO b/test/dev/ivo_c2_h2o_dev/DFPCMO similarity index 100% rename from test/dev/ivo_c2_h2o/DFPCMO rename to test/dev/ivo_c2_h2o_dev/DFPCMO diff --git a/test/dev/ivo_c2_h2o/MDCINT b/test/dev/ivo_c2_h2o_dev/MDCINT similarity index 100% rename from test/dev/ivo_c2_h2o/MDCINT rename to test/dev/ivo_c2_h2o_dev/MDCINT diff --git a/test/dev/ivo_c2_h2o/MRCONEE b/test/dev/ivo_c2_h2o_dev/MRCONEE similarity index 100% rename from test/dev/ivo_c2_h2o/MRCONEE rename to test/dev/ivo_c2_h2o_dev/MRCONEE diff --git a/test/dev/ivo_c2_h2o/active.ivo.inp b/test/dev/ivo_c2_h2o_dev/active.ivo.inp similarity index 100% rename from test/dev/ivo_c2_h2o/active.ivo.inp rename to test/dev/ivo_c2_h2o_dev/active.ivo.inp diff --git a/test/dev/ivo_c2_h2o/dirac_data/H2O.xyz b/test/dev/ivo_c2_h2o_dev/dirac_data/H2O.xyz similarity index 100% rename from test/dev/ivo_c2_h2o/dirac_data/H2O.xyz rename to test/dev/ivo_c2_h2o_dev/dirac_data/H2O.xyz diff --git a/test/dev/ivo_c2_h2o/dirac_data/dossss.inp b/test/dev/ivo_c2_h2o_dev/dirac_data/dossss.inp similarity index 100% rename from test/dev/ivo_c2_h2o/dirac_data/dossss.inp rename to test/dev/ivo_c2_h2o_dev/dirac_data/dossss.inp diff --git a/test/dev/ivo_c2_h2o/dirac_data/dossss.transform.inp b/test/dev/ivo_c2_h2o_dev/dirac_data/dossss.transform.inp similarity index 100% rename from test/dev/ivo_c2_h2o/dirac_data/dossss.transform.inp rename to test/dev/ivo_c2_h2o_dev/dirac_data/dossss.transform.inp diff --git a/test/dev/ivo_c2_h2o/dirac_data/dossss_H2O.out b/test/dev/ivo_c2_h2o_dev/dirac_data/dossss_H2O.out similarity index 100% rename from test/dev/ivo_c2_h2o/dirac_data/dossss_H2O.out rename to test/dev/ivo_c2_h2o_dev/dirac_data/dossss_H2O.out diff --git a/test/dev/ivo_c2_h2o/reference.DFPCMONEW b/test/dev/ivo_c2_h2o_dev/reference.DFPCMONEW similarity index 100% rename from test/dev/ivo_c2_h2o/reference.DFPCMONEW rename to test/dev/ivo_c2_h2o_dev/reference.DFPCMONEW diff --git a/test/dev/ivo_c2_h2o_dev/test_ivo_c2_h2o_dev.py b/test/dev/ivo_c2_h2o_dev/test_ivo_c2_h2o_dev.py new file mode 100644 index 00000000..2f0e9cd0 --- /dev/null +++ b/test/dev/ivo_c2_h2o_dev/test_ivo_c2_h2o_dev.py @@ -0,0 +1,51 @@ +import os +import shutil + +import pytest +from module_testing import run_test_dcaspt2 + + +@pytest.mark.dev +def test_ivo_c2_h2o_dev(env_setup_ivo) -> None: + (test_path, DFPCMONEW_path, ref_DFPCMONEW_path, latest_passed_DFPCMONEW_path, output_path, latest_passed_output_path, test_command) = env_setup_ivo + os.chdir(test_path) # Change directory to the path of this file + + run_test_dcaspt2(test_command) + + # DFPCMONEW format + # INFO (DIRAC version >= 21) + # N2 Thu Apr 6 11:00:00 2023 + # 2 15 15 54 15 15 54 + # -0.1075307794799569E+03 + # COEFS (DIRAC version >= 21) + # 0.0783846162631894 -0.0932522358717089 0.2444662687107759 -0.2100050908725506 0.0207980763363816 -0.0061525045832165 + # -0.0001106259309856 -0.0000860939270339 0.0001830653248163 0.0000000555844586 -0.0000000349239622 0.0000000146384444 + # -0.0000000555844586 0.0000000349239622 -0.0000000146384444 -0.4656826540533246 0.2259566676583494 -0.3303017764820634 + # ... + # EVALS (DIRAC version >= 21) + # -0.378466132952E+05 -0.376317160433E+05 -0.375871872904E+05 -0.375847489191E+05 -0.375740444395E+05 -0.375738772125E+05 + # -0.375678183830E+05 -0.375638423228E+05 -0.375612685737E+05 -0.375611284085E+05 -0.375605808599E+05 -0.375591793895E+05 + # -0.375586003412E+05 -0.375585970263E+05 -0.375581434458E+05 -0.155806087301E+02 -0.122487085753E+01 -0.527584459237E+00 + # ... + # SUPERSYM + # 1 1 1 1 -3 1 1 1 -3 1 1 1 -3 1 1 1 1 1 1 -3 1 1 -3 1 1 1 -3 1 1 1 1 1 1 1 1 -3 1 1 1 -3 1 1 1 -3 1 1 1 1 -3 1 1 -3 1 1 1 -3 1 1 1 1 + # 1 2 3 2 + + # Open DFPCMONEW and reference.DFPCMONEW and compare the values (if the values are float, compare the values to 10th decimal places) + with open(DFPCMONEW_path, "r") as DFPCMONEW_file, open(ref_DFPCMONEW_path, "r") as ref_file: + for DFPCMONEW_line, ref_line in zip(DFPCMONEW_file, ref_file): + # if the first value cannot be converted to float, compare the values as strings + DFPCMONEW_values = DFPCMONEW_line.split() + ref_values = ref_line.split() + try: + DFPCMONEW_float_values = [float(value) for value in DFPCMONEW_values] + ref_float_values = [float(value) for value in ref_values] + for DFPCMONEW_float_value, ref_float_value in zip(DFPCMONEW_float_values, ref_float_values): + assert ref_float_value == pytest.approx(DFPCMONEW_float_value, abs=1e-13) + except ValueError: + assert DFPCMONEW_values == ref_values + + # If it reaches this point, the result of assert is true. + # The latest passed output file is overwritten by the current output file if assert is True. + shutil.copy(output_path, latest_passed_output_path) + shutil.copy(DFPCMONEW_path, latest_passed_DFPCMONEW_path) diff --git a/test/dev/ivo_n2/.gitignore b/test/dev/ivo_c32h_n2_dev_dirac19/.gitignore similarity index 56% rename from test/dev/ivo_n2/.gitignore rename to test/dev/ivo_c32h_n2_dev_dirac19/.gitignore index e3bcc01a..03c3887d 100644 --- a/test/dev/ivo_n2/.gitignore +++ b/test/dev/ivo_c32h_n2_dev_dirac19/.gitignore @@ -1,4 +1,4 @@ *DFPCMONEW* -c32h_n2_dev.dirac*.caspt2.out +ivo_c32h_n2_dev_dirac*.ivo.out latest_passed.* !reference.* diff --git a/test/dev/ivo_n2/input/19/DFPCMO b/test/dev/ivo_c32h_n2_dev_dirac19/DFPCMO similarity index 100% rename from test/dev/ivo_n2/input/19/DFPCMO rename to test/dev/ivo_c32h_n2_dev_dirac19/DFPCMO diff --git a/test/dev/ivo_n2/input/19/MDCINT b/test/dev/ivo_c32h_n2_dev_dirac19/MDCINT similarity index 100% rename from test/dev/ivo_n2/input/19/MDCINT rename to test/dev/ivo_c32h_n2_dev_dirac19/MDCINT diff --git a/test/dev/ivo_n2/input/19/MDCINXXXX1 b/test/dev/ivo_c32h_n2_dev_dirac19/MDCINXXXX1 similarity index 100% rename from test/dev/ivo_n2/input/19/MDCINXXXX1 rename to test/dev/ivo_c32h_n2_dev_dirac19/MDCINXXXX1 diff --git a/test/dev/ivo_n2/input/19/MDCINXXXX2 b/test/dev/ivo_c32h_n2_dev_dirac19/MDCINXXXX2 similarity index 100% rename from test/dev/ivo_n2/input/19/MDCINXXXX2 rename to test/dev/ivo_c32h_n2_dev_dirac19/MDCINXXXX2 diff --git a/test/dev/ivo_n2/input/19/MDCINXXXX3 b/test/dev/ivo_c32h_n2_dev_dirac19/MDCINXXXX3 similarity index 100% rename from test/dev/ivo_n2/input/19/MDCINXXXX3 rename to test/dev/ivo_c32h_n2_dev_dirac19/MDCINXXXX3 diff --git a/test/dev/ivo_n2/input/19/MDCINXXXX4 b/test/dev/ivo_c32h_n2_dev_dirac19/MDCINXXXX4 similarity index 100% rename from test/dev/ivo_n2/input/19/MDCINXXXX4 rename to test/dev/ivo_c32h_n2_dev_dirac19/MDCINXXXX4 diff --git a/test/dev/ivo_n2/input/19/MDCINXXXX5 b/test/dev/ivo_c32h_n2_dev_dirac19/MDCINXXXX5 similarity index 100% rename from test/dev/ivo_n2/input/19/MDCINXXXX5 rename to test/dev/ivo_c32h_n2_dev_dirac19/MDCINXXXX5 diff --git a/test/dev/ivo_n2/input/19/MDCINXXXX6 b/test/dev/ivo_c32h_n2_dev_dirac19/MDCINXXXX6 similarity index 100% rename from test/dev/ivo_n2/input/19/MDCINXXXX6 rename to test/dev/ivo_c32h_n2_dev_dirac19/MDCINXXXX6 diff --git a/test/dev/ivo_n2/input/19/MDCINXXXX7 b/test/dev/ivo_c32h_n2_dev_dirac19/MDCINXXXX7 similarity index 100% rename from test/dev/ivo_n2/input/19/MDCINXXXX7 rename to test/dev/ivo_c32h_n2_dev_dirac19/MDCINXXXX7 diff --git a/test/dev/ivo_n2/input/19/MRCONEE b/test/dev/ivo_c32h_n2_dev_dirac19/MRCONEE similarity index 100% rename from test/dev/ivo_n2/input/19/MRCONEE rename to test/dev/ivo_c32h_n2_dev_dirac19/MRCONEE diff --git a/test/dev/ivo_n2/input/19/active.ivo.inp b/test/dev/ivo_c32h_n2_dev_dirac19/active.ivo.inp similarity index 100% rename from test/dev/ivo_n2/input/19/active.ivo.inp rename to test/dev/ivo_c32h_n2_dev_dirac19/active.ivo.inp diff --git a/test/dev/ivo_n2/dirac_data/N2.inp b/test/dev/ivo_c32h_n2_dev_dirac19/dirac_data/N2.inp similarity index 100% rename from test/dev/ivo_n2/dirac_data/N2.inp rename to test/dev/ivo_c32h_n2_dev_dirac19/dirac_data/N2.inp diff --git a/test/dev/ivo_n2/dirac_data/N2.ivo.inp b/test/dev/ivo_c32h_n2_dev_dirac19/dirac_data/N2.ivo.inp similarity index 100% rename from test/dev/ivo_n2/dirac_data/N2.ivo.inp rename to test/dev/ivo_c32h_n2_dev_dirac19/dirac_data/N2.ivo.inp diff --git a/test/dev/ivo_n2/dirac_data/N2.ivo_N2.out b/test/dev/ivo_c32h_n2_dev_dirac19/dirac_data/N2.ivo_N2.out similarity index 100% rename from test/dev/ivo_n2/dirac_data/N2.ivo_N2.out rename to test/dev/ivo_c32h_n2_dev_dirac19/dirac_data/N2.ivo_N2.out diff --git a/test/dev/ivo_n2/dirac_data/N2.mol b/test/dev/ivo_c32h_n2_dev_dirac19/dirac_data/N2.mol similarity index 100% rename from test/dev/ivo_n2/dirac_data/N2.mol rename to test/dev/ivo_c32h_n2_dev_dirac19/dirac_data/N2.mol diff --git a/test/dev/ivo_n2/dirac_data/N2_N2.out b/test/dev/ivo_c32h_n2_dev_dirac19/dirac_data/N2_N2.out similarity index 100% rename from test/dev/ivo_n2/dirac_data/N2_N2.out rename to test/dev/ivo_c32h_n2_dev_dirac19/dirac_data/N2_N2.out diff --git a/test/dev/ivo_n2/dirac_data/sh_ivo_caspt2 b/test/dev/ivo_c32h_n2_dev_dirac19/dirac_data/sh_ivo_caspt2 similarity index 100% rename from test/dev/ivo_n2/dirac_data/sh_ivo_caspt2 rename to test/dev/ivo_c32h_n2_dev_dirac19/dirac_data/sh_ivo_caspt2 diff --git a/test/dev/ivo_n2/reference.DFPCMONEW.dirac19 b/test/dev/ivo_c32h_n2_dev_dirac19/reference.DFPCMONEW similarity index 100% rename from test/dev/ivo_n2/reference.DFPCMONEW.dirac19 rename to test/dev/ivo_c32h_n2_dev_dirac19/reference.DFPCMONEW diff --git a/test/dev/ivo_c2_h2o/test_ivo_h2o_6_31g.py b/test/dev/ivo_c32h_n2_dev_dirac19/test_ivo_c32h_n2_dev_dirac19.py similarity index 57% rename from test/dev/ivo_c2_h2o/test_ivo_h2o_6_31g.py rename to test/dev/ivo_c32h_n2_dev_dirac19/test_ivo_c32h_n2_dev_dirac19.py index 7503146b..6908791a 100644 --- a/test/dev/ivo_c2_h2o/test_ivo_h2o_6_31g.py +++ b/test/dev/ivo_c32h_n2_dev_dirac19/test_ivo_c32h_n2_dev_dirac19.py @@ -1,38 +1,16 @@ import os import shutil + import pytest from module_testing import ( run_test_dcaspt2, - create_test_command_dcaspt2, ) @pytest.mark.dev -def test_ivo_h2o_6_31g(mpi_num_process: int, omp_num_threads: int, save: bool) -> None: - - test_path = os.path.dirname(os.path.abspath(__file__)) # The path of this file +def test_ivo_c32h_n2_dev_dirac19(env_setup_ivo) -> None: + (test_path, DFPCMONEW_path, ref_DFPCMONEW_path, latest_passed_DFPCMONEW_path, output_path, latest_passed_output_path, test_command) = env_setup_ivo os.chdir(test_path) # Change directory to the path of this file - - # Set file names - input_file = "active.ivo.inp" # Input - DFPCMONEW_file = "DFPCMONEW" # Test (This file is compared with Reference) - ref_DFPCMONEW_file = "reference.DFPCMONEW" # Reference - latest_passed_test = "latest_passed.DFPCMONEW" # latest passed DFPCMONEW - output_filename = "c2_h2o_dev.ivo.out" # Output - latest_passed_output = "latest_passed.c2_h2o_dev.ivo.out" # latest passed output (After test, the output file is moved to this) - - # Set file paths - input_file_path = os.path.abspath(os.path.join(test_path, input_file)) - DFPCMONEW_file_path = os.path.abspath(os.path.join(test_path, DFPCMONEW_file)) - ref_DFPCMONEW_file_path = os.path.abspath(os.path.join(test_path, ref_DFPCMONEW_file)) - latest_passed_DFPCMONEW_file_path = os.path.abspath(os.path.join(test_path, latest_passed_test)) - output_file_path = os.path.abspath(os.path.join(test_path, output_filename)) - latest_passed_output_file_path = os.path.abspath(os.path.join(test_path, latest_passed_output)) - binary_dir = os.path.abspath(os.path.join(test_path, "../../../bin")) # Set the Built binary directory - dcaspt2 = os.path.join(binary_dir, "dcaspt2") # Set the dcaspt2 binary path - - is_ivo = True - test_command = create_test_command_dcaspt2(dcaspt2, mpi_num_process, omp_num_threads, input_file_path, output_file_path, test_path, save, is_ivo) run_test_dcaspt2(test_command) # DFPCMONEW format @@ -55,7 +33,7 @@ def test_ivo_h2o_6_31g(mpi_num_process: int, omp_num_threads: int, save: bool) - # 1 2 3 2 # Open DFPCMONEW and reference.DFPCMONEW and compare the values (if the values are float, compare the values to 10th decimal places) - with open(DFPCMONEW_file_path, "r") as DFPCMONEW_file, open(ref_DFPCMONEW_file_path, "r") as ref_file: + with open(DFPCMONEW_path, "r") as DFPCMONEW_file, open(ref_DFPCMONEW_path, "r") as ref_file: for DFPCMONEW_line, ref_line in zip(DFPCMONEW_file, ref_file): # if the first value cannot be converted to float, compare the values as strings DFPCMONEW_values = DFPCMONEW_line.split() @@ -70,5 +48,5 @@ def test_ivo_h2o_6_31g(mpi_num_process: int, omp_num_threads: int, save: bool) - # If it reaches this point, the result of assert is true. # The latest passed output file is overwritten by the current output file if assert is True. - shutil.copy(output_file_path, latest_passed_output_file_path) - shutil.copy(DFPCMONEW_file_path, latest_passed_DFPCMONEW_file_path) + shutil.copy(output_path, latest_passed_output_path) + shutil.copy(DFPCMONEW_path, latest_passed_DFPCMONEW_path) diff --git a/test/dev/ivo_c32h_n2_dev_dirac22/.gitignore b/test/dev/ivo_c32h_n2_dev_dirac22/.gitignore new file mode 100644 index 00000000..03c3887d --- /dev/null +++ b/test/dev/ivo_c32h_n2_dev_dirac22/.gitignore @@ -0,0 +1,4 @@ +*DFPCMONEW* +ivo_c32h_n2_dev_dirac*.ivo.out +latest_passed.* +!reference.* diff --git a/test/dev/ivo_n2/input/22/DFPCMO b/test/dev/ivo_c32h_n2_dev_dirac22/DFPCMO similarity index 100% rename from test/dev/ivo_n2/input/22/DFPCMO rename to test/dev/ivo_c32h_n2_dev_dirac22/DFPCMO diff --git a/test/dev/ivo_n2/input/22/MDCINT b/test/dev/ivo_c32h_n2_dev_dirac22/MDCINT similarity index 100% rename from test/dev/ivo_n2/input/22/MDCINT rename to test/dev/ivo_c32h_n2_dev_dirac22/MDCINT diff --git a/test/dev/ivo_n2/input/22/MDCINXXXX1 b/test/dev/ivo_c32h_n2_dev_dirac22/MDCINXXXX1 similarity index 100% rename from test/dev/ivo_n2/input/22/MDCINXXXX1 rename to test/dev/ivo_c32h_n2_dev_dirac22/MDCINXXXX1 diff --git a/test/dev/ivo_n2/input/22/MDCINXXXX2 b/test/dev/ivo_c32h_n2_dev_dirac22/MDCINXXXX2 similarity index 100% rename from test/dev/ivo_n2/input/22/MDCINXXXX2 rename to test/dev/ivo_c32h_n2_dev_dirac22/MDCINXXXX2 diff --git a/test/dev/ivo_n2/input/22/MDCINXXXX3 b/test/dev/ivo_c32h_n2_dev_dirac22/MDCINXXXX3 similarity index 100% rename from test/dev/ivo_n2/input/22/MDCINXXXX3 rename to test/dev/ivo_c32h_n2_dev_dirac22/MDCINXXXX3 diff --git a/test/dev/ivo_n2/input/22/MDCINXXXX4 b/test/dev/ivo_c32h_n2_dev_dirac22/MDCINXXXX4 similarity index 100% rename from test/dev/ivo_n2/input/22/MDCINXXXX4 rename to test/dev/ivo_c32h_n2_dev_dirac22/MDCINXXXX4 diff --git a/test/dev/ivo_n2/input/22/MDCINXXXX5 b/test/dev/ivo_c32h_n2_dev_dirac22/MDCINXXXX5 similarity index 100% rename from test/dev/ivo_n2/input/22/MDCINXXXX5 rename to test/dev/ivo_c32h_n2_dev_dirac22/MDCINXXXX5 diff --git a/test/dev/ivo_n2/input/22/MDCINXXXX6 b/test/dev/ivo_c32h_n2_dev_dirac22/MDCINXXXX6 similarity index 100% rename from test/dev/ivo_n2/input/22/MDCINXXXX6 rename to test/dev/ivo_c32h_n2_dev_dirac22/MDCINXXXX6 diff --git a/test/dev/ivo_n2/input/22/MDCINXXXX7 b/test/dev/ivo_c32h_n2_dev_dirac22/MDCINXXXX7 similarity index 100% rename from test/dev/ivo_n2/input/22/MDCINXXXX7 rename to test/dev/ivo_c32h_n2_dev_dirac22/MDCINXXXX7 diff --git a/test/dev/ivo_n2/input/22/MRCONEE b/test/dev/ivo_c32h_n2_dev_dirac22/MRCONEE similarity index 100% rename from test/dev/ivo_n2/input/22/MRCONEE rename to test/dev/ivo_c32h_n2_dev_dirac22/MRCONEE diff --git a/test/dev/ivo_n2/input/22/active.ivo.inp b/test/dev/ivo_c32h_n2_dev_dirac22/active.ivo.inp similarity index 100% rename from test/dev/ivo_n2/input/22/active.ivo.inp rename to test/dev/ivo_c32h_n2_dev_dirac22/active.ivo.inp diff --git a/test/dev/ivo_c32h_n2_dev_dirac22/dirac_data b/test/dev/ivo_c32h_n2_dev_dirac22/dirac_data new file mode 120000 index 00000000..395118ed --- /dev/null +++ b/test/dev/ivo_c32h_n2_dev_dirac22/dirac_data @@ -0,0 +1 @@ +../ivo_c32h_n2_dev_dirac19/dirac_data \ No newline at end of file diff --git a/test/dev/ivo_n2/DFPCMONEW b/test/dev/ivo_c32h_n2_dev_dirac22/reference.DFPCMONEW similarity index 100% rename from test/dev/ivo_n2/DFPCMONEW rename to test/dev/ivo_c32h_n2_dev_dirac22/reference.DFPCMONEW diff --git a/test/dev/ivo_c32h_n2_dev_dirac22/test_ivo_c32h_n2_dev_dirac22.py b/test/dev/ivo_c32h_n2_dev_dirac22/test_ivo_c32h_n2_dev_dirac22.py new file mode 100644 index 00000000..453a828e --- /dev/null +++ b/test/dev/ivo_c32h_n2_dev_dirac22/test_ivo_c32h_n2_dev_dirac22.py @@ -0,0 +1,52 @@ +import os +import shutil + +import pytest +from module_testing import ( + run_test_dcaspt2, +) + + +@pytest.mark.dev +def test_ivo_c32h_n2_dev_dirac22(env_setup_ivo) -> None: + (test_path, DFPCMONEW_path, ref_DFPCMONEW_path, latest_passed_DFPCMONEW_path, output_path, latest_passed_output_path, test_command) = env_setup_ivo + os.chdir(test_path) # Change directory to the path of this file + run_test_dcaspt2(test_command) + + # DFPCMONEW format + # INFO (DIRAC version >= 21) + # N2 Thu Apr 6 11:00:00 2023 + # 2 15 15 54 15 15 54 + # -0.1075307794799569E+03 + # COEFS (DIRAC version >= 21) + # 0.0783846162631894 -0.0932522358717089 0.2444662687107759 -0.2100050908725506 0.0207980763363816 -0.0061525045832165 + # -0.0001106259309856 -0.0000860939270339 0.0001830653248163 0.0000000555844586 -0.0000000349239622 0.0000000146384444 + # -0.0000000555844586 0.0000000349239622 -0.0000000146384444 -0.4656826540533246 0.2259566676583494 -0.3303017764820634 + # ... + # EVALS (DIRAC version >= 21) + # -0.378466132952E+05 -0.376317160433E+05 -0.375871872904E+05 -0.375847489191E+05 -0.375740444395E+05 -0.375738772125E+05 + # -0.375678183830E+05 -0.375638423228E+05 -0.375612685737E+05 -0.375611284085E+05 -0.375605808599E+05 -0.375591793895E+05 + # -0.375586003412E+05 -0.375585970263E+05 -0.375581434458E+05 -0.155806087301E+02 -0.122487085753E+01 -0.527584459237E+00 + # ... + # SUPERSYM + # 1 1 1 1 -3 1 1 1 -3 1 1 1 -3 1 1 1 1 1 1 -3 1 1 -3 1 1 1 -3 1 1 1 1 1 1 1 1 -3 1 1 1 -3 1 1 1 -3 1 1 1 1 -3 1 1 -3 1 1 1 -3 1 1 1 1 + # 1 2 3 2 + + # Open DFPCMONEW and reference.DFPCMONEW and compare the values (if the values are float, compare the values to 10th decimal places) + with open(DFPCMONEW_path, "r") as DFPCMONEW_file, open(ref_DFPCMONEW_path, "r") as ref_file: + for DFPCMONEW_line, ref_line in zip(DFPCMONEW_file, ref_file): + # if the first value cannot be converted to float, compare the values as strings + DFPCMONEW_values = DFPCMONEW_line.split() + ref_values = ref_line.split() + try: + DFPCMONEW_float_values = [float(value) for value in DFPCMONEW_values] + ref_float_values = [float(value) for value in ref_values] + for DFPCMONEW_float_value, ref_float_value in zip(DFPCMONEW_float_values, ref_float_values): + assert ref_float_value == pytest.approx(DFPCMONEW_float_value, abs=1e-13) + except ValueError: + assert DFPCMONEW_values == ref_values + + # If it reaches this point, the result of assert is true. + # The latest passed output file is overwritten by the current output file if assert is True. + shutil.copy(output_path, latest_passed_output_path) + shutil.copy(DFPCMONEW_path, latest_passed_DFPCMONEW_path) diff --git a/test/dev/ivo_n2/reference.DFPCMONEW.dirac22 b/test/dev/ivo_n2/reference.DFPCMONEW.dirac22 deleted file mode 100644 index a0cae86c..00000000 --- a/test/dev/ivo_n2/reference.DFPCMONEW.dirac22 +++ /dev/null @@ -1,558 +0,0 @@ -INFO -N2 Wed Apr 12 16:50:54 2023 - 2 1 15 15 54 15 15 54 - -0.1075307794860381E+03 -COEFS - 0.0783846162631894 -0.0932522358717089 0.2444662687107759 -0.2100050908725506 0.0207980763363816 -0.0061525045832165 - -0.0001106259309856 -0.0000860939270339 0.0001830653248163 0.0000000555844586 -0.0000000349239622 0.0000000146384444 - -0.0000000555844586 0.0000000349239622 -0.0000000146384444 -0.4656826540533246 0.2259566676583494 -0.3303017764820634 - 0.2560407409432995 -0.0153911789480404 0.0035241831680542 0.0000653181267719 0.0002166303784295 -0.0000538323950596 - -0.4656826540533251 0.2259566676583504 -0.3303017764820698 0.2560407409433058 -0.0153911789480409 0.0035241831680542 - 0.0000653181267721 0.0002166303784295 -0.0000538323950597 -0.0001379058649716 -0.0004319486734709 0.0001080515216575 - -0.4656826540533240 0.2259566676583468 -0.3303017764820440 0.2560407409432802 -0.0153911789480368 0.0035241831680530 - 0.0000012116019045 0.0000012116019046 0.0000665297286768 -0.0000002186805645 -0.0000002186805646 0.0002164116978645 - -0.0000000644552564 -0.0000000644552563 -0.0000538968503160 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0056714689534337 -0.0677063290616104 0.2635940785505467 -0.2309575073976286 0.0228839638903761 -0.0066470151677963 - -0.0001509600829191 -0.0000475973620065 0.0001754610222941 0.0000023550111103 -0.0000014934532280 0.0000007005726900 - -0.0000023550111103 0.0000014934532280 -0.0000007005726900 -0.0951625766443238 0.6736898272378686 -1.3210621498301500 - 1.0279950980300576 -0.0569539606385081 0.0119888691894000 0.0005128390811342 0.0005261184617080 -0.0001743771807494 - -0.0951625766443256 0.6736898272378788 -1.3210621498302240 1.0279950980301309 -0.0569539606385197 0.0119888691894043 - 0.0005128390811345 0.0005261184617076 -0.0001743771807492 -0.0013348615058919 -0.0009821922281215 0.0003205363027680 - -0.0951625766443219 0.6736898272378596 -1.3210621498300810 1.0279950980299872 -0.0569539606384943 0.0119888691893950 - 0.0000515305572702 0.0000515305572704 0.0005643696384054 -0.0000116741158815 -0.0000116741158818 0.0005144443458240 - 0.0000047030097884 0.0000047030097888 -0.0001696741709612 0.0000000000000000 -0.0000000000000001 0.0000000000000001 - -0.0000008822468634 0.0001038463797836 -0.0021227774116806 0.0022276001795508 -0.0001816878702782 0.0002781246949207 - 0.0085741397724195 -0.0049162573616894 0.0021645144522115 -0.0088878884888857 0.0052839216860940 -0.0025122943972189 - 0.0088878884888857 -0.0052839216860940 0.0025122943972189 0.0000676739495768 -0.0010364334066128 0.0159436949074298 - -0.0130671456442422 -0.0028271702282737 0.0002030163277384 0.0029057561771909 0.0003232552874856 0.0010700901381940 - 0.0000676739495768 -0.0010364334066129 0.0159436949074307 -0.0130671456442433 -0.0028271702282736 0.0002030163277384 - 0.0029057561771908 0.0003232552874858 0.0010700901381938 1.1511399849992314 -0.1834181174134959 0.1315913122115030 - 0.0000676739495798 -0.0010364334066246 0.0159436949075061 -0.0130671456443177 -0.0028271702282610 0.0002030163277375 - -0.1928252495589357 -0.1928252495589359 -0.1899194933817442 0.0304619344730880 0.0304619344730882 0.0307851897605718 - -0.0222885820813147 -0.0222885820813147 -0.0212184919431221 -0.0000000000000001 0.0000000000000001 -0.0000000000000002 - 0.0000425333680828 0.0115965074806698 -0.1845157442138665 0.1831746021253046 -0.0236175381278845 0.0069325648465821 - 0.0001865403314135 -0.0000116704476908 -0.0001550684562072 0.0001212603472880 -0.0000743486994082 0.0000356426065608 - -0.0001212603472880 0.0000743486994082 -0.0000356426065608 0.0363678251960112 -0.2609901619578598 2.5322726280815555 - -2.1913811155574878 0.1426829697356705 -0.0280473464502958 -0.0037502736320803 0.0000609129770279 0.0001285790331700 - 0.0363678251960148 -0.2609901619578809 2.5322726280817092 -2.1913811155576419 0.1426829697356947 -0.0280473464503044 - -0.0037502736320811 0.0000609129770288 0.0001285790331693 -0.0083578735253562 0.0029738203111076 -0.0022236866951091 - 0.0363678251960073 -0.2609901619578419 2.5322726280814134 -2.1913811155573444 0.1426829697356418 -0.0280473464502853 - 0.0026430701315871 0.0026430701315867 -0.0011072035004956 -0.0005159410441961 -0.0005159410441954 -0.0004550280671624 - 0.0003277547714618 0.0003277547714610 0.0004563338046317 0.0000000000000001 0.0000000000000000 -0.0000000000000001 - 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0000000000000000 0.0000000000000000 0.0000000000000000 -0.0111508193829558 0.0076203625946878 -0.0036108500020420 - -0.0111508193829558 0.0076203625946878 -0.0036108500020420 -0.0000000000000011 0.0000000000000051 -0.0000000000000330 - 0.0000000000000325 -0.0000000000000053 0.0000000000000019 0.2464325953761997 -0.0786001193024347 0.0240777663982773 - 0.0000000000000013 -0.0000000000000057 0.0000000000000386 -0.0000000000000381 0.0000000000000062 -0.0000000000000022 - -0.2464325953761999 0.0786001193024349 -0.0240777663982773 -0.0000000000000002 0.0000000000000003 -0.0000000000000001 - -0.0000000000000001 0.0000000000000005 -0.0000000000000032 0.0000000000000033 -0.0000000000000006 0.0000000000000003 - -0.2464325953761996 0.2464325953761997 0.0000000000000001 0.0786001193024346 -0.0786001193024347 0.0000000000000000 - -0.0240777663982772 0.0240777663982771 0.0000000000000001 -0.4928651907523995 0.1572002386048695 -0.0481555327965547 - -0.0000047030611551 -0.0000491744739782 0.0003293860238986 -0.0001185487784934 0.0001484724492898 0.0003353444919636 - 0.0125934810336912 -0.0082449563816339 0.0036114046269672 0.0063985610694128 -0.0043982382559582 0.0020837342615528 - -0.0063985610694128 0.0043982382559582 -0.0020837342615529 -0.0005358359562800 0.0031238545993019 -0.0222659375166693 - 0.0188517676163862 -0.0046776155245132 -0.0021455021308012 -0.4258190253697903 0.1344820883585566 -0.0391299851745362 - -0.0005358359562797 0.0031238545993012 -0.0222659375166633 0.0188517676163802 -0.0046776155245120 -0.0021455021308017 - -0.4258190253697905 0.1344820883585570 -0.0391299851745364 0.0024867543053556 0.0078806723614666 -0.0040016157403101 - -0.0005358359562788 0.0031238545992975 -0.0222659375166373 0.0188517676163537 -0.0046776155245069 -0.0021455021308031 - 0.1415252160723706 0.1415252160723705 -0.2842938092974190 -0.0461408081797626 -0.0461408081797625 0.0883412801787919 - 0.0137102643482305 0.0137102643482303 -0.0254197208263058 0.0000000000000001 -0.0000000000000001 0.0000000000000001 - 0.0001775166894317 0.0007498681478107 -0.0546212425330281 0.0721302245785478 -0.0215396607222913 0.0071582364222569 - 0.0000856430951177 0.0000633469899687 -0.0002094025899188 -0.0000094021651537 -0.0000105488051027 0.0000099476908772 - 0.0000094021651537 0.0000105488051027 -0.0000099476908772 0.0260581608265483 -0.1510976214337246 2.0463534303884128 - -2.4119808388376520 0.3301742007092254 -0.0680714352050822 0.0017230828591900 -0.0030314668366921 0.0016531973649603 - 0.0260581608265520 -0.1510976214337457 2.0463534303885664 -2.4119808388378057 0.3301742007092500 -0.0680714352050913 - 0.0017230828591891 -0.0030314668366912 0.0016531973649599 -0.0028606622158504 0.0106127518049517 -0.0059062795339600 - 0.0260581608265447 -0.1510976214337077 2.0463534303882800 -2.4119808388375170 0.3301742007091979 -0.0680714352050732 - -0.0000975839170873 -0.0000975839170876 0.0016254989421002 -0.0007583030219300 -0.0007583030219294 -0.0037897698586164 - 0.0004333141340068 0.0004333141340060 0.0020865114989672 0.0000000000000000 0.0000000000000001 -0.0000000000000001 - -0.0000033744899298 0.0000052829050988 -0.0000864958110038 0.0001387118266195 0.0000978087920069 0.0002842232543741 - 0.0021297601585085 -0.0056630257935259 0.0028051848198451 -0.0021655715749877 0.0062816693176158 -0.0033982418365988 - 0.0021655715749877 -0.0062816693176158 0.0033982418365988 -0.0002561678776207 0.0013906161589617 -0.0124646794959631 - 0.0128355565030910 -0.0011926617920694 -0.0127073734376735 -0.0012236333527040 -0.0134391149952977 0.0095406549219818 - -0.0002561678776207 0.0013906161589618 -0.0124646794959639 0.0128355565030918 -0.0011926617920696 -0.0127073734376734 - -0.0012236333527040 -0.0134391149952976 0.0095406549219817 0.4404719316838236 -1.3121465623831694 0.1842281350840674 - -0.0002561678776177 0.0013906161589462 -0.0124646794958530 0.0128355565029813 -0.0011926617920520 -0.0127073734376723 - -0.0730041108297360 -0.0730041108297362 -0.0742277441824396 0.2231707987289612 0.2231707987289614 0.2097316837336620 - -0.0338849074880038 -0.0338849074880043 -0.0243442525660257 -0.0000000000000002 0.0000000000000002 -0.0000000000000003 - 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0007240594329278 -0.0066298649625747 0.0043504266191480 - 0.0007240594329278 -0.0066298649625747 0.0043504266191480 0.0000000000000019 -0.0000000000000086 0.0000000000000592 - -0.0000000000000585 0.0000000000000089 -0.0000000000000028 -0.0522514937689750 0.2880613227713542 -0.1067561120769895 - -0.0000000000000019 0.0000000000000088 -0.0000000000000613 0.0000000000000606 -0.0000000000000093 0.0000000000000030 - 0.0522514937689753 -0.2880613227713549 0.1067561120769899 0.0000000000000003 -0.0000000000000003 0.0000000000000004 - 0.0000000000000001 -0.0000000000000006 0.0000000000000029 -0.0000000000000026 0.0000000000000001 -0.0000000000000002 - 0.0522514937689751 -0.0522514937689752 -0.0000000000000001 -0.2880613227713542 0.2880613227713543 0.0000000000000000 - 0.1067561120769894 -0.1067561120769896 0.0000000000000001 0.1045029875379503 -0.5761226455427094 0.2135122241539800 - 0.0000411256294083 -0.0000848650690439 -0.0006196875024699 0.0012111697318492 -0.0020910103885540 0.0004857043883088 - -0.0008244310352286 0.0078634037287947 -0.0048545612696026 -0.0003689308863819 0.0035382259841596 -0.0023484787452761 - 0.0003689308863819 -0.0035382259841596 0.0023484787452761 0.0027747522909490 -0.0155765956407611 0.1821884410096629 - -0.2153355089573471 0.1188594038092479 -0.0152884327824667 0.0991651782930444 -0.5254027843261186 0.1856619350637788 - 0.0027747522909494 -0.0155765956407626 0.1821884410096724 -0.2153355089573569 0.1188594038092495 -0.0152884327824672 - 0.0991651782930447 -0.5254027843261193 0.1856619350637792 -0.0320131776147519 0.1220605760547031 -0.0136581189981920 - 0.0027747522909478 -0.0155765956407542 0.1821884410096081 -0.2153355089572915 0.1188594038092367 -0.0152884327824628 - -0.0277195298285559 -0.0277195298285559 0.0714456484644878 0.1547908320995883 0.1547908320995882 -0.3706119522265283 - -0.0596109585215610 -0.0596109585215608 0.1260509765422179 -0.0000000000000001 0.0000000000000002 -0.0000000000000002 - 0.0002103705335007 -0.0004080895495120 -0.0036293163357801 0.0073590820157761 -0.0122306184897935 0.0065739193283655 - 0.0000830084919747 -0.0002631501317523 -0.0001607568640502 0.0000334738597726 -0.0005966058375578 0.0004903147661713 - -0.0000334738597726 0.0005966058375578 -0.0004903147661713 0.0139237985383472 -0.0787083254491710 0.9410934132857268 - -1.1302853625095504 0.7260980757354127 -0.2162617920682146 -0.0037899430900093 0.0321602527457461 -0.0074117753324977 - 0.0139237985383491 -0.0787083254491817 0.9410934132858008 -1.1302853625096236 0.7260980757354250 -0.2162617920682193 - -0.0037899430900095 0.0321602527457465 -0.0074117753324981 -0.0206828556322496 0.1105390156947754 -0.1021027714139119 - 0.0139237985383456 -0.0787083254491611 0.9410934132856436 -1.1302853625094649 0.7260980757353955 -0.2162617920682093 - 0.0047104569687116 0.0047104569687114 0.0009205138787018 -0.0291432535310453 -0.0291432535310453 0.0030169992147029 - 0.0194877203464845 0.0194877203464843 0.0120759450139871 0.0000000000000001 -0.0000000000000001 0.0000000000000000 - -0.0000063128508172 0.0000048501331519 0.0002791841542324 -0.0004753513504692 0.0005438671968770 -0.0008277590460059 - 0.0002236999279153 0.0017863370645282 -0.0029084810443927 -0.0001983209047545 -0.0016267615107790 0.0032118026266594 - 0.0001983209047545 0.0016267615107790 -0.0032118026266594 -0.0004384965118108 0.0025379368316979 -0.0320271510449027 - 0.0396298892319249 -0.0341806533019354 0.0366705252409584 0.0057507781972518 -0.0252688395638055 -0.0158489198592711 - -0.0004384965118107 0.0025379368316983 -0.0320271510449065 0.0396298892319288 -0.0341806533019361 0.0366705252409587 - 0.0057507781972519 -0.0252688395638054 -0.0158489198592712 -0.1248169144611549 0.8547891712677921 -1.4194098087415421 - -0.0004384965118119 0.0025379368317039 -0.0320271510449474 0.0396298892319715 -0.0341806533019439 0.0366705252409488 - 0.0188858930111085 0.0188858930111087 0.0246366712083602 -0.1340419153566972 -0.1340419153566976 -0.1593107549205014 - 0.2418512747433453 0.2418512747433458 0.2260023548840800 0.0000000000000002 -0.0000000000000001 0.0000000000000000 - 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0000000000000000 0.0000000000000000 0.0000000000000000 -0.0000710916423486 -0.0005833099466619 0.0032414333617541 - -0.0000710916423486 -0.0005833099466619 0.0032414333617541 0.0000000000000006 -0.0000000000000032 0.0000000000000224 - -0.0000000000000222 0.0000000000000033 -0.0000000000000009 -0.0196012344671512 0.1021235107689950 -0.2983825072569462 - -0.0000000000000006 0.0000000000000028 -0.0000000000000198 0.0000000000000194 -0.0000000000000029 0.0000000000000008 - 0.0196012344671514 -0.1021235107689955 0.2983825072569465 -0.0000000000000002 -0.0000000000000006 0.0000000000000006 - 0.0000000000000003 -0.0000000000000014 0.0000000000000095 -0.0000000000000094 0.0000000000000013 -0.0000000000000006 - 0.0196012344671513 -0.0196012344671512 0.0000000000000000 -0.1021235107689947 0.1021235107689948 0.0000000000000002 - 0.2983825072569456 -0.2983825072569458 -0.0000000000000001 0.0392024689343029 -0.2042470215379912 0.5967650145138934 - 0.0000053138254523 -0.0000191923227479 0.0001138890480628 -0.0001343209682008 0.0000066112926821 -0.0004877391600971 - 0.0000736506273188 0.0007661602109050 -0.0026510649456558 0.0000492574889128 0.0003018968245902 -0.0020452662630207 - -0.0000492574889128 -0.0003018968245902 0.0020452662630207 0.0003365280629036 -0.0018247840746155 0.0196408936399586 - -0.0220234963181250 0.0052163913082524 0.0140285072941430 0.0358995468815193 -0.1818157866420866 0.4414090065210725 - 0.0003365280629038 -0.0018247840746156 0.0196408936399588 -0.0220234963181255 0.0052163913082525 0.0140285072941430 - 0.0358995468815197 -0.1818157866420872 0.4414090065210730 0.0011990963689946 -0.0121299609605943 0.2668741736756475 - 0.0003365280629037 -0.0018247840746161 0.0196408936399606 -0.0220234963181263 0.0052163913082520 0.0140285072941441 - -0.0121663650220056 -0.0121663650220054 0.0237331818595136 0.0626269223741275 0.0626269223741273 -0.1191888642679577 - -0.1916153644529650 -0.1916153644529650 0.2497936420681061 -0.0000000000000001 0.0000000000000002 0.0000000000000000 - 0.0001229922475348 -0.0004478108602091 0.0027970647541753 -0.0027940399448149 -0.0004072022179193 0.0023177488633748 - -0.0000274518072379 0.0000285711702258 0.0005381184038408 0.0000019181423945 -0.0000844487928720 0.0000996568890369 - -0.0000019181423945 0.0000844487928720 -0.0000996568890369 0.0072239332338056 -0.0394248513540785 0.4401546872697008 - -0.5111778180797980 0.3394649488132716 -0.5568139253675615 -0.0043441329573080 0.0261792906850895 -0.0860628805235642 - 0.0072239332338068 -0.0394248513540845 0.4401546872697401 -0.5111778180798378 0.3394649488132785 -0.5568139253675641 - -0.0043441329573081 0.0261792906850894 -0.0860628805235644 0.0038930108124898 -0.0225581567373864 0.1372596119688968 - 0.0072239332338083 -0.0394248513540819 0.4401546872697138 -0.5111778180798092 0.3394649488132712 -0.5568139253675578 - 0.0007992091836877 0.0007992091836876 -0.0035449237736202 -0.0049667374387990 -0.0049667374387988 0.0212125532462910 - 0.0058110248463724 0.0058110248463722 -0.0802518556771930 0.0000000000000000 0.0000000000000000 0.0000000000000000 - -0.1084838368898102 -0.3642921383545447 -0.3397247479353747 0.0211876156669093 -0.0227304386853281 0.0044385464206430 - 0.0015880786317096 -0.0000354521826654 0.0000507028921872 -0.0000001226380969 -0.0000002583963069 0.0000000387705860 - 0.0000001226380969 0.0000002583963069 -0.0000000387705860 -0.0039328018168815 -0.0056479772031507 -0.0027386977503975 - 0.0001486502492903 -0.0000775929734296 0.0000086048507418 0.0000112627305255 -0.0000001248826410 0.0000000981532363 - -0.0039328018168815 -0.0056479772031507 -0.0027386977503975 0.0001486502492903 -0.0000775929734296 0.0000086048507418 - 0.0000112627305255 -0.0000001248826410 0.0000000981532363 -0.0000225422944289 0.0000002409970849 -0.0000001975745276 - -0.0039328018168815 -0.0056479772031507 -0.0027386977503973 0.0001486502492902 -0.0000775929734296 0.0000086048507418 - 0.0000000028055630 0.0000000028055630 0.0000112655360885 0.0000000014613662 0.0000000014613662 -0.0000001234212748 - 0.0000000002113425 0.0000000002113425 0.0000000983645788 0.0000000000000000 0.0000000000000000 0.0000000000000000 - -0.0235283706219973 -0.0953074264291322 -0.1492805558123920 0.0160785916923575 0.2660318770895667 0.3977327913899718 - -0.0313903746104130 -0.0973082095577798 -0.0482640482334325 0.0000675617039021 0.0001294398874875 0.0000760269747036 - -0.0000675617039021 -0.0001294398874875 -0.0000760269747036 -0.0008525757799569 -0.0014770378130938 -0.0012033817883491 - 0.0001136039121496 0.0009098062657884 0.0007757015762001 -0.0002221814100115 -0.0003323413205622 -0.0000939804471921 - -0.0008525757799569 -0.0014770378130938 -0.0012033817883491 0.0001136039121496 0.0009098062657884 0.0007757015762001 - -0.0002221814100115 -0.0003323413205622 -0.0000939804471921 0.0004469363961081 0.0006672802967936 0.0001887979868285 - -0.0008525757799569 -0.0014770378130938 -0.0012033817883492 0.0001136039121497 0.0009098062657884 0.0007757015762001 - -0.0000004289293475 -0.0000004289293475 -0.0002226103393590 -0.0000004329426115 -0.0000004329426115 -0.0003327742631738 - -0.0000001395154074 -0.0000001395154074 -0.0000941199625995 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0078237078916307 0.0299437634446543 0.0850476243115945 -0.0502560440113957 -0.0621480438304703 -0.2499395150898524 - -0.1294144337388328 -0.3186022458291009 -0.2904557902007915 0.0005566569013192 0.0011815672448617 0.0011167568248840 - -0.0005566569013192 -0.0011815672448617 -0.0011167568248840 0.0002835002460590 0.0004640400274620 0.0006857021389168 - -0.0003563701225669 -0.0002125281834826 -0.0004874628357875 -0.0009140026867385 -0.0010855372211852 -0.0005642917736052 - 0.0002835002460590 0.0004640400274620 0.0006857021389169 -0.0003563701225670 -0.0002125281834826 -0.0004874628357875 - -0.0009140026867385 -0.0010855372211852 -0.0005642917736052 0.0018506057737507 0.0021951368545102 0.0011414491949540 - 0.0002835002460590 0.0004640400274620 0.0006857021389168 -0.0003563701225669 -0.0002125281834826 -0.0004874628357875 - -0.0000037667333789 -0.0000037667333789 -0.0009177694201175 -0.0000040104020233 -0.0000040104020233 -0.0010895476232085 - -0.0000021442746239 -0.0000021442746239 -0.0005664360482291 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0000256558044045 0.0000960577922155 0.0003245004560738 -0.0002202267375403 -0.0002068354078599 -0.0009582274955978 - -0.0004469932903075 -0.0013153057268474 -0.0015257749487937 -0.1077307372213938 -0.2490977425535095 -0.2896584536596488 - 0.1077307372213939 0.2490977425535094 0.2896584536596488 0.0000009293280213 0.0000014906357048 0.0000025978495972 - -0.0000015437179638 -0.0000007213088681 -0.0000018594426184 -0.0007673148097015 -0.0008563668940959 -0.0005678906893158 - 0.0000009293280213 0.0000014906357048 0.0000025978495972 -0.0000015437179638 -0.0000007213088681 -0.0000018594426184 - -0.0007673148097015 -0.0008563668940959 -0.0005678906893158 -0.0030484904281363 -0.0033982502696037 -0.0022533947546412 - 0.0000009293280213 0.0000014906357048 0.0000025978495972 -0.0000015437179638 -0.0000007213088681 -0.0000018594426184 - 0.0007638533412565 0.0007638533412565 -0.0000034614684449 0.0008518306762992 0.0008518306762992 -0.0000045362177967 - 0.0005648626888788 0.0005648626888788 -0.0000030280004370 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0000000000000000 0.0000000000000000 0.0000000000000000 -0.1076284916174815 -0.2490329835952191 -0.2898328321476025 - -0.1076284916174816 -0.2490329835952186 -0.2898328321476032 0.0000000000000000 -0.0000000000000000 -0.0000000000000001 - 0.0000000000000001 0.0000000000000000 0.0000000000000000 -0.0007634166878056 -0.0008516525247491 -0.0005652541968557 - 0.0000000000000000 0.0000000000000000 0.0000000000000001 -0.0000000000000001 -0.0000000000000000 0.0000000000000000 - 0.0007634166878056 0.0008516525247491 0.0005652541968557 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0000000000000000 0.0000000000000000 0.0000000000000000 -0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0007634166878056 -0.0007634166878056 0.0000000000000000 0.0008516525247491 -0.0008516525247491 0.0000000000000000 - 0.0005652541968557 -0.0005652541968557 0.0000000000000000 0.0015268333756112 0.0017033050494982 0.0011305083937116 - -0.0166034645212376 -0.0882670807633390 0.1771294453728916 -0.3845172265567476 0.9087920263886712 -0.8019849831017072 - 0.0932018497015106 0.6053542952563931 -0.7069414443380205 -0.0036739054781501 -0.0209242273611690 0.0303673324354780 - 0.0036739054781501 0.0209242273611690 -0.0303673324354780 -0.0006015266586750 -0.0013678978683661 0.0014288329977066 - -0.0027280940810392 0.0031077995452735 -0.0015640528399419 0.0006349771300166 0.0019986048224778 -0.0013194856464329 - -0.0006015266586750 -0.0013678978683661 0.0014288329977068 -0.0027280940810394 0.0031077995452735 -0.0015640528399419 - 0.0006349771300166 0.0019986048224778 -0.0013194856464329 -0.0014253592323127 -0.0044264159687954 0.0029944605173478 - -0.0006015266586750 -0.0013678978683661 0.0014288329977067 -0.0027280940810393 0.0031077995452735 -0.0015640528399418 - 0.0000259008287133 0.0000259008287133 0.0006608779587299 0.0000715343873067 0.0000715343873067 0.0020701392097844 - -0.0000592482040803 -0.0000592482040803 -0.0013787338505132 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0007240400009793 0.0038752330147901 -0.0081330347809847 0.0173269759866457 -0.0402323657965959 0.0342861808904679 - -0.0034204012003535 -0.0224514961876046 0.0262047666013163 -0.0913109490022182 -0.5287131428177879 0.7622884786443552 - 0.0913109490022180 0.5287131428177883 -0.7622884786443556 0.0000262309234851 0.0000600569073326 -0.0000656163752159 - 0.0001229417758974 -0.0001375926804295 0.0000668745771050 -0.0006718912293805 -0.0018848352616223 0.0015377522104477 - 0.0000262309234851 0.0000600569073326 -0.0000656163752159 0.0001229417758974 -0.0001375926804295 0.0000668745771050 - -0.0006718912293805 -0.0018848352616223 0.0015377522104477 -0.0025403879641685 -0.0070784989466841 0.0058446239617348 - 0.0000262309234851 0.0000600569073326 -0.0000656163752157 0.0001229417758972 -0.0001375926804295 0.0000668745771051 - 0.0006473617371549 0.0006473617371549 -0.0000245294922255 0.0018080282449881 0.0018080282449881 -0.0000768070166342 - -0.0014866880637717 -0.0014866880637717 0.0000510641466760 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0913239420030021 0.5292963539809026 -0.7628657145670207 - 0.0913239420030020 0.5292963539809032 -0.7628657145670218 0.0000000000000000 0.0000000000000000 0.0000000000000003 - -0.0000000000000003 -0.0000000000000000 0.0000000000000000 0.0006477225281381 0.0018100553648581 -0.0014877731826275 - 0.0000000000000000 -0.0000000000000000 -0.0000000000000003 0.0000000000000003 0.0000000000000000 0.0000000000000000 - -0.0006477225281381 -0.0018100553648581 0.0014877731826275 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0000000000000000 0.0000000000000000 -0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 - -0.0006477225281381 0.0006477225281381 0.0000000000000000 -0.0018100553648581 0.0018100553648581 0.0000000000000000 - 0.0014877731826275 -0.0014877731826275 0.0000000000000000 -0.0012954450562761 -0.0036201107297163 0.0029755463652550 - -0.0193452337221978 -0.1117234487869279 0.3456522097479031 -0.6378368888720256 1.2612862717088051 -0.7423627027769710 - -0.0614553902009616 -0.5755910006124814 0.5929848631406924 -0.0002708863170225 -0.0018073961761285 0.0024298173606702 - 0.0002708863170225 0.0018073961761285 -0.0024298173606702 -0.0007008246780767 -0.0017314162947743 0.0027878920679519 - -0.0045251385577366 0.0043132045098705 -0.0014477699160757 -0.0004377827949246 -0.0019745358214450 0.0011611949530427 - -0.0007008246780767 -0.0017314162947743 0.0027878920679523 -0.0045251385577369 0.0043132045098706 -0.0014477699160757 - -0.0004377827949246 -0.0019745358214450 0.0011611949530427 0.0008633646567070 0.0039119076185856 -0.0022940527496364 - -0.0007008246780767 -0.0017314162947742 0.0027878920679514 -0.0045251385577360 0.0043132045098704 -0.0014477699160757 - 0.0000020334888570 0.0000020334888570 -0.0004357493060676 0.0000061940040507 0.0000061940040507 -0.0019683418173943 - -0.0000047228594082 -0.0000047228594082 0.0011564720936345 0.0000000000000000 0.0000000000000000 0.0000000000000000 - -0.0068519854145428 -0.0059589975731344 -0.4702426494860152 0.5691391907062969 -0.1752538597470879 0.0143698986789712 - -0.8531435957755391 0.8681233329041352 -0.4246851597718463 0.0026801418161492 -0.0029454451113741 0.0015650541603540 - -0.0026801418161492 0.0029454451113741 -0.0015650541603540 -0.0002483303436871 -0.0000922991106685 -0.0037914014575178 - 0.0040365244971755 -0.0005991672961733 0.0000280142576496 -0.0060318148566571 0.0029580811358822 -0.0008250039253874 - -0.0002483303436871 -0.0000922991106685 -0.0037914014575180 0.0040365244971757 -0.0005991672961734 0.0000280142576496 - -0.0060318148566571 0.0029580811358822 -0.0008250039253874 0.0121742712859178 -0.0059764137471351 0.0016678221783004 - -0.0002483303436871 -0.0000922991106688 -0.0037914014575160 0.0040365244971737 -0.0005991672961730 0.0000280142576495 - -0.0000184402621006 -0.0000184402621006 -0.0060502551187577 0.0000100419125618 0.0000100419125618 0.0029681230484439 - -0.0000029690545876 -0.0000029690545876 -0.0008279729799750 0.0000000000000000 0.0000000000000000 0.0000000000000000 - -0.0000349431275849 -0.0000308224093959 -0.0024304591421372 0.0029514136018238 -0.0008900652273520 0.0001162414316849 - -0.0038048437937904 0.0037082431649179 -0.0017925244426868 -0.6104278001511489 0.6395904124244123 -0.3357974478606299 - 0.6104278001511494 -0.6395904124244126 0.3357974478606304 -0.0000012671848488 -0.0000004721135640 -0.0000196522775416 - 0.0000209877873578 -0.0000030651952967 0.0000002323675627 -0.0043563436955759 0.0021994837257708 -0.0006582315918186 - -0.0000012671848488 -0.0000004721135640 -0.0000196522775415 0.0000209877873577 -0.0000030651952967 0.0000002323675627 - -0.0043563436955759 0.0021994837257708 -0.0006582315918186 -0.0172587015036445 0.0087215014788812 -0.0026112841403551 - -0.0000012671848488 -0.0000004721135638 -0.0000196522775427 0.0000209877873589 -0.0000030651952969 0.0000002323675627 - 0.0043285648157994 0.0043285648157994 -0.0000277788797765 -0.0021867448217371 -0.0021867448217371 0.0000127389040337 - 0.0006546245539987 0.0006546245539987 -0.0000036070378199 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.6104611091421734 -0.6394859457408230 0.3357235157682754 - 0.6104611091421742 -0.6394859457408237 0.3357235157682760 0.0000000000000000 0.0000000000000001 -0.0000000000000007 - 0.0000000000000007 -0.0000000000000001 0.0000000000000000 0.0043295912931241 -0.0021864334541976 0.0006545936194897 - 0.0000000000000000 -0.0000000000000001 0.0000000000000008 -0.0000000000000008 0.0000000000000001 0.0000000000000000 - -0.0043295912931241 0.0021864334541976 -0.0006545936194897 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0000000000000000 0.0000000000000000 -0.0000000000000001 0.0000000000000001 0.0000000000000000 0.0000000000000000 - -0.0043295912931241 0.0043295912931241 0.0000000000000000 0.0021864334541976 -0.0021864334541976 0.0000000000000000 - -0.0006545936194897 0.0006545936194897 0.0000000000000000 -0.0086591825862482 0.0043728669083951 -0.0013091872389795 - -0.0704385597532877 -0.0789707599906753 -5.1136824469342725 6.3052033548807476 -1.6541178863430166 0.5630198818344012 - 0.0768430103965699 -0.0638753118470607 0.0170689961558608 0.0000438131395897 -0.0000390120599196 0.0000175544931702 - -0.0000438131395897 0.0000390120599196 -0.0000175544931702 -0.0025526256999707 -0.0012230547067523 -0.0412291170897932 - 0.0447178712865903 -0.0056552643522551 0.0010977219388550 0.0005452871994979 -0.0002185199398570 0.0000333097206387 - -0.0025526256999707 -0.0012230547067519 -0.0412291170897961 0.0447178712865931 -0.0056552643522556 0.0010977219388552 - 0.0005452871994979 -0.0002185199398570 0.0000333097206387 -0.0010884196421187 0.0004362371622755 -0.0000663793469431 - -0.0025526256999706 -0.0012230547067526 -0.0412291170897908 0.0447178712865878 -0.0056552643522546 0.0010977219388548 - -0.0000003591261462 -0.0000003591261462 0.0005449280733517 0.0000001337862398 0.0000001337862398 -0.0002183861536173 - -0.0000000400157224 -0.0000000400157223 0.0000332697049164 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0741599944803362 1.3978487517374534 -8.9436820669748744 8.2911891565299527 -0.9287722738240671 0.2694776504376637 - 0.0073082824774061 -0.0002844472479489 -0.0060694517403748 -0.0000000274338534 -0.0000000467502302 -0.0000000952057250 - 0.0000000274338534 0.0000000467502302 0.0000000952057250 0.0026814561737036 0.0216481234901720 -0.0720604858586357 - 0.0587637873065560 -0.0031730054863639 0.0005249226174789 0.0000517981964965 -0.0000009847015644 -0.0000118306373209 - 0.0026814561737035 0.0216481234901726 -0.0720604858586400 0.0587637873065603 -0.0031730054863646 0.0005249226174792 - 0.0000517981964966 -0.0000009847015644 -0.0000118306373209 -0.0001035919455330 0.0000019682979960 0.0000236599138856 - 0.0026814561737037 0.0216481234901715 -0.0720604858586319 0.0587637873065521 -0.0031730054863631 0.0005249226174787 - -0.0000000007412434 -0.0000000007412433 0.0000517974552532 0.0000000001841889 0.0000000001841888 -0.0000009845173757 - 0.0000000002267927 0.0000000002267927 -0.0000118304105282 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 1.0006930052999983 -1.5463404069273043 4.3361041072737363 -3.7330600670761855 0.3671480155624736 -0.1079801020290156 - -0.0020146273771078 -0.0013099693829723 0.0031092945508317 -0.0000000196868898 0.0000000169103422 0.0000000017218082 - 0.0000000196868898 -0.0000000169103422 -0.0000000017218082 0.0361540516582569 -0.0238553453981584 0.0347886454159848 - -0.0263420137813458 0.0012468856443889 -0.0002085437611646 -0.0000142594125200 -0.0000043507769594 0.0000060365509331 - 0.0361540516582569 -0.0238553453981586 0.0347886454159858 -0.0263420137813468 0.0012468856443890 -0.0002085437611646 - -0.0000142594125200 -0.0000043507769594 0.0000060365509331 0.0000285077952640 0.0000087043699329 -0.0000120743491299 - 0.0361540516582568 -0.0238553453981581 0.0347886454159829 -0.0263420137813438 0.0012468856443886 -0.0002085437611645 - 0.0000000018382961 0.0000000018382961 -0.0000142575742241 -0.0000000004693357 -0.0000000004693357 -0.0000043512462950 - 0.0000000002078773 0.0000000002078772 0.0000060367588104 0.0000000000000000 0.0000000000000000 0.0000000000000000 - -0.0000001429405998 0.0000000856360311 -0.0000000321672142 -0.0000001429405998 0.0000000856360311 -0.0000000321672142 - -0.0785116082656044 0.0939989066390638 -0.2515509924291106 0.2177569183854546 -0.0238566890267389 0.0116876737309044 - -0.0003890186349582 0.0009860091746814 -0.0036047549429252 0.0007718414859873 -0.0010181101074962 0.0032784315815541 - -0.4658784260145035 0.2273090745234693 -0.3374894893797584 0.2629783957711058 -0.0169350468810636 0.0057542286147251 - -0.0000031668953575 -0.0000031668953576 -0.0003795869522785 0.0000006448633145 0.0000006448633143 0.0005077653271194 - -0.0000003438020320 -0.0000003438020319 -0.0016385281867132 0.0000000000000001 0.0000000000000000 0.0000000000000000 - 0.4658784260145050 -0.2273090745234731 0.3374894893797812 -0.2629783957711285 0.0169350468810678 -0.0057542286147273 - 0.0003764200569210 -0.0005071204638050 0.0016381843846821 -0.4658784260145053 0.2273090745234750 -0.3374894893797933 - 0.2629783957711402 -0.0169350468810693 0.0057542286147283 -0.0003764200569208 0.0005071204638051 -0.0016381843846828 - 0.0000041560612050 -0.0000023220690797 0.0000008652997986 0.0000041560612050 -0.0000023220690797 0.0000008652997986 - 0.0057006907800047 -0.0683731762079494 0.2718958177491118 -0.2401525769503574 0.0263965430693880 -0.0126835955318890 - 0.0004842222279779 -0.0011364462507536 0.0039069143687038 -0.0041566696195021 0.0043984380648970 -0.0117379746862105 - 0.0949826891882677 -0.6761329688606753 1.3505274083035530 -1.0576487279970810 0.0634261398491185 -0.0201905207835347 - 0.0000907039271402 0.0000907039271406 0.0018969269554702 -0.0000114066354303 -0.0000114066354301 -0.0021764057615881 - 0.0000099615430340 0.0000099615430339 0.0058490642570374 0.0000000000000000 -0.0000000000000001 0.0000000000000000 - -0.0949826891882698 0.6761329688606809 -1.3505274083035852 1.0576487279971116 -0.0634261398491235 0.0201905207835373 - -0.0018062230283297 0.0021649991261581 -0.0058391027140041 0.0949826891882708 -0.6761329688606844 1.3505274083036065 - -1.0576487279971325 0.0634261398491263 -0.0201905207835399 0.0018062230283307 -0.0021649991261586 0.0058391027140059 - 0.0086770751716164 -0.0049854515144350 0.0018574582942244 0.0086770751716164 -0.0049854515144350 0.0018574582942244 - 0.0000013070374100 -0.0009205416242325 0.0161851092991077 -0.0167547955978149 0.0032821706702153 -0.0030476956023621 - 0.0092543022583611 -0.0059353189916850 0.0037695275481119 -1.1510569096260836 0.1847648560708200 -0.1372744991393867 - 0.0023291905698998 -0.0179452370424720 0.1963021157364677 -0.1765635142853269 0.0159881211053321 -0.0110633763733226 - 0.1898184049769915 0.1898184049769918 0.1958916448590586 -0.0294304207293197 -0.0294304207293196 -0.0335215865767707 - 0.0198712416924270 0.0198712416924272 0.0288947661848391 -0.0000000000000001 0.0000000000000000 0.0000000000000000 - -0.0023291905699043 0.0179452370424891 -0.1963021157365728 0.1765635142854290 -0.0159881211053482 0.0110633763733300 - -0.0060732398820669 0.0040911658474510 -0.0090235244924145 0.0023291905699044 -0.0179452370424896 0.1963021157365760 - -0.1765635142854321 0.0159881211053487 -0.0110633763733304 0.0060732398820669 -0.0040911658474510 0.0090235244924148 - 0.0007257327559776 -0.0004177086075429 0.0001553320950945 0.0007257327559776 -0.0004177086075429 0.0001553320950945 - 0.0000347811009371 0.0117557829673132 -0.1903689131415723 0.1904301094392731 -0.0272252043639802 0.0131570838838050 - -0.0000322259509877 0.0009671734256673 -0.0039316597804766 -0.0784849610424221 0.0006314309568097 0.0184483594837918 - -0.0357924401891530 0.2593327768114971 -2.5645170141616735 2.2352379887426261 -0.1590905495452259 0.0480825042657092 - 0.0158754560637891 0.0158754560637886 0.0074915683936334 -0.0024787700468984 -0.0024787700468988 0.0046418246153924 - 0.0016164500630069 0.0016164500630073 -0.0124570798679100 -0.0000000000000001 0.0000000000000002 -0.0000000000000001 - 0.0357924401891561 -0.2593327768115062 2.5645170141617264 -2.2352379887426772 0.1590905495452351 -0.0480825042657143 - 0.0083838876701558 -0.0071205946622922 0.0140735299309184 -0.0357924401891582 0.2593327768115127 -2.5645170141617672 - 2.2352379887427158 -0.1590905495452413 0.0480825042657190 -0.0083838876701572 0.0071205946622927 -0.0140735299309210 - -0.0064381705263251 0.0042200241932842 -0.0015683508098371 -0.0064381705263251 0.0042200241932842 -0.0015683508098371 - 0.0000065171451831 -0.0000003600077988 0.0029426599009389 -0.0045035872953351 0.0026276647642467 -0.0037276611590241 - 0.0131812432417278 -0.0096806188137088 0.0058103907538664 0.0040046707723464 0.0225994390933706 -0.0307926873911205 - 0.0000727095472913 -0.0006987550074483 0.0542180138682812 -0.0807693466260488 0.0231480981437223 -0.0215287318279808 - -0.1432877014463810 -0.1432877014463810 0.2845730675065888 0.0431242304075358 0.0431242304075359 -0.0975481803617570 - -0.0109097323341247 -0.0109097323341249 0.0372158083638099 0.0000000000000000 0.0000000000000000 0.0000000000000000 - -0.0000727095472927 0.0006987550074521 -0.0542180138683074 0.0807693466260749 -0.0231480981437271 0.0215287318279819 - -0.4278607689529703 0.1406724107692927 -0.0481255406979348 0.0000727095472926 -0.0006987550074544 0.0542180138683237 - -0.0807693466260907 0.0231480981437291 -0.0215287318279827 0.4278607689529697 -0.1406724107692924 0.0481255406979350 - -0.0110424731750099 0.0072895883048843 -0.0027105010063632 0.0110424731750099 -0.0072895883048843 0.0027105010063632 - 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0000000000000000 0.0000000000000000 0.0000000000000000 -0.0000000000000002 0.0000000000000009 -0.0000000000000012 - 0.0000000000000005 -0.0000000000000014 0.0000000000000087 -0.0000000000000086 0.0000000000000014 -0.0000000000000007 - -0.2460249761505440 0.2460249761505439 0.0000000000000001 0.0761473579207937 -0.0761473579207940 -0.0000000000000001 - -0.0185670942019327 0.0185670942019330 0.0000000000000003 0.4920499523010881 -0.1522947158415879 0.0371341884038657 - 0.0000000000000010 -0.0000000000000054 0.0000000000000358 -0.0000000000000353 0.0000000000000060 -0.0000000000000036 - -0.2460249761505444 0.0761473579207938 -0.0185670942019317 0.0000000000000011 -0.0000000000000041 0.0000000000000268 - -0.0000000000000265 0.0000000000000050 -0.0000000000000035 -0.2460249761505439 0.0761473579207937 -0.0185670942019317 - 0.0003319194597274 -0.0003437698060803 0.0001337482019789 0.0003319194597274 -0.0003437698060803 0.0001337482019789 - -0.0001551271140036 -0.0008105050412598 0.0566680904830619 -0.0752177348472074 0.0246384934456135 -0.0136606948713356 - -0.0001291054984009 -0.0011639852665404 0.0043283112459224 -0.0141551644394016 0.0673219381894804 -0.0739996766734982 - 0.0247983124456242 -0.1446165321111086 2.0128076501482983 -2.3909263077303118 0.3592623068690700 -0.1186522383075085 - 0.0080648065122414 0.0080648065122419 -0.0090520308047825 -0.0076791291245459 -0.0076791291245453 -0.0183027108456490 - 0.0005739500477651 0.0005739500477647 0.0358519382412194 0.0000000000000000 -0.0000000000000002 0.0000000000000002 - -0.0247983124456281 0.1446165321111199 -2.0128076501483698 2.3909263077303820 -0.3592623068690819 0.1186522383075141 - 0.0171168373170238 0.0106235817211041 -0.0352779881934553 0.0247983124456295 -0.1446165321111238 2.0128076501483920 - -2.3909263077304046 0.3592623068690868 -0.1186522383075201 -0.0171168373170225 -0.0106235817211049 0.0352779881934590 - -0.0021695502960768 0.0057010906983239 -0.0023914076053448 -0.0021695502960768 0.0057010906983239 -0.0023914076053448 - -0.0000129220819752 0.0000053814036735 0.0013749699369938 -0.0017023041370737 -0.0004249748642226 0.0022562886148301 - -0.0022684826151880 0.0069898432923542 -0.0045582876216757 0.4330293340220562 -1.2790121538859958 0.1522770446625292 - 0.0013071086345869 -0.0072550532279228 0.0839323767053475 -0.0928013292053547 -0.0144543169773070 0.0401908147950419 - -0.0720450558559555 -0.0720450558559556 -0.0724245552991170 0.2025377654163339 0.2025377654163338 0.2344305461103301 - -0.0136527048018357 -0.0136527048018359 -0.0488331127275932 0.0000000000000001 0.0000000000000000 0.0000000000000002 - -0.0013071086345816 0.0072550532278988 -0.0839323767051828 0.0928013292051918 0.0144543169773341 -0.0401908147950554 - 0.0003794994431615 -0.0318927806939963 0.0351804079257620 0.0013071086345816 -0.0072550532278989 0.0839323767051828 - -0.0928013292051918 -0.0144543169773341 0.0401908147950553 -0.0003794994431615 0.0318927806939963 -0.0351804079257623 - -0.0004925155277502 0.0039129697242517 -0.0019171532328325 -0.0004925155277502 0.0039129697242517 -0.0019171532328325 - -0.0000302499173243 0.0000182261296230 0.0013929088729904 -0.0024779019977788 0.0046971570926608 -0.0065888949168443 - 0.0007540664836603 -0.0074023620404866 0.0070358583509147 0.0381390959687732 -0.0920571896442359 -0.1720150332969798 - 0.0020648398954834 -0.0121727102285652 0.1615908835487991 -0.2045683062285860 0.2057768618287176 -0.1522801484616030 - -0.0334620120076011 -0.0334620120076012 0.0478544760308157 0.1712562716079358 0.1712562716079360 -0.2964839483937539 - -0.0414388091234262 -0.0414388091234264 0.1688851348953426 0.0000000000000000 0.0000000000000000 0.0000000000000001 - -0.0020648398954847 0.0121727102285697 -0.1615908835488285 0.2045683062286144 -0.2057768618287216 0.1522801484616029 - -0.0813164880384171 0.4677402200016897 -0.2103239440187687 0.0020648398954845 -0.0121727102285694 0.1615908835488283 - -0.2045683062286142 0.2057768618287216 -0.1522801484616038 0.0813164880384170 -0.4677402200016896 0.2103239440187698 - 0.0007020142623362 -0.0063682040867107 0.0032365941380959 -0.0007020142623362 0.0063682040867107 -0.0032365941380959 - 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0000000000000000 0.0000000000000000 0.0000000000000000 -0.0000000000000003 0.0000000000000005 -0.0000000000000014 - 0.0000000000000003 -0.0000000000000014 0.0000000000000105 -0.0000000000000108 0.0000000000000025 -0.0000000000000013 - 0.0538338725456908 -0.0538338725456906 0.0000000000000000 -0.2858167253182752 0.2858167253182750 0.0000000000000000 - 0.0828868812967961 -0.0828868812967958 0.0000000000000004 -0.1076677450913817 0.5716334506365516 -0.1657737625935929 - -0.0000000000000019 0.0000000000000086 -0.0000000000000598 0.0000000000000595 -0.0000000000000105 0.0000000000000065 - 0.0538338725456908 -0.2858167253182753 0.0828868812967941 -0.0000000000000019 0.0000000000000086 -0.0000000000000595 - 0.0000000000000593 -0.0000000000000105 0.0000000000000065 0.0538338725456907 -0.2858167253182750 0.0828868812967938 - -0.0000932476390227 0.0009724344513938 -0.0005221794870707 -0.0000932476390227 0.0009724344513938 -0.0005221794870707 - 0.0001889106214561 -0.0003367603619098 -0.0040794178420160 0.0078899253570651 -0.0140136006187381 0.0131289234119809 - 0.0001887564183914 -0.0014073713901561 -0.0037205735521445 -0.0022711501133481 -0.0386229736713210 0.2981276992229074 - -0.0126248783552878 0.0718186265116986 -0.8766250691815103 1.0626990519183757 -0.7679617831022284 0.3941804453989339 - -0.0082599893125672 -0.0082599893125673 0.0176555536818086 0.0451473736844486 0.0451473736844480 -0.0709832605332361 - -0.0164210723636496 -0.0164210723636493 -0.1162217048841549 0.0000000000000000 0.0000000000000001 -0.0000000000000001 - 0.0126248783552885 -0.0718186265116998 0.8766250691815152 -1.0626990519183808 0.7679617831022300 -0.3941804453989351 - -0.0259155429943758 0.1161306342176845 0.0998006325205041 -0.0126248783552889 0.0718186265117007 -0.8766250691815253 - 1.0626990519183912 -0.7679617831022330 0.3941804453989390 0.0259155429943753 -0.1161306342176843 -0.0998006325205067 - -0.0000835933144458 -0.0004615909032044 0.0004862875431774 -0.0000835933144458 -0.0004615909032044 0.0004862875431774 - -0.0000379256876541 0.0001425479341724 -0.0007603206537755 0.0007750004631652 0.0019889228278784 -0.0096583467234158 - -0.0001134840538676 -0.0015390187508457 0.0094171689916390 -0.0637403101157770 0.4509851572958998 -1.3692756080786328 - 0.0023456221816684 -0.0129559099013849 0.1555514727330908 -0.1852797170600208 0.2264041733801040 -0.6103494050763831 - 0.0040897791208860 0.0040897791208859 0.0236905968161165 -0.0344332042404251 -0.0344332042404248 -0.1566261701671002 - 0.0398538900708608 0.0398538900708604 0.6049300238975954 -0.0000000000000001 0.0000000000000001 0.0000000000000000 - -0.0023456221816701 0.0129559099013928 -0.1555514727331486 0.1852797170600780 -0.2264041733801128 0.6103494050763854 - -0.0196008176952300 0.1221929659266745 -0.5650761338267329 0.0023456221816702 -0.0129559099013944 0.1555514727331603 - -0.1852797170600900 0.2264041733801158 -0.6103494050763882 0.0196008176952301 -0.1221929659266749 0.5650761338267345 - -0.0002070211240448 -0.0013666665527184 0.0022977666840202 -0.0002070211240448 -0.0013666665527184 0.0022977666840202 - 0.0000399881770163 -0.0001379594837146 0.0006571852310370 -0.0005702837721233 -0.0007921006121482 0.0023244740149689 - -0.0001722526546200 -0.0007582480584614 -0.0003139924292126 -0.0977544227665608 0.6526103635117371 -0.9703072748081616 - -0.0024233012711297 0.0133192822658476 -0.1524962246352509 0.1787092455122903 -0.1353419749992949 0.2266485256743573 - 0.0222598335361984 0.0222598335361985 0.0043575443108834 -0.1385927260993564 -0.1385927260993564 -0.0491197295571557 - 0.2363271021548028 0.2363271021548028 0.0124994330944753 -0.0000000000000001 0.0000000000000003 -0.0000000000000003 - 0.0024233012711285 -0.0133192822658428 0.1524962246352183 -0.1787092455122576 0.1353419749992895 -0.2266485256743530 - 0.0179022892253147 -0.0894729965422007 0.2238276690603256 -0.0024233012711287 0.0133192822658436 -0.1524962246352240 - 0.1787092455122637 -0.1353419749992909 0.2266485256743544 -0.0179022892253145 0.0894729965422005 -0.2238276690603261 - -0.0000877922205472 -0.0003539939799249 0.0019325021678604 0.0000877922205472 0.0003539939799249 -0.0019325021678604 - 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000009 0.0000000000000007 -0.0000000000000024 - 0.0000000000000001 -0.0000000000000004 0.0000000000000056 -0.0000000000000062 0.0000000000000020 -0.0000000000000015 - 0.0197336602596507 -0.0197336602596512 0.0000000000000000 -0.0949868902041613 0.0949868902041611 -0.0000000000000002 - 0.2450747801220870 -0.2450747801220865 0.0000000000000007 -0.0394673205193016 0.1899737804083226 -0.4901495602441729 - -0.0000000000000007 0.0000000000000030 -0.0000000000000219 0.0000000000000221 -0.0000000000000042 0.0000000000000031 - 0.0197336602596506 -0.0949868902041611 0.2450747801220853 -0.0000000000000005 0.0000000000000026 -0.0000000000000179 - 0.0000000000000177 -0.0000000000000030 0.0000000000000020 0.0197336602596509 -0.0949868902041608 0.2450747801220855 - 0.0000202124803106 0.0000781029967421 -0.0006478138965758 0.0000202124803106 0.0000781029967421 -0.0006478138965758 - 0.0000741950760357 -0.0002683567521375 0.0015689213492304 -0.0015279224767587 -0.0007059818375600 0.0021816613186189 - -0.0001012293947030 -0.0002080060716620 0.0016628291298998 -0.0080890190236005 0.0478553796104456 -0.2013797146078141 - -0.0044039922495285 0.0240809953573882 -0.2715015814327500 0.3163550314853787 -0.2207849405215449 0.3377114462184972 - -0.0067585321723981 -0.0067585321723980 0.0175615738565964 0.0306436990825137 0.0306436990825133 -0.0852150879702498 - -0.0845442748905727 -0.0845442748905724 0.2697784070850522 0.0000000000000000 -0.0000000000000001 0.0000000000000001 - 0.0044039922495284 -0.0240809953573904 0.2715015814327725 -0.3163550314854026 0.2207849405215519 -0.3377114462185020 - -0.0243201060289942 0.1158587870527635 -0.3543226819756227 -0.0044039922495287 0.0240809953573912 -0.2715015814327786 - 0.3163550314854090 -0.2207849405215531 0.3377114462185031 0.0243201060289943 -0.1158587870527635 0.3543226819756226 - 0.0000000630463000 0.0000000722345919 -0.0000000131796929 0.0000000630463000 0.0000000722345919 -0.0000000131796929 - 0.1085078179862649 0.3641804283806221 0.3421437434089478 -0.0239872315732754 0.0243366202974939 -0.0083825425551351 - -0.0012980746318664 -0.0001923730272403 0.0024101495298993 -0.0000184212188181 -0.0000013198960529 0.0000093641307673 - -0.0039336718821133 -0.0056462447000065 -0.0027582143423918 0.0001685200954757 -0.0000830823957571 0.0000162766394285 - 0.0000000016957570 0.0000000016957570 0.0000092072178950 0.0000000003613936 0.0000000003613936 0.0000006592252393 - 0.0000000002754899 0.0000000002754899 -0.0000046826163635 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0039336718821133 0.0056462447000065 0.0027582143423919 -0.0001685200954757 0.0000830823957572 -0.0000162766394285 - -0.0000092055221379 -0.0000006588638457 0.0000046828918534 -0.0039336718821133 -0.0056462447000065 -0.0027582143423920 - 0.0001685200954759 -0.0000830823957572 0.0000162766394285 0.0000092055221379 0.0000006588638457 -0.0000046828918534 - -0.0001332056054989 -0.0002835189200607 -0.0002003629654982 -0.0001332056054989 -0.0002835189200607 -0.0002003629654982 - 0.0254124725240688 0.1020503326711045 0.1853984949928108 -0.0460152560876052 -0.2833588631514600 -0.5345027420249026 - -0.0376537076267751 -0.0798948146974734 -0.0695758753001430 -0.0005376375035323 -0.0005502887986161 -0.0002728848862038 - -0.0009208426386680 -0.0015815190032869 -0.0014945969188533 0.0003259245546023 0.0009690548441583 0.0010424393842483 - 0.0000008939527087 0.0000008939527087 0.0002670308463488 0.0000009611236778 0.0000009611236778 0.0002732221519525 - 0.0000003789960134 0.0000003789960134 0.0001356844510751 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0009208426386680 0.0015815190032868 0.0014945969188535 -0.0003259245546025 -0.0009690548441582 -0.0010424393842483 - -0.0002661368936401 -0.0002722610282747 -0.0001353054550616 -0.0009208426386680 -0.0015815190032868 -0.0014945969188536 - 0.0003259245546026 0.0009690548441582 0.0010424393842483 0.0002661368936401 0.0002722610282747 0.0001353054550616 - 0.0881587178363237 0.1937041500846937 0.2647572597686021 0.0881587178363238 0.1937041500846937 0.2647572597686021 - 0.0000540593916235 0.0002162118258436 0.0004263430618639 -0.0001354546593240 -0.0005562643720647 -0.0016746104354702 - 0.0004663124358171 0.0009783013631586 0.0010201199879685 0.0025064504552743 0.0026562340468903 0.0020690933411925 - -0.0000019591296294 -0.0000033496430001 -0.0000034513750896 0.0000009794188316 0.0000018980251751 0.0000032732885984 - -0.0006250799981691 -0.0006250799981691 -0.0000030652312989 -0.0006624050134494 -0.0006624050134494 -0.0000033069965463 - -0.0005163032996614 -0.0005163032996614 -0.0000019400712735 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0000019591296294 0.0000033496430001 0.0000034513750895 -0.0000009794188316 -0.0000018980251752 -0.0000032732885984 - -0.0006220147668703 -0.0006590980169031 -0.0005143632283879 -0.0000019591296294 -0.0000033496430001 -0.0000034513750895 - 0.0000009794188315 0.0000018980251752 0.0000032732885984 0.0006220147668703 0.0006590980169031 0.0005143632283879 - 0.0880685416769848 0.1936286969635074 0.2648681368561919 -0.0880685416769850 -0.1936286969635073 -0.2648681368561919 - 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0000000000000000 0.0000000000000000 0.0000000000000001 -0.0000000000000001 0.0000000000000000 0.0000000000000000 - -0.0006246826091165 0.0006246826091165 0.0000000000000000 -0.0006621827623669 0.0006621827623669 0.0000000000000000 - -0.0005165687756752 0.0005165687756752 0.0000000000000000 0.0012493652182330 0.0013243655247338 0.0010331375513505 - 0.0000000000000000 0.0000000000000000 -0.0000000000000001 0.0000000000000001 0.0000000000000000 0.0000000000000000 - -0.0006246826091165 -0.0006621827623669 -0.0005165687756752 0.0000000000000000 0.0000000000000000 -0.0000000000000001 - 0.0000000000000001 0.0000000000000000 0.0000000000000000 -0.0006246826091165 -0.0006621827623669 -0.0005165687756752 - 0.0000535521812740 0.0001438390264493 0.0009709051284217 0.0000535521812740 0.0001438390264493 0.0009709051284217 - -0.0128673092391235 -0.0522945134796025 -0.0971815795790674 0.0248829790670646 0.1513768651089982 0.5250179702733521 - -0.1663997463414391 -0.3820309489572568 -0.6526914071594446 -0.0023577171394548 -0.0026108071817921 -0.0025380137644564 - 0.0004662481996006 0.0008104167128002 0.0007834294807267 -0.0001762528811480 -0.0005176749664430 -0.0010239225993518 - -0.0000005996160545 -0.0000005996160545 0.0011800578018364 -0.0000005203979780 -0.0000005203979780 0.0013064443868520 - -0.0000019326495124 -0.0000019326495125 0.0012728721812531 0.0000000000000000 0.0000000000000000 0.0000000000000000 - -0.0004662481996006 -0.0008104167128002 -0.0007834294807266 0.0001762528811479 0.0005176749664431 0.0010239225993518 - -0.0011806574178908 -0.0013069647848301 -0.0012748048307656 0.0004662481996006 0.0008104167128002 0.0007834294807267 - -0.0001762528811480 -0.0005176749664431 -0.0010239225993518 0.0011806574178908 0.0013069647848301 0.0012748048307656 - 0.1043338968671886 0.5349261691774895 -0.5206893025532602 0.1043338968671886 0.5349261691774891 -0.5206893025532598 - -0.0000830016831288 -0.0004067560390425 0.0003326889844103 -0.0011541165745468 0.0027310233011464 0.0035896484100835 - 0.0010375118377717 0.0052278631967300 -0.0116988957723680 0.0029728707077215 0.0073527924165110 -0.0041078512238737 - 0.0000030069783460 0.0000063044488608 -0.0000026984066625 0.0000082081408278 -0.0000093412695814 -0.0000070024784298 - -0.0007396937921111 -0.0007396937921111 -0.0000070477696386 -0.0018292779784553 -0.0018292779784553 -0.0000178402513449 - 0.0010155251170781 0.0010155251170781 0.0000228753777805 0.0000000000000000 0.0000000000000000 0.0000000000000000 - -0.0000030069783460 -0.0000063044488608 0.0000026984066622 -0.0000082081408274 0.0000093412695813 0.0000070024784298 - -0.0007326460224723 -0.0018114377271104 0.0009926497392977 0.0000030069783460 0.0000063044488608 -0.0000026984066620 - 0.0000082081408274 -0.0000093412695813 -0.0000070024784298 0.0007326460224723 0.0018114377271104 -0.0009926497392977 - -0.1042582553960022 -0.5350998573159294 0.5206806420297089 0.1042582553960023 0.5350998573159291 -0.5206806420297087 - 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0000000000000000 0.0000000000000000 -0.0000000000000001 0.0000000000000001 0.0000000000000000 0.0000000000000000 - 0.0007394678075342 -0.0007394678075342 0.0000000000000000 0.0018299079569507 -0.0018299079569507 0.0000000000000000 - -0.0010154566220088 0.0010154566220088 0.0000000000000000 -0.0014789356150682 -0.0036598159139012 0.0020309132440177 - 0.0000000000000000 0.0000000000000000 0.0000000000000003 -0.0000000000000003 0.0000000000000001 0.0000000000000000 - 0.0007394678075342 0.0018299079569507 -0.0010154566220088 0.0000000000000000 0.0000000000000000 0.0000000000000003 - -0.0000000000000003 0.0000000000000001 0.0000000000000000 0.0007394678075342 0.0018299079569507 -0.0010154566220088 - -0.0008186295640998 -0.0045942682017412 0.0042664096623204 -0.0008186295640998 -0.0045942682017412 0.0042664096623204 - -0.0098181128844580 -0.0491663474817726 0.0557506689145418 -0.1590184805584586 0.3596364623559538 0.3472181291714347 - 0.1254951139025903 0.6748785127113249 -1.3299539303383983 0.0017558571325181 0.0045528529529005 -0.0051543825587471 - 0.0003557118370266 0.0007619423111466 -0.0004498563308689 0.0011283112217078 -0.0012298657351789 -0.0006771562501249 - 0.0000059889358420 0.0000059889358420 -0.0008899064379431 0.0000157322970255 0.0000157322970255 -0.0023078910705013 - -0.0000082889933657 -0.0000082889933657 0.0025937692661049 0.0000000000000000 0.0000000000000000 0.0000000000000000 - -0.0003557118370267 -0.0007619423111465 0.0004498563308684 -0.0011283112217074 0.0012298657351788 0.0006771562501249 - 0.0008958953737850 0.0023236233675268 -0.0026020582594705 0.0003557118370267 0.0007619423111465 -0.0004498563308685 - 0.0011283112217074 -0.0012298657351788 -0.0006771562501249 -0.0008958953737850 -0.0023236233675268 0.0026020582594705 - -0.0000011815684005 -0.0001211110522653 0.0001003546729168 -0.0000011815684005 -0.0001211110522653 0.0001003546729168 - 0.0213242205019586 0.1241883821545017 -0.4061921101250383 0.7499007839560962 -1.7676268027646163 2.4690231515324532 - 0.0332432942895798 0.2206844935327919 -1.2942270452155706 0.0004712572300515 0.0015076710820292 -0.0050472817157422 - -0.0007725082171058 -0.0019245772230134 0.0032761374408468 -0.0053201241508317 0.0060446901494363 -0.0048151002223683 - 0.0000000544133611 0.0000000544133611 -0.0002357374417478 0.0000004154299803 0.0000004154299803 -0.0007546664009751 - -0.0000001872163277 -0.0000001872163277 0.0025240152905266 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0007725082171058 0.0019245772230134 -0.0032761374408470 0.0053201241508319 -0.0060446901494363 0.0048151002223683 - 0.0002357918551089 0.0007550818309554 -0.0025242025068543 -0.0007725082171058 -0.0019245772230134 0.0032761374408470 - -0.0053201241508319 0.0060446901494363 -0.0048151002223683 -0.0002357918551089 -0.0007550818309554 0.0025242025068544 - 0.6078397895864120 -0.6170698287693464 0.2549255350404644 0.6078397895864120 -0.6170698287693464 0.2549255350404643 - -0.0000272415463973 -0.0000312522668485 -0.0016561104002295 0.0019373230180294 -0.0001193926747274 -0.0009973551812732 - 0.0033169074049398 -0.0037978418166864 0.0023807182991278 0.0172863088188798 -0.0084648716423272 0.0019967793507658 - 0.0000009871890695 0.0000004834098756 0.0000133556310571 -0.0000137325007654 0.0000004001000944 0.0000019286302622 - -0.0043102142815701 -0.0043102142815701 -0.0000227258462996 0.0021097476104855 0.0021097476104855 0.0000129406001926 - -0.0004969425636525 -0.0004969425636525 -0.0000045045480778 0.0000000000000000 0.0000000000000000 0.0000000000000000 - -0.0000009871890695 -0.0000004834098759 -0.0000133556310553 0.0000137325007636 -0.0000004001000941 -0.0000019286302623 - -0.0042874884352705 0.0020968070102928 -0.0004924380155747 0.0000009871890695 0.0000004834098758 0.0000133556310555 - -0.0000137325007637 0.0000004001000941 0.0000019286302623 0.0042874884352705 -0.0020968070102928 0.0004924380155747 - -0.6078709749338062 0.6169643589578586 -0.2548674012126430 0.6078709749338063 -0.6169643589578586 0.2548674012126431 - 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0000000000000000 0.0000000000000000 -0.0000000000000001 0.0000000000000001 0.0000000000000000 0.0000000000000000 - 0.0043112329460203 -0.0043112329460203 0.0000000000000000 -0.0021094344013281 0.0021094344013281 0.0000000000000000 - 0.0004969393882819 -0.0004969393882819 0.0000000000000000 -0.0086224658920406 0.0042188688026562 -0.0009938787765640 - 0.0000000000000000 0.0000000000000001 -0.0000000000000008 0.0000000000000008 -0.0000000000000001 0.0000000000000001 - 0.0043112329460203 -0.0021094344013281 0.0004969393882819 0.0000000000000000 0.0000000000000001 -0.0000000000000006 - 0.0000000000000006 -0.0000000000000001 0.0000000000000001 0.0043112329460203 -0.0021094344013281 0.0004969393882819 - 0.0023664211551530 -0.0022940988432503 0.0009355149421723 0.0023664211551530 -0.0022940988432503 0.0009355149421723 - 0.0081674536683588 0.0087430291952895 0.5193471541723547 -0.6135837220402698 0.0675654311867987 0.2211424997148327 - -0.8680389969817625 0.9432512558298395 -0.5769917197562996 -0.0122422939544608 0.0064184187879281 -0.0022422175327988 - -0.0002959979936504 -0.0001354102917117 -0.0041874488481027 0.0043518970944895 -0.0002310076684949 -0.0004311777835340 - -0.0000173369386526 -0.0000173369386526 0.0061558208545354 0.0000078789759600 0.0000078789759600 -0.0032249673458843 - -0.0000019006989696 -0.0000019006989696 0.0011249101643387 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0002959979936504 0.0001354102917120 0.0041874488481008 -0.0043518970944876 0.0002310076684947 0.0004311777835341 - -0.0061731577931880 0.0032328463218443 -0.0011268108633083 -0.0002959979936504 -0.0001354102917120 -0.0041874488481006 - 0.0043518970944874 -0.0002310076684946 -0.0004311777835341 0.0061731577931880 -0.0032328463218443 0.0011268108633083 - 0.0000407103498242 -0.0000342193480894 0.0000128650025543 0.0000407103498242 -0.0000342193480894 0.0000128650025543 - -0.0703603321234818 -0.0856608692416063 -5.1668971480752894 6.4203169952281147 -1.8587377559673950 1.0647720165838992 - -0.1134398002010595 0.1752775136881712 -0.3792391995339023 -0.0016074347892403 0.0011979657011656 -0.0014786541029447 - 0.0025497345250695 0.0013266952948414 0.0416578064898317 -0.0455338711569546 0.0063547889315492 -0.0020760034237266 - -0.0000003548092173 -0.0000003548092173 0.0008044270130549 0.0000001263913729 0.0000001263913729 -0.0005992356333285 - -0.0000000344284317 -0.0000000344284318 0.0007393959083359 0.0000000000000000 0.0000000000000000 0.0000000000000000 - -0.0025497345250696 -0.0013266952948412 -0.0416578064898333 0.0455338711569560 -0.0063547889315495 0.0020760034237267 - -0.0008047818222722 0.0005993620247014 -0.0007394303367677 0.0025497345250696 0.0013266952948411 0.0416578064898339 - -0.0455338711569566 0.0063547889315496 -0.0020760034237269 0.0008047818222723 -0.0005993620247014 0.0007394303367677 - 0.0000009908373104 -0.0000006002174217 0.0000002611646974 0.0000009908373104 -0.0000006002174217 0.0000002611646974 - 0.0742572995908804 1.4067116757753872 -9.1951149240351278 8.5940815048751258 -1.0697418334995377 0.5130344371939913 - -0.0213885293665989 0.0486887064468075 -0.1582329784473089 -0.0003030976559213 0.0003327042587809 -0.0006165297651477 - -0.0026849370895819 -0.0217851976760131 0.0740857619774296 -0.0609101332464079 0.0036546423780450 -0.0009994471006995 - -0.0000000203524729 -0.0000000203524729 0.0001515895329063 0.0000000043175538 0.0000000043175538 -0.0001663607644980 - -0.0000000022962362 -0.0000000022962362 0.0003082694750464 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0026849370895819 0.0217851976760134 -0.0740857619774312 0.0609101332464094 -0.0036546423780453 0.0009994471006996 - -0.0001516098853792 0.0001663650820520 -0.0003082717712828 -0.0026849370895818 -0.0217851976760136 0.0740857619774322 - -0.0609101332464104 0.0036546423780454 -0.0009994471006998 0.0001516098853793 -0.0001663650820520 0.0003082717712828 - -0.0000000288363545 0.0000000154259189 -0.0000000068644147 -0.0000000288363545 0.0000000154259189 -0.0000000068644147 - 1.0017160949573538 -1.5580073008486528 4.4611514474873477 -3.8707823965430865 0.4214526735363833 -0.2051079830043258 - 0.0069294801830860 -0.0174566157600110 0.0631218551573770 0.0000979010746758 -0.0001188488873850 0.0002443478202369 - -0.0361907651846227 0.0240352775937184 -0.0357928902490674 0.0273150272271179 -0.0014317450719935 0.0003967158864541 - 0.0000000026923468 0.0000000026923468 -0.0000489559220316 -0.0000000004032816 -0.0000000004032816 0.0000594252502557 - 0.0000000003153389 0.0000000003153389 -0.0001221745407962 0.0000000000000000 0.0000000000000000 0.0000000000000000 - 0.0361907651846229 -0.0240352775937187 0.0357928902490693 -0.0273150272271198 0.0014317450719938 -0.0003967158864543 - 0.0000489586143784 -0.0000594256535374 0.0001221748561351 -0.0361907651846229 0.0240352775937189 -0.0357928902490704 - 0.0273150272271209 -0.0014317450719940 0.0003967158864544 -0.0000489586143784 0.0000594256535374 -0.0001221748561352 -EVALS - -0.378466132952E+05 -0.376317160433E+05 -0.375871872904E+05 -0.375847489191E+05 -0.375740444395E+05 -0.375738772125E+05 - -0.375678183830E+05 -0.375638423228E+05 -0.375612685737E+05 -0.375611284085E+05 -0.375605808599E+05 -0.375591793895E+05 - -0.375586003412E+05 -0.375585970263E+05 -0.375581434458E+05 -0.155806087301E+02 -0.122487085753E+01 -0.527584459237E+00 - 0.487823164069E-01 0.491092456791E-01 0.120018853899E+01 0.122150012239E+01 0.122182241470E+01 0.134234136404E+01 - 0.564541233737E+01 0.598579398902E+01 0.598778450387E+01 0.803170115385E+01 0.297043201270E+02 0.144328359679E+03 - -0.378468650814E+05 -0.376320139391E+05 -0.375872742259E+05 -0.375850686480E+05 -0.375741973718E+05 -0.375739522440E+05 - -0.375681447129E+05 -0.375639432388E+05 -0.375614642969E+05 -0.375611790470E+05 -0.375607019678E+05 -0.375591395109E+05 - -0.375589780132E+05 -0.375583791254E+05 -0.375582647071E+05 -0.155799037333E+02 -0.858367878417E+00 -0.452922530832E+00 - -0.452639681560E+00 0.347451570138E+00 0.111774654029E+01 0.111814230324E+01 0.113960182467E+01 0.159764982125E+01 - 0.587423824177E+01 0.587624854790E+01 0.627425178614E+01 0.846308723469E+01 0.300972229602E+02 0.144625749267E+03 -SUPERSYM - 1 1 1 1 -3 1 1 1 -3 1 1 1 -3 1 1 1 1 1 1 -3 1 1 -3 1 1 1 -3 1 1 1 1 1 1 1 1 -3 1 1 1 -3 1 1 1 -3 1 1 1 1 -3 1 1 -3 1 1 1 -3 1 1 1 1 diff --git a/test/dev/ivo_n2/test_ivo_n2_sto3g.py b/test/dev/ivo_n2/test_ivo_n2_sto3g.py deleted file mode 100644 index 67271926..00000000 --- a/test/dev/ivo_n2/test_ivo_n2_sto3g.py +++ /dev/null @@ -1,86 +0,0 @@ -import os -import shutil -import pytest -from module_testing import ( - run_test_dcaspt2, - create_test_command_dcaspt2, -) - - -def run_ivo_test_n2_sto3g(mpi_num_process: int, omp_num_threads: int, save: bool, dirac_version: int, path_this_file: str, test_path: str) -> None: - - # Set file names - input_file = "active.ivo.inp" # Input - DFPCMONEW_file = "DFPCMONEW" # Test (This file is compared with Reference) - ref_DFPCMONEW_file = f"reference.DFPCMONEW.dirac{dirac_version}" # Reference - latest_passed_test = f"latest_passed.DFPCMONEW.dirac{dirac_version}" # latest passed DFPCMONEW - output_filename = f"c32h_n2_dev.dirac{dirac_version}.caspt2.out" # Output - latest_passed_output = f"latest_passed.c32h_n2_dev.dirac{dirac_version}.caspt2.out" # latest passed output (After test, the output file is moved to this) - - # Set file paths - input_file_path = os.path.abspath(os.path.join(test_path, input_file)) - DFPCMONEW_file_path = os.path.abspath(os.path.join(test_path, DFPCMONEW_file)) - ref_DFPCMONEW_file_path = os.path.abspath(os.path.join(path_this_file, ref_DFPCMONEW_file)) - latest_passed_DFPCMONEW_file_path = os.path.abspath(os.path.join(path_this_file, latest_passed_test)) - output_file_path = os.path.abspath(os.path.join(path_this_file, output_filename)) - latest_passed_output_file_path = os.path.abspath(os.path.join(path_this_file, latest_passed_output)) - binary_dir = os.path.abspath(os.path.join(path_this_file, "../../../bin")) # Set the Built binary directory - dcaspt2 = os.path.join(binary_dir, "dcaspt2") # Set the dcaspt2 binary path - - is_ivo = True - test_command = create_test_command_dcaspt2(dcaspt2, mpi_num_process, omp_num_threads, input_file_path, output_file_path, test_path, save, is_ivo) - run_test_dcaspt2(test_command) - - # Copy DFPCMO to path_this_file/result.DFPCMONEW.dirac{dirac_version} - DFPCMONEW_copy_path = os.path.abspath(os.path.join(path_this_file, f"result.DFPCMONEW.dirac{dirac_version}")) - shutil.copyfile(DFPCMONEW_file_path, DFPCMONEW_copy_path) - - # DFPCMONEW format - # INFO (DIRAC version >= 21) - # N2 Thu Apr 6 11:00:00 2023 - # 2 15 15 54 15 15 54 - # -0.1075307794799569E+03 - # COEFS (DIRAC version >= 21) - # 0.0783846162631894 -0.0932522358717089 0.2444662687107759 -0.2100050908725506 0.0207980763363816 -0.0061525045832165 - # -0.0001106259309856 -0.0000860939270339 0.0001830653248163 0.0000000555844586 -0.0000000349239622 0.0000000146384444 - # -0.0000000555844586 0.0000000349239622 -0.0000000146384444 -0.4656826540533246 0.2259566676583494 -0.3303017764820634 - # ... - # EVALS (DIRAC version >= 21) - # -0.378466132952E+05 -0.376317160433E+05 -0.375871872904E+05 -0.375847489191E+05 -0.375740444395E+05 -0.375738772125E+05 - # -0.375678183830E+05 -0.375638423228E+05 -0.375612685737E+05 -0.375611284085E+05 -0.375605808599E+05 -0.375591793895E+05 - # -0.375586003412E+05 -0.375585970263E+05 -0.375581434458E+05 -0.155806087301E+02 -0.122487085753E+01 -0.527584459237E+00 - # ... - # SUPERSYM - # 1 1 1 1 -3 1 1 1 -3 1 1 1 -3 1 1 1 1 1 1 -3 1 1 -3 1 1 1 -3 1 1 1 1 1 1 1 1 -3 1 1 1 -3 1 1 1 -3 1 1 1 1 -3 1 1 -3 1 1 1 -3 1 1 1 1 - # 1 2 3 2 - - # Open DFPCMONEW and reference.DFPCMONEW and compare the values (if the values are float, compare the values to 10th decimal places) - with open(DFPCMONEW_file_path, "r") as DFPCMONEW_file, open(ref_DFPCMONEW_file_path, "r") as ref_file: - for DFPCMONEW_line, ref_line in zip(DFPCMONEW_file, ref_file): - # if the first value cannot be converted to float, compare the values as strings - DFPCMONEW_values = DFPCMONEW_line.split() - ref_values = ref_line.split() - try: - DFPCMONEW_float_values = [float(value) for value in DFPCMONEW_values] - ref_float_values = [float(value) for value in ref_values] - for DFPCMONEW_float_value, ref_float_value in zip(DFPCMONEW_float_values, ref_float_values): - assert ref_float_value == pytest.approx(DFPCMONEW_float_value, abs=1e-13) - except ValueError: - assert DFPCMONEW_values == ref_values - - # If it reaches this point, the result of assert is true. - # The latest passed output file is overwritten by the current output file if assert is True. - shutil.copy(output_file_path, latest_passed_output_file_path) - shutil.copy(DFPCMONEW_file_path, latest_passed_DFPCMONEW_file_path) - - -@pytest.mark.dev -def test_ivo_n2_sto3g(mpi_num_process: int, omp_num_threads: int, save: bool) -> None: - - for dirac_version in [19, 22]: - # Get this files path and change directory to this path - path_this_file = os.path.dirname(os.path.abspath(__file__)) # The path of this file - test_path = os.path.join(path_this_file, f"./input/{dirac_version}") # The path of the test directory - os.chdir(test_path) - - run_ivo_test_n2_sto3g(mpi_num_process, omp_num_threads, save, dirac_version, path_this_file, test_path) diff --git a/test/dev/ninact_0_h2_dev/test_ninact_0_h2_dev.py b/test/dev/ninact_0_h2_dev/test_ninact_0_h2_dev.py index 9d684d98..574e3dd8 100644 --- a/test/dev/ninact_0_h2_dev/test_ninact_0_h2_dev.py +++ b/test/dev/ninact_0_h2_dev/test_ninact_0_h2_dev.py @@ -1,40 +1,24 @@ import os import shutil + import pytest from module_testing import ( - run_test_dcaspt2, - create_test_command_dcaspt2, get_caspt2_energy_from_output_file, + run_test_dcaspt2, ) @pytest.mark.dev -def test_ninact_0_h2_dev(mpi_num_process: int, omp_num_threads: int, save: bool) -> None: +def test_ninact_0_h2_dev(env_setup_caspt2) -> None: + (test_path, ref_output_path, output_path, latest_passed_path, test_command) = env_setup_caspt2 - # Set file names - input_file = "active.inp" # Input - ref_output_file = "reference.ninact_0_h2_dev.out" # Reference - output_filename = "ninact_0_h2_dev.caspt2.out" # Output (This file is compared with Reference) - latest_passed_output = "latest_passed.ninact_0_h2_dev.caspt2.out" # latest passed output (After test, the output file is moved to this) - - # Get this files path and change directory to this path - test_path = os.path.dirname(os.path.abspath(__file__)) # The path of this file os.chdir(test_path) # Change directory to the path of this file print(test_path, "test start") # Debug output - # Set file paths - ref_output_file_path = os.path.abspath(os.path.join(test_path, ref_output_file)) - output_file_path = os.path.abspath(os.path.join(test_path, output_filename)) - latest_passed_file_path = os.path.abspath(os.path.join(test_path, latest_passed_output)) - binary_dir = os.path.abspath(os.path.join(test_path, "../../../bin")) # Set the Built binary directory - dcaspt2 = os.path.join(binary_dir, "dcaspt2") # Set the dcaspt2 binary path - - test_command = create_test_command_dcaspt2(dcaspt2, mpi_num_process, omp_num_threads, input_file, output_file_path, test_path, save) - run_test_dcaspt2(test_command) - ref_energy = get_caspt2_energy_from_output_file(ref_output_file_path) - test_energy = get_caspt2_energy_from_output_file(output_file_path) + ref_energy = get_caspt2_energy_from_output_file(ref_output_path) + test_energy = get_caspt2_energy_from_output_file(output_path) # Check whether the output of test run # matches the reference to 7th decimal places. @@ -42,4 +26,4 @@ def test_ninact_0_h2_dev(mpi_num_process: int, omp_num_threads: int, save: bool) # If it reaches this point, the result of assert is true. # The latest passed output file is overwritten by the current output file if assert is True. - shutil.copy(output_file_path, latest_passed_file_path) + shutil.copy(output_path, latest_passed_path) diff --git a/test/slow/c1_methane_slow/test_c1_methane_slow.py b/test/slow/c1_methane_slow/test_c1_methane_slow.py index 4f7eb838..30574628 100644 --- a/test/slow/c1_methane_slow/test_c1_methane_slow.py +++ b/test/slow/c1_methane_slow/test_c1_methane_slow.py @@ -2,40 +2,24 @@ import shutil import pytest from module_testing import ( - create_test_command_dcaspt2, get_caspt2_energy_from_output_file, run_test_dcaspt2, ) @pytest.mark.slowonly -def test_c1_methane_slow(mpi_num_process: int, omp_num_threads: int, save: bool) -> None: +def test_c1_methane_slow(env_setup_caspt2) -> None: + (test_path, ref_output_path, output_path, latest_passed_path, test_command) = env_setup_caspt2 - # Set file names - input_file = "active.inp" # Input - ref_output_file = "reference.c1_methane_slow.out" # Reference - output_filename = "c1_methane_slow.caspt2.out" # Output (This file is compared with Reference) - latest_passed_output = "latest_passed.c1_methane_slow.caspt2.out" # latest passed output (After test, the output file is moved to this) - - # Get this files path and change directory to this path - test_path = os.path.dirname(os.path.abspath(__file__)) # The path of this file os.chdir(test_path) # Change directory to the path of this file print(test_path, "test start") # Debug output - # Set file paths - ref_output_file_path = os.path.abspath(os.path.join(test_path, ref_output_file)) - output_file_path = os.path.abspath(os.path.join(test_path, output_filename)) - latest_passed_file_path = os.path.abspath(os.path.join(test_path, latest_passed_output)) - binary_dir = os.path.abspath(os.path.join(test_path, "../../../bin")) # Set the Built binary directory - dcaspt2 = os.path.join(binary_dir, "dcaspt2") # Set the dcaspt2 binary path - - test_command = create_test_command_dcaspt2(dcaspt2, mpi_num_process, omp_num_threads, input_file, output_file_path, test_path, save) - with open(output_file_path, "w") as f: + with open(output_path, "w") as f: print(f"TEST COMMAND: {test_command}", file=f) run_test_dcaspt2(test_command) - ref_energy = get_caspt2_energy_from_output_file(ref_output_file_path) - test_energy = get_caspt2_energy_from_output_file(output_file_path) + ref_energy = get_caspt2_energy_from_output_file(ref_output_path) + test_energy = get_caspt2_energy_from_output_file(output_path) # Check whether the output of test run # matches the reference to 7th decimal places. @@ -43,4 +27,4 @@ def test_c1_methane_slow(mpi_num_process: int, omp_num_threads: int, save: bool) # If it reaches this point, the result of assert is true. # The latest passed output file is overwritten by the current output file if assert is True. - shutil.copy(output_file_path, latest_passed_file_path) + shutil.copy(output_path, latest_passed_path) diff --git a/test/slow/c32h_co2_slow/test_c32h_co2_slow.py b/test/slow/c32h_co2_slow/test_c32h_co2_slow.py index c19af0b4..404eba71 100644 --- a/test/slow/c32h_co2_slow/test_c32h_co2_slow.py +++ b/test/slow/c32h_co2_slow/test_c32h_co2_slow.py @@ -2,38 +2,22 @@ import shutil import pytest from module_testing import ( - create_test_command_dcaspt2, get_caspt2_energy_from_output_file, run_test_dcaspt2, ) @pytest.mark.slowonly -def test_c32h_co2_slow(mpi_num_process: int, omp_num_threads: int, save: bool) -> None: +def test_c32h_co2_slow(env_setup_caspt2) -> None: + (test_path, ref_output_path, output_path, latest_passed_path, test_command) = env_setup_caspt2 - # Set file names - input_file = "active.inp" # Input - ref_output_file = "reference.c32h_co2_slow.out" # Reference - output_filename = "c32h_co2_slow.caspt2.out" # Output (This file is compared with Reference) - latest_passed_output = "latest_passed.c32h_co2_slow.caspt2.out" # latest passed output (After test, the output file is moved to this) - - # Get this files path and change directory to this path - test_path = os.path.dirname(os.path.abspath(__file__)) # The path of this file os.chdir(test_path) # Change directory to the path of this file print(test_path, "test start") # Debug output - # Set file paths - ref_output_file_path = os.path.abspath(os.path.join(test_path, ref_output_file)) - output_file_path = os.path.abspath(os.path.join(test_path, output_filename)) - latest_passed_file_path = os.path.abspath(os.path.join(test_path, latest_passed_output)) - binary_dir = os.path.abspath(os.path.join(test_path, "../../../bin")) # Set the Built binary directory - dcaspt2 = os.path.join(binary_dir, "dcaspt2") # Set the dcaspt2 binary path - - test_command = create_test_command_dcaspt2(dcaspt2, mpi_num_process, omp_num_threads, input_file, output_file_path, test_path, save) run_test_dcaspt2(test_command) - ref_energy = get_caspt2_energy_from_output_file(ref_output_file_path) - test_energy = get_caspt2_energy_from_output_file(output_file_path) + ref_energy = get_caspt2_energy_from_output_file(ref_output_path) + test_energy = get_caspt2_energy_from_output_file(output_path) # Check whether the output of test run # matches the reference to 7th decimal places. @@ -41,4 +25,4 @@ def test_c32h_co2_slow(mpi_num_process: int, omp_num_threads: int, save: bool) - # If it reaches this point, the result of assert is true. # The latest passed output file is overwritten by the current output file if assert is True. - shutil.copy(output_file_path, latest_passed_file_path) + shutil.copy(output_path, latest_passed_path) diff --git a/test/slow/cs_methanol_slow/test_cs_methanol_slow.py b/test/slow/cs_methanol_slow/test_cs_methanol_slow.py index 873fa0cd..afa86931 100644 --- a/test/slow/cs_methanol_slow/test_cs_methanol_slow.py +++ b/test/slow/cs_methanol_slow/test_cs_methanol_slow.py @@ -1,40 +1,24 @@ import os import shutil + import pytest from module_testing import ( - create_test_command_dcaspt2, get_caspt2_energy_from_output_file, run_test_dcaspt2, ) @pytest.mark.slowonly -def test_cs_methanol_slow(mpi_num_process: int, omp_num_threads: int, save: bool) -> None: - - # Set file names - input_file = "active.inp" # Input - ref_output_file = "reference.cs_methanol_slow.out" # Reference - output_filename = "cs_methanol_slow.caspt2.out" # Output (This file is compared with Reference) - latest_passed_output = "latest_passed.cs_methanol_slow.caspt2.out" # latest passed output (After test, the output file is moved to this) +def test_cs_methanol_slow(env_setup_caspt2) -> None: + (test_path, ref_output_path, output_path, latest_passed_path, test_command) = env_setup_caspt2 - # Get this files path and change directory to this path - test_path = os.path.dirname(os.path.abspath(__file__)) # The path of this file os.chdir(test_path) # Change directory to the path of this file print(test_path, "test start") # Debug output - # Set file paths - ref_output_file_path = os.path.abspath(os.path.join(test_path, ref_output_file)) - output_file_path = os.path.abspath(os.path.join(test_path, output_filename)) - latest_passed_file_path = os.path.abspath(os.path.join(test_path, latest_passed_output)) - binary_dir = os.path.abspath(os.path.join(test_path, "../../../bin")) # Set the Built binary directory - dcaspt2 = os.path.join(binary_dir, "dcaspt2") # Set the dcaspt2 binary path - - test_command = create_test_command_dcaspt2(dcaspt2, mpi_num_process, omp_num_threads, input_file, output_file_path, test_path, save) - run_test_dcaspt2(test_command) - ref_energy = get_caspt2_energy_from_output_file(ref_output_file_path) - test_energy = get_caspt2_energy_from_output_file(output_file_path) + ref_energy = get_caspt2_energy_from_output_file(ref_output_path) + test_energy = get_caspt2_energy_from_output_file(output_path) # Check whether the output of test run # matches the reference to 7th decimal places. @@ -42,4 +26,4 @@ def test_cs_methanol_slow(mpi_num_process: int, omp_num_threads: int, save: bool # If it reaches this point, the result of assert is true. # The latest passed output file is overwritten by the current output file if assert is True. - shutil.copy(output_file_path, latest_passed_file_path) + shutil.copy(output_path, latest_passed_path) diff --git a/test/unmarked/c2_h2o/reference.h2o.out b/test/unmarked/c2_h2o/reference.c2_h2o.out similarity index 100% rename from test/unmarked/c2_h2o/reference.h2o.out rename to test/unmarked/c2_h2o/reference.c2_h2o.out diff --git a/test/unmarked/c2_h2o/test_c2_h2o.py b/test/unmarked/c2_h2o/test_c2_h2o.py index 2a822fd8..b413dbfd 100644 --- a/test/unmarked/c2_h2o/test_c2_h2o.py +++ b/test/unmarked/c2_h2o/test_c2_h2o.py @@ -2,37 +2,22 @@ import shutil import pytest from module_testing import ( - create_test_command_dcaspt2, get_caspt2_energy_from_output_file, run_test_dcaspt2, ) -def test_h2o(mpi_num_process: int, omp_num_threads: int, save: bool) -> None: +def test_h2o(env_setup_caspt2) -> None: + (test_path, ref_output_path, output_path, latest_passed_path, test_command) = env_setup_caspt2 - # Set file names - input_file = "active.inp" # Input - ref_output_file = "reference.h2o.out" # Reference - output_filename = "h2o.caspt2.out" # Output (This file is compared with Reference) - latest_passed_output = "latest_passed.h2o.caspt2.out" # latest passed output (After test, the output file is moved to this) - - # Get this files path and change directory to this path - test_path = os.path.dirname(os.path.abspath(__file__)) # The path of this file os.chdir(test_path) # Change directory to the path of this file print(test_path, "test start") # Debug output # Set file paths - ref_output_file_path = os.path.abspath(os.path.join(test_path, ref_output_file)) - output_file_path = os.path.abspath(os.path.join(test_path, output_filename)) - latest_passed_file_path = os.path.abspath(os.path.join(test_path, latest_passed_output)) - binary_dir = os.path.abspath(os.path.join(test_path, "../../../bin")) # Set the Built binary directory - dcaspt2 = os.path.join(binary_dir, "dcaspt2") # Set the dcaspt2 binary path - - test_command = create_test_command_dcaspt2(dcaspt2, mpi_num_process, omp_num_threads, input_file, output_file_path, test_path, save) run_test_dcaspt2(test_command) - ref_energy = get_caspt2_energy_from_output_file(ref_output_file_path) - test_energy = get_caspt2_energy_from_output_file(output_file_path) + ref_energy = get_caspt2_energy_from_output_file(ref_output_path) + test_energy = get_caspt2_energy_from_output_file(output_path) # Check whether the output of test run # matches the reference to 7th decimal places. @@ -40,4 +25,4 @@ def test_h2o(mpi_num_process: int, omp_num_threads: int, save: bool) -> None: # If it reaches this point, the result of assert is true. # The latest passed output file is overwritten by the current output file if assert is True. - shutil.copy(output_file_path, latest_passed_file_path) + shutil.copy(output_path, latest_passed_path)