From e7dd374ab9bbdb045537272f4126a51d62bdeaa0 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 24 May 2021 21:55:14 +0200 Subject: [PATCH] Removed omp_set_nested --- src/ao_basis/aos.irp.f | 49 ++++++++----------- src/basis/EZFIO.cfg | 2 +- src/basis/basis.irp.f | 78 +++++++++++++++++++++--------- src/cipsi/pt2_stoch_routines.irp.f | 3 +- src/dressing/run_dress_slave.irp.f | 6 +-- 5 files changed, 80 insertions(+), 58 deletions(-) diff --git a/src/ao_basis/aos.irp.f b/src/ao_basis/aos.irp.f index a8384ad4..2ff72898 100644 --- a/src/ao_basis/aos.irp.f +++ b/src/ao_basis/aos.irp.f @@ -6,6 +6,23 @@ BEGIN_PROVIDER [ integer, ao_prim_num_max ] ao_prim_num_max = maxval(ao_prim_num) END_PROVIDER +BEGIN_PROVIDER [ integer, ao_shell, (ao_num) ] + implicit none + BEGIN_DOC + ! Index of the shell to which the AO corresponds + END_DOC + integer :: i, j, k, n + k=0 + do i=1,shell_num + n = shell_ang_mom(i)+1 + do j=1,(n*(n+1))/2 + k = k+1 + ao_shell(k) = i + enddo + enddo + +END_PROVIDER + BEGIN_PROVIDER [ double precision, ao_coef_normalized, (ao_num,ao_prim_num_max) ] &BEGIN_PROVIDER [ double precision, ao_coef_normalization_factor, (ao_num) ] implicit none @@ -30,7 +47,8 @@ END_PROVIDER ! Normalization of the primitives if (primitives_normalized) then do j=1,ao_prim_num(i) - call overlap_gaussian_xyz(C_A,C_A,ao_expo(i,j),ao_expo(i,j),powA,powA,overlap_x,overlap_y,overlap_z,norm,nz) + call overlap_gaussian_xyz(C_A,C_A,ao_expo(i,j),ao_expo(i,j), & + powA,powA,overlap_x,overlap_y,overlap_z,norm,nz) ao_coef_normalized(i,j) = ao_coef(i,j)/sqrt(norm) enddo else @@ -198,38 +216,11 @@ END_PROVIDER END_DOC do i = 1, nucl_num Nucl_num_shell_Aos(i) = 0 - do j = 1, Nucl_N_Aos(i) - if(ao_l(Nucl_Aos(i,j))==0)then - ! S type function - Nucl_num_shell_Aos(i)+=1 - Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j) - elseif(ao_l(Nucl_Aos(i,j))==1)then - ! P type function - if(ao_power(Nucl_Aos(i,j),1)==1)then + if (ao_power(Nucl_Aos(i,j),1) == ao_l(Nucl_Aos(i,j))) then Nucl_num_shell_Aos(i)+=1 Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j) endif - elseif(ao_l(Nucl_Aos(i,j))==2)then - ! D type function - if(ao_power(Nucl_Aos(i,j),1)==2)then - Nucl_num_shell_Aos(i)+=1 - Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j) - endif - elseif(ao_l(Nucl_Aos(i,j))==3)then - ! F type function - if(ao_power(Nucl_Aos(i,j),1)==3)then - Nucl_num_shell_Aos(i)+=1 - Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j) - endif - elseif(ao_l(Nucl_Aos(i,j))==4)then - ! G type function - if(ao_power(Nucl_Aos(i,j),1)==4)then - Nucl_num_shell_Aos(i)+=1 - Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j) - endif - endif - enddo enddo diff --git a/src/basis/EZFIO.cfg b/src/basis/EZFIO.cfg index 57bd427b..1c66e758 100644 --- a/src/basis/EZFIO.cfg +++ b/src/basis/EZFIO.cfg @@ -17,7 +17,7 @@ interface: ezfio, provider type: double precision doc: Number of primitives per |AO| size: (basis.shell_num) -interface: ezfio, provider +interface: ezfio [prim_num] type: integer diff --git a/src/basis/basis.irp.f b/src/basis/basis.irp.f index 2674b9f5..e25e6a46 100644 --- a/src/basis/basis.irp.f +++ b/src/basis/basis.irp.f @@ -1,32 +1,62 @@ -BEGIN_PROVIDER [ double precision, basis_normalization_factor, (shell_num) ] +BEGIN_PROVIDER [ double precision, shell_normalization_factor , (shell_num) ] implicit none BEGIN_DOC - ! Normalization factors of the shells + ! Number of primitives per |AO| END_DOC - double precision :: norm,overlap_x,overlap_y,overlap_z,C_A(3), c - integer :: l, powA(3), nz - integer :: i,j,k - nz=100 - C_A(1) = 0.d0 - C_A(2) = 0.d0 - C_A(3) = 0.d0 - do i=1,shell_num - powA(1) = shell_ang_mom(i) - powA(2) = 0 - powA(3) = 0 + logical :: has + PROVIDE ezfio_filename + if (mpi_master) then + if (size(shell_normalization_factor) == 0) return - ! Normalization of the contracted basis functions - norm = 0.d0 - do j=shell_prim_index(i), shell_prim_index(i)+shell_prim_num(i)-1 - do k=shell_prim_index(i), shell_prim_index(i)+shell_prim_num(i)-1 - call overlap_gaussian_xyz(C_A,C_A,shell_prim_expo(j),shell_prim_expo(k), & - powA,powA,overlap_x,overlap_y,overlap_z,c,nz) - norm = norm+c*shell_prim_coef(j)*shell_prim_coef(k) - enddo - enddo - basis_normalization_factor(i) = basis_normalization_factor(i) * sqrt(norm) + call ezfio_has_basis_shell_normalization_factor(has) + if (has) then + write(6,'(A)') '.. >>>>> [ IO READ: shell_normalization_factor ] <<<<< ..' + call ezfio_get_basis_shell_normalization_factor(shell_normalization_factor) + else - enddo + + double precision :: norm,overlap_x,overlap_y,overlap_z,C_A(3), c + integer :: l, powA(3), nz + integer :: i,j,k + nz=100 + C_A(1) = 0.d0 + C_A(2) = 0.d0 + C_A(3) = 0.d0 + + do i=1,shell_num + powA(1) = shell_ang_mom(i) + powA(2) = 0 + powA(3) = 0 + + ! Normalization of the contracted basis functions + norm = 0.d0 + do j=shell_prim_index(i), shell_prim_index(i)+shell_prim_num(i)-1 + do k=shell_prim_index(i), shell_prim_index(i)+shell_prim_num(i)-1 + call overlap_gaussian_xyz(C_A,C_A,shell_prim_expo(j),shell_prim_expo(k),& + powA,powA,overlap_x,overlap_y,overlap_z,c,nz) + norm = norm+c*shell_prim_coef(j)*shell_prim_coef(k) + enddo + enddo + shell_normalization_factor(i) = dsqrt(norm) + enddo + + + endif + endif + IRP_IF MPI_DEBUG + print *, irp_here, mpi_rank + call MPI_BARRIER(MPI_COMM_WORLD, ierr) + IRP_ENDIF + IRP_IF MPI + include 'mpif.h' + integer :: ierr + call MPI_BCAST( shell_normalization_factor, (shell_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read shell_normalization_factor with MPI' + endif + IRP_ENDIF + + call write_time(6) END_PROVIDER diff --git a/src/cipsi/pt2_stoch_routines.irp.f b/src/cipsi/pt2_stoch_routines.irp.f index 7554c39e..6f0d6683 100644 --- a/src/cipsi/pt2_stoch_routines.irp.f +++ b/src/cipsi/pt2_stoch_routines.irp.f @@ -286,7 +286,7 @@ subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, N_in) call write_int(6,nproc_target,'Number of threads for PT2') call write_double(6,mem,'Memory (Gb)') - call omp_set_nested(.false.) + call omp_set_max_active_levels(1) print '(A)', '========== ======================= ===================== ===================== ===========' @@ -313,6 +313,7 @@ subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, N_in) endif !$OMP END PARALLEL call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2') + call omp_set_max_active_levels(8) print '(A)', '========== ======================= ===================== ===================== ===========' diff --git a/src/dressing/run_dress_slave.irp.f b/src/dressing/run_dress_slave.irp.f index 8a92962c..a33fb1dd 100644 --- a/src/dressing/run_dress_slave.irp.f +++ b/src/dressing/run_dress_slave.irp.f @@ -72,7 +72,7 @@ subroutine run_dress_slave(thread,iproce,energy) provide psi_energy ending = dress_N_cp+1 ntask_tbd = 0 - call omp_set_nested(.true.) + call omp_set_max_active_levels(8) !$OMP PARALLEL DEFAULT(SHARED) & !$OMP PRIVATE(interesting, breve_delta_m, task_id) & @@ -84,7 +84,7 @@ subroutine run_dress_slave(thread,iproce,energy) zmq_socket_push = new_zmq_push_socket(thread) integer, external :: connect_to_taskserver !$OMP CRITICAL - call omp_set_nested(.false.) + call omp_set_max_active_levels(1) if (connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) == -1) then print *, irp_here, ': Unable to connect to task server' stop -1 @@ -296,7 +296,7 @@ subroutine run_dress_slave(thread,iproce,energy) !$OMP END CRITICAL !$OMP END PARALLEL - call omp_set_nested(.false.) + call omp_set_max_active_levels(1) ! do i=0,dress_N_cp+1 ! call omp_destroy_lock(lck_sto(i)) ! end do