LCOV - code coverage report
Current view: top level - src - qmmm_gaussian_init.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:42dac4a) Lines: 98.6 % 71 70
Test Date: 2025-07-25 12:55:17 Functions: 100.0 % 1 1

            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 Initialize the use of the gaussians to treat the QMMM
      10              : !>      coupling potential
      11              : !> \par History
      12              : !>      6.2004 created [tlaino]
      13              : !> \author Teodoro Laino
      14              : ! **************************************************************************************************
      15              : MODULE qmmm_gaussian_init
      16              :    USE ao_util,                         ONLY: exp_radius
      17              :    USE cp_log_handling,                 ONLY: cp_get_default_logger,&
      18              :                                               cp_logger_type
      19              :    USE cp_output_handling,              ONLY: cp_print_key_finished_output,&
      20              :                                               cp_print_key_unit_nr
      21              :    USE gaussian_gridlevels,             ONLY: gaussian_gridlevel,&
      22              :                                               gridlevel_info_type
      23              :    USE input_constants,                 ONLY: do_qmmm_gauss,&
      24              :                                               do_qmmm_swave
      25              :    USE input_section_types,             ONLY: section_vals_type,&
      26              :                                               section_vals_val_get
      27              :    USE kinds,                           ONLY: dp
      28              :    USE memory_utilities,                ONLY: reallocate
      29              :    USE message_passing,                 ONLY: mp_para_env_type
      30              :    USE pw_env_types,                    ONLY: pw_env_get,&
      31              :                                               pw_env_type
      32              :    USE pw_pool_types,                   ONLY: pw_pool_p_type
      33              :    USE qmmm_gaussian_data,              ONLY: max_geep_lib_gauss,&
      34              :                                               min_geep_lib_gauss
      35              :    USE qmmm_gaussian_input,             ONLY: read_mm_potential,&
      36              :                                               set_mm_potential_erf,&
      37              :                                               set_mm_potential_swave
      38              :    USE qmmm_gaussian_types,             ONLY: qmmm_gaussian_p_type,&
      39              :                                               qmmm_gaussian_type
      40              : #include "./base/base_uses.f90"
      41              : 
      42              :    IMPLICIT NONE
      43              :    PRIVATE
      44              : 
      45              :    LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
      46              :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qmmm_gaussian_init'
      47              :    PUBLIC :: qmmm_gaussian_initialize
      48              : 
      49              : CONTAINS
      50              : 
      51              : ! **************************************************************************************************
      52              : !> \brief Initialize the Gaussian QMMM Environment
      53              : !> \param qmmm_gaussian_fns ...
      54              : !> \param para_env ...
      55              : !> \param pw_env ...
      56              : !> \param mm_el_pot_radius ...
      57              : !> \param mm_el_pot_radius_corr ...
      58              : !> \param qmmm_coupl_type ...
      59              : !> \param eps_mm_rspace ...
      60              : !> \param maxradius ...
      61              : !> \param maxchrg ...
      62              : !> \param compatibility ...
      63              : !> \param print_section ...
      64              : !> \param qmmm_section ...
      65              : !> \par History
      66              : !>      06.2004 created [tlaino]
      67              : !> \author Teodoro Laino
      68              : ! **************************************************************************************************
      69          808 :    SUBROUTINE qmmm_gaussian_initialize(qmmm_gaussian_fns, para_env, pw_env, &
      70              :                                        mm_el_pot_radius, mm_el_pot_radius_corr, &
      71              :                                        qmmm_coupl_type, eps_mm_rspace, maxradius, maxchrg, compatibility, &
      72              :                                        print_section, qmmm_section)
      73              :       TYPE(qmmm_gaussian_p_type), DIMENSION(:), POINTER  :: qmmm_gaussian_fns
      74              :       TYPE(mp_para_env_type), POINTER                    :: para_env
      75              :       TYPE(pw_env_type), POINTER                         :: pw_env
      76              :       REAL(KIND=dp), DIMENSION(:), POINTER               :: mm_el_pot_radius, mm_el_pot_radius_corr
      77              :       INTEGER, INTENT(IN)                                :: qmmm_coupl_type
      78              :       REAL(KIND=dp), INTENT(IN)                          :: eps_mm_rspace
      79              :       REAL(KIND=dp), DIMENSION(:), POINTER               :: maxradius
      80              :       REAL(KIND=dp), INTENT(IN)                          :: maxchrg
      81              :       LOGICAL, INTENT(IN)                                :: compatibility
      82              :       TYPE(section_vals_type), POINTER                   :: print_section, qmmm_section
      83              : 
      84              :       INTEGER                                            :: i, ilevel, j, Ndim, num_geep_gauss, &
      85              :                                                             output_unit
      86              :       LOGICAL                                            :: Found, use_geep_lib
      87              :       REAL(KIND=dp)                                      :: alpha, mymaxradius, Prefactor
      88          404 :       REAL(KIND=dp), DIMENSION(:), POINTER               :: c_radius, radius
      89              :       TYPE(cp_logger_type), POINTER                      :: logger
      90              :       TYPE(gridlevel_info_type), POINTER                 :: gridlevel_info
      91          404 :       TYPE(pw_pool_p_type), DIMENSION(:), POINTER        :: pools
      92              :       TYPE(qmmm_gaussian_type), POINTER                  :: mypgf
      93              : 
      94              : ! Statements
      95              : 
      96          404 :       NULLIFY (mypgf, gridlevel_info, radius, c_radius, logger)
      97          808 :       logger => cp_get_default_logger()
      98          404 :       CALL section_vals_val_get(qmmm_section, "USE_GEEP_LIB", i_val=num_geep_gauss)
      99          404 :       IF (num_geep_gauss == 0) THEN
     100              :          use_geep_lib = .FALSE.
     101              :       ELSE
     102          200 :          use_geep_lib = .TRUE.
     103          200 :          CPASSERT(num_geep_gauss >= min_geep_lib_gauss)
     104          200 :          CPASSERT(num_geep_gauss <= max_geep_lib_gauss)
     105              :       END IF
     106          662 :       SELECT CASE (qmmm_coupl_type)
     107              :       CASE (do_qmmm_gauss, do_qmmm_swave)
     108              :          !
     109              :          ! Preprocessing...
     110              :          !
     111          258 :          ALLOCATE (radius(1))
     112          258 :          ALLOCATE (c_radius(1))
     113          258 :          Ndim = SIZE(radius)
     114         4188 :          Loop_on_all_values: DO I = 1, SIZE(mm_el_pot_radius)
     115         3930 :             Found = .FALSE.
     116         5232 :             Loop_on_found_values: DO J = 1, SIZE(radius) - 1
     117         5232 :                IF (mm_el_pot_radius(i) .EQ. radius(j)) THEN
     118              :                   Found = .TRUE.
     119              :                   EXIT Loop_on_found_values
     120              :                END IF
     121              :             END DO Loop_on_found_values
     122         4188 :             IF (.NOT. Found) THEN
     123              :                Ndim = SIZE(radius)
     124          428 :                radius(Ndim) = mm_el_pot_radius(i)
     125          428 :                c_radius(Ndim) = mm_el_pot_radius_corr(i)
     126          428 :                Ndim = Ndim + 1
     127          428 :                CALL REALLOCATE(radius, 1, Ndim)
     128          428 :                CALL REALLOCATE(c_radius, 1, Ndim)
     129              :             END IF
     130              :          END DO Loop_on_all_values
     131              :          !
     132          258 :          IF (Ndim - 1 > 0) THEN
     133          256 :             CALL REALLOCATE(radius, 1, Ndim - 1)
     134          256 :             CALL REALLOCATE(c_radius, 1, Ndim - 1)
     135            2 :          ELSE IF (Ndim - 1 == 0) THEN
     136            2 :             DEALLOCATE (radius)
     137            2 :             DEALLOCATE (c_radius)
     138              :          ELSE
     139            0 :             CPABORT("")
     140              :          END IF
     141              :          !
     142         1200 :          ALLOCATE (qmmm_gaussian_fns(Ndim - 1))
     143          686 :          DO I = 1, Ndim - 1
     144          428 :             NULLIFY (qmmm_gaussian_fns(I)%pgf)
     145          428 :             ALLOCATE (qmmm_gaussian_fns(I)%pgf)
     146          428 :             NULLIFY (qmmm_gaussian_fns(I)%pgf%Ak)
     147          428 :             NULLIFY (qmmm_gaussian_fns(I)%pgf%Gk)
     148          428 :             NULLIFY (qmmm_gaussian_fns(I)%pgf%grid_level)
     149              :             !
     150              :             ! Default Values
     151              :             !
     152          428 :             qmmm_gaussian_fns(I)%pgf%Elp_Radius = radius(I)
     153          686 :             qmmm_gaussian_fns(I)%pgf%Elp_Radius_corr = c_radius(I)
     154              :          END DO
     155          258 :          IF (ASSOCIATED(radius)) THEN
     156          256 :             DEALLOCATE (radius)
     157              :          END IF
     158          258 :          IF (ASSOCIATED(c_radius)) THEN
     159          256 :             DEALLOCATE (c_radius)
     160              :          END IF
     161              :          !
     162          258 :          IF (use_geep_lib) THEN
     163          164 :             IF (qmmm_coupl_type == do_qmmm_gauss) THEN
     164              :                CALL set_mm_potential_erf(qmmm_gaussian_fns, &
     165          130 :                                          compatibility, num_geep_gauss)
     166           34 :             ELSEIF (qmmm_coupl_type == do_qmmm_swave) THEN
     167              :                CALL set_mm_potential_swave(qmmm_gaussian_fns, &
     168           34 :                                            num_geep_gauss)
     169              :             END IF
     170              :          ELSE
     171              :             CALL read_mm_potential(para_env, qmmm_gaussian_fns, &
     172          184 :                                    (compatibility .AND. (qmmm_coupl_type == do_qmmm_gauss)), qmmm_section)
     173              :          END IF
     174              :          !
     175          258 :          CALL pw_env_get(pw_env, pw_pools=pools, gridlevel_info=gridlevel_info)
     176          774 :          ALLOCATE (maxradius(SIZE(pools)))
     177         1306 :          maxradius = 0.0_dp
     178          686 :          DO J = 1, SIZE(qmmm_gaussian_fns)
     179          428 :             mypgf => qmmm_gaussian_fns(J)%pgf
     180         1284 :             ALLOCATE (mypgf%grid_level(SIZE(mypgf%Ak)))
     181         3672 :             mypgf%grid_level = 0
     182          428 :             mymaxradius = 0.0_dp
     183         3930 :             DO I = 1, mypgf%number_of_gaussians
     184         3672 :                IF (mypgf%Gk(I) /= 0.0_dp) THEN
     185         3244 :                   alpha = 1.0_dp/mypgf%Gk(I)
     186         3244 :                   alpha = alpha*alpha
     187         3244 :                   ilevel = gaussian_gridlevel(gridlevel_info, alpha)
     188         3244 :                   Prefactor = mypgf%Ak(I)*maxchrg
     189         3244 :                   mymaxradius = exp_radius(0, alpha, eps_mm_rspace, Prefactor, rlow=mymaxradius)
     190         3244 :                   maxradius(ilevel) = MAX(maxradius(ilevel), mymaxradius)
     191         3244 :                   mypgf%grid_level(i) = ilevel
     192              :                END IF
     193              :             END DO
     194              :          END DO
     195              :          !
     196              :          ! End of gaussian initialization...
     197              :       CASE DEFAULT
     198              :          output_unit = cp_print_key_unit_nr(logger, print_section, "PROGRAM_RUN_INFO", &
     199          146 :                                             extension=".qmmmLog")
     200          146 :          IF (output_unit > 0) WRITE (output_unit, '(A)') " QMMM Gaussian Data Not Initialized!"
     201          550 :          CALL cp_print_key_finished_output(output_unit, logger, print_section, "PROGRAM_RUN_INFO")
     202              :       END SELECT
     203          404 :    END SUBROUTINE qmmm_gaussian_initialize
     204              : 
     205              : END MODULE qmmm_gaussian_init
        

Generated by: LCOV version 2.0-1