mirror of
https://github.com/LCPQ/quantum_package
synced 2025-01-05 11:00:10 +01:00
Corrected for use with new irpf90
This commit is contained in:
parent
b08ced8741
commit
cdd59910ff
@ -42,7 +42,7 @@ subroutine assert(cond, msg)
|
|||||||
print *, "assert fail: "//msg
|
print *, "assert fail: "//msg
|
||||||
stop
|
stop
|
||||||
end if
|
end if
|
||||||
end subroutine
|
end
|
||||||
|
|
||||||
|
|
||||||
subroutine get_mask_phase(det, phasemask)
|
subroutine get_mask_phase(det, phasemask)
|
||||||
@ -64,7 +64,7 @@ subroutine get_mask_phase(det, phasemask)
|
|||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end subroutine
|
end
|
||||||
|
|
||||||
|
|
||||||
subroutine select_connected(i_generator,E0,pt2,b,subset)
|
subroutine select_connected(i_generator,E0,pt2,b,subset)
|
||||||
@ -92,7 +92,7 @@ subroutine select_connected(i_generator,E0,pt2,b,subset)
|
|||||||
enddo
|
enddo
|
||||||
call select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2,b,subset)
|
call select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2,b,subset)
|
||||||
enddo
|
enddo
|
||||||
end subroutine
|
end
|
||||||
|
|
||||||
|
|
||||||
double precision function get_phase_bi(phasemask, s1, s2, h1, p1, h2, p2)
|
double precision function get_phase_bi(phasemask, s1, s2, h1, p1, h2, p2)
|
||||||
@ -111,7 +111,7 @@ double precision function get_phase_bi(phasemask, s1, s2, h1, p1, h2, p2)
|
|||||||
|
|
||||||
if(s1 == s2 .and. max(h1, p1) > min(h2, p2)) np = np + 1_1
|
if(s1 == s2 .and. max(h1, p1) > min(h2, p2)) np = np + 1_1
|
||||||
get_phase_bi = res(iand(np,1_1))
|
get_phase_bi = res(iand(np,1_1))
|
||||||
end subroutine
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -170,7 +170,7 @@ subroutine get_m2(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs)
|
|||||||
vect(:, puti) += hij * coefs
|
vect(:, puti) += hij * coefs
|
||||||
end if
|
end if
|
||||||
end if
|
end if
|
||||||
end subroutine
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -233,7 +233,7 @@ subroutine get_m1(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs)
|
|||||||
call apply_particle(mask, sp, p1, det, ok, N_int)
|
call apply_particle(mask, sp, p1, det, ok, N_int)
|
||||||
call i_h_j(gen, det, N_int, hij)
|
call i_h_j(gen, det, N_int, hij)
|
||||||
vect(:, p1) += hij * coefs
|
vect(:, p1) += hij * coefs
|
||||||
end subroutine
|
end
|
||||||
|
|
||||||
|
|
||||||
subroutine get_m0(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs)
|
subroutine get_m0(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs)
|
||||||
@ -259,7 +259,7 @@ subroutine get_m0(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs)
|
|||||||
call i_h_j(gen, det, N_int, hij)
|
call i_h_j(gen, det, N_int, hij)
|
||||||
vect(:, i) += hij * coefs
|
vect(:, i) += hij * coefs
|
||||||
end do
|
end do
|
||||||
end subroutine
|
end
|
||||||
|
|
||||||
subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2,buf,subset)
|
subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2,buf,subset)
|
||||||
use bitmasks
|
use bitmasks
|
||||||
@ -471,7 +471,7 @@ subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
end subroutine
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -537,7 +537,7 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
|
|||||||
end if
|
end if
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end subroutine
|
end
|
||||||
|
|
||||||
|
|
||||||
subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, interesting)
|
subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, interesting)
|
||||||
@ -612,7 +612,7 @@ subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, intere
|
|||||||
end if
|
end if
|
||||||
end if
|
end if
|
||||||
end do
|
end do
|
||||||
end subroutine
|
end
|
||||||
|
|
||||||
|
|
||||||
subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
|
subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
|
||||||
@ -730,7 +730,7 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
|
|||||||
end if
|
end if
|
||||||
end if
|
end if
|
||||||
end if
|
end if
|
||||||
end subroutine
|
end
|
||||||
|
|
||||||
|
|
||||||
subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
|
subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
|
||||||
@ -897,7 +897,7 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
|
|||||||
mat(:, p1, p2) += coefs * hij
|
mat(:, p1, p2) += coefs * hij
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end subroutine
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -959,7 +959,7 @@ subroutine get_d0(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
|
|||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end if
|
end if
|
||||||
end subroutine
|
end
|
||||||
|
|
||||||
|
|
||||||
subroutine past_d1(bannedOrb, p)
|
subroutine past_d1(bannedOrb, p)
|
||||||
@ -975,7 +975,7 @@ subroutine past_d1(bannedOrb, p)
|
|||||||
bannedOrb(p(i, s), s) = .true.
|
bannedOrb(p(i, s), s) = .true.
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end subroutine
|
end
|
||||||
|
|
||||||
|
|
||||||
subroutine past_d2(banned, p, sp)
|
subroutine past_d2(banned, p, sp)
|
||||||
@ -1000,7 +1000,7 @@ subroutine past_d2(banned, p, sp)
|
|||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end if
|
end if
|
||||||
end subroutine
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -1045,5 +1045,5 @@ subroutine spot_isinwf(mask, det, i_gen, N, banned, fullMatch, interesting)
|
|||||||
call bitstring_to_list(myMask(1,2), list(na+1), nb, N_int)
|
call bitstring_to_list(myMask(1,2), list(na+1), nb, N_int)
|
||||||
banned(list(1), list(2)) = .true.
|
banned(list(1), list(2)) = .true.
|
||||||
end do genl
|
end do genl
|
||||||
end subroutine
|
end
|
||||||
|
|
||||||
|
@ -156,7 +156,7 @@ BEGIN_TEMPLATE
|
|||||||
iorder(i) = i0
|
iorder(i) = i0
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
end subroutine heap_$Xsort$big
|
end subroutine heap_$Xsort_big
|
||||||
|
|
||||||
subroutine $Xsort(x,iorder,isize)
|
subroutine $Xsort(x,iorder,isize)
|
||||||
implicit none
|
implicit none
|
||||||
@ -248,7 +248,7 @@ BEGIN_TEMPLATE
|
|||||||
iorder(j+1_8) = i0
|
iorder(j+1_8) = i0
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
end subroutine insertion_$Xsort
|
end subroutine insertion_$Xsort_big
|
||||||
|
|
||||||
subroutine $Xset_order_big(x,iorder,isize)
|
subroutine $Xset_order_big(x,iorder,isize)
|
||||||
implicit none
|
implicit none
|
||||||
|
Loading…
Reference in New Issue
Block a user