10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-06-29 16:34:50 +02:00

Corrected for use with new irpf90

This commit is contained in:
Anthony Scemama 2017-01-31 21:48:47 +01:00
parent b08ced8741
commit cdd59910ff
2 changed files with 18 additions and 18 deletions

View File

@ -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

View File

@ -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