LCOV - code coverage report
Current view: top level - src - semi_empirical_types.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:42dac4a) Lines: 68.6 % 334 229
Test Date: 2025-07-25 12:55:17 Functions: 55.6 % 18 10

            Line data    Source code
       1              : !--------------------------------------------------------------------------------------------------!
       2              : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3              : !   Copyright 2000-2025 CP2K developers group <https://cp2k.org>                                   !
       4              : !                                                                                                  !
       5              : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6              : !--------------------------------------------------------------------------------------------------!
       7              : 
       8              : ! **************************************************************************************************
       9              : !> \brief Definition of the semi empirical parameter types.
      10              : !> \author JGH (14.08.2004)
      11              : ! **************************************************************************************************
      12              : MODULE semi_empirical_types
      13              :    USE basis_set_types,                 ONLY: deallocate_sto_basis_set,&
      14              :                                               sto_basis_set_type
      15              :    USE cp_log_handling,                 ONLY: cp_get_default_logger,&
      16              :                                               cp_logger_type,&
      17              :                                               cp_to_string
      18              :    USE cp_output_handling,              ONLY: cp_p_file,&
      19              :                                               cp_print_key_finished_output,&
      20              :                                               cp_print_key_should_output,&
      21              :                                               cp_print_key_unit_nr
      22              :    USE dg_types,                        ONLY: dg_type
      23              :    USE input_constants,                 ONLY: &
      24              :         do_method_am1, do_method_mndo, do_method_mndod, do_method_pdg, do_method_pm3, &
      25              :         do_method_pm6, do_method_pm6fm, do_method_pnnl, do_method_rm1, do_se_IS_kdso_d, &
      26              :         do_se_IS_slater
      27              :    USE input_section_types,             ONLY: section_vals_type
      28              :    USE kinds,                           ONLY: default_string_length,&
      29              :                                               dp
      30              :    USE multipole_types,                 ONLY: do_multipole_charge,&
      31              :                                               do_multipole_dipole,&
      32              :                                               do_multipole_none,&
      33              :                                               do_multipole_quadrupole
      34              :    USE physcon,                         ONLY: angstrom,&
      35              :                                               evolt,&
      36              :                                               kcalmol
      37              :    USE pw_pool_types,                   ONLY: pw_pool_type
      38              :    USE semi_empirical_expns3_types,     ONLY: semi_empirical_expns3_p_type,&
      39              :                                               semi_empirical_expns3_release
      40              :    USE semi_empirical_mpole_types,      ONLY: semi_empirical_mpole_p_release,&
      41              :                                               semi_empirical_mpole_p_type
      42              :    USE taper_types,                     ONLY: taper_create,&
      43              :                                               taper_release,&
      44              :                                               taper_type
      45              : #include "./base/base_uses.f90"
      46              : 
      47              :    IMPLICIT NONE
      48              : 
      49              :    PRIVATE
      50              : 
      51              : ! *** Global parameters ***
      52              :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'semi_empirical_types'
      53              : 
      54              : ! **************************************************************************************************
      55              : !> \brief Semi-empirical type
      56              : ! **************************************************************************************************
      57              :    TYPE semi_empirical_type
      58              :       INTEGER                                :: typ = -1
      59              :       INTEGER                                :: nr = -1
      60              :       INTEGER                                :: core_size = -1, atm_int_size = -1
      61              :       CHARACTER(LEN=default_string_length)   :: name = ""
      62              :       LOGICAL                                :: defined = .FALSE., dorb = .FALSE., extended_basis_set = .FALSE.
      63              :       LOGICAL                                :: p_orbitals_on_h = .FALSE.
      64              :       INTEGER                                :: z = -1
      65              :       REAL(KIND=dp)                          :: zeff = -1.0_dp
      66              :       INTEGER                                :: natorb = -1
      67              :       REAL(KIND=dp), DIMENSION(:), POINTER :: beta => NULL()
      68              :       REAL(KIND=dp), DIMENSION(:), POINTER :: sto_exponents => NULL()
      69              :       REAL(KIND=dp), DIMENSION(:), POINTER :: zn => NULL()
      70              :       TYPE(sto_basis_set_type), POINTER      :: basis => NULL()
      71              :       INTEGER                                :: ngauss = -1
      72              :       REAL(KIND=dp)                        :: eheat = -1.0_dp
      73              :       REAL(KIND=dp)                        :: uss = -1.0_dp, upp = -1.0_dp, udd = -1.0_dp, uff = -1.0_dp
      74              :       REAL(KIND=dp)                        :: alp = -1.0_dp
      75              :       REAL(KIND=dp)                        :: eisol = -1.0_dp
      76              :       REAL(KIND=dp)                        :: ass = -1.0_dp, asp = -1.0_dp, app = -1.0_dp, de = -1.0_dp, acoul = -1.0_dp
      77              :       REAL(KIND=dp)                        :: gss = -1.0_dp, gsp = -1.0_dp, gpp = -1.0_dp, gp2 = -1.0_dp
      78              :       REAL(KIND=dp)                        :: gsd = -1.0_dp, gpd = -1.0_dp, gdd = -1.0_dp
      79              :       REAL(KIND=dp)                        :: hsp = -1.0_dp
      80              :       REAL(KIND=dp)                        :: dd = -1.0_dp, qq = -1.0_dp, am = -1.0_dp, ad = -1.0_dp, aq = -1.0_dp
      81              :       REAL(KIND=dp), DIMENSION(2)           :: pre = -1.0_dp, d = -1.0_dp
      82              :       REAL(KIND=dp), DIMENSION(4)           :: fn1 = -1.0_dp, fn2 = -1.0_dp, fn3 = -1.0_dp
      83              :       REAL(KIND=dp), DIMENSION(4, 4)         :: bfn1 = -1.0_dp, bfn2 = -1.0_dp, bfn3 = -1.0_dp
      84              :       REAL(KIND=dp)                        :: f0dd = -1.0_dp, f2dd = -1.0_dp, f4dd = -1.0_dp, &
      85              :                                               f0sd = -1.0_dp, f0pd = -1.0_dp, f2pd = -1.0_dp, &
      86              :                                               g1pd = -1.0_dp, g2sd = -1.0_dp, g3pd = -1.0_dp
      87              :       REAL(KIND=dp), DIMENSION(9)          :: ko = -1.0_dp
      88              :       REAL(KIND=dp), DIMENSION(6)          :: cs = -1.0_dp
      89              :       REAL(KIND=dp), DIMENSION(52)         :: onec2el = -1.0_dp
      90              :       ! Specific for PM6 & PM6-FM
      91              :       REAL(KIND=dp), DIMENSION(0:115)      :: xab = -1.0_dp
      92              :       REAL(KIND=dp), DIMENSION(0:115)      :: aab = -1.0_dp
      93              :       REAL(KIND=dp)                        :: a = -1.0_dp, b = -1.0_dp, c = -1.0_dp, rho = -1.0_dp
      94              :       ! One center - two electron integrals
      95              :       REAL(KIND=dp), DIMENSION(:, :), &
      96              :          POINTER                           :: w => NULL()
      97              :       TYPE(semi_empirical_mpole_p_type), &
      98              :          POINTER, DIMENSION(:)             :: w_mpole => NULL()
      99              :       ! 1/R^3 residual integral part
     100              :       TYPE(semi_empirical_expns3_p_type), &
     101              :          POINTER, DIMENSION(:)             :: expns3_int => NULL()
     102              :    END TYPE semi_empirical_type
     103              : 
     104              :    TYPE semi_empirical_p_type
     105              :       TYPE(semi_empirical_type), POINTER    :: se_param => NULL()
     106              :    END TYPE semi_empirical_p_type
     107              : 
     108              : ! **************************************************************************************************
     109              : !> \brief  Rotation Matrix Type
     110              : !> \author 05.2008 Teodoro Laino [tlaino] - University of Zurich
     111              : ! **************************************************************************************************
     112              :    TYPE rotmat_type
     113              :       ! Value of Rotation Matrices
     114              :       REAL(KIND=dp), DIMENSION(3, 3)      :: sp = -1.0_dp
     115              :       REAL(KIND=dp), DIMENSION(5, 5)      :: sd = -1.0_dp
     116              :       REAL(KIND=dp), DIMENSION(6, 3, 3)      :: pp = -1.0_dp
     117              :       REAL(KIND=dp), DIMENSION(15, 5, 3)      :: pd = -1.0_dp
     118              :       REAL(KIND=dp), DIMENSION(15, 5, 5)      :: dd = -1.0_dp
     119              :       ! Derivatives of Rotation Matrices
     120              :       REAL(KIND=dp), DIMENSION(3, 3, 3)   :: sp_d = -1.0_dp
     121              :       REAL(KIND=dp), DIMENSION(3, 5, 5)   :: sd_d = -1.0_dp
     122              :       REAL(KIND=dp), DIMENSION(3, 6, 3, 3)   :: pp_d = -1.0_dp
     123              :       REAL(KIND=dp), DIMENSION(3, 15, 5, 3)   :: pd_d = -1.0_dp
     124              :       REAL(KIND=dp), DIMENSION(3, 15, 5, 5)   :: dd_d = -1.0_dp
     125              :    END TYPE rotmat_type
     126              : 
     127              : ! **************************************************************************************************
     128              : !> \brief  Ewald control type (for periodic SE)
     129              : !> \author Teodoro Laino [tlaino]  - 12.2008
     130              : ! **************************************************************************************************
     131              :    TYPE ewald_gks_type
     132              :       REAL(KIND=dp)                            :: alpha = -1.0_dp
     133              :       TYPE(dg_type), POINTER                   :: dg => NULL()
     134              :       TYPE(pw_pool_type), POINTER              :: pw_pool => NULL()
     135              :    END TYPE ewald_gks_type
     136              : 
     137              :    TYPE se_int_control_type
     138              :       LOGICAL                                  :: shortrange = .FALSE.
     139              :       LOGICAL                                  :: do_ewald_r3 = .FALSE.
     140              :       LOGICAL                                  :: do_ewald_gks = .FALSE.
     141              :       LOGICAL                                  :: pc_coulomb_int = .FALSE.
     142              :       INTEGER                                  :: integral_screening = -1
     143              :       INTEGER                                  :: max_multipole = -1
     144              :       TYPE(ewald_gks_type)                     :: ewald_gks = ewald_gks_type()
     145              :    END TYPE se_int_control_type
     146              : 
     147              : ! **************************************************************************************************
     148              : !> \brief Store the value of the tapering function and possibly its derivative
     149              : !>        for screened integrals
     150              : ! **************************************************************************************************
     151              :    TYPE se_int_screen_type
     152              :       REAL(KIND=dp)                            :: ft = -1.0_dp, dft = -1.0_dp
     153              :    END TYPE se_int_screen_type
     154              : 
     155              : ! **************************************************************************************************
     156              : !> \brief Taper type use in semi-empirical calculations
     157              : ! **************************************************************************************************
     158              :    TYPE se_taper_type
     159              :       TYPE(taper_type), POINTER             :: taper => NULL()
     160              :       TYPE(taper_type), POINTER             :: taper_cou => NULL()
     161              :       TYPE(taper_type), POINTER             :: taper_exc => NULL()
     162              :       TYPE(taper_type), POINTER             :: taper_lrc => NULL()
     163              :       ! This taper is for KDSO-D integrals
     164              :       TYPE(taper_type), POINTER             :: taper_add => NULL()
     165              :    END TYPE se_taper_type
     166              : 
     167              :    PUBLIC :: semi_empirical_type, &
     168              :              semi_empirical_p_type, &
     169              :              semi_empirical_create, &
     170              :              semi_empirical_release, &
     171              :              rotmat_type, &
     172              :              rotmat_create, &
     173              :              rotmat_release, &
     174              :              get_se_param, &
     175              :              write_se_param, &
     176              :              se_int_control_type, &
     177              :              setup_se_int_control_type, &
     178              :              se_int_screen_type, &
     179              :              se_taper_type, &
     180              :              se_taper_release, &
     181              :              se_taper_create
     182              : 
     183              : CONTAINS
     184              : 
     185              : ! **************************************************************************************************
     186              : !> \brief Allocate semi-empirical type
     187              : !> \param sep ...
     188              : ! **************************************************************************************************
     189         3964 :    SUBROUTINE semi_empirical_create(sep)
     190              :       TYPE(semi_empirical_type), POINTER                 :: sep
     191              : 
     192         3964 :       CPASSERT(.NOT. ASSOCIATED(sep))
     193      1538032 :       ALLOCATE (sep)
     194         3964 :       ALLOCATE (sep%beta(0:3))
     195         3964 :       ALLOCATE (sep%sto_exponents(0:3))
     196         3964 :       ALLOCATE (sep%zn(0:3))
     197              :       NULLIFY (sep%basis)
     198              :       NULLIFY (sep%w)
     199              :       NULLIFY (sep%w_mpole)
     200              :       NULLIFY (sep%expns3_int)
     201         3964 :       CALL zero_se_param(sep)
     202              : 
     203         3964 :    END SUBROUTINE semi_empirical_create
     204              : 
     205              : ! **************************************************************************************************
     206              : !> \brief Deallocate the semi-empirical type
     207              : !> \param sep ...
     208              : ! **************************************************************************************************
     209         3964 :    SUBROUTINE semi_empirical_release(sep)
     210              : 
     211              :       TYPE(semi_empirical_type), POINTER                 :: sep
     212              : 
     213              :       INTEGER                                            :: i
     214              : 
     215         3964 :       IF (ASSOCIATED(sep)) THEN
     216         3964 :          CALL deallocate_sto_basis_set(sep%basis)
     217         3964 :          CALL semi_empirical_mpole_p_release(sep%w_mpole)
     218         3964 :          IF (ASSOCIATED(sep%beta)) THEN
     219         3964 :             DEALLOCATE (sep%beta)
     220              :          END IF
     221         3964 :          IF (ASSOCIATED(sep%sto_exponents)) THEN
     222         3964 :             DEALLOCATE (sep%sto_exponents)
     223              :          END IF
     224         3964 :          IF (ASSOCIATED(sep%zn)) THEN
     225         3964 :             DEALLOCATE (sep%zn)
     226              :          END IF
     227         3964 :          IF (ASSOCIATED(sep%w)) THEN
     228         3964 :             DEALLOCATE (sep%w)
     229              :          END IF
     230         3964 :          IF (ASSOCIATED(sep%expns3_int)) THEN
     231            0 :             DO i = 1, SIZE(sep%expns3_int)
     232            0 :                CALL semi_empirical_expns3_release(sep%expns3_int(i)%expns3)
     233              :             END DO
     234            0 :             DEALLOCATE (sep%expns3_int)
     235              :          END IF
     236         3964 :          DEALLOCATE (sep)
     237              :       END IF
     238              : 
     239         3964 :    END SUBROUTINE semi_empirical_release
     240              : 
     241              : ! **************************************************************************************************
     242              : !> \brief Zero the whole semi-empirical type
     243              : !> \param sep ...
     244              : ! **************************************************************************************************
     245         3964 :    SUBROUTINE zero_se_param(sep)
     246              :       TYPE(semi_empirical_type), POINTER                 :: sep
     247              : 
     248         3964 :       CPASSERT(ASSOCIATED(sep))
     249         3964 :       sep%defined = .FALSE.
     250         3964 :       sep%dorb = .FALSE.
     251         3964 :       sep%extended_basis_set = .FALSE.
     252         3964 :       sep%p_orbitals_on_h = .FALSE.
     253         3964 :       sep%name = ""
     254         3964 :       sep%typ = HUGE(0)
     255         3964 :       sep%core_size = HUGE(0)
     256         3964 :       sep%atm_int_size = HUGE(0)
     257         3964 :       sep%z = HUGE(0)
     258         3964 :       sep%zeff = HUGE(0.0_dp)
     259         3964 :       sep%natorb = 0
     260         3964 :       sep%ngauss = 0
     261         3964 :       sep%eheat = HUGE(0.0_dp)
     262              : 
     263        19820 :       sep%zn = 0.0_dp
     264        19820 :       sep%sto_exponents = 0.0_dp
     265        19820 :       sep%beta = 0.0_dp
     266              : 
     267         3964 :       sep%uss = 0.0_dp !eV
     268         3964 :       sep%upp = 0.0_dp !eV
     269         3964 :       sep%udd = 0.0_dp !eV
     270         3964 :       sep%uff = 0.0_dp
     271         3964 :       sep%alp = 0.0_dp
     272         3964 :       sep%eisol = 0.0_dp
     273         3964 :       sep%nr = 1
     274         3964 :       sep%acoul = 0.0_dp
     275         3964 :       sep%de = 0.0_dp
     276         3964 :       sep%ass = 0.0_dp
     277         3964 :       sep%asp = 0.0_dp
     278         3964 :       sep%app = 0.0_dp
     279         3964 :       sep%gss = 0.0_dp
     280         3964 :       sep%gsp = 0.0_dp
     281         3964 :       sep%gpp = 0.0_dp
     282         3964 :       sep%gp2 = 0.0_dp
     283         3964 :       sep%gsd = 0.0_dp
     284         3964 :       sep%gpd = 0.0_dp
     285         3964 :       sep%gdd = 0.0_dp
     286         3964 :       sep%hsp = 0.0_dp
     287         3964 :       sep%dd = 0.0_dp
     288         3964 :       sep%qq = 0.0_dp
     289         3964 :       sep%am = 0.0_dp
     290         3964 :       sep%ad = 0.0_dp
     291         3964 :       sep%aq = 0.0_dp
     292              : 
     293        19820 :       sep%fn1 = 0.0_dp
     294        19820 :       sep%fn2 = 0.0_dp
     295        19820 :       sep%fn3 = 0.0_dp
     296        83244 :       sep%bfn1 = 0.0_dp
     297        83244 :       sep%bfn2 = 0.0_dp
     298        83244 :       sep%bfn3 = 0.0_dp
     299              : 
     300        11892 :       sep%pre = 0.0_dp
     301        11892 :       sep%d = 0.0_dp
     302              : 
     303       463788 :       sep%xab = 0.0_dp
     304       463788 :       sep%aab = 0.0_dp
     305         3964 :       sep%a = 0.0_dp
     306         3964 :       sep%b = 0.0_dp
     307         3964 :       sep%c = 0.0_dp
     308         3964 :       sep%rho = 0.0_dp
     309              : 
     310         3964 :       sep%f0dd = 0.0_dp
     311         3964 :       sep%f2dd = 0.0_dp
     312         3964 :       sep%f4dd = 0.0_dp
     313         3964 :       sep%f0sd = 0.0_dp
     314         3964 :       sep%f0pd = 0.0_dp
     315         3964 :       sep%f2pd = 0.0_dp
     316         3964 :       sep%g1pd = 0.0_dp
     317         3964 :       sep%g2sd = 0.0_dp
     318         3964 :       sep%g3pd = 0.0_dp
     319        39640 :       sep%ko = 0.0_dp
     320        27748 :       sep%cs = 0.0_dp
     321       210092 :       sep%onec2el = 0.0_dp
     322              : 
     323         3964 :    END SUBROUTINE zero_se_param
     324              : 
     325              : ! **************************************************************************************************
     326              : !> \brief Get info from the semi-empirical type
     327              : !> \param sep ...
     328              : !> \param name ...
     329              : !> \param typ ...
     330              : !> \param defined ...
     331              : !> \param z ...
     332              : !> \param zeff ...
     333              : !> \param natorb ...
     334              : !> \param eheat ...
     335              : !> \param beta ...
     336              : !> \param sto_exponents ...
     337              : !> \param uss ...
     338              : !> \param upp ...
     339              : !> \param udd ...
     340              : !> \param uff ...
     341              : !> \param alp ...
     342              : !> \param eisol ...
     343              : !> \param gss ...
     344              : !> \param gsp ...
     345              : !> \param gpp ...
     346              : !> \param gp2 ...
     347              : !> \param acoul ...
     348              : !> \param nr ...
     349              : !> \param de ...
     350              : !> \param ass ...
     351              : !> \param asp ...
     352              : !> \param app ...
     353              : !> \param hsp ...
     354              : !> \param gsd ...
     355              : !> \param gpd ...
     356              : !> \param gdd ...
     357              : !> \param ppddg ...
     358              : !> \param dpddg ...
     359              : !> \param ngauss ...
     360              : ! **************************************************************************************************
     361       260347 :    SUBROUTINE get_se_param(sep, name, typ, defined, z, zeff, natorb, eheat, &
     362              :                            beta, sto_exponents, uss, upp, udd, uff, alp, eisol, gss, gsp, gpp, gp2, &
     363              :                            acoul, nr, de, ass, asp, app, hsp, gsd, gpd, gdd, ppddg, dpddg, ngauss)
     364              : 
     365              :       TYPE(semi_empirical_type), POINTER                 :: sep
     366              :       CHARACTER(LEN=default_string_length), &
     367              :          INTENT(OUT), OPTIONAL                           :: name
     368              :       INTEGER, INTENT(OUT), OPTIONAL                     :: typ
     369              :       LOGICAL, INTENT(OUT), OPTIONAL                     :: defined
     370              :       INTEGER, INTENT(OUT), OPTIONAL                     :: z
     371              :       REAL(KIND=dp), INTENT(OUT), OPTIONAL               :: zeff
     372              :       INTEGER, INTENT(OUT), OPTIONAL                     :: natorb
     373              :       REAL(KIND=dp), OPTIONAL                            :: eheat
     374              :       REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER     :: beta, sto_exponents
     375              :       REAL(KIND=dp), OPTIONAL                            :: uss, upp, udd, uff, alp, eisol, gss, &
     376              :                                                             gsp, gpp, gp2, acoul
     377              :       INTEGER, INTENT(OUT), OPTIONAL                     :: nr
     378              :       REAL(KIND=dp), OPTIONAL                            :: de, ass, asp, app, hsp, gsd, gpd, gdd
     379              :       REAL(KIND=dp), DIMENSION(2), OPTIONAL              :: ppddg, dpddg
     380              :       INTEGER, INTENT(OUT), OPTIONAL                     :: ngauss
     381              : 
     382       260347 :       IF (ASSOCIATED(sep)) THEN
     383       260347 :          IF (PRESENT(name)) name = sep%name
     384       260347 :          IF (PRESENT(typ)) typ = sep%typ
     385       260347 :          IF (PRESENT(defined)) defined = sep%defined
     386       260347 :          IF (PRESENT(z)) z = sep%z
     387       260347 :          IF (PRESENT(zeff)) zeff = sep%zeff
     388       260347 :          IF (PRESENT(natorb)) natorb = sep%natorb
     389       260347 :          IF (PRESENT(eheat)) eheat = sep%eheat
     390       260347 :          IF (PRESENT(beta)) beta => sep%beta
     391       260347 :          IF (PRESENT(sto_exponents)) sto_exponents => sep%sto_exponents
     392       260347 :          IF (PRESENT(ngauss)) ngauss = sep%ngauss
     393       260347 :          IF (PRESENT(uss)) uss = sep%uss
     394       260347 :          IF (PRESENT(upp)) upp = sep%upp
     395       260347 :          IF (PRESENT(udd)) udd = sep%udd
     396       260347 :          IF (PRESENT(uff)) uff = sep%uff
     397       260347 :          IF (PRESENT(alp)) alp = sep%alp
     398       260347 :          IF (PRESENT(eisol)) eisol = sep%eisol
     399       260347 :          IF (PRESENT(nr)) nr = sep%nr
     400       260347 :          IF (PRESENT(acoul)) acoul = sep%acoul
     401       260347 :          IF (PRESENT(de)) de = sep%de
     402       260347 :          IF (PRESENT(ass)) ass = sep%ass
     403       260347 :          IF (PRESENT(asp)) asp = sep%asp
     404       260347 :          IF (PRESENT(app)) app = sep%app
     405       260347 :          IF (PRESENT(gss)) gss = sep%gss
     406       260347 :          IF (PRESENT(gsp)) gsp = sep%gsp
     407       260347 :          IF (PRESENT(gpp)) gpp = sep%gpp
     408       260347 :          IF (PRESENT(gp2)) gp2 = sep%gp2
     409       260347 :          IF (PRESENT(hsp)) hsp = sep%hsp
     410       260347 :          IF (PRESENT(gsd)) gsd = sep%gsd
     411       260347 :          IF (PRESENT(gpd)) gpd = sep%gpd
     412       260347 :          IF (PRESENT(gdd)) gdd = sep%gdd
     413       260425 :          IF (PRESENT(ppddg)) ppddg = sep%pre
     414       260425 :          IF (PRESENT(dpddg)) dpddg = sep%d
     415              :       ELSE
     416            0 :          CPABORT("The pointer sep is not associated")
     417              :       END IF
     418              : 
     419       260347 :    END SUBROUTINE get_se_param
     420              : 
     421              : ! **************************************************************************************************
     422              : !> \brief Set info from the semi-empirical type
     423              : !> \param sep ...
     424              : !> \param name ...
     425              : !> \param typ ...
     426              : !> \param defined ...
     427              : !> \param z ...
     428              : !> \param zeff ...
     429              : !> \param natorb ...
     430              : !> \param eheat ...
     431              : !> \param beta ...
     432              : !> \param sto_exponents ...
     433              : !> \param uss ...
     434              : !> \param upp ...
     435              : !> \param udd ...
     436              : !> \param uff ...
     437              : !> \param alp ...
     438              : !> \param eisol ...
     439              : !> \param gss ...
     440              : !> \param gsp ...
     441              : !> \param gpp ...
     442              : !> \param gp2 ...
     443              : !> \param acoul ...
     444              : !> \param nr ...
     445              : !> \param de ...
     446              : !> \param ass ...
     447              : !> \param asp ...
     448              : !> \param app ...
     449              : !> \param hsp ...
     450              : !> \param gsd ...
     451              : !> \param gpd ...
     452              : !> \param gdd ...
     453              : !> \param ppddg ...
     454              : !> \param dpddg ...
     455              : !> \param ngauss ...
     456              : ! **************************************************************************************************
     457            0 :    SUBROUTINE set_se_param(sep, name, typ, defined, z, zeff, natorb, eheat, &
     458            0 :                            beta, sto_exponents, uss, upp, udd, uff, alp, eisol, gss, gsp, gpp, gp2, &
     459              :                            acoul, nr, de, ass, asp, app, hsp, gsd, gpd, gdd, ppddg, dpddg, ngauss)
     460              : 
     461              :       TYPE(semi_empirical_type), POINTER                 :: sep
     462              :       CHARACTER(LEN=default_string_length), INTENT(IN), &
     463              :          OPTIONAL                                        :: name
     464              :       INTEGER, INTENT(IN), OPTIONAL                      :: typ
     465              :       LOGICAL, INTENT(IN), OPTIONAL                      :: defined
     466              :       INTEGER, INTENT(IN), OPTIONAL                      :: z
     467              :       REAL(KIND=dp), INTENT(IN), OPTIONAL                :: zeff
     468              :       INTEGER, INTENT(IN), OPTIONAL                      :: natorb
     469              :       REAL(KIND=dp), OPTIONAL                            :: eheat
     470              :       REAL(dp), DIMENSION(0:), OPTIONAL                  :: beta
     471              :       REAL(KIND=dp), DIMENSION(:), OPTIONAL              :: sto_exponents
     472              :       REAL(KIND=dp), OPTIONAL                            :: uss, upp, udd, uff, alp, eisol, gss, &
     473              :                                                             gsp, gpp, gp2, acoul
     474              :       INTEGER, INTENT(IN), OPTIONAL                      :: nr
     475              :       REAL(KIND=dp), OPTIONAL                            :: de, ass, asp, app, hsp, gsd, gpd, gdd
     476              :       REAL(dp), DIMENSION(2), OPTIONAL                   :: ppddg, dpddg
     477              :       INTEGER, INTENT(IN), OPTIONAL                      :: ngauss
     478              : 
     479            0 :       IF (ASSOCIATED(sep)) THEN
     480            0 :          IF (PRESENT(name)) sep%name = name
     481            0 :          IF (PRESENT(typ)) sep%typ = typ
     482            0 :          IF (PRESENT(defined)) sep%defined = defined
     483            0 :          IF (PRESENT(z)) sep%z = z
     484            0 :          IF (PRESENT(zeff)) sep%zeff = zeff
     485            0 :          IF (PRESENT(natorb)) sep%natorb = natorb
     486            0 :          IF (PRESENT(eheat)) sep%eheat = eheat
     487            0 :          IF (PRESENT(beta)) sep%beta = beta
     488            0 :          IF (PRESENT(sto_exponents)) sep%sto_exponents = sto_exponents
     489            0 :          IF (PRESENT(ngauss)) sep%ngauss = ngauss
     490            0 :          IF (PRESENT(uss)) sep%uss = uss
     491            0 :          IF (PRESENT(upp)) sep%upp = upp
     492            0 :          IF (PRESENT(udd)) sep%udd = udd
     493            0 :          IF (PRESENT(uff)) sep%uff = uff
     494            0 :          IF (PRESENT(alp)) sep%alp = alp
     495            0 :          IF (PRESENT(eisol)) sep%eisol = eisol
     496            0 :          IF (PRESENT(acoul)) sep%acoul = acoul
     497            0 :          IF (PRESENT(nr)) sep%nr = nr
     498            0 :          IF (PRESENT(de)) sep%de = de
     499            0 :          IF (PRESENT(ass)) sep%ass = ass
     500            0 :          IF (PRESENT(asp)) sep%asp = asp
     501            0 :          IF (PRESENT(app)) sep%app = app
     502            0 :          IF (PRESENT(gss)) sep%gss = gss
     503            0 :          IF (PRESENT(gsp)) sep%gsp = gsp
     504            0 :          IF (PRESENT(gpp)) sep%gpp = gpp
     505            0 :          IF (PRESENT(gp2)) sep%gp2 = gp2
     506            0 :          IF (PRESENT(hsp)) sep%hsp = hsp
     507            0 :          IF (PRESENT(gsd)) sep%gsd = gsd
     508            0 :          IF (PRESENT(gpd)) sep%gpd = gpd
     509            0 :          IF (PRESENT(gdd)) sep%gdd = gdd
     510            0 :          IF (PRESENT(ppddg)) sep%pre = ppddg
     511            0 :          IF (PRESENT(dpddg)) sep%d = dpddg
     512              :       ELSE
     513            0 :          CPABORT("The pointer sep is not associated")
     514              :       END IF
     515              : 
     516            0 :    END SUBROUTINE set_se_param
     517              : 
     518              : ! **************************************************************************************************
     519              : !> \brief Creates rotmat type
     520              : !> \param rotmat ...
     521              : ! **************************************************************************************************
     522     17364991 :    SUBROUTINE rotmat_create(rotmat)
     523              :       TYPE(rotmat_type), POINTER                         :: rotmat
     524              : 
     525     17364991 :       CPASSERT(.NOT. ASSOCIATED(rotmat))
     526  62288222717 :       ALLOCATE (rotmat)
     527              : 
     528     17364991 :    END SUBROUTINE rotmat_create
     529              : 
     530              : ! **************************************************************************************************
     531              : !> \brief Releases rotmat type
     532              : !> \param rotmat ...
     533              : ! **************************************************************************************************
     534     17364991 :    SUBROUTINE rotmat_release(rotmat)
     535              :       TYPE(rotmat_type), POINTER                         :: rotmat
     536              : 
     537     17364991 :       IF (ASSOCIATED(rotmat)) THEN
     538     17364991 :          DEALLOCATE (rotmat)
     539              :       END IF
     540              : 
     541     17364991 :    END SUBROUTINE rotmat_release
     542              : 
     543              : ! **************************************************************************************************
     544              : !> \brief Setup the Semiempirical integral control type
     545              : !> \param se_int_control ...
     546              : !> \param shortrange ...
     547              : !> \param do_ewald_r3 ...
     548              : !> \param do_ewald_gks ...
     549              : !> \param integral_screening ...
     550              : !> \param max_multipole ...
     551              : !> \param pc_coulomb_int ...
     552              : !> \author Teodoro Laino [tlaino] - 12.2008
     553              : ! **************************************************************************************************
     554     24988443 :    SUBROUTINE setup_se_int_control_type(se_int_control, shortrange, do_ewald_r3, &
     555              :                                         do_ewald_gks, integral_screening, max_multipole, pc_coulomb_int)
     556              :       TYPE(se_int_control_type)                          :: se_int_control
     557              :       LOGICAL, INTENT(IN)                                :: shortrange, do_ewald_r3, do_ewald_gks
     558              :       INTEGER, INTENT(IN)                                :: integral_screening, max_multipole
     559              :       LOGICAL, INTENT(IN)                                :: pc_coulomb_int
     560              : 
     561     24988443 :       se_int_control%shortrange = shortrange
     562     24988443 :       se_int_control%do_ewald_r3 = do_ewald_r3
     563     24988443 :       se_int_control%integral_screening = integral_screening
     564              :       ! This makes the assignment independent of the value of the different constants
     565     49974262 :       SELECT CASE (max_multipole)
     566              :       CASE (do_multipole_none)
     567     24985819 :          se_int_control%max_multipole = -1
     568              :       CASE (do_multipole_charge)
     569            0 :          se_int_control%max_multipole = 0
     570              :       CASE (do_multipole_dipole)
     571            0 :          se_int_control%max_multipole = 1
     572              :       CASE (do_multipole_quadrupole)
     573     24988443 :          se_int_control%max_multipole = 2
     574              :       END SELECT
     575              : 
     576     24988443 :       se_int_control%do_ewald_gks = do_ewald_gks
     577     24988443 :       se_int_control%pc_coulomb_int = pc_coulomb_int
     578     24988443 :       NULLIFY (se_int_control%ewald_gks%dg, se_int_control%ewald_gks%pw_pool)
     579              : 
     580     24988443 :    END SUBROUTINE setup_se_int_control_type
     581              : 
     582              : ! **************************************************************************************************
     583              : !> \brief Creates the taper type used in SE calculations
     584              : !> \param se_taper ...
     585              : !> \param integral_screening ...
     586              : !> \param do_ewald ...
     587              : !> \param taper_cou ...
     588              : !> \param range_cou ...
     589              : !> \param taper_exc ...
     590              : !> \param range_exc ...
     591              : !> \param taper_scr ...
     592              : !> \param range_scr ...
     593              : !> \param taper_lrc ...
     594              : !> \param range_lrc ...
     595              : !> \author Teodoro Laino [tlaino] - 03.2009
     596              : ! **************************************************************************************************
     597          998 :    SUBROUTINE se_taper_create(se_taper, integral_screening, do_ewald, &
     598              :                               taper_cou, range_cou, taper_exc, range_exc, taper_scr, range_scr, &
     599              :                               taper_lrc, range_lrc)
     600              :       TYPE(se_taper_type), POINTER                       :: se_taper
     601              :       INTEGER, INTENT(IN)                                :: integral_screening
     602              :       LOGICAL, INTENT(IN)                                :: do_ewald
     603              :       REAL(KIND=dp), INTENT(IN)                          :: taper_cou, range_cou, taper_exc, &
     604              :                                                             range_exc, taper_scr, range_scr, &
     605              :                                                             taper_lrc, range_lrc
     606              : 
     607          998 :       CPASSERT(.NOT. ASSOCIATED(se_taper))
     608          998 :       ALLOCATE (se_taper)
     609              :       NULLIFY (se_taper%taper)
     610              :       NULLIFY (se_taper%taper_cou)
     611              :       NULLIFY (se_taper%taper_exc)
     612              :       NULLIFY (se_taper%taper_lrc)
     613              :       NULLIFY (se_taper%taper_add)
     614              :       ! Create the sub-typo taper
     615          998 :       CALL taper_create(se_taper%taper_cou, taper_cou, range_cou)
     616          998 :       CALL taper_create(se_taper%taper_exc, taper_exc, range_exc)
     617          998 :       IF (integral_screening == do_se_IS_kdso_d) THEN
     618           14 :          CALL taper_create(se_taper%taper_add, taper_scr, range_scr)
     619              :       END IF
     620          998 :       IF ((integral_screening /= do_se_IS_slater) .AND. do_ewald) THEN
     621           20 :          CALL taper_create(se_taper%taper_lrc, taper_lrc, range_lrc)
     622              :       END IF
     623          998 :    END SUBROUTINE se_taper_create
     624              : 
     625              : ! **************************************************************************************************
     626              : !> \brief Releases the taper type used in SE calculations
     627              : !> \param se_taper ...
     628              : !> \author Teodoro Laino [tlaino] - 03.2009
     629              : ! **************************************************************************************************
     630         1996 :    SUBROUTINE se_taper_release(se_taper)
     631              :       TYPE(se_taper_type), POINTER                       :: se_taper
     632              : 
     633         1996 :       IF (ASSOCIATED(se_taper)) THEN
     634          998 :          CALL taper_release(se_taper%taper_cou)
     635          998 :          CALL taper_release(se_taper%taper_exc)
     636          998 :          CALL taper_release(se_taper%taper_lrc)
     637          998 :          CALL taper_release(se_taper%taper_add)
     638              : 
     639          998 :          DEALLOCATE (se_taper)
     640              :       END IF
     641         1996 :    END SUBROUTINE se_taper_release
     642              : 
     643              : ! **************************************************************************************************
     644              : !> \brief Writes the semi-empirical type
     645              : !> \param sep ...
     646              : !> \param subsys_section ...
     647              : !> \par History
     648              : !>        04.2008 Teodoro Laino [tlaino] - University of Zurich: rewriting with
     649              : !>                support for the whole set of parameters
     650              : ! **************************************************************************************************
     651         2240 :    SUBROUTINE write_se_param(sep, subsys_section)
     652              : 
     653              :       TYPE(semi_empirical_type), POINTER                 :: sep
     654              :       TYPE(section_vals_type), POINTER                   :: subsys_section
     655              : 
     656              :       CHARACTER(LEN=1), DIMENSION(0:3), PARAMETER :: orb_lab = (/"S", "P", "D", "F"/)
     657              :       CHARACTER(LEN=2), DIMENSION(0:3), PARAMETER :: z_lab = (/"ZS", "ZP", "ZD", "ZF"/)
     658              :       CHARACTER(LEN=3), DIMENSION(0:3), PARAMETER :: zeta_lab = (/"ZSN", "ZPN", "ZDN", "ZFN"/)
     659              :       CHARACTER(LEN=5), DIMENSION(0:3), PARAMETER :: &
     660              :          beta_lab = (/"BETAS", "BETAP", "BETAD", "BETAF"/)
     661              :       CHARACTER(LEN=default_string_length)               :: i_string, name
     662              :       INTEGER                                            :: i, l, natorb, ngauss, nr, output_unit, &
     663              :                                                             typ, z
     664              :       LOGICAL                                            :: defined
     665              :       REAL(KIND=dp)                                      :: acoul, alp, app, asp, ass, de, eheat, &
     666              :                                                             eisol, gp2, gpp, gsp, gss, hsp, udd, &
     667              :                                                             uff, upp, uss, zeff
     668              :       CHARACTER(LEN=3), DIMENSION(0:3), PARAMETER :: u_lab = (/"USS", "UPP", "UDD", "UFF"/)
     669              : 
     670              :       REAL(KIND=dp), DIMENSION(0:3)                      :: u
     671              :       REAL(KIND=dp), DIMENSION(2)                        :: dpddg, ppddg
     672         2240 :       REAL(KIND=dp), DIMENSION(:), POINTER               :: beta, sexp
     673              :       TYPE(cp_logger_type), POINTER                      :: logger
     674              : 
     675         2240 :       NULLIFY (logger)
     676         4480 :       logger => cp_get_default_logger()
     677         2240 :       IF (ASSOCIATED(sep) .AND. BTEST(cp_print_key_should_output(logger%iter_info, subsys_section, &
     678              :                                                                  "PRINT%KINDS/SE_PARAMETERS"), cp_p_file)) THEN
     679              : 
     680              :          output_unit = cp_print_key_unit_nr(logger, subsys_section, "PRINT%KINDS/SE_PARAMETERS", &
     681           78 :                                             extension=".Log")
     682              : 
     683           78 :          IF (output_unit > 0) THEN
     684              :             CALL get_se_param(sep, name=name, typ=typ, defined=defined, &
     685              :                               z=z, zeff=zeff, natorb=natorb, eheat=eheat, beta=beta, &
     686              :                               sto_exponents=sexp, uss=uss, upp=upp, udd=udd, uff=uff, &
     687              :                               alp=alp, eisol=eisol, gss=gss, gsp=gsp, gpp=gpp, gp2=gp2, &
     688              :                               de=de, ass=ass, asp=asp, app=app, hsp=hsp, ppddg=ppddg, &
     689           39 :                               acoul=acoul, nr=nr, dpddg=dpddg, ngauss=ngauss)
     690              : 
     691           39 :             u(0) = uss
     692           39 :             u(1) = upp
     693           39 :             u(2) = udd
     694           39 :             u(3) = uff
     695              : 
     696            0 :             SELECT CASE (typ)
     697              :             CASE DEFAULT
     698            0 :                CPABORT("Semiempirical method unknown")
     699              :             CASE (do_method_am1)
     700              :                WRITE (UNIT=output_unit, FMT="(/,A,T35,A,T67,A14)") &
     701            0 :                   " Semi empirical parameters: ", "Austin Model 1 (AM1)", TRIM(name)
     702              :             CASE (do_method_rm1)
     703              :                WRITE (UNIT=output_unit, FMT="(/,A,T35,A,T67,A14)") &
     704            0 :                   " Semi empirical parameters: ", "Recife Model 1 (RM1)", TRIM(name)
     705              :             CASE (do_method_pm3)
     706              :                WRITE (UNIT=output_unit, FMT="(/,A,T35,A,T67,A14)") &
     707            0 :                   " Semi empirical parameters: ", "Parametric Method 3 (PM3) ", TRIM(name)
     708              :             CASE (do_method_pnnl)
     709              :                WRITE (UNIT=output_unit, FMT="(/,A,T35,A,T67,A14)") &
     710            0 :                   " Semi empirical parameters: ", "PNNL method ", TRIM(name)
     711              :             CASE (do_method_pm6)
     712              :                WRITE (UNIT=output_unit, FMT="(/,A,T35,A,T67,A14)") &
     713           27 :                   " Semi empirical parameters: ", "Parametric Method 6 (PM6) ", TRIM(name)
     714              :             CASE (do_method_pm6fm)
     715              :                WRITE (UNIT=output_unit, FMT="(/,A,T35,A,T67,A14)") &
     716            0 :                   " Semi empirical parameters: ", "Parametric Method 6 (PM6-FM) ", TRIM(name)
     717              :             CASE (do_method_pdg)
     718              :                WRITE (UNIT=output_unit, FMT="(/,A,T35,A,T67,A14)") &
     719            0 :                   " Semi empirical parameters: ", "PDDG/PM3 ", TRIM(name)
     720              :             CASE (do_method_mndo)
     721              :                WRITE (UNIT=output_unit, FMT="(/,A,T35,A,T67,A14)") &
     722            0 :                   " Semi empirical parameters: ", "MNDO ", TRIM(name)
     723              :             CASE (do_method_mndod)
     724              :                WRITE (UNIT=output_unit, FMT="(/,A,T35,A,T67,A14)") &
     725           39 :                   " Semi empirical parameters: ", "MNDOD", TRIM(name)
     726              :             END SELECT
     727              : 
     728              :             ! If defined print all its semi-empirical parameters
     729           39 :             IF (defined) THEN
     730              :                WRITE (UNIT=output_unit, FMT="(T16,A,T71,F10.2)") &
     731           39 :                   "Effective core charge:", zeff
     732              :                WRITE (UNIT=output_unit, FMT="(T16,A,T71,I10)") &
     733           39 :                   "Number of orbitals:", natorb, &
     734           78 :                   "Basis set expansion (STO-NG)", ngauss
     735              :                WRITE (UNIT=output_unit, FMT="(T16,A,T66,F15.5)") &
     736           39 :                   "Atomic heat of formation [kcal/mol]:", eheat*kcalmol
     737          195 :                DO l = 0, 3
     738          195 :                   IF (ABS(beta(l)) > 0._dp) THEN
     739           83 :                      WRITE (UNIT=output_unit, FMT="(T16,A,I2)") "Parameters for Shell: ", l
     740              :                      WRITE (UNIT=output_unit, FMT="(T22,A5,T30,A,T64,F17.4)") &
     741           83 :                         ADJUSTR(z_lab(l)), "- "//"Slater  Exponent for "//orb_lab(l)//"     [A]: ", sexp(l)
     742              :                      WRITE (UNIT=output_unit, FMT="(T22,A5,T30,A,T64,F17.4)") &
     743           83 :                         ADJUSTR(u_lab(l)), "- "//"One Center Energy for "//orb_lab(l)//"   [eV]: ", u(l)*evolt
     744              :                      WRITE (UNIT=output_unit, FMT="(T22,A5,T30,A,T64,F17.4)") &
     745           83 :                         ADJUSTR(beta_lab(l)), "- "//"Beta Parameter for "//orb_lab(l)//"      [eV]: ", beta(l)*evolt
     746              :                      WRITE (UNIT=output_unit, FMT="(T22,A5,T30,A,T64,F17.4)") &
     747           83 :                         ADJUSTR(zeta_lab(l)), "- "//"Internal Exponent for "//orb_lab(l)//" [a.u.]: ", sep%zn(l)
     748              :                   END IF
     749              :                END DO
     750           39 :                WRITE (UNIT=output_unit, FMT="(/,T16,A)") "Additional Parameters (Derived or Fitted):"
     751              :                WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     752           39 :                   ADJUSTR("ALP"), "- "//"Alpha Parameter for Core    [A^-1]: ", alp/angstrom
     753              :                WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     754           39 :                   ADJUSTR("EISOL"), "- "//"Atomic Energy (Calculated)    [eV]: ", eisol*evolt
     755              :                ! One center Two electron Integrals
     756              :                WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     757           39 :                   ADJUSTR("GSS"), "- "//"One Center Integral (SS ,SS ) [eV]: ", gss*evolt
     758              :                WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     759           39 :                   ADJUSTR("GSP"), "- "//"One Center Integral (SS ,PP ) [eV]: ", gsp*evolt
     760              :                WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     761           39 :                   ADJUSTR("GPP"), "- "//"One Center Integral (PP ,PP ) [eV]: ", gpp*evolt
     762              :                WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     763           39 :                   ADJUSTR("GP2"), "- "//"One Center Integral (PP*,PP*) [eV]: ", gp2*evolt
     764              :                WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     765           39 :                   ADJUSTR("HSP"), "- "//"One Center Integral (SP ,SP ) [eV]: ", hsp*evolt
     766              :                ! Slater Condon Parameters
     767           39 :                IF (sep%dorb) THEN
     768              :                   WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     769           17 :                      ADJUSTR("F0DD"), "- "//"Slater Condon Parameter F0DD  [eV]: ", sep%f0dd
     770              :                   WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     771           17 :                      ADJUSTR("F2DD"), "- "//"Slater Condon Parameter F2DD  [eV]: ", sep%f2dd
     772              :                   WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     773           17 :                      ADJUSTR("F4DD"), "- "//"Slater Condon Parameter F4DD  [eV]: ", sep%f4dd
     774              :                   WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     775           17 :                      ADJUSTR("FOSD"), "- "//"Slater Condon Parameter FOSD  [eV]: ", sep%f0sd
     776              :                   WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     777           17 :                      ADJUSTR("G2SD"), "- "//"Slater Condon Parameter G2SD  [eV]: ", sep%g2sd
     778              :                   WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     779           17 :                      ADJUSTR("F0PD"), "- "//"Slater Condon Parameter F0PD  [eV]: ", sep%f0pd
     780              :                   WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     781           17 :                      ADJUSTR("F2PD"), "- "//"Slater Condon Parameter F2PD  [eV]: ", sep%f2pd
     782              :                   WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     783           17 :                      ADJUSTR("G1PD"), "- "//"Slater Condon Parameter G1PD  [eV]: ", sep%g1pd
     784              :                   WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     785           17 :                      ADJUSTR("G3PD"), "- "//"Slater Condon Parameter G3PD  [eV]: ", sep%g3pd
     786              :                END IF
     787              :                ! Charge Separation
     788              :                WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     789           39 :                   ADJUSTR("DD2"), "- "//"Charge Separation  SP, L=1  [bohr]: ", sep%cs(2)
     790              :                WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     791           39 :                   ADJUSTR("DD3"), "- "//"Charge Separation  PP, L=2  [bohr]: ", sep%cs(3)
     792           39 :                IF (sep%dorb) THEN
     793              :                   WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     794           17 :                      ADJUSTR("DD4"), "- "//"Charge Separation  SD, L=2  [bohr]: ", sep%cs(4)
     795              :                   WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     796           17 :                      ADJUSTR("DD5"), "- "//"Charge Separation  PD, L=1  [bohr]: ", sep%cs(5)
     797              :                   WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     798           17 :                      ADJUSTR("DD6"), "- "//"Charge Separation  DD, L=2  [bohr]: ", sep%cs(6)
     799              :                END IF
     800              :                ! Klopman-Ohno Terms
     801              :                WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     802           39 :                   ADJUSTR("PO1"), "- "//"Klopman-Ohno term, SS, L=0  [bohr]: ", sep%ko(1)
     803              :                WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     804           39 :                   ADJUSTR("PO2"), "- "//"Klopman-Ohno term, SP, L=1  [bohr]: ", sep%ko(2)
     805              :                WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     806           39 :                   ADJUSTR("PO3"), "- "//"Klopman-Ohno term, PP, L=2  [bohr]: ", sep%ko(3)
     807           39 :                IF (sep%dorb) THEN
     808              :                   WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     809           17 :                      ADJUSTR("PO4"), "- "//"Klopman-Ohno term, SD, L=2  [bohr]: ", sep%ko(4)
     810              :                   WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     811           17 :                      ADJUSTR("PO5"), "- "//"Klopman-Ohno term, PD, L=1  [bohr]: ", sep%ko(5)
     812              :                   WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     813           17 :                      ADJUSTR("PO6"), "- "//"Klopman-Ohno term, DD, L=2  [bohr]: ", sep%ko(6)
     814              :                   WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     815           17 :                      ADJUSTR("PO7"), "- "//"Klopman-Ohno term, PP, L=0  [bohr]: ", sep%ko(7)
     816              :                   WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     817           17 :                      ADJUSTR("PO8"), "- "//"Klopman-Ohno term, DD, L=0  [bohr]: ", sep%ko(8)
     818              :                END IF
     819              :                WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     820           39 :                   ADJUSTR("PO9"), "- "//"Klopman-Ohno term, CORE     [bohr]: ", sep%ko(9)
     821            0 :                SELECT CASE (typ)
     822              :                CASE (do_method_am1, do_method_rm1, do_method_pm3, do_method_pdg, do_method_pnnl)
     823           39 :                   IF (typ == do_method_pnnl) THEN
     824              :                      WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     825            0 :                         ADJUSTR("ASS"), "- "//" SS polarization [au]: ", sep%ass
     826              :                      WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     827            0 :                         ADJUSTR("ASP"), "- "//" SP polarization [au]: ", sep%asp
     828              :                      WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     829            0 :                         ADJUSTR("APP"), "- "//" PP polarization[au]: ", sep%app
     830              :                      WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     831            0 :                         ADJUSTR("DE"), "- "//" Dispersion Parameter [eV]: ", sep%de*evolt
     832              :                      WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     833            0 :                         ADJUSTR("ACOUL"), "- "//" Slater parameter: ", sep%acoul
     834              :                      WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,I12)") &
     835            0 :                         ADJUSTR("NR"), "- "//" Slater parameter: ", sep%nr
     836            0 :                   ELSEIF ((typ == do_method_am1 .OR. typ == do_method_rm1) .AND. sep%z == 5) THEN
     837              :                      ! Standard case
     838            0 :                      DO i = 1, SIZE(sep%bfn1, 1)
     839            0 :                         i_string = cp_to_string(i)
     840              :                         WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     841            0 :                            ADJUSTR("FN1"//TRIM(ADJUSTL(i_string))//"_ALL"), &
     842            0 :                            "- "//"Core-Core VDW, Multiplier   [a.u.]: ", sep%bfn1(i, 1)
     843              :                         WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     844            0 :                            ADJUSTR("FN2"//TRIM(ADJUSTL(i_string))//"_ALL"), &
     845            0 :                            "- "//"Core-Core VDW, Exponent     [a.u.]: ", sep%bfn2(i, 1)
     846              :                         WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     847            0 :                            ADJUSTR("FN3"//TRIM(ADJUSTL(i_string))//"_ALL"), &
     848            0 :                            "- "//"Core-Core VDW, Position     [a.u.]: ", sep%bfn3(i, 1)
     849              :                      END DO
     850              :                      ! Special Case : Hydrogen
     851            0 :                      DO i = 1, SIZE(sep%bfn1, 1)
     852            0 :                         i_string = cp_to_string(i)
     853              :                         WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     854            0 :                            ADJUSTR("FN1"//TRIM(ADJUSTL(i_string))//"_H"), &
     855            0 :                            "- "//"Core-Core VDW, Multiplier   [a.u.]: ", sep%bfn1(i, 2)
     856              :                         WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     857            0 :                            ADJUSTR("FN2"//TRIM(ADJUSTL(i_string))//"_H"), &
     858            0 :                            "- "//"Core-Core VDW, Exponent     [a.u.]: ", sep%bfn2(i, 2)
     859              :                         WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     860            0 :                            ADJUSTR("FN3"//TRIM(ADJUSTL(i_string))//"_H"), &
     861            0 :                            "- "//"Core-Core VDW, Position     [a.u.]: ", sep%bfn3(i, 2)
     862              :                      END DO
     863              :                      ! Special Case : Carbon
     864            0 :                      DO i = 1, SIZE(sep%bfn1, 1)
     865            0 :                         i_string = cp_to_string(i)
     866              :                         WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     867            0 :                            ADJUSTR("FN1"//TRIM(ADJUSTL(i_string))//"_C"), &
     868            0 :                            "- "//"Core-Core VDW, Multiplier   [a.u.]: ", sep%bfn1(i, 3)
     869              :                         WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     870            0 :                            ADJUSTR("FN2"//TRIM(ADJUSTL(i_string))//"_C"), &
     871            0 :                            "- "//"Core-Core VDW, Exponent     [a.u.]: ", sep%bfn2(i, 3)
     872              :                         WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     873            0 :                            ADJUSTR("FN3"//TRIM(ADJUSTL(i_string))//"_C"), &
     874            0 :                            "- "//"Core-Core VDW, Position     [a.u.]: ", sep%bfn3(i, 3)
     875              :                      END DO
     876              :                      ! Special Case : Halogens
     877            0 :                      DO i = 1, SIZE(sep%bfn1, 1)
     878            0 :                         i_string = cp_to_string(i)
     879              :                         WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     880            0 :                            ADJUSTR("FN1"//TRIM(ADJUSTL(i_string))//"_HALO"), &
     881            0 :                            "- "//"Core-Core VDW, Multiplier   [a.u.]: ", sep%bfn1(i, 4)
     882              :                         WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     883            0 :                            ADJUSTR("FN2"//TRIM(ADJUSTL(i_string))//"_HALO"), &
     884            0 :                            "- "//"Core-Core VDW, Exponent     [a.u.]: ", sep%bfn2(i, 4)
     885              :                         WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     886            0 :                            ADJUSTR("FN3"//TRIM(ADJUSTL(i_string))//"_HALO"), &
     887            0 :                            "- "//"Core-Core VDW, Position     [a.u.]: ", sep%bfn3(i, 4)
     888              :                      END DO
     889              :                   ELSE
     890            0 :                      DO i = 1, SIZE(sep%fn1, 1)
     891            0 :                         i_string = cp_to_string(i)
     892              :                         ! Skip the printing of params that are zero..
     893            0 :                         IF (sep%fn1(i) == 0.0_dp .AND. sep%fn2(i) == 0.0_dp .AND. sep%fn3(i) == 0.0_dp) CYCLE
     894              :                         WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     895            0 :                            ADJUSTR("FN1"//TRIM(ADJUSTL(i_string))), &
     896            0 :                            "- "//"Core-Core VDW, Multiplier   [a.u.]: ", sep%fn1(i)
     897              :                         WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     898            0 :                            ADJUSTR("FN2"//TRIM(ADJUSTL(i_string))), &
     899            0 :                            "- "//"Core-Core VDW, Exponent     [a.u.]: ", sep%fn2(i)
     900              :                         WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
     901            0 :                            ADJUSTR("FN3"//TRIM(ADJUSTL(i_string))), &
     902            0 :                            "- "//"Core-Core VDW, Position     [a.u.]: ", sep%fn3(i)
     903              :                      END DO
     904              :                   END IF
     905              :                END SELECT
     906              :             ELSE
     907            0 :                WRITE (UNIT=output_unit, FMT="(T55,A)") "Parameters are not defined"
     908              :             END IF
     909              : 
     910              :             ! Additional Parameters not common to all semi-empirical methods
     911            0 :             SELECT CASE (typ)
     912              :             CASE (do_method_pdg)
     913              :                WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T52,F14.10,T67,F14.10)") &
     914            0 :                   ADJUSTR("d_PDDG"), "- "//"Exponent [A^-1]:", dpddg/angstrom, &
     915           39 :                   ADJUSTR("P_PDDG"), "- "//"Parameter  [eV]:", ppddg*evolt
     916              :             END SELECT
     917              :          END IF
     918              :          CALL cp_print_key_finished_output(output_unit, logger, subsys_section, &
     919           78 :                                            "PRINT%KINDS/SE_PARAMETERS")
     920              :       END IF
     921         2240 :    END SUBROUTINE write_se_param
     922              : 
     923            0 : END MODULE semi_empirical_types
        

Generated by: LCOV version 2.0-1