LCOV - code coverage report
Current view: top level - src - qs_update_s_mstruct.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:a43c040) Lines: 94.1 % 101 95
Test Date: 2026-02-12 06:45:40 Functions: 100.0 % 3 3

            Line data    Source code
       1              : !--------------------------------------------------------------------------------------------------!
       2              : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3              : !   Copyright 2000-2026 CP2K developers group <https://cp2k.org>                                   !
       4              : !                                                                                                  !
       5              : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6              : !--------------------------------------------------------------------------------------------------!
       7              : 
       8              : ! *****************************************************************************
       9              : !> \brief qs_environment methods that use many other modules
      10              : !> \par History
      11              : !>      09.2002 created [fawzi]
      12              : !>      - local atom distribution (25.06.2003,MK)
      13              : !> \author Fawzi Mohamed
      14              : ! *****************************************************************************
      15              : MODULE qs_update_s_mstruct
      16              :    USE cp_control_types,                ONLY: dft_control_type
      17              :    USE cp_ddapc_types,                  ONLY: cp_ddapc_release
      18              :    USE cp_ddapc_util,                   ONLY: cp_ddapc_init
      19              :    USE input_constants,                 ONLY: do_ppl_analytic,&
      20              :                                               do_ppl_grid,&
      21              :                                               kg_tnadd_embed,&
      22              :                                               kg_tnadd_embed_ri
      23              :    USE kinds,                           ONLY: default_string_length,&
      24              :                                               dp
      25              :    USE pw_methods,                      ONLY: pw_transfer
      26              :    USE pw_types,                        ONLY: pw_c1d_gs_type,&
      27              :                                               pw_r3d_rs_type
      28              :    USE qs_collocate_density,            ONLY: calculate_ppl_grid,&
      29              :                                               calculate_rho_core,&
      30              :                                               calculate_rho_nlcc
      31              :    USE qs_environment_types,            ONLY: get_qs_env,&
      32              :                                               qs_environment_type
      33              :    USE qs_ks_types,                     ONLY: get_ks_env,&
      34              :                                               qs_ks_did_change,&
      35              :                                               qs_ks_env_type,&
      36              :                                               set_ks_env
      37              :    USE qs_rho_methods,                  ONLY: qs_rho_rebuild
      38              :    USE qs_rho_types,                    ONLY: qs_rho_type
      39              :    USE qs_scf_types,                    ONLY: scf_env_did_change
      40              :    USE task_list_methods,               ONLY: generate_qs_task_list
      41              :    USE task_list_types,                 ONLY: allocate_task_list,&
      42              :                                               deallocate_task_list,&
      43              :                                               task_list_type
      44              : #include "./base/base_uses.f90"
      45              : 
      46              :    IMPLICIT NONE
      47              :    PRIVATE
      48              : 
      49              :    LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
      50              :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_update_s_mstruct'
      51              : 
      52              :    PUBLIC :: qs_env_update_s_mstruct
      53              : !***
      54              : CONTAINS
      55              : 
      56              : ! *****************************************************************************
      57              : !> \brief updates the s_mstruct to reflect the new overlap structure,
      58              : !>      and also updates rho_core distribution.
      59              : !>      Should be called after the atoms have moved and the new overlap
      60              : !>      has been calculated.
      61              : !> \param qs_env the environment to update
      62              : !> \par History
      63              : !>      07.2002 created [fawzi]
      64              : !> \author Fawzi Mohamed
      65              : ! **************************************************************************************************
      66        23196 :    SUBROUTINE qs_env_update_s_mstruct(qs_env)
      67              :       TYPE(qs_environment_type), POINTER                 :: qs_env
      68              : 
      69              :       CHARACTER(len=*), PARAMETER :: routineN = 'qs_env_update_s_mstruct'
      70              : 
      71              :       INTEGER                                            :: handle, nk
      72              :       LOGICAL                                            :: do_ppl
      73              :       REAL(KIND=dp)                                      :: wtot
      74        23196 :       REAL(KIND=dp), ALLOCATABLE, DIMENSION(:)           :: cw
      75              :       TYPE(dft_control_type), POINTER                    :: dft_control
      76              :       TYPE(pw_c1d_gs_type), POINTER                      :: rho_core, rho_nlcc_g
      77              :       TYPE(pw_r3d_rs_type), POINTER                      :: rho_nlcc, vppl, xcint_weights
      78              : 
      79        23196 :       CALL timeset(routineN, handle)
      80              : 
      81        23196 :       CPASSERT(ASSOCIATED(qs_env))
      82              : 
      83        23196 :       NULLIFY (dft_control)
      84              :       CALL get_qs_env(qs_env, &
      85        23196 :                       dft_control=dft_control)
      86              : 
      87              :       ! *** updates rho core ***
      88        23196 :       NULLIFY (rho_core)
      89        23196 :       CALL get_qs_env(qs_env, rho_core=rho_core)
      90        23196 :       IF (dft_control%qs_control%gapw) THEN
      91         1816 :          qs_env%qs_charges%total_rho_core_rspace = qs_env%local_rho_set%rhoz_tot
      92              :          ! Initial CNEO quantum nuclear charge density is a simple Zeff sum.
      93              :          ! Later it will be calculated from numerical integration during SCF.
      94         1816 :          qs_env%qs_charges%total_rho1_hard_nuc = qs_env%local_rho_set%rhoz_cneo_tot
      95         1816 :          IF (dft_control%qs_control%gapw_control%nopaw_as_gpw) THEN
      96          180 :             CPASSERT(ASSOCIATED(rho_core))
      97              :             CALL calculate_rho_core(rho_core, &
      98          180 :                                     qs_env%qs_charges%total_rho_core_rspace, qs_env, only_nopaw=.TRUE.)
      99              :          ELSE
     100         1636 :             IF (ASSOCIATED(rho_core)) THEN
     101            0 :                CALL rho_core%release()
     102            0 :                DEALLOCATE (rho_core)
     103              :             END IF
     104              :          END IF
     105              :          ! force analytic ppl calculation
     106         1816 :          dft_control%qs_control%do_ppl_method = do_ppl_analytic
     107        21380 :       ELSE IF (dft_control%qs_control%semi_empirical) THEN
     108              :          !??
     109        17022 :       ELSE IF (dft_control%qs_control%dftb) THEN
     110              :          !??
     111        14924 :       ELSE IF (dft_control%qs_control%xtb) THEN
     112              :          !??
     113              :       ELSE
     114         9348 :          CPASSERT(ASSOCIATED(rho_core))
     115              :          CALL calculate_rho_core(rho_core, &
     116         9348 :                                  qs_env%qs_charges%total_rho_core_rspace, qs_env)
     117              :       END IF
     118              : 
     119              :       ! calculate local pseudopotential on grid
     120        23196 :       do_ppl = dft_control%qs_control%do_ppl_method == do_ppl_grid
     121        23196 :       IF (do_ppl) THEN
     122           12 :          NULLIFY (vppl)
     123           12 :          CALL get_qs_env(qs_env, vppl=vppl)
     124           12 :          CPASSERT(ASSOCIATED(vppl))
     125           12 :          CALL calculate_ppl_grid(vppl, qs_env)
     126              :       END IF
     127              : 
     128              :       ! compute the rho_nlcc
     129        23196 :       NULLIFY (rho_nlcc, rho_nlcc_g)
     130        23196 :       CALL get_qs_env(qs_env, rho_nlcc=rho_nlcc, rho_nlcc_g=rho_nlcc_g)
     131        23196 :       IF (ASSOCIATED(rho_nlcc)) THEN
     132           48 :          CALL calculate_rho_nlcc(rho_nlcc, qs_env)
     133           48 :          CALL pw_transfer(rho_nlcc, rho_nlcc_g)
     134              :       END IF
     135              : 
     136              :       ! compute the xcint_weights
     137        23196 :       IF (dft_control%qs_control%gapw .OR. dft_control%qs_control%gapw_xc) THEN
     138         2146 :          IF (dft_control%qs_control%gapw_control%accurate_xcint) THEN
     139          372 :             CALL get_qs_env(qs_env, xcint_weights=xcint_weights, nkind=nk)
     140         1116 :             ALLOCATE (cw(nk))
     141         1156 :             cw = 1.0_dp
     142              :             CALL calculate_rho_core(xcint_weights, wtot, qs_env, &
     143          372 :                                     dft_control%qs_control%gapw_control%aw, cw)
     144     20389593 :             xcint_weights%array = 1.0_dp + xcint_weights%array
     145          744 :             DEALLOCATE (cw)
     146              :          END IF
     147              :       END IF
     148              : 
     149              :       ! allocates and creates the task_list
     150        23196 :       CALL qs_create_task_list(qs_env)
     151              : 
     152              :       ! *** environment for ddapc ***
     153        23196 :       IF (ASSOCIATED(qs_env%cp_ddapc_env)) THEN
     154          128 :          CALL cp_ddapc_release(qs_env%cp_ddapc_env)
     155          128 :          DEALLOCATE (qs_env%cp_ddapc_env)
     156              :       END IF
     157        23196 :       CALL cp_ddapc_init(qs_env)
     158              : 
     159              :       ! *** tell ks_env ***
     160        23196 :       CALL qs_ks_did_change(qs_env%ks_env, s_mstruct_changed=.TRUE.)
     161              : 
     162              :       !   *** Updates rho structure ***
     163        23196 :       CALL qs_env_rebuild_rho(qs_env=qs_env)
     164              : 
     165              :       ! *** tell scf_env ***
     166        23196 :       IF (ASSOCIATED(qs_env%scf_env)) THEN
     167        15158 :          CALL scf_env_did_change(qs_env%scf_env)
     168              :       END IF
     169              : 
     170        23196 :       CALL timestop(handle)
     171              : 
     172        23196 :    END SUBROUTINE qs_env_update_s_mstruct
     173              : 
     174              : ! *****************************************************************************
     175              : !> \brief ...
     176              : !> \param qs_env ...
     177              : ! **************************************************************************************************
     178        23196 :    SUBROUTINE qs_create_task_list(qs_env)
     179              :       TYPE(qs_environment_type), POINTER                 :: qs_env
     180              : 
     181              :       CHARACTER(len=*), PARAMETER :: routineN = 'qs_create_task_list'
     182              : 
     183              :       CHARACTER(LEN=default_string_length)               :: basis_type
     184              :       INTEGER                                            :: handle, isub
     185              :       LOGICAL                                            :: skip_load_balance_distributed, soft_valid
     186              :       TYPE(dft_control_type), POINTER                    :: dft_control
     187              :       TYPE(qs_ks_env_type), POINTER                      :: ks_env
     188              :       TYPE(task_list_type), POINTER                      :: task_list
     189              : 
     190        23196 :       CALL timeset(routineN, handle)
     191        23196 :       NULLIFY (ks_env, dft_control)
     192        23196 :       CALL get_qs_env(qs_env, ks_env=ks_env, dft_control=dft_control)
     193              : 
     194        23196 :       soft_valid = (dft_control%qs_control%gapw .OR. dft_control%qs_control%gapw_xc)
     195        23196 :       skip_load_balance_distributed = dft_control%qs_control%skip_load_balance_distributed
     196        23196 :       IF (.NOT. (dft_control%qs_control%semi_empirical &
     197              :                  .OR. dft_control%qs_control%xtb &
     198              :                  .OR. dft_control%qs_control%dftb)) THEN
     199              :          ! generate task lists (non-soft)
     200        11164 :          IF (.NOT. dft_control%qs_control%gapw) THEN
     201         9348 :             CALL get_ks_env(ks_env, task_list=task_list)
     202         9348 :             IF (.NOT. ASSOCIATED(task_list)) THEN
     203         4398 :                CALL allocate_task_list(task_list)
     204         4398 :                CALL set_ks_env(ks_env, task_list=task_list)
     205              :             END IF
     206              :             CALL generate_qs_task_list(ks_env, task_list, basis_type="ORB", &
     207              :                                        reorder_rs_grid_ranks=.TRUE., &
     208         9348 :                                        skip_load_balance_distributed=skip_load_balance_distributed)
     209              :          END IF
     210              :          ! generate the soft task list
     211        11164 :          IF (dft_control%qs_control%gapw .OR. dft_control%qs_control%gapw_xc) THEN
     212         2146 :             CALL get_ks_env(ks_env, task_list_soft=task_list)
     213         2146 :             IF (.NOT. ASSOCIATED(task_list)) THEN
     214         1160 :                CALL allocate_task_list(task_list)
     215         1160 :                CALL set_ks_env(ks_env, task_list_soft=task_list)
     216              :             END IF
     217              :             CALL generate_qs_task_list(ks_env, task_list, basis_type="ORB_SOFT", &
     218              :                                        reorder_rs_grid_ranks=.TRUE., &
     219         2146 :                                        skip_load_balance_distributed=skip_load_balance_distributed)
     220              :          END IF
     221              :       END IF
     222              : 
     223        23196 :       IF (dft_control%qs_control%do_kg) THEN
     224              : 
     225          112 :          IF (qs_env%kg_env%tnadd_method == kg_tnadd_embed .OR. &
     226              :              qs_env%kg_env%tnadd_method == kg_tnadd_embed_ri) THEN
     227              : 
     228           82 :             IF (ASSOCIATED(qs_env%kg_env%subset)) THEN
     229          252 :                DO isub = 1, qs_env%kg_env%nsubsets
     230          170 :                   IF (ASSOCIATED(qs_env%kg_env%subset(isub)%task_list)) &
     231          146 :                      CALL deallocate_task_list(qs_env%kg_env%subset(isub)%task_list)
     232              :                END DO
     233              :             ELSE
     234            0 :                ALLOCATE (qs_env%kg_env%subset(qs_env%kg_env%nsubsets))
     235              :             END IF
     236              : 
     237           82 :             IF (soft_valid) THEN
     238            0 :                basis_type = "ORB_SOFT"
     239              :             ELSE
     240           82 :                basis_type = "ORB"
     241              :             END IF
     242              : 
     243          252 :             DO isub = 1, qs_env%kg_env%nsubsets
     244          170 :                CALL allocate_task_list(qs_env%kg_env%subset(isub)%task_list)
     245              :                ! generate the subset task list from the neighborlist
     246              :                CALL generate_qs_task_list(ks_env, qs_env%kg_env%subset(isub)%task_list, &
     247              :                                           basis_type=basis_type, &
     248              :                                           reorder_rs_grid_ranks=.FALSE., &
     249              :                                           skip_load_balance_distributed=skip_load_balance_distributed, &
     250          252 :                                           sab_orb_external=qs_env%kg_env%subset(isub)%sab_orb)
     251              :             END DO
     252              : 
     253              :          END IF
     254              : 
     255              :       END IF
     256              : 
     257        23196 :       CALL timestop(handle)
     258              : 
     259        23196 :    END SUBROUTINE qs_create_task_list
     260              : 
     261              : ! *****************************************************************************
     262              : !> \brief rebuilds the rho structure, making sure that everything is allocated
     263              : !>      and has the right size
     264              : !> \param qs_env the environment in which rho should be rebuilt
     265              : !> \param rebuild_ao if it is necessary to rebuild rho_ao. Defaults to true.
     266              : !> \param rebuild_grids if it in necessary to rebuild rho_r and rho_g.
     267              : !>        Defaults to false.
     268              : !> \par History
     269              : !>      10.2002 created [fawzi]
     270              : !> \author Fawzi Mohamed
     271              : !> \note
     272              : !>      needs updated  pw pools, s_mstruct and h.
     273              : !>      The use of p to keep the structure of h (needed for the forces)
     274              : !>      is ugly and should be removed.
     275              : !>      If necessary rho is created from scratch.
     276              : ! **************************************************************************************************
     277        23196 :    SUBROUTINE qs_env_rebuild_rho(qs_env, rebuild_ao, rebuild_grids)
     278              :       TYPE(qs_environment_type), POINTER                 :: qs_env
     279              :       LOGICAL, INTENT(in), OPTIONAL                      :: rebuild_ao, rebuild_grids
     280              : 
     281              :       CHARACTER(len=*), PARAMETER :: routineN = 'qs_env_rebuild_rho'
     282              : 
     283              :       INTEGER                                            :: handle
     284              :       LOGICAL                                            :: do_admm, gapw_xc
     285              :       TYPE(dft_control_type), POINTER                    :: dft_control
     286              :       TYPE(qs_rho_type), POINTER                         :: rho, rho_external, rho_xc
     287              : 
     288        23196 :       NULLIFY (rho)
     289        23196 :       CALL timeset(routineN, handle)
     290              : 
     291              :       CALL get_qs_env(qs_env, &
     292              :                       dft_control=dft_control, &
     293              :                       rho=rho, &
     294              :                       rho_xc=rho_xc, &
     295        23196 :                       rho_external=rho_external)
     296              : 
     297        23196 :       gapw_xc = dft_control%qs_control%gapw_xc
     298        23196 :       do_admm = dft_control%do_admm
     299              :       CALL qs_rho_rebuild(rho, qs_env=qs_env, &
     300        23196 :                           rebuild_ao=rebuild_ao, rebuild_grids=rebuild_grids)
     301              : 
     302        23196 :       IF (gapw_xc) THEN
     303              :          CALL qs_rho_rebuild(rho_xc, qs_env=qs_env, &
     304          330 :                              rebuild_ao=rebuild_ao, rebuild_grids=rebuild_grids)
     305              :       END IF
     306              : 
     307              : ! ZMP rebuilding external density
     308        23196 :       IF (dft_control%apply_external_density) THEN
     309              :          CALL qs_rho_rebuild(rho_external, qs_env=qs_env, &
     310            0 :                              rebuild_grids=rebuild_grids)
     311            0 :          dft_control%read_external_density = .TRUE.
     312              :       END IF
     313              : 
     314        23196 :       CALL timestop(handle)
     315              : 
     316        23196 :    END SUBROUTINE qs_env_rebuild_rho
     317              : 
     318              : END MODULE qs_update_s_mstruct
        

Generated by: LCOV version 2.0-1