LCOV - code coverage report
Current view: top level - src - mscfg_methods.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:936074a) Lines: 99.3 % 151 150
Test Date: 2025-12-04 06:27:48 Functions: 100.0 % 4 4

            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 Subroutines to perform calculations on molecules from a bigger
      10              : !>        system. Useful to generate a high-quality MO guess for systems
      11              : !>        of many molecules with complex electronic structure, to bootstrap
      12              : !>        ALMO simulations, etc.
      13              : !> \par History
      14              : !>      10.2014 Rustam Z Khaliullin
      15              : !>      09.2018 ALMO smearing support and ALMO diag+molecular_guess patch [Ruben Staub]
      16              : !> \author Rustam Z Khaliullin
      17              : ! **************************************************************************************************
      18              : MODULE mscfg_methods
      19              :    USE almo_scf_types,                  ONLY: almo_scf_env_type
      20              :    USE atomic_kind_types,               ONLY: get_atomic_kind
      21              :    USE cell_types,                      ONLY: cell_type
      22              :    USE cp_dbcsr_api,                    ONLY: dbcsr_copy,&
      23              :                                               dbcsr_create,&
      24              :                                               dbcsr_type_no_symmetry
      25              :    USE cp_dbcsr_operations,             ONLY: copy_fm_to_dbcsr
      26              :    USE cp_log_handling,                 ONLY: cp_get_default_logger,&
      27              :                                               cp_logger_get_default_unit_nr,&
      28              :                                               cp_logger_type
      29              :    USE cp_subsys_methods,               ONLY: create_small_subsys
      30              :    USE cp_subsys_types,                 ONLY: cp_subsys_get,&
      31              :                                               cp_subsys_release,&
      32              :                                               cp_subsys_type
      33              :    USE force_env_types,                 ONLY: force_env_get,&
      34              :                                               force_env_type
      35              :    USE global_types,                    ONLY: global_environment_type
      36              :    USE input_constants,                 ONLY: almo_frz_crystal,&
      37              :                                               almo_frz_none,&
      38              :                                               do_qs,&
      39              :                                               molecular_guess
      40              :    USE input_section_types,             ONLY: section_vals_get_subs_vals,&
      41              :                                               section_vals_type,&
      42              :                                               section_vals_val_get,&
      43              :                                               section_vals_val_set
      44              :    USE kinds,                           ONLY: default_string_length
      45              :    USE message_passing,                 ONLY: mp_para_env_type
      46              :    USE molecule_types,                  ONLY: get_molecule_set_info,&
      47              :                                               molecule_type
      48              :    USE mscfg_types,                     ONLY: molecular_scf_guess_env_init,&
      49              :                                               molecular_scf_guess_env_type,&
      50              :                                               mscfg_max_moset_size
      51              :    USE particle_list_types,             ONLY: particle_list_type
      52              :    USE qs_energy,                       ONLY: qs_energies
      53              :    USE qs_energy_types,                 ONLY: qs_energy_type
      54              :    USE qs_environment,                  ONLY: qs_init
      55              :    USE qs_environment_types,            ONLY: get_qs_env,&
      56              :                                               qs_env_create,&
      57              :                                               qs_env_release,&
      58              :                                               qs_environment_type
      59              :    USE qs_mo_types,                     ONLY: get_mo_set,&
      60              :                                               mo_set_type
      61              : #include "./base/base_uses.f90"
      62              : 
      63              :    IMPLICIT NONE
      64              :    PRIVATE
      65              : 
      66              :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'mscfg_methods'
      67              : 
      68              :    PUBLIC :: loop_over_molecules, do_mol_loop
      69              : 
      70              : CONTAINS
      71              : 
      72              : ! **************************************************************************************************
      73              : !> \brief Prepare data for calculations on isolated molecules.
      74              : !> \param globenv ...
      75              : !> \param force_env ...
      76              : !> \par   History
      77              : !>        10.2014 created [Rustam Z Khaliullin]
      78              : !> \author Rustam Z Khaliullin
      79              : ! **************************************************************************************************
      80           10 :    SUBROUTINE loop_over_molecules(globenv, force_env)
      81              : 
      82              :       TYPE(global_environment_type), POINTER             :: globenv
      83              :       TYPE(force_env_type), POINTER                      :: force_env
      84              : 
      85              :       INTEGER                                            :: nmols
      86              :       INTEGER, ALLOCATABLE, DIMENSION(:)                 :: charge_of_frag, first_atom_of_frag, &
      87              :                                                             last_atom_of_frag, multip_of_frag
      88           10 :       TYPE(molecule_type), DIMENSION(:), POINTER         :: molecule_set
      89              :       TYPE(qs_environment_type), POINTER                 :: qs_env
      90              : 
      91           10 :       CALL force_env_get(force_env, qs_env=qs_env)
      92           10 :       CPASSERT(ASSOCIATED(qs_env))
      93              :       CALL get_qs_env(qs_env, &
      94           10 :                       molecule_set=molecule_set)
      95              : 
      96           10 :       nmols = SIZE(molecule_set)
      97              : 
      98           30 :       ALLOCATE (first_atom_of_frag(nmols))
      99           30 :       ALLOCATE (last_atom_of_frag(nmols))
     100           30 :       ALLOCATE (charge_of_frag(nmols))
     101           30 :       ALLOCATE (multip_of_frag(nmols))
     102              : 
     103              :       CALL get_molecule_set_info(molecule_set, &
     104              :                                  mol_to_first_atom=first_atom_of_frag, &
     105              :                                  mol_to_last_atom=last_atom_of_frag, &
     106              :                                  mol_to_charge=charge_of_frag, &
     107           10 :                                  mol_to_multiplicity=multip_of_frag)
     108              : 
     109              :       CALL calcs_on_isolated_molecules(force_env, globenv, nmols, &
     110           10 :                                        first_atom_of_frag, last_atom_of_frag, charge_of_frag, multip_of_frag)
     111              : 
     112           10 :       DEALLOCATE (first_atom_of_frag)
     113           10 :       DEALLOCATE (last_atom_of_frag)
     114           10 :       DEALLOCATE (charge_of_frag)
     115           10 :       DEALLOCATE (multip_of_frag)
     116              : 
     117           10 :    END SUBROUTINE loop_over_molecules
     118              : 
     119              : ! **************************************************************************************************
     120              : !> \brief Run calculations on isolated molecules. The ideas for setting up
     121              : !>        the calculations are borrowed from BSSE files
     122              : !> \param force_env ...
     123              : !> \param globenv ...
     124              : !> \param nfrags ...
     125              : !> \param first_atom_of_frag ...
     126              : !> \param last_atom_of_frag ...
     127              : !> \param charge_of_frag ...
     128              : !> \param multip_of_frag ...
     129              : !> \par   History
     130              : !>        10.2014 created
     131              : !>        09.2018 ALMO smearing support, and ALMO diag+molecular_guess patch [Ruben Staub]
     132              : !> \author Rustam Z Khaliullin
     133              : ! **************************************************************************************************
     134           60 :    SUBROUTINE calcs_on_isolated_molecules(force_env, globenv, nfrags, &
     135           10 :                                           first_atom_of_frag, last_atom_of_frag, charge_of_frag, multip_of_frag)
     136              : 
     137              :       TYPE(force_env_type), POINTER                      :: force_env
     138              :       TYPE(global_environment_type), POINTER             :: globenv
     139              :       INTEGER, INTENT(IN)                                :: nfrags
     140              :       INTEGER, DIMENSION(:), INTENT(IN)                  :: first_atom_of_frag, last_atom_of_frag, &
     141              :                                                             charge_of_frag, multip_of_frag
     142              : 
     143              :       CHARACTER(LEN=*), PARAMETER :: routineN = 'calcs_on_isolated_molecules'
     144              : 
     145              :       CHARACTER(LEN=default_string_length)               :: name
     146              :       CHARACTER(LEN=default_string_length), &
     147           10 :          DIMENSION(:), POINTER                           :: atom_type
     148              :       INTEGER :: first_atom, force_method, global_charge, global_multpl, handle, i, ifrag, imo, &
     149              :          isize, j, k, last_atom, my_targ, nb_eigenval_stored, nmo, nmo_of_frag, nmosets_of_frag, &
     150              :          tot_added_mos, tot_isize
     151           10 :       INTEGER, DIMENSION(:), POINTER                     :: atom_index, atom_list
     152              :       LOGICAL                                            :: global_almo_scf_keyword, smear_almo_scf
     153              :       TYPE(almo_scf_env_type), POINTER                   :: almo_scf_env
     154              :       TYPE(cell_type), POINTER                           :: cell
     155              :       TYPE(cp_subsys_type), POINTER                      :: subsys, subsys_loc
     156           10 :       TYPE(mo_set_type), DIMENSION(:), POINTER           :: mos, mos_of_frag
     157              :       TYPE(molecular_scf_guess_env_type), POINTER        :: mscfg_env
     158              :       TYPE(mp_para_env_type), POINTER                    :: para_env
     159              :       TYPE(particle_list_type), POINTER                  :: particles
     160              :       TYPE(qs_energy_type), POINTER                      :: qs_energy
     161              :       TYPE(qs_environment_type), POINTER                 :: qs_env, qs_env_loc
     162              :       TYPE(section_vals_type), POINTER                   :: dft_section, force_env_section, &
     163              :                                                             qs_section, root_section, scf_section, &
     164              :                                                             subsys_section
     165              : 
     166           10 :       CALL timeset(routineN, handle)
     167              : 
     168           10 :       NULLIFY (subsys_loc, subsys, particles, para_env, cell, atom_index, atom_type, &
     169           10 :                force_env_section, qs_env_loc, mscfg_env, qs_env, qs_energy)
     170              :       CALL force_env_get(force_env, force_env_section=force_env_section, &
     171           10 :                          qs_env=qs_env)
     172           10 :       CALL section_vals_val_get(force_env_section, "METHOD", i_val=force_method)
     173           10 :       CPASSERT(force_method == do_qs)
     174           10 :       root_section => force_env%root_section
     175           10 :       subsys_section => section_vals_get_subs_vals(force_env_section, "SUBSYS")
     176           10 :       dft_section => section_vals_get_subs_vals(force_env_section, "DFT")
     177              :       !
     178              :       ! Save several global settings to restore them after the loop:
     179              :       !  charge, multiplicity, ALMO flag
     180              :       !
     181           10 :       CALL section_vals_val_get(dft_section, "CHARGE", i_val=global_charge)
     182           10 :       CALL section_vals_val_get(dft_section, "MULTIPLICITY", i_val=global_multpl)
     183           10 :       qs_section => section_vals_get_subs_vals(dft_section, "QS")
     184           10 :       CALL section_vals_val_get(qs_section, "ALMO_SCF", l_val=global_almo_scf_keyword)
     185              :       !
     186              :       ! Get access to critical data before the loop
     187              :       !
     188              :       CALL force_env_get(force_env=force_env, subsys=subsys, para_env=para_env, &
     189           10 :                          cell=cell)
     190           10 :       CALL cp_subsys_get(subsys, particles=particles)
     191           10 :       CALL get_qs_env(qs_env, mscfg_env=mscfg_env, almo_scf_env=almo_scf_env)
     192           10 :       CPASSERT(ASSOCIATED(mscfg_env))
     193           10 :       IF (global_almo_scf_keyword) THEN !! Check if smearing is on, and retrieve smearing parameters accordingly
     194           10 :          smear_almo_scf = qs_env%scf_control%smear%do_smear
     195           10 :          IF (smear_almo_scf) THEN
     196            4 :             scf_section => section_vals_get_subs_vals(dft_section, "SCF")
     197            4 :             CALL section_vals_val_get(scf_section, "added_mos", i_val=tot_added_mos) !! Get total number of added MOs
     198            4 :             tot_isize = last_atom_of_frag(nfrags) - first_atom_of_frag(1) + 1 !! Get total number of atoms (assume consecutive atoms)
     199              :             !! Check that number of added MOs matches the number of atoms
     200              :             !! (to ensure compatibility, since each fragment will be computed with such parameters)
     201            4 :             IF (tot_isize /= tot_added_mos) THEN
     202            0 :                CPABORT("ALMO smearing currently requires ADDED_MOS == total number of atoms")
     203              :             END IF
     204              :             !! Get total number of MOs
     205            4 :             CALL get_qs_env(qs_env, mos=mos)
     206            4 :             IF (SIZE(mos) > 1) CPABORT("Unrestricted ALMO methods are NYI") !! Unrestricted ALMO is not implemented yet
     207            4 :             CALL get_mo_set(mo_set=mos(1), nmo=nmo)
     208              :             !! Initialize storage of MO energies for ALMO smearing
     209            4 :             CPASSERT(ASSOCIATED(almo_scf_env))
     210           16 :             ALLOCATE (almo_scf_env%mo_energies(nmo, SIZE(mos)))
     211           12 :             ALLOCATE (almo_scf_env%kTS(SIZE(mos)))
     212           12 :             nb_eigenval_stored = 0 !! Keep track of how many eigenvalues were stored in mo_energies
     213              :          END IF
     214              :       ELSE
     215              :          smear_almo_scf = .FALSE.
     216              :       END IF
     217              :       !
     218              :       ! These flags determine the options of molecular runs (e.g. cell size)
     219              :       !
     220              :       !!!LATER is_fast_dirty = mscfg_env%is_fast_dirty - shrink the cell
     221              :       !!!LATER is_crystal = mscfg_env%is_crystal - remove periodicity
     222              :       !
     223              :       ! Prepare storage for the results
     224              :       ! Until molecular_scf_guess_env is destroyed it will keep
     225              :       ! the results of fragment calculations
     226              :       !
     227           10 :       CALL molecular_scf_guess_env_init(mscfg_env, nfrags)
     228              : 
     229              :       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     230              :       !
     231              :       ! Start the loop over molecules
     232              :       !
     233              :       ! Here is the list of modifications necessary to run isolated molecules:
     234              :       ! * Atom list of a subsystem and their names
     235              :       ! * Charge and multiplicity of a subsystem
     236              :       ! * ALMO SCF flag off (unless several levels of recursion is desired)
     237              :       ! * Smaller cell can be provided if a fast-and-dirty approach is ok
     238              :       ! * Set ADDED_MOS to number of atoms in the fragment, if smearing requested (VASP default)
     239              :       ! * ... add your own and explain it here ...
     240              :       !
     241              :       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     242           42 :       DO ifrag = 1, nfrags
     243              :          !
     244              :          ! Turn ALMO SCF flag off
     245              :          !
     246           32 :          CALL section_vals_val_set(qs_section, "ALMO_SCF", l_val=.FALSE.)
     247              :          !
     248              :          ! Setup the charge and multiplicity of the molecule
     249              :          !
     250           32 :          CALL section_vals_val_set(dft_section, "CHARGE", i_val=charge_of_frag(ifrag))
     251           32 :          CALL section_vals_val_set(dft_section, "MULTIPLICITY", i_val=multip_of_frag(ifrag))
     252              :          !
     253              :          ! Create a list of atoms in the current molecule
     254              :          !
     255              :          ! Assume that atoms arranged consecutively (in ALMO SCF it is always the case)
     256              :          ! It is important to have a linear scaling procedure here
     257           32 :          first_atom = first_atom_of_frag(ifrag)
     258           32 :          last_atom = last_atom_of_frag(ifrag)
     259           32 :          isize = last_atom - first_atom + 1
     260           96 :          ALLOCATE (atom_index(isize))
     261          352 :          atom_index(1:isize) = [(i, i=first_atom, last_atom)]
     262              :          !
     263              :          ! Get atom type names
     264              :          !
     265           96 :          ALLOCATE (atom_type(isize))
     266          176 :          DO j = 1, isize
     267          144 :             my_targ = atom_index(j)
     268          416 :             DO k = 1, SIZE(particles%els)
     269          416 :                CALL get_atomic_kind(particles%els(k)%atomic_kind, atom_list=atom_list, name=name)
     270         3658 :                IF (ANY(atom_list == my_targ)) EXIT
     271              :             END DO
     272          176 :             atom_type(j) = name
     273              :          END DO
     274              :          !
     275              :          ! If smearing requested, setup ADDED_MOS correctly for each fragment (i.e. number of atoms in fragment)
     276              :          !
     277           32 :          IF (smear_almo_scf) THEN
     278            8 :             CALL section_vals_val_set(scf_section, "added_mos", i_val=isize)
     279              :          END IF
     280              :          !
     281              :          ! Create the environment of a subsystem
     282              :          !
     283              :          CALL create_small_subsys(subsys_loc, big_subsys=subsys, &
     284              :                                   small_para_env=para_env, small_cell=cell, sub_atom_index=atom_index, &
     285              :                                   sub_atom_kind_name=atom_type, para_env=para_env, &
     286           32 :                                   force_env_section=force_env_section, subsys_section=subsys_section)
     287           32 :          ALLOCATE (qs_env_loc)
     288           32 :          CALL qs_env_create(qs_env_loc, globenv)
     289              :          CALL qs_init(qs_env_loc, para_env, root_section, globenv=globenv, cp_subsys=subsys_loc, &
     290              :                       force_env_section=force_env_section, subsys_section=subsys_section, &
     291           32 :                       use_motion_section=.FALSE.)
     292           32 :          CALL cp_subsys_release(subsys_loc)
     293              : 
     294              :          !
     295              :          ! Print-out fragment info
     296              :          !
     297              :          CALL print_frag_info(atom_index, atom_type, ifrag, nfrags, &
     298           32 :                               charge_of_frag(ifrag), multip_of_frag(ifrag))
     299              :          !
     300              :          !  Run calculations on a subsystem
     301              :          !
     302           32 :          CALL qs_energies(qs_env_loc)
     303              :          !
     304              :          !  Get the desired results (energy and MOs) out
     305              :          !
     306           32 :          CALL get_qs_env(qs_env_loc, mos=mos_of_frag, energy=qs_energy)
     307              :          !
     308              :          ! Store all desired results of fragment calculations in the fragment_env
     309              :          ! of the qs_env to use them later as needed
     310              :          !
     311           32 :          mscfg_env%energy_of_frag(ifrag) = qs_energy%total
     312           32 :          nmosets_of_frag = SIZE(mos_of_frag)
     313           32 :          CPASSERT(nmosets_of_frag <= mscfg_max_moset_size)
     314           32 :          mscfg_env%nmosets_of_frag(ifrag) = nmosets_of_frag
     315           64 :          DO imo = 1, nmosets_of_frag
     316              :             !! Forcing compatibility for ALMO smearing
     317           32 :             IF (global_almo_scf_keyword) THEN
     318              :                !! Manually add compatibility between ALMO SCF and diag SCF (used for smearing compatibility)
     319              :                !! MOs are required to compute ALMO orbitals, but not stored with diag SCF algorithm...
     320              :                !! RS-WARNING: Should be properly fixed, this is just a raw fix.
     321              :                CALL copy_fm_to_dbcsr(mos_of_frag(imo)%mo_coeff, &
     322           32 :                                      mos_of_frag(imo)%mo_coeff_b)
     323           32 :                IF (smear_almo_scf) THEN
     324              :                   !! Store MOs energies for ALMO smearing purpose
     325            8 :                   nmo_of_frag = SIZE(mos_of_frag(imo)%eigenvalues)
     326              :                   almo_scf_env%mo_energies(nb_eigenval_stored + 1:nb_eigenval_stored + nmo_of_frag, imo) &
     327          272 :                      = mos_of_frag(imo)%eigenvalues(:)
     328              :                   !! update stored energies offset. Assumes nmosets_of_frag == 1 (general smearing ALMO assumption)
     329            8 :                   nb_eigenval_stored = nb_eigenval_stored + nmo_of_frag
     330              :                END IF
     331              :             END IF !! ALMO
     332              : 
     333              :             ! the matrices have been allocated already - copy the results there
     334              :             CALL dbcsr_create(mscfg_env%mos_of_frag(ifrag, imo), &
     335              :                               template=mos_of_frag(imo)%mo_coeff_b, &
     336           32 :                               matrix_type=dbcsr_type_no_symmetry)
     337              :             CALL dbcsr_copy(mscfg_env%mos_of_frag(ifrag, imo), &
     338           64 :                             mos_of_frag(imo)%mo_coeff_b)
     339              :          END DO
     340              :          !
     341              :          ! Clean up
     342              :          !
     343           32 :          NULLIFY (qs_energy)
     344           32 :          CALL qs_env_release(qs_env_loc)
     345           32 :          DEALLOCATE (qs_env_loc)
     346           32 :          DEALLOCATE (atom_index)
     347           74 :          DEALLOCATE (atom_type)
     348              : 
     349              :       END DO
     350              : 
     351           10 :       CALL section_vals_val_set(dft_section, "CHARGE", i_val=global_charge)
     352           10 :       CALL section_vals_val_set(dft_section, "MULTIPLICITY", i_val=global_multpl)
     353           10 :       CALL section_vals_val_set(qs_section, "ALMO_SCF", l_val=global_almo_scf_keyword)
     354              : 
     355           10 :       CALL timestop(handle)
     356              : 
     357           10 :    END SUBROUTINE calcs_on_isolated_molecules
     358              : 
     359              : ! **************************************************************************************************
     360              : !> \brief Print info about fragment
     361              : !> \param atom_index ...
     362              : !> \param atom_type ...
     363              : !> \param frag ...
     364              : !> \param nfrags ...
     365              : !> \param charge ...
     366              : !> \param multpl ...
     367              : !> \par History
     368              : !>      07.2005 created as a part of BSSE calculations [tlaino]
     369              : !>      10.2014 adapted to ALMO guess calculations [Rustam Z Khaliullin]
     370              : !> \author Rustam Z Khaliullin
     371              : ! **************************************************************************************************
     372           32 :    SUBROUTINE print_frag_info(atom_index, atom_type, frag, nfrags, charge, &
     373              :                               multpl)
     374              : 
     375              :       INTEGER, DIMENSION(:), POINTER                     :: atom_index
     376              :       CHARACTER(len=default_string_length), &
     377              :          DIMENSION(:), POINTER                           :: atom_type
     378              :       INTEGER, INTENT(IN)                                :: frag, nfrags, charge, multpl
     379              : 
     380              :       CHARACTER(len=11)                                  :: charI
     381              :       INTEGER                                            :: i, iw
     382              :       TYPE(cp_logger_type), POINTER                      :: logger
     383              : 
     384           32 :       NULLIFY (logger)
     385           32 :       logger => cp_get_default_logger()
     386           32 :       IF (logger%para_env%is_source()) THEN
     387           16 :          iw = cp_logger_get_default_unit_nr(logger, local=.TRUE.)
     388              :       ELSE
     389              :          iw = -1
     390              :       END IF
     391              : 
     392           16 :       IF (iw > 0) THEN
     393              : 
     394           16 :          WRITE (UNIT=iw, FMT="(/,T2,A)") REPEAT("-", 79)
     395           16 :          WRITE (UNIT=iw, FMT="(T2,A,T80,A)") "-", "-"
     396              :          WRITE (UNIT=iw, FMT="(T2,A,T5,A,T25,A,T40,I11,T53,A,T67,I11,T80,A)") &
     397           16 :             "-", "MOLECULAR GUESS:", "FRAGMENT", frag, "OUT OF", nfrags, "-"
     398           16 :          WRITE (UNIT=iw, FMT="(T2,A,T25,A,T40,I11,T53,A,T67,I11,T80,A)") "-", "CHARGE", charge, "MULTIPLICITY", &
     399           32 :             multpl, "-"
     400           16 :          WRITE (UNIT=iw, FMT="(T2,A,T80,A)") "-", "-"
     401           16 :          WRITE (UNIT=iw, FMT="(T2,A,T25,A,T53,A,T80,A)") "-", "ATOM INDEX", "ATOM NAME", "-"
     402           16 :          WRITE (UNIT=iw, FMT="(T2,A,T25,A,T53,A,T80,A)") "-", "----------", "---------", "-"
     403           88 :          DO i = 1, SIZE(atom_index)
     404           72 :             WRITE (charI, '(I11)') atom_index(i)
     405           88 :             WRITE (UNIT=iw, FMT="(T2,A,T25,A,T53,A,T80,A)") "-", ADJUSTL(charI), TRIM(atom_type(i)), "-"
     406              :          END DO
     407           16 :          WRITE (UNIT=iw, FMT="(T2,A)") REPEAT("-", 79)
     408              :       END IF
     409              : 
     410           32 :    END SUBROUTINE print_frag_info
     411              : 
     412              : ! **************************************************************************************************
     413              : !> \brief Is the loop over molecules requested?
     414              : !> \param force_env ...
     415              : !> \return ...
     416              : !> \par History
     417              : !>       10.2014 created [Rustam Z. Khaliullin]
     418              : !> \author Rustam Z. Khaliullin
     419              : ! **************************************************************************************************
     420        10312 :    FUNCTION do_mol_loop(force_env)
     421              : 
     422              :       TYPE(force_env_type), POINTER                      :: force_env
     423              :       LOGICAL                                            :: do_mol_loop
     424              : 
     425              :       INTEGER                                            :: almo_guess_type, frz_term_type, &
     426              :                                                             method_name_id, scf_guess_type
     427              :       LOGICAL                                            :: almo_scf_is_on, is_crystal, is_fast_dirty
     428              :       TYPE(molecular_scf_guess_env_type), POINTER        :: mscfg_env
     429              :       TYPE(qs_environment_type), POINTER                 :: qs_env
     430              :       TYPE(section_vals_type), POINTER                   :: force_env_section, subsection
     431              : 
     432         5156 :       do_mol_loop = .FALSE.
     433              :       ! What kind of options are we using in the loop ?
     434         5156 :       is_fast_dirty = .TRUE.
     435         5156 :       is_crystal = .FALSE.
     436         5156 :       almo_scf_is_on = .FALSE.
     437              : 
     438         5156 :       NULLIFY (qs_env, mscfg_env, force_env_section, subsection)
     439         5156 :       CALL force_env_get(force_env, force_env_section=force_env_section)
     440         5156 :       CALL section_vals_val_get(force_env_section, "METHOD", i_val=method_name_id)
     441              : 
     442         5156 :       IF (method_name_id == do_qs) THEN
     443              : 
     444         4472 :          CALL force_env_get(force_env, qs_env=qs_env)
     445         4472 :          CPASSERT(ASSOCIATED(qs_env))
     446              : 
     447         4472 :          CALL get_qs_env(qs_env, mscfg_env=mscfg_env)
     448         4472 :          CPASSERT(ASSOCIATED(mscfg_env))
     449              : 
     450              :          !!!! RZK-warning: All decisions are based on the values of input keywords
     451              :          !!!! The real danger is that many of these keywords might not be even
     452              :          !!!! in control of the job. They might be simply present in the input
     453              :          !!!! This section must be re-written more accurately
     454              : 
     455              :          ! check ALMO SCF guess option
     456         4472 :          NULLIFY (subsection)
     457         4472 :          subsection => section_vals_get_subs_vals(force_env_section, "DFT%ALMO_SCF")
     458         4472 :          CALL section_vals_val_get(subsection, "ALMO_SCF_GUESS", i_val=almo_guess_type)
     459              :          ! check whether ALMO SCF is on
     460         4472 :          NULLIFY (subsection)
     461         4472 :          subsection => section_vals_get_subs_vals(force_env_section, "DFT%QS")
     462         4472 :          CALL section_vals_val_get(subsection, "ALMO_SCF", l_val=almo_scf_is_on)
     463              : 
     464              :          ! check SCF guess option
     465         4472 :          NULLIFY (subsection)
     466         4472 :          subsection => section_vals_get_subs_vals(force_env_section, "DFT%SCF")
     467         4472 :          CALL section_vals_val_get(subsection, "SCF_GUESS", i_val=scf_guess_type)
     468              : 
     469              :          ! check ALMO EDA options
     470         4472 :          NULLIFY (subsection)
     471              :          !!!LATER subsection    => section_vals_get_subs_vals(force_env_section,"DFT%ALMO_SCF%ALMO_DA")
     472              :          !!!LATER CALL section_vals_val_get(subsection,"FRZ_TERM",i_val=frz_term_type)
     473         4472 :          frz_term_type = almo_frz_none
     474              : 
     475              :          ! Are we doing the loop ?
     476              :          IF (scf_guess_type == molecular_guess .OR. & ! SCF guess is molecular
     477         4472 :              (almo_guess_type == molecular_guess .AND. almo_scf_is_on) .OR. & ! ALMO SCF guess is molecular
     478              :              frz_term_type /= almo_frz_none) THEN ! ALMO FRZ term is requested
     479              : 
     480           10 :             do_mol_loop = .TRUE.
     481              : 
     482              :             ! If we are calculating molecular guess it is OK to do fast and dirty loop
     483              :             ! It is NOT ok to be sloppy with ALMO EDA calculations of the FRZ term
     484              :             IF (frz_term_type /= almo_frz_none) THEN
     485              :                is_fast_dirty = .FALSE.
     486              :                IF (frz_term_type == almo_frz_crystal) THEN
     487              :                   is_crystal = .TRUE.
     488              :                END IF
     489              :             END IF
     490              : 
     491              :          END IF
     492              : 
     493         4472 :          mscfg_env%is_fast_dirty = is_fast_dirty
     494         4472 :          mscfg_env%is_crystal = is_crystal
     495              : 
     496              :       END IF
     497              : 
     498              :       RETURN
     499              : 
     500              :    END FUNCTION do_mol_loop
     501              : 
     502              : END MODULE mscfg_methods
     503              : 
        

Generated by: LCOV version 2.0-1