LCOV - code coverage report
Current view: top level - src - qs_cdft_scf_utils.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:1425fcd) Lines: 163 186 87.6 %
Date: 2024-05-08 07:14:22 Functions: 6 6 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 Auxiliary routines for performing a constrained DFT SCF run with Quickstep.
      10             : !> \par History
      11             : !>      - Separated some routines from qs_scf (03.2018) [Nico Holmberg]
      12             : !> \author Nico Holmberg (03.2018)
      13             : ! **************************************************************************************************
      14             : MODULE qs_cdft_scf_utils
      15             :    USE cp_control_types,                ONLY: dft_control_type
      16             :    USE cp_files,                        ONLY: close_file,&
      17             :                                               get_unit_number,&
      18             :                                               open_file
      19             :    USE cp_log_handling,                 ONLY: cp_logger_create,&
      20             :                                               cp_logger_type,&
      21             :                                               cp_to_string
      22             :    USE input_constants,                 ONLY: &
      23             :         broyden_type_1, broyden_type_1_explicit, broyden_type_1_explicit_ls, broyden_type_1_ls, &
      24             :         broyden_type_2, broyden_type_2_explicit, broyden_type_2_explicit_ls, broyden_type_2_ls, &
      25             :         jacobian_fd1, jacobian_fd1_backward, jacobian_fd1_central, jacobian_fd2, &
      26             :         jacobian_fd2_backward, outer_scf_optimizer_broyden, outer_scf_optimizer_newton, &
      27             :         outer_scf_optimizer_newton_ls
      28             :    USE kinds,                           ONLY: default_path_length,&
      29             :                                               dp
      30             :    USE mathlib,                         ONLY: invert_matrix
      31             :    USE message_passing,                 ONLY: mp_para_env_type
      32             :    USE qs_environment_types,            ONLY: get_qs_env,&
      33             :                                               qs_environment_type
      34             :    USE qs_scf_types,                    ONLY: qs_scf_env_type
      35             :    USE scf_control_types,               ONLY: scf_control_type
      36             : #include "./base/base_uses.f90"
      37             : 
      38             :    IMPLICIT NONE
      39             : 
      40             :    PRIVATE
      41             : 
      42             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_cdft_scf_utils'
      43             : 
      44             :    PUBLIC :: prepare_jacobian_stencil, build_diagonal_jacobian, &
      45             :              restart_inverse_jacobian, print_inverse_jacobian, &
      46             :              create_tmp_logger, initialize_inverse_jacobian
      47             : 
      48             : CONTAINS
      49             : 
      50             : ! **************************************************************************************************
      51             : !> \brief Prepares the finite difference stencil for computing the Jacobian. The constraints
      52             : !>        are re-evaluated by perturbing each constraint.
      53             : !> \param qs_env the qs_env where to build the Jacobian
      54             : !> \param output_unit the output unit number
      55             : !> \param nwork the number of perturbations to take in the negative direction
      56             : !> \param pwork the number of perturbations to take in the positive direction
      57             : !> \param coeff list of coefficients that determine how to sum up the various perturbations
      58             : !> \param step_multiplier list of values that determine how large steps to take for each perturbatio
      59             : !> \param dh total length of the interval to use for computing the finite difference derivatives
      60             : !> \par History
      61             : !>      03.2018 created [Nico Holmberg]
      62             : ! **************************************************************************************************
      63          62 :    SUBROUTINE prepare_jacobian_stencil(qs_env, output_unit, nwork, pwork, &
      64             :                                        coeff, step_multiplier, dh)
      65             :       TYPE(qs_environment_type), POINTER                 :: qs_env
      66             :       INTEGER                                            :: output_unit, nwork, pwork
      67             :       REAL(KIND=dp), ALLOCATABLE, DIMENSION(:)           :: coeff, step_multiplier, dh
      68             : 
      69             :       CHARACTER(len=15)                                  :: fmt_code
      70             :       INTEGER                                            :: ivar
      71             :       TYPE(dft_control_type), POINTER                    :: dft_control
      72             :       TYPE(qs_scf_env_type), POINTER                     :: scf_env
      73             :       TYPE(scf_control_type), POINTER                    :: scf_control
      74             : 
      75          62 :       NULLIFY (scf_env, scf_control, dft_control)
      76             : 
      77          62 :       CPASSERT(ASSOCIATED(qs_env))
      78             :       CALL get_qs_env(qs_env, scf_env=scf_env, &
      79             :                       scf_control=scf_control, &
      80          62 :                       dft_control=dft_control)
      81             : 
      82           4 :       IF (SIZE(scf_control%outer_scf%cdft_opt_control%jacobian_step) /= 1 .AND. &
      83             :           SIZE(scf_control%outer_scf%cdft_opt_control%jacobian_step) /= SIZE(scf_env%outer_scf%variables, 1)) &
      84             :          CALL cp_abort(__LOCATION__, &
      85             :                        cp_to_string(SIZE(scf_control%outer_scf%cdft_opt_control%jacobian_step))// &
      86             :                        " values passed to keyword JACOBIAN_STEP, expected 1 or "// &
      87          62 :                        cp_to_string(SIZE(scf_env%outer_scf%variables, 1)))
      88             : 
      89         186 :       ALLOCATE (dh(SIZE(scf_env%outer_scf%variables, 1)))
      90          62 :       IF (SIZE(dh) /= SIZE(scf_control%outer_scf%cdft_opt_control%jacobian_step)) THEN
      91          60 :          DO ivar = 1, SIZE(dh)
      92          60 :             dh(ivar) = scf_control%outer_scf%cdft_opt_control%jacobian_step(1)
      93             :          END DO
      94             :       ELSE
      95          88 :          dh(:) = scf_control%outer_scf%cdft_opt_control%jacobian_step
      96             :       END IF
      97             : 
      98          62 :       SELECT CASE (scf_control%outer_scf%cdft_opt_control%jacobian_type)
      99             :       CASE DEFAULT
     100             :          CALL cp_abort(__LOCATION__, &
     101             :                        "Unknown Jacobian type: "// &
     102           0 :                        cp_to_string(scf_control%outer_scf%cdft_opt_control%jacobian_type))
     103             :       CASE (jacobian_fd1)
     104             :          ! f'(x0) = [ f(x0+h) - f(x0) ] / h
     105          48 :          nwork = 0
     106          48 :          pwork = 1
     107          48 :          ALLOCATE (coeff(nwork:pwork), step_multiplier(nwork:pwork))
     108          48 :          coeff(nwork) = -1.0_dp
     109          48 :          coeff(pwork) = 1.0_dp
     110         144 :          step_multiplier = 1.0_dp
     111             :       CASE (jacobian_fd1_backward)
     112             :          ! f'(x0) = [ f(x0) - f(x0-h) ] / h
     113           2 :          nwork = -1
     114           2 :          pwork = 0
     115           2 :          ALLOCATE (coeff(nwork:pwork), step_multiplier(nwork:pwork))
     116           2 :          coeff(nwork) = -1.0_dp
     117           2 :          coeff(pwork) = 1.0_dp
     118           6 :          step_multiplier = -1.0_dp
     119             :       CASE (jacobian_fd2)
     120             :          ! f'(x0) = [ -f(x0+2h) + 4f(x0+h) - 3f(x0) ] / 2h
     121           2 :          nwork = 0
     122           2 :          pwork = 2
     123           2 :          ALLOCATE (coeff(nwork:pwork), step_multiplier(nwork:pwork))
     124           2 :          coeff(0) = -3.0_dp
     125           2 :          coeff(1) = 4.0_dp
     126           2 :          coeff(2) = -1.0_dp
     127           2 :          step_multiplier(0) = 0.0_dp
     128           2 :          step_multiplier(1) = 1.0_dp
     129           2 :          step_multiplier(2) = 2.0_dp
     130           4 :          dh(:) = 2.0_dp*dh(:)
     131             :       CASE (jacobian_fd2_backward)
     132             :          ! f'(x0) = [ 3f(x0) - 4f(x0-h) + f(x0-2h) ] / 2h
     133           8 :          nwork = -2
     134           8 :          pwork = 0
     135           8 :          ALLOCATE (coeff(nwork:pwork), step_multiplier(nwork:pwork))
     136           8 :          coeff(0) = 3.0_dp
     137           8 :          coeff(-1) = -4.0_dp
     138           8 :          coeff(-2) = 1.0_dp
     139           8 :          step_multiplier(0) = 0.0_dp
     140           8 :          step_multiplier(-1) = -1.0_dp
     141           8 :          step_multiplier(-2) = -2.0_dp
     142          16 :          dh(:) = 2.0_dp*dh(:)
     143             :       CASE (jacobian_fd1_central)
     144             :          ! f'(x0) = [ f(x0+h) - f(x0-h) ] / 2h
     145           2 :          nwork = -1
     146           2 :          pwork = 1
     147           2 :          ALLOCATE (coeff(nwork:pwork), step_multiplier(nwork:pwork))
     148           2 :          coeff(0) = 0.0_dp
     149           2 :          coeff(nwork) = -1.0_dp
     150           2 :          coeff(pwork) = 1.0_dp
     151           2 :          step_multiplier(0) = 0.0_dp
     152           2 :          step_multiplier(nwork) = -1.0_dp
     153           2 :          step_multiplier(pwork) = 1.0_dp
     154          66 :          dh(:) = 2.0_dp*dh(:)
     155             :       END SELECT
     156             :       ! Print some info
     157          62 :       IF (output_unit > 0) THEN
     158             :          WRITE (output_unit, FMT="(/,A)") &
     159          31 :             " ================================== JACOBIAN CALCULATION ================================="
     160             :          WRITE (output_unit, FMT="(A)") &
     161          31 :             " Evaluating inverse Jacobian using finite differences"
     162             :          WRITE (output_unit, '(A,I10,A,I10)') &
     163          31 :             " Energy evaluation: ", dft_control%qs_control%cdft_control%ienergy, &
     164          62 :             ", CDFT SCF iteration: ", scf_env%outer_scf%iter_count
     165          55 :          SELECT CASE (scf_control%outer_scf%cdft_opt_control%jacobian_type)
     166             :          CASE (jacobian_fd1)
     167          24 :             WRITE (output_unit, '(A)') " Type               : First order forward difference"
     168             :          CASE (jacobian_fd1_backward)
     169           1 :             WRITE (output_unit, '(A)') " Type               : First order backward difference"
     170             :          CASE (jacobian_fd2)
     171           1 :             WRITE (output_unit, '(A)') " Type               : Second order forward difference"
     172             :          CASE (jacobian_fd2_backward)
     173           4 :             WRITE (output_unit, '(A)') " Type               : Second order backward difference"
     174             :          CASE (jacobian_fd1_central)
     175           1 :             WRITE (output_unit, '(A)') " Type               : First order central difference"
     176             :          CASE DEFAULT
     177             :             CALL cp_abort(__LOCATION__, "Unknown Jacobian type: "// &
     178          31 :                           cp_to_string(scf_control%outer_scf%cdft_opt_control%jacobian_type))
     179             :          END SELECT
     180          31 :          IF (SIZE(scf_control%outer_scf%cdft_opt_control%jacobian_step) == 1) THEN
     181          29 :             WRITE (output_unit, '(A,ES12.4)') " Step size          : ", scf_control%outer_scf%cdft_opt_control%jacobian_step
     182             :          ELSE
     183             :             WRITE (output_unit, '(A,ES12.4,A)') &
     184           2 :                " Step sizes         : ", scf_control%outer_scf%cdft_opt_control%jacobian_step(1), ' (constraint 1)'
     185           2 :             IF (SIZE(scf_control%outer_scf%cdft_opt_control%jacobian_step) < 10) THEN
     186           2 :                fmt_code = '(ES34.4,A,I2,A)'
     187             :             ELSE
     188           0 :                fmt_code = '(ES34.4,A,I3,A)'
     189             :             END IF
     190           4 :             DO ivar = 2, SIZE(scf_control%outer_scf%cdft_opt_control%jacobian_step)
     191           4 :                WRITE (output_unit, fmt_code) scf_control%outer_scf%cdft_opt_control%jacobian_step(ivar), " (constraint", ivar, ")"
     192             :             END DO
     193             :          END IF
     194             :       END IF
     195             : 
     196          62 :    END SUBROUTINE prepare_jacobian_stencil
     197             : ! **************************************************************************************************
     198             : !> \brief Builds a strictly diagonal inverse Jacobian from MD/SCF history.
     199             : !> \param qs_env the qs_environment_type where to compute the Jacobian
     200             : !> \param used_history flag that determines if history was actually used to prepare the Jacobian
     201             : !> \par History
     202             : !>      03.2018 created [Nico Holmberg]
     203             : ! **************************************************************************************************
     204          16 :    SUBROUTINE build_diagonal_jacobian(qs_env, used_history)
     205             :       TYPE(qs_environment_type), POINTER                 :: qs_env
     206             :       LOGICAL                                            :: used_history
     207             : 
     208             :       INTEGER                                            :: i, ihistory, nvar, outer_scf_ihistory
     209             :       LOGICAL                                            :: use_md_history
     210             :       REAL(KIND=dp)                                      :: inv_error
     211          16 :       REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :)        :: jacobian
     212          16 :       REAL(KIND=dp), DIMENSION(:, :), POINTER            :: gradient_history, inv_jacobian, &
     213          16 :                                                             variable_history
     214             :       TYPE(qs_scf_env_type), POINTER                     :: scf_env
     215             :       TYPE(scf_control_type), POINTER                    :: scf_control
     216             : 
     217          16 :       NULLIFY (scf_control, scf_env)
     218             : 
     219             :       CALL get_qs_env(qs_env, scf_env=scf_env, &
     220             :                       scf_control=scf_control, &
     221          16 :                       outer_scf_ihistory=outer_scf_ihistory)
     222          16 :       ihistory = scf_env%outer_scf%iter_count
     223             : 
     224          16 :       IF (outer_scf_ihistory .GE. 3 .AND. .NOT. used_history) THEN
     225             :          ! First, lets try using the history from previous energy evaluations
     226             :          CALL get_qs_env(qs_env, gradient_history=gradient_history, &
     227           0 :                          variable_history=variable_history)
     228           0 :          nvar = SIZE(scf_env%outer_scf%variables, 1)
     229           0 :          use_md_history = .TRUE.
     230             :          ! Check that none of the history values are identical in which case we should try something different
     231           0 :          DO i = 1, nvar
     232           0 :             IF (ABS(variable_history(i, 2) - variable_history(i, 1)) .LT. 1.0E-12_dp) &
     233           0 :                use_md_history = .FALSE.
     234             :          END DO
     235           0 :          IF (use_md_history) THEN
     236           0 :             ALLOCATE (jacobian(nvar, nvar))
     237           0 :             DO i = 1, nvar
     238             :                jacobian(i, i) = (gradient_history(i, 2) - gradient_history(i, 1))/ &
     239           0 :                                 (variable_history(i, 2) - variable_history(i, 1))
     240             :             END DO
     241           0 :             IF (.NOT. ASSOCIATED(scf_env%outer_scf%inv_jacobian)) &
     242           0 :                ALLOCATE (scf_env%outer_scf%inv_jacobian(nvar, nvar))
     243           0 :             inv_jacobian => scf_env%outer_scf%inv_jacobian
     244           0 :             CALL invert_matrix(jacobian, inv_jacobian, inv_error)
     245           0 :             DEALLOCATE (jacobian)
     246             :             ! Mark that an inverse Jacobian was just built and the next outer_loop_optimize should not perform
     247             :             ! a Broyden update of it
     248           0 :             scf_control%outer_scf%cdft_opt_control%broyden_update = .FALSE.
     249             :             ! Mark that the MD history has been used and should not be reused anymore on this energy evaluation
     250           0 :             used_history = .TRUE.
     251             :          END IF
     252             :       END IF
     253          16 :       IF (ihistory .GE. 2 .AND. .NOT. ASSOCIATED(scf_env%outer_scf%inv_jacobian)) THEN
     254             :          ! Next, try history from current SCF procedure
     255           8 :          nvar = SIZE(scf_env%outer_scf%variables, 1)
     256           8 :          IF (SIZE(scf_env%outer_scf%gradient, 2) .LT. 3) &
     257             :             CALL cp_abort(__LOCATION__, &
     258             :                           "Keyword EXTRAPOLATION_ORDER in section OUTER_SCF must be greater than or equal "// &
     259           0 :                           "to 3 for optimizers that build the Jacobian from SCF history.")
     260          32 :          ALLOCATE (jacobian(nvar, nvar))
     261          16 :          DO i = 1, nvar
     262             :             jacobian(i, i) = (scf_env%outer_scf%gradient(i, ihistory) - scf_env%outer_scf%gradient(i, ihistory - 1))/ &
     263          16 :                              (scf_env%outer_scf%variables(i, ihistory) - scf_env%outer_scf%variables(i, ihistory - 1))
     264             :          END DO
     265           8 :          IF (.NOT. ASSOCIATED(scf_env%outer_scf%inv_jacobian)) &
     266          32 :             ALLOCATE (scf_env%outer_scf%inv_jacobian(nvar, nvar))
     267           8 :          inv_jacobian => scf_env%outer_scf%inv_jacobian
     268           8 :          CALL invert_matrix(jacobian, inv_jacobian, inv_error)
     269           8 :          DEALLOCATE (jacobian)
     270          16 :          scf_control%outer_scf%cdft_opt_control%broyden_update = .FALSE.
     271             :       ELSE
     272             :          ! No history => will fall back to SD optimizer in outer_loop_optimize
     273             :       END IF
     274             : 
     275          32 :    END SUBROUTINE build_diagonal_jacobian
     276             : 
     277             : ! **************************************************************************************************
     278             : !> \brief Restarts the finite difference inverse Jacobian.
     279             : !> \param qs_env the qs_environment_type where to compute the Jacobian
     280             : !> \par History
     281             : !>      03.2018 created [Nico Holmberg]
     282             : ! **************************************************************************************************
     283           6 :    SUBROUTINE restart_inverse_jacobian(qs_env)
     284             :       TYPE(qs_environment_type), POINTER                 :: qs_env
     285             : 
     286             :       INTEGER                                            :: i, iwork, j, nvar
     287           6 :       REAL(KIND=dp), DIMENSION(:, :), POINTER            :: inv_jacobian
     288             :       TYPE(qs_scf_env_type), POINTER                     :: scf_env
     289             :       TYPE(scf_control_type), POINTER                    :: scf_control
     290             : 
     291           6 :       NULLIFY (scf_env, scf_control)
     292           0 :       CPASSERT(ASSOCIATED(qs_env))
     293           6 :       CALL get_qs_env(qs_env, scf_env=scf_env, scf_control=scf_control)
     294             : 
     295           6 :       CPASSERT(ASSOCIATED(scf_control%outer_scf%cdft_opt_control%jacobian_vector))
     296           6 :       nvar = SIZE(scf_env%outer_scf%variables, 1)
     297           6 :       IF (SIZE(scf_control%outer_scf%cdft_opt_control%jacobian_vector) /= nvar**2) &
     298             :          CALL cp_abort(__LOCATION__, &
     299           0 :                        "Too many or too few values defined for restarting inverse Jacobian.")
     300           6 :       IF (.NOT. ASSOCIATED(scf_env%outer_scf%inv_jacobian)) &
     301          24 :          ALLOCATE (scf_env%outer_scf%inv_jacobian(nvar, nvar))
     302           6 :       inv_jacobian => scf_env%outer_scf%inv_jacobian
     303           6 :       iwork = 1
     304          16 :       DO i = 1, nvar
     305          34 :          DO j = 1, nvar
     306          18 :             inv_jacobian(i, j) = scf_control%outer_scf%cdft_opt_control%jacobian_vector(iwork)
     307          28 :             iwork = iwork + 1
     308             :          END DO
     309             :       END DO
     310           6 :       DEALLOCATE (scf_control%outer_scf%cdft_opt_control%jacobian_vector)
     311           6 :       scf_control%outer_scf%cdft_opt_control%jacobian_restart = .FALSE.
     312           6 :       scf_control%outer_scf%cdft_opt_control%broyden_update = .FALSE.
     313           6 :       scf_env%outer_scf%deallocate_jacobian = .FALSE.
     314             : 
     315           6 :    END SUBROUTINE restart_inverse_jacobian
     316             : 
     317             : ! **************************************************************************************************
     318             : !> \brief Prints the finite difference inverse Jacobian to file
     319             : !> \param logger the default IO logger
     320             : !> \param inv_jacobian the inverse Jacobian matrix
     321             : !> \param iter_count the iteration number
     322             : !> \par History
     323             : !>      03.2018 created [Nico Holmberg]
     324             : ! **************************************************************************************************
     325          55 :    SUBROUTINE print_inverse_jacobian(logger, inv_jacobian, iter_count)
     326             :       TYPE(cp_logger_type), POINTER                      :: logger
     327             :       REAL(KIND=dp), DIMENSION(:, :), INTENT(IN), &
     328             :          POINTER                                         :: inv_jacobian
     329             :       INTEGER                                            :: iter_count
     330             : 
     331             :       CHARACTER(len=default_path_length)                 :: project_name
     332             :       INTEGER                                            :: i, j, lp, nvar, output_unit
     333             : 
     334          55 :       nvar = SIZE(inv_jacobian, 1)
     335          55 :       output_unit = get_unit_number()
     336          55 :       project_name = logger%iter_info%project_name
     337          55 :       lp = LEN_TRIM(project_name)
     338          55 :       project_name(lp + 1:LEN(project_name)) = ".inverseJacobian"
     339             :       CALL open_file(file_name=project_name, file_status="UNKNOWN", &
     340             :                      file_action="WRITE", file_position="APPEND", &
     341          55 :                      unit_number=output_unit)
     342          55 :       WRITE (output_unit, FMT="(/,A)") "Inverse Jacobian matrix in row major order"
     343          55 :       WRITE (output_unit, FMT="(A,I10)") "Iteration: ", iter_count
     344         138 :       DO i = 1, nvar
     345         277 :          DO j = 1, nvar
     346         222 :             WRITE (output_unit, *) inv_jacobian(i, j)
     347             :          END DO
     348             :       END DO
     349          55 :       CALL close_file(unit_number=output_unit)
     350             : 
     351          55 :    END SUBROUTINE print_inverse_jacobian
     352             : 
     353             : ! **************************************************************************************************
     354             : !> \brief Creates a temporary logger for redirecting output to a new file
     355             : !> \param para_env the para_env
     356             : !> \param project_name the project basename
     357             : !> \param suffix the suffix
     358             : !> \param output_unit the default unit number for the newly created temporary logger
     359             : !> \param tmp_logger pointer to the newly created temporary logger
     360             : !> \par History
     361             : !>      03.2018 created [Nico Holmberg]
     362             : ! **************************************************************************************************
     363          70 :    SUBROUTINE create_tmp_logger(para_env, project_name, suffix, output_unit, tmp_logger)
     364             :       TYPE(mp_para_env_type), POINTER                    :: para_env
     365             :       CHARACTER(len=*)                                   :: project_name, suffix
     366             :       INTEGER, INTENT(OUT)                               :: output_unit
     367             :       TYPE(cp_logger_type), INTENT(OUT), POINTER         :: tmp_logger
     368             : 
     369             :       INTEGER                                            :: lp
     370             : 
     371          70 :       IF (para_env%is_source()) THEN
     372          35 :          lp = LEN_TRIM(project_name)
     373          35 :          project_name(lp + 1:LEN(project_name)) = suffix
     374             :          CALL open_file(file_name=project_name, file_status="UNKNOWN", &
     375             :                         file_action="WRITE", file_position="APPEND", &
     376          35 :                         unit_number=output_unit)
     377             :       ELSE
     378          35 :          output_unit = -1
     379             :       END IF
     380             :       CALL cp_logger_create(tmp_logger, &
     381             :                             para_env=para_env, &
     382             :                             default_global_unit_nr=output_unit, &
     383          70 :                             close_global_unit_on_dealloc=.FALSE.)
     384             : 
     385          70 :    END SUBROUTINE create_tmp_logger
     386             : 
     387             : ! **************************************************************************************************
     388             : !> \brief Checks if the inverse Jacobian should be calculated and initializes the calculation
     389             : !> \param scf_control         the scf_control that holds the Jacobian settings
     390             : !> \param scf_env             the scf_env that holds the CDFT iteration information
     391             : !> \param explicit_jacobian   flag that determines if the finite difference Jacobian is needed
     392             : !> \param should_build        flag that determines if the Jacobian should be built
     393             : !> \param used_history        flag that determines if SCF history has been used to build a Jacobian
     394             : !> \par History
     395             : !>      03.2018 created [Nico Holmberg]
     396             : ! **************************************************************************************************
     397         118 :    SUBROUTINE initialize_inverse_jacobian(scf_control, scf_env, explicit_jacobian, &
     398             :                                           should_build, used_history)
     399             :       TYPE(scf_control_type), POINTER                    :: scf_control
     400             :       TYPE(qs_scf_env_type), POINTER                     :: scf_env
     401             :       LOGICAL                                            :: explicit_jacobian, should_build, &
     402             :                                                             used_history
     403             : 
     404         118 :       CPASSERT(ASSOCIATED(scf_control))
     405         118 :       CPASSERT(ASSOCIATED(scf_env))
     406             : 
     407         118 :       SELECT CASE (scf_control%outer_scf%optimizer)
     408             :       CASE DEFAULT
     409           0 :          CPABORT("Noncompatible optimizer requested.")
     410             :       CASE (outer_scf_optimizer_newton, outer_scf_optimizer_newton_ls)
     411          94 :          CPASSERT(ASSOCIATED(scf_control%outer_scf%cdft_opt_control))
     412          94 :          scf_control%outer_scf%cdft_opt_control%build_jacobian = .TRUE.
     413          94 :          explicit_jacobian = .TRUE.
     414             :       CASE (outer_scf_optimizer_broyden)
     415          24 :          CPASSERT(ASSOCIATED(scf_control%outer_scf%cdft_opt_control))
     416         142 :          SELECT CASE (scf_control%outer_scf%cdft_opt_control%broyden_type)
     417             :          CASE (broyden_type_1, broyden_type_2, broyden_type_1_ls, broyden_type_2_ls)
     418          20 :             scf_control%outer_scf%cdft_opt_control%build_jacobian = .TRUE.
     419          20 :             explicit_jacobian = .FALSE.
     420             :          CASE (broyden_type_1_explicit, broyden_type_2_explicit, broyden_type_1_explicit_ls, broyden_type_2_explicit_ls)
     421           4 :             scf_control%outer_scf%cdft_opt_control%build_jacobian = .TRUE.
     422           4 :             explicit_jacobian = .TRUE.
     423             :          END SELECT
     424             :       END SELECT
     425         118 :       IF (scf_control%outer_scf%cdft_opt_control%build_jacobian) THEN
     426             :          ! Reset counter
     427         118 :          IF (scf_env%outer_scf%iter_count == 1) scf_control%outer_scf%cdft_opt_control%ijacobian(1) = 0
     428             :          ! Check if an old Jacobian can be reused avoiding a rebuild
     429         118 :          IF (ASSOCIATED(scf_env%outer_scf%inv_jacobian)) THEN
     430             :             ! Rebuild if number of previous energy evaluations exceeds limit
     431             :             IF (scf_control%outer_scf%cdft_opt_control%ijacobian(2) .GE. &
     432          62 :                 scf_control%outer_scf%cdft_opt_control%jacobian_freq(2) .AND. .NOT. used_history .AND. &
     433             :                 scf_control%outer_scf%cdft_opt_control%jacobian_freq(2) > 0) THEN
     434           4 :                should_build = .TRUE.
     435             :                ! Zero the corresponding counters
     436          12 :                scf_control%outer_scf%cdft_opt_control%ijacobian(:) = 0
     437             :                ! Rebuild if number of previous SCF iterations exceeds limit (on this energy eval)
     438             :             ELSE IF (scf_control%outer_scf%cdft_opt_control%ijacobian(1) .GE. &
     439          58 :                      scf_control%outer_scf%cdft_opt_control%jacobian_freq(1) .AND. &
     440             :                      scf_control%outer_scf%cdft_opt_control%jacobian_freq(1) > 0) THEN
     441          24 :                should_build = .TRUE.
     442             :                ! Zero the corresponding counter
     443          24 :                scf_control%outer_scf%cdft_opt_control%ijacobian(1) = 0
     444             :             END IF
     445          62 :             IF (should_build) DEALLOCATE (scf_env%outer_scf%inv_jacobian)
     446             :          ELSE
     447          56 :             should_build = .TRUE.
     448             :             ! Zero the counter
     449         168 :             scf_control%outer_scf%cdft_opt_control%ijacobian(:) = 0
     450             :          END IF
     451             :       END IF
     452             : 
     453         118 :    END SUBROUTINE initialize_inverse_jacobian
     454             : 
     455             : END MODULE qs_cdft_scf_utils

Generated by: LCOV version 1.15