26 semi_empirical_type, &
28 #include "./base/base_uses.f90"
30 TYPE(semi_empirical_type),
POINTER :: sepi, sepj
31 REAL(KIND=
dp),
DIMENSION(3),
INTENT(IN) :: rjiv
32 TYPE(rotmat_type),
POINTER :: ij_matrix
33 LOGICAL,
INTENT(IN) :: do_invert
35 CHARACTER(len=*),
PARAMETER :: modulen =
'semi_empirical_int_debug', &
36 routinen =
'check_rotmat_der', routinep = modulen//
':'//routinen
39 REAL(kind=
dp) :: dx, r, r0(3), x(3)
40 TYPE(rotmat_type),
POINTER :: matrix, matrix_m, matrix_n, &
42 INTEGER :: imap(3), i, j, k, l
44 NULLIFY (matrix_m, matrix_p, matrix_n, matrix)
58 WRITE (*, *)
"DEBUG::"//routinep
63 IF (i == 1) matrix => matrix_p
64 IF (i == 2) matrix => matrix_m
65 r0 = rjiv + (-1.0_dp)**(i - 1)*x
66 r = sqrt(dot_product(r0, r0))
67 CALL rotmat(sepi, sepj, r0, r, matrix, do_derivatives=.false., debug_invert=do_invert)
70 matrix_n%sp_d(j, :, :) = (matrix_p%sp - matrix_m%sp)/(2.0_dp*dx)
73 IF (.NOT.
check_value(matrix_n%sp_d(j, k, i), ij_matrix%sp_d(j, k, i), dx, 0.1_dp))
THEN
74 WRITE (*, *)
"ERROR for SP rotation matrix derivative SP(j,k,i), j,k,i::", j, k, i
80 matrix_n%pp_d(j, :, :, :) = (matrix_p%pp - matrix_m%pp)/(2.0_dp*dx)
84 IF (.NOT.
check_value(matrix_n%pp_d(j, l, k, i), ij_matrix%pp_d(j, l, k, i), dx, 0.1_dp))
THEN
85 WRITE (*, *)
"ERROR for PP rotation matrix derivative PP(j,l,k,i), j,l,k,i::", j, l, k, i
92 IF (sepi%dorb .OR. sepj%dorb)
THEN
94 matrix_n%sd_d(j, :, :) = (matrix_p%sd - matrix_m%sd)/(2.0_dp*dx)
97 IF (.NOT.
check_value(matrix_n%sd_d(j, k, i), ij_matrix%sd_d(j, k, i), dx, 0.1_dp))
THEN
98 WRITE (*, *)
"ERROR for SD rotation matrix derivative SD(j,k,i), j,k,i::", j, k, i
104 matrix_n%pd_d(j, :, :, :) = (matrix_p%pd - matrix_m%pd)/(2.0_dp*dx)
108 IF (.NOT.
check_value(matrix_n%pd_d(j, l, k, i), ij_matrix%pd_d(j, l, k, i), dx, 0.1_dp))
THEN
109 WRITE (*, *)
"ERROR for DP rotation matrix derivative DP(j,l,k,i), j,l,k,i::", j, l, k, i
116 matrix_n%dd_d(j, :, :, :) = (matrix_p%dd - matrix_m%dd)/(2.0_dp*dx)
120 IF (.NOT.
check_value(matrix_n%dd_d(j, l, k, i), ij_matrix%dd_d(j, l, k, i), dx, 0.1_dp))
THEN
121 WRITE (*, *)
"ERROR for DD rotation matrix derivative DD(j,l,k,i), j,l,k,i::", j, l, k, i
161 se_int_control_type, &
164 #include "./base/base_uses.f90"
166 TYPE(semi_empirical_type),
POINTER :: sepi, sepj
167 REAL(KIND=
dp),
DIMENSION(3),
INTENT(IN) :: rijv
168 TYPE(se_int_control_type),
INTENT(IN) :: se_int_control
169 LOGICAL,
INTENT(IN) :: invert
170 TYPE(se_taper_type),
POINTER :: se_taper
171 INTEGER,
INTENT(IN) :: ii, kk
172 REAL(KIND=
dp),
DIMENSION(3, 45, 45), &
175 CHARACTER(len=*),
PARAMETER :: moduleN =
'semi_empirical_int_debug', &
176 routinen =
'rot_2el_2c_first', routinep = modulen//
':'//routinen
178 REAL(KIND=
dp),
DIMENSION(491) :: rep
179 LOGICAL,
DIMENSION(45, 45) :: logv
180 REAL(KIND=
dp),
DIMENSION(45, 45) :: v_n, v_p, v_m
182 LOGICAL :: check_value
183 REAL(KIND=
dp) :: dx, r, r0(3), x(3)
184 TYPE(rotmat_type),
POINTER :: matrix
185 INTEGER :: imap(3), i, j, k, limkl
199 WRITE (*, *)
"DEBUG::"//routinep
204 r0 = rijv + (-1.0_dp)**(i - 1)*x
205 r = sqrt(dot_product(r0, r0))
208 CALL rotmat(sepi, sepj, r0, r, matrix, do_derivatives=.false., debug_invert=invert)
211 CALL terep_num(sepi, sepj, r, rep, se_taper=se_taper, se_int_control=se_int_control)
214 CALL rot_2el_2c_first(sepi, sepj, r0, se_int_control, se_taper, invert, ii, kk, rep, logv, matrix, &
218 CALL rot_2el_2c_first(sepi, sepj, r0, se_int_control, se_taper, invert, ii, kk, rep, logv, matrix, &
227 v_n(i, k) = (v_p(i, k) - v_m(i, k))/(2.0_dp*dx)
228 IF (.NOT. check_value(v_d(j, i, k), v_n(i, k), dx, 0.1_dp))
THEN
229 WRITE (*, *)
"ERROR for rot_2el_2c_first derivative V_D(j,i,k), j,i,k::", j, i, k
257 se_int_control_type, &
259 #include "./base/base_uses.f90"
261 TYPE(semi_empirical_type),
POINTER :: sepi, sepj
262 REAL(dp),
INTENT(IN) :: r
263 REAL(dp),
INTENT(IN) :: dssss
264 INTEGER,
INTENT(IN) :: itype
265 TYPE(se_int_control_type),
INTENT(IN) :: se_int_control
266 TYPE(se_taper_type),
POINTER :: se_taper
268 CHARACTER(len=*),
PARAMETER :: moduleN =
'semi_empirical_int_debug', &
269 routinen =
'check_dssss_nucint_ana', routinep = modulen//
':'//routinen
271 REAL(dp) :: delta, nssss, od, rn, ssssm, ssssp
272 LOGICAL :: check_value
277 CALL ssss_nucint_num(sepi, sepj, rn, ssssp, itype, se_taper, se_int_control)
279 CALL ssss_nucint_num(sepi, sepj, rn, ssssm, itype, se_taper, se_int_control)
280 nssss = od*(ssssp - ssssm)
282 WRITE (*, *)
"DEBUG::"//routinep
283 IF (.NOT. check_value(nssss, dssss, delta, 0.1_dp))
THEN
284 WRITE (*, *)
"ERROR for SSSS derivative SSSS"
309 se_int_control_type, &
311 #include "./base/base_uses.f90"
313 TYPE(semi_empirical_type),
POINTER :: sepi, sepj
314 REAL(dp),
INTENT(IN) :: r
315 REAL(dp),
DIMENSION(10, 2),
INTENT(IN) :: dcore
316 INTEGER,
INTENT(IN) :: itype
317 TYPE(se_int_control_type),
INTENT(IN) :: se_int_control
318 TYPE(se_taper_type),
POINTER :: se_taper
320 CHARACTER(len=*),
PARAMETER :: moduleN =
'semi_empirical_int_debug', &
321 routinen =
'check_dcore_nucint_ana', routinep = modulen//
':'//routinen
324 REAL(dp) :: delta, od, rn
325 REAL(dp),
DIMENSION(10, 2) :: corem, corep, ncore
326 LOGICAL :: check_value
331 CALL core_nucint_num(sepi, sepj, rn, corep, itype, se_taper, se_int_control)
333 CALL core_nucint_num(sepi, sepj, rn, corem, itype, se_taper, se_int_control)
334 ncore = od*(corep - corem)
336 WRITE (*, *)
"DEBUG::"//routinep
339 IF (.NOT. check_value(ncore(j, i), dcore(j, i), delta, 0.1_dp))
THEN
340 WRITE (*, *)
"ERROR for CORE derivative CORE(j,i), j,i::", j, i
363 REAL(kind=
dp) :: num, ana, thrs, minval
368 IF ((abs(num) < minval) .AND. (abs(ana) > minval))
THEN
369 WRITE (*, *)
"WARNING ---> ", num, ana, thrs
370 ELSE IF ((abs(num) > minval) .AND. (abs(ana) < minval))
THEN
371 WRITE (*, *)
"WARNING ---> ", num, ana, thrs
372 ELSE IF ((abs(num) < minval) .AND. (abs(ana) < minval))
THEN
376 IF (abs((num - ana)/num*100._dp) > thrs)
THEN
377 WRITE (*, *) abs(num - ana)/num*100._dp, thrs
380 IF (.NOT. passed)
THEN
381 WRITE (*, *)
"ANALYTICAL ::", ana
382 WRITE (*, *)
"NUMERICAL ::", num
404 SUBROUTINE check_drotnuc_ana(sepi, sepj, rijv, itype, se_int_control, se_taper, e1b, e2a, de1b, de2a)
410 se_int_control_type, &
412 #include "./base/base_uses.f90"
414 TYPE(semi_empirical_type),
POINTER :: sepi, sepj
415 REAL(dp),
DIMENSION(3),
INTENT(IN) :: rijv
416 INTEGER,
INTENT(IN) :: itype
417 TYPE(se_int_control_type),
INTENT(IN) :: se_int_control
418 TYPE(se_taper_type),
POINTER :: se_taper
419 REAL(dp),
DIMENSION(45),
INTENT(IN), &
421 REAL(dp),
DIMENSION(3, 45), &
422 INTENT(IN),
OPTIONAL :: de1b, de2a
424 CHARACTER(len=*),
PARAMETER :: moduleN =
'semi_empirical_int_debug', &
425 routinen =
'check_drotnuc_ana', routinep = modulen//
':'//routinen
428 LOGICAL :: l_de1b, l_de2a, l_e1b, l_e2a, &
431 REAL(KIND=dp),
DIMENSION(45) :: e1b2, e2a2
432 REAL(KIND=dp),
DIMENSION(3, 45) :: de1b2, de2a2
436 l_de1b =
PRESENT(de1b)
437 l_de2a =
PRESENT(de2a)
438 lgrad = l_de1b .OR. l_de2a
441 WRITE (*, *)
"DEBUG::"//routinep
442 CALL rotnuc_num(sepi, sepj, rijv, e1b2, e2a2, itype, se_int_control, se_taper=se_taper)
445 IF (.NOT. check_value(e1b2(j), e1b(j), delta, 0.1_dp))
THEN
446 WRITE (*, *)
"ERROR for E1B value E1B(j), j::", j
453 IF (.NOT. check_value(e2a2(j), e2a(j), delta, 0.1_dp))
THEN
454 WRITE (*, *)
"ERROR for E2A value E2A(j), j::", j
462 CALL drotnuc_num(sepi, sepj, rijv, de1b2, de2a2, itype, delta=delta, &
463 se_int_control=se_int_control, se_taper=se_taper)
468 IF (abs(e1b2(j)) > delta)
THEN
469 IF (.NOT. check_value(de1b2(i, j), de1b(i, j), delta, 0.1_dp))
THEN
470 WRITE (*, *)
"ERROR for derivative of E1B. DE1B(i,j), i,j::", i, j
481 IF (abs(e2a2(j)) > delta)
THEN
482 IF (.NOT. check_value(de2a2(i, j), de2a(i, j), delta, 0.1_dp))
THEN
483 WRITE (*, *)
"ERROR for derivative of E2A. DE2A(i,j), i,j::", i, j
515 se_int_control_type, &
517 #include "./base/base_uses.f90"
519 TYPE(semi_empirical_type),
POINTER :: sepi, sepj
520 REAL(
dp),
DIMENSION(3),
INTENT(IN) :: rijv
521 INTEGER,
INTENT(IN) :: itype
522 REAL(dp),
INTENT(IN),
OPTIONAL :: enuc
523 REAL(dp),
DIMENSION(3),
INTENT(IN), &
525 TYPE(se_int_control_type),
INTENT(IN) :: se_int_control
526 TYPE(se_taper_type),
POINTER :: se_taper
528 CHARACTER(len=*),
PARAMETER :: moduleN =
'semi_empirical_int_debug', &
529 routinen =
'check_dcorecore_ana', routinep = modulen//
':'//routinen
531 LOGICAL :: check_value
533 REAL(dp) :: enuc_num, delta
534 REAL(dp),
DIMENSION(3) :: denuc_num
536 WRITE (*, *)
"DEBUG::"//routinep
539 IF (
PRESENT(enuc))
THEN
540 CALL corecore_num(sepi, sepj, rijv, enuc_num, itype, se_int_control, se_taper)
541 IF (.NOT. check_value(enuc, enuc_num, delta, 0.001_dp))
THEN
542 WRITE (*, *)
"ERROR for CORE-CORE energy value (numerical different from analytical)!!"
546 IF (
PRESENT(denuc))
THEN
547 CALL dcorecore_num(sepi, sepj, rijv, denuc_num, itype, delta, se_int_control, se_taper)
549 IF (.NOT. check_value(denuc(j), denuc_num(j), delta, 0.001_dp))
THEN
550 WRITE (*, *)
"ERROR for CORE-CORE energy derivative value (numerical different from analytical). DENUC(j), j::", j
578 se_int_control_type, &
580 #include "./base/base_uses.f90"
582 TYPE(semi_empirical_type),
POINTER :: sepi, sepj
583 REAL(dp),
INTENT(IN) :: r
584 REAL(dp),
DIMENSION(491),
INTENT(IN) :: ri, dri
585 TYPE(se_int_control_type),
INTENT(IN) :: se_int_control
586 LOGICAL,
INTENT(IN) :: lgrad
587 TYPE(se_taper_type),
POINTER :: se_taper
589 CHARACTER(len=*),
PARAMETER :: moduleN =
'semi_empirical_int_debug', &
590 routinen =
'check_dterep_ana', routinep = modulen//
':'//routinen
592 LOGICAL :: check_value
594 REAL(dp) :: delta, od, rn
595 REAL(dp),
DIMENSION(491) :: nri, ri0, rim, rip
600 CALL terep_num(sepi, sepj, rn, ri0, se_taper, se_int_control)
603 CALL terep_num(sepi, sepj, rn, rip, se_taper, se_int_control)
605 CALL terep_num(sepi, sepj, rn, rim, se_taper, se_int_control)
609 WRITE (*, *)
"DEBUG::"//routinep
611 IF (abs(ri(j) - ri0(j)) > epsilon(0.0_dp))
THEN
612 WRITE (*, *)
"Error in value of the integral RI", j, ri(j), ri0(j)
616 IF (.NOT. check_value(dri(j), nri(j), delta*100.0_dp, 0.1_dp))
THEN
617 WRITE (*, *)
"ERROR for derivative of RI integral, RI(j), j::", j
618 WRITE (*, *)
"FULL SET OF INTEGRALS: INDX ANAL NUM DIFF"
620 WRITE (*,
'(I5,3F15.9)') i, dri(i), nri(i), nri(i) - dri(i)
649 se_int_control_type, &
651 #include "./base/base_uses.f90"
653 TYPE(semi_empirical_type),
POINTER :: sepi, sepj
654 REAL(dp),
DIMENSION(3),
INTENT(IN) :: rijv
655 REAL(dp),
DIMENSION(2025),
INTENT(IN), &
657 REAL(dp),
DIMENSION(3, 2025), &
658 INTENT(IN),
OPTIONAL :: dw
659 TYPE(se_int_control_type),
INTENT(IN) :: se_int_control
660 TYPE(se_taper_type),
POINTER :: se_taper
662 CHARACTER(len=*),
PARAMETER :: moduleN =
'semi_empirical_int_debug', &
663 routinen =
'rotint_ana', routinep = modulen//
':'//routinen
665 REAL(dp),
DIMENSION(2025) :: w2
666 REAL(dp),
DIMENSION(3, 2025) :: dw2
667 LOGICAL :: check_value
669 REAL(KIND=dp) :: delta
672 WRITE (*, *)
"DEBUG::"//routinep
675 CALL rotint_num(sepi, sepj, rijv, w2, se_int_control, se_taper=se_taper)
677 IF (.NOT. check_value(w(j), w2(j), delta, 0.1_dp))
THEN
678 WRITE (*, *)
"ERROR for integral value W(j), j::", j
683 IF (
PRESENT(dw))
THEN
688 CALL drotint_num(sepi, sepj, rijv, dw2, delta=delta, se_int_control=se_int_control, se_taper=se_taper)
689 CALL rotint_num(sepi, sepj, rijv, w2, se_int_control=se_int_control, se_taper=se_taper)
692 IF ((abs(w2(j)) > delta) .AND. (abs(dw2(i, j)) > delta*10))
THEN
693 IF (.NOT. check_value(dw(i, j), dw2(i, j), delta, 0.1_dp))
THEN
694 WRITE (*, *)
"ERROR for derivative of the integral value W(j). DW(i,j) i,j::", i, j
Defines the basic variable types.
integer, parameter, public dp
Arrays of parameters used in the semi-empirical calculations \References Everywhere in this module TC...
integer, dimension(9, 9), public indexb
Integrals for semi-empiric methods.
subroutine, public rotnuc_num(sepi, sepj, rijv, e1b, e2a, itype, se_int_control, se_taper)
Computes the two-particle interactions.
subroutine, public rotint_num(sepi, sepj, rijv, w, se_int_control, se_taper)
Computes the two particle interactions in the lab frame.
subroutine, public drotint_num(sepi, sepj, r, dw, delta, se_int_control, se_taper)
Numerical Derivatives for rotint.
subroutine, public core_nucint_num(sepi, sepj, rij, core, itype, se_taper, se_int_control)
Calculates the nuclear attraction integrals CORE (main driver)
subroutine, public ssss_nucint_num(sepi, sepj, rij, ssss, itype, se_taper, se_int_control)
Calculates the SSSS integrals (main driver)
subroutine, public drotnuc_num(sepi, sepj, r, de1b, de2a, itype, delta, se_int_control, se_taper)
Numerical Derivatives for rotnuc.
subroutine, public dcorecore_num(sepi, sepj, r, denuc, itype, delta, se_int_control, se_taper)
Numerical Derivatives for corecore.
subroutine, public corecore_num(sepi, sepj, rijv, enuc, itype, se_int_control, se_taper)
Computes the core-core interactions.
subroutine, public terep_num(sepi, sepj, rij, rep, se_taper, se_int_control)
Calculates the derivative pf two-electron repulsion integrals and the nuclear attraction integrals w....
Utilities for Integrals for semi-empiric methods.
recursive subroutine, public rotmat(sepi, sepj, rjiv, r, ij_matrix, do_derivatives, do_invert, debug_invert)
Computes the general rotation matrices for the integrals between I and J (J>=I)
recursive subroutine, public rot_2el_2c_first(sepi, sepj, rijv, se_int_control, se_taper, invert, ii, kk, rep, logv, ij_matrix, v, lgrad, rep_d, v_d, logv_d, drij)
First Step of the rotation of the two-electron two-center integrals in SPD basis.
Definition of the semi empirical parameter types.
subroutine, public rotmat_release(rotmat)
Releases rotmat type.
subroutine, public rotmat_create(rotmat)
Creates rotmat type.
subroutine check_rotmat_der(sepi, sepj, rjiv, ij_matrix, do_invert)
Debug the derivatives of the the rotational matrices.
subroutine rot_2el_2c_first_debug(sepi, sepj, rijv, se_int_control, se_taper, invert, ii, kk, v_d)
Check Numerical Vs Analytical.
subroutine check_dssss_nucint_ana(sepi, sepj, r, dssss, itype, se_int_control, se_taper)
Check Numerical Vs Analytical ssss.
logical function check_value(num, ana, minval, thrs)
Low level comparison function between numberical and analytical values.
subroutine check_dcorecore_ana(sepi, sepj, rijv, itype, se_int_control, se_taper, enuc, denuc)
Check Numerical Vs Analytical CORE-CORE.
subroutine check_rotint_ana(sepi, sepj, rijv, w, dw, se_int_control, se_taper)
Check Numerical Vs Analytical ROTINT_ANA.
subroutine check_drotnuc_ana(sepi, sepj, rijv, itype, se_int_control, se_taper, e1b, e2a, de1b, de2a)
Check Numerical Vs Analytical.
subroutine check_dcore_nucint_ana(sepi, sepj, r, dcore, itype, se_int_control, se_taper)
Check Numerical Vs Analytical core.
subroutine check_dterep_ana(sepi, sepj, r, ri, dri, se_int_control, se_taper, lgrad)
Check Numerical Vs Analytical DTEREP_ANA.