LCOV - code coverage report
Current view: top level - src - replica_methods.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:2fce0f8) Lines: 208 217 95.9 %
Date: 2024-12-21 06:28:57 Functions: 5 5 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 methods to setup replicas of the same system differing only by atom
      10             : !>      positions and velocities (as used in path integral or nudged elastic
      11             : !>      band for example)
      12             : !> \par History
      13             : !>      09.2005 created [fawzi]
      14             : !> \author fawzi
      15             : ! **************************************************************************************************
      16             : MODULE replica_methods
      17             :    USE cp_control_types,                ONLY: dft_control_type
      18             :    USE cp_files,                        ONLY: close_file,&
      19             :                                               open_file
      20             :    USE cp_log_handling,                 ONLY: cp_get_default_logger,&
      21             :                                               cp_logger_get_default_io_unit,&
      22             :                                               cp_logger_type,&
      23             :                                               cp_to_string
      24             :    USE cp_output_handling,              ONLY: cp_add_iter_level
      25             :    USE cp_result_types,                 ONLY: cp_result_create,&
      26             :                                               cp_result_retain
      27             :    USE cp_subsys_types,                 ONLY: cp_subsys_get,&
      28             :                                               cp_subsys_set,&
      29             :                                               cp_subsys_type
      30             :    USE f77_interface,                   ONLY: calc_force,&
      31             :                                               create_force_env,&
      32             :                                               f_env_add_defaults,&
      33             :                                               f_env_rm_defaults,&
      34             :                                               f_env_type,&
      35             :                                               get_nparticle,&
      36             :                                               get_pos,&
      37             :                                               set_vel
      38             :    USE force_env_types,                 ONLY: force_env_get,&
      39             :                                               use_qs_force
      40             :    USE input_section_types,             ONLY: section_type,&
      41             :                                               section_vals_type,&
      42             :                                               section_vals_val_get,&
      43             :                                               section_vals_val_set,&
      44             :                                               section_vals_write
      45             :    USE kinds,                           ONLY: default_path_length,&
      46             :                                               dp
      47             :    USE message_passing,                 ONLY: mp_comm_null,&
      48             :                                               mp_para_cart_type,&
      49             :                                               mp_para_env_type
      50             :    USE qs_environment_types,            ONLY: get_qs_env,&
      51             :                                               qs_environment_type,&
      52             :                                               set_qs_env
      53             :    USE qs_wf_history_methods,           ONLY: wfi_create,&
      54             :                                               wfi_create_for_kp
      55             :    USE qs_wf_history_types,             ONLY: wfi_retain
      56             :    USE replica_types,                   ONLY: rep_env_sync,&
      57             :                                               rep_env_sync_results,&
      58             :                                               rep_envs_add_rep_env,&
      59             :                                               rep_envs_get_rep_env,&
      60             :                                               replica_env_type
      61             : #include "./base/base_uses.f90"
      62             : 
      63             :    IMPLICIT NONE
      64             :    PRIVATE
      65             : 
      66             :    LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
      67             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'replica_methods'
      68             :    INTEGER, SAVE, PRIVATE :: last_rep_env_id = 0
      69             : 
      70             :    PUBLIC :: rep_env_create, rep_env_calc_e_f
      71             : 
      72             : CONTAINS
      73             : 
      74             : ! **************************************************************************************************
      75             : !> \brief creates a replica environment together with its force environment
      76             : !> \param rep_env the replica environment that will be created
      77             : !> \param para_env the parallel environment that will contain the replicas
      78             : !> \param input the input used to initialize the force environment
      79             : !> \param input_declaration ...
      80             : !> \param nrep the number of replicas to calculate
      81             : !> \param prep the number of processors for each replica
      82             : !> \param sync_v if the velocity should be synchronized (defaults to false)
      83             : !> \param keep_wf_history if wf history should be kept on a per replica
      84             : !>        basis (defaults to true for QS jobs)
      85             : !> \param row_force to use the new mapping to the cart with rows
      86             : !>        working on force instead of columns.
      87             : !> \author fawzi
      88             : ! **************************************************************************************************
      89         144 :    SUBROUTINE rep_env_create(rep_env, para_env, input, input_declaration, nrep, prep, &
      90             :                              sync_v, keep_wf_history, row_force)
      91             :       TYPE(replica_env_type), POINTER                    :: rep_env
      92             :       TYPE(mp_para_env_type), POINTER                    :: para_env
      93             :       TYPE(section_vals_type), POINTER                   :: input
      94             :       TYPE(section_type), POINTER                        :: input_declaration
      95             :       INTEGER                                            :: nrep, prep
      96             :       LOGICAL, INTENT(in), OPTIONAL                      :: sync_v, keep_wf_history, row_force
      97             : 
      98             :       CHARACTER(len=default_path_length)                 :: input_file_path, output_file_path
      99             :       INTEGER                                            :: forcedim, i, i0, ierr, ip, ir, irep, lp, &
     100             :                                                             my_prep, new_env_id, nparticle, &
     101             :                                                             nrep_local, unit_nr
     102         144 :       INTEGER, ALLOCATABLE, DIMENSION(:, :)              :: gridinfo
     103             :       INTEGER, DIMENSION(2)                              :: dims, pos
     104             :       TYPE(cp_logger_type), POINTER                      :: logger
     105             :       TYPE(mp_para_cart_type), POINTER                   :: cart
     106             :       TYPE(mp_para_env_type), POINTER                    :: para_env_f, para_env_full, &
     107             :                                                             para_env_inter_rep
     108             : 
     109         144 :       CPASSERT(.NOT. ASSOCIATED(rep_env))
     110         144 :       CPASSERT(ASSOCIATED(input_declaration))
     111             : 
     112         144 :       NULLIFY (cart, para_env_f, para_env_inter_rep)
     113         144 :       logger => cp_get_default_logger()
     114         144 :       unit_nr = cp_logger_get_default_io_unit(logger)
     115         144 :       new_env_id = -1
     116         144 :       forcedim = 1
     117         144 :       IF (PRESENT(row_force)) THEN
     118         144 :          IF (row_force) forcedim = 2
     119             :       END IF
     120         144 :       my_prep = MIN(prep, para_env%num_pe)
     121         144 :       dims(3 - forcedim) = MIN(para_env%num_pe/my_prep, nrep)
     122         144 :       dims(forcedim) = my_prep
     123         144 :       IF ((dims(1)*dims(2) /= para_env%num_pe) .AND. (unit_nr > 0)) THEN
     124           0 :          WRITE (unit_nr, FMT="(T2,A)") "REPLICA| WARNING: number of processors is not divisible by the number of replicas"
     125           0 :          WRITE (unit_nr, FMT="(T2,A,I0,A)") "REPLICA| ", para_env%num_pe - dims(1)*dims(2), " MPI process(es) will be idle"
     126             :       END IF
     127         144 :       ALLOCATE (cart)
     128         144 :       CALL cart%create(comm_old=para_env, ndims=2, dims=dims)
     129         144 :       IF (cart /= mp_comm_null) THEN
     130         432 :          pos = cart%mepos_cart
     131         144 :          ALLOCATE (para_env_full)
     132         144 :          para_env_full = cart
     133         144 :          ALLOCATE (para_env_f)
     134         144 :          CALL para_env_f%from_split(cart, pos(3 - forcedim))
     135         144 :          ALLOCATE (para_env_inter_rep)
     136         144 :          CALL para_env_inter_rep%from_split(cart, pos(forcedim))
     137         144 :          ALLOCATE (rep_env)
     138             :       ELSE
     139           0 :          pos = -1
     140           0 :          DEALLOCATE (cart)
     141             :       END IF
     142         432 :       ALLOCATE (gridinfo(2, 0:para_env%num_pe - 1))
     143        1008 :       gridinfo = 0
     144         432 :       gridinfo(:, para_env%mepos) = pos
     145         144 :       CALL para_env%sum(gridinfo)
     146         144 :       IF (unit_nr > 0) THEN
     147          72 :          WRITE (unit_nr, FMT="(T2,A,T71,I10)") "REPLICA| layout of the replica grid, number of groups ", para_env_inter_rep%num_pe
     148          72 :          WRITE (unit_nr, FMT="(T2,A,T71,I10)") "REPLICA| layout of the replica grid, size of each group", para_env_f%num_pe
     149          72 :          WRITE (unit_nr, FMT="(T2,A)", ADVANCE="NO") "REPLICA| MPI process to grid (group,rank) correspondence:"
     150         216 :          DO i = 0, para_env%num_pe - 1
     151         144 :             IF (MODULO(i, 4) == 0) WRITE (unit_nr, *)
     152             :             WRITE (unit_nr, FMT='(A3,I4,A3,I4,A1,I4,A1)', ADVANCE="NO") &
     153         144 :                "  (", i, " : ", gridinfo(3 - forcedim, i), ",", &
     154         360 :                gridinfo(forcedim, i), ")"
     155             :          END DO
     156          72 :          WRITE (unit_nr, *)
     157             :       END IF
     158         144 :       DEALLOCATE (gridinfo)
     159         144 :       IF (ASSOCIATED(rep_env)) THEN
     160         144 :          last_rep_env_id = last_rep_env_id + 1
     161         144 :          rep_env%id_nr = last_rep_env_id
     162         144 :          rep_env%ref_count = 1
     163         144 :          rep_env%nrep = nrep
     164         144 :          rep_env%sync_v = .FALSE.
     165         144 :          IF (PRESENT(sync_v)) rep_env%sync_v = sync_v
     166         144 :          rep_env%keep_wf_history = .TRUE.
     167         144 :          IF (PRESENT(keep_wf_history)) rep_env%keep_wf_history = keep_wf_history
     168         144 :          NULLIFY (rep_env%wf_history)
     169         144 :          NULLIFY (rep_env%results)
     170             : 
     171         144 :          rep_env%force_dim = forcedim
     172         144 :          rep_env%my_rep_group = cart%mepos_cart(3 - forcedim)
     173             :          ALLOCATE (rep_env%inter_rep_rank(0:para_env_inter_rep%num_pe - 1), &
     174         720 :                    rep_env%force_rank(0:para_env_f%num_pe - 1))
     175         402 :          rep_env%inter_rep_rank = 0
     176         144 :          rep_env%inter_rep_rank(rep_env%my_rep_group) = para_env_inter_rep%mepos
     177         660 :          CALL para_env_inter_rep%sum(rep_env%inter_rep_rank)
     178         318 :          rep_env%force_rank = 0
     179         144 :          rep_env%force_rank(cart%mepos_cart(forcedim)) = para_env_f%mepos
     180         492 :          CALL para_env_f%sum(rep_env%force_rank)
     181             : 
     182             :          CALL section_vals_val_get(input, "GLOBAL%PROJECT_NAME", &
     183         144 :                                    c_val=input_file_path)
     184         144 :          rep_env%original_project_name = input_file_path
     185             :          ! By default replica_env handles files for each replica
     186             :          ! with the structure PROJECT_NAME-r-N where N is the
     187             :          ! number of the local replica..
     188         144 :          lp = LEN_TRIM(input_file_path)
     189             :          input_file_path(lp + 1:LEN(input_file_path)) = "-r-"// &
     190         144 :                                                         ADJUSTL(cp_to_string(rep_env%my_rep_group))
     191         144 :          lp = LEN_TRIM(input_file_path)
     192             :          ! Setup new project name
     193             :          CALL section_vals_val_set(input, "GLOBAL%PROJECT_NAME", &
     194         144 :                                    c_val=input_file_path)
     195             :          ! Redirect the output of each replica on a same local file
     196         144 :          output_file_path = input_file_path(1:lp)//".out"
     197             :          CALL section_vals_val_set(input, "GLOBAL%OUTPUT_FILE_NAME", &
     198         144 :                                    c_val=TRIM(output_file_path))
     199             : 
     200             :          ! Dump an input file to warm-up new force_eval structures and
     201             :          ! delete them immediately afterwards..
     202         144 :          input_file_path(lp + 1:LEN(input_file_path)) = ".inp"
     203         144 :          IF (para_env_f%is_source()) THEN
     204             :             CALL open_file(file_name=TRIM(input_file_path), file_status="UNKNOWN", &
     205             :                            file_form="FORMATTED", file_action="WRITE", &
     206         129 :                            unit_number=unit_nr)
     207         129 :             CALL section_vals_write(input, unit_nr, hide_root=.TRUE.)
     208         129 :             CALL close_file(unit_nr)
     209             :          END IF
     210             :          CALL create_force_env(new_env_id, input_declaration, input_file_path, &
     211         144 :                                output_file_path, para_env_f, ierr=ierr)
     212         144 :          CPASSERT(ierr == 0)
     213             : 
     214             :          ! Delete input files..
     215         144 :          IF (para_env_f%is_source()) THEN
     216             :             CALL open_file(file_name=TRIM(input_file_path), file_status="OLD", &
     217         129 :                            file_form="FORMATTED", file_action="READ", unit_number=unit_nr)
     218         129 :             CALL close_file(unit_number=unit_nr, file_status="DELETE")
     219             :          END IF
     220             : 
     221         144 :          rep_env%f_env_id = new_env_id
     222         144 :          CALL get_nparticle(new_env_id, nparticle, ierr)
     223         144 :          CPASSERT(ierr == 0)
     224         144 :          rep_env%nparticle = nparticle
     225         144 :          rep_env%ndim = 3*nparticle
     226         432 :          ALLOCATE (rep_env%replica_owner(nrep))
     227             : 
     228         144 :          i0 = nrep/para_env_inter_rep%num_pe
     229         144 :          ir = MODULO(nrep, para_env_inter_rep%num_pe)
     230         402 :          DO ip = 0, para_env_inter_rep%num_pe - 1
     231         892 :             DO i = i0*ip + MIN(ip, ir) + 1, i0*(ip + 1) + MIN(ip + 1, ir)
     232         748 :                rep_env%replica_owner(i) = ip
     233             :             END DO
     234             :          END DO
     235             : 
     236         144 :          nrep_local = i0
     237         144 :          IF (rep_env%my_rep_group < ir) nrep_local = nrep_local + 1
     238             :          ALLOCATE (rep_env%local_rep_indices(nrep_local), &
     239         576 :                    rep_env%rep_is_local(nrep))
     240         144 :          nrep_local = 0
     241         634 :          rep_env%rep_is_local = .FALSE.
     242         634 :          DO irep = 1, nrep
     243         634 :             IF (rep_env%replica_owner(irep) == rep_env%my_rep_group) THEN
     244         260 :                nrep_local = nrep_local + 1
     245         260 :                rep_env%local_rep_indices(nrep_local) = irep
     246         260 :                rep_env%rep_is_local(irep) = .TRUE.
     247             :             END IF
     248             :          END DO
     249         144 :          CPASSERT(nrep_local == SIZE(rep_env%local_rep_indices))
     250             : 
     251         144 :          rep_env%cart => cart
     252         144 :          rep_env%para_env => para_env_full
     253         144 :          rep_env%para_env_f => para_env_f
     254         144 :          rep_env%para_env_inter_rep => para_env_inter_rep
     255             : 
     256             :          ALLOCATE (rep_env%r(rep_env%ndim, nrep), rep_env%v(rep_env%ndim, nrep), &
     257        1440 :                    rep_env%f(rep_env%ndim + 1, nrep))
     258             : 
     259      313270 :          rep_env%r = 0._dp
     260      313760 :          rep_env%f = 0._dp
     261      313270 :          rep_env%v = 0._dp
     262         144 :          CALL set_vel(rep_env%f_env_id, rep_env%v(:, 1), rep_env%ndim, ierr)
     263         144 :          CPASSERT(ierr == 0)
     264         778 :          DO i = 1, nrep
     265         634 :             IF (rep_env%rep_is_local(i)) THEN
     266         260 :                CALL get_pos(rep_env%f_env_id, rep_env%r(:, i), rep_env%ndim, ierr)
     267         260 :                CPASSERT(ierr == 0)
     268             :             END IF
     269             :          END DO
     270             :       END IF
     271         144 :       IF (ASSOCIATED(rep_env)) THEN
     272         144 :          CALL rep_envs_add_rep_env(rep_env)
     273         144 :          CALL rep_env_init_low(rep_env%id_nr, ierr)
     274         144 :          CPASSERT(ierr == 0)
     275             :       END IF
     276         144 :    END SUBROUTINE rep_env_create
     277             : 
     278             : ! **************************************************************************************************
     279             : !> \brief finishes the low level initialization of the replica env
     280             : !> \param rep_env_id id_nr of the replica environment that should be initialized
     281             : !> \param ierr will be non zero if there is an initialization error
     282             : !> \author fawzi
     283             : ! **************************************************************************************************
     284         144 :    SUBROUTINE rep_env_init_low(rep_env_id, ierr)
     285             :       INTEGER, INTENT(in)                                :: rep_env_id
     286             :       INTEGER, INTENT(out)                               :: ierr
     287             : 
     288             :       INTEGER                                            :: i, in_use, stat
     289             :       LOGICAL                                            :: do_kpoints, has_unit_metric
     290             :       TYPE(cp_logger_type), POINTER                      :: logger
     291             :       TYPE(cp_subsys_type), POINTER                      :: subsys
     292             :       TYPE(dft_control_type), POINTER                    :: dft_control
     293             :       TYPE(f_env_type), POINTER                          :: f_env
     294             :       TYPE(qs_environment_type), POINTER                 :: qs_env
     295             :       TYPE(replica_env_type), POINTER                    :: rep_env
     296             : 
     297         144 :       rep_env => rep_envs_get_rep_env(rep_env_id, ierr=stat)
     298         144 :       IF (.NOT. ASSOCIATED(rep_env)) &
     299           0 :          CPABORT("could not find rep_env with id_nr"//cp_to_string(rep_env_id))
     300         144 :       NULLIFY (qs_env, dft_control, subsys)
     301         144 :       CALL f_env_add_defaults(f_env_id=rep_env%f_env_id, f_env=f_env)
     302         144 :       logger => cp_get_default_logger()
     303         144 :       logger%iter_info%iteration(1) = rep_env%my_rep_group
     304             :       CALL cp_add_iter_level(iteration_info=logger%iter_info, &
     305         144 :                              level_name="REPLICA_EVAL")
     306             :       !wf interp
     307         144 :       IF (rep_env%keep_wf_history) THEN
     308         144 :          CALL force_env_get(f_env%force_env, in_use=in_use)
     309         144 :          IF (in_use == use_qs_force) THEN
     310          30 :             CALL force_env_get(f_env%force_env, qs_env=qs_env)
     311          30 :             CALL get_qs_env(qs_env, dft_control=dft_control)
     312         126 :             ALLOCATE (rep_env%wf_history(SIZE(rep_env%local_rep_indices)))
     313          66 :             DO i = 1, SIZE(rep_env%wf_history)
     314          36 :                NULLIFY (rep_env%wf_history(i)%wf_history)
     315          66 :                IF (i == 1) THEN
     316             :                   CALL get_qs_env(qs_env, &
     317          30 :                                   wf_history=rep_env%wf_history(i)%wf_history)
     318          30 :                   CALL wfi_retain(rep_env%wf_history(i)%wf_history)
     319             :                ELSE
     320             :                   CALL get_qs_env(qs_env, has_unit_metric=has_unit_metric, &
     321           6 :                                   do_kpoints=do_kpoints)
     322             :                   CALL wfi_create(rep_env%wf_history(i)%wf_history, &
     323             :                                   interpolation_method_nr= &
     324             :                                   dft_control%qs_control%wf_interpolation_method_nr, &
     325             :                                   extrapolation_order=dft_control%qs_control%wf_extrapolation_order, &
     326           6 :                                   has_unit_metric=has_unit_metric)
     327           6 :                   IF (do_kpoints) THEN
     328           0 :                      CALL wfi_create_for_kp(rep_env%wf_history(i)%wf_history)
     329             :                   END IF
     330             :                END IF
     331             :             END DO
     332             :          ELSE
     333         114 :             rep_env%keep_wf_history = .FALSE.
     334             :          END IF
     335             :       END IF
     336         922 :       ALLOCATE (rep_env%results(rep_env%nrep))
     337         634 :       DO i = 1, rep_env%nrep
     338         490 :          NULLIFY (rep_env%results(i)%results)
     339         634 :          IF (i == 1) THEN
     340         144 :             CALL force_env_get(f_env%force_env, subsys=subsys)
     341         144 :             CALL cp_subsys_get(subsys, results=rep_env%results(i)%results)
     342         144 :             CALL cp_result_retain(rep_env%results(i)%results)
     343             :          ELSE
     344         346 :             CALL cp_result_create(rep_env%results(i)%results)
     345             :          END IF
     346             :       END DO
     347         144 :       CALL rep_env_sync(rep_env, rep_env%r)
     348         144 :       CALL rep_env_sync(rep_env, rep_env%v)
     349         144 :       CALL rep_env_sync(rep_env, rep_env%f)
     350             : 
     351         144 :       CALL f_env_rm_defaults(f_env, ierr)
     352         144 :       CPASSERT(ierr == 0)
     353         144 :    END SUBROUTINE rep_env_init_low
     354             : 
     355             : ! **************************************************************************************************
     356             : !> \brief evaluates the forces
     357             : !> \param rep_env the replica environment on which you want to evaluate the
     358             : !>        forces
     359             : !> \param calc_f if true calculates also the forces, if false only the
     360             : !>        energy
     361             : !> \author fawzi
     362             : !> \note
     363             : !>      indirect through f77_int_low to work around fortran madness
     364             : ! **************************************************************************************************
     365        7800 :    SUBROUTINE rep_env_calc_e_f(rep_env, calc_f)
     366             :       TYPE(replica_env_type), POINTER                    :: rep_env
     367             :       LOGICAL, OPTIONAL                                  :: calc_f
     368             : 
     369             :       CHARACTER(len=*), PARAMETER                        :: routineN = 'rep_env_calc_e_f'
     370             : 
     371             :       INTEGER                                            :: handle, ierr, my_calc_f
     372             : 
     373        3900 :       CALL timeset(routineN, handle)
     374        3900 :       CPASSERT(ASSOCIATED(rep_env))
     375        3900 :       CPASSERT(rep_env%ref_count > 0)
     376        3900 :       my_calc_f = 0
     377        3900 :       IF (PRESENT(calc_f)) THEN
     378        3900 :          IF (calc_f) my_calc_f = 1
     379             :       END IF
     380        3900 :       CALL rep_env_calc_e_f_low(rep_env%id_nr, my_calc_f, ierr)
     381        3900 :       CPASSERT(ierr == 0)
     382        3900 :       CALL timestop(handle)
     383        3900 :    END SUBROUTINE rep_env_calc_e_f
     384             : 
     385             : ! **************************************************************************************************
     386             : !> \brief calculates energy and force, internal private method
     387             : !> \param rep_env_id the id if the replica environment in which energy and
     388             : !>        forces have to be evaluated
     389             : !> \param calc_f if nonzero calculates also the forces along with the
     390             : !>        energy
     391             : !> \param ierr if an error happens this will be nonzero
     392             : !> \author fawzi
     393             : !> \note
     394             : !>      low level wrapper to export this function in f77_int_low and work
     395             : !>      around the handling of circular dependencies in fortran
     396             : ! **************************************************************************************************
     397        3900 :    RECURSIVE SUBROUTINE rep_env_calc_e_f_low(rep_env_id, calc_f, ierr)
     398             :       INTEGER, INTENT(in)                                :: rep_env_id, calc_f
     399             :       INTEGER, INTENT(out)                               :: ierr
     400             : 
     401             :       TYPE(f_env_type), POINTER                          :: f_env
     402             :       TYPE(replica_env_type), POINTER                    :: rep_env
     403             : 
     404        3900 :       rep_env => rep_envs_get_rep_env(rep_env_id, ierr)
     405        3900 :       IF (ASSOCIATED(rep_env)) THEN
     406        3900 :          CALL f_env_add_defaults(f_env_id=rep_env%f_env_id, f_env=f_env)
     407        3900 :          CALL rep_env_calc_e_f_int(rep_env, calc_f /= 0)
     408        3900 :          CALL f_env_rm_defaults(f_env, ierr)
     409             :       ELSE
     410           0 :          ierr = 111
     411             :       END IF
     412        3900 :    END SUBROUTINE rep_env_calc_e_f_low
     413             : 
     414             : ! **************************************************************************************************
     415             : !> \brief calculates energy and force, internal private method
     416             : !> \param rep_env the replica env to update
     417             : !> \param calc_f if the force should be calculated as well (defaults to true)
     418             : !> \author fawzi
     419             : !> \note
     420             : !>      this is the where the real work is done
     421             : ! **************************************************************************************************
     422        7800 :    SUBROUTINE rep_env_calc_e_f_int(rep_env, calc_f)
     423             :       TYPE(replica_env_type), POINTER                    :: rep_env
     424             :       LOGICAL, OPTIONAL                                  :: calc_f
     425             : 
     426             :       INTEGER                                            :: i, ierr, irep, md_iter, my_calc_f, ndim
     427             :       TYPE(cp_logger_type), POINTER                      :: logger
     428             :       TYPE(cp_subsys_type), POINTER                      :: subsys
     429             :       TYPE(f_env_type), POINTER                          :: f_env
     430             :       TYPE(qs_environment_type), POINTER                 :: qs_env
     431             : 
     432        3900 :       NULLIFY (f_env, qs_env, subsys)
     433        3900 :       CPASSERT(ASSOCIATED(rep_env))
     434        3900 :       CPASSERT(rep_env%ref_count > 0)
     435        3900 :       my_calc_f = 3*rep_env%nparticle
     436        3900 :       IF (PRESENT(calc_f)) THEN
     437        3900 :          IF (.NOT. calc_f) my_calc_f = 0
     438             :       END IF
     439             : 
     440        3900 :       CALL f_env_add_defaults(f_env_id=rep_env%f_env_id, f_env=f_env)
     441        3900 :       logger => cp_get_default_logger()
     442             :       !     md_iter=logger%iter_info%iteration(2)+1
     443        3900 :       md_iter = logger%iter_info%iteration(2)
     444        3900 :       CALL f_env_rm_defaults(f_env, ierr)
     445        3900 :       CPASSERT(ierr == 0)
     446        9106 :       DO i = 1, SIZE(rep_env%local_rep_indices)
     447        5206 :          irep = rep_env%local_rep_indices(i)
     448        5206 :          ndim = 3*rep_env%nparticle
     449        5206 :          IF (rep_env%sync_v) THEN
     450           0 :             CALL set_vel(rep_env%f_env_id, rep_env%v(:, irep), ndim, ierr)
     451           0 :             CPASSERT(ierr == 0)
     452             :          END IF
     453             : 
     454        5206 :          logger%iter_info%iteration(1) = irep
     455        5206 :          logger%iter_info%iteration(2) = md_iter
     456             : 
     457        5206 :          IF (rep_env%keep_wf_history) THEN
     458         372 :             CALL f_env_add_defaults(f_env_id=rep_env%f_env_id, f_env=f_env)
     459         372 :             CALL force_env_get(f_env%force_env, qs_env=qs_env)
     460             :             CALL set_qs_env(qs_env, &
     461         372 :                             wf_history=rep_env%wf_history(i)%wf_history)
     462         372 :             CALL f_env_rm_defaults(f_env, ierr)
     463         372 :             CPASSERT(ierr == 0)
     464             :          END IF
     465             : 
     466        5206 :          CALL f_env_add_defaults(f_env_id=rep_env%f_env_id, f_env=f_env)
     467        5206 :          CALL force_env_get(f_env%force_env, subsys=subsys)
     468        5206 :          CALL cp_subsys_set(subsys, results=rep_env%results(irep)%results)
     469        5206 :          CALL f_env_rm_defaults(f_env, ierr)
     470        5206 :          CPASSERT(ierr == 0)
     471             :          CALL calc_force(rep_env%f_env_id, rep_env%r(:, irep), ndim, &
     472             :                          rep_env%f(ndim + 1, irep), rep_env%f(:ndim, irep), &
     473        5206 :                          my_calc_f, ierr)
     474       14312 :          CPASSERT(ierr == 0)
     475             :       END DO
     476        3900 :       CALL rep_env_sync(rep_env, rep_env%f)
     477        3900 :       CALL rep_env_sync_results(rep_env, rep_env%results)
     478             : 
     479        3900 :    END SUBROUTINE rep_env_calc_e_f_int
     480             : 
     481             : END MODULE replica_methods

Generated by: LCOV version 1.15