LCOV - code coverage report
Current view: top level - src - mscfg_methods.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:4dc10b3) Lines: 150 151 99.3 %
Date: 2024-11-21 06:45:46 Functions: 4 4 100.0 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2024 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 .EQ. 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 .NE. 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) .GT. 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 .LE. 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        8976 :    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        4488 :       do_mol_loop = .FALSE.
     433             :       ! What kind of options are we using in the loop ?
     434        4488 :       is_fast_dirty = .TRUE.
     435        4488 :       is_crystal = .FALSE.
     436        4488 :       almo_scf_is_on = .FALSE.
     437             : 
     438        4488 :       NULLIFY (qs_env, mscfg_env, force_env_section, subsection)
     439        4488 :       CALL force_env_get(force_env, force_env_section=force_env_section)
     440        4488 :       CALL section_vals_val_get(force_env_section, "METHOD", i_val=method_name_id)
     441             : 
     442        4488 :       IF (method_name_id .EQ. do_qs) THEN
     443             : 
     444        3810 :          CALL force_env_get(force_env, qs_env=qs_env)
     445        3810 :          CPASSERT(ASSOCIATED(qs_env))
     446             : 
     447        3810 :          CALL get_qs_env(qs_env, mscfg_env=mscfg_env)
     448        3810 :          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        3810 :          NULLIFY (subsection)
     457        3810 :          subsection => section_vals_get_subs_vals(force_env_section, "DFT%ALMO_SCF")
     458        3810 :          CALL section_vals_val_get(subsection, "ALMO_SCF_GUESS", i_val=almo_guess_type)
     459             :          ! check whether ALMO SCF is on
     460        3810 :          NULLIFY (subsection)
     461        3810 :          subsection => section_vals_get_subs_vals(force_env_section, "DFT%QS")
     462        3810 :          CALL section_vals_val_get(subsection, "ALMO_SCF", l_val=almo_scf_is_on)
     463             : 
     464             :          ! check SCF guess option
     465        3810 :          NULLIFY (subsection)
     466        3810 :          subsection => section_vals_get_subs_vals(force_env_section, "DFT%SCF")
     467        3810 :          CALL section_vals_val_get(subsection, "SCF_GUESS", i_val=scf_guess_type)
     468             : 
     469             :          ! check ALMO EDA options
     470        3810 :          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        3810 :          frz_term_type = almo_frz_none
     474             : 
     475             :          ! Are we doing the loop ?
     476             :          IF (scf_guess_type .EQ. molecular_guess .OR. & ! SCF guess is molecular
     477        3810 :              (almo_guess_type .EQ. molecular_guess .AND. almo_scf_is_on) .OR. & ! ALMO SCF guess is molecular
     478             :              frz_term_type .NE. 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 .NE. almo_frz_none) THEN
     485             :                is_fast_dirty = .FALSE.
     486             :                IF (frz_term_type .EQ. almo_frz_crystal) THEN
     487             :                   is_crystal = .TRUE.
     488             :                END IF
     489             :             END IF
     490             : 
     491             :          END IF
     492             : 
     493        3810 :          mscfg_env%is_fast_dirty = is_fast_dirty
     494        3810 :          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 1.15