LCOV - code coverage report
Current view: top level - src - f77_interface.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:3130539) Lines: 410 519 79.0 %
Date: 2025-05-14 06:57:18 Functions: 21 29 72.4 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2025 CP2K developers group <https://cp2k.org>                                   !
       4             : !                                                                                                  !
       5             : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6             : !--------------------------------------------------------------------------------------------------!
       7             : 
       8             : ! **************************************************************************************************
       9             : !> \brief interface to use cp2k as library
      10             : !> \note
      11             : !>      useful additions for the future would be:
      12             : !>      - string(path) based set/get of simple values (to change the new
      13             : !>        input during the run and extract more data (energy types for example).
      14             : !>      - set/get of a subset of atoms
      15             : !> \par History
      16             : !>      07.2004 created [fawzi]
      17             : !>      11.2004 parallel version [fawzi]
      18             : !> \author fawzi & Johanna
      19             : ! **************************************************************************************************
      20             : MODULE f77_interface
      21             :    USE base_hooks,                      ONLY: cp_abort_hook,&
      22             :                                               cp_warn_hook,&
      23             :                                               timeset_hook,&
      24             :                                               timestop_hook
      25             :    USE bibliography,                    ONLY: add_all_references
      26             :    USE cell_methods,                    ONLY: init_cell
      27             :    USE cell_types,                      ONLY: cell_type
      28             :    USE cp2k_info,                       ONLY: get_runtime_info
      29             :    USE cp_dbcsr_api,                    ONLY: dbcsr_finalize_lib,&
      30             :                                               dbcsr_init_lib
      31             :    USE cp_dlaf_utils_api,               ONLY: cp_dlaf_finalize,&
      32             :                                               cp_dlaf_free_all_grids
      33             :    USE cp_error_handling,               ONLY: cp_error_handling_setup
      34             :    USE cp_files,                        ONLY: init_preconnection_list,&
      35             :                                               open_file
      36             :    USE cp_log_handling,                 ONLY: &
      37             :         cp_add_default_logger, cp_default_logger_stack_size, cp_failure_level, &
      38             :         cp_get_default_logger, cp_logger_create, cp_logger_get_default_unit_nr, cp_logger_release, &
      39             :         cp_logger_retain, cp_logger_type, cp_rm_default_logger, cp_to_string
      40             :    USE cp_output_handling,              ONLY: cp_iterate
      41             :    USE cp_result_methods,               ONLY: get_results,&
      42             :                                               test_for_result
      43             :    USE cp_result_types,                 ONLY: cp_result_type
      44             :    USE cp_subsys_types,                 ONLY: cp_subsys_get,&
      45             :                                               cp_subsys_set,&
      46             :                                               cp_subsys_type,&
      47             :                                               unpack_subsys_particles
      48             :    USE dbm_api,                         ONLY: dbm_library_finalize,&
      49             :                                               dbm_library_init
      50             :    USE eip_environment,                 ONLY: eip_init
      51             :    USE eip_environment_types,           ONLY: eip_env_create,&
      52             :                                               eip_environment_type
      53             :    USE embed_main,                      ONLY: embed_create_force_env
      54             :    USE embed_types,                     ONLY: embed_env_type
      55             :    USE environment,                     ONLY: cp2k_finalize,&
      56             :                                               cp2k_init,&
      57             :                                               cp2k_read,&
      58             :                                               cp2k_setup
      59             :    USE fist_main,                       ONLY: fist_create_force_env
      60             :    USE force_env_methods,               ONLY: force_env_calc_energy_force,&
      61             :                                               force_env_create
      62             :    USE force_env_types,                 ONLY: &
      63             :         force_env_get, force_env_get_frc, force_env_get_natom, force_env_get_nparticle, &
      64             :         force_env_get_pos, force_env_get_vel, force_env_release, force_env_retain, force_env_set, &
      65             :         force_env_type, multiple_fe_list
      66             :    USE fp_types,                        ONLY: fp_env_create,&
      67             :                                               fp_env_read,&
      68             :                                               fp_env_write,&
      69             :                                               fp_type
      70             :    USE global_types,                    ONLY: global_environment_type,&
      71             :                                               globenv_create,&
      72             :                                               globenv_release
      73             :    USE grid_api,                        ONLY: grid_library_finalize,&
      74             :                                               grid_library_init
      75             :    USE input_constants,                 ONLY: &
      76             :         do_eip, do_embed, do_fist, do_ipi, do_mixed, do_nnp, do_qmmm, do_qmmmx, do_qs, do_sirius
      77             :    USE input_cp2k_check,                ONLY: check_cp2k_input
      78             :    USE input_cp2k_force_eval,           ONLY: create_force_eval_section
      79             :    USE input_cp2k_read,                 ONLY: empty_initial_variables,&
      80             :                                               read_input
      81             :    USE input_enumeration_types,         ONLY: enum_i2c,&
      82             :                                               enumeration_type
      83             :    USE input_keyword_types,             ONLY: keyword_get,&
      84             :                                               keyword_type
      85             :    USE input_section_types,             ONLY: &
      86             :         section_get_keyword, section_release, section_type, section_vals_duplicate, &
      87             :         section_vals_get, section_vals_get_subs_vals, section_vals_release, &
      88             :         section_vals_remove_values, section_vals_retain, section_vals_type, section_vals_val_get, &
      89             :         section_vals_write
      90             :    USE ipi_environment,                 ONLY: ipi_init
      91             :    USE ipi_environment_types,           ONLY: ipi_environment_type
      92             :    USE kinds,                           ONLY: default_path_length,&
      93             :                                               default_string_length,&
      94             :                                               dp
      95             :    USE machine,                         ONLY: default_output_unit,&
      96             :                                               m_chdir,&
      97             :                                               m_getcwd,&
      98             :                                               m_memory
      99             :    USE message_passing,                 ONLY: mp_comm_type,&
     100             :                                               mp_comm_world,&
     101             :                                               mp_para_env_release,&
     102             :                                               mp_para_env_type,&
     103             :                                               mp_world_finalize,&
     104             :                                               mp_world_init
     105             :    USE metadynamics_types,              ONLY: meta_env_type
     106             :    USE metadynamics_utils,              ONLY: metadyn_read
     107             :    USE mixed_environment_types,         ONLY: mixed_environment_type
     108             :    USE mixed_main,                      ONLY: mixed_create_force_env
     109             :    USE mp_perf_env,                     ONLY: add_mp_perf_env,&
     110             :                                               get_mp_perf_env,&
     111             :                                               mp_perf_env_release,&
     112             :                                               mp_perf_env_retain,&
     113             :                                               mp_perf_env_type,&
     114             :                                               rm_mp_perf_env
     115             :    USE nnp_environment,                 ONLY: nnp_init
     116             :    USE nnp_environment_types,           ONLY: nnp_type
     117             :    USE offload_api,                     ONLY: offload_get_device_count,&
     118             :                                               offload_init,&
     119             :                                               offload_set_chosen_device
     120             :    USE periodic_table,                  ONLY: init_periodic_table
     121             :    USE pw_fpga,                         ONLY: pw_fpga_finalize,&
     122             :                                               pw_fpga_init
     123             :    USE pw_gpu,                          ONLY: pw_gpu_finalize,&
     124             :                                               pw_gpu_init
     125             :    USE pwdft_environment,               ONLY: pwdft_init
     126             :    USE pwdft_environment_types,         ONLY: pwdft_env_create,&
     127             :                                               pwdft_environment_type
     128             :    USE qmmm_create,                     ONLY: qmmm_env_create
     129             :    USE qmmm_types,                      ONLY: qmmm_env_type
     130             :    USE qmmmx_create,                    ONLY: qmmmx_env_create
     131             :    USE qmmmx_types,                     ONLY: qmmmx_env_type
     132             :    USE qs_environment,                  ONLY: qs_init
     133             :    USE qs_environment_types,            ONLY: get_qs_env,&
     134             :                                               qs_env_create,&
     135             :                                               qs_environment_type
     136             :    USE reference_manager,               ONLY: remove_all_references
     137             :    USE sirius_interface,                ONLY: cp_sirius_finalize,&
     138             :                                               cp_sirius_init
     139             :    USE string_table,                    ONLY: string_table_allocate,&
     140             :                                               string_table_deallocate
     141             :    USE timings,                         ONLY: add_timer_env,&
     142             :                                               get_timer_env,&
     143             :                                               rm_timer_env,&
     144             :                                               timer_env_release,&
     145             :                                               timer_env_retain,&
     146             :                                               timings_register_hooks
     147             :    USE timings_types,                   ONLY: timer_env_type
     148             :    USE virial_types,                    ONLY: virial_type
     149             : #include "./base/base_uses.f90"
     150             : 
     151             :    IMPLICIT NONE
     152             :    PRIVATE
     153             : 
     154             :    LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
     155             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'f77_interface'
     156             : 
     157             : ! **************************************************************************************************
     158             :    TYPE f_env_p_type
     159             :       TYPE(f_env_type), POINTER :: f_env => NULL()
     160             :    END TYPE f_env_p_type
     161             : 
     162             : ! **************************************************************************************************
     163             :    TYPE f_env_type
     164             :       INTEGER :: id_nr = 0
     165             :       TYPE(force_env_type), POINTER      :: force_env => NULL()
     166             :       TYPE(cp_logger_type), POINTER      :: logger => NULL()
     167             :       TYPE(timer_env_type), POINTER      :: timer_env => NULL()
     168             :       TYPE(mp_perf_env_type), POINTER    :: mp_perf_env => NULL()
     169             :       CHARACTER(len=default_path_length) :: my_path = "", old_path = ""
     170             :    END TYPE f_env_type
     171             : 
     172             :    TYPE(f_env_p_type), DIMENSION(:), POINTER, SAVE :: f_envs
     173             :    TYPE(mp_para_env_type), POINTER, SAVE :: default_para_env
     174             :    LOGICAL, SAVE :: module_initialized = .FALSE.
     175             :    INTEGER, SAVE :: last_f_env_id = 0, n_f_envs = 0
     176             : 
     177             :    PUBLIC :: default_para_env
     178             :    PUBLIC :: init_cp2k, finalize_cp2k
     179             :    PUBLIC :: create_force_env, destroy_force_env, set_pos, get_pos, &
     180             :              get_force, calc_energy_force, get_energy, get_stress_tensor, &
     181             :              calc_energy, calc_force, check_input, get_natom, get_nparticle, &
     182             :              f_env_add_defaults, f_env_rm_defaults, f_env_type, &
     183             :              f_env_get_from_id, &
     184             :              set_vel, set_cell, get_cell, get_qmmm_cell, get_result_r1
     185             : CONTAINS
     186             : 
     187             : ! **************************************************************************************************
     188             : !> \brief returns the position of the force env corresponding to the given id
     189             : !> \param env_id the id of the requested environment
     190             : !> \return ...
     191             : !> \author fawzi
     192             : !> \note
     193             : !>      private utility function
     194             : ! **************************************************************************************************
     195      101342 :    FUNCTION get_pos_of_env(env_id) RESULT(res)
     196             :       INTEGER, INTENT(in)                                :: env_id
     197             :       INTEGER                                            :: res
     198             : 
     199             :       INTEGER                                            :: env_pos, isub
     200             : 
     201      101342 :       env_pos = -1
     202      245878 :       DO isub = 1, n_f_envs
     203      245878 :          IF (f_envs(isub)%f_env%id_nr == env_id) THEN
     204      101342 :             env_pos = isub
     205             :          END IF
     206             :       END DO
     207      101342 :       res = env_pos
     208      101342 :    END FUNCTION get_pos_of_env
     209             : 
     210             : ! **************************************************************************************************
     211             : !> \brief initializes cp2k, needs to be called once before using any of the
     212             : !>      other functions when using cp2k as library
     213             : !> \param init_mpi if the mpi environment should be initialized
     214             : !> \param ierr returns a number different from 0 if there was an error
     215             : !> \author fawzi
     216             : ! **************************************************************************************************
     217        9158 :    SUBROUTINE init_cp2k(init_mpi, ierr)
     218             :       LOGICAL, INTENT(in)                                :: init_mpi
     219             :       INTEGER, INTENT(out)                               :: ierr
     220             : 
     221             :       INTEGER                                            :: offload_device_count, unit_nr
     222             :       INTEGER, POINTER                                   :: active_device_id
     223             :       INTEGER, TARGET                                    :: offload_chosen_device
     224             :       TYPE(cp_logger_type), POINTER                      :: logger
     225             : 
     226        9158 :       IF (.NOT. module_initialized) THEN
     227             :          ! install error handler hooks
     228        9158 :          CALL cp_error_handling_setup()
     229             : 
     230             :          ! install timming handler hooks
     231        9158 :          CALL timings_register_hooks()
     232             : 
     233             :          ! Initialise preconnection list
     234        9158 :          CALL init_preconnection_list()
     235             : 
     236             :          ! get runtime information
     237        9158 :          CALL get_runtime_info()
     238             : 
     239             :          ! Intialize CUDA/HIP before MPI
     240             :          ! Needed for HIP on ALPS & LUMI
     241        9158 :          CALL offload_init()
     242             : 
     243             :          ! re-create the para_env and log with correct (reordered) ranks
     244        9158 :          ALLOCATE (default_para_env)
     245        9158 :          IF (init_mpi) THEN
     246             :             ! get the default system wide communicator
     247        9158 :             CALL mp_world_init(default_para_env)
     248             :          ELSE
     249           0 :             default_para_env = mp_comm_world
     250             :          END IF
     251             : 
     252        9158 :          CALL string_table_allocate()
     253        9158 :          CALL add_mp_perf_env()
     254        9158 :          CALL add_timer_env()
     255             : 
     256        9158 :          IF (default_para_env%is_source()) THEN
     257        4579 :             unit_nr = default_output_unit
     258             :          ELSE
     259        4579 :             unit_nr = -1
     260             :          END IF
     261        9158 :          NULLIFY (logger)
     262             : 
     263             :          CALL cp_logger_create(logger, para_env=default_para_env, &
     264             :                                default_global_unit_nr=unit_nr, &
     265        9158 :                                close_global_unit_on_dealloc=.FALSE.)
     266        9158 :          CALL cp_add_default_logger(logger)
     267        9158 :          CALL cp_logger_release(logger)
     268             : 
     269        9158 :          ALLOCATE (f_envs(0))
     270        9158 :          module_initialized = .TRUE.
     271        9158 :          ierr = 0
     272             : 
     273             :          !   *** Initialize mathematical constants ***
     274        9158 :          CALL init_periodic_table()
     275             : 
     276             :          !   *** init the bibliography ***
     277        9158 :          CALL add_all_references()
     278             : 
     279        9158 :          NULLIFY (active_device_id)
     280        9158 :          offload_device_count = offload_get_device_count()
     281             : 
     282             :          ! Select active offload device when available.
     283        9158 :          IF (offload_device_count > 0) THEN
     284           0 :             offload_chosen_device = MOD(default_para_env%mepos, offload_device_count)
     285           0 :             CALL offload_set_chosen_device(offload_chosen_device)
     286           0 :             active_device_id => offload_chosen_device
     287             :          END IF
     288             : 
     289             :          ! Initialize the DBCSR configuration
     290             :          ! Attach the time handler hooks to DBCSR
     291             :          CALL dbcsr_init_lib(default_para_env%get_handle(), timeset_hook, timestop_hook, &
     292             :                              cp_abort_hook, cp_warn_hook, io_unit=unit_nr, &
     293        9158 :                              accdrv_active_device_id=active_device_id)
     294        9158 :          CALL cp_sirius_init() ! independent of method_name_id == do_sirius
     295        9158 :          CALL pw_fpga_init()
     296        9158 :          CALL pw_gpu_init()
     297        9158 :          CALL grid_library_init()
     298        9158 :          CALL dbm_library_init()
     299             :       ELSE
     300           0 :          ierr = cp_failure_level
     301             :       END IF
     302             : 
     303             :       !sample peak memory
     304        9158 :       CALL m_memory()
     305             : 
     306        9158 :    END SUBROUTINE init_cp2k
     307             : 
     308             : ! **************************************************************************************************
     309             : !> \brief cleanup after you have finished using this interface
     310             : !> \param finalize_mpi if the mpi environment should be finalized
     311             : !> \param ierr returns a number different from 0 if there was an error
     312             : !> \author fawzi
     313             : ! **************************************************************************************************
     314        9158 :    SUBROUTINE finalize_cp2k(finalize_mpi, ierr)
     315             :       LOGICAL, INTENT(in)                                :: finalize_mpi
     316             :       INTEGER, INTENT(out)                               :: ierr
     317             : 
     318             :       INTEGER                                            :: ienv
     319             : 
     320             : !sample peak memory
     321             : 
     322        9158 :       CALL m_memory()
     323             : 
     324        9158 :       IF (.NOT. module_initialized) THEN
     325           0 :          ierr = cp_failure_level
     326             :       ELSE
     327        9160 :          DO ienv = n_f_envs, 1, -1
     328           2 :             CALL destroy_force_env(f_envs(ienv)%f_env%id_nr, ierr=ierr)
     329        9160 :             CPASSERT(ierr == 0)
     330             :          END DO
     331        9158 :          DEALLOCATE (f_envs)
     332             : 
     333             :          ! Finalize libraries (Offload)
     334        9158 :          CALL dbm_library_finalize()
     335        9158 :          CALL grid_library_finalize()
     336        9158 :          CALL pw_gpu_finalize()
     337        9158 :          CALL pw_fpga_finalize()
     338        9158 :          CALL cp_sirius_finalize()
     339             :          ! Finalize the DBCSR library
     340        9158 :          CALL dbcsr_finalize_lib()
     341             : 
     342             :          ! Finalize DLA-Future and pika runtime; if already finalized does nothing
     343        9158 :          CALL cp_dlaf_free_all_grids()
     344        9158 :          CALL cp_dlaf_finalize()
     345             : 
     346        9158 :          CALL mp_para_env_release(default_para_env)
     347        9158 :          CALL cp_rm_default_logger()
     348             : 
     349             :          ! Deallocate the bibliography
     350        9158 :          CALL remove_all_references()
     351        9158 :          CALL rm_timer_env()
     352        9158 :          CALL rm_mp_perf_env()
     353        9158 :          CALL string_table_deallocate(0)
     354        9158 :          IF (finalize_mpi) THEN
     355        9158 :             CALL mp_world_finalize()
     356             :          END IF
     357             : 
     358        9158 :          ierr = 0
     359             :       END IF
     360        9158 :    END SUBROUTINE finalize_cp2k
     361             : 
     362             : ! **************************************************************************************************
     363             : !> \brief deallocates a f_env
     364             : !> \param f_env the f_env to deallocate
     365             : !> \author fawzi
     366             : ! **************************************************************************************************
     367        9235 :    RECURSIVE SUBROUTINE f_env_dealloc(f_env)
     368             :       TYPE(f_env_type), POINTER                          :: f_env
     369             : 
     370             :       INTEGER                                            :: ierr
     371             : 
     372        9235 :       CPASSERT(ASSOCIATED(f_env))
     373        9235 :       CALL force_env_release(f_env%force_env)
     374        9235 :       CALL cp_logger_release(f_env%logger)
     375        9235 :       CALL timer_env_release(f_env%timer_env)
     376        9235 :       CALL mp_perf_env_release(f_env%mp_perf_env)
     377        9235 :       IF (f_env%old_path /= f_env%my_path) THEN
     378           0 :          CALL m_chdir(f_env%old_path, ierr)
     379           0 :          CPASSERT(ierr == 0)
     380             :       END IF
     381        9235 :    END SUBROUTINE f_env_dealloc
     382             : 
     383             : ! **************************************************************************************************
     384             : !> \brief createates a f_env
     385             : !> \param f_env the f_env to createate
     386             : !> \param force_env the force_environment to be stored
     387             : !> \param timer_env the timer env to be stored
     388             : !> \param mp_perf_env the mp performance environment to be stored
     389             : !> \param id_nr ...
     390             : !> \param logger ...
     391             : !> \param old_dir ...
     392             : !> \author fawzi
     393             : ! **************************************************************************************************
     394        9235 :    SUBROUTINE f_env_create(f_env, force_env, timer_env, mp_perf_env, id_nr, logger, old_dir)
     395             :       TYPE(f_env_type), POINTER                          :: f_env
     396             :       TYPE(force_env_type), POINTER                      :: force_env
     397             :       TYPE(timer_env_type), POINTER                      :: timer_env
     398             :       TYPE(mp_perf_env_type), POINTER                    :: mp_perf_env
     399             :       INTEGER, INTENT(in)                                :: id_nr
     400             :       TYPE(cp_logger_type), POINTER                      :: logger
     401             :       CHARACTER(len=*), INTENT(in)                       :: old_dir
     402             : 
     403           0 :       ALLOCATE (f_env)
     404        9235 :       f_env%force_env => force_env
     405        9235 :       CALL force_env_retain(f_env%force_env)
     406        9235 :       f_env%logger => logger
     407        9235 :       CALL cp_logger_retain(logger)
     408        9235 :       f_env%timer_env => timer_env
     409        9235 :       CALL timer_env_retain(f_env%timer_env)
     410        9235 :       f_env%mp_perf_env => mp_perf_env
     411        9235 :       CALL mp_perf_env_retain(f_env%mp_perf_env)
     412        9235 :       f_env%id_nr = id_nr
     413        9235 :       CALL m_getcwd(f_env%my_path)
     414        9235 :       f_env%old_path = old_dir
     415        9235 :    END SUBROUTINE f_env_create
     416             : 
     417             : ! **************************************************************************************************
     418             : !> \brief ...
     419             : !> \param f_env_id ...
     420             : !> \param f_env ...
     421             : ! **************************************************************************************************
     422         283 :    SUBROUTINE f_env_get_from_id(f_env_id, f_env)
     423             :       INTEGER, INTENT(in)                                :: f_env_id
     424             :       TYPE(f_env_type), POINTER                          :: f_env
     425             : 
     426             :       INTEGER                                            :: f_env_pos
     427             : 
     428         283 :       NULLIFY (f_env)
     429         283 :       f_env_pos = get_pos_of_env(f_env_id)
     430         283 :       IF (f_env_pos < 1) THEN
     431           0 :          CPABORT("invalid env_id "//cp_to_string(f_env_id))
     432             :       ELSE
     433         283 :          f_env => f_envs(f_env_pos)%f_env
     434             :       END IF
     435             : 
     436         283 :    END SUBROUTINE f_env_get_from_id
     437             : 
     438             : ! **************************************************************************************************
     439             : !> \brief adds the default environments of the f_env to the stack of the
     440             : !>      defaults, and returns a new error and sets failure to true if
     441             : !>      something went wrong
     442             : !> \param f_env_id the f_env from where to take the defaults
     443             : !> \param f_env will contain the f_env corresponding to f_env_id
     444             : !> \param handle ...
     445             : !> \author fawzi
     446             : !> \note
     447             : !>      The following routines need to be synchronized wrt. adding/removing
     448             : !>      of the default environments (logging, performance,error):
     449             : !>      environment:cp2k_init, environment:cp2k_finalize,
     450             : !>      f77_interface:f_env_add_defaults, f77_interface:f_env_rm_defaults,
     451             : !>      f77_interface:create_force_env, f77_interface:destroy_force_env
     452             : ! **************************************************************************************************
     453       91824 :    SUBROUTINE f_env_add_defaults(f_env_id, f_env, handle)
     454             :       INTEGER, INTENT(in)                                :: f_env_id
     455             :       TYPE(f_env_type), POINTER                          :: f_env
     456             :       INTEGER, INTENT(out), OPTIONAL                     :: handle
     457             : 
     458             :       INTEGER                                            :: f_env_pos, ierr
     459             :       TYPE(cp_logger_type), POINTER                      :: logger
     460             : 
     461       91824 :       NULLIFY (f_env)
     462       91824 :       f_env_pos = get_pos_of_env(f_env_id)
     463       91824 :       IF (f_env_pos < 1) THEN
     464           0 :          CPABORT("invalid env_id "//cp_to_string(f_env_id))
     465             :       ELSE
     466       91824 :          f_env => f_envs(f_env_pos)%f_env
     467       91824 :          logger => f_env%logger
     468       91824 :          CPASSERT(ASSOCIATED(logger))
     469       91824 :          CALL m_getcwd(f_env%old_path)
     470       91824 :          IF (f_env%old_path /= f_env%my_path) THEN
     471           0 :             CALL m_chdir(TRIM(f_env%my_path), ierr)
     472           0 :             CPASSERT(ierr == 0)
     473             :          END IF
     474       91824 :          CALL add_mp_perf_env(f_env%mp_perf_env)
     475       91824 :          CALL add_timer_env(f_env%timer_env)
     476       91824 :          CALL cp_add_default_logger(logger)
     477       91824 :          IF (PRESENT(handle)) handle = cp_default_logger_stack_size()
     478             :       END IF
     479       91824 :    END SUBROUTINE f_env_add_defaults
     480             : 
     481             : ! **************************************************************************************************
     482             : !> \brief removes the default environments of the f_env to the stack of the
     483             : !>      defaults, and sets ierr accordingly to the failuers stored in error
     484             : !>      It also releases the error
     485             : !> \param f_env the f_env from where to take the defaults
     486             : !> \param ierr variable that will be set to a number different from 0 if
     487             : !>        error contains an error (otherwise it will be set to 0)
     488             : !> \param handle ...
     489             : !> \author fawzi
     490             : !> \note
     491             : !>      The following routines need to be synchronized wrt. adding/removing
     492             : !>      of the default environments (logging, performance,error):
     493             : !>      environment:cp2k_init, environment:cp2k_finalize,
     494             : !>      f77_interface:f_env_add_defaults, f77_interface:f_env_rm_defaults,
     495             : !>      f77_interface:create_force_env, f77_interface:destroy_force_env
     496             : ! **************************************************************************************************
     497       91824 :    SUBROUTINE f_env_rm_defaults(f_env, ierr, handle)
     498             :       TYPE(f_env_type), POINTER                          :: f_env
     499             :       INTEGER, INTENT(out), OPTIONAL                     :: ierr
     500             :       INTEGER, INTENT(in), OPTIONAL                      :: handle
     501             : 
     502             :       INTEGER                                            :: ierr2
     503             :       TYPE(cp_logger_type), POINTER                      :: d_logger, logger
     504             :       TYPE(mp_perf_env_type), POINTER                    :: d_mp_perf_env
     505             :       TYPE(timer_env_type), POINTER                      :: d_timer_env
     506             : 
     507       91824 :       IF (ASSOCIATED(f_env)) THEN
     508       91824 :          IF (PRESENT(handle)) THEN
     509       14124 :             CPASSERT(handle == cp_default_logger_stack_size())
     510             :          END IF
     511             : 
     512       91824 :          logger => f_env%logger
     513       91824 :          d_logger => cp_get_default_logger()
     514       91824 :          d_timer_env => get_timer_env()
     515       91824 :          d_mp_perf_env => get_mp_perf_env()
     516       91824 :          CPASSERT(ASSOCIATED(logger))
     517       91824 :          CPASSERT(ASSOCIATED(d_logger))
     518       91824 :          CPASSERT(ASSOCIATED(d_timer_env))
     519       91824 :          CPASSERT(ASSOCIATED(d_mp_perf_env))
     520       91824 :          CPASSERT(ASSOCIATED(logger, d_logger))
     521             :          ! CPASSERT(ASSOCIATED(d_timer_env, f_env%timer_env))
     522       91824 :          CPASSERT(ASSOCIATED(d_mp_perf_env, f_env%mp_perf_env))
     523       91824 :          IF (f_env%old_path /= f_env%my_path) THEN
     524           0 :             CALL m_chdir(TRIM(f_env%old_path), ierr2)
     525           0 :             CPASSERT(ierr2 == 0)
     526             :          END IF
     527       91824 :          IF (PRESENT(ierr)) THEN
     528       91300 :             ierr = 0
     529             :          END IF
     530       91824 :          CALL cp_rm_default_logger()
     531       91824 :          CALL rm_timer_env()
     532       91824 :          CALL rm_mp_perf_env()
     533             :       ELSE
     534           0 :          IF (PRESENT(ierr)) THEN
     535           0 :             ierr = 0
     536             :          END IF
     537             :       END IF
     538       91824 :    END SUBROUTINE f_env_rm_defaults
     539             : 
     540             : ! **************************************************************************************************
     541             : !> \brief creates a new force environment using the given input, and writing
     542             : !>      the output to the given output unit
     543             : !> \param new_env_id will contain the id of the newly created environment
     544             : !> \param input_declaration ...
     545             : !> \param input_path where to read the input (if the input is given it can
     546             : !>        a virtual path)
     547             : !> \param output_path filename (or name of the unit) for the output
     548             : !> \param mpi_comm the mpi communicator to be used for this environment
     549             : !>        it will not be freed when you get rid of the force_env
     550             : !> \param output_unit if given it should be the unit for the output
     551             : !>        and no file is open(should be valid on the processor with rank 0)
     552             : !> \param owns_out_unit if the output unit should be closed upon destroing
     553             : !>        of the force_env (defaults to true if not default_output_unit)
     554             : !> \param input the parsed input, if given and valid it is used
     555             : !>        instead of parsing from file
     556             : !> \param ierr will return a number different from 0 if there was an error
     557             : !> \param work_dir ...
     558             : !> \param initial_variables key-value list of initial preprocessor variables
     559             : !> \author fawzi
     560             : !> \note
     561             : !>      The following routines need to be synchronized wrt. adding/removing
     562             : !>      of the default environments (logging, performance,error):
     563             : !>      environment:cp2k_init, environment:cp2k_finalize,
     564             : !>      f77_interface:f_env_add_defaults, f77_interface:f_env_rm_defaults,
     565             : !>      f77_interface:create_force_env, f77_interface:destroy_force_env
     566             : ! **************************************************************************************************
     567        9235 :    RECURSIVE SUBROUTINE create_force_env(new_env_id, input_declaration, input_path, &
     568             :                                          output_path, mpi_comm, output_unit, owns_out_unit, &
     569          86 :                                          input, ierr, work_dir, initial_variables)
     570             :       INTEGER, INTENT(out)                               :: new_env_id
     571             :       TYPE(section_type), POINTER                        :: input_declaration
     572             :       CHARACTER(len=*), INTENT(in)                       :: input_path
     573             :       CHARACTER(len=*), INTENT(in), OPTIONAL             :: output_path
     574             : 
     575             :       CLASS(mp_comm_type), INTENT(IN), OPTIONAL           :: mpi_comm
     576             :       INTEGER, INTENT(in), OPTIONAL                      :: output_unit
     577             :       LOGICAL, INTENT(in), OPTIONAL                      :: owns_out_unit
     578             :       TYPE(section_vals_type), OPTIONAL, POINTER         :: input
     579             :       INTEGER, INTENT(out), OPTIONAL                     :: ierr
     580             :       CHARACTER(len=*), INTENT(in), OPTIONAL             :: work_dir
     581             :       CHARACTER(len=*), DIMENSION(:, :), OPTIONAL        :: initial_variables
     582             : 
     583             :       CHARACTER(len=*), PARAMETER                        :: routineN = 'create_force_env'
     584             : 
     585             :       CHARACTER(len=default_path_length)                 :: old_dir, wdir
     586             :       INTEGER :: handle, i, ierr2, iforce_eval, isubforce_eval, k, method_name_id, my_group, &
     587             :                  nforce_eval, ngroups, nsubforce_size, unit_nr
     588        9235 :       INTEGER, DIMENSION(:), POINTER                     :: group_distribution, i_force_eval, &
     589        9235 :                                                             lgroup_distribution
     590             :       LOGICAL :: check, do_qmmm_force_mixing, multiple_subsys, my_echo, my_owns_out_unit, &
     591             :                  use_motion_section, use_multiple_para_env
     592             :       TYPE(cp_logger_type), POINTER                      :: logger, my_logger
     593             :       TYPE(mp_para_env_type), POINTER                    :: my_para_env, para_env
     594             :       TYPE(eip_environment_type), POINTER                :: eip_env
     595             :       TYPE(embed_env_type), POINTER                      :: embed_env
     596             :       TYPE(enumeration_type), POINTER                    :: enum
     597        9235 :       TYPE(f_env_p_type), DIMENSION(:), POINTER          :: f_envs_old
     598             :       TYPE(force_env_type), POINTER                      :: force_env, my_force_env
     599             :       TYPE(fp_type), POINTER                             :: fp_env
     600             :       TYPE(global_environment_type), POINTER             :: globenv
     601             :       TYPE(ipi_environment_type), POINTER                :: ipi_env
     602             :       TYPE(keyword_type), POINTER                        :: keyword
     603             :       TYPE(meta_env_type), POINTER                       :: meta_env
     604             :       TYPE(mixed_environment_type), POINTER              :: mixed_env
     605             :       TYPE(mp_perf_env_type), POINTER                    :: mp_perf_env
     606             :       TYPE(nnp_type), POINTER                            :: nnp_env
     607             :       TYPE(pwdft_environment_type), POINTER              :: pwdft_env
     608             :       TYPE(qmmm_env_type), POINTER                       :: qmmm_env
     609             :       TYPE(qmmmx_env_type), POINTER                      :: qmmmx_env
     610             :       TYPE(qs_environment_type), POINTER                 :: qs_env
     611             :       TYPE(section_type), POINTER                        :: section
     612             :       TYPE(section_vals_type), POINTER :: fe_section, force_env_section, force_env_sections, &
     613             :                                           fp_section, input_file, qmmm_section, qmmmx_section, root_section, subsys_section, &
     614             :                                           wrk_section
     615             :       TYPE(timer_env_type), POINTER                      :: timer_env
     616             : 
     617           0 :       CPASSERT(ASSOCIATED(input_declaration))
     618        9235 :       NULLIFY (para_env, force_env, timer_env, mp_perf_env, globenv, meta_env, &
     619        9235 :                fp_env, eip_env, pwdft_env, mixed_env, qs_env, qmmm_env, embed_env)
     620        9235 :       new_env_id = -1
     621        9235 :       IF (PRESENT(mpi_comm)) THEN
     622        9233 :          ALLOCATE (para_env)
     623        9233 :          para_env = mpi_comm
     624             :       ELSE
     625           2 :          para_env => default_para_env
     626           2 :          CALL para_env%retain()
     627             :       END IF
     628             : 
     629        9235 :       CALL timeset(routineN, handle)
     630             : 
     631        9235 :       CALL m_getcwd(old_dir)
     632        9235 :       wdir = old_dir
     633        9235 :       IF (PRESENT(work_dir)) THEN
     634           0 :          IF (work_dir /= " ") THEN
     635           0 :             CALL m_chdir(work_dir, ierr2)
     636           0 :             IF (ierr2 /= 0) THEN
     637           0 :                IF (PRESENT(ierr)) ierr = ierr2
     638           0 :                RETURN
     639             :             END IF
     640           0 :             wdir = work_dir
     641             :          END IF
     642             :       END IF
     643             : 
     644        9235 :       IF (PRESENT(output_unit)) THEN
     645        8969 :          unit_nr = output_unit
     646             :       ELSE
     647         266 :          IF (para_env%is_source()) THEN
     648         207 :             IF (output_path == "__STD_OUT__") THEN
     649           1 :                unit_nr = default_output_unit
     650             :             ELSE
     651             :                CALL open_file(file_name=output_path, file_status="UNKNOWN", &
     652             :                               file_action="WRITE", file_position="APPEND", &
     653         206 :                               unit_number=unit_nr)
     654             :             END IF
     655             :          ELSE
     656          59 :             unit_nr = -1
     657             :          END IF
     658             :       END IF
     659        9235 :       my_owns_out_unit = unit_nr /= default_output_unit
     660        9235 :       IF (PRESENT(owns_out_unit)) my_owns_out_unit = owns_out_unit
     661        9235 :       CALL globenv_create(globenv)
     662             :       CALL cp2k_init(para_env, output_unit=unit_nr, globenv=globenv, input_file_name=input_path, &
     663        9235 :                      wdir=wdir)
     664        9235 :       logger => cp_get_default_logger()
     665             :       ! warning this is dangerous, I did not check that all the subfunctions
     666             :       ! support it, the program might crash upon error
     667             : 
     668        9235 :       NULLIFY (input_file)
     669        9235 :       IF (PRESENT(input)) input_file => input
     670        9235 :       IF (.NOT. ASSOCIATED(input_file)) THEN
     671         467 :          IF (PRESENT(initial_variables)) THEN
     672          86 :             input_file => read_input(input_declaration, input_path, initial_variables, para_env=para_env)
     673             :          ELSE
     674         381 :             input_file => read_input(input_declaration, input_path, empty_initial_variables, para_env=para_env)
     675             :          END IF
     676             :       ELSE
     677        8768 :          CALL section_vals_retain(input_file)
     678             :       END IF
     679             :       CALL section_vals_val_get(input_file, "GLOBAL%ECHO_INPUT", &
     680        9235 :                                 l_val=my_echo)
     681             :       ! echo after check?
     682        9235 :       IF (para_env%is_source() .AND. my_echo) THEN
     683             :          CALL section_vals_write(input_file, unit_nr=cp_logger_get_default_unit_nr(logger), &
     684          15 :                                  hide_root=.TRUE., hide_defaults=.FALSE.)
     685             :       END IF
     686             :       ! XXXXXXXXXXXXXXXXXXXXXXXXXXX
     687             :       ! root_section => input_file
     688             :       ! XXXXXXXXXXXXXXXXXXXXXXXXXXX
     689             : 
     690        9235 :       CALL check_cp2k_input(input_declaration, input_file, para_env=para_env, output_unit=unit_nr)
     691             :       ! XXXXXXXXXXXXXXXXXXXXXXXXXXX
     692             :       ! NULLIFY(input_file)
     693             :       ! XXXXXXXXXXXXXXXXXXXXXXXXXXX
     694        9235 :       root_section => input_file
     695        9235 :       CALL section_vals_retain(root_section)
     696             : 
     697        9235 :       IF (n_f_envs + 1 > SIZE(f_envs)) THEN
     698        8691 :          f_envs_old => f_envs
     699      112983 :          ALLOCATE (f_envs(n_f_envs + 10))
     700        8691 :          DO i = 1, n_f_envs
     701        8691 :             f_envs(i)%f_env => f_envs_old(i)%f_env
     702             :          END DO
     703       95601 :          DO i = n_f_envs + 1, SIZE(f_envs)
     704       95601 :             NULLIFY (f_envs(i)%f_env)
     705             :          END DO
     706        8691 :          DEALLOCATE (f_envs_old)
     707             :       END IF
     708             : 
     709        9235 :       CALL cp2k_read(root_section, para_env, globenv)
     710             : 
     711        9235 :       CALL cp2k_setup(root_section, para_env, globenv)
     712             :       ! Group Distribution
     713       27705 :       ALLOCATE (group_distribution(0:para_env%num_pe - 1))
     714       27498 :       group_distribution = 0
     715        9235 :       lgroup_distribution => group_distribution
     716             :       ! Setup all possible force_env
     717        9235 :       force_env_sections => section_vals_get_subs_vals(root_section, "FORCE_EVAL")
     718             :       CALL section_vals_val_get(root_section, "MULTIPLE_FORCE_EVALS%MULTIPLE_SUBSYS", &
     719        9235 :                                 l_val=multiple_subsys)
     720        9235 :       CALL multiple_fe_list(force_env_sections, root_section, i_force_eval, nforce_eval)
     721             :       ! Enforce the deletion of the subsys (unless not explicitly required)
     722        9235 :       IF (.NOT. multiple_subsys) THEN
     723        9433 :          DO iforce_eval = 2, nforce_eval
     724             :             wrk_section => section_vals_get_subs_vals(force_env_sections, "SUBSYS", &
     725         246 :                                                       i_rep_section=i_force_eval(iforce_eval))
     726        9433 :             CALL section_vals_remove_values(wrk_section)
     727             :          END DO
     728             :       END IF
     729        9235 :       nsubforce_size = nforce_eval - 1
     730        9235 :       use_multiple_para_env = .FALSE.
     731        9235 :       use_motion_section = .TRUE.
     732       18868 :       DO iforce_eval = 1, nforce_eval
     733        9633 :          NULLIFY (force_env_section, my_force_env, subsys_section)
     734             :          ! Reference subsys from the first ordered force_eval
     735        9633 :          IF (.NOT. multiple_subsys) THEN
     736             :             subsys_section => section_vals_get_subs_vals(force_env_sections, "SUBSYS", &
     737        9433 :                                                          i_rep_section=i_force_eval(1))
     738             :          END IF
     739             :          ! Handling para_env in case of multiple force_eval
     740        9633 :          IF (use_multiple_para_env) THEN
     741             :             ! Check that the order of the force_eval is the correct one
     742             :             CALL section_vals_val_get(force_env_sections, "METHOD", i_val=method_name_id, &
     743         388 :                                       i_rep_section=i_force_eval(1))
     744         388 :             IF ((method_name_id /= do_mixed) .AND. (method_name_id /= do_embed)) &
     745             :                CALL cp_abort(__LOCATION__, &
     746             :                              "In case of multiple force_eval the MAIN force_eval (the first in the list of FORCE_EVAL_ORDER or "// &
     747             :                              "the one omitted from that order list) must be a MIXED_ENV type calculation. Please check your "// &
     748           0 :                              "input file and possibly correct the MULTIPLE_FORCE_EVAL%FORCE_EVAL_ORDER. ")
     749             : 
     750         388 :             IF (method_name_id .EQ. do_mixed) THEN
     751         292 :                check = ASSOCIATED(force_env%mixed_env%sub_para_env)
     752         292 :                CPASSERT(check)
     753         292 :                ngroups = force_env%mixed_env%ngroups
     754         292 :                my_group = lgroup_distribution(para_env%mepos)
     755         292 :                isubforce_eval = iforce_eval - 1
     756             :                ! If task not allocated on this procs skip setup..
     757         292 :                IF (MODULO(isubforce_eval - 1, ngroups) /= my_group) CYCLE
     758         208 :                my_para_env => force_env%mixed_env%sub_para_env(my_group + 1)%para_env
     759         208 :                my_logger => force_env%mixed_env%sub_logger(my_group + 1)%p
     760         208 :                CALL cp_rm_default_logger()
     761         208 :                CALL cp_add_default_logger(my_logger)
     762             :             END IF
     763         304 :             IF (method_name_id .EQ. do_embed) THEN
     764          96 :                check = ASSOCIATED(force_env%embed_env%sub_para_env)
     765          96 :                CPASSERT(check)
     766          96 :                ngroups = force_env%embed_env%ngroups
     767          96 :                my_group = lgroup_distribution(para_env%mepos)
     768          96 :                isubforce_eval = iforce_eval - 1
     769             :                ! If task not allocated on this procs skip setup..
     770          96 :                IF (MODULO(isubforce_eval - 1, ngroups) /= my_group) CYCLE
     771          96 :                my_para_env => force_env%embed_env%sub_para_env(my_group + 1)%para_env
     772          96 :                my_logger => force_env%embed_env%sub_logger(my_group + 1)%p
     773          96 :                CALL cp_rm_default_logger()
     774          96 :                CALL cp_add_default_logger(my_logger)
     775             :             END IF
     776             :          ELSE
     777        9245 :             my_para_env => para_env
     778             :          END IF
     779             : 
     780             :          ! Initialize force_env_section
     781             :          ! No need to allocate one more force_env_section if only 1 force_eval
     782             :          ! is provided.. this is in order to save memory..
     783        9549 :          IF (nforce_eval > 1) THEN
     784             :             CALL section_vals_duplicate(force_env_sections, force_env_section, &
     785         476 :                                         i_force_eval(iforce_eval), i_force_eval(iforce_eval))
     786         476 :             IF (iforce_eval /= 1) use_motion_section = .FALSE.
     787             :          ELSE
     788        9073 :             force_env_section => force_env_sections
     789        9073 :             use_motion_section = .TRUE.
     790             :          END IF
     791        9549 :          CALL section_vals_val_get(force_env_section, "METHOD", i_val=method_name_id)
     792             : 
     793        9549 :          IF (method_name_id == do_qmmm) THEN
     794         334 :             qmmmx_section => section_vals_get_subs_vals(force_env_section, "QMMM%FORCE_MIXING")
     795         334 :             CALL section_vals_get(qmmmx_section, explicit=do_qmmm_force_mixing)
     796         334 :             IF (do_qmmm_force_mixing) &
     797           8 :                method_name_id = do_qmmmx ! QMMM Force-Mixing has its own (hidden) method_id
     798             :          END IF
     799             : 
     800        2249 :          SELECT CASE (method_name_id)
     801             :          CASE (do_fist)
     802             :             CALL fist_create_force_env(my_force_env, root_section, my_para_env, globenv, &
     803             :                                        force_env_section=force_env_section, subsys_section=subsys_section, &
     804        2249 :                                        use_motion_section=use_motion_section)
     805             : 
     806             :          CASE (do_qs)
     807        6780 :             ALLOCATE (qs_env)
     808        6780 :             CALL qs_env_create(qs_env, globenv)
     809             :             CALL qs_init(qs_env, my_para_env, root_section, globenv=globenv, force_env_section=force_env_section, &
     810        6780 :                          subsys_section=subsys_section, use_motion_section=use_motion_section)
     811             :             CALL force_env_create(my_force_env, root_section, qs_env=qs_env, para_env=my_para_env, globenv=globenv, &
     812        6780 :                                   force_env_section=force_env_section)
     813             : 
     814             :          CASE (do_qmmm)
     815         326 :             qmmm_section => section_vals_get_subs_vals(force_env_section, "QMMM")
     816         326 :             ALLOCATE (qmmm_env)
     817             :             CALL qmmm_env_create(qmmm_env, root_section, my_para_env, globenv, &
     818         326 :                                  force_env_section, qmmm_section, subsys_section, use_motion_section)
     819             :             CALL force_env_create(my_force_env, root_section, qmmm_env=qmmm_env, para_env=my_para_env, &
     820         326 :                                   globenv=globenv, force_env_section=force_env_section)
     821             : 
     822             :          CASE (do_qmmmx)
     823           8 :             ALLOCATE (qmmmx_env)
     824             :             CALL qmmmx_env_create(qmmmx_env, root_section, my_para_env, globenv, &
     825           8 :                                   force_env_section, subsys_section, use_motion_section)
     826             :             CALL force_env_create(my_force_env, root_section, qmmmx_env=qmmmx_env, para_env=my_para_env, &
     827           8 :                                   globenv=globenv, force_env_section=force_env_section)
     828             : 
     829             :          CASE (do_eip)
     830           2 :             ALLOCATE (eip_env)
     831           2 :             CALL eip_env_create(eip_env)
     832             :             CALL eip_init(eip_env, root_section, my_para_env, force_env_section=force_env_section, &
     833           2 :                           subsys_section=subsys_section)
     834             :             CALL force_env_create(my_force_env, root_section, eip_env=eip_env, para_env=my_para_env, &
     835           2 :                                   globenv=globenv, force_env_section=force_env_section)
     836             : 
     837             :          CASE (do_sirius)
     838         464 :             ALLOCATE (pwdft_env)
     839          16 :             CALL pwdft_env_create(pwdft_env)
     840             :             CALL pwdft_init(pwdft_env, root_section, my_para_env, force_env_section=force_env_section, &
     841          16 :                             subsys_section=subsys_section, use_motion_section=use_motion_section)
     842             :             CALL force_env_create(my_force_env, root_section, pwdft_env=pwdft_env, para_env=my_para_env, &
     843          16 :                                   globenv=globenv, force_env_section=force_env_section)
     844             : 
     845             :          CASE (do_mixed)
     846         130 :             ALLOCATE (mixed_env)
     847             :             CALL mixed_create_force_env(mixed_env, root_section, my_para_env, &
     848             :                                         force_env_section=force_env_section, n_subforce_eval=nsubforce_size, &
     849         130 :                                         use_motion_section=use_motion_section)
     850             :             CALL force_env_create(my_force_env, root_section, mixed_env=mixed_env, para_env=my_para_env, &
     851         130 :                                   globenv=globenv, force_env_section=force_env_section)
     852             :             !TODO: the sub_force_envs should really be created via recursion
     853         130 :             use_multiple_para_env = .TRUE.
     854         130 :             CALL cp_add_default_logger(logger) ! just to get the logger swapping started
     855         130 :             lgroup_distribution => my_force_env%mixed_env%group_distribution
     856             : 
     857             :          CASE (do_embed)
     858          24 :             ALLOCATE (embed_env)
     859             :             CALL embed_create_force_env(embed_env, root_section, my_para_env, &
     860             :                                         force_env_section=force_env_section, n_subforce_eval=nsubforce_size, &
     861          24 :                                         use_motion_section=use_motion_section)
     862             :             CALL force_env_create(my_force_env, root_section, embed_env=embed_env, para_env=my_para_env, &
     863          24 :                                   globenv=globenv, force_env_section=force_env_section)
     864             :             !TODO: the sub_force_envs should really be created via recursion
     865          24 :             use_multiple_para_env = .TRUE.
     866          24 :             CALL cp_add_default_logger(logger) ! just to get the logger swapping started
     867          24 :             lgroup_distribution => my_force_env%embed_env%group_distribution
     868             : 
     869             :          CASE (do_nnp)
     870          14 :             ALLOCATE (nnp_env)
     871             :             CALL nnp_init(nnp_env, root_section, my_para_env, force_env_section=force_env_section, &
     872          14 :                           subsys_section=subsys_section, use_motion_section=use_motion_section)
     873             :             CALL force_env_create(my_force_env, root_section, nnp_env=nnp_env, para_env=my_para_env, &
     874          14 :                                   globenv=globenv, force_env_section=force_env_section)
     875             : 
     876             :          CASE (do_ipi)
     877           0 :             ALLOCATE (ipi_env)
     878             :             CALL ipi_init(ipi_env, root_section, my_para_env, force_env_section=force_env_section, &
     879           0 :                           subsys_section=subsys_section)
     880             :             CALL force_env_create(my_force_env, root_section, ipi_env=ipi_env, para_env=my_para_env, &
     881           0 :                                   globenv=globenv, force_env_section=force_env_section)
     882             : 
     883             :          CASE default
     884           0 :             CALL create_force_eval_section(section)
     885           0 :             keyword => section_get_keyword(section, "METHOD")
     886           0 :             CALL keyword_get(keyword, enum=enum)
     887             :             CALL cp_abort(__LOCATION__, &
     888             :                           "Invalid METHOD <"//TRIM(enum_i2c(enum, method_name_id))// &
     889           0 :                           "> was specified, ")
     890       16705 :             CALL section_release(section)
     891             :          END SELECT
     892             : 
     893        9549 :          NULLIFY (meta_env, fp_env)
     894        9549 :          IF (use_motion_section) THEN
     895             :             ! Metadynamics Setup
     896        9235 :             fe_section => section_vals_get_subs_vals(root_section, "MOTION%FREE_ENERGY")
     897        9235 :             CALL metadyn_read(meta_env, my_force_env, root_section, my_para_env, fe_section)
     898        9235 :             CALL force_env_set(my_force_env, meta_env=meta_env)
     899             :             ! Flexible Partition Setup
     900        9235 :             fp_section => section_vals_get_subs_vals(root_section, "MOTION%FLEXIBLE_PARTITIONING")
     901        9235 :             ALLOCATE (fp_env)
     902        9235 :             CALL fp_env_create(fp_env)
     903        9235 :             CALL fp_env_read(fp_env, fp_section)
     904        9235 :             CALL fp_env_write(fp_env, fp_section)
     905        9235 :             CALL force_env_set(my_force_env, fp_env=fp_env)
     906             :          END IF
     907             :          ! Handle multiple force_eval
     908        9549 :          IF (nforce_eval > 1 .AND. iforce_eval == 1) THEN
     909         884 :             ALLOCATE (my_force_env%sub_force_env(nsubforce_size))
     910             :             ! Nullify subforce_env
     911         560 :             DO k = 1, nsubforce_size
     912         560 :                NULLIFY (my_force_env%sub_force_env(k)%force_env)
     913             :             END DO
     914             :          END IF
     915             :          ! Reference the right force_env
     916        9235 :          IF (iforce_eval == 1) THEN
     917        9235 :             force_env => my_force_env
     918             :          ELSE
     919         314 :             force_env%sub_force_env(iforce_eval - 1)%force_env => my_force_env
     920             :          END IF
     921             :          ! Multiple para env for sub_force_eval
     922        9549 :          IF (.NOT. use_multiple_para_env) THEN
     923       27066 :             lgroup_distribution = iforce_eval
     924             :          END IF
     925             :          ! Release force_env_section
     926       28333 :          IF (nforce_eval > 1) CALL section_vals_release(force_env_section)
     927             :       END DO
     928        9235 :       IF (use_multiple_para_env) &
     929         154 :          CALL cp_rm_default_logger()
     930        9235 :       DEALLOCATE (group_distribution)
     931        9235 :       DEALLOCATE (i_force_eval)
     932        9235 :       timer_env => get_timer_env()
     933        9235 :       mp_perf_env => get_mp_perf_env()
     934        9235 :       CALL para_env%max(last_f_env_id)
     935        9235 :       last_f_env_id = last_f_env_id + 1
     936        9235 :       new_env_id = last_f_env_id
     937        9235 :       n_f_envs = n_f_envs + 1
     938             :       CALL f_env_create(f_envs(n_f_envs)%f_env, logger=logger, &
     939             :                         timer_env=timer_env, mp_perf_env=mp_perf_env, force_env=force_env, &
     940        9235 :                         id_nr=last_f_env_id, old_dir=old_dir)
     941        9235 :       CALL force_env_release(force_env)
     942        9235 :       CALL globenv_release(globenv)
     943        9235 :       CALL section_vals_release(root_section)
     944        9235 :       CALL mp_para_env_release(para_env)
     945        9235 :       CALL f_env_rm_defaults(f_envs(n_f_envs)%f_env, ierr=ierr)
     946        9235 :       CALL timestop(handle)
     947             : 
     948       46261 :    END SUBROUTINE create_force_env
     949             : 
     950             : ! **************************************************************************************************
     951             : !> \brief deallocates the force_env with the given id
     952             : !> \param env_id the id of the force_env to remove
     953             : !> \param ierr will contain a number different from 0 if
     954             : !> \param q_finalize ...
     955             : !> \author fawzi
     956             : !> \note
     957             : !>      The following routines need to be synchronized wrt. adding/removing
     958             : !>      of the default environments (logging, performance,error):
     959             : !>      environment:cp2k_init, environment:cp2k_finalize,
     960             : !>      f77_interface:f_env_add_defaults, f77_interface:f_env_rm_defaults,
     961             : !>      f77_interface:create_force_env, f77_interface:destroy_force_env
     962             : ! **************************************************************************************************
     963        9235 :    RECURSIVE SUBROUTINE destroy_force_env(env_id, ierr, q_finalize)
     964             :       INTEGER, INTENT(in)                                :: env_id
     965             :       INTEGER, INTENT(out)                               :: ierr
     966             :       LOGICAL, INTENT(IN), OPTIONAL                      :: q_finalize
     967             : 
     968             :       INTEGER                                            :: env_pos, i
     969             :       TYPE(f_env_type), POINTER                          :: f_env
     970             :       TYPE(global_environment_type), POINTER             :: globenv
     971             :       TYPE(mp_para_env_type), POINTER                    :: para_env
     972             :       TYPE(section_vals_type), POINTER                   :: root_section
     973             : 
     974        9235 :       NULLIFY (f_env)
     975        9235 :       CALL f_env_add_defaults(env_id, f_env)
     976        9235 :       env_pos = get_pos_of_env(env_id)
     977        9235 :       n_f_envs = n_f_envs - 1
     978        9240 :       DO i = env_pos, n_f_envs
     979        9240 :          f_envs(i)%f_env => f_envs(i + 1)%f_env
     980             :       END DO
     981        9235 :       NULLIFY (f_envs(n_f_envs + 1)%f_env)
     982             : 
     983             :       CALL force_env_get(f_env%force_env, globenv=globenv, &
     984        9235 :                          root_section=root_section, para_env=para_env)
     985             : 
     986        9235 :       CPASSERT(ASSOCIATED(globenv))
     987        9235 :       NULLIFY (f_env%force_env%globenv)
     988        9235 :       CALL f_env_dealloc(f_env)
     989        9235 :       IF (PRESENT(q_finalize)) THEN
     990         210 :          CALL cp2k_finalize(root_section, para_env, globenv, f_env%old_path, q_finalize)
     991             :       ELSE
     992        9025 :          CALL cp2k_finalize(root_section, para_env, globenv, f_env%old_path)
     993             :       END IF
     994        9235 :       CALL section_vals_release(root_section)
     995        9235 :       CALL globenv_release(globenv)
     996        9235 :       DEALLOCATE (f_env)
     997        9235 :       ierr = 0
     998        9235 :    END SUBROUTINE destroy_force_env
     999             : 
    1000             : ! **************************************************************************************************
    1001             : !> \brief returns the number of atoms in the given force env
    1002             : !> \param env_id id of the force_env
    1003             : !> \param n_atom ...
    1004             : !> \param ierr will return a number different from 0 if there was an error
    1005             : !> \date   22.11.2010 (MK)
    1006             : !> \author fawzi
    1007             : ! **************************************************************************************************
    1008          40 :    SUBROUTINE get_natom(env_id, n_atom, ierr)
    1009             : 
    1010             :       INTEGER, INTENT(IN)                                :: env_id
    1011             :       INTEGER, INTENT(OUT)                               :: n_atom, ierr
    1012             : 
    1013             :       TYPE(f_env_type), POINTER                          :: f_env
    1014             : 
    1015          20 :       n_atom = 0
    1016          20 :       NULLIFY (f_env)
    1017          20 :       CALL f_env_add_defaults(env_id, f_env)
    1018          20 :       n_atom = force_env_get_natom(f_env%force_env)
    1019          20 :       CALL f_env_rm_defaults(f_env, ierr)
    1020             : 
    1021          20 :    END SUBROUTINE get_natom
    1022             : 
    1023             : ! **************************************************************************************************
    1024             : !> \brief returns the number of particles in the given force env
    1025             : !> \param env_id id of the force_env
    1026             : !> \param n_particle ...
    1027             : !> \param ierr will return a number different from 0 if there was an error
    1028             : !> \author Matthias Krack
    1029             : !>
    1030             : ! **************************************************************************************************
    1031         288 :    SUBROUTINE get_nparticle(env_id, n_particle, ierr)
    1032             : 
    1033             :       INTEGER, INTENT(IN)                                :: env_id
    1034             :       INTEGER, INTENT(OUT)                               :: n_particle, ierr
    1035             : 
    1036             :       TYPE(f_env_type), POINTER                          :: f_env
    1037             : 
    1038         144 :       n_particle = 0
    1039         144 :       NULLIFY (f_env)
    1040         144 :       CALL f_env_add_defaults(env_id, f_env)
    1041         144 :       n_particle = force_env_get_nparticle(f_env%force_env)
    1042         144 :       CALL f_env_rm_defaults(f_env, ierr)
    1043             : 
    1044         144 :    END SUBROUTINE get_nparticle
    1045             : 
    1046             : ! **************************************************************************************************
    1047             : !> \brief gets a cell
    1048             : !> \param env_id id of the force_env
    1049             : !> \param cell the array with the cell matrix
    1050             : !> \param per periodicity
    1051             : !> \param ierr will return a number different from 0 if there was an error
    1052             : !> \author Joost VandeVondele
    1053             : ! **************************************************************************************************
    1054           0 :    SUBROUTINE get_cell(env_id, cell, per, ierr)
    1055             : 
    1056             :       INTEGER, INTENT(IN)                                :: env_id
    1057             :       REAL(KIND=DP), DIMENSION(3, 3)                     :: cell
    1058             :       INTEGER, DIMENSION(3), OPTIONAL                    :: per
    1059             :       INTEGER, INTENT(OUT)                               :: ierr
    1060             : 
    1061             :       TYPE(cell_type), POINTER                           :: cell_full
    1062             :       TYPE(f_env_type), POINTER                          :: f_env
    1063             : 
    1064           0 :       NULLIFY (f_env)
    1065           0 :       CALL f_env_add_defaults(env_id, f_env)
    1066           0 :       NULLIFY (cell_full)
    1067           0 :       CALL force_env_get(f_env%force_env, cell=cell_full)
    1068           0 :       CPASSERT(ASSOCIATED(cell_full))
    1069           0 :       cell = cell_full%hmat
    1070           0 :       IF (PRESENT(per)) per(:) = cell_full%perd(:)
    1071           0 :       CALL f_env_rm_defaults(f_env, ierr)
    1072             : 
    1073           0 :    END SUBROUTINE get_cell
    1074             : 
    1075             : ! **************************************************************************************************
    1076             : !> \brief gets the qmmm cell
    1077             : !> \param env_id id of the force_env
    1078             : !> \param cell the array with the cell matrix
    1079             : !> \param ierr will return a number different from 0 if there was an error
    1080             : !> \author Holly Judge
    1081             : ! **************************************************************************************************
    1082           0 :    SUBROUTINE get_qmmm_cell(env_id, cell, ierr)
    1083             : 
    1084             :       INTEGER, INTENT(IN)                                :: env_id
    1085             :       REAL(KIND=DP), DIMENSION(3, 3)                     :: cell
    1086             :       INTEGER, INTENT(OUT)                               :: ierr
    1087             : 
    1088             :       TYPE(cell_type), POINTER                           :: cell_qmmm
    1089             :       TYPE(f_env_type), POINTER                          :: f_env
    1090             :       TYPE(qmmm_env_type), POINTER                       :: qmmm_env
    1091             : 
    1092           0 :       NULLIFY (f_env)
    1093           0 :       CALL f_env_add_defaults(env_id, f_env)
    1094           0 :       NULLIFY (cell_qmmm)
    1095           0 :       CALL force_env_get(f_env%force_env, qmmm_env=qmmm_env)
    1096           0 :       CALL get_qs_env(qmmm_env%qs_env, cell=cell_qmmm)
    1097           0 :       CPASSERT(ASSOCIATED(cell_qmmm))
    1098           0 :       cell = cell_qmmm%hmat
    1099           0 :       CALL f_env_rm_defaults(f_env, ierr)
    1100             : 
    1101           0 :    END SUBROUTINE get_qmmm_cell
    1102             : 
    1103             : ! **************************************************************************************************
    1104             : !> \brief gets a result from CP2K that is a real 1D array
    1105             : !> \param env_id id of the force_env
    1106             : !> \param description the tag of the result
    1107             : !> \param N ...
    1108             : !> \param RESULT ...
    1109             : !> \param res_exist ...
    1110             : !> \param ierr will return a number different from 0 if there was an error
    1111             : !> \author Joost VandeVondele
    1112             : ! **************************************************************************************************
    1113           0 :    SUBROUTINE get_result_r1(env_id, description, N, RESULT, res_exist, ierr)
    1114             :       INTEGER                                            :: env_id
    1115             :       CHARACTER(LEN=default_string_length)               :: description
    1116             :       INTEGER                                            :: N
    1117             :       REAL(KIND=dp), DIMENSION(1:N)                      :: RESULT
    1118             :       LOGICAL, OPTIONAL                                  :: res_exist
    1119             :       INTEGER                                            :: ierr
    1120             : 
    1121             :       INTEGER                                            :: nres
    1122             :       LOGICAL                                            :: exist_res
    1123             :       TYPE(cp_result_type), POINTER                      :: results
    1124             :       TYPE(cp_subsys_type), POINTER                      :: subsys
    1125             :       TYPE(f_env_type), POINTER                          :: f_env
    1126             : 
    1127           0 :       NULLIFY (f_env, subsys, results)
    1128           0 :       CALL f_env_add_defaults(env_id, f_env)
    1129             : 
    1130           0 :       CALL force_env_get(f_env%force_env, subsys=subsys)
    1131           0 :       CALL cp_subsys_get(subsys, results=results)
    1132             :       ! first test for the result
    1133           0 :       IF (PRESENT(res_exist)) THEN
    1134           0 :          res_exist = test_for_result(results, description=description)
    1135             :          exist_res = res_exist
    1136             :       ELSE
    1137             :          exist_res = .TRUE.
    1138             :       END IF
    1139             :       ! if existing (or assuming the existence) read the results
    1140           0 :       IF (exist_res) THEN
    1141           0 :          CALL get_results(results, description=description, n_rep=nres)
    1142           0 :          CALL get_results(results, description=description, values=RESULT, nval=nres)
    1143             :       END IF
    1144             : 
    1145           0 :       CALL f_env_rm_defaults(f_env, ierr)
    1146             : 
    1147           0 :    END SUBROUTINE get_result_r1
    1148             : 
    1149             : ! **************************************************************************************************
    1150             : !> \brief gets the forces of the particles
    1151             : !> \param env_id id of the force_env
    1152             : !> \param frc the array where to write the forces
    1153             : !> \param n_el number of positions (3*nparticle) just to check
    1154             : !> \param ierr will return a number different from 0 if there was an error
    1155             : !> \date   22.11.2010 (MK)
    1156             : !> \author fawzi
    1157             : ! **************************************************************************************************
    1158       18476 :    SUBROUTINE get_force(env_id, frc, n_el, ierr)
    1159             : 
    1160             :       INTEGER, INTENT(IN)                                :: env_id, n_el
    1161             :       REAL(KIND=dp), DIMENSION(1:n_el)                   :: frc
    1162             :       INTEGER, INTENT(OUT)                               :: ierr
    1163             : 
    1164             :       TYPE(f_env_type), POINTER                          :: f_env
    1165             : 
    1166        9238 :       NULLIFY (f_env)
    1167        9238 :       CALL f_env_add_defaults(env_id, f_env)
    1168        9238 :       CALL force_env_get_frc(f_env%force_env, frc, n_el)
    1169        9238 :       CALL f_env_rm_defaults(f_env, ierr)
    1170             : 
    1171        9238 :    END SUBROUTINE get_force
    1172             : 
    1173             : ! **************************************************************************************************
    1174             : !> \brief gets the stress tensor
    1175             : !> \param env_id id of the force_env
    1176             : !> \param stress_tensor the array where to write the stress tensor
    1177             : !> \param ierr will return a number different from 0 if there was an error
    1178             : !> \author Ole Schuett
    1179             : ! **************************************************************************************************
    1180           0 :    SUBROUTINE get_stress_tensor(env_id, stress_tensor, ierr)
    1181             : 
    1182             :       INTEGER, INTENT(IN)                                :: env_id
    1183             :       REAL(KIND=dp), DIMENSION(3, 3), INTENT(OUT)        :: stress_tensor
    1184             :       INTEGER, INTENT(OUT)                               :: ierr
    1185             : 
    1186             :       TYPE(cell_type), POINTER                           :: cell
    1187             :       TYPE(cp_subsys_type), POINTER                      :: subsys
    1188             :       TYPE(f_env_type), POINTER                          :: f_env
    1189             :       TYPE(virial_type), POINTER                         :: virial
    1190             : 
    1191           0 :       NULLIFY (f_env, subsys, virial, cell)
    1192           0 :       stress_tensor(:, :) = 0.0_dp
    1193             : 
    1194           0 :       CALL f_env_add_defaults(env_id, f_env)
    1195           0 :       CALL force_env_get(f_env%force_env, subsys=subsys, cell=cell)
    1196           0 :       CALL cp_subsys_get(subsys, virial=virial)
    1197           0 :       IF (virial%pv_availability) THEN
    1198           0 :          stress_tensor(:, :) = virial%pv_virial(:, :)/cell%deth
    1199             :       END IF
    1200           0 :       CALL f_env_rm_defaults(f_env, ierr)
    1201             : 
    1202           0 :    END SUBROUTINE get_stress_tensor
    1203             : 
    1204             : ! **************************************************************************************************
    1205             : !> \brief gets the positions of the particles
    1206             : !> \param env_id id of the force_env
    1207             : !> \param pos the array where to write the positions
    1208             : !> \param n_el number of positions (3*nparticle) just to check
    1209             : !> \param ierr will return a number different from 0 if there was an error
    1210             : !> \date   22.11.2010 (MK)
    1211             : !> \author fawzi
    1212             : ! **************************************************************************************************
    1213         680 :    SUBROUTINE get_pos(env_id, pos, n_el, ierr)
    1214             : 
    1215             :       INTEGER, INTENT(IN)                                :: env_id, n_el
    1216             :       REAL(KIND=DP), DIMENSION(1:n_el)                   :: pos
    1217             :       INTEGER, INTENT(OUT)                               :: ierr
    1218             : 
    1219             :       TYPE(f_env_type), POINTER                          :: f_env
    1220             : 
    1221         340 :       NULLIFY (f_env)
    1222         340 :       CALL f_env_add_defaults(env_id, f_env)
    1223         340 :       CALL force_env_get_pos(f_env%force_env, pos, n_el)
    1224         340 :       CALL f_env_rm_defaults(f_env, ierr)
    1225             : 
    1226         340 :    END SUBROUTINE get_pos
    1227             : 
    1228             : ! **************************************************************************************************
    1229             : !> \brief gets the velocities of the particles
    1230             : !> \param env_id id of the force_env
    1231             : !> \param vel the array where to write the velocities
    1232             : !> \param n_el number of velocities (3*nparticle) just to check
    1233             : !> \param ierr will return a number different from 0 if there was an error
    1234             : !> \author fawzi
    1235             : !> date    22.11.2010 (MK)
    1236             : ! **************************************************************************************************
    1237           0 :    SUBROUTINE get_vel(env_id, vel, n_el, ierr)
    1238             : 
    1239             :       INTEGER, INTENT(IN)                                :: env_id, n_el
    1240             :       REAL(KIND=DP), DIMENSION(1:n_el)                   :: vel
    1241             :       INTEGER, INTENT(OUT)                               :: ierr
    1242             : 
    1243             :       TYPE(f_env_type), POINTER                          :: f_env
    1244             : 
    1245           0 :       NULLIFY (f_env)
    1246           0 :       CALL f_env_add_defaults(env_id, f_env)
    1247           0 :       CALL force_env_get_vel(f_env%force_env, vel, n_el)
    1248           0 :       CALL f_env_rm_defaults(f_env, ierr)
    1249             : 
    1250           0 :    END SUBROUTINE get_vel
    1251             : 
    1252             : ! **************************************************************************************************
    1253             : !> \brief sets a new cell
    1254             : !> \param env_id id of the force_env
    1255             : !> \param new_cell the array with the cell matrix
    1256             : !> \param ierr will return a number different from 0 if there was an error
    1257             : !> \author Joost VandeVondele
    1258             : ! **************************************************************************************************
    1259        8304 :    SUBROUTINE set_cell(env_id, new_cell, ierr)
    1260             : 
    1261             :       INTEGER, INTENT(IN)                                :: env_id
    1262             :       REAL(KIND=DP), DIMENSION(3, 3)                     :: new_cell
    1263             :       INTEGER, INTENT(OUT)                               :: ierr
    1264             : 
    1265             :       TYPE(cell_type), POINTER                           :: cell
    1266             :       TYPE(cp_subsys_type), POINTER                      :: subsys
    1267             :       TYPE(f_env_type), POINTER                          :: f_env
    1268             : 
    1269        4152 :       NULLIFY (f_env, cell, subsys)
    1270        4152 :       CALL f_env_add_defaults(env_id, f_env)
    1271        4152 :       NULLIFY (cell)
    1272        4152 :       CALL force_env_get(f_env%force_env, cell=cell)
    1273        4152 :       CPASSERT(ASSOCIATED(cell))
    1274       53976 :       cell%hmat = new_cell
    1275        4152 :       CALL init_cell(cell)
    1276        4152 :       CALL force_env_get(f_env%force_env, subsys=subsys)
    1277        4152 :       CALL cp_subsys_set(subsys, cell=cell)
    1278        4152 :       CALL f_env_rm_defaults(f_env, ierr)
    1279             : 
    1280        4152 :    END SUBROUTINE set_cell
    1281             : 
    1282             : ! **************************************************************************************************
    1283             : !> \brief sets the positions of the particles
    1284             : !> \param env_id id of the force_env
    1285             : !> \param new_pos the array with the new positions
    1286             : !> \param n_el number of positions (3*nparticle) just to check
    1287             : !> \param ierr will return a number different from 0 if there was an error
    1288             : !> \date   22.11.2010 updated (MK)
    1289             : !> \author fawzi
    1290             : ! **************************************************************************************************
    1291       26898 :    SUBROUTINE set_pos(env_id, new_pos, n_el, ierr)
    1292             : 
    1293             :       INTEGER, INTENT(IN)                                :: env_id, n_el
    1294             :       REAL(KIND=dp), DIMENSION(1:n_el)                   :: new_pos
    1295             :       INTEGER, INTENT(OUT)                               :: ierr
    1296             : 
    1297             :       TYPE(cp_subsys_type), POINTER                      :: subsys
    1298             :       TYPE(f_env_type), POINTER                          :: f_env
    1299             : 
    1300       13449 :       NULLIFY (f_env)
    1301       13449 :       CALL f_env_add_defaults(env_id, f_env)
    1302       13449 :       NULLIFY (subsys)
    1303       13449 :       CALL force_env_get(f_env%force_env, subsys=subsys)
    1304       13449 :       CALL unpack_subsys_particles(subsys=subsys, r=new_pos)
    1305       13449 :       CALL f_env_rm_defaults(f_env, ierr)
    1306             : 
    1307       13449 :    END SUBROUTINE set_pos
    1308             : 
    1309             : ! **************************************************************************************************
    1310             : !> \brief sets the velocities of the particles
    1311             : !> \param env_id id of the force_env
    1312             : !> \param new_vel the array with the new velocities
    1313             : !> \param n_el number of velocities (3*nparticle) just to check
    1314             : !> \param ierr will return a number different from 0 if there was an error
    1315             : !> \date   22.11.2010 updated (MK)
    1316             : !> \author fawzi
    1317             : ! **************************************************************************************************
    1318         288 :    SUBROUTINE set_vel(env_id, new_vel, n_el, ierr)
    1319             : 
    1320             :       INTEGER, INTENT(IN)                                :: env_id, n_el
    1321             :       REAL(kind=dp), DIMENSION(1:n_el)                   :: new_vel
    1322             :       INTEGER, INTENT(OUT)                               :: ierr
    1323             : 
    1324             :       TYPE(cp_subsys_type), POINTER                      :: subsys
    1325             :       TYPE(f_env_type), POINTER                          :: f_env
    1326             : 
    1327         144 :       NULLIFY (f_env)
    1328         144 :       CALL f_env_add_defaults(env_id, f_env)
    1329         144 :       NULLIFY (subsys)
    1330         144 :       CALL force_env_get(f_env%force_env, subsys=subsys)
    1331         144 :       CALL unpack_subsys_particles(subsys=subsys, v=new_vel)
    1332         144 :       CALL f_env_rm_defaults(f_env, ierr)
    1333             : 
    1334         144 :    END SUBROUTINE set_vel
    1335             : 
    1336             : ! **************************************************************************************************
    1337             : !> \brief updates the energy and the forces of given force_env
    1338             : !> \param env_id id of the force_env that you want to update
    1339             : !> \param calc_force if the forces should be updated, if false the forces
    1340             : !>        might be wrong.
    1341             : !> \param ierr will return a number different from 0 if there was an error
    1342             : !> \author fawzi
    1343             : ! **************************************************************************************************
    1344       26758 :    RECURSIVE SUBROUTINE calc_energy_force(env_id, calc_force, ierr)
    1345             : 
    1346             :       INTEGER, INTENT(in)                                :: env_id
    1347             :       LOGICAL, INTENT(in)                                :: calc_force
    1348             :       INTEGER, INTENT(out)                               :: ierr
    1349             : 
    1350             :       TYPE(cp_logger_type), POINTER                      :: logger
    1351             :       TYPE(f_env_type), POINTER                          :: f_env
    1352             : 
    1353       13379 :       NULLIFY (f_env)
    1354       13379 :       CALL f_env_add_defaults(env_id, f_env)
    1355       13379 :       logger => cp_get_default_logger()
    1356       13379 :       CALL cp_iterate(logger%iter_info) ! add one to the iteration count
    1357       13379 :       CALL force_env_calc_energy_force(f_env%force_env, calc_force=calc_force)
    1358       13379 :       CALL f_env_rm_defaults(f_env, ierr)
    1359             : 
    1360       13379 :    END SUBROUTINE calc_energy_force
    1361             : 
    1362             : ! **************************************************************************************************
    1363             : !> \brief returns the energy of the last configuration calculated
    1364             : !> \param env_id id of the force_env that you want to update
    1365             : !> \param e_pot the potential energy of the system
    1366             : !> \param ierr will return a number different from 0 if there was an error
    1367             : !> \author fawzi
    1368             : ! **************************************************************************************************
    1369       40317 :    SUBROUTINE get_energy(env_id, e_pot, ierr)
    1370             : 
    1371             :       INTEGER, INTENT(in)                                :: env_id
    1372             :       REAL(kind=dp), INTENT(out)                         :: e_pot
    1373             :       INTEGER, INTENT(out)                               :: ierr
    1374             : 
    1375             :       TYPE(f_env_type), POINTER                          :: f_env
    1376             : 
    1377       13439 :       NULLIFY (f_env)
    1378       13439 :       CALL f_env_add_defaults(env_id, f_env)
    1379       13439 :       CALL force_env_get(f_env%force_env, potential_energy=e_pot)
    1380       13439 :       CALL f_env_rm_defaults(f_env, ierr)
    1381             : 
    1382       13439 :    END SUBROUTINE get_energy
    1383             : 
    1384             : ! **************************************************************************************************
    1385             : !> \brief returns the energy of the configuration given by the positions
    1386             : !>      passed as argument
    1387             : !> \param env_id id of the force_env that you want to update
    1388             : !> \param pos array with the positions
    1389             : !> \param n_el number of elements in pos (3*natom)
    1390             : !> \param e_pot the potential energy of the system
    1391             : !> \param ierr will return a number different from 0 if there was an error
    1392             : !> \author fawzi
    1393             : !> \note
    1394             : !>      utility call
    1395             : ! **************************************************************************************************
    1396        4199 :    RECURSIVE SUBROUTINE calc_energy(env_id, pos, n_el, e_pot, ierr)
    1397             : 
    1398             :       INTEGER, INTENT(IN)                                :: env_id, n_el
    1399             :       REAL(KIND=dp), DIMENSION(1:n_el), INTENT(IN)       :: pos
    1400             :       REAL(KIND=dp), INTENT(OUT)                         :: e_pot
    1401             :       INTEGER, INTENT(OUT)                               :: ierr
    1402             : 
    1403             :       REAL(KIND=dp), DIMENSION(1)                        :: dummy_f
    1404             : 
    1405        4199 :       CALL calc_force(env_id, pos, n_el, e_pot, dummy_f, 0, ierr)
    1406             : 
    1407        4199 :    END SUBROUTINE calc_energy
    1408             : 
    1409             : ! **************************************************************************************************
    1410             : !> \brief returns the energy of the configuration given by the positions
    1411             : !>      passed as argument
    1412             : !> \param env_id id of the force_env that you want to update
    1413             : !> \param pos array with the positions
    1414             : !> \param n_el_pos number of elements in pos (3*natom)
    1415             : !> \param e_pot the potential energy of the system
    1416             : !> \param force array that will contain the forces
    1417             : !> \param n_el_force number of elements in force (3*natom). If 0 the
    1418             : !>        forces are not calculated
    1419             : !> \param ierr will return a number different from 0 if there was an error
    1420             : !> \author fawzi
    1421             : !> \note
    1422             : !>      utility call, but actually it could be a better and more efficient
    1423             : !>      interface to connect to other codes if cp2k would be deeply
    1424             : !>      refactored
    1425             : ! **************************************************************************************************
    1426       13377 :    RECURSIVE SUBROUTINE calc_force(env_id, pos, n_el_pos, e_pot, force, n_el_force, ierr)
    1427             : 
    1428             :       INTEGER, INTENT(in)                                :: env_id, n_el_pos
    1429             :       REAL(kind=dp), DIMENSION(1:n_el_pos), INTENT(in)   :: pos
    1430             :       REAL(kind=dp), INTENT(out)                         :: e_pot
    1431             :       INTEGER, INTENT(in)                                :: n_el_force
    1432             :       REAL(kind=dp), DIMENSION(1:n_el_force), &
    1433             :          INTENT(inout)                                   :: force
    1434             :       INTEGER, INTENT(out)                               :: ierr
    1435             : 
    1436             :       LOGICAL                                            :: calc_f
    1437             : 
    1438       13377 :       calc_f = (n_el_force /= 0)
    1439       13377 :       CALL set_pos(env_id, pos, n_el_pos, ierr)
    1440       13377 :       IF (ierr == 0) CALL calc_energy_force(env_id, calc_f, ierr)
    1441       13377 :       IF (ierr == 0) CALL get_energy(env_id, e_pot, ierr)
    1442       13377 :       IF (calc_f .AND. (ierr == 0)) CALL get_force(env_id, force, n_el_force, ierr)
    1443             : 
    1444       13377 :    END SUBROUTINE calc_force
    1445             : 
    1446             : ! **************************************************************************************************
    1447             : !> \brief performs a check of the input
    1448             : !> \param input_declaration ...
    1449             : !> \param input_file_path the path of the input file to check
    1450             : !> \param output_file_path path of the output file (to which it is appended)
    1451             : !>        if it is "__STD_OUT__" the default_output_unit is used
    1452             : !> \param echo_input if the parsed input should be written out with all the
    1453             : !>        defaults made explicit
    1454             : !> \param mpi_comm the mpi communicator (if not given it uses the default
    1455             : !>        one)
    1456             : !> \param initial_variables key-value list of initial preprocessor variables
    1457             : !> \param ierr error control, if different from 0 there was an error
    1458             : !> \author fawzi
    1459             : ! **************************************************************************************************
    1460           0 :    SUBROUTINE check_input(input_declaration, input_file_path, output_file_path, &
    1461           0 :                           echo_input, mpi_comm, initial_variables, ierr)
    1462             :       TYPE(section_type), POINTER                        :: input_declaration
    1463             :       CHARACTER(len=*), INTENT(in)                       :: input_file_path, output_file_path
    1464             :       LOGICAL, INTENT(in), OPTIONAL                      :: echo_input
    1465             :       TYPE(mp_comm_type), INTENT(in), OPTIONAL           :: mpi_comm
    1466             :       CHARACTER(len=default_path_length), &
    1467             :          DIMENSION(:, :), INTENT(IN)                     :: initial_variables
    1468             :       INTEGER, INTENT(out)                               :: ierr
    1469             : 
    1470             :       INTEGER                                            :: unit_nr
    1471             :       LOGICAL                                            :: my_echo_input
    1472             :       TYPE(cp_logger_type), POINTER                      :: logger
    1473             :       TYPE(mp_para_env_type), POINTER                    :: para_env
    1474             :       TYPE(section_vals_type), POINTER                   :: input_file
    1475             : 
    1476           0 :       my_echo_input = .FALSE.
    1477           0 :       IF (PRESENT(echo_input)) my_echo_input = echo_input
    1478             : 
    1479           0 :       IF (PRESENT(mpi_comm)) THEN
    1480           0 :          ALLOCATE (para_env)
    1481           0 :          para_env = mpi_comm
    1482             :       ELSE
    1483           0 :          para_env => default_para_env
    1484           0 :          CALL para_env%retain()
    1485             :       END IF
    1486           0 :       IF (para_env%is_source()) THEN
    1487           0 :          IF (output_file_path == "__STD_OUT__") THEN
    1488           0 :             unit_nr = default_output_unit
    1489             :          ELSE
    1490             :             CALL open_file(file_name=output_file_path, file_status="UNKNOWN", &
    1491             :                            file_action="WRITE", file_position="APPEND", &
    1492           0 :                            unit_number=unit_nr)
    1493             :          END IF
    1494             :       ELSE
    1495           0 :          unit_nr = -1
    1496             :       END IF
    1497             : 
    1498           0 :       NULLIFY (logger)
    1499             :       CALL cp_logger_create(logger, para_env=para_env, &
    1500             :                             default_global_unit_nr=unit_nr, &
    1501           0 :                             close_global_unit_on_dealloc=.FALSE.)
    1502           0 :       CALL cp_add_default_logger(logger)
    1503           0 :       CALL cp_logger_release(logger)
    1504             : 
    1505             :       input_file => read_input(input_declaration, input_file_path, initial_variables=initial_variables, &
    1506           0 :                                para_env=para_env)
    1507           0 :       CALL check_cp2k_input(input_declaration, input_file, para_env=para_env, output_unit=unit_nr)
    1508           0 :       IF (my_echo_input .AND. para_env%is_source()) THEN
    1509             :          CALL section_vals_write(input_file, &
    1510             :                                  unit_nr=cp_logger_get_default_unit_nr(logger, local=.FALSE.), hide_root=.TRUE., &
    1511           0 :                                  hide_defaults=.FALSE.)
    1512             :       END IF
    1513           0 :       CALL section_vals_release(input_file)
    1514             : 
    1515           0 :       CALL cp_logger_release(logger)
    1516           0 :       CALL mp_para_env_release(para_env)
    1517           0 :       ierr = 0
    1518           0 :       CALL cp_rm_default_logger()
    1519           0 :    END SUBROUTINE check_input
    1520             : 
    1521           0 : END MODULE f77_interface

Generated by: LCOV version 1.15