mirror of
https://gitlab.com/scemama/qp_plugins_scemama.git
synced 2024-08-29 23:43:43 +02:00
C version OK
This commit is contained in:
parent
a264f8bb6f
commit
a9ee23aba4
59
devel/ccsd_gpu/.gitignore
vendored
Normal file
59
devel/ccsd_gpu/.gitignore
vendored
Normal file
@ -0,0 +1,59 @@
|
||||
IRPF90_temp/
|
||||
IRPF90_man/
|
||||
build.ninja
|
||||
irpf90.make
|
||||
ezfio_interface.irp.f
|
||||
irpf90_entities
|
||||
tags
|
||||
Makefile
|
||||
ao_basis
|
||||
ao_one_e_ints
|
||||
ao_two_e_erf_ints
|
||||
ao_two_e_ints
|
||||
aux_quantities
|
||||
becke_numerical_grid
|
||||
bitmask
|
||||
cis
|
||||
cisd
|
||||
cipsi
|
||||
davidson
|
||||
davidson_dressed
|
||||
davidson_undressed
|
||||
density_for_dft
|
||||
determinants
|
||||
dft_keywords
|
||||
dft_utils_in_r
|
||||
dft_utils_one_e
|
||||
dft_utils_two_body
|
||||
dressing
|
||||
dummy
|
||||
electrons
|
||||
ezfio_files
|
||||
fci
|
||||
generators_cas
|
||||
generators_full
|
||||
hartree_fock
|
||||
iterations
|
||||
kohn_sham
|
||||
kohn_sham_rs
|
||||
mo_basis
|
||||
mo_guess
|
||||
mo_one_e_ints
|
||||
mo_two_e_erf_ints
|
||||
mo_two_e_ints
|
||||
mpi
|
||||
mrpt_utils
|
||||
nuclei
|
||||
perturbation
|
||||
pseudo
|
||||
psiref_cas
|
||||
psiref_utils
|
||||
scf_utils
|
||||
selectors_cassd
|
||||
selectors_full
|
||||
selectors_utils
|
||||
single_ref_method
|
||||
slave
|
||||
tools
|
||||
utils
|
||||
zmq
|
225
devel/ccsd_gpu/80.ccsd_spin.bats
Normal file
225
devel/ccsd_gpu/80.ccsd_spin.bats
Normal file
@ -0,0 +1,225 @@
|
||||
#!/usr/bin/env bats
|
||||
|
||||
source $QP_ROOT/tests/bats/common.bats.sh
|
||||
source $QP_ROOT/quantum_package.rc
|
||||
|
||||
|
||||
function run() {
|
||||
thresh1=1e-6
|
||||
thresh2=1e-6
|
||||
test_exe scf || skip
|
||||
qp set_file $1
|
||||
qp edit --check
|
||||
#qp run scf
|
||||
qp set_frozen_core
|
||||
qp set utils_cc cc_par_t true
|
||||
qp set utils_cc cc_thresh_conv 1e-12
|
||||
file="$(echo $1 | sed 's/.ezfio//g')"
|
||||
qp run ccsd_spin_orb | tee $file.ccsd.out
|
||||
energy1="$(grep 'E(CCSD)' $file.ccsd.out | tail -n 1 | awk '{printf $3}')"
|
||||
energy2="$(grep 'E(T)' $file.ccsd.out | tail -n 1 | awk '{printf $3}')"
|
||||
#rm $file.ccsd.out
|
||||
eq $energy1 $2 $thresh1
|
||||
eq $energy2 $3 $thresh2
|
||||
}
|
||||
|
||||
@test "b2_stretched" {
|
||||
run b2_stretched.ezfio -49.136487344382 -0.003497589175
|
||||
}
|
||||
|
||||
@test "be" {
|
||||
run be.ezfio -14.623559003577 -0.000230982022
|
||||
}
|
||||
|
||||
@test "c2h2" {
|
||||
run c2h2.ezfio -12.394008897618 -0.010790491561
|
||||
}
|
||||
|
||||
@test "ch4" {
|
||||
run ch4.ezfio -40.390721785799 -0.004476100282
|
||||
}
|
||||
|
||||
@test "clf" {
|
||||
run clf.ezfio -559.186562904081 -0.006577143392
|
||||
}
|
||||
|
||||
@test "clo" {
|
||||
run clo.ezfio -534.564874409332 -0.007584571424
|
||||
}
|
||||
|
||||
@test "co2" {
|
||||
run co2.ezfio -188.129602527766 -0.018040668885
|
||||
}
|
||||
|
||||
@test "dhno" {
|
||||
run dhno.ezfio -130.816650109473 -0.012197331453
|
||||
}
|
||||
|
||||
@test "f2" {
|
||||
run f2.ezfio -199.287826338097 -0.017592872692
|
||||
}
|
||||
|
||||
@test "f" {
|
||||
run f.ezfio -99.616644511121 -0.003624525307
|
||||
}
|
||||
|
||||
@test "h2o2" {
|
||||
run h2o2.ezfio -151.182552729963 -0.009511682086
|
||||
}
|
||||
|
||||
@test "h2o" {
|
||||
run h2o.ezfio -76.237710276526 -0.003001800577
|
||||
}
|
||||
|
||||
@test "h2s" {
|
||||
run h2s.ezfio -398.861214015390 -0.003300559757
|
||||
}
|
||||
|
||||
@test "h3coh" {
|
||||
run h3coh.ezfio -115.221296424969 -0.003566171432
|
||||
}
|
||||
|
||||
@test "hbo" {
|
||||
run hbo.ezfio -100.213539770415 -0.006851489212
|
||||
}
|
||||
|
||||
@test "hcn" {
|
||||
run hcn.ezfio -93.190247992657 -0.013418135043
|
||||
}
|
||||
|
||||
@test "hco" {
|
||||
run hco.ezfio -113.405413962350 -0.007973455337
|
||||
}
|
||||
|
||||
@test "lif" {
|
||||
run lif.ezfio -107.270402903250 -0.007742969005
|
||||
}
|
||||
|
||||
@test "n2" {
|
||||
run n2.ezfio -109.355358930472 -0.018477744342
|
||||
}
|
||||
|
||||
@test "n2h4" {
|
||||
run n2h4.ezfio -111.556885923139 -0.009048077008
|
||||
}
|
||||
|
||||
@test "nh3" {
|
||||
run nh3.ezfio -56.465503060954 -0.007638273755
|
||||
}
|
||||
|
||||
@test "oh" {
|
||||
run oh.ezfio -75.614606132774 -0.004126661739
|
||||
}
|
||||
|
||||
@test "sih2_3b1" {
|
||||
run sih2_3b1.ezfio -290.016780973072 -0.000497825874
|
||||
}
|
||||
|
||||
@test "sih3" {
|
||||
run sih3.ezfio -5.575343504534 -0.002094123268
|
||||
}
|
||||
|
||||
@test "so" {
|
||||
run so.ezfio -26.035945178665 -0.010594351274
|
||||
}
|
||||
|
||||
#@test "b2_stretched" {
|
||||
#run b2_stretched.ezfio -49.136487344382 -49.139984933557
|
||||
#}
|
||||
#
|
||||
#@test "be" {
|
||||
#run be.ezfio -14.623559003577 -14.623789985599
|
||||
#}
|
||||
#
|
||||
#@test "c2h2" {
|
||||
#run c2h2.ezfio -12.394008897618 -12.404799389179
|
||||
#}
|
||||
#
|
||||
#@test "ch4" {
|
||||
#run ch4.ezfio -40.390721784961 -40.395197884406
|
||||
#}
|
||||
#
|
||||
#@test "clf" {
|
||||
#run clf.ezfio -559.186562906072 -559.193140046904
|
||||
#}
|
||||
#
|
||||
#@test "clo" {
|
||||
#run clo.ezfio -534.564874409333 -534.572458980757
|
||||
#}
|
||||
#
|
||||
#@test "co2" {
|
||||
#run co2.ezfio -188.129602511724 -188.147643198675
|
||||
#}
|
||||
#
|
||||
#@test "dhno" {
|
||||
#run dhno.ezfio -130.816650109473 -130.828847440925
|
||||
#}
|
||||
#
|
||||
#@test "f2" {
|
||||
#run f2.ezfio -199.287826338097 -199.305419210789
|
||||
#}
|
||||
#
|
||||
#@test "f" {
|
||||
#run f.ezfio -99.616644511120 -99.620269036428
|
||||
#}
|
||||
#
|
||||
#@test "h2o2" {
|
||||
#run h2o2.ezfio -151.182552729963 -151.192064412049
|
||||
#}
|
||||
#
|
||||
#@test "h2o" {
|
||||
#run h2o.ezfio -76.237710276526 -76.240712077103
|
||||
#}
|
||||
#
|
||||
#@test "h2s" {
|
||||
#run h2s.ezfio -398.861214015416 -398.864514575146
|
||||
#}
|
||||
#
|
||||
#@test "h3coh" {
|
||||
#run h3coh.ezfio -115.221296424969 -115.224862596401
|
||||
#}
|
||||
#
|
||||
#@test "hbo" {
|
||||
#run hbo.ezfio -100.213539770415 -100.220391259627
|
||||
#}
|
||||
#
|
||||
#@test "hcn" {
|
||||
#run hcn.ezfio -93.190247983000 -93.203666131216
|
||||
#}
|
||||
#
|
||||
#@test "hco" {
|
||||
#run hco.ezfio -113.405413962350 -113.413387417687
|
||||
#}
|
||||
#
|
||||
#@test "lif" {
|
||||
#run lif.ezfio -107.270402903211 -107.278145872216
|
||||
#}
|
||||
#
|
||||
#@test "n2" {
|
||||
#run n2.ezfio -109.355358930472 -109.373836674814
|
||||
#}
|
||||
#
|
||||
#@test "n2h4" {
|
||||
#run n2h4.ezfio -111.556885922642 -111.565934000556
|
||||
#}
|
||||
#
|
||||
#@test "nh3" {
|
||||
#run nh3.ezfio -56.465503060954 -56.473141334709
|
||||
#}
|
||||
#
|
||||
#@test "oh" {
|
||||
#run oh.ezfio -75.614606131897 -75.618732794235
|
||||
#}
|
||||
#
|
||||
#@test "sih2_3b1" {
|
||||
#run sih2_3b1.ezfio -290.016780973071 -290.017278798946
|
||||
#}
|
||||
#
|
||||
#@test "sih3" {
|
||||
#run sih3.ezfio -5.575343504534 -5.577437627802
|
||||
#}
|
||||
#
|
||||
#@test "so" {
|
||||
#run so.ezfio -26.035945181998 -26.046539528491
|
||||
#}
|
||||
|
225
devel/ccsd_gpu/81.ccsd_space.bats
Normal file
225
devel/ccsd_gpu/81.ccsd_space.bats
Normal file
@ -0,0 +1,225 @@
|
||||
#!/usr/bin/env bats
|
||||
|
||||
source $QP_ROOT/tests/bats/common.bats.sh
|
||||
source $QP_ROOT/quantum_package.rc
|
||||
|
||||
|
||||
function run() {
|
||||
thresh1=1e-6
|
||||
thresh2=1e-6
|
||||
test_exe scf || skip
|
||||
qp set_file $1
|
||||
qp edit --check
|
||||
#qp run scf
|
||||
qp set_frozen_core
|
||||
qp set utils_cc cc_par_t true
|
||||
qp set utils_cc cc_thresh_conv 1e-12
|
||||
file="$(echo $1 | sed 's/.ezfio//g')"
|
||||
qp run ccsd_space_orb | tee $file.ccsd.out
|
||||
energy1="$(grep 'E(CCSD)' $file.ccsd.out | tail -n 1 | awk '{printf $3}')"
|
||||
energy2="$(grep 'E(T)' $file.ccsd.out | tail -n 1 | awk '{printf $3}')"
|
||||
#rm $file.ccsd.out
|
||||
eq $energy1 $2 $thresh1
|
||||
eq $energy2 $3 $thresh2
|
||||
}
|
||||
|
||||
@test "b2_stretched" {
|
||||
run b2_stretched.ezfio -49.136487344382 -0.003497589175
|
||||
}
|
||||
|
||||
@test "be" {
|
||||
run be.ezfio -14.623559003577 -0.000230982022
|
||||
}
|
||||
|
||||
@test "c2h2" {
|
||||
run c2h2.ezfio -12.394008897618 -0.010790491561
|
||||
}
|
||||
|
||||
@test "ch4" {
|
||||
run ch4.ezfio -40.390721785799 -0.004476100282
|
||||
}
|
||||
|
||||
@test "clf" {
|
||||
run clf.ezfio -559.186562904081 -0.006577143392
|
||||
}
|
||||
|
||||
#@test "clo" {
|
||||
#run clo.ezfio -534.564874409332 -0.007584571424
|
||||
#}
|
||||
|
||||
@test "co2" {
|
||||
run co2.ezfio -188.129602527766 -0.018040668885
|
||||
}
|
||||
|
||||
#@test "dhno" {
|
||||
#run dhno.ezfio -130.816650109473 -0.012197331453
|
||||
#}
|
||||
|
||||
@test "f2" {
|
||||
run f2.ezfio -199.287826338097 -0.017592872692
|
||||
}
|
||||
|
||||
#@test "f" {
|
||||
#run f.ezfio -99.616644511121 -0.003624525307
|
||||
#}
|
||||
|
||||
@test "h2o2" {
|
||||
run h2o2.ezfio -151.182552729963 -0.009511682086
|
||||
}
|
||||
|
||||
@test "h2o" {
|
||||
run h2o.ezfio -76.237710276526 -0.003001800577
|
||||
}
|
||||
|
||||
@test "h2s" {
|
||||
run h2s.ezfio -398.861214015390 -0.003300559757
|
||||
}
|
||||
|
||||
@test "h3coh" {
|
||||
run h3coh.ezfio -115.221296424969 -0.003566171432
|
||||
}
|
||||
|
||||
@test "hbo" {
|
||||
run hbo.ezfio -100.213539770415 -0.006851489212
|
||||
}
|
||||
|
||||
@test "hcn" {
|
||||
run hcn.ezfio -93.190247992657 -0.013418135043
|
||||
}
|
||||
|
||||
#@test "hco" {
|
||||
#run hco.ezfio -113.405413962350 -0.007973455337
|
||||
#}
|
||||
|
||||
@test "lif" {
|
||||
run lif.ezfio -107.270402903250 -0.007742969005
|
||||
}
|
||||
|
||||
@test "n2" {
|
||||
run n2.ezfio -109.355358930472 -0.018477744342
|
||||
}
|
||||
|
||||
@test "n2h4" {
|
||||
run n2h4.ezfio -111.556885923139 -0.009048077008
|
||||
}
|
||||
|
||||
@test "nh3" {
|
||||
run nh3.ezfio -56.465503060954 -0.007638273755
|
||||
}
|
||||
|
||||
#@test "oh" {
|
||||
#run oh.ezfio -75.614606132774 -0.004126661739
|
||||
#}
|
||||
|
||||
#@test "sih2_3b1" {
|
||||
#run sih2_3b1.ezfio -290.016780973072 -0.000497825874
|
||||
#}
|
||||
|
||||
#@test "sih3" {
|
||||
#run sih3.ezfio -5.575343504534 -0.002094123268
|
||||
#}
|
||||
|
||||
#@test "so" {
|
||||
#run so.ezfio -26.035945178665 -0.010594351274
|
||||
#}
|
||||
|
||||
#@test "b2_stretched" {
|
||||
#run b2_stretched.ezfio -49.136487344382 -49.139984933557
|
||||
#}
|
||||
#
|
||||
#@test "be" {
|
||||
#run be.ezfio -14.623559003577 -14.623789985599
|
||||
#}
|
||||
#
|
||||
#@test "c2h2" {
|
||||
#run c2h2.ezfio -12.394008897618 -12.404799389179
|
||||
#}
|
||||
#
|
||||
#@test "ch4" {
|
||||
#run ch4.ezfio -40.390721784961 -40.395197884406
|
||||
#}
|
||||
#
|
||||
#@test "clf" {
|
||||
#run clf.ezfio -559.186562906072 -559.193140046904
|
||||
#}
|
||||
#
|
||||
##@test "clo" {
|
||||
##run clo.ezfio -534.564874409333 -534.572458980757
|
||||
##}
|
||||
#
|
||||
#@test "co2" {
|
||||
#run co2.ezfio -188.129602511724 -188.147643198675
|
||||
#}
|
||||
#
|
||||
##@test "dhno" {
|
||||
##run dhno.ezfio -130.816650109473 -130.828847440925
|
||||
##}
|
||||
#
|
||||
#@test "f2" {
|
||||
#run f2.ezfio -199.287826338097 -199.305419210789
|
||||
#}
|
||||
#
|
||||
##@test "f" {
|
||||
##run f.ezfio -99.616644511120 -99.620269036428
|
||||
##}
|
||||
#
|
||||
#@test "h2o2" {
|
||||
#run h2o2.ezfio -151.182552729963 -151.192064412049
|
||||
#}
|
||||
#
|
||||
#@test "h2o" {
|
||||
#run h2o.ezfio -76.237710276526 -76.240712077103
|
||||
#}
|
||||
#
|
||||
#@test "h2s" {
|
||||
#run h2s.ezfio -398.861214015416 -398.864514575146
|
||||
#}
|
||||
#
|
||||
#@test "h3coh" {
|
||||
#run h3coh.ezfio -115.221296424969 -115.224862596401
|
||||
#}
|
||||
#
|
||||
#@test "hbo" {
|
||||
#run hbo.ezfio -100.213539770415 -100.220391259627
|
||||
#}
|
||||
#
|
||||
#@test "hcn" {
|
||||
#run hcn.ezfio -93.190247983000 -93.203666131216
|
||||
#}
|
||||
#
|
||||
##@test "hco" {
|
||||
##run hco.ezfio -113.405413962350 -113.413387417687
|
||||
##}
|
||||
#
|
||||
#@test "lif" {
|
||||
#run lif.ezfio -107.270402903211 -107.278145872216
|
||||
#}
|
||||
#
|
||||
#@test "n2" {
|
||||
#run n2.ezfio -109.355358930472 -109.373836674814
|
||||
#}
|
||||
#
|
||||
#@test "n2h4" {
|
||||
#run n2h4.ezfio -111.556885922642 -111.565934000556
|
||||
#}
|
||||
#
|
||||
#@test "nh3" {
|
||||
#run nh3.ezfio -56.465503060954 -56.473141334709
|
||||
#}
|
||||
#
|
||||
##@test "oh" {
|
||||
##run oh.ezfio -75.614606131897 -75.618732794235
|
||||
##}
|
||||
#
|
||||
##@test "sih2_3b1" {
|
||||
##run sih2_3b1.ezfio -290.016780973071 -290.017278798946
|
||||
##}
|
||||
#
|
||||
##@test "sih3" {
|
||||
##run sih3.ezfio -5.575343504534 -5.577437627802
|
||||
##}
|
||||
#
|
||||
##@test "so" {
|
||||
##run so.ezfio -26.035945181998 -26.046539528491
|
||||
##}
|
||||
|
11
devel/ccsd_gpu/EZFIO.cfg
Normal file
11
devel/ccsd_gpu/EZFIO.cfg
Normal file
@ -0,0 +1,11 @@
|
||||
[energy]
|
||||
type: double precision
|
||||
doc: CCSD energy
|
||||
interface: ezfio
|
||||
|
||||
[energy_t]
|
||||
type: double precision
|
||||
doc: CCSD(T) energy
|
||||
interface: ezfio
|
||||
|
||||
|
2
devel/ccsd_gpu/NEED
Normal file
2
devel/ccsd_gpu/NEED
Normal file
@ -0,0 +1,2 @@
|
||||
hartree_fock
|
||||
utils_cc
|
31
devel/ccsd_gpu/README.md
Normal file
31
devel/ccsd_gpu/README.md
Normal file
@ -0,0 +1,31 @@
|
||||
# CCSD in spin orbitals and spatial orbitals
|
||||
|
||||
CCSD and CCSD(T) in spin orbitals for open and closed shell systems.
|
||||
CCSD and CCSD(T) in spatial orbitals for closed shell systems.
|
||||
|
||||
## Calculations
|
||||
The program will automatically choose the version in spin or spatial orbitals
|
||||
To run the general program:
|
||||
```
|
||||
qp run ccsd
|
||||
```
|
||||
Nevertheless, you can enforce the run in spin orbitals with
|
||||
```
|
||||
qp run ccsd_spin_orb
|
||||
```
|
||||
|
||||
## Settings
|
||||
The settings can be changed with:
|
||||
```
|
||||
qp set utils_cc cc_#param #val
|
||||
```
|
||||
For more informations on the settings, look at the module utils_cc and its documentation.
|
||||
|
||||
## Org files
|
||||
The org files are stored in the directory org in order to avoid overwriting on user changes.
|
||||
The org files can be modified, to export the change to the source code, run
|
||||
```
|
||||
./TANGLE_org_mode.sh and
|
||||
mv *.irp.f ../.
|
||||
```
|
||||
|
4
devel/ccsd_gpu/README.rst
Normal file
4
devel/ccsd_gpu/README.rst
Normal file
@ -0,0 +1,4 @@
|
||||
========
|
||||
ccsd_gpu
|
||||
========
|
||||
|
18
devel/ccsd_gpu/ccsd_gpu.irp.f
Normal file
18
devel/ccsd_gpu/ccsd_gpu.irp.f
Normal file
@ -0,0 +1,18 @@
|
||||
program ccsd
|
||||
|
||||
implicit none
|
||||
|
||||
BEGIN_DOC
|
||||
! CCSD program
|
||||
END_DOC
|
||||
|
||||
read_wf = .True.
|
||||
touch read_wf
|
||||
|
||||
if (.not. cc_ref_is_open_shell) then
|
||||
call run_ccsd_space_orb
|
||||
else
|
||||
stop 'Not implemented'
|
||||
endif
|
||||
|
||||
end
|
2311
devel/ccsd_gpu/ccsd_space_orb_sub.irp.f
Normal file
2311
devel/ccsd_gpu/ccsd_space_orb_sub.irp.f
Normal file
File diff suppressed because it is too large
Load Diff
1515
devel/ccsd_gpu/ccsd_space_orb_sub_chol.irp.f
Normal file
1515
devel/ccsd_gpu/ccsd_space_orb_sub_chol.irp.f
Normal file
File diff suppressed because it is too large
Load Diff
513
devel/ccsd_gpu/ccsd_t_space_orb.irp.f
Normal file
513
devel/ccsd_gpu/ccsd_t_space_orb.irp.f
Normal file
@ -0,0 +1,513 @@
|
||||
! Dumb way
|
||||
|
||||
subroutine ccsd_par_t_space(nO,nV,t1,t2,energy)
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: nO,nV
|
||||
double precision, intent(in) :: t1(nO, nV)
|
||||
double precision, intent(in) :: t2(nO, nO, nV, nV)
|
||||
double precision, intent(out) :: energy
|
||||
|
||||
double precision, allocatable :: W(:,:,:,:,:,:)
|
||||
double precision, allocatable :: V(:,:,:,:,:,:)
|
||||
integer :: i,j,k,a,b,c
|
||||
|
||||
allocate(W(nO,nO,nO,nV,nV,nV))
|
||||
allocate(V(nO,nO,nO,nV,nV,nV))
|
||||
|
||||
call form_w(nO,nV,t2,W)
|
||||
call form_v(nO,nV,t1,W,V)
|
||||
|
||||
energy = 0d0
|
||||
do c = 1, nV
|
||||
do b = 1, nV
|
||||
do a = 1, nV
|
||||
do k = 1, nO
|
||||
do j = 1, nO
|
||||
do i = 1, nO
|
||||
energy = energy + (4d0 * W(i,j,k,a,b,c) + W(i,j,k,b,c,a) + W(i,j,k,c,a,b)) * (V(i,j,k,a,b,c) - V(i,j,k,c,b,a)) / (cc_space_f_o(i) + cc_space_f_o(j) + cc_space_f_o(k) - cc_space_f_v(a) - cc_space_f_v(b) - cc_space_f_v(c)) !delta_ooovvv(i,j,k,a,b,c)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
energy = energy / 3d0
|
||||
|
||||
deallocate(V,W)
|
||||
end
|
||||
|
||||
subroutine form_w(nO,nV,t2,W)
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: nO,nV
|
||||
double precision, intent(in) :: t2(nO, nO, nV, nV)
|
||||
double precision, intent(out) :: W(nO, nO, nO, nV, nV, nV)
|
||||
|
||||
integer :: i,j,k,l,a,b,c,d
|
||||
|
||||
W = 0d0
|
||||
do c = 1, nV
|
||||
print*,'W:',c,'/',nV
|
||||
do b = 1, nV
|
||||
do a = 1, nV
|
||||
do k = 1, nO
|
||||
do j = 1, nO
|
||||
do i = 1, nO
|
||||
|
||||
do d = 1, nV
|
||||
W(i,j,k,a,b,c) = W(i,j,k,a,b,c) &
|
||||
! chem (bd|ai)
|
||||
! phys <ba|di>
|
||||
+ cc_space_v_vvvo(b,a,d,i) * t2(k,j,c,d) &
|
||||
+ cc_space_v_vvvo(c,a,d,i) * t2(j,k,b,d) & ! bc kj
|
||||
+ cc_space_v_vvvo(a,c,d,k) * t2(j,i,b,d) & ! prev ac ik
|
||||
+ cc_space_v_vvvo(b,c,d,k) * t2(i,j,a,d) & ! prev ab ij
|
||||
+ cc_space_v_vvvo(c,b,d,j) * t2(i,k,a,d) & ! prev bc kj
|
||||
+ cc_space_v_vvvo(a,b,d,j) * t2(k,i,c,d) ! prev ac ik
|
||||
enddo
|
||||
|
||||
do l = 1, nO
|
||||
W(i,j,k,a,b,c) = W(i,j,k,a,b,c) &
|
||||
! chem (ck|jl)
|
||||
! phys <cj|kl>
|
||||
- cc_space_v_vooo(c,j,k,l) * t2(i,l,a,b) &
|
||||
- cc_space_v_vooo(b,k,j,l) * t2(i,l,a,c) & ! bc kj
|
||||
- cc_space_v_vooo(b,i,j,l) * t2(k,l,c,a) & ! prev ac ik
|
||||
- cc_space_v_vooo(a,j,i,l) * t2(k,l,c,b) & ! prev ab ij
|
||||
- cc_space_v_vooo(a,k,i,l) * t2(j,l,b,c) & ! prev bc kj
|
||||
- cc_space_v_vooo(c,i,k,l) * t2(j,l,b,a) ! prev ac ik
|
||||
enddo
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
end
|
||||
|
||||
subroutine form_v(nO,nV,t1,w,v)
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: nO,nV
|
||||
double precision, intent(in) :: t1(nO, nV)
|
||||
double precision, intent(in) :: W(nO, nO, nO, nV, nV, nV)
|
||||
double precision, intent(out) :: V(nO, nO, nO, nV, nV, nV)
|
||||
|
||||
integer :: i,j,k,a,b,c
|
||||
|
||||
V = 0d0
|
||||
do c = 1, nV
|
||||
do b = 1, nV
|
||||
do a = 1, nV
|
||||
do k = 1, nO
|
||||
do j = 1, nO
|
||||
do i = 1, nO
|
||||
V(i,j,k,a,b,c) = V(i,j,k,a,b,c) + W(i,j,k,a,b,c) &
|
||||
+ cc_space_v_vvoo(b,c,j,k) * t1(i,a) &
|
||||
+ cc_space_v_vvoo(a,c,i,k) * t1(j,b) &
|
||||
+ cc_space_v_vvoo(a,b,i,j) * t1(k,c)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
end
|
||||
|
||||
! Main
|
||||
|
||||
subroutine ccsd_par_t_space_v2(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energy)
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: nO,nV
|
||||
double precision, intent(in) :: t1(nO,nV), f_o(nO), f_v(nV)
|
||||
double precision, intent(in) :: t2(nO,nO,nV,nV)
|
||||
double precision, intent(in) :: v_vvvo(nV,nV,nV,nO), v_vvoo(nV,nV,nO,nO), v_vooo(nV,nO,nO,nO)
|
||||
double precision, intent(out) :: energy
|
||||
|
||||
double precision, allocatable :: W(:,:,:,:,:,:)
|
||||
double precision, allocatable :: V(:,:,:,:,:,:)
|
||||
double precision, allocatable :: W_ijk(:,:,:), V_ijk(:,:,:)
|
||||
double precision, allocatable :: X_vvvo(:,:,:,:), X_ovoo(:,:,:,:), X_vvoo(:,:,:,:)
|
||||
double precision, allocatable :: T_vvoo(:,:,:,:), T_ovvo(:,:,:,:), T_vo(:,:)
|
||||
integer :: i,j,k,l,a,b,c,d
|
||||
double precision :: e,ta,tb, delta, delta_ijk
|
||||
|
||||
!allocate(W(nV,nV,nV,nO,nO,nO))
|
||||
!allocate(V(nV,nV,nV,nO,nO,nO))
|
||||
allocate(W_ijk(nV,nV,nV), V_ijk(nV,nV,nV))
|
||||
allocate(X_vvvo(nV,nV,nV,nO), X_ovoo(nO,nV,nO,nO), X_vvoo(nV,nV,nO,nO))
|
||||
allocate(T_vvoo(nV,nV,nO,nO), T_ovvo(nO,nV,nV,nO), T_vo(nV,nO))
|
||||
|
||||
! Temporary arrays
|
||||
!$OMP PARALLEL &
|
||||
!$OMP SHARED(nO,nV,T_vvoo,T_ovvo,T_vo,X_vvvo,X_ovoo,X_vvoo, &
|
||||
!$OMP t1,t2,v_vvvo,v_vooo,v_vvoo) &
|
||||
!$OMP PRIVATE(a,b,c,d,i,j,k,l) &
|
||||
!$OMP DEFAULT(NONE)
|
||||
|
||||
!v_vvvo(b,a,d,i) * t2(k,j,c,d) &
|
||||
!X_vvvo(d,b,a,i) * T_vvoo(d,c,k,j)
|
||||
|
||||
!$OMP DO collapse(3)
|
||||
do i = 1, nO
|
||||
do a = 1, nV
|
||||
do b = 1, nV
|
||||
do d = 1, nV
|
||||
X_vvvo(d,b,a,i) = v_vvvo(b,a,d,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO nowait
|
||||
|
||||
!$OMP DO collapse(3)
|
||||
do j = 1, nO
|
||||
do k = 1, nO
|
||||
do c = 1, nV
|
||||
do d = 1, nV
|
||||
T_vvoo(d,c,k,j) = t2(k,j,c,d)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO nowait
|
||||
|
||||
!v_vooo(c,j,k,l) * t2(i,l,a,b) &
|
||||
!X_ovoo(l,c,j,k) * T_ovvo(l,a,b,i) &
|
||||
|
||||
!$OMP DO collapse(3)
|
||||
do k = 1, nO
|
||||
do j = 1, nO
|
||||
do c = 1, nV
|
||||
do l = 1, nO
|
||||
X_ovoo(l,c,j,k) = v_vooo(c,j,k,l)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO nowait
|
||||
|
||||
!$OMP DO collapse(3)
|
||||
do i = 1, nO
|
||||
do b = 1, nV
|
||||
do a = 1, nV
|
||||
do l = 1, nO
|
||||
T_ovvo(l,a,b,i) = t2(i,l,a,b)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO nowait
|
||||
|
||||
!v_vvoo(b,c,j,k) * t1(i,a) &
|
||||
!X_vvoo(b,c,k,j) * T1_vo(a,i) &
|
||||
|
||||
!$OMP DO collapse(3)
|
||||
do j = 1, nO
|
||||
do k = 1, nO
|
||||
do c = 1, nV
|
||||
do b = 1, nV
|
||||
X_vvoo(b,c,k,j) = v_vvoo(b,c,j,k)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO nowait
|
||||
|
||||
!$OMP DO collapse(1)
|
||||
do i = 1, nO
|
||||
do a = 1, nV
|
||||
T_vo(a,i) = t1(i,a)
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(ta)
|
||||
energy = 0d0
|
||||
do i = 1, nO
|
||||
do j = 1, nO
|
||||
do k = 1, nO
|
||||
delta_ijk = f_o(i) + f_o(j) + f_o(k)
|
||||
call form_w_ijk(nO,nV,i,j,k,T_vvoo,T_ovvo,X_vvvo,X_ovoo,W_ijk)
|
||||
call form_v_ijk(nO,nV,i,j,k,T_vo,X_vvoo,W_ijk,V_ijk)
|
||||
!$OMP PARALLEL &
|
||||
!$OMP SHARED(energy,nV,i,j,k,W_ijk,V_ijk,f_o,f_v,delta_ijk) &
|
||||
!$OMP PRIVATE(a,b,c,e,delta) &
|
||||
!$OMP DEFAULT(NONE)
|
||||
e = 0d0
|
||||
!$OMP DO
|
||||
do c = 1, nV
|
||||
do b = 1, nV
|
||||
do a = 1, nV
|
||||
delta = 1d0 / (delta_ijk - f_v(a) - f_v(b) - f_v(c))
|
||||
!energy = energy + (4d0 * W(i,j,k,a,b,c) + W(i,j,k,b,c,a) + W(i,j,k,c,a,b)) * (V(i,j,k,a,b,c) - V(i,j,k,c,b,a)) / (cc_space_f_o(i) + cc_space_f_o(j) + cc_space_f_o(k) - cc_space_f_v(a) - cc_space_f_v(b) - cc_space_f_v(c)) !delta_ooovvv(i,j,k,a,b,c)
|
||||
e = e + (4d0 * W_ijk(a,b,c) + W_ijk(b,c,a) + W_ijk(c,a,b)) &
|
||||
* (V_ijk(a,b,c) - V_ijk(c,b,a)) * delta
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO NOWAIT
|
||||
!$OMP CRITICAL
|
||||
energy = energy + e
|
||||
!$OMP END CRITICAL
|
||||
!$OMP END PARALLEL
|
||||
enddo
|
||||
enddo
|
||||
call wall_time(tb)
|
||||
write(*,'(F12.2,A5,F12.2,A2)') dble(i)/dble(nO)*100d0, '% in ', tb - ta, ' s'
|
||||
enddo
|
||||
|
||||
energy = energy / 3d0
|
||||
|
||||
deallocate(W_ijk,V_ijk,X_vvvo,X_ovoo,T_vvoo,T_ovvo,T_vo)
|
||||
!deallocate(V,W)
|
||||
end
|
||||
|
||||
! W_ijk
|
||||
|
||||
subroutine form_w_ijk(nO,nV,i,j,k,T_vvoo,T_ovvo,X_vvvo,X_ovoo,W)
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: nO,nV,i,j,k
|
||||
!double precision, intent(in) :: t2(nO,nO,nV,nV)
|
||||
double precision, intent(in) :: T_vvoo(nV,nV,nO,nO), T_ovvo(nO,nV,nV,nO)
|
||||
double precision, intent(in) :: X_vvvo(nV,nV,nV,nO), X_ovoo(nO,nV,nO,nO)
|
||||
double precision, intent(out) :: W(nV,nV,nV)!,nO,nO,nO)
|
||||
|
||||
integer :: l,a,b,c,d
|
||||
double precision, allocatable, dimension(:,:,:) :: X, Y, Z
|
||||
|
||||
!W = 0d0
|
||||
!do i = 1, nO
|
||||
! do j = 1, nO
|
||||
! do k = 1, nO
|
||||
|
||||
allocate(X(nV,nV,nV))
|
||||
allocate(Y(nV,nV,nV))
|
||||
allocate(Z(nV,nV,nV))
|
||||
|
||||
!$OMP PARALLEL DO
|
||||
do b = 1, nV
|
||||
do a = 1, nV
|
||||
do d = 1, nV
|
||||
Z(d,a,b) = X_vvvo(d,b,a,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
call dgemm('T','N',nV*nV,nV,nV, 1.d0, &
|
||||
Z, nV, T_vvoo(1,1,k,j), nV, 0.d0, W, nV*nV)
|
||||
|
||||
!$OMP PARALLEL DO
|
||||
do c = 1, nV
|
||||
do a = 1, nV
|
||||
do d = 1, nV
|
||||
Z(d,a,c) = X_vvvo(d,c,a,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
call dgemm('T','N',nV*nV,nV,nV, 1.d0, &
|
||||
Z, nV, T_vvoo(1,1,j,k), nV, 0.d0, Y, nV*nV)
|
||||
|
||||
call dgemm('T','N',nV*nV,nV,nV, 1.d0, &
|
||||
X_vvvo(1,1,1,k), nV, T_vvoo(1,1,j,i), nV, 1.d0, Y, nV*nV)
|
||||
|
||||
call dgemm('T','N',nV,nV*nV,nV, 1.d0, &
|
||||
T_vvoo(1,1,i,j), nV, X_vvvo(1,1,1,k), nV, 1.d0, W, nV)
|
||||
|
||||
call dgemm('T','N',nV,nV*nV,nV, 1.d0, &
|
||||
T_vvoo(1,1,i,k), nV, X_vvvo(1,1,1,j), nV, 1.d0, Y, nV)
|
||||
|
||||
call dgemm('T','N',nV*nV,nV,nV, 1.d0, &
|
||||
X_vvvo(1,1,1,j), nV, T_vvoo(1,1,k,i), nV, 1.d0, W, nV*nV)
|
||||
|
||||
deallocate(Z)
|
||||
|
||||
|
||||
allocate(Z(nO,nV,nV))
|
||||
|
||||
call dgemm('T','N',nV*nV,nV,nO, -1.d0, &
|
||||
T_ovvo(1,1,1,i), nO, X_ovoo(1,1,j,k), nO, 1.d0, W, nV*nV)
|
||||
|
||||
call dgemm('T','N',nV*nV,nV,nO, -1.d0, &
|
||||
T_ovvo(1,1,1,i), nO, X_ovoo(1,1,k,j), nO, 1.d0, Y, nV*nV)
|
||||
|
||||
!$OMP PARALLEL DO
|
||||
do c = 1, nV
|
||||
do a = 1, nV
|
||||
do l = 1, nO
|
||||
Z(l,a,c) = T_ovvo(l,c,a,k)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
call dgemm('T','N',nV*nV,nV,nO, -1.d0, &
|
||||
Z, nO, X_ovoo(1,1,i,j), nO, 1.d0, Y, nV*nV)
|
||||
|
||||
call dgemm('T','N',nV,nV*nV,nO, -1.d0, &
|
||||
X_ovoo(1,1,j,i), nO, T_ovvo(1,1,1,k), nO, 1.d0, Y, nV)
|
||||
|
||||
call dgemm('T','N',nV,nV*nV,nO, -1.d0, &
|
||||
X_ovoo(1,1,k,i), nO, T_ovvo(1,1,1,j), nO, 1.d0, W, nV)
|
||||
|
||||
!$OMP PARALLEL DO
|
||||
do b = 1, nV
|
||||
do a = 1, nV
|
||||
do l = 1, nO
|
||||
Z(l,a,b) = T_ovvo(l,b,a,j)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
call dgemm('T','N',nV*nV,nV,nO, -1.d0, &
|
||||
Z, nO, X_ovoo(1,1,i,k), nO, 1.d0, W, nV*nV)
|
||||
|
||||
!$OMP PARALLEL DO
|
||||
do c = 1, nV
|
||||
do b = 1, nV
|
||||
do a = 1, nV
|
||||
W(a,b,c) = W(a,b,c) + Y(a,c,b)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
deallocate(X,Y,Z)
|
||||
|
||||
|
||||
! !$OMP PARALLEL &
|
||||
! !$OMP SHARED(nO,nV,i,j,k,T_vvoo,T_ovvo,X_vvvo,X_ovoo,W) &
|
||||
! !$OMP PRIVATE(a,b,c,d,l) &
|
||||
! !$OMP DEFAULT(NONE)
|
||||
!
|
||||
! !$OMP DO collapse(2)
|
||||
! do c = 1, nV
|
||||
! do b = 1, nV
|
||||
! do a = 1, nV
|
||||
! W(a,b,c) = 0.d0
|
||||
!
|
||||
! do d = 1, nV
|
||||
! !W(i,j,k,a,b,c) = W(i,j,k,a,b,c) &
|
||||
! W(a,b,c) = W(a,b,c) &
|
||||
! ! chem (bd|ai)
|
||||
! ! phys <ba|di>
|
||||
! !+ cc_space_v_vvvo(b,a,d,i) * t2(k,j,c,d) &
|
||||
! !+ cc_space_v_vvvo(c,a,d,i) * t2(j,k,b,d) & ! bc kj
|
||||
! !+ cc_space_v_vvvo(a,c,d,k) * t2(j,i,b,d) & ! prev ac ik
|
||||
! !+ cc_space_v_vvvo(b,c,d,k) * t2(i,j,a,d) & ! prev ab ij
|
||||
! !+ cc_space_v_vvvo(c,b,d,j) * t2(i,k,a,d) & ! prev bc kj
|
||||
! !+ cc_space_v_vvvo(a,b,d,j) * t2(k,i,c,d) ! prev ac ik
|
||||
! + X_vvvo(d,b,a,i) * T_vvoo(d,c,k,j) &
|
||||
! + X_vvvo(d,c,a,i) * T_vvoo(d,b,j,k) & ! bc kj
|
||||
! + X_vvvo(d,a,c,k) * T_vvoo(d,b,j,i) & ! prev ac ik
|
||||
! + X_vvvo(d,b,c,k) * T_vvoo(d,a,i,j) & ! prev ab ij
|
||||
! + X_vvvo(d,c,b,j) * T_vvoo(d,a,i,k) & ! prev bc kj
|
||||
! + X_vvvo(d,a,b,j) * T_vvoo(d,c,k,i) ! prev ac ik
|
||||
! enddo
|
||||
!
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
! !$OMP END DO nowait
|
||||
!
|
||||
! !$OMP DO collapse(2)
|
||||
! do c = 1, nV
|
||||
! do b = 1, nV
|
||||
! do a = 1, nV
|
||||
!
|
||||
! do l = 1, nO
|
||||
! !W(i,j,k,a,b,c) = W(i,j,k,a,b,c) &
|
||||
! W(a,b,c) = W(a,b,c) &
|
||||
! ! chem (ck|jl)
|
||||
! ! phys <cj|kl>
|
||||
! !- cc_space_v_vooo(c,j,k,l) * t2(i,l,a,b) &
|
||||
! !- cc_space_v_vooo(b,k,j,l) * t2(i,l,a,c) & ! bc kj
|
||||
! !- cc_space_v_vooo(b,i,j,l) * t2(k,l,c,a) & ! prev ac ik
|
||||
! !- cc_space_v_vooo(a,j,i,l) * t2(k,l,c,b) & ! prev ab ij
|
||||
! !- cc_space_v_vooo(a,k,i,l) * t2(j,l,b,c) & ! prev bc kj
|
||||
! !- cc_space_v_vooo(c,i,k,l) * t2(j,l,b,a) ! prev ac ik
|
||||
! - T_ovvo(l,a,b,i) * X_ovoo(l,c,j,k) &
|
||||
! - T_ovvo(l,a,c,i) * X_ovoo(l,b,k,j) & ! bc kj
|
||||
! - T_ovvo(l,c,a,k) * X_ovoo(l,b,i,j) & ! prev ac ik
|
||||
! - T_ovvo(l,c,b,k) * X_ovoo(l,a,j,i) & ! prev ab ij
|
||||
! - T_ovvo(l,b,c,j) * X_ovoo(l,a,k,i) & ! prev bc kj
|
||||
! - T_ovvo(l,b,a,j) * X_ovoo(l,c,i,k) ! prev ac ik
|
||||
! enddo
|
||||
!
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
! !$OMP END DO
|
||||
! !$OMP END PARALLEL
|
||||
|
||||
! enddo
|
||||
! enddo
|
||||
!enddo
|
||||
|
||||
end
|
||||
|
||||
! V_ijk
|
||||
|
||||
subroutine form_v_ijk(nO,nV,i,j,k,T_vo,X_vvoo,w,v)
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: nO,nV,i,j,k
|
||||
!double precision, intent(in) :: t1(nO,nV)
|
||||
double precision, intent(in) :: T_vo(nV,nO)
|
||||
double precision, intent(in) :: X_vvoo(nV,nV,nO,nO)
|
||||
double precision, intent(in) :: W(nV,nV,nV)!,nO,nO,nO)
|
||||
double precision, intent(out) :: V(nV,nV,nV)!,nO,nO,nO)
|
||||
|
||||
integer :: a,b,c
|
||||
|
||||
!V = 0d0
|
||||
!do i = 1, nO
|
||||
! do j = 1, nO
|
||||
! do k = 1, nO
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP SHARED(nO,nV,i,j,k,T_vo,X_vvoo,W,V) &
|
||||
!$OMP PRIVATE(a,b,c) &
|
||||
!$OMP DEFAULT(NONE)
|
||||
!$OMP DO collapse(2)
|
||||
do c = 1, nV
|
||||
do b = 1, nV
|
||||
do a = 1, nV
|
||||
!V(i,j,k,a,b,c) = V(i,j,k,a,b,c) + W(i,j,k,a,b,c) &
|
||||
V(a,b,c) = W(a,b,c) &
|
||||
!+ cc_space_v_vvoo(b,c,j,k) * t1(i,a) &
|
||||
!+ cc_space_v_vvoo(a,c,i,k) * t1(j,b) &
|
||||
!+ cc_space_v_vvoo(a,b,i,j) * t1(k,c)
|
||||
+ X_vvoo(b,c,k,j) * T_vo(a,i) &
|
||||
+ X_vvoo(a,c,k,i) * T_vo(b,j) &
|
||||
+ X_vvoo(a,b,j,i) * T_vo(c,k)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
! enddo
|
||||
! enddo
|
||||
!enddo
|
||||
|
||||
end
|
||||
|
452
devel/ccsd_gpu/ccsd_t_space_orb_abc.irp.f
Normal file
452
devel/ccsd_gpu/ccsd_t_space_orb_abc.irp.f
Normal file
@ -0,0 +1,452 @@
|
||||
! Main
|
||||
|
||||
subroutine ccsd_par_t_space_v3(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energy)
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: nO,nV
|
||||
double precision, intent(in) :: t1(nO,nV), f_o(nO), f_v(nV)
|
||||
double precision, intent(in) :: t2(nO,nO,nV,nV)
|
||||
double precision, intent(in) :: v_vvvo(nV,nV,nV,nO), v_vvoo(nV,nV,nO,nO), v_vooo(nV,nO,nO,nO)
|
||||
double precision, intent(out) :: energy
|
||||
|
||||
double precision, allocatable :: X_vovv(:,:,:,:), X_ooov(:,:,:,:), X_oovv(:,:,:,:)
|
||||
double precision, allocatable :: T_voov(:,:,:,:), T_oovv(:,:,:,:)
|
||||
integer :: i,j,k,l,a,b,c,d
|
||||
double precision :: e,ta,tb
|
||||
|
||||
call set_multiple_levels_omp(.False.)
|
||||
|
||||
allocate(X_vovv(nV,nO,nV,nV), X_ooov(nO,nO,nO,nV), X_oovv(nO,nO,nV,nV))
|
||||
allocate(T_voov(nV,nO,nO,nV),T_oovv(nO,nO,nV,nV))
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP SHARED(nO,nV,T_voov,T_oovv,X_vovv,X_ooov,X_oovv, &
|
||||
!$OMP t1,t2,v_vvvo,v_vooo,v_vvoo) &
|
||||
!$OMP PRIVATE(a,b,c,d,i,j,k,l) &
|
||||
!$OMP DEFAULT(NONE)
|
||||
|
||||
!v_vvvo(b,a,d,i) * t2(k,j,c,d) &
|
||||
!X_vovv(d,i,b,a,i) * T_voov(d,j,c,k)
|
||||
|
||||
!$OMP DO
|
||||
do a = 1, nV
|
||||
do b = 1, nV
|
||||
do i = 1, nO
|
||||
do d = 1, nV
|
||||
X_vovv(d,i,b,a) = v_vvvo(b,a,d,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO nowait
|
||||
|
||||
!$OMP DO
|
||||
do c = 1, nV
|
||||
do j = 1, nO
|
||||
do k = 1, nO
|
||||
do d = 1, nV
|
||||
T_voov(d,k,j,c) = t2(k,j,c,d)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO nowait
|
||||
|
||||
!v_vooo(c,j,k,l) * t2(i,l,a,b) &
|
||||
!X_ooov(l,j,k,c) * T_oovv(l,i,a,b) &
|
||||
|
||||
!$OMP DO
|
||||
do c = 1, nV
|
||||
do k = 1, nO
|
||||
do j = 1, nO
|
||||
do l = 1, nO
|
||||
X_ooov(l,j,k,c) = v_vooo(c,j,k,l)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO nowait
|
||||
|
||||
!$OMP DO
|
||||
do b = 1, nV
|
||||
do a = 1, nV
|
||||
do i = 1, nO
|
||||
do l = 1, nO
|
||||
T_oovv(l,i,a,b) = t2(i,l,a,b)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO nowait
|
||||
|
||||
!X_oovv(j,k,b,c) * T1_vo(a,i) &
|
||||
|
||||
!$OMP DO
|
||||
do c = 1, nV
|
||||
do b = 1, nV
|
||||
do k = 1, nO
|
||||
do j = 1, nO
|
||||
X_oovv(j,k,b,c) = v_vvoo(b,c,j,k)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO nowait
|
||||
|
||||
!$OMP END PARALLEL
|
||||
|
||||
double precision, external :: ccsd_t_task_aba
|
||||
double precision, external :: ccsd_t_task_abc
|
||||
|
||||
!$OMP PARALLEL PRIVATE(a,b,c,e) DEFAULT(SHARED)
|
||||
e = 0d0
|
||||
!$OMP DO SCHEDULE(guided)
|
||||
do a = 1, nV
|
||||
do b = a+1, nV
|
||||
do c = b+1, nV
|
||||
e = e + ccsd_t_task_abc(a,b,c,nO,nV,t1,T_oovv,T_voov, &
|
||||
X_ooov,X_oovv,X_vovv,f_o,f_v)
|
||||
enddo
|
||||
|
||||
e = e + ccsd_t_task_aba(a,b,nO,nV,t1,T_oovv,T_voov, &
|
||||
X_ooov,X_oovv,X_vovv,f_o,f_v)
|
||||
|
||||
e = e + ccsd_t_task_aba(b,a,nO,nV,t1,T_oovv,T_voov, &
|
||||
X_ooov,X_oovv,X_vovv,f_o,f_v)
|
||||
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO NOWAIT
|
||||
|
||||
!$OMP CRITICAL
|
||||
energy = energy + e
|
||||
!$OMP END CRITICAL
|
||||
|
||||
!$OMP END PARALLEL
|
||||
|
||||
energy = energy / 3.d0
|
||||
|
||||
deallocate(X_vovv,X_ooov,T_voov,T_oovv)
|
||||
end
|
||||
|
||||
|
||||
double precision function ccsd_t_task_abc(a,b,c,nO,nV,t1,T_oovv,T_voov,&
|
||||
X_ooov,X_oovv,X_vovv,f_o,f_v) result(e)
|
||||
implicit none
|
||||
integer, intent(in) :: nO,nV,a,b,c
|
||||
double precision, intent(in) :: t1(nO,nV), f_o(nO), f_v(nV)
|
||||
double precision, intent(in) :: X_oovv(nO,nO,nV,nV)
|
||||
double precision, intent(in) :: T_voov(nV,nO,nO,nV), T_oovv(nO,nO,nV,nV)
|
||||
double precision, intent(in) :: X_vovv(nV,nO,nV,nV), X_ooov(nO,nO,nO,nV)
|
||||
|
||||
double precision :: delta, delta_abc
|
||||
integer :: i,j,k
|
||||
|
||||
double precision, allocatable :: W_abc(:,:,:), W_cab(:,:,:), W_bca(:,:,:)
|
||||
double precision, allocatable :: W_bac(:,:,:), W_cba(:,:,:), W_acb(:,:,:)
|
||||
double precision, allocatable :: V_abc(:,:,:), V_cab(:,:,:), V_bca(:,:,:)
|
||||
double precision, allocatable :: V_bac(:,:,:), V_cba(:,:,:), V_acb(:,:,:)
|
||||
|
||||
allocate( W_abc(nO,nO,nO), W_cab(nO,nO,nO), W_bca(nO,nO,nO), &
|
||||
W_bac(nO,nO,nO), W_cba(nO,nO,nO), W_acb(nO,nO,nO), &
|
||||
V_abc(nO,nO,nO), V_cab(nO,nO,nO), V_bca(nO,nO,nO), &
|
||||
V_bac(nO,nO,nO), V_cba(nO,nO,nO), V_acb(nO,nO,nO) )
|
||||
|
||||
call form_w_abc(nO,nV,a,b,c,T_voov,T_oovv,X_vovv,X_ooov,W_abc,W_cba,W_bca,W_cab,W_bac,W_acb)
|
||||
|
||||
call form_v_abc(nO,nV,a,b,c,t1,X_oovv,W_abc,V_abc,W_cba,V_cba,W_bca,V_bca,W_cab,V_cab,W_bac,V_bac,W_acb,V_acb)
|
||||
|
||||
delta_abc = f_v(a) + f_v(b) + f_v(c)
|
||||
e = 0.d0
|
||||
|
||||
do k = 1, nO
|
||||
do j = 1, nO
|
||||
do i = 1, nO
|
||||
delta = 1.d0 / (f_o(i) + f_o(j) + f_o(k) - delta_abc)
|
||||
e = e + delta * ( &
|
||||
(4d0 * (W_abc(i,j,k) - W_cba(i,j,k)) + &
|
||||
W_bca(i,j,k) - W_bac(i,j,k) + &
|
||||
W_cab(i,j,k) - W_acb(i,j,k) ) * (V_abc(i,j,k) - V_cba(i,j,k)) +&
|
||||
(4d0 * (W_acb(i,j,k) - W_bca(i,j,k)) + &
|
||||
W_cba(i,j,k) - W_cab(i,j,k) + &
|
||||
W_bac(i,j,k) - W_abc(i,j,k) ) * (V_acb(i,j,k) - V_bca(i,j,k)) +&
|
||||
(4d0 * (W_bac(i,j,k) - W_cab(i,j,k)) + &
|
||||
W_acb(i,j,k) - W_abc(i,j,k) + &
|
||||
W_cba(i,j,k) - W_bca(i,j,k) ) * (V_bac(i,j,k) - V_cab(i,j,k)) )
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
deallocate(W_abc, W_cab, W_bca, W_bac, W_cba, W_acb, &
|
||||
V_abc, V_cab, V_bca, V_bac, V_cba, V_acb )
|
||||
|
||||
end
|
||||
|
||||
double precision function ccsd_t_task_aba(a,b,nO,nV,t1,T_oovv,T_voov,&
|
||||
X_ooov,X_oovv,X_vovv,f_o,f_v) result(e)
|
||||
implicit none
|
||||
integer, intent(in) :: nO,nV,a,b
|
||||
double precision, intent(in) :: t1(nO,nV), f_o(nO), f_v(nV)
|
||||
double precision, intent(in) :: X_oovv(nO,nO,nV,nV)
|
||||
double precision, intent(in) :: T_voov(nV,nO,nO,nV), T_oovv(nO,nO,nV,nV)
|
||||
double precision, intent(in) :: X_vovv(nV,nO,nV,nV), X_ooov(nO,nO,nO,nV)
|
||||
|
||||
double precision :: delta, delta_abc
|
||||
integer :: i,j,k
|
||||
|
||||
double precision, allocatable :: W_abc(:,:,:), W_cab(:,:,:), W_bca(:,:,:)
|
||||
double precision, allocatable :: W_bac(:,:,:), W_cba(:,:,:), W_acb(:,:,:)
|
||||
double precision, allocatable :: V_abc(:,:,:), V_cab(:,:,:), V_bca(:,:,:)
|
||||
double precision, allocatable :: V_bac(:,:,:), V_cba(:,:,:), V_acb(:,:,:)
|
||||
|
||||
allocate( W_abc(nO,nO,nO), W_cab(nO,nO,nO), W_bca(nO,nO,nO), &
|
||||
W_bac(nO,nO,nO), W_cba(nO,nO,nO), W_acb(nO,nO,nO), &
|
||||
V_abc(nO,nO,nO), V_cab(nO,nO,nO), V_bca(nO,nO,nO), &
|
||||
V_bac(nO,nO,nO), V_cba(nO,nO,nO), V_acb(nO,nO,nO) )
|
||||
|
||||
call form_w_abc(nO,nV,a,b,a,T_voov,T_oovv,X_vovv,X_ooov,W_abc,W_cba,W_bca,W_cab,W_bac,W_acb)
|
||||
|
||||
call form_v_abc(nO,nV,a,b,a,t1,X_oovv,W_abc,V_abc,W_cba,V_cba,W_bca,V_bca,W_cab,V_cab,W_bac,V_bac,W_acb,V_acb)
|
||||
|
||||
delta_abc = f_v(a) + f_v(b) + f_v(a)
|
||||
e = 0.d0
|
||||
|
||||
do k = 1, nO
|
||||
do j = 1, nO
|
||||
do i = 1, nO
|
||||
delta = 1.d0 / (f_o(i) + f_o(j) + f_o(k) - delta_abc)
|
||||
e = e + delta * ( &
|
||||
(4d0 * W_abc(i,j,k) + W_bca(i,j,k) + W_cab(i,j,k)) * (V_abc(i,j,k) - V_cba(i,j,k)) + &
|
||||
(4d0 * W_acb(i,j,k) + W_cba(i,j,k) + W_bac(i,j,k)) * (V_acb(i,j,k) - V_bca(i,j,k)) + &
|
||||
(4d0 * W_bac(i,j,k) + W_acb(i,j,k) + W_cba(i,j,k)) * (V_bac(i,j,k) - V_cab(i,j,k)) )
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
deallocate(W_abc, W_cab, W_bca, W_bac, W_cba, W_acb, &
|
||||
V_abc, V_cab, V_bca, V_bac, V_cba, V_acb )
|
||||
|
||||
end
|
||||
|
||||
subroutine form_w_abc(nO,nV,a,b,c,T_voov,T_oovv,X_vovv,X_ooov,W_abc,W_cba,W_bca,W_cab,W_bac,W_acb)
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: nO,nV,a,b,c
|
||||
double precision, intent(in) :: T_voov(nV,nO,nO,nV), T_oovv(nO,nO,nV,nV)
|
||||
double precision, intent(in) :: X_vovv(nV,nO,nV,nV), X_ooov(nO,nO,nO,nV)
|
||||
double precision, intent(out) :: W_abc(nO,nO,nO)
|
||||
double precision, intent(out) :: W_cba(nO,nO,nO)
|
||||
double precision, intent(out) :: W_bca(nO,nO,nO)
|
||||
double precision, intent(out) :: W_cab(nO,nO,nO)
|
||||
double precision, intent(out) :: W_bac(nO,nO,nO)
|
||||
double precision, intent(out) :: W_acb(nO,nO,nO)
|
||||
|
||||
integer :: l,i,j,k,d
|
||||
double precision, allocatable, dimension(:,:,:,:) :: W_ikj
|
||||
double precision, allocatable :: X(:,:,:,:)
|
||||
|
||||
allocate(W_ikj(nO,nO,nO,6))
|
||||
allocate(X(nV,nO,nO,3))
|
||||
|
||||
do k=1,nO
|
||||
do i=1,nO
|
||||
do d=1,nV
|
||||
X(d,i,k,1) = T_voov(d,k,i,a)
|
||||
X(d,i,k,2) = T_voov(d,k,i,b)
|
||||
X(d,i,k,3) = T_voov(d,k,i,c)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! X_vovv(d,i,c,a) * T_voov(d,j,k,b) : i jk
|
||||
|
||||
call dgemm('T','N', nO, nO*nO, nV, 1.d0, X_vovv(1,1,c,a), nV, T_voov(1,1,1,b), nV, 0.d0, W_abc, nO)
|
||||
call dgemm('T','N', nO, nO*nO, nV, 1.d0, X_vovv(1,1,c,b), nV, T_voov(1,1,1,a), nV, 0.d0, W_bac, nO)
|
||||
call dgemm('T','N', nO, nO*nO, nV, 1.d0, X_vovv(1,1,a,c), nV, T_voov(1,1,1,b), nV, 0.d0, W_cba, nO)
|
||||
call dgemm('T','N', nO, nO*nO, nV, 1.d0, X_vovv(1,1,a,b), nV, T_voov(1,1,1,c), nV, 0.d0, W_bca, nO)
|
||||
call dgemm('T','N', nO, nO*nO, nV, 1.d0, X_vovv(1,1,b,c), nV, T_voov(1,1,1,a), nV, 0.d0, W_cab, nO)
|
||||
call dgemm('T','N', nO, nO*nO, nV, 1.d0, X_vovv(1,1,b,a), nV, T_voov(1,1,1,c), nV, 0.d0, W_acb, nO)
|
||||
|
||||
! T_voov(d,i,j,a) * X_vovv(d,k,b,c) : ij k
|
||||
|
||||
call dgemm('T','N', nO*nO, nO, nV, 1.d0, T_voov(1,1,1,a), nV, X_vovv(1,1,b,c), nV, 1.d0, W_abc, nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nV, 1.d0, T_voov(1,1,1,b), nV, X_vovv(1,1,a,c), nV, 1.d0, W_bac, nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nV, 1.d0, T_voov(1,1,1,c), nV, X_vovv(1,1,b,a), nV, 1.d0, W_cba, nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nV, 1.d0, T_voov(1,1,1,b), nV, X_vovv(1,1,c,a), nV, 1.d0, W_bca, nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nV, 1.d0, T_voov(1,1,1,c), nV, X_vovv(1,1,a,b), nV, 1.d0, W_cab, nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nV, 1.d0, T_voov(1,1,1,a), nV, X_vovv(1,1,c,b), nV, 1.d0, W_acb, nO*nO)
|
||||
|
||||
|
||||
! X_vovv(d,k,a,c) * T_voov(d,j,i,b) : k ji
|
||||
|
||||
call dgemm('T','N', nO*nO, nO, nV, 1.d0, X(1,1,1,2), nV, X_vovv(1,1,a,c), nV, 1.d0, W_abc, nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nV, 1.d0, X(1,1,1,1), nV, X_vovv(1,1,b,c), nV, 1.d0, W_bac, nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nV, 1.d0, X(1,1,1,2), nV, X_vovv(1,1,c,a), nV, 1.d0, W_cba, nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nV, 1.d0, X(1,1,1,3), nV, X_vovv(1,1,b,a), nV, 1.d0, W_bca, nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nV, 1.d0, X(1,1,1,1), nV, X_vovv(1,1,c,b), nV, 1.d0, W_cab, nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nV, 1.d0, X(1,1,1,3), nV, X_vovv(1,1,a,b), nV, 1.d0, W_acb, nO*nO)
|
||||
|
||||
! X_vovv(d,i,b,a) * T_voov(d,k,j,c) : i kj
|
||||
|
||||
call dgemm('T','N', nO, nO*nO, nV, 1.d0, X_vovv(1,1,b,a), nV, X(1,1,1,3), nV, 1.d0, W_abc, nO)
|
||||
call dgemm('T','N', nO, nO*nO, nV, 1.d0, X_vovv(1,1,a,b), nV, X(1,1,1,3), nV, 1.d0, W_bac, nO)
|
||||
call dgemm('T','N', nO, nO*nO, nV, 1.d0, X_vovv(1,1,b,c), nV, X(1,1,1,1), nV, 1.d0, W_cba, nO)
|
||||
call dgemm('T','N', nO, nO*nO, nV, 1.d0, X_vovv(1,1,c,b), nV, X(1,1,1,1), nV, 1.d0, W_bca, nO)
|
||||
call dgemm('T','N', nO, nO*nO, nV, 1.d0, X_vovv(1,1,a,c), nV, X(1,1,1,2), nV, 1.d0, W_cab, nO)
|
||||
call dgemm('T','N', nO, nO*nO, nV, 1.d0, X_vovv(1,1,c,a), nV, X(1,1,1,2), nV, 1.d0, W_acb, nO)
|
||||
|
||||
! T_voov(d,k,i,c) * X_vovv(d,j,a,b) : ki j
|
||||
|
||||
call dgemm('T','N', nO*nO, nO, nV, 1.d0, X(1,1,1,3), nV, X_vovv(1,1,a,b), nV, 0.d0, W_ikj(1,1,1,1), nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nV, 1.d0, X(1,1,1,3), nV, X_vovv(1,1,b,a), nV, 0.d0, W_ikj(1,1,1,2), nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nV, 1.d0, X(1,1,1,1), nV, X_vovv(1,1,c,b), nV, 0.d0, W_ikj(1,1,1,3), nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nV, 1.d0, X(1,1,1,1), nV, X_vovv(1,1,b,c), nV, 0.d0, W_ikj(1,1,1,4), nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nV, 1.d0, X(1,1,1,2), nV, X_vovv(1,1,c,a), nV, 0.d0, W_ikj(1,1,1,5), nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nV, 1.d0, X(1,1,1,2), nV, X_vovv(1,1,a,c), nV, 0.d0, W_ikj(1,1,1,6), nO*nO)
|
||||
|
||||
! T_voov(d,i,k,a) * X_vovv(d,j,c,b) : ik j
|
||||
call dgemm('T','N', nO*nO, nO, nV, 1.d0, T_voov(1,1,1,a), nV, X_vovv(1,1,c,b), nV, 1.d0, W_ikj(1,1,1,1), nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nV, 1.d0, T_voov(1,1,1,b), nV, X_vovv(1,1,c,a), nV, 1.d0, W_ikj(1,1,1,2), nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nV, 1.d0, T_voov(1,1,1,c), nV, X_vovv(1,1,a,b), nV, 1.d0, W_ikj(1,1,1,3), nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nV, 1.d0, T_voov(1,1,1,b), nV, X_vovv(1,1,a,c), nV, 1.d0, W_ikj(1,1,1,4), nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nV, 1.d0, T_voov(1,1,1,c), nV, X_vovv(1,1,b,a), nV, 1.d0, W_ikj(1,1,1,5), nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nV, 1.d0, T_voov(1,1,1,a), nV, X_vovv(1,1,b,c), nV, 1.d0, W_ikj(1,1,1,6), nO*nO)
|
||||
|
||||
deallocate(X)
|
||||
|
||||
allocate(X(nO,nO,nO,3))
|
||||
|
||||
do k=1,nO
|
||||
do j=1,nO
|
||||
do l=1,nO
|
||||
X(l,j,k,1) = X_ooov(l,k,j,a)
|
||||
X(l,j,k,2) = X_ooov(l,k,j,b)
|
||||
X(l,j,k,3) = X_ooov(l,k,j,c)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
|
||||
! - T_oovv(l,i,a,b) * X_ooov(l,j,k,c) : i jk
|
||||
call dgemm('T','N', nO, nO*nO, nO, -1.d0, T_oovv(1,1,a,b), nO, X_ooov(1,1,1,c), nO, 1.d0, W_abc, nO)
|
||||
call dgemm('T','N', nO, nO*nO, nO, -1.d0, T_oovv(1,1,b,a), nO, X_ooov(1,1,1,c), nO, 1.d0, W_bac, nO)
|
||||
call dgemm('T','N', nO, nO*nO, nO, -1.d0, T_oovv(1,1,c,b), nO, X_ooov(1,1,1,a), nO, 1.d0, W_cba, nO)
|
||||
call dgemm('T','N', nO, nO*nO, nO, -1.d0, T_oovv(1,1,b,c), nO, X_ooov(1,1,1,a), nO, 1.d0, W_bca, nO)
|
||||
call dgemm('T','N', nO, nO*nO, nO, -1.d0, T_oovv(1,1,c,a), nO, X_ooov(1,1,1,b), nO, 1.d0, W_cab, nO)
|
||||
call dgemm('T','N', nO, nO*nO, nO, -1.d0, T_oovv(1,1,a,c), nO, X_ooov(1,1,1,b), nO, 1.d0, W_acb, nO)
|
||||
|
||||
! - T_oovv(l,i,a,c) * X_ooov(l,k,j,b) : i kj
|
||||
call dgemm('T','N', nO, nO*nO, nO, -1.d0, T_oovv(1,1,a,c), nO, X(1,1,1,2), nO, 1.d0, W_abc, nO)
|
||||
call dgemm('T','N', nO, nO*nO, nO, -1.d0, T_oovv(1,1,b,c), nO, X(1,1,1,1), nO, 1.d0, W_bac, nO)
|
||||
call dgemm('T','N', nO, nO*nO, nO, -1.d0, T_oovv(1,1,c,a), nO, X(1,1,1,2), nO, 1.d0, W_cba, nO)
|
||||
call dgemm('T','N', nO, nO*nO, nO, -1.d0, T_oovv(1,1,b,a), nO, X(1,1,1,3), nO, 1.d0, W_bca, nO)
|
||||
call dgemm('T','N', nO, nO*nO, nO, -1.d0, T_oovv(1,1,c,b), nO, X(1,1,1,1), nO, 1.d0, W_cab, nO)
|
||||
call dgemm('T','N', nO, nO*nO, nO, -1.d0, T_oovv(1,1,a,b), nO, X(1,1,1,3), nO, 1.d0, W_acb, nO)
|
||||
|
||||
! - X_ooov(l,i,j,b) * T_oovv(l,k,c,a) : ij k
|
||||
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X_ooov(1,1,1,b), nO, T_oovv(1,1,c,a), nO, 1.d0, W_abc, nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X_ooov(1,1,1,a), nO, T_oovv(1,1,c,b), nO, 1.d0, W_bac, nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X_ooov(1,1,1,b), nO, T_oovv(1,1,a,c), nO, 1.d0, W_cba, nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X_ooov(1,1,1,c), nO, T_oovv(1,1,a,b), nO, 1.d0, W_bca, nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X_ooov(1,1,1,a), nO, T_oovv(1,1,b,c), nO, 1.d0, W_cab, nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X_ooov(1,1,1,c), nO, T_oovv(1,1,b,a), nO, 1.d0, W_acb, nO*nO)
|
||||
|
||||
! - X_ooov(l,j,i,a) * T_oovv(l,k,c,b) : ji k
|
||||
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X(1,1,1,1), nO, T_oovv(1,1,c,b), nO, 1.d0, W_abc, nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X(1,1,1,2), nO, T_oovv(1,1,c,a), nO, 1.d0, W_bac, nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X(1,1,1,3), nO, T_oovv(1,1,a,b), nO, 1.d0, W_cba, nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X(1,1,1,2), nO, T_oovv(1,1,a,c), nO, 1.d0, W_bca, nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X(1,1,1,3), nO, T_oovv(1,1,b,a), nO, 1.d0, W_cab, nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X(1,1,1,1), nO, T_oovv(1,1,b,c), nO, 1.d0, W_acb, nO*nO)
|
||||
|
||||
! - X_ooov(l,k,i,a) * T_oovv(l,j,b,c) : ki j
|
||||
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X(1,1,1,1), nO, T_oovv(1,1,b,c), nO, 1.d0, W_ikj(1,1,1,1), nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X(1,1,1,2), nO, T_oovv(1,1,a,c), nO, 1.d0, W_ikj(1,1,1,2), nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X(1,1,1,3), nO, T_oovv(1,1,b,a), nO, 1.d0, W_ikj(1,1,1,3), nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X(1,1,1,2), nO, T_oovv(1,1,c,a), nO, 1.d0, W_ikj(1,1,1,4), nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X(1,1,1,3), nO, T_oovv(1,1,a,b), nO, 1.d0, W_ikj(1,1,1,5), nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X(1,1,1,1), nO, T_oovv(1,1,c,b), nO, 1.d0, W_ikj(1,1,1,6), nO*nO)
|
||||
|
||||
! - X_ooov(l,i,k,c) * T_oovv(l,j,b,a) : ik j
|
||||
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X_ooov(1,1,1,c), nO, T_oovv(1,1,b,a), nO, 1.d0, W_ikj(1,1,1,1), nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X_ooov(1,1,1,c), nO, T_oovv(1,1,a,b), nO, 1.d0, W_ikj(1,1,1,2), nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X_ooov(1,1,1,a), nO, T_oovv(1,1,b,c), nO, 1.d0, W_ikj(1,1,1,3), nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X_ooov(1,1,1,a), nO, T_oovv(1,1,c,b), nO, 1.d0, W_ikj(1,1,1,4), nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X_ooov(1,1,1,b), nO, T_oovv(1,1,a,c), nO, 1.d0, W_ikj(1,1,1,5), nO*nO)
|
||||
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X_ooov(1,1,1,b), nO, T_oovv(1,1,c,a), nO, 1.d0, W_ikj(1,1,1,6), nO*nO)
|
||||
|
||||
do k=1,nO
|
||||
do j=1,nO
|
||||
do i=1,nO
|
||||
W_abc(i,j,k) = W_abc(i,j,k) + W_ikj(i,k,j,1)
|
||||
W_bac(i,j,k) = W_bac(i,j,k) + W_ikj(i,k,j,2)
|
||||
W_cba(i,j,k) = W_cba(i,j,k) + W_ikj(i,k,j,3)
|
||||
W_bca(i,j,k) = W_bca(i,j,k) + W_ikj(i,k,j,4)
|
||||
W_cab(i,j,k) = W_cab(i,j,k) + W_ikj(i,k,j,5)
|
||||
W_acb(i,j,k) = W_acb(i,j,k) + W_ikj(i,k,j,6)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
deallocate(X,W_ikj)
|
||||
end
|
||||
|
||||
|
||||
! V_abc
|
||||
|
||||
subroutine form_v_abc(nO,nV,a,b,c,T_ov,X_oovv,W_abc,V_abc,W_cba,V_cba,W_bca,V_bca,W_cab,V_cab,W_bac,V_bac,W_acb,V_acb)
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: nO,nV,a,b,c
|
||||
double precision, intent(in) :: T_ov(nO,nV)
|
||||
double precision, intent(in) :: X_oovv(nO,nO,nV,nV)
|
||||
double precision, intent(in) :: W_abc(nO,nO,nO), W_cab(nO,nO,nO), W_bca(nO,nO,nO)
|
||||
double precision, intent(in) :: W_bac(nO,nO,nO), W_cba(nO,nO,nO), W_acb(nO,nO,nO)
|
||||
double precision, intent(out) :: V_abc(nO,nO,nO), V_cab(nO,nO,nO), V_bca(nO,nO,nO)
|
||||
double precision, intent(out) :: V_bac(nO,nO,nO), V_cba(nO,nO,nO), V_acb(nO,nO,nO)
|
||||
|
||||
integer :: i,j,k
|
||||
|
||||
do k = 1, nO
|
||||
do j = 1, nO
|
||||
do i = 1, nO
|
||||
V_abc(i,j,k) = W_abc(i,j,k) &
|
||||
+ X_oovv(j,k,b,c) * T_ov(i,a) &
|
||||
+ X_oovv(i,k,a,c) * T_ov(j,b) &
|
||||
+ X_oovv(i,j,a,b) * T_ov(k,c)
|
||||
|
||||
V_cba(i,j,k) = W_cba(i,j,k) &
|
||||
+ X_oovv(j,k,b,a) * T_ov(i,c) &
|
||||
+ X_oovv(i,k,c,a) * T_ov(j,b) &
|
||||
+ X_oovv(i,j,c,b) * T_ov(k,a)
|
||||
|
||||
V_bca(i,j,k) = W_bca(i,j,k) &
|
||||
+ X_oovv(j,k,c,a) * T_ov(i,b) &
|
||||
+ X_oovv(i,k,b,a) * T_ov(j,c) &
|
||||
+ X_oovv(i,j,b,c) * T_ov(k,a)
|
||||
|
||||
V_cab(i,j,k) = W_cab(i,j,k) &
|
||||
+ X_oovv(j,k,a,b) * T_ov(i,c) &
|
||||
+ X_oovv(i,k,c,b) * T_ov(j,a) &
|
||||
+ X_oovv(i,j,c,a) * T_ov(k,b)
|
||||
|
||||
V_bac(i,j,k) = W_bac(i,j,k) &
|
||||
+ X_oovv(j,k,a,c) * T_ov(i,b) &
|
||||
+ X_oovv(i,k,b,c) * T_ov(j,a) &
|
||||
+ X_oovv(i,j,b,a) * T_ov(k,c)
|
||||
|
||||
V_acb(i,j,k) = W_acb(i,j,k) &
|
||||
+ X_oovv(j,k,c,b) * T_ov(i,a) &
|
||||
+ X_oovv(i,k,a,b) * T_ov(j,c) &
|
||||
+ X_oovv(i,j,a,c) * T_ov(k,b)
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
end
|
||||
|
380
devel/ccsd_gpu/ccsd_t_space_orb_stoch.irp.f
Normal file
380
devel/ccsd_gpu/ccsd_t_space_orb_stoch.irp.f
Normal file
@ -0,0 +1,380 @@
|
||||
! Main
|
||||
subroutine ccsd_par_t_space_stoch(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energy)
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: nO,nV
|
||||
double precision, intent(in) :: t1(nO,nV), f_o(nO), f_v(nV)
|
||||
double precision, intent(in) :: t2(nO,nO,nV,nV)
|
||||
double precision, intent(in) :: v_vvvo(nV,nV,nV,nO), v_vvoo(nV,nV,nO,nO), v_vooo(nV,nO,nO,nO)
|
||||
double precision, intent(inout) :: energy
|
||||
|
||||
double precision, allocatable :: X_vovv(:,:,:,:), X_ooov(:,:,:,:), X_oovv(:,:,:,:)
|
||||
double precision, allocatable :: T_voov(:,:,:,:), T_oovv(:,:,:,:)
|
||||
integer :: i,j,k,l,a,b,c,d
|
||||
double precision :: e,ta,tb,eccsd
|
||||
|
||||
eccsd = energy
|
||||
call set_multiple_levels_omp(.False.)
|
||||
|
||||
allocate(X_vovv(nV,nO,nV,nV), X_ooov(nO,nO,nO,nV), X_oovv(nO,nO,nV,nV))
|
||||
allocate(T_voov(nV,nO,nO,nV),T_oovv(nO,nO,nV,nV))
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP SHARED(nO,nV,T_voov,T_oovv,X_vovv,X_ooov,X_oovv, &
|
||||
!$OMP t1,t2,v_vvvo,v_vooo,v_vvoo) &
|
||||
!$OMP PRIVATE(a,b,c,d,i,j,k,l) &
|
||||
!$OMP DEFAULT(NONE)
|
||||
|
||||
!v_vvvo(b,a,d,i) * t2(k,j,c,d) &
|
||||
!X_vovv(d,i,b,a,i) * T_voov(d,j,c,k)
|
||||
|
||||
!$OMP DO
|
||||
do a = 1, nV
|
||||
do b = 1, nV
|
||||
do i = 1, nO
|
||||
do d = 1, nV
|
||||
X_vovv(d,i,b,a) = v_vvvo(b,a,d,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO nowait
|
||||
|
||||
!$OMP DO
|
||||
do c = 1, nV
|
||||
do j = 1, nO
|
||||
do k = 1, nO
|
||||
do d = 1, nV
|
||||
T_voov(d,k,j,c) = t2(k,j,c,d)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO nowait
|
||||
|
||||
!v_vooo(c,j,k,l) * t2(i,l,a,b) &
|
||||
!X_ooov(l,j,k,c) * T_oovv(l,i,a,b) &
|
||||
|
||||
!$OMP DO
|
||||
do c = 1, nV
|
||||
do k = 1, nO
|
||||
do j = 1, nO
|
||||
do l = 1, nO
|
||||
X_ooov(l,j,k,c) = v_vooo(c,j,k,l)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO nowait
|
||||
|
||||
!$OMP DO
|
||||
do b = 1, nV
|
||||
do a = 1, nV
|
||||
do i = 1, nO
|
||||
do l = 1, nO
|
||||
T_oovv(l,i,a,b) = t2(i,l,a,b)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO nowait
|
||||
|
||||
!X_oovv(j,k,b,c) * T1_vo(a,i) &
|
||||
|
||||
!$OMP DO
|
||||
do c = 1, nV
|
||||
do b = 1, nV
|
||||
do k = 1, nO
|
||||
do j = 1, nO
|
||||
X_oovv(j,k,b,c) = v_vvoo(b,c,j,k)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO nowait
|
||||
|
||||
!$OMP BARRIER
|
||||
!$OMP END PARALLEL
|
||||
|
||||
double precision, external :: ccsd_t_task_aba
|
||||
double precision, external :: ccsd_t_task_abc
|
||||
! logical, external :: omp_test_lock
|
||||
|
||||
double precision, allocatable :: memo(:), Pabc(:), waccu(:)
|
||||
integer*8, allocatable :: sampled(:)
|
||||
! integer(omp_lock_kind), allocatable :: lock(:)
|
||||
integer*2 , allocatable :: abc(:,:)
|
||||
integer*8 :: Nabc, i8,kiter
|
||||
integer*8, allocatable :: iorder(:)
|
||||
double precision :: eocc
|
||||
double precision :: norm
|
||||
integer :: isample
|
||||
|
||||
|
||||
! Prepare table of triplets (a,b,c)
|
||||
|
||||
Nabc = (int(nV,8) * int(nV+1,8) * int(nV+2,8))/6_8 - nV
|
||||
allocate (memo(Nabc), sampled(Nabc), Pabc(Nabc), waccu(0:Nabc))
|
||||
allocate (abc(4,Nabc), iorder(Nabc)) !, lock(Nabc))
|
||||
|
||||
! eocc = 3.d0/dble(nO) * sum(f_o(1:nO))
|
||||
Nabc = 0_8
|
||||
do a = 1, nV
|
||||
do b = a+1, nV
|
||||
do c = b+1, nV
|
||||
Nabc = Nabc + 1_8
|
||||
Pabc(Nabc) = -1.d0/(f_v(a) + f_v(b) + f_v(c))
|
||||
abc(1,Nabc) = int(a,2)
|
||||
abc(2,Nabc) = int(b,2)
|
||||
abc(3,Nabc) = int(c,2)
|
||||
enddo
|
||||
|
||||
Nabc = Nabc + 1_8
|
||||
abc(1,Nabc) = int(a,2)
|
||||
abc(2,Nabc) = int(b,2)
|
||||
abc(3,Nabc) = int(a,2)
|
||||
Pabc(Nabc) = -1.d0/(2.d0*f_v(a) + f_v(b))
|
||||
|
||||
Nabc = Nabc + 1_8
|
||||
abc(1,Nabc) = int(b,2)
|
||||
abc(2,Nabc) = int(a,2)
|
||||
abc(3,Nabc) = int(b,2)
|
||||
Pabc(Nabc) = -1.d0/(f_v(a) + 2.d0*f_v(b))
|
||||
enddo
|
||||
enddo
|
||||
|
||||
do i8=1,Nabc
|
||||
iorder(i8) = i8
|
||||
enddo
|
||||
|
||||
! Sort triplets in decreasing Pabc
|
||||
call dsort_big(Pabc, iorder, Nabc)
|
||||
|
||||
! Normalize
|
||||
norm = 0.d0
|
||||
do i8=Nabc,1,-1
|
||||
norm = norm + Pabc(i8)
|
||||
enddo
|
||||
norm = 1.d0/norm
|
||||
do i8=1,Nabc
|
||||
Pabc(i8) = Pabc(i8) * norm
|
||||
enddo
|
||||
|
||||
call i8set_order_big(abc, iorder, Nabc)
|
||||
|
||||
|
||||
! Cumulative distribution for sampling
|
||||
waccu(Nabc) = 0.d0
|
||||
do i8=Nabc-1,1,-1
|
||||
waccu(i8) = waccu(i8+1) - Pabc(i8+1)
|
||||
enddo
|
||||
waccu(:) = waccu(:) + 1.d0
|
||||
waccu(0) = 0.d0
|
||||
|
||||
logical :: converged, do_comp
|
||||
double precision :: eta, variance, error, sample
|
||||
double precision :: t00, t01
|
||||
integer*8 :: ieta, Ncomputed
|
||||
integer*8, external :: binary_search
|
||||
|
||||
integer :: nbuckets
|
||||
nbuckets = 100
|
||||
|
||||
double precision, allocatable :: wsum(:)
|
||||
allocate(wsum(nbuckets))
|
||||
|
||||
converged = .False.
|
||||
Ncomputed = 0_8
|
||||
|
||||
energy = 0.d0
|
||||
variance = 0.d0
|
||||
memo(:) = 0.d0
|
||||
sampled(:) = -1_8
|
||||
|
||||
integer*8 :: ileft, iright, imin
|
||||
ileft = 1_8
|
||||
iright = Nabc
|
||||
integer*8, allocatable :: bounds(:,:)
|
||||
|
||||
allocate (bounds(2,nbuckets))
|
||||
do isample=1,nbuckets
|
||||
eta = 1.d0/dble(nbuckets) * dble(isample)
|
||||
ieta = binary_search(waccu,eta,Nabc)
|
||||
bounds(1,isample) = ileft
|
||||
bounds(2,isample) = ieta
|
||||
ileft = ieta+1
|
||||
wsum(isample) = sum( Pabc(bounds(1,isample):bounds(2,isample) ) )
|
||||
enddo
|
||||
|
||||
Pabc(:) = 1.d0/Pabc(:)
|
||||
|
||||
print '(A)', ''
|
||||
print '(A)', ' ======================= ============== =========='
|
||||
print '(A)', ' E(CCSD(T)) Error % '
|
||||
print '(A)', ' ======================= ============== =========='
|
||||
|
||||
|
||||
call wall_time(t00)
|
||||
imin = 1_8
|
||||
!$OMP PARALLEL &
|
||||
!$OMP PRIVATE(ieta,eta,a,b,c,kiter,isample) &
|
||||
!$OMP DEFAULT(SHARED)
|
||||
|
||||
do kiter=1,Nabc
|
||||
|
||||
!$OMP MASTER
|
||||
do while (imin <= Nabc)
|
||||
if (sampled(imin)>-1_8) then
|
||||
imin = imin+1
|
||||
else
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
|
||||
! Deterministic part
|
||||
if (imin < Nabc) then
|
||||
ieta=imin
|
||||
sampled(ieta) = 0_8
|
||||
a = abc(1,ieta)
|
||||
b = abc(2,ieta)
|
||||
c = abc(3,ieta)
|
||||
Ncomputed += 1_8
|
||||
!$OMP TASK DEFAULT(SHARED) FIRSTPRIVATE(a,b,c,ieta)
|
||||
if (a/=c) then
|
||||
memo(ieta) = ccsd_t_task_abc(a,b,c,nO,nV,t1,T_oovv,T_voov, &
|
||||
X_ooov,X_oovv,X_vovv,f_o,f_v) / 3.d0
|
||||
else
|
||||
memo(ieta) = ccsd_t_task_aba(a,b,nO,nV,t1,T_oovv,T_voov, &
|
||||
X_ooov,X_oovv,X_vovv,f_o,f_v) / 3.d0
|
||||
endif
|
||||
!$OMP END TASK
|
||||
endif
|
||||
|
||||
! Stochastic part
|
||||
call random_number(eta)
|
||||
do isample=1,nbuckets
|
||||
if (imin >= bounds(2,isample)) then
|
||||
cycle
|
||||
endif
|
||||
ieta = binary_search(waccu,(eta + dble(isample-1))/dble(nbuckets),Nabc)+1
|
||||
|
||||
if (sampled(ieta) == -1_8) then
|
||||
sampled(ieta) = 0_8
|
||||
a = abc(1,ieta)
|
||||
b = abc(2,ieta)
|
||||
c = abc(3,ieta)
|
||||
Ncomputed += 1_8
|
||||
!$OMP TASK DEFAULT(SHARED) FIRSTPRIVATE(a,b,c,ieta)
|
||||
if (a/=c) then
|
||||
memo(ieta) = ccsd_t_task_abc(a,b,c,nO,nV,t1,T_oovv,T_voov, &
|
||||
X_ooov,X_oovv,X_vovv,f_o,f_v) / 3.d0
|
||||
else
|
||||
memo(ieta) = ccsd_t_task_aba(a,b,nO,nV,t1,T_oovv,T_voov, &
|
||||
X_ooov,X_oovv,X_vovv,f_o,f_v) / 3.d0
|
||||
endif
|
||||
!$OMP END TASK
|
||||
endif
|
||||
sampled(ieta) = sampled(ieta)+1_8
|
||||
|
||||
enddo
|
||||
|
||||
call wall_time(t01)
|
||||
if ((t01-t00 > 1.0d0).or.(imin >= Nabc)) then
|
||||
|
||||
!$OMP TASKWAIT
|
||||
call wall_time(t01)
|
||||
t00 = t01
|
||||
|
||||
double precision :: ET, ET2
|
||||
double precision :: energy_stoch, energy_det
|
||||
double precision :: scale
|
||||
double precision :: w
|
||||
double precision :: tmp
|
||||
energy_stoch = 0.d0
|
||||
energy_det = 0.d0
|
||||
norm = 0.d0
|
||||
scale = 1.d0
|
||||
ET = 0.d0
|
||||
ET2 = 0.d0
|
||||
|
||||
|
||||
do isample=1,nbuckets
|
||||
if (imin >= bounds(2,isample)) then
|
||||
energy_det = energy_det + sum(memo(bounds(1,isample):bounds(2,isample)))
|
||||
scale = scale - wsum(isample)
|
||||
else
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
|
||||
isample = min(isample,nbuckets)
|
||||
do ieta=bounds(1,isample), Nabc
|
||||
w = dble(max(sampled(ieta),0_8))
|
||||
tmp = w * memo(ieta) * Pabc(ieta)
|
||||
ET = ET + tmp
|
||||
ET2 = ET2 + tmp * memo(ieta) * Pabc(ieta)
|
||||
norm = norm + w
|
||||
enddo
|
||||
norm = norm/scale
|
||||
if (norm > 0.d0) then
|
||||
energy_stoch = ET / norm
|
||||
variance = ET2 / norm - energy_stoch*energy_stoch
|
||||
endif
|
||||
|
||||
energy = energy_det + energy_stoch
|
||||
|
||||
print '('' '',F20.8, '' '', ES12.4,'' '', F8.2,'' '')', eccsd+energy, dsqrt(variance/(norm-1.d0)), 100.*real(Ncomputed)/real(Nabc)
|
||||
endif
|
||||
!$OMP END MASTER
|
||||
if (imin >= Nabc) exit
|
||||
enddo
|
||||
|
||||
!$OMP END PARALLEL
|
||||
print '(A)', ' ======================= ============== ========== '
|
||||
print '(A)', ''
|
||||
|
||||
deallocate(X_vovv)
|
||||
deallocate(X_ooov)
|
||||
deallocate(T_voov)
|
||||
deallocate(T_oovv)
|
||||
end
|
||||
|
||||
|
||||
|
||||
integer*8 function binary_search(arr, key, sze)
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Searches the key in array arr(1:sze) between l_in and r_in, and returns its index
|
||||
END_DOC
|
||||
integer*8 :: sze, i, j, mid
|
||||
double precision :: arr(0:sze)
|
||||
double precision :: key
|
||||
|
||||
if ( key < arr(1) ) then
|
||||
binary_search = 0_8
|
||||
return
|
||||
end if
|
||||
|
||||
if ( key >= arr(sze) ) then
|
||||
binary_search = sze
|
||||
return
|
||||
end if
|
||||
|
||||
i = 0_8
|
||||
j = sze + 1_8
|
||||
|
||||
do while (.True.)
|
||||
mid = (i + j) / 2_8
|
||||
if ( key >= arr(mid) ) then
|
||||
i = mid
|
||||
else
|
||||
j = mid
|
||||
end if
|
||||
if (j-i <= 1_8) then
|
||||
binary_search = i
|
||||
return
|
||||
endif
|
||||
end do
|
||||
end function binary_search
|
||||
|
376
devel/ccsd_gpu/ccsd_t_spin_orb.irp.f
Normal file
376
devel/ccsd_gpu/ccsd_t_spin_orb.irp.f
Normal file
@ -0,0 +1,376 @@
|
||||
! v1
|
||||
|
||||
subroutine ccsd_par_t_spin(nO,nV,t1,t2,f_o,f_v,f_ov,v_ooov,v_vvoo,v_vvvo,energy)
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: nO, nV
|
||||
double precision, intent(in) :: t1(nO,nV), t2(nO,nO,nV,nV)
|
||||
double precision, intent(in) :: f_o(nO), f_v(nV), f_ov(nO,nV)
|
||||
double precision, intent(in) :: v_ooov(nO,nO,nO,nV)
|
||||
double precision, intent(in) :: v_vvoo(nV,nV,nO,nO), v_vvvo(nV,nV,nV,nO)
|
||||
double precision, intent(out) :: energy
|
||||
|
||||
double precision, allocatable :: t3(:,:,:,:,:,:), s(:,:)
|
||||
double precision :: e_t, e_st, e_dt, delta_abc, delta
|
||||
integer :: i,j,k,l,m,a,b,c,d,e
|
||||
|
||||
allocate(t3(nO,nO,nO,nV,nV,nV), s(nO,nV))
|
||||
|
||||
t3 = 0d0
|
||||
|
||||
! T3
|
||||
do c = 1, nV
|
||||
do b = 1, nV
|
||||
do a = 1, nV
|
||||
delta_abc = f_v(a) + f_v(b) + f_v(c)
|
||||
do k = 1, nO
|
||||
do j = 1, nO
|
||||
do i = 1, nO
|
||||
delta = f_o(i) + f_o(j) + f_o(k) - delta_abc
|
||||
do e = 1, nV
|
||||
t3(i,j,k,a,b,c) = t3(i,j,k,a,b,c) &
|
||||
+ t2(j,k,a,e) * v_vvvo(b,c,e,i) &
|
||||
- t2(i,k,a,e) * v_vvvo(b,c,e,j) & ! - P(ij)
|
||||
- t2(j,i,a,e) * v_vvvo(b,c,e,k) & ! - P(ik)
|
||||
- t2(j,k,b,e) * v_vvvo(a,c,e,i) & ! - P(ab)
|
||||
- t2(j,k,c,e) * v_vvvo(b,a,e,i) & ! - P(ac)
|
||||
+ t2(i,k,b,e) * v_vvvo(a,c,e,j) & ! + P(ij) P(ab)
|
||||
+ t2(i,k,c,e) * v_vvvo(b,a,e,j) & ! + P(ij) P(ac)
|
||||
+ t2(j,i,b,e) * v_vvvo(a,c,e,k) & ! + P(ik) P(ab)
|
||||
+ t2(j,i,c,e) * v_vvvo(b,a,e,k) ! + P(ik) P(ac)
|
||||
enddo
|
||||
do m = 1, nO
|
||||
t3(i,j,k,a,b,c) = t3(i,j,k,a,b,c) &
|
||||
+ t2(m,i,b,c) * v_ooov(j,k,m,a) &
|
||||
- t2(m,j,b,c) * v_ooov(i,k,m,a) & ! - P(ij)
|
||||
- t2(m,k,b,c) * v_ooov(j,i,m,a) & ! - P(ik)
|
||||
- t2(m,i,a,c) * v_ooov(j,k,m,b) & ! - P(ab)
|
||||
- t2(m,i,b,a) * v_ooov(j,k,m,c) & ! - P(ac)
|
||||
+ t2(m,j,a,c) * v_ooov(i,k,m,b) & ! + P(ij) P(ab)
|
||||
+ t2(m,j,b,a) * v_ooov(i,k,m,c) & ! + P(ij) P(ac)
|
||||
+ t2(m,k,a,c) * v_ooov(j,i,m,b) & ! + P(ik) P(ab)
|
||||
+ t2(m,k,b,a) * v_ooov(j,i,m,c) ! + P(ik) P(ac)
|
||||
enddo
|
||||
t3(i,j,k,a,b,c) = t3(i,j,k,a,b,c) * (1d0 / delta)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
|
||||
! E_T
|
||||
e_t = 0d0
|
||||
do c = 1, nV
|
||||
do b = 1, nV
|
||||
do a = 1, nV
|
||||
delta_abc = f_v(a) + f_v(b) + f_v(c)
|
||||
do k = 1, nO
|
||||
do j = 1, nO
|
||||
do i = 1, nO
|
||||
delta = f_o(i) + f_o(j) + f_o(k) - delta_abc
|
||||
e_t = e_t + t3(i,j,k,a,b,c) * delta * t3(i,j,k,a,b,c)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
e_t = e_t / 36d0
|
||||
|
||||
! E_ST
|
||||
s = 0d0
|
||||
do c = 1, nV
|
||||
do b = 1, nV
|
||||
do a = 1, nV
|
||||
do k = 1, nO
|
||||
do j = 1, nO
|
||||
do i = 1, nO
|
||||
s(i,a) = s(i,a) + v_vvoo(b,c,j,k) * t3(i,j,k,a,b,c)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
e_st = 0d0
|
||||
do a = 1, nV
|
||||
do i = 1, nO
|
||||
e_st = e_st + s(i,a) * t1(i,a)
|
||||
enddo
|
||||
enddo
|
||||
e_st = e_st * 0.25d0
|
||||
|
||||
! E_DT
|
||||
e_dt = 0d0
|
||||
do c = 1, nV
|
||||
do b = 1, nV
|
||||
do a = 1, nV
|
||||
do k = 1, nO
|
||||
do j = 1, nO
|
||||
do i = 1, nO
|
||||
e_dt = e_dt + t2(i,j,a,b) * f_ov(k,c) * t3(i,j,k,a,b,c)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
e_dt = e_dt * 0.25d0
|
||||
|
||||
! (T)
|
||||
!print*,e_t,e_st,e_dt
|
||||
energy = e_t + e_st + e_dt
|
||||
|
||||
deallocate(t3,s)
|
||||
|
||||
end
|
||||
|
||||
! v2
|
||||
|
||||
subroutine ccsd_par_t_spin_v2(nO,nV,t1,t2,f_o,f_v,f_ov,v_ooov,v_vvoo,energy)
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: nO, nV
|
||||
double precision, intent(in) :: t1(nO,nV), t2(nO,nO,nV,nV)
|
||||
double precision, intent(in) :: f_o(nO), f_v(nV), f_ov(nO,nV)
|
||||
double precision, intent(in) :: v_ooov(nO,nO,nO,nV)
|
||||
double precision, intent(in) :: v_vvoo(nV,nV,nO,nO)
|
||||
double precision, intent(out) :: energy
|
||||
|
||||
double precision, allocatable :: t3_bc(:,:,:,:), s(:,:), e_t(:), e_dt(:)
|
||||
double precision, allocatable :: A_vovv(:,:,:,:), v_vvvo(:,:,:,:)
|
||||
double precision, allocatable :: T_voov(:,:,:,:), B_ooov(:,:,:,:)
|
||||
double precision :: e_st, delta_abc, delta, ta, tb
|
||||
integer :: i,j,k,l,m,a,b,c,d,e
|
||||
|
||||
allocate(t3_bc(nO,nO,nO,nV), s(nO,nV), e_t(nV), e_dt(nV))
|
||||
allocate(A_vovv(nV,nO,nV,nV),v_vvvo(nV,nV,nV,nO),T_voov(nV,nO,nO,nV),B_ooov(nO,nO,nO,nV))
|
||||
|
||||
call gen_v_spin(cc_nV_m,cc_nV_m,cc_nV_m,cc_nO_m, &
|
||||
cc_nV_S,cc_nV_S,cc_nV_S,cc_nO_S, &
|
||||
cc_list_vir_spin,cc_list_vir_spin,cc_list_vir_spin,cc_list_occ_spin, &
|
||||
nV,nV,nV,nO, v_vvvo)
|
||||
|
||||
! Init
|
||||
s = 0d0
|
||||
e_t = 0d0
|
||||
e_st = 0d0
|
||||
e_dt = 0d0
|
||||
|
||||
call wall_time(ta)
|
||||
!$OMP PARALLEL &
|
||||
!$OMP PRIVATE(i,j,k,m,a,b,c,e) &
|
||||
!$OMP SHARED(A_vovv,ta,tb,t3_bc,s,e_t,e_st,e_dt,t2,v_vvvo,v_ooov, &
|
||||
!$OMP v_vvoo,f_o,f_v,f_ov,delta,delta_abc,nO,nV,T_voov,B_ooov) &
|
||||
!$OMP DEFAULT(NONE)
|
||||
|
||||
!$OMP DO collapse(3)
|
||||
do c = 1, nV
|
||||
do b = 1, nV
|
||||
do i = 1, nO
|
||||
do e = 1, nV
|
||||
A_vovv(e,i,b,c) = v_vvvo(b,c,e,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO nowait
|
||||
|
||||
!$omp do collapse(3)
|
||||
do a = 1, nV
|
||||
do k = 1, nO
|
||||
do j = 1, nO
|
||||
do e = 1, nV
|
||||
T_voov(e,j,k,a) = t2(j,k,a,e)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$omp end do nowait
|
||||
|
||||
!$omp do collapse(3)
|
||||
do a = 1, nV
|
||||
do k = 1, nO
|
||||
do j = 1, nO
|
||||
do m = 1, nO
|
||||
B_ooov(m,j,k,a) = v_ooov(j,k,m,a)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$omp end do
|
||||
|
||||
do c = 1, nV
|
||||
do b = 1, nV
|
||||
|
||||
! T3(:,:,:,:,b,c)
|
||||
! Init
|
||||
!$OMP DO collapse(3)
|
||||
do a = 1, nV
|
||||
do k = 1, nO
|
||||
do j = 1, nO
|
||||
do i = 1, nO
|
||||
t3_bc(i,j,k,a) = 0d0
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
|
||||
!$OMP DO collapse(3)
|
||||
do a = 1, nV
|
||||
do k = 1, nO
|
||||
do j = 1, nO
|
||||
do i = 1, nO
|
||||
do e = 1, nV
|
||||
t3_bc(i,j,k,a) = t3_bc(i,j,k,a) &
|
||||
!+ t2(j,k,a,e) * v_vvvo(b,c,e,i) &
|
||||
!- t2(i,k,a,e) * v_vvvo(b,c,e,j) & ! - P(ij)
|
||||
!- t2(j,i,a,e) * v_vvvo(b,c,e,k) & ! - P(ik)
|
||||
!- t2(j,k,b,e) * v_vvvo(a,c,e,i) & ! - P(ab)
|
||||
!- t2(j,k,c,e) * v_vvvo(b,a,e,i) & ! - P(ac)
|
||||
!+ t2(i,k,b,e) * v_vvvo(a,c,e,j) & ! + P(ij) P(ab)
|
||||
!+ t2(i,k,c,e) * v_vvvo(b,a,e,j) & ! + P(ij) P(ac)
|
||||
!+ t2(j,i,b,e) * v_vvvo(a,c,e,k) & ! + P(ik) P(ab)
|
||||
!+ t2(j,i,c,e) * v_vvvo(b,a,e,k) ! + P(ik) P(ac)
|
||||
+ T_voov(e,j,k,a) * A_vovv(e,i,b,c) &
|
||||
- T_voov(e,i,k,a) * A_vovv(e,j,b,c) & ! - P(ij)
|
||||
- T_voov(e,j,i,a) * A_vovv(e,k,b,c) & ! - P(ik)
|
||||
- T_voov(e,j,k,b) * A_vovv(e,i,a,c) & ! - P(ab)
|
||||
- T_voov(e,j,k,c) * A_vovv(e,i,b,a) & ! - P(ac)
|
||||
+ T_voov(e,i,k,b) * A_vovv(e,j,a,c) & ! + P(ij) P(ab)
|
||||
+ T_voov(e,i,k,c) * A_vovv(e,j,b,a) & ! + P(ij) P(ac)
|
||||
+ T_voov(e,j,i,b) * A_vovv(e,k,a,c) & ! + P(ik) P(ab)
|
||||
+ T_voov(e,j,i,c) * A_vovv(e,k,b,a) ! + P(ik) P(ac)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
|
||||
!$OMP DO collapse(3)
|
||||
do a = 1, nV
|
||||
do k = 1, nO
|
||||
do j = 1, nO
|
||||
do i = 1, nO
|
||||
do m = 1, nO
|
||||
t3_bc(i,j,k,a) = t3_bc(i,j,k,a) &
|
||||
!+ t2(m,i,b,c) * v_ooov(j,k,m,a) &
|
||||
!- t2(m,j,b,c) * v_ooov(i,k,m,a) & ! - P(ij)
|
||||
!- t2(m,k,b,c) * v_ooov(j,i,m,a) & ! - P(ik)
|
||||
!- t2(m,i,a,c) * v_ooov(j,k,m,b) & ! - P(ab)
|
||||
!- t2(m,i,b,a) * v_ooov(j,k,m,c) & ! - P(ac)
|
||||
!+ t2(m,j,a,c) * v_ooov(i,k,m,b) & ! + P(ij) P(ab)
|
||||
!+ t2(m,j,b,a) * v_ooov(i,k,m,c) & ! + P(ij) P(ac)
|
||||
!+ t2(m,k,a,c) * v_ooov(j,i,m,b) & ! + P(ik) P(ab)
|
||||
!+ t2(m,k,b,a) * v_ooov(j,i,m,c) ! + P(ik) P(ac)
|
||||
+ t2(m,i,b,c) * B_ooov(m,j,k,a) &
|
||||
- t2(m,j,b,c) * B_ooov(m,i,k,a) & ! - P(ij)
|
||||
- t2(m,k,b,c) * B_ooov(m,j,i,a) & ! - P(ik)
|
||||
- t2(m,i,a,c) * B_ooov(m,j,k,b) & ! - P(ab)
|
||||
- t2(m,i,b,a) * B_ooov(m,j,k,c) & ! - P(ac)
|
||||
+ t2(m,j,a,c) * B_ooov(m,i,k,b) & ! + P(ij) P(ab)
|
||||
+ t2(m,j,b,a) * B_ooov(m,i,k,c) & ! + P(ij) P(ac)
|
||||
+ t2(m,k,a,c) * B_ooov(m,j,i,b) & ! + P(ik) P(ab)
|
||||
+ t2(m,k,b,a) * B_ooov(m,j,i,c) ! + P(ik) P(ac)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
|
||||
!$OMP DO
|
||||
do a = 1, nV
|
||||
delta_abc = f_v(a) + f_v(b) + f_v(c)
|
||||
do k = 1, nO
|
||||
do j = 1, nO
|
||||
do i = 1, nO
|
||||
delta = f_o(i) + f_o(j) + f_o(k) - delta_abc
|
||||
t3_bc(i,j,k,a) = t3_bc(i,j,k,a) * (1d0 / delta)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
|
||||
! E_T
|
||||
!$OMP DO
|
||||
do a = 1, nV
|
||||
delta_abc = f_v(a) + f_v(b) + f_v(c)
|
||||
do k = 1, nO
|
||||
do j = 1, nO
|
||||
do i = 1, nO
|
||||
delta = f_o(i) + f_o(j) + f_o(k) - delta_abc
|
||||
e_t(a) = e_t(a) + t3_bc(i,j,k,a) * delta * t3_bc(i,j,k,a)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO nowait
|
||||
|
||||
! E_ST
|
||||
!$OMP DO
|
||||
do a = 1, nV
|
||||
do k = 1, nO
|
||||
do j = 1, nO
|
||||
do i = 1, nO
|
||||
s(i,a) = s(i,a) + v_vvoo(b,c,j,k) * t3_bc(i,j,k,a)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO nowait
|
||||
|
||||
! E_DT
|
||||
!$OMP DO
|
||||
do a = 1, nV
|
||||
do k = 1, nO
|
||||
do j = 1, nO
|
||||
do i = 1, nO
|
||||
e_dt(a) = e_dt(a) + t2(i,j,a,b) * f_ov(k,c) * t3_bc(i,j,k,a)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
enddo
|
||||
!$OMP MASTER
|
||||
call wall_time(tb)
|
||||
write(*,'(A1,F6.2,A5,F10.2,A2)') ' ', dble(c)/dble(nV)*100d0, '% in ', tb-ta, ' s'
|
||||
!$OMP END MASTER
|
||||
enddo
|
||||
!$OMP END PARALLEL
|
||||
|
||||
do a = 2, nV
|
||||
e_t(1) = e_t(1) + e_t(a)
|
||||
enddo
|
||||
|
||||
do a = 2, nV
|
||||
e_dt(1) = e_dt(1) + e_dt(a)
|
||||
enddo
|
||||
|
||||
e_t = e_t / 36d0
|
||||
|
||||
do a = 1, nV
|
||||
do i = 1, nO
|
||||
e_st = e_st + s(i,a) * t1(i,a)
|
||||
enddo
|
||||
enddo
|
||||
e_st = e_st * 0.25d0
|
||||
|
||||
e_dt = e_dt * 0.25d0
|
||||
|
||||
! (T)
|
||||
!print*,e_t(1),e_st,e_dt(1)
|
||||
energy = e_t(1) + e_st + e_dt(1)
|
||||
|
||||
deallocate(t3_bc,s)
|
||||
|
||||
end
|
106
devel/ccsd_gpu/gpu.c
Normal file
106
devel/ccsd_gpu/gpu.c
Normal file
@ -0,0 +1,106 @@
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
/*
|
||||
#include <stdio.h>
|
||||
#include <pthread.h>
|
||||
#include <cblas.h>
|
||||
#include <cublas_v2.h>
|
||||
*/
|
||||
|
||||
#define BLOCK_SIZE 16
|
||||
|
||||
void dgemm_(char*, char*, int*, int*, int*, double*, double*, int*, double*, int*,
|
||||
double*, double*, int*);
|
||||
|
||||
|
||||
|
||||
void* compute_r2_space_chol_gpu(const int nO, const int nV, const int cholesky_mo_num,
|
||||
double* t1,
|
||||
double* tau,
|
||||
double* cc_space_v_vo_chol,
|
||||
double* cc_space_v_vv_chol,
|
||||
double* r2)
|
||||
{
|
||||
int m,n,k, lda, ldb, ldc;
|
||||
double alpha, beta;
|
||||
double* A;
|
||||
double* B;
|
||||
double* C;
|
||||
|
||||
double* tmp_cc = malloc(cholesky_mo_num*nV*nV*sizeof(double));
|
||||
|
||||
|
||||
m=cholesky_mo_num*nV; n=nV; k=nO;
|
||||
alpha=1.0; beta=0.0;
|
||||
lda=m ; ldb=k ; ldc=m;
|
||||
A=cc_space_v_vo_chol; B=t1; C=tmp_cc;
|
||||
dgemm_("N","N", &m, &n, &k, &alpha, A, &lda, B, &ldb, &beta, C, &ldc);
|
||||
|
||||
|
||||
#pragma omp parallel
|
||||
{
|
||||
|
||||
double* tmp_cc2 = malloc(cholesky_mo_num*nV*sizeof(double));
|
||||
double* B1 = malloc(nV*nV*BLOCK_SIZE*sizeof(double));
|
||||
double* tmpB1 = malloc(nV*BLOCK_SIZE*nV*sizeof(double));
|
||||
|
||||
#pragma omp for
|
||||
for (size_t gam=0 ; gam<nV ; ++gam)
|
||||
{
|
||||
double* cc_space_v_vv_chol_ = &(cc_space_v_vv_chol[gam*nV*cholesky_mo_num]);
|
||||
double* tmp_cc_ = &(tmp_cc[gam*nV*cholesky_mo_num]);
|
||||
|
||||
for (size_t l=0 ; l<nV*cholesky_mo_num ; ++l) {
|
||||
tmp_cc2[l] = cc_space_v_vv_chol_[l] - tmp_cc_[l];
|
||||
}
|
||||
|
||||
for (size_t iblock=0 ; iblock<nV ; iblock += BLOCK_SIZE)
|
||||
{
|
||||
const size_t mbs = BLOCK_SIZE < nV-iblock ? BLOCK_SIZE : nV-iblock;
|
||||
|
||||
|
||||
alpha=-1.0; beta=0.0;
|
||||
m=nV*mbs; n=nV; k=cholesky_mo_num;
|
||||
A=&(tmp_cc[iblock*cholesky_mo_num*nV]); lda=cholesky_mo_num;
|
||||
B=cc_space_v_vv_chol_; ldb=cholesky_mo_num;
|
||||
C=tmpB1 ; ldc=nV*BLOCK_SIZE;
|
||||
dgemm_("T","N", &m, &n, &k, &alpha, A, &lda, B, &ldb, &beta, C, &ldc);
|
||||
|
||||
|
||||
|
||||
alpha=1.0; beta=1.0;
|
||||
m=nV*mbs; n=nV; k=cholesky_mo_num;
|
||||
A=&(cc_space_v_vv_chol[iblock*cholesky_mo_num*nV]); lda=cholesky_mo_num;
|
||||
B=tmp_cc2; ldb=cholesky_mo_num;
|
||||
C=tmpB1 ; ldc=nV*BLOCK_SIZE;
|
||||
dgemm_("T","N", &m, &n, &k, &alpha, A, &lda, B, &ldb, &beta, C, &ldc);
|
||||
|
||||
|
||||
|
||||
for (size_t beta=iblock ; beta<(nV < iblock+BLOCK_SIZE ? nV : iblock+BLOCK_SIZE) ; ++beta) {
|
||||
for (size_t b=0 ; b<nV ; ++b) {
|
||||
for (size_t a=0 ; a<nV ; ++a) {
|
||||
B1[a + nV*(b + nV*(beta-iblock))] =
|
||||
tmpB1[a + nV*(beta-iblock + BLOCK_SIZE*b)];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
alpha=1.0; beta=1.0;
|
||||
m=nO*nO; n=mbs; k=nV*nV;
|
||||
A=tau; lda=nO*nO;
|
||||
B=B1 ; ldb=nV*nV;
|
||||
C=&(r2[nO*nO*(iblock + nV*gam)]); ldc=nO*nO;
|
||||
dgemm_("N","N", &m, &n, &k, &alpha, A, &lda, B, &ldb, &beta, C, &ldc);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
free(tmp_cc2);
|
||||
free(B1);
|
||||
free(tmpB1);
|
||||
}
|
||||
free(tmp_cc);
|
||||
}
|
||||
|
||||
|
BIN
devel/ccsd_gpu/gpu.o
Normal file
BIN
devel/ccsd_gpu/gpu.o
Normal file
Binary file not shown.
52
devel/ccsd_gpu/gpu_module.f90
Normal file
52
devel/ccsd_gpu/gpu_module.f90
Normal file
@ -0,0 +1,52 @@
|
||||
|
||||
module gpu_module
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
|
||||
interface
|
||||
subroutine compute_r2_space_chol_gpu(nO,nV,cholesky_mo_num, &
|
||||
t1,tau,cc_space_v_vo_chol,cc_space_v_vv_chol, r2) bind(C)
|
||||
import c_int, c_double
|
||||
integer(c_int), value :: nO, nV, cholesky_mo_num
|
||||
real(c_double), intent(in) :: t1(nO,nV)
|
||||
real(c_double), intent(in) :: tau(nO,nO,nV,nV)
|
||||
real(c_double), intent(in) :: cc_space_v_vo_chol(cholesky_mo_num,nV,nO)
|
||||
real(c_double), intent(in) :: cc_space_v_vv_chol(cholesky_mo_num,nV,nV)
|
||||
real(c_double), intent(out) :: r2(nO,nO,nV,nV)
|
||||
end subroutine
|
||||
|
||||
subroutine gemm0(nO, nV, cholesky_mo_num, cc_space_v_vo_chol, t1, tmp_cc) bind(C, name="gemm0")
|
||||
import c_int, c_double
|
||||
integer(c_int), value :: nO, nV, cholesky_mo_num
|
||||
real(c_double) :: cc_space_v_vo_chol(cholesky_mo_num,nV,nO)
|
||||
real(c_double) :: t1(nO,nV)
|
||||
real(c_double) :: tmp_cc(cholesky_mo_num,nV,nV)
|
||||
end subroutine gemm0
|
||||
|
||||
subroutine gemm1(iblock, nV, cholesky_mo_num, tmp_cc, cc_space_v_vv_chol_, tmpB1) bind(C, name="gemm1")
|
||||
import c_int, c_double
|
||||
integer(c_int), value :: iblock, nV, cholesky_mo_num
|
||||
real(c_double) :: tmp_cc(cholesky_mo_num,nV,nV)
|
||||
real(c_double) :: cc_space_v_vv_chol_(cholesky_mo_num,nV)
|
||||
real(c_double) :: tmpB1(nV,16,nV)
|
||||
end subroutine gemm1
|
||||
|
||||
subroutine gemm2(iblock, nV, cholesky_mo_num, tmp_cc2, cc_space_v_vv_chol, tmpB1) bind(C, name="gemm2")
|
||||
import c_int, c_double
|
||||
integer(c_int), value :: iblock, nV, cholesky_mo_num
|
||||
real(c_double) :: tmp_cc2(cholesky_mo_num,nV)
|
||||
real(c_double) :: cc_space_v_vv_chol(cholesky_mo_num,nV,nV)
|
||||
real(c_double) :: tmpB1(nV,16,nV)
|
||||
end subroutine gemm2
|
||||
|
||||
subroutine gemm3(iblock, nO, nV, gam, tau, B1, r2) bind(C, name="gemm3")
|
||||
import c_int, c_double
|
||||
integer(c_int), value :: iblock, nO, nV, gam
|
||||
real(c_double) :: tau(nO,nO,nV,nV)
|
||||
real(c_double) :: B1(nV,nV,*)
|
||||
real(c_double) :: r2(nO,nO,nV,nV)
|
||||
end subroutine gemm3
|
||||
|
||||
end interface
|
||||
|
||||
end module
|
13
devel/ccsd_gpu/save_energy.irp.f
Normal file
13
devel/ccsd_gpu/save_energy.irp.f
Normal file
@ -0,0 +1,13 @@
|
||||
subroutine save_energy(E,ET)
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Saves the energy in |EZFIO|.
|
||||
END_DOC
|
||||
double precision, intent(in) :: E, ET
|
||||
call ezfio_set_ccsd_energy(E)
|
||||
if (ET /= 0.d0) then
|
||||
call ezfio_set_ccsd_energy_t(E+ET)
|
||||
endif
|
||||
end
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user