1 !-----------------------------------------------------------------------------!
2 !   CP2K: A general program to perform molecular dynamics simulations         !
3 !   Copyright (C) 2000 - 2019  CP2K developers group                          !
4 !-----------------------------------------------------------------------------!
5 
6 ! *****************************************************************************
7 !> \brief Debug the derivatives of the the rotational matrices
8 !>
9 !> \author Teodoro Laino [tlaino] - University of Zurich
10 !> \date 04.2008 [tlaino]
11 ! *****************************************************************************
12 INTERFACE
13    SUBROUTINE check_rotmat_der( sepi, sepj, rjiv, ij_matrix, do_invert)
14      USE kinds,                           ONLY: dp
15      USE semi_empirical_types,            ONLY: rotmat_type,&
16                                                 semi_empirical_type
17      IMPLICIT NONE
18      TYPE(semi_empirical_type), POINTER       :: sepi, sepj
19      REAL(KIND=dp), DIMENSION(3), INTENT(IN)  :: rjiv
20      TYPE(rotmat_type), POINTER               :: ij_matrix
21      LOGICAL, INTENT(IN)                      :: do_invert
22    END SUBROUTINE check_rotmat_der
23 END INTERFACE
24 
25 ! *****************************************************************************
26 !> \brief Check Numerical Vs Analytical NUCINT ssss
27 !> \note
28 !>      Debug routine
29 !> \par History
30 !>      04.2008 created [tlaino]
31 !> \author Teodoro Laino - Zurich University
32 ! *****************************************************************************
33 INTERFACE
34   SUBROUTINE check_dssss_nucint_ana (sepi,sepj,r,dssss,itype,se_int_control,&
35        se_taper)
36     USE kinds,                           ONLY: dp
37     USE semi_empirical_types,            ONLY: semi_empirical_type,&
38                                                se_int_control_type,&
39                                                se_taper_type
40     IMPLICIT NONE
41     TYPE(semi_empirical_type), POINTER       :: sepi, sepj
42     REAL(dp), INTENT(IN)                     :: r
43     REAL(dp), INTENT(IN)                     :: dssss
44     INTEGER, INTENT(IN)                      :: itype
45     TYPE(se_int_control_type), INTENT(IN)    :: se_int_control
46     TYPE(se_taper_type), POINTER             :: se_taper
47   END SUBROUTINE check_dssss_nucint_ana
48 END INTERFACE
49 
50 ! *****************************************************************************
51 !> \brief Check Numerical Vs Analytical NUCINT core
52 !> \note
53 !>      Debug routine
54 !> \par History
55 !>      04.2008 created [tlaino]
56 !> \author Teodoro Laino - Zurich University
57 ! *****************************************************************************
58 INTERFACE
59   SUBROUTINE check_dcore_nucint_ana (sepi,sepj,r,dcore,itype,se_int_control,&
60        se_taper)
61     USE kinds,                           ONLY: dp
62     USE semi_empirical_types,            ONLY: semi_empirical_type,&
63                                                se_int_control_type,&
64                                                se_taper_type
65     IMPLICIT NONE
66     TYPE(semi_empirical_type), POINTER       :: sepi, sepj
67     REAL(dp), INTENT(IN)                     :: r
68     REAL(dp), DIMENSION(10, 2), INTENT(IN)   :: dcore
69     INTEGER, INTENT(IN)                      :: itype
70     TYPE(se_int_control_type), INTENT(IN)    :: se_int_control
71     TYPE(se_taper_type), POINTER             :: se_taper
72   END SUBROUTINE check_dcore_nucint_ana
73 END INTERFACE
74 
75 ! *****************************************************************************
76 !> \brief Check Numerical Vs Analytical ROTNUC
77 !> \note
78 !>      Debug routine
79 !> \par History
80 !>      04.2008 created [tlaino]
81 !> \author Teodoro Laino - Zurich University
82 ! *****************************************************************************
83 INTERFACE
84    SUBROUTINE check_drotnuc_ana(sepi, sepj, rijv, itype, se_int_control, se_taper,&
85         e1b, e2a, de1b, de2a)
86     USE kinds,                           ONLY: dp
87     USE semi_empirical_types,            ONLY: semi_empirical_type,&
88                                                se_int_control_type,&
89                                                se_taper_type
90     IMPLICIT NONE
91     TYPE(semi_empirical_type), POINTER       :: sepi, sepj
92     REAL(dp), DIMENSION(3), INTENT(IN)       :: rijv
93     INTEGER, INTENT(IN)                      :: itype
94     TYPE(se_int_control_type), INTENT(IN)    :: se_int_control
95     TYPE(se_taper_type), POINTER             :: se_taper
96     REAL(dp), DIMENSION(45), INTENT(IN), &
97       OPTIONAL                               :: e1b, e2a
98     REAL(dp), DIMENSION(45, 3), &
99       INTENT(IN), OPTIONAL                   :: de1b, de2a
100    END SUBROUTINE check_drotnuc_ana
101 END INTERFACE
102 
103 ! *****************************************************************************
104 !> \brief Check Numerical Vs Analytical CORECORE
105 !> \note
106 !>      Debug routine
107 !> \par History
108 !>      04.2008 created [tlaino]
109 !> \author Teodoro Laino - Zurich University
110 ! *****************************************************************************
111 INTERFACE
112   SUBROUTINE check_dcorecore_ana(sepi, sepj, rijv, itype,se_int_control,&
113        se_taper, enuc, denuc)
114     USE kinds,                           ONLY: dp
115     USE semi_empirical_types,            ONLY: semi_empirical_type,&
116                                                se_int_control_type,&
117                                                se_taper_type
118     IMPLICIT NONE
119     TYPE(semi_empirical_type), POINTER       :: sepi, sepj
120     REAL(dp), DIMENSION(3), INTENT(IN)       :: rijv
121     INTEGER, INTENT(IN)                      :: itype
122     REAL(dp), INTENT(IN), OPTIONAL           :: enuc
123     REAL(dp), DIMENSION(3), INTENT(IN), &
124          OPTIONAL                            :: denuc
125     TYPE(se_int_control_type), INTENT(IN)    :: se_int_control
126     TYPE(se_taper_type), POINTER             :: se_taper
127   END SUBROUTINE check_dcorecore_ana
128 
129 END INTERFACE
130 
131 ! *****************************************************************************
132 !> \brief Check Numerical Vs Analytical rot_2el_2c_first
133 !> \note
134 !>      Debug routine
135 !> \par History
136 !>      04.2008 created [tlaino]
137 !> \author Teodoro Laino - Zurich University
138 ! *****************************************************************************
139 INTERFACE
140   SUBROUTINE rot_2el_2c_first_debug(sepi, sepj, rijv, se_int_control, se_taper,&
141        invert, ii, kk, v_d)
142     USE kinds,                           ONLY: dp
143     USE semi_empirical_types,            ONLY: semi_empirical_type,&
144                                                se_int_control_type,&
145                                                se_taper_type
146     IMPLICIT NONE
147     TYPE(semi_empirical_type), POINTER       :: sepi, sepj
148     REAL(KIND=dp), DIMENSION(3), INTENT(IN)  :: rijv
149     LOGICAL, INTENT(IN)                      :: invert
150     TYPE(se_int_control_type), INTENT(IN)    :: se_int_control
151     TYPE(se_taper_type), POINTER             :: se_taper
152     INTEGER, INTENT(IN)                      :: ii, kk
153     REAL(KIND=dp), DIMENSION(45, 45, 3), &
154       INTENT(IN)                             :: v_d
155   END SUBROUTINE rot_2el_2c_first_debug
156 END INTERFACE
157 
158 ! *****************************************************************************
159 !> \brief Check Numerical Vs Analytical check_dterep_ana
160 !> \note
161 !>      Debug routine
162 !> \par History
163 !>      04.2008 created [tlaino]
164 !> \author Teodoro Laino - Zurich University
165 ! *****************************************************************************
166 INTERFACE
167   SUBROUTINE check_dterep_ana (sepi,sepj,r,ri,dri,se_int_control,se_taper,lgrad)
168     USE kinds,                           ONLY: dp
169     USE semi_empirical_types,            ONLY: semi_empirical_type,&
170                                                se_int_control_type,&
171                                                se_taper_type
172     IMPLICIT NONE
173     TYPE(semi_empirical_type), POINTER       :: sepi, sepj
174     REAL(dp), INTENT(IN)                     :: r
175     REAL(dp), DIMENSION(491), INTENT(IN)     :: ri, dri
176     TYPE(se_int_control_type), INTENT(IN)    :: se_int_control
177     LOGICAL, INTENT(IN)                      :: lgrad
178     TYPE(se_taper_type), POINTER             :: se_taper
179   END SUBROUTINE check_dterep_ana
180 END INTERFACE
181 
182 ! *****************************************************************************
183 !> \brief Check Numerical Vs Analytical check_rotint_ana
184 !> \note
185 !>      Debug routine
186 !> \par History
187 !>      04.2008 created [tlaino]
188 !> \author Teodoro Laino - Zurich University
189 ! *****************************************************************************
190 INTERFACE
191   SUBROUTINE check_rotint_ana(sepi,sepj,rijv,w,dw,se_int_control,se_taper)
192     USE kinds,                           ONLY: dp
193     USE semi_empirical_types,            ONLY: semi_empirical_type,&
194                                                se_int_control_type,&
195                                                se_taper_type
196     IMPLICIT NONE
197     TYPE(semi_empirical_type), POINTER       :: sepi, sepj
198     REAL(dp), DIMENSION(3), INTENT(IN)       :: rijv
199     REAL(dp), DIMENSION(2025), INTENT(IN), &
200       OPTIONAL                               :: w
201     REAL(dp), DIMENSION(2025, 3), &
202       INTENT(IN), OPTIONAL                   :: dw
203     TYPE(se_int_control_type), INTENT(IN)    :: se_int_control
204     TYPE(se_taper_type), POINTER             :: se_taper
205   END SUBROUTINE check_rotint_ana
206 END INTERFACE
207