From f6369660bd59bbb9e2237629e36aa3b26dc464f0 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 6 Jun 2016 10:36:23 +0200 Subject: [PATCH] Removed lck --- scripts/generate_h_apply.py | 8 ++++---- src/Determinants/H_apply.template.f | 13 ------------- src/Determinants/H_apply_nozmq.template.f | 8 ++------ src/Determinants/H_apply_zmq.template.f | 1 - src/Determinants/s2.irp.f | 16 ++++++++++------ 5 files changed, 16 insertions(+), 30 deletions(-) diff --git a/scripts/generate_h_apply.py b/scripts/generate_h_apply.py index 90f997ed..5a4d41de 100755 --- a/scripts/generate_h_apply.py +++ b/scripts/generate_h_apply.py @@ -248,13 +248,13 @@ class H_apply(object): """ self.data["deinit_thread"] = """ - !$ call omp_set_lock(lck) + !$OMP CRITICAL do k=1,N_st sum_e_2_pert_in(k) = sum_e_2_pert_in(k) + sum_e_2_pert(k) sum_norm_pert_in(k) = sum_norm_pert_in(k) + sum_norm_pert(k) sum_H_pert_diag_in(k) = sum_H_pert_diag_in(k) + sum_H_pert_diag(k) enddo - !$ call omp_unset_lock(lck) + !$OMP END CRITICAL deallocate (e_2_pert_buffer, coef_pert_buffer) """ self.data["size_max"] = "8192" @@ -356,12 +356,12 @@ class H_apply(object): self.data["skip"] = """ if (i_generator < size_select_max) then if (select_max(i_generator) < selection_criterion_min*selection_criterion_factor) then - !$ call omp_set_lock(lck) + !$OMP CRITICAL do k=1,N_st norm_psi(k) = norm_psi(k) + psi_coef_generators(i_generator,k)*psi_coef_generators(i_generator,k) pt2_old(k) = 0.d0 enddo - !$ call omp_unset_lock(lck) + !$OMP END CRITICAL cycle endif select_max(i_generator) = 0.d0 diff --git a/src/Determinants/H_apply.template.f b/src/Determinants/H_apply.template.f index af94d70b..45f08f75 100644 --- a/src/Determinants/H_apply.template.f +++ b/src/Determinants/H_apply.template.f @@ -167,12 +167,6 @@ subroutine $subroutine_diexcOrg(key_in,key_mask,hole_1,particl_1,hole_2, particl double precision :: diag_H_mat_elem integer :: iproc integer :: jtest_vvvv - integer(omp_lock_kind), save :: lck - integer, save :: ifirst=0 - if (ifirst == 0) then -!$ call omp_init_lock(lck) - ifirst=1 - endif logical :: check_double_excitation logical :: is_a_1h1p @@ -418,8 +412,6 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1,fock_diag_tmp,i_generato integer, allocatable :: ia_ja_pairs(:,:,:) logical, allocatable :: array_pairs(:,:) double precision :: diag_H_mat_elem - integer(omp_lock_kind), save :: lck - integer, save :: ifirst=0 integer :: iproc integer(bit_kind) :: key_mask(N_int, 2) @@ -430,11 +422,6 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1,fock_diag_tmp,i_generato logical :: is_a_1p logical :: is_a_2p - if (ifirst == 0) then - ifirst=1 -!$ call omp_init_lock(lck) - endif - do k=1,N_int key_mask(k,1) = 0_bit_kind key_mask(k,2) = 0_bit_kind diff --git a/src/Determinants/H_apply_nozmq.template.f b/src/Determinants/H_apply_nozmq.template.f index e5220d49..0c319fe3 100644 --- a/src/Determinants/H_apply_nozmq.template.f +++ b/src/Determinants/H_apply_nozmq.template.f @@ -11,7 +11,6 @@ subroutine $subroutine($params_main) integer :: i_generator, nmax double precision :: wall_0, wall_1 - integer(omp_lock_kind) :: lck integer(bit_kind), allocatable :: mask(:,:,:) integer :: ispin, k integer :: iproc @@ -23,8 +22,6 @@ subroutine $subroutine($params_main) nmax = mod( N_det_generators,nproc ) - !$ call omp_init_lock(lck) - call wall_time(wall_0) iproc = 0 @@ -129,19 +126,18 @@ subroutine $subroutine($params_main) mask(1,1,s_hole ), mask(1,1,s_part ), & fock_diag_tmp, i_generator, iproc $params_post) endif - !$ call omp_set_lock(lck) + !$OMP CRITICAL call wall_time(wall_1) $printout_always if (wall_1 - wall_0 > 2.d0) then $printout_now wall_0 = wall_1 endif - !$ call omp_unset_lock(lck) + !$OMP END CRITICAL enddo !$OMP END DO deallocate( mask, fock_diag_tmp ) !$OMP END PARALLEL - !$ call omp_destroy_lock(lck) $copy_buffer $generate_psi_guess diff --git a/src/Determinants/H_apply_zmq.template.f b/src/Determinants/H_apply_zmq.template.f index c1f6ceed..2faceb77 100644 --- a/src/Determinants/H_apply_zmq.template.f +++ b/src/Determinants/H_apply_zmq.template.f @@ -13,7 +13,6 @@ subroutine $subroutine($params_main) integer :: i integer :: i_generator double precision :: wall_0, wall_1 - integer(omp_lock_kind) :: lck integer(bit_kind), allocatable :: mask(:,:,:) integer :: ispin, k integer :: rc diff --git a/src/Determinants/s2.irp.f b/src/Determinants/s2.irp.f index 8587098b..9a60dbd9 100644 --- a/src/Determinants/s2.irp.f +++ b/src/Determinants/s2.irp.f @@ -301,11 +301,13 @@ subroutine diagonalize_s2_betweenstates(keys_tmp,psi_coefs_inout,n,nmax_keys,nma print*,'' print*,'nstates = ',nstates allocate(s2(nstates,nstates),overlap(nstates,nstates)) - !$OMP PARALLEL DO COLLAPSE(2) DEFAULT(NONE) & + !$OMP PARALLEL DO COLLAPSE(2) DEFAULT(NONE) SCHEDULE(dynamic) & !$OMP PRIVATE(i,j) SHARED(overlap,psi_coefs_inout,nstates,n) do i = 1, nstates - do j = i+1, nstates - if (i == j) then + do j = 1, nstates + if (i < j) then + cycle + else if (i == j) then overlap(i,i) = u_dot_u(psi_coefs_inout(1,i),n) else overlap(i,j) = u_dot_v(psi_coefs_inout(1,j),psi_coefs_inout(1,i),n) @@ -321,11 +323,13 @@ subroutine diagonalize_s2_betweenstates(keys_tmp,psi_coefs_inout,n,nmax_keys,nma call ortho_lowdin(overlap,size(overlap,1),nstates,psi_coefs_inout,size(psi_coefs_inout,1),n) print*,'passed ortho' - !$OMP PARALLEL DO COLLAPSE(2) DEFAULT(NONE) & + !$OMP PARALLEL DO COLLAPSE(2) DEFAULT(NONE) SCHEDULE(dynamic) & !$OMP PRIVATE(i,j) SHARED(overlap,psi_coefs_inout,nstates,n) do i = 1, nstates - do j = i+1, nstates - if (i == j) then + do j = 1, nstates + if (i < j) then + cycle + else if (i == j) then overlap(i,i) = u_dot_u(psi_coefs_inout(1,i),n) else overlap(i,j) = u_dot_v(psi_coefs_inout(1,j),psi_coefs_inout(1,i),n)