-
Notifications
You must be signed in to change notification settings - Fork 4
/
Copy pathcalc_radial_nucGa.f90
125 lines (102 loc) · 4.01 KB
/
calc_radial_nucGa.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
!
! ParaGauss, a program package for high-performance computations of
! molecular systems
!
! Copyright (C) 2014 T. Belling, T. Grauschopf, S. Krüger,
! F. Nörtemann, M. Staufer, M. Mayer, V. A. Nasluzov, U. Birkenheuer,
! A. Hu, A. V. Matveev, A. V. Shor, M. S. K. Fuchs-Rohr, K. M. Neyman,
! D. I. Ganyushin, T. Kerdcharoen, A. Woiterski, A. B. Gordienko,
! S. Majumder, M. H. i Rotllant, R. Ramakrishnan, G. Dixit,
! A. Nikodem, T. Soini, M. Roderus, N. Rösch
!
! This program is free software; you can redistribute it and/or modify
! it under the terms of the GNU General Public License version 2 as
! published by the Free Software Foundation [1].
!
! This program is distributed in the hope that it will be useful, but
! WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
! General Public License for more details.
!
! [1] http://www.gnu.org/licenses/gpl-2.0.html
!
! Please see the accompanying LICENSE file for further information.
!
subroutine calc_radial_nucGa(L_a,L_b)
! used to calc nuc ewald and solv grads
! input: gamma_help calculated with calc_radial_nucP
! result: radialNuc_matGa
use calc_3center_module, &
j1m=>j1,j2m=>j2,i1m=>i1,i2m=>i2,m_upM=>m_up
implicit none
!------------ Declaration of formal parameters ---------------
integer(kind=i4_kind), intent(in) :: L_a,L_b
!** End of interface *****************************************
integer(kind=i4_kind) :: Lam,j1,j2,i1,i2,m,jj,llam,m_up
! jj_facGa previosly alloc temp
jj_facGa=0.0_r8_kind
do LLam=llam_m,l_a+l_b
do m_up=0,mup_llam(LLam)
do m=0,min(m_up,LLam-llam_m)
jj_facGa(:,m_up,LLam)=jj_facGa(:,m_up,LLam) &
+bin_fac(m_up, m)*gamma_help(:,2+LLam-m)
! ^
enddo
enddo
enddo
jj=0
do j1=0,L_a
do j2=0,L_b
if(.NOT. even_triangle(j1,j2,0) ) cycle
Lam = (j1 + j2)/2
LLam=L_a+L_b-Lam
do i1=0,L_a-j1
do i2=0,L_b-j2
jj=jj+1
m_up=L_a-i1+i2+j2-Lam
radialNuc_matGa(:,jj)=jj_facGa(:,m_up,LLam) &
*nucR_fac(:,m_up,j1+i1-Lam,L_b-i2-Lam)
end do
end do
end do
end do
end subroutine calc_radial_nucGa
subroutine calc_radial_nucGGa(L_a,L_b)
! used to calc nuc ewald and solv grads
! input: gamma_help calculated with calc_radial_nucP
! result: radialNuc_matGGa
use calc_3center_module, &
j1m=>j1,j2m=>j2,i1m=>i1,i2m=>i2,m_upM=>m_up
implicit none
!------------ Declaration of formal parameters ---------------
integer(kind=i4_kind), intent(in) :: L_a,L_b
!** End of interface *****************************************
integer(kind=i4_kind) :: Lam,j1,j2,i1,i2,m,jj,llam,m_up
! jj_facGa previosly alloc temp
jj_facGa=0.0_r8_kind
do LLam=llam_m,l_a+l_b
do m_up=0,mup_llam(LLam)
do m=0,min(m_up,LLam-llam_m)
jj_facGa(:,m_up,LLam)=jj_facGa(:,m_up,LLam) &
+bin_fac(m_up, m)*gamma_help(:,3+LLam-m)
! ^ - 2nd devs
enddo
enddo
enddo
jj=0
do j1=0,L_a
do j2=0,L_b
if(.NOT. even_triangle(j1,j2,0) ) cycle
Lam = (j1 + j2)/2
LLam=L_a+L_b-Lam
do i1=0,L_a-j1
do i2=0,L_b-j2
jj=jj+1
m_up=L_a-i1+i2+j2-Lam
radialNuc_matGGa(:,jj)=jj_facGa(:,m_up,LLam) &
*nucR_fac(:,m_up,j1+i1-Lam,L_b-i2-Lam)
end do
end do
end do
end do
end subroutine calc_radial_nucGGa