From 4741f2f54426808ffa6da79678ab22bd7e827339 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 27 Feb 2020 10:16:27 +0100 Subject: [PATCH] Blanks at end of line --- src/cipsi/selection.irp.f | 160 +++++++++++++++++++------------------- 1 file changed, 81 insertions(+), 79 deletions(-) diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f index af63bbd8..88012b50 100644 --- a/src/cipsi/selection.irp.f +++ b/src/cipsi/selection.irp.f @@ -13,7 +13,7 @@ END_PROVIDER BEGIN_PROVIDER [ double precision, variance_match_weight, (N_states) ] implicit none BEGIN_DOC - ! Weights adjusted along the selection to make the variances + ! Weights adjusted along the selection to make the variances ! of each state coincide. END_DOC variance_match_weight(:) = 1.d0 @@ -46,10 +46,10 @@ subroutine update_pt2_and_variance_weights(pt2, variance, norm, N_st) i_iter = 1 endif - dt = 4.d0 + dt = 4.d0 do k=1,N_st - rpt2(k) = pt2(k)/(1.d0 + norm(k)) + rpt2(k) = pt2(k)/(1.d0 + norm(k)) enddo avg = sum(rpt2(1:N_st)) / dble(N_st) @@ -90,7 +90,7 @@ BEGIN_PROVIDER [ double precision, selection_weight, (N_states) ] case (1) print *, 'Using 1/c_max^2 weight in selection' - selection_weight(1:N_states) = c0_weight(1:N_states) + selection_weight(1:N_states) = c0_weight(1:N_states) case (2) print *, 'Using pt2-matching weight in selection' @@ -114,7 +114,7 @@ BEGIN_PROVIDER [ double precision, selection_weight, (N_states) ] print *, '# var weight ', real(variance_match_weight(:),4) case (6) - print *, 'Using CI coefficient-based selection' + print *, 'Using CI coefficient-based selection' selection_weight(1:N_states) = c0_weight(1:N_states) case (7) @@ -289,34 +289,34 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d monoAdo = .true. monoBdo = .true. - - + + do k=1,N_int hole (k,1) = iand(psi_det_generators(k,1,i_generator), hole_mask(k,1)) hole (k,2) = iand(psi_det_generators(k,2,i_generator), hole_mask(k,2)) particle(k,1) = iand(not(psi_det_generators(k,1,i_generator)), particle_mask(k,1)) particle(k,2) = iand(not(psi_det_generators(k,2,i_generator)), particle_mask(k,2)) enddo - - + + integer :: N_holes(2), N_particles(2) integer :: hole_list(N_int*bit_kind_size,2) integer :: particle_list(N_int*bit_kind_size,2) - + call bitstring_to_list_ab(hole , hole_list , N_holes , N_int) call bitstring_to_list_ab(particle, particle_list, N_particles, N_int) - + integer :: l_a, nmax, idx integer, allocatable :: indices(:), exc_degree(:), iorder(:) allocate (indices(N_det), & exc_degree(max(N_det_alpha_unique,N_det_beta_unique))) - + k=1 do i=1,N_det_alpha_unique call get_excitation_degree_spin(psi_det_alpha_unique(1,i), & psi_det_generators(1,1,i_generator), exc_degree(i), N_int) enddo - + do j=1,N_det_beta_unique call get_excitation_degree_spin(psi_det_beta_unique(1,j), & psi_det_generators(1,2,i_generator), nt, N_int) @@ -332,12 +332,12 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d endif enddo enddo - + do i=1,N_det_beta_unique call get_excitation_degree_spin(psi_det_beta_unique(1,i), & psi_det_generators(1,2,i_generator), exc_degree(i), N_int) enddo - + do j=1,N_det_alpha_unique call get_excitation_degree_spin(psi_det_alpha_unique(1,j), & psi_det_generators(1,1,i_generator), nt, N_int) @@ -356,7 +356,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d endif enddo enddo - + deallocate(exc_degree) nmax=k-1 @@ -366,18 +366,18 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d enddo call isort(indices,iorder,nmax) deallocate(iorder) - + ! Start with 32 elements. Size will double along with the filtering. allocate(preinteresting(0:32), prefullinteresting(0:32), & interesting(0:32), fullinteresting(0:32)) preinteresting(:) = 0 prefullinteresting(:) = 0 - + do i=1,N_int negMask(i,1) = not(psi_det_generators(i,1,i_generator)) negMask(i,2) = not(psi_det_generators(i,2,i_generator)) end do - + do k=1,nmax i = indices(k) mobMask(1,1) = iand(negMask(1,1), psi_det_sorted(1,1,i)) @@ -388,10 +388,10 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d mobMask(j,2) = iand(negMask(j,2), psi_det_sorted(j,2,i)) nt = nt + popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2)) end do - + if(nt <= 4) then if(i <= N_det_selectors) then - sze = preinteresting(0) + sze = preinteresting(0) if (sze+1 == size(preinteresting)) then allocate (tmp_array(0:sze)) tmp_array(0:sze) = preinteresting(0:sze) @@ -403,7 +403,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d preinteresting(0) = sze+1 preinteresting(sze+1) = i else if(nt <= 2) then - sze = prefullinteresting(0) + sze = prefullinteresting(0) if (sze+1 == size(prefullinteresting)) then allocate (tmp_array(0:sze)) tmp_array(0:sze) = prefullinteresting(0:sze) @@ -422,17 +422,17 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d ! !$OMP CRITICAL ! print *, 'Step1: ', i_generator, preinteresting(0) ! !$OMP END CRITICAL - + allocate(banned(mo_num, mo_num,2), bannedOrb(mo_num, 2)) allocate (mat(N_states, mo_num, mo_num)) maskInd = -1 - + integer :: nb_count, maskInd_save logical :: monoBdo_save logical :: found do s1=1,2 do i1=N_holes(s1),1,-1 ! Generate low excitations first - + found = .False. monoBdo_save = monoBdo maskInd_save = maskInd @@ -447,21 +447,21 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d enddo if(s1 /= s2) monoBdo = .false. enddo - + if (.not.found) cycle monoBdo = monoBdo_save maskInd = maskInd_save - + h1 = hole_list(i1,s1) call apply_hole(psi_det_generators(1,1,i_generator), s1,h1, pmask, ok, N_int) - + negMask = not(pmask) - + interesting(0) = 0 fullinteresting(0) = 0 - + do ii=1,preinteresting(0) - i = preinteresting(ii) + i = preinteresting(ii) select case (N_int) case (1) mobMask(1,1) = iand(negMask(1,1), psi_det_sorted(1,1,i)) @@ -515,9 +515,9 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d endif end do end select - + if(nt <= 4) then - sze = interesting(0) + sze = interesting(0) if (sze+1 == size(interesting)) then allocate (tmp_array(0:sze)) tmp_array(0:sze) = interesting(0:sze) @@ -529,7 +529,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d interesting(0) = sze+1 interesting(sze+1) = i if(nt <= 2) then - sze = fullinteresting(0) + sze = fullinteresting(0) if (sze+1 == size(fullinteresting)) then allocate (tmp_array(0:sze)) tmp_array(0:sze) = fullinteresting(0:sze) @@ -542,9 +542,9 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d fullinteresting(sze+1) = i end if end if - + end do - + do ii=1,prefullinteresting(0) i = prefullinteresting(ii) nt = 0 @@ -560,7 +560,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d end do if(nt <= 2) then - sze = fullinteresting(0) + sze = fullinteresting(0) if (sze+1 == size(fullinteresting)) then allocate (tmp_array(0:sze)) tmp_array(0:sze) = fullinteresting(0:sze) @@ -577,7 +577,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d allocate (fullminilist (N_int, 2, fullinteresting(0)), & minilist (N_int, 2, interesting(0)) ) if(pert_2rdm)then - allocate(coef_fullminilist_rev(N_states,fullinteresting(0))) + allocate(coef_fullminilist_rev(N_states,fullinteresting(0))) do i=1,fullinteresting(0) do j = 1, N_states coef_fullminilist_rev(j,i) = psi_coef_sorted(fullinteresting(i),j) @@ -588,7 +588,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d do i=1,fullinteresting(0) fullminilist(1:N_int,1:2,i) = psi_det_sorted(1:N_int,1:2,fullinteresting(i)) enddo - + do i=1,interesting(0) minilist(1:N_int,1:2,i) = psi_det_sorted(1:N_int,1:2,interesting(i)) enddo @@ -624,21 +624,21 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d monoAdo = .false. end if end if - + maskInd = maskInd + 1 if(mod(maskInd, csubset) == (subset-1)) then - + call spot_isinwf(mask, fullminilist, i_generator, fullinteresting(0), banned, fullMatch, fullinteresting) if(fullMatch) cycle ! !$OMP CRITICAL ! print *, 'Step3: ', i_generator, h1, interesting(0) ! !$OMP END CRITICAL - + call splash_pq(mask, sp, minilist, i_generator, interesting(0), bannedOrb, banned, mat, interesting) - + if(.not.pert_2rdm)then call fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, variance, norm, mat, buf) - else + else call fill_buffer_double_rdm(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, variance, norm, mat, buf,fullminilist, coef_fullminilist_rev, fullinteresting(0)) endif end if @@ -682,7 +682,7 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d double precision, allocatable :: values(:) integer, allocatable :: keys(:,:) integer :: nkeys - + if(sp == 3) then s1 = 1 @@ -712,7 +712,7 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d ! to a determinant of the future. In that case, the determinant will be ! detected as already generated when generating in the future with a ! double excitation. -! +! ! if (.not.do_singles) then ! if ((h1 == p1) .or. (h2 == p2)) then ! cycle @@ -783,6 +783,8 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d norm(istate) = norm(istate) + coef * coef !!!DEBUG +! pt2(istate) = pt2(istate) - e_pert + alpha_h_psi**2/delta_E +! ! integer :: k ! double precision :: alpha_h_psi_2,hij ! alpha_h_psi_2 = 0.d0 @@ -792,7 +794,7 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d ! enddo ! if(dabs(alpha_h_psi_2 - alpha_h_psi).gt.1.d-12)then ! call debug_det(psi_det_generators(1,1,i_generator),N_int) -! call debug_det(det,N_int) +! call debug_det(det,N_int) ! print*,'alpha_h_psi,alpha_h_psi_2 = ',alpha_h_psi,alpha_h_psi_2 ! stop ! endif @@ -816,7 +818,7 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d if(pseudo_sym)then - if(dabs(mat(1, p1, p2)).lt.thresh_sym)then + if(dabs(mat(1, p1, p2)).lt.thresh_sym)then w = 0.d0 endif endif @@ -857,7 +859,7 @@ subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, intere negMask(i,2) = not(mask(i,2)) end do - do i=1, N_sel + do i=1, N_sel if (interesting(i) < 0) then stop 'prefetch interesting(i) and det(i)' endif @@ -1210,7 +1212,7 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) endif end if ! enddo -! +! putj = p2 ! do puti=1,mo_num !HOT if(.not. banned(putj,puti,bant)) then @@ -1573,15 +1575,15 @@ subroutine get_d0_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p, double precision, intent(in) :: coefs(N_states) double precision, intent(inout) :: mat(N_states, mo_num, mo_num) integer, intent(in) :: h(0:2,2), p(0:4,2), sp - + integer :: i, j, s, h1, h2, p1, p2, puti, putj double precision :: hij, phase double precision, external :: get_phase_bi, mo_two_e_integral logical :: ok - + integer :: bant bant = 1 - + if(sp == 3) then ! AB h1 = p(1,1) @@ -1619,7 +1621,7 @@ subroutine get_d0_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p, end do end do end if -end +end subroutine get_d1_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) use bitmasks @@ -1639,27 +1641,27 @@ subroutine get_d1_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p, logical, allocatable :: lbanned(:,:) integer :: puti, putj, ma, mi, s1, s2, i, i1, i2, j integer :: hfix, pfix, h1, h2, p1, p2, ib - + integer, parameter :: turn2(2) = (/2,1/) integer, parameter :: turn3(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/)) - + integer :: bant - - + + allocate (lbanned(mo_num, 2)) lbanned = bannedOrb - + do i=1, p(0,1) lbanned(p(i,1), 1) = .true. end do do i=1, p(0,2) lbanned(p(i,2), 2) = .true. end do - + ma = 1 if(p(0,2) >= 2) ma = 2 mi = turn2(ma) - + bant = 1 if(sp == 3) then @@ -1682,7 +1684,7 @@ subroutine get_d1_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p, tmp_row(1:N_states,putj) += hij * coefs(1:N_states) end do - if(ma == 1) then + if(ma == 1) then mat(1:N_states,1:mo_num,puti) += tmp_row(1:N_states,1:mo_num) else mat(1:N_states,puti,1:mo_num) += tmp_row(1:N_states,1:mo_num) @@ -1701,14 +1703,14 @@ subroutine get_d1_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p, hij = mo_two_e_integral(p2,pfix,hfix,puti) * get_phase_bi(phasemask, ma, mi, hfix, p2, puti, pfix, N_int) tmp_row(:,puti) += hij * coefs(:) end if - + putj = p2 if(.not. banned(putj,puti,bant)) then hij = mo_two_e_integral(p1,pfix,hfix,puti) * get_phase_bi(phasemask, ma, mi, hfix, p1, puti, pfix, N_int) tmp_row2(:,puti) += hij * coefs(:) end if end do - + if(mi == 1) then mat(:,:,p1) += tmp_row(:,:) mat(:,:,p2) += tmp_row2(:,:) @@ -1752,7 +1754,7 @@ subroutine get_d1_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p, hij = mo_two_e_integral(pfix, p1, hfix, puti) * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p1, N_int) tmp_row(:,puti) += hij * coefs(:) end if - + putj = p1 if(.not. banned(puti,putj,1)) then hij = mo_two_e_integral(pfix, p2, hfix, puti) * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p2, N_int) @@ -1788,7 +1790,7 @@ subroutine get_d1_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p, mat(:, p1, p2) += coefs(:) * hij end do end do -end +end subroutine get_d2_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) use bitmasks @@ -1800,30 +1802,30 @@ subroutine get_d2_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p, double precision, intent(in) :: coefs(N_states) double precision, intent(inout) :: mat(N_states, mo_num, mo_num) integer, intent(in) :: h(0:2,2), p(0:4,2), sp - + double precision, external :: get_phase_bi, mo_two_e_integral - + integer :: i, j, tip, ma, mi, puti, putj integer :: h1, h2, p1, p2, i1, i2 double precision :: hij, phase - + integer, parameter:: turn2d(2,3,4) = reshape((/0,0, 0,0, 0,0, 3,4, 0,0, 0,0, 2,4, 1,4, 0,0, 2,3, 1,3, 1,2 /), (/2,3,4/)) integer, parameter :: turn2(2) = (/2, 1/) integer, parameter :: turn3(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/)) - + integer :: bant bant = 1 tip = p(0,1) * p(0,2) - + ma = sp if(p(0,1) > p(0,2)) ma = 1 if(p(0,1) < p(0,2)) ma = 2 mi = mod(ma, 2) + 1 - + if(sp == 3) then if(ma == 2) bant = 2 - + if(tip == 3) then puti = p(1, mi) do i = 1, 3 @@ -1835,7 +1837,7 @@ subroutine get_d2_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p, p2 = p(i2, ma) h1 = h(1, ma) h2 = h(2, ma) - + hij = (mo_two_e_integral(p1, p2, h1, h2) - mo_two_e_integral(p2,p1, h1, h2)) * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2, N_int) if(ma == 1) then mat(:, putj, puti) += coefs(:) * hij @@ -1851,10 +1853,10 @@ subroutine get_d2_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p, p2 = p(turn2(j), 2) do i = 1,2 puti = p(i, 1) - + if(banned(puti,putj,bant)) cycle p1 = p(turn2(i), 1) - + hij = mo_two_e_integral(p1, p2, h1, h2) * get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2,N_int) mat(:, puti, putj) += coefs(:) * hij end do @@ -1870,7 +1872,7 @@ subroutine get_d2_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p, do j=i+1,4 putj = p(j, ma) if(banned(puti,putj,1)) cycle - + i1 = turn2d(1, i, j) i2 = turn2d(2, i, j) p1 = p(i1, ma) @@ -1888,7 +1890,7 @@ subroutine get_d2_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p, putj = p(turn3(2,i), ma) if(banned(puti,putj,1)) cycle p2 = p(i, ma) - + hij = mo_two_e_integral(p1, p2, h1, h2) * get_phase_bi(phasemask, mi, ma, h1, p1, h2, p2,N_int) mat(:, min(puti, putj), max(puti, putj)) += coefs(:) * hij end do @@ -1905,6 +1907,6 @@ subroutine get_d2_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p, end if end if end if -end +end