mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-12-14 15:43:30 +01:00
Fixed Conflict
This commit is contained in:
parent
bb155c0dfd
commit
b26f7e7fe6
2
.github/workflows/configuration.yml
vendored
2
.github/workflows/configuration.yml
vendored
@ -22,7 +22,7 @@ jobs:
|
||||
- uses: actions/checkout@v3
|
||||
- name: Install dependencies
|
||||
run: |
|
||||
sudo apt install gfortran gcc liblapack-dev libblas-dev wget python3 make m4 pkg-config hdf5
|
||||
sudo apt install gfortran gcc liblapack-dev libblas-dev wget python3 make m4 pkg-config libhdf5-dev
|
||||
- name: zlib
|
||||
run: |
|
||||
./configure -i zlib || echo OK
|
||||
|
@ -10,7 +10,8 @@
|
||||
- Added many types of integrals
|
||||
- Accelerated four-index transformation
|
||||
- Added transcorrelated SCF
|
||||
- Added transcorrelated CIPSI
|
||||
- Added bi-orthonormal transcorrelated CIPSI
|
||||
- Added Cholesky decomposition of AO integrals
|
||||
- Added CCSD and CCSD(T)
|
||||
- Added MO localization
|
||||
- Changed coupling parameters for ROHF
|
||||
@ -20,7 +21,7 @@
|
||||
- Removed cryptokit dependency in OCaml
|
||||
- Using now standard convention in RDM
|
||||
- Added molecular properties
|
||||
- [ ] Added GTOs with complex exponent
|
||||
- Added GTOs with complex exponent
|
||||
|
||||
*** TODO: take from dev
|
||||
- Updated version of f77-zmq
|
||||
|
@ -14,7 +14,7 @@
|
||||
#
|
||||
[COMMON]
|
||||
FC : gfortran -g -ffree-line-length-none -I . -fPIC -march=native
|
||||
LAPACK_LIB : -larmpl_lp64
|
||||
LAPACK_LIB : -larmpl_lp64_mp
|
||||
IRPF90 : irpf90
|
||||
IRPF90_FLAGS : --ninja --align=32 --assert -DSET_NESTED
|
||||
|
||||
|
66
config/ifort_2021_debug.cfg
Normal file
66
config/ifort_2021_debug.cfg
Normal file
@ -0,0 +1,66 @@
|
||||
# Common flags
|
||||
##############
|
||||
#
|
||||
# -mkl=[parallel|sequential] : Use the MKL library
|
||||
# --ninja : Allow the utilisation of ninja. It is mandatory !
|
||||
# --align=32 : Align all provided arrays on a 32-byte boundary
|
||||
#
|
||||
[COMMON]
|
||||
FC : ifort -fpic
|
||||
LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps
|
||||
IRPF90 : irpf90
|
||||
IRPF90_FLAGS : --ninja --align=32 --assert -DINTEL
|
||||
|
||||
# Global options
|
||||
################
|
||||
#
|
||||
# 1 : Activate
|
||||
# 0 : Deactivate
|
||||
#
|
||||
[OPTION]
|
||||
MODE : DEBUG ; [ OPT | PROFILE | DEBUG ] : Chooses the section below
|
||||
CACHE : 0 ; Enable cache_compile.py
|
||||
OPENMP : 1 ; Append OpenMP flags
|
||||
|
||||
# Optimization flags
|
||||
####################
|
||||
#
|
||||
# -xHost : Compile a binary optimized for the current architecture
|
||||
# -O2 : O3 not better than O2.
|
||||
# -ip : Inter-procedural optimizations
|
||||
# -ftz : Flushes denormal results to zero
|
||||
#
|
||||
[OPT]
|
||||
FC : -traceback
|
||||
FCFLAGS : -msse4.2 -O2 -ip -ftz -g
|
||||
|
||||
|
||||
# Profiling flags
|
||||
#################
|
||||
#
|
||||
[PROFILE]
|
||||
FC : -p -g
|
||||
FCFLAGS : -msse4.2 -O2 -ip -ftz
|
||||
|
||||
|
||||
# Debugging flags
|
||||
#################
|
||||
#
|
||||
# -traceback : Activate backtrace on runtime
|
||||
# -fpe0 : All floating point exaceptions
|
||||
# -C : Checks uninitialized variables, array subscripts, etc...
|
||||
# -g : Extra debugging information
|
||||
# -msse4.2 : Valgrind needs a very simple x86 executable
|
||||
#
|
||||
[DEBUG]
|
||||
FC : -g -traceback
|
||||
FCFLAGS : -msse4.2 -check all -debug all -fpe-all=0 -implicitnone
|
||||
|
||||
|
||||
# OpenMP flags
|
||||
#################
|
||||
#
|
||||
[OPENMP]
|
||||
FC : -qopenmp
|
||||
IRPF90_FLAGS : --openmp
|
||||
|
13
etc/qp.rc
13
etc/qp.rc
@ -188,7 +188,18 @@ _qp_Complete()
|
||||
;;
|
||||
esac;;
|
||||
set_file)
|
||||
COMPREPLY=( $(compgen -W "$(for i in */ $(find . -name ezfio | sed 's/ezfio$/.version/') ; do [[ -f $i ]] && echo ${i%/.version} ; done)" -- ${cur} ) )
|
||||
# Array to store directory names
|
||||
dirs=""
|
||||
|
||||
# Find directories containing "ezfio/.version" file recursively
|
||||
for i in $(find . -name ezfio | sed 's/ezfio$/.version/')
|
||||
do
|
||||
dir_name=${i%/.version} # Remove the ".version" suffix
|
||||
dir_name=${dir_name#./} # Remove the leading "./"
|
||||
dirs+="./$dir_name "
|
||||
done
|
||||
|
||||
COMPREPLY=( $(compgen -W "$dirs" -- ${cur} ) )
|
||||
return 0
|
||||
;;
|
||||
plugins)
|
||||
|
2
external/ezfio
vendored
2
external/ezfio
vendored
@ -1 +1 @@
|
||||
Subproject commit 0520b5e2cf70e2451c37ce5b7f2f64f6d2e5e956
|
||||
Subproject commit ed1df9f3c1f51752656ca98da5693a4119add05c
|
2
external/irpf90
vendored
2
external/irpf90
vendored
@ -1 +1 @@
|
||||
Subproject commit 0007f72f677fe7d61c5e1ed461882cb239517102
|
||||
Subproject commit 33ca5e1018f3bbb5e695e6ee558f5dac0753b271
|
@ -4,6 +4,12 @@ doc: Read/Write |AO| integrals from/to disk [ Write | Read | None ]
|
||||
interface: ezfio,provider,ocaml
|
||||
default: None
|
||||
|
||||
[io_ao_cholesky]
|
||||
type: Disk_access
|
||||
doc: Read/Write |AO| integrals from/to disk [ Write | Read | None ]
|
||||
interface: ezfio,provider,ocaml
|
||||
default: None
|
||||
|
||||
[ao_integrals_threshold]
|
||||
type: Threshold
|
||||
doc: If | (pq|rs) | < `ao_integrals_threshold` then (pq|rs) is zero
|
||||
|
@ -1,121 +1,3 @@
|
||||
BEGIN_PROVIDER [ integer, cholesky_ao_num_guess ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Number of Cholesky vectors in AO basis
|
||||
END_DOC
|
||||
|
||||
cholesky_ao_num_guess = ao_num*ao_num
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer, cholesky_ao_num ]
|
||||
&BEGIN_PROVIDER [ double precision, cholesky_ao, (ao_num, ao_num, cholesky_ao_num_guess) ]
|
||||
use mmap_module
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Cholesky vectors in AO basis: (ik|a):
|
||||
! <ij|kl> = (ik|jl) = sum_a (ik|a).(a|jl)
|
||||
END_DOC
|
||||
|
||||
type(c_ptr) :: ptr
|
||||
integer :: fd, i,j,k,l,m,rank
|
||||
double precision, pointer :: ao_integrals(:,:,:,:)
|
||||
double precision, external :: ao_two_e_integral
|
||||
|
||||
! Store AO integrals in a memory mapped file
|
||||
call mmap(trim(ezfio_work_dir)//'ao_integrals', &
|
||||
(/ int(ao_num,8), int(ao_num,8), int(ao_num,8), int(ao_num,8) /), &
|
||||
8, fd, .False., ptr)
|
||||
call c_f_pointer(ptr, ao_integrals, (/ao_num, ao_num, ao_num, ao_num/))
|
||||
|
||||
print*, 'Providing the AO integrals (Cholesky)'
|
||||
call wall_time(wall_1)
|
||||
call cpu_time(cpu_1)
|
||||
|
||||
ao_integrals = 0.d0
|
||||
|
||||
double precision :: integral, cpu_1, cpu_2, wall_1, wall_2
|
||||
logical, external :: ao_two_e_integral_zero
|
||||
double precision, external :: get_ao_two_e_integral
|
||||
|
||||
if (read_ao_two_e_integrals) then
|
||||
PROVIDE ao_two_e_integrals_in_map
|
||||
|
||||
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(i,j,k,l, integral, wall_2)
|
||||
do m=0,9
|
||||
do l=1+m,ao_num,10
|
||||
!$OMP DO SCHEDULE(dynamic)
|
||||
do j=1,ao_num
|
||||
do k=1,ao_num
|
||||
do i=1,ao_num
|
||||
if (ao_two_e_integral_zero(i,j,k,l)) cycle
|
||||
integral = get_ao_two_e_integral(i,j,k,l, ao_integrals_map)
|
||||
ao_integrals(i,k,j,l) = integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO NOWAIT
|
||||
enddo
|
||||
!$OMP MASTER
|
||||
call wall_time(wall_2)
|
||||
print '(I10,'' % in'', 4X, F10.2, '' s.'')', (m+1) * 10, wall_2-wall_1
|
||||
!$OMP END MASTER
|
||||
enddo
|
||||
!$OMP END PARALLEL
|
||||
|
||||
else
|
||||
|
||||
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(i,j,k,l, integral, wall_2)
|
||||
do m=0,9
|
||||
do l=1+m,ao_num,10
|
||||
!$OMP DO SCHEDULE(dynamic)
|
||||
do j=1,l
|
||||
do k=1,ao_num
|
||||
do i=1,min(k,j)
|
||||
if (ao_two_e_integral_zero(i,j,k,l)) cycle
|
||||
integral = ao_two_e_integral(i,k,j,l)
|
||||
ao_integrals(i,k,j,l) = integral
|
||||
ao_integrals(k,i,j,l) = integral
|
||||
ao_integrals(i,k,l,j) = integral
|
||||
ao_integrals(k,i,l,j) = integral
|
||||
ao_integrals(j,l,i,k) = integral
|
||||
ao_integrals(j,l,k,i) = integral
|
||||
ao_integrals(l,j,i,k) = integral
|
||||
ao_integrals(l,j,k,i) = integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO NOWAIT
|
||||
enddo
|
||||
!$OMP MASTER
|
||||
call wall_time(wall_2)
|
||||
print '(I10,'' % in'', 4X, F10.2, '' s.'')', (m+1) * 10, wall_2-wall_1
|
||||
!$OMP END MASTER
|
||||
enddo
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall_2)
|
||||
call cpu_time(cpu_2)
|
||||
print*, 'AO integrals provided:'
|
||||
print*, ' cpu time :',cpu_2 - cpu_1, 's'
|
||||
print*, ' wall time :',wall_2 - wall_1, 's ( x ', (cpu_2-cpu_1)/(wall_2-wall_1+tiny(1.d0)), ' )'
|
||||
|
||||
endif
|
||||
|
||||
! Call Lapack
|
||||
cholesky_ao_num = cholesky_ao_num_guess
|
||||
call pivoted_cholesky(ao_integrals, cholesky_ao_num, ao_cholesky_threshold, ao_num*ao_num, cholesky_ao)
|
||||
print *, 'Rank: ', cholesky_ao_num, '(', 100.d0*dble(cholesky_ao_num)/dble(ao_num*ao_num), ' %)'
|
||||
|
||||
! Remove mmap
|
||||
double precision, external :: getUnitAndOpen
|
||||
call munmap( &
|
||||
(/ int(ao_num,8), int(ao_num,8), int(ao_num,8), int(ao_num,8) /), &
|
||||
8, fd, ptr)
|
||||
open(unit=99,file=trim(ezfio_work_dir)//'ao_integrals')
|
||||
close(99, status='delete')
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, cholesky_ao_transp, (cholesky_ao_num, ao_num, ao_num) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
@ -131,3 +13,401 @@ BEGIN_PROVIDER [ double precision, cholesky_ao_transp, (cholesky_ao_num, ao_num,
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ integer, cholesky_ao_num ]
|
||||
&BEGIN_PROVIDER [ double precision, cholesky_ao, (ao_num, ao_num, 1) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Cholesky vectors in AO basis: (ik|a):
|
||||
! <ij|kl> = (ik|jl) = sum_a (ik|a).(a|jl)
|
||||
!
|
||||
! Last dimension of cholesky_ao is cholesky_ao_num
|
||||
END_DOC
|
||||
|
||||
integer :: rank, ndim
|
||||
double precision :: tau
|
||||
double precision, pointer :: L(:,:), L_old(:,:)
|
||||
|
||||
|
||||
double precision :: s
|
||||
double precision, parameter :: dscale = 1.d0
|
||||
|
||||
double precision, allocatable :: D(:), Delta(:,:), Ltmp_p(:,:), Ltmp_q(:,:)
|
||||
integer, allocatable :: Lset(:), Dset(:), addr(:,:)
|
||||
logical, allocatable :: computed(:)
|
||||
|
||||
integer :: i,j,k,m,p,q, qj, dj, p2, q2
|
||||
integer :: N, np, nq
|
||||
|
||||
double precision :: Dmax, Dmin, Qmax, f
|
||||
double precision, external :: get_ao_two_e_integral
|
||||
logical, external :: ao_two_e_integral_zero
|
||||
|
||||
double precision, external :: ao_two_e_integral
|
||||
integer :: block_size, iblock, ierr
|
||||
|
||||
double precision :: mem
|
||||
double precision, external :: memory_of_double, memory_of_int
|
||||
|
||||
integer, external :: getUnitAndOpen
|
||||
integer :: iunit
|
||||
|
||||
ndim = ao_num*ao_num
|
||||
deallocate(cholesky_ao)
|
||||
|
||||
if (read_ao_cholesky) then
|
||||
print *, 'Reading Cholesky vectors from disk...'
|
||||
iunit = getUnitAndOpen(trim(ezfio_work_dir)//'cholesky_ao', 'R')
|
||||
read(iunit) rank
|
||||
allocate(cholesky_ao(ao_num,ao_num,rank), stat=ierr)
|
||||
read(iunit) cholesky_ao
|
||||
close(iunit)
|
||||
cholesky_ao_num = rank
|
||||
|
||||
else
|
||||
|
||||
PROVIDE nucl_coord
|
||||
|
||||
if (do_direct_integrals) then
|
||||
if (ao_two_e_integral(1,1,1,1) < huge(1.d0)) then
|
||||
! Trigger providers inside ao_two_e_integral
|
||||
continue
|
||||
endif
|
||||
else
|
||||
PROVIDE ao_two_e_integrals_in_map
|
||||
endif
|
||||
|
||||
tau = ao_cholesky_threshold
|
||||
|
||||
mem = 6.d0 * memory_of_double(ndim) + 6.d0 * memory_of_int(ndim)
|
||||
call check_mem(mem, irp_here)
|
||||
|
||||
call print_memory_usage()
|
||||
|
||||
allocate(L(ndim,1))
|
||||
|
||||
print *, ''
|
||||
print *, 'Cholesky decomposition of AO integrals'
|
||||
print *, '======================================'
|
||||
print *, ''
|
||||
print *, '============ ============='
|
||||
print *, ' Rank Threshold'
|
||||
print *, '============ ============='
|
||||
|
||||
|
||||
rank = 0
|
||||
|
||||
allocate( D(ndim), Lset(ndim), Dset(ndim) )
|
||||
allocate( addr(3,ndim) )
|
||||
|
||||
! 1.
|
||||
k=0
|
||||
do j=1,ao_num
|
||||
do i=1,ao_num
|
||||
k = k+1
|
||||
addr(1,k) = i
|
||||
addr(2,k) = j
|
||||
addr(3,k) = (i-1)*ao_num + j
|
||||
enddo
|
||||
enddo
|
||||
|
||||
if (do_direct_integrals) then
|
||||
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i) SCHEDULE(guided)
|
||||
do i=1,ndim
|
||||
D(i) = ao_two_e_integral(addr(1,i), addr(2,i), &
|
||||
addr(1,i), addr(2,i))
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
else
|
||||
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i) SCHEDULE(guided)
|
||||
do i=1,ndim
|
||||
D(i) = get_ao_two_e_integral(addr(1,i), addr(1,i), &
|
||||
addr(2,i), addr(2,i), &
|
||||
ao_integrals_map)
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
endif
|
||||
|
||||
Dmax = maxval(D)
|
||||
|
||||
! 2.
|
||||
np=0
|
||||
do p=1,ndim
|
||||
if ( dscale*dscale*Dmax*D(p) > tau*tau ) then
|
||||
np = np+1
|
||||
Lset(np) = p
|
||||
endif
|
||||
enddo
|
||||
|
||||
! 3.
|
||||
N = 0
|
||||
|
||||
! 4.
|
||||
i = 0
|
||||
|
||||
! 5.
|
||||
do while ( (Dmax > tau).and.(rank < ndim) )
|
||||
! a.
|
||||
i = i+1
|
||||
|
||||
s = 0.01d0
|
||||
|
||||
! Inrease s until the arrays fit in memory
|
||||
do while (.True.)
|
||||
|
||||
! b.
|
||||
Dmin = max(s*Dmax,tau)
|
||||
|
||||
! c.
|
||||
nq=0
|
||||
do p=1,np
|
||||
if ( D(Lset(p)) > Dmin ) then
|
||||
nq = nq+1
|
||||
Dset(nq) = Lset(p)
|
||||
endif
|
||||
enddo
|
||||
|
||||
call total_memory(mem)
|
||||
mem = mem &
|
||||
+ np*memory_of_double(nq) &! Delta(np,nq)
|
||||
+ (rank+nq)* memory_of_double(ndim) &! L(ndim,rank+nq)
|
||||
+ (np+nq)*memory_of_double(block_size) ! Ltmp_p(np,block_size) + Ltmp_q(nq,block_size)
|
||||
|
||||
if (mem > qp_max_mem) then
|
||||
s = s*2.d0
|
||||
else
|
||||
exit
|
||||
endif
|
||||
|
||||
if ((s > 1.d0).or.(nq == 0)) then
|
||||
call print_memory_usage()
|
||||
print *, 'Not enough memory. Reduce cholesky threshold'
|
||||
stop -1
|
||||
endif
|
||||
|
||||
enddo
|
||||
|
||||
! d., e.
|
||||
block_size = max(N,24)
|
||||
|
||||
L_old => L
|
||||
allocate(L(ndim,rank+nq), stat=ierr)
|
||||
if (ierr /= 0) then
|
||||
call print_memory_usage()
|
||||
print *, irp_here, ': allocation failed : (L(ndim,rank+nq))'
|
||||
stop -1
|
||||
endif
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(k,j)
|
||||
do k=1,rank
|
||||
do j=1,ndim
|
||||
L(j,k) = L_old(j,k)
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
deallocate(L_old)
|
||||
|
||||
allocate(Delta(np,nq), stat=ierr)
|
||||
if (ierr /= 0) then
|
||||
call print_memory_usage()
|
||||
print *, irp_here, ': allocation failed : (Delta(np,nq))'
|
||||
stop -1
|
||||
endif
|
||||
|
||||
allocate(Ltmp_p(np,block_size), stat=ierr)
|
||||
if (ierr /= 0) then
|
||||
call print_memory_usage()
|
||||
print *, irp_here, ': allocation failed : (Ltmp_p(np,block_size))'
|
||||
stop -1
|
||||
endif
|
||||
|
||||
allocate(Ltmp_q(nq,block_size), stat=ierr)
|
||||
if (ierr /= 0) then
|
||||
call print_memory_usage()
|
||||
print *, irp_here, ': allocation failed : (Ltmp_q(nq,block_size))'
|
||||
stop -1
|
||||
endif
|
||||
|
||||
|
||||
allocate(computed(nq))
|
||||
|
||||
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(m,k,p,q,j)
|
||||
|
||||
!$OMP DO
|
||||
do q=1,nq
|
||||
do j=1,np
|
||||
Delta(j,q) = 0.d0
|
||||
enddo
|
||||
computed(q) = .False.
|
||||
enddo
|
||||
!$OMP ENDDO NOWAIT
|
||||
|
||||
!$OMP DO
|
||||
do k=1,N
|
||||
do p=1,np
|
||||
Ltmp_p(p,k) = L(Lset(p),k)
|
||||
enddo
|
||||
do q=1,nq
|
||||
Ltmp_q(q,k) = L(Dset(q),k)
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO NOWAIT
|
||||
|
||||
!$OMP BARRIER
|
||||
!$OMP END PARALLEL
|
||||
|
||||
if (N>0) then
|
||||
call dgemm('N','T', np, nq, N, -1.d0, &
|
||||
Ltmp_p, np, Ltmp_q, nq, 1.d0, Delta, np)
|
||||
endif
|
||||
|
||||
! f.
|
||||
Qmax = D(Dset(1))
|
||||
do q=1,nq
|
||||
Qmax = max(Qmax, D(Dset(q)))
|
||||
enddo
|
||||
|
||||
! g.
|
||||
|
||||
iblock = 0
|
||||
do j=1,nq
|
||||
|
||||
if ( (Qmax <= Dmin).or.(N+j > ndim) ) exit
|
||||
! i.
|
||||
rank = N+j
|
||||
|
||||
if (iblock == block_size) then
|
||||
call dgemm('N','T',np,nq,block_size,-1.d0, &
|
||||
Ltmp_p, np, Ltmp_q, nq, 1.d0, Delta, np)
|
||||
iblock = 0
|
||||
endif
|
||||
|
||||
! ii.
|
||||
do dj=1,nq
|
||||
qj = Dset(dj)
|
||||
if (D(qj) == Qmax) then
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
|
||||
L(1:ndim, rank) = 0.d0
|
||||
|
||||
if (.not.computed(dj)) then
|
||||
m = dj
|
||||
!$OMP PARALLEL DO PRIVATE(k) SCHEDULE(guided)
|
||||
do k=np,1,-1
|
||||
if (.not.ao_two_e_integral_zero( addr(1,Lset(k)), addr(1,Dset(m)),&
|
||||
addr(2,Lset(k)), addr(2,Dset(m)) ) ) then
|
||||
if (do_direct_integrals) then
|
||||
Delta(k,m) = Delta(k,m) + &
|
||||
ao_two_e_integral(addr(1,Lset(k)), addr(2,Lset(k)),&
|
||||
addr(1,Dset(m)), addr(2,Dset(m)))
|
||||
else
|
||||
Delta(k,m) = Delta(k,m) + &
|
||||
get_ao_two_e_integral( addr(1,Lset(k)), addr(1,Dset(m)),&
|
||||
addr(2,Lset(k)), addr(2,Dset(m)), ao_integrals_map)
|
||||
endif
|
||||
endif
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
computed(dj) = .True.
|
||||
endif
|
||||
|
||||
iblock = iblock+1
|
||||
do p=1,np
|
||||
Ltmp_p(p,iblock) = Delta(p,dj)
|
||||
enddo
|
||||
|
||||
! iv.
|
||||
if (iblock > 1) then
|
||||
call dgemv('N', np, iblock-1, -1.d0, Ltmp_p, np, Ltmp_q(dj,1), nq, 1.d0,&
|
||||
Ltmp_p(1,iblock), 1)
|
||||
endif
|
||||
|
||||
! iii.
|
||||
f = 1.d0/dsqrt(Qmax)
|
||||
|
||||
!$OMP PARALLEL PRIVATE(m,p,q,k) DEFAULT(shared)
|
||||
!$OMP DO
|
||||
do p=1,np
|
||||
Ltmp_p(p,iblock) = Ltmp_p(p,iblock) * f
|
||||
L(Lset(p), rank) = Ltmp_p(p,iblock)
|
||||
D(Lset(p)) = D(Lset(p)) - Ltmp_p(p,iblock) * Ltmp_p(p,iblock)
|
||||
enddo
|
||||
!$OMP END DO
|
||||
|
||||
!$OMP DO
|
||||
do q=1,nq
|
||||
Ltmp_q(q,iblock) = L(Dset(q), rank)
|
||||
enddo
|
||||
!$OMP END DO
|
||||
|
||||
!$OMP END PARALLEL
|
||||
|
||||
Qmax = D(Dset(1))
|
||||
do q=1,nq
|
||||
Qmax = max(Qmax, D(Dset(q)))
|
||||
enddo
|
||||
|
||||
enddo
|
||||
|
||||
print '(I10, 4X, ES12.3)', rank, Qmax
|
||||
|
||||
deallocate(computed)
|
||||
deallocate(Delta)
|
||||
deallocate(Ltmp_p)
|
||||
deallocate(Ltmp_q)
|
||||
|
||||
! i.
|
||||
N = rank
|
||||
|
||||
! j.
|
||||
Dmax = D(Lset(1))
|
||||
do p=1,np
|
||||
Dmax = max(Dmax, D(Lset(p)))
|
||||
enddo
|
||||
|
||||
np=0
|
||||
do p=1,ndim
|
||||
if ( dscale*dscale*Dmax*D(p) > tau*tau ) then
|
||||
np = np+1
|
||||
Lset(np) = p
|
||||
endif
|
||||
enddo
|
||||
|
||||
enddo
|
||||
|
||||
allocate(cholesky_ao(ao_num,ao_num,rank), stat=ierr)
|
||||
if (ierr /= 0) then
|
||||
call print_memory_usage()
|
||||
print *, irp_here, ': Allocation failed'
|
||||
stop -1
|
||||
endif
|
||||
!$OMP PARALLEL DO PRIVATE(k)
|
||||
do k=1,rank
|
||||
call dcopy(ndim, L(1,k), 1, cholesky_ao(1,1,k), 1)
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
deallocate(L)
|
||||
cholesky_ao_num = rank
|
||||
|
||||
print *, '============ ============='
|
||||
print *, ''
|
||||
|
||||
if (write_ao_cholesky) then
|
||||
print *, 'Writing Cholesky vectors to disk...'
|
||||
iunit = getUnitAndOpen(trim(ezfio_work_dir)//'cholesky_ao', 'W')
|
||||
write(iunit) rank
|
||||
write(iunit) cholesky_ao
|
||||
close(iunit)
|
||||
call ezfio_set_ao_two_e_ints_io_ao_cholesky('Read')
|
||||
endif
|
||||
|
||||
endif
|
||||
|
||||
print *, 'Rank : ', cholesky_ao_num, '(', 100.d0*dble(cholesky_ao_num)/dble(ao_num*ao_num), ' %)'
|
||||
print *, ''
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
@ -460,7 +460,7 @@ BEGIN_PROVIDER [ double precision, ao_two_e_integral_schwartz, (ao_num, ao_num)
|
||||
!$OMP PARALLEL DO PRIVATE(i,k) &
|
||||
!$OMP DEFAULT(NONE) &
|
||||
!$OMP SHARED (ao_num,ao_two_e_integral_schwartz) &
|
||||
!$OMP SCHEDULE(dynamic)
|
||||
!$OMP SCHEDULE(guided)
|
||||
do i=1,ao_num
|
||||
do k=1,i
|
||||
ao_two_e_integral_schwartz(i,k) = dsqrt(ao_two_e_integral(i,i,k,k))
|
||||
@ -951,7 +951,7 @@ recursive subroutine I_x1_pol_mult_recurs(a,c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt
|
||||
double precision :: X(0:max_dim)
|
||||
double precision :: Y(0:max_dim)
|
||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: X,Y
|
||||
integer :: nx, ix,iy,ny
|
||||
integer :: nx, ix,iy,ny,ib
|
||||
|
||||
ASSERT (a>2)
|
||||
!DIR$ LOOP COUNT(8)
|
||||
@ -974,8 +974,43 @@ recursive subroutine I_x1_pol_mult_recurs(a,c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt
|
||||
enddo
|
||||
|
||||
! !DIR$ FORCEINLINE
|
||||
! call multiply_poly(X,nx,B_10,2,d,nd)
|
||||
call multiply_poly_c2(X,nx,B_10,d,nd)
|
||||
! call multiply_poly_c2_inline_2e(X,nx,B_10,d,nd)
|
||||
if (nx >= 0) then
|
||||
select case (nx)
|
||||
case (0)
|
||||
d(0) = d(0) + B_10(0) * X(0)
|
||||
d(1) = d(1) + B_10(1) * X(0)
|
||||
d(2) = d(2) + B_10(2) * X(0)
|
||||
|
||||
case (1)
|
||||
d(0) = d(0) + B_10(0) * X(0)
|
||||
d(1) = d(1) + B_10(0) * X(1) + B_10(1) * X(0)
|
||||
d(2) = d(2) + B_10(1) * X(1) + B_10(2) * X(0)
|
||||
d(3) = d(3) + B_10(2) * X(1)
|
||||
|
||||
case (2)
|
||||
d(0) = d(0) + B_10(0) * X(0)
|
||||
d(1) = d(1) + B_10(0) * X(1) + B_10(1) * X(0)
|
||||
d(2) = d(2) + B_10(0) * X(2) + B_10(1) * X(1) + B_10(2) * X(0)
|
||||
d(3) = d(3) + B_10(1) * X(2) + B_10(2) * X(1)
|
||||
d(4) = d(4) + B_10(2) * X(2)
|
||||
|
||||
case default
|
||||
d(0) = d(0) + B_10(0) * X(0)
|
||||
d(1) = d(1) + B_10(0) * X(1) + B_10(1) * X(0)
|
||||
do ib=2,nx
|
||||
d(ib) = d(ib) + B_10(0) * X(ib) + B_10(1) * X(ib-1) + B_10(2) * X(ib-2)
|
||||
enddo
|
||||
d(nx+1) = d(nx+1) + B_10(1) * X(nx) + B_10(2) * X(nx-1)
|
||||
d(nx+2) = d(nx+2) + B_10(2) * X(nx)
|
||||
|
||||
end select
|
||||
|
||||
do nd = nx+2,0,-1
|
||||
if (d(nd) /= 0.d0) exit
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
nx = nd
|
||||
!DIR$ LOOP COUNT(8)
|
||||
@ -996,9 +1031,47 @@ recursive subroutine I_x1_pol_mult_recurs(a,c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt
|
||||
X(ix) *= c
|
||||
enddo
|
||||
endif
|
||||
|
||||
! !DIR$ FORCEINLINE
|
||||
! call multiply_poly(X,nx,B_00,2,d,nd)
|
||||
call multiply_poly_c2(X,nx,B_00,d,nd)
|
||||
! call multiply_poly_c2_inline_2e(X,nx,B_00,d,nd)
|
||||
if(nx >= 0) then
|
||||
|
||||
select case (nx)
|
||||
case (0)
|
||||
d(0) = d(0) + B_00(0) * X(0)
|
||||
d(1) = d(1) + B_00(1) * X(0)
|
||||
d(2) = d(2) + B_00(2) * X(0)
|
||||
|
||||
case (1)
|
||||
d(0) = d(0) + B_00(0) * X(0)
|
||||
d(1) = d(1) + B_00(0) * X(1) + B_00(1) * X(0)
|
||||
d(2) = d(2) + B_00(1) * X(1) + B_00(2) * X(0)
|
||||
d(3) = d(3) + B_00(2) * X(1)
|
||||
|
||||
case (2)
|
||||
d(0) = d(0) + B_00(0) * X(0)
|
||||
d(1) = d(1) + B_00(0) * X(1) + B_00(1) * X(0)
|
||||
d(2) = d(2) + B_00(0) * X(2) + B_00(1) * X(1) + B_00(2) * X(0)
|
||||
d(3) = d(3) + B_00(1) * X(2) + B_00(2) * X(1)
|
||||
d(4) = d(4) + B_00(2) * X(2)
|
||||
|
||||
case default
|
||||
d(0) = d(0) + B_00(0) * X(0)
|
||||
d(1) = d(1) + B_00(0) * X(1) + B_00(1) * X(0)
|
||||
do ib=2,nx
|
||||
d(ib) = d(ib) + B_00(0) * X(ib) + B_00(1) * X(ib-1) + B_00(2) * X(ib-2)
|
||||
enddo
|
||||
d(nx+1) = d(nx+1) + B_00(1) * X(nx) + B_00(2) * X(nx-1)
|
||||
d(nx+2) = d(nx+2) + B_00(2) * X(nx)
|
||||
|
||||
end select
|
||||
|
||||
do nd = nx+2,0,-1
|
||||
if (d(nd) /= 0.d0) exit
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
endif
|
||||
|
||||
ny=0
|
||||
@ -1016,8 +1089,45 @@ recursive subroutine I_x1_pol_mult_recurs(a,c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt
|
||||
endif
|
||||
|
||||
! !DIR$ FORCEINLINE
|
||||
! call multiply_poly(Y,ny,C_00,2,d,nd)
|
||||
call multiply_poly_c2(Y,ny,C_00,d,nd)
|
||||
! call multiply_poly_c2_inline_2e(Y,ny,C_00,d,nd)
|
||||
if(ny >= 0) then
|
||||
|
||||
select case (ny)
|
||||
case (0)
|
||||
d(0) = d(0) + C_00(0) * Y(0)
|
||||
d(1) = d(1) + C_00(1) * Y(0)
|
||||
d(2) = d(2) + C_00(2) * Y(0)
|
||||
|
||||
case (1)
|
||||
d(0) = d(0) + C_00(0) * Y(0)
|
||||
d(1) = d(1) + C_00(0) * Y(1) + C_00(1) * Y(0)
|
||||
d(2) = d(2) + C_00(1) * Y(1) + C_00(2) * Y(0)
|
||||
d(3) = d(3) + C_00(2) * Y(1)
|
||||
|
||||
case (2)
|
||||
d(0) = d(0) + C_00(0) * Y(0)
|
||||
d(1) = d(1) + C_00(0) * Y(1) + C_00(1) * Y(0)
|
||||
d(2) = d(2) + C_00(0) * Y(2) + C_00(1) * Y(1) + C_00(2) * Y(0)
|
||||
d(3) = d(3) + C_00(1) * Y(2) + C_00(2) * Y(1)
|
||||
d(4) = d(4) + C_00(2) * Y(2)
|
||||
|
||||
case default
|
||||
d(0) = d(0) + C_00(0) * Y(0)
|
||||
d(1) = d(1) + C_00(0) * Y(1) + C_00(1) * Y(0)
|
||||
do ib=2,ny
|
||||
d(ib) = d(ib) + C_00(0) * Y(ib) + C_00(1) * Y(ib-1) + C_00(2) * Y(ib-2)
|
||||
enddo
|
||||
d(ny+1) = d(ny+1) + C_00(1) * Y(ny) + C_00(2) * Y(ny-1)
|
||||
d(ny+2) = d(ny+2) + C_00(2) * Y(ny)
|
||||
|
||||
end select
|
||||
|
||||
do nd = ny+2,0,-1
|
||||
if (d(nd) /= 0.d0) exit
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
end
|
||||
|
||||
recursive subroutine I_x1_pol_mult_a1(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
|
||||
@ -1034,7 +1144,7 @@ recursive subroutine I_x1_pol_mult_a1(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
|
||||
double precision :: X(0:max_dim)
|
||||
double precision :: Y(0:max_dim)
|
||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: X,Y
|
||||
integer :: nx, ix,iy,ny
|
||||
integer :: nx, ix,iy,ny,ib
|
||||
|
||||
if( (c<0).or.(nd<0) )then
|
||||
nd = -1
|
||||
@ -1056,8 +1166,44 @@ recursive subroutine I_x1_pol_mult_a1(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
|
||||
endif
|
||||
|
||||
! !DIR$ FORCEINLINE
|
||||
! call multiply_poly(X,nx,B_00,2,d,nd)
|
||||
call multiply_poly_c2(X,nx,B_00,d,nd)
|
||||
! call multiply_poly_c2_inline_2e(X,nx,B_00,d,nd)
|
||||
if(nx >= 0) then
|
||||
|
||||
select case (nx)
|
||||
case (0)
|
||||
d(0) = d(0) + B_00(0) * X(0)
|
||||
d(1) = d(1) + B_00(1) * X(0)
|
||||
d(2) = d(2) + B_00(2) * X(0)
|
||||
|
||||
case (1)
|
||||
d(0) = d(0) + B_00(0) * X(0)
|
||||
d(1) = d(1) + B_00(0) * X(1) + B_00(1) * X(0)
|
||||
d(2) = d(2) + B_00(1) * X(1) + B_00(2) * X(0)
|
||||
d(3) = d(3) + B_00(2) * X(1)
|
||||
|
||||
case (2)
|
||||
d(0) = d(0) + B_00(0) * X(0)
|
||||
d(1) = d(1) + B_00(0) * X(1) + B_00(1) * X(0)
|
||||
d(2) = d(2) + B_00(0) * X(2) + B_00(1) * X(1) + B_00(2) * X(0)
|
||||
d(3) = d(3) + B_00(1) * X(2) + B_00(2) * X(1)
|
||||
d(4) = d(4) + B_00(2) * X(2)
|
||||
|
||||
case default
|
||||
d(0) = d(0) + B_00(0) * X(0)
|
||||
d(1) = d(1) + B_00(0) * X(1) + B_00(1) * X(0)
|
||||
do ib=2,nx
|
||||
d(ib) = d(ib) + B_00(0) * X(ib) + B_00(1) * X(ib-1) + B_00(2) * X(ib-2)
|
||||
enddo
|
||||
d(nx+1) = d(nx+1) + B_00(1) * X(nx) + B_00(2) * X(nx-1)
|
||||
d(nx+2) = d(nx+2) + B_00(2) * X(nx)
|
||||
|
||||
end select
|
||||
|
||||
do nd = nx+2,0,-1
|
||||
if (d(nd) /= 0.d0) exit
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
ny=0
|
||||
|
||||
@ -1068,8 +1214,44 @@ recursive subroutine I_x1_pol_mult_a1(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
|
||||
call I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,Y,ny,n_pt_in)
|
||||
|
||||
! !DIR$ FORCEINLINE
|
||||
! call multiply_poly(Y,ny,C_00,2,d,nd)
|
||||
call multiply_poly_c2(Y,ny,C_00,d,nd)
|
||||
! call multiply_poly_c2_inline_2e(Y,ny,C_00,d,nd)
|
||||
if(ny >= 0) then
|
||||
|
||||
select case (ny)
|
||||
case (0)
|
||||
d(0) = d(0) + C_00(0) * Y(0)
|
||||
d(1) = d(1) + C_00(1) * Y(0)
|
||||
d(2) = d(2) + C_00(2) * Y(0)
|
||||
|
||||
case (1)
|
||||
d(0) = d(0) + C_00(0) * Y(0)
|
||||
d(1) = d(1) + C_00(0) * Y(1) + C_00(1) * Y(0)
|
||||
d(2) = d(2) + C_00(1) * Y(1) + C_00(2) * Y(0)
|
||||
d(3) = d(3) + C_00(2) * Y(1)
|
||||
|
||||
case (2)
|
||||
d(0) = d(0) + C_00(0) * Y(0)
|
||||
d(1) = d(1) + C_00(0) * Y(1) + C_00(1) * Y(0)
|
||||
d(2) = d(2) + C_00(0) * Y(2) + C_00(1) * Y(1) + C_00(2) * Y(0)
|
||||
d(3) = d(3) + C_00(1) * Y(2) + C_00(2) * Y(1)
|
||||
d(4) = d(4) + C_00(2) * Y(2)
|
||||
|
||||
case default
|
||||
d(0) = d(0) + C_00(0) * Y(0)
|
||||
d(1) = d(1) + C_00(0) * Y(1) + C_00(1) * Y(0)
|
||||
do ib=2,ny
|
||||
d(ib) = d(ib) + C_00(0) * Y(ib) + C_00(1) * Y(ib-1) + C_00(2) * Y(ib-2)
|
||||
enddo
|
||||
d(ny+1) = d(ny+1) + C_00(1) * Y(ny) + C_00(2) * Y(ny-1)
|
||||
d(ny+2) = d(ny+2) + C_00(2) * Y(ny)
|
||||
|
||||
end select
|
||||
|
||||
do nd = ny+2,0,-1
|
||||
if (d(nd) /= 0.d0) exit
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
end
|
||||
|
||||
@ -1087,7 +1269,7 @@ recursive subroutine I_x1_pol_mult_a2(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
|
||||
double precision :: X(0:max_dim)
|
||||
double precision :: Y(0:max_dim)
|
||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: X,Y
|
||||
integer :: nx, ix,iy,ny
|
||||
integer :: nx, ix,iy,ny,ib
|
||||
|
||||
!DIR$ LOOP COUNT(8)
|
||||
do ix=0,n_pt_in
|
||||
@ -1097,8 +1279,44 @@ recursive subroutine I_x1_pol_mult_a2(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
|
||||
call I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,X,nx,n_pt_in)
|
||||
|
||||
! !DIR$ FORCEINLINE
|
||||
! call multiply_poly(X,nx,B_10,2,d,nd)
|
||||
call multiply_poly_c2(X,nx,B_10,d,nd)
|
||||
! call multiply_poly_c2_inline_2e(X,nx,B_10,d,nd)
|
||||
if(nx >= 0) then
|
||||
|
||||
select case (nx)
|
||||
case (0)
|
||||
d(0) = d(0) + B_10(0) * X(0)
|
||||
d(1) = d(1) + B_10(1) * X(0)
|
||||
d(2) = d(2) + B_10(2) * X(0)
|
||||
|
||||
case (1)
|
||||
d(0) = d(0) + B_10(0) * X(0)
|
||||
d(1) = d(1) + B_10(0) * X(1) + B_10(1) * X(0)
|
||||
d(2) = d(2) + B_10(1) * X(1) + B_10(2) * X(0)
|
||||
d(3) = d(3) + B_10(2) * X(1)
|
||||
|
||||
case (2)
|
||||
d(0) = d(0) + B_10(0) * X(0)
|
||||
d(1) = d(1) + B_10(0) * X(1) + B_10(1) * X(0)
|
||||
d(2) = d(2) + B_10(0) * X(2) + B_10(1) * X(1) + B_10(2) * X(0)
|
||||
d(3) = d(3) + B_10(1) * X(2) + B_10(2) * X(1)
|
||||
d(4) = d(4) + B_10(2) * X(2)
|
||||
|
||||
case default
|
||||
d(0) = d(0) + B_10(0) * X(0)
|
||||
d(1) = d(1) + B_10(0) * X(1) + B_10(1) * X(0)
|
||||
do ib=2,nx
|
||||
d(ib) = d(ib) + B_10(0) * X(ib) + B_10(1) * X(ib-1) + B_10(2) * X(ib-2)
|
||||
enddo
|
||||
d(nx+1) = d(nx+1) + B_10(1) * X(nx) + B_10(2) * X(nx-1)
|
||||
d(nx+2) = d(nx+2) + B_10(2) * X(nx)
|
||||
|
||||
end select
|
||||
|
||||
do nd = nx+2,0,-1
|
||||
if (d(nd) /= 0.d0) exit
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
nx = nd
|
||||
!DIR$ LOOP COUNT(8)
|
||||
@ -1117,8 +1335,44 @@ recursive subroutine I_x1_pol_mult_a2(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
|
||||
endif
|
||||
|
||||
! !DIR$ FORCEINLINE
|
||||
! call multiply_poly(X,nx,B_00,2,d,nd)
|
||||
call multiply_poly_c2(X,nx,B_00,d,nd)
|
||||
! call multiply_poly_c2_inline_2e(X,nx,B_00,d,nd)
|
||||
if(nx >= 0) then
|
||||
|
||||
select case (nx)
|
||||
case (0)
|
||||
d(0) = d(0) + B_00(0) * X(0)
|
||||
d(1) = d(1) + B_00(1) * X(0)
|
||||
d(2) = d(2) + B_00(2) * X(0)
|
||||
|
||||
case (1)
|
||||
d(0) = d(0) + B_00(0) * X(0)
|
||||
d(1) = d(1) + B_00(0) * X(1) + B_00(1) * X(0)
|
||||
d(2) = d(2) + B_00(1) * X(1) + B_00(2) * X(0)
|
||||
d(3) = d(3) + B_00(2) * X(1)
|
||||
|
||||
case (2)
|
||||
d(0) = d(0) + B_00(0) * X(0)
|
||||
d(1) = d(1) + B_00(0) * X(1) + B_00(1) * X(0)
|
||||
d(2) = d(2) + B_00(0) * X(2) + B_00(1) * X(1) + B_00(2) * X(0)
|
||||
d(3) = d(3) + B_00(1) * X(2) + B_00(2) * X(1)
|
||||
d(4) = d(4) + B_00(2) * X(2)
|
||||
|
||||
case default
|
||||
d(0) = d(0) + B_00(0) * X(0)
|
||||
d(1) = d(1) + B_00(0) * X(1) + B_00(1) * X(0)
|
||||
do ib=2,nx
|
||||
d(ib) = d(ib) + B_00(0) * X(ib) + B_00(1) * X(ib-1) + B_00(2) * X(ib-2)
|
||||
enddo
|
||||
d(nx+1) = d(nx+1) + B_00(1) * X(nx) + B_00(2) * X(nx-1)
|
||||
d(nx+2) = d(nx+2) + B_00(2) * X(nx)
|
||||
|
||||
end select
|
||||
|
||||
do nd = nx+2,0,-1
|
||||
if (d(nd) /= 0.d0) exit
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
ny=0
|
||||
!DIR$ LOOP COUNT(8)
|
||||
@ -1129,8 +1383,45 @@ recursive subroutine I_x1_pol_mult_a2(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
|
||||
call I_x1_pol_mult_a1(c,B_10,B_01,B_00,C_00,D_00,Y,ny,n_pt_in)
|
||||
|
||||
! !DIR$ FORCEINLINE
|
||||
! call multiply_poly(Y,ny,C_00,2,d,nd)
|
||||
call multiply_poly_c2(Y,ny,C_00,d,nd)
|
||||
! call multiply_poly_c2_inline_2e(Y,ny,C_00,d,nd)
|
||||
if(ny >= 0) then
|
||||
|
||||
select case (ny)
|
||||
case (0)
|
||||
d(0) = d(0) + C_00(0) * Y(0)
|
||||
d(1) = d(1) + C_00(1) * Y(0)
|
||||
d(2) = d(2) + C_00(2) * Y(0)
|
||||
|
||||
case (1)
|
||||
d(0) = d(0) + C_00(0) * Y(0)
|
||||
d(1) = d(1) + C_00(0) * Y(1) + C_00(1) * Y(0)
|
||||
d(2) = d(2) + C_00(1) * Y(1) + C_00(2) * Y(0)
|
||||
d(3) = d(3) + C_00(2) * Y(1)
|
||||
|
||||
case (2)
|
||||
d(0) = d(0) + C_00(0) * Y(0)
|
||||
d(1) = d(1) + C_00(0) * Y(1) + C_00(1) * Y(0)
|
||||
d(2) = d(2) + C_00(0) * Y(2) + C_00(1) * Y(1) + C_00(2) * Y(0)
|
||||
d(3) = d(3) + C_00(1) * Y(2) + C_00(2) * Y(1)
|
||||
d(4) = d(4) + C_00(2) * Y(2)
|
||||
|
||||
case default
|
||||
d(0) = d(0) + C_00(0) * Y(0)
|
||||
d(1) = d(1) + C_00(0) * Y(1) + C_00(1) * Y(0)
|
||||
do ib=2,ny
|
||||
d(ib) = d(ib) + C_00(0) * Y(ib) + C_00(1) * Y(ib-1) + C_00(2) * Y(ib-2)
|
||||
enddo
|
||||
d(ny+1) = d(ny+1) + C_00(1) * Y(ny) + C_00(2) * Y(ny-1)
|
||||
d(ny+2) = d(ny+2) + C_00(2) * Y(ny)
|
||||
|
||||
end select
|
||||
|
||||
do nd = ny+2,0,-1
|
||||
if (d(nd) /= 0.d0) exit
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
end
|
||||
|
||||
recursive subroutine I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,d,nd,dim)
|
||||
@ -1147,7 +1438,7 @@ recursive subroutine I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,d,nd,dim)
|
||||
integer :: nx, ix,ny
|
||||
double precision :: X(0:max_dim),Y(0:max_dim)
|
||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: X, Y
|
||||
integer :: i
|
||||
integer :: i, ib
|
||||
|
||||
select case (c)
|
||||
case (0)
|
||||
@ -1178,8 +1469,45 @@ recursive subroutine I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,d,nd,dim)
|
||||
Y(2) = D_00(2)
|
||||
|
||||
! !DIR$ FORCEINLINE
|
||||
! call multiply_poly(Y,ny,D_00,2,d,nd)
|
||||
call multiply_poly_c2(Y,ny,D_00,d,nd)
|
||||
! call multiply_poly_c2_inline_2e(Y,ny,D_00,d,nd)
|
||||
if(ny >= 0) then
|
||||
|
||||
select case (ny)
|
||||
case (0)
|
||||
d(0) = d(0) + D_00(0) * Y(0)
|
||||
d(1) = d(1) + D_00(1) * Y(0)
|
||||
d(2) = d(2) + D_00(2) * Y(0)
|
||||
|
||||
case (1)
|
||||
d(0) = d(0) + D_00(0) * Y(0)
|
||||
d(1) = d(1) + D_00(0) * Y(1) + D_00(1) * Y(0)
|
||||
d(2) = d(2) + D_00(1) * Y(1) + D_00(2) * Y(0)
|
||||
d(3) = d(3) + D_00(2) * Y(1)
|
||||
|
||||
case (2)
|
||||
d(0) = d(0) + D_00(0) * Y(0)
|
||||
d(1) = d(1) + D_00(0) * Y(1) + D_00(1) * Y(0)
|
||||
d(2) = d(2) + D_00(0) * Y(2) + D_00(1) * Y(1) + D_00(2) * Y(0)
|
||||
d(3) = d(3) + D_00(1) * Y(2) + D_00(2) * Y(1)
|
||||
d(4) = d(4) + D_00(2) * Y(2)
|
||||
|
||||
case default
|
||||
d(0) = d(0) + D_00(0) * Y(0)
|
||||
d(1) = d(1) + D_00(0) * Y(1) + D_00(1) * Y(0)
|
||||
do ib=2,ny
|
||||
d(ib) = d(ib) + D_00(0) * Y(ib) + D_00(1) * Y(ib-1) + D_00(2) * Y(ib-2)
|
||||
enddo
|
||||
d(ny+1) = d(ny+1) + D_00(1) * Y(ny) + D_00(2) * Y(ny-1)
|
||||
d(ny+2) = d(ny+2) + D_00(2) * Y(ny)
|
||||
|
||||
end select
|
||||
|
||||
do nd = ny+2,0,-1
|
||||
if (d(nd) /= 0.d0) exit
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
|
||||
return
|
||||
|
||||
@ -1198,8 +1526,44 @@ recursive subroutine I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,d,nd,dim)
|
||||
enddo
|
||||
|
||||
! !DIR$ FORCEINLINE
|
||||
! call multiply_poly(X,nx,B_01,2,d,nd)
|
||||
call multiply_poly_c2(X,nx,B_01,d,nd)
|
||||
! call multiply_poly_c2_inline_2e(X,nx,B_01,d,nd)
|
||||
if(nx >= 0) then
|
||||
|
||||
select case (nx)
|
||||
case (0)
|
||||
d(0) = d(0) + B_01(0) * X(0)
|
||||
d(1) = d(1) + B_01(1) * X(0)
|
||||
d(2) = d(2) + B_01(2) * X(0)
|
||||
|
||||
case (1)
|
||||
d(0) = d(0) + B_01(0) * X(0)
|
||||
d(1) = d(1) + B_01(0) * X(1) + B_01(1) * X(0)
|
||||
d(2) = d(2) + B_01(1) * X(1) + B_01(2) * X(0)
|
||||
d(3) = d(3) + B_01(2) * X(1)
|
||||
|
||||
case (2)
|
||||
d(0) = d(0) + B_01(0) * X(0)
|
||||
d(1) = d(1) + B_01(0) * X(1) + B_01(1) * X(0)
|
||||
d(2) = d(2) + B_01(0) * X(2) + B_01(1) * X(1) + B_01(2) * X(0)
|
||||
d(3) = d(3) + B_01(1) * X(2) + B_01(2) * X(1)
|
||||
d(4) = d(4) + B_01(2) * X(2)
|
||||
|
||||
case default
|
||||
d(0) = d(0) + B_01(0) * X(0)
|
||||
d(1) = d(1) + B_01(0) * X(1) + B_01(1) * X(0)
|
||||
do ib=2,nx
|
||||
d(ib) = d(ib) + B_01(0) * X(ib) + B_01(1) * X(ib-1) + B_01(2) * X(ib-2)
|
||||
enddo
|
||||
d(nx+1) = d(nx+1) + B_01(1) * X(nx) + B_01(2) * X(nx-1)
|
||||
d(nx+2) = d(nx+2) + B_01(2) * X(nx)
|
||||
|
||||
end select
|
||||
|
||||
do nd = nx+2,0,-1
|
||||
if (d(nd) /= 0.d0) exit
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
ny = 0
|
||||
!DIR$ LOOP COUNT(6)
|
||||
@ -1209,8 +1573,45 @@ recursive subroutine I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,d,nd,dim)
|
||||
call I_x2_pol_mult(c-1,B_10,B_01,B_00,C_00,D_00,Y,ny,dim)
|
||||
|
||||
! !DIR$ FORCEINLINE
|
||||
! call multiply_poly(Y,ny,D_00,2,d,nd)
|
||||
call multiply_poly_c2(Y,ny,D_00,d,nd)
|
||||
! call multiply_poly_c2_inline_2e(Y,ny,D_00,d,nd)
|
||||
|
||||
if(ny >= 0) then
|
||||
|
||||
select case (ny)
|
||||