1!--------------------------------------------------------------------------------------------------!
2!   CP2K: A general program to perform molecular dynamics simulations                              !
3!   Copyright (C) 2000 - 2019  CP2K developers group                                               !
4!--------------------------------------------------------------------------------------------------!
5
6! **************************************************************************************************
7!> \brief perform classical molecular dynamics and path integral simulations
8!> \par History
9!>      gt SEPT-23-2002: part is allocated/deallocated/initialized in
10!>                       read_coord_vel
11!>      CJM rewrite
12!> \author CJM-Sept-01-02
13! **************************************************************************************************
14MODULE fist_main
15   USE cp_para_types,                   ONLY: cp_para_env_type
16   USE cp_subsys_types,                 ONLY: cp_subsys_type
17   USE fist_environment,                ONLY: fist_init
18   USE fist_environment_types,          ONLY: fist_env_create,&
19                                              fist_env_release,&
20                                              fist_env_set,&
21                                              fist_environment_type
22   USE force_env_methods,               ONLY: force_env_create
23   USE force_env_types,                 ONLY: force_env_type
24   USE global_types,                    ONLY: global_environment_type
25   USE input_section_types,             ONLY: section_vals_type
26   USE qmmm_types_low,                  ONLY: qmmm_env_mm_type
27#include "./base/base_uses.f90"
28
29   IMPLICIT NONE
30
31   PRIVATE
32
33! *** Global parameters ***
34   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'fist_main'
35
36! *** Global variables ***
37   PUBLIC :: fist_create_force_env
38
39!!-----------------------------------------------------------------------------!
40
41CONTAINS
42
43!-----------------------------------------------------------------------------!
44! FIST FIST FIST FIST FIST FIST FIST FIST FIST FIST FIST FIST FIST FIST FIST  !
45!-----------------------------------------------------------------------------!
46
47! **************************************************************************************************
48!> \brief Controls program flow for classical MD and path-integrals
49!> \param force_env ...
50!> \param root_section ...
51!> \param para_env ...
52!> \param globenv ...
53!> \param qmmm ...
54!> \param qmmm_env ...
55!> \param force_env_section ...
56!> \param subsys_section ...
57!> \param use_motion_section ...
58!> \param prev_subsys ...
59!> \par Used By
60!>      cp2k
61!> \author CJM
62! **************************************************************************************************
63   SUBROUTINE fist_create_force_env(force_env, root_section, para_env, globenv, &
64                                    qmmm, qmmm_env, force_env_section, subsys_section, use_motion_section, prev_subsys)
65      TYPE(force_env_type), POINTER                      :: force_env
66      TYPE(section_vals_type), POINTER                   :: root_section
67      TYPE(cp_para_env_type), POINTER                    :: para_env
68      TYPE(global_environment_type), POINTER             :: globenv
69      LOGICAL, OPTIONAL                                  :: qmmm
70      TYPE(qmmm_env_mm_type), OPTIONAL, POINTER          :: qmmm_env
71      TYPE(section_vals_type), POINTER                   :: force_env_section, subsys_section
72      LOGICAL, INTENT(IN)                                :: use_motion_section
73      TYPE(cp_subsys_type), OPTIONAL, POINTER            :: prev_subsys
74
75      CHARACTER(LEN=*), PARAMETER :: routineN = 'fist_create_force_env', &
76         routineP = moduleN//':'//routineN
77
78      INTEGER                                            :: handle
79      LOGICAL                                            :: myqmmm
80      TYPE(fist_environment_type), POINTER               :: fist_env
81
82      CALL timeset(routineN, handle)
83      myqmmm = .FALSE.
84      IF (PRESENT(qmmm)) THEN
85         myqmmm = qmmm
86      END IF
87
88      CALL fist_env_create(fist_env, para_env=para_env)
89      IF (PRESENT(qmmm_env)) THEN
90         CALL fist_env_set(fist_env, qmmm=myqmmm, qmmm_env=qmmm_env)
91      ELSE
92         CALL fist_env_set(fist_env, qmmm=myqmmm)
93      END IF
94      ! *** Read the input and the database files and perform further  ***
95      ! *** initializations for the setup of the FIST environment ***
96      CALL fist_init(fist_env, root_section, para_env, force_env_section, &
97                     subsys_section, use_motion_section, prev_subsys=prev_subsys)
98
99      CALL force_env_create(force_env, root_section, fist_env=fist_env, &
100                            para_env=para_env, globenv=globenv, &
101                            force_env_section=force_env_section)
102
103      CALL fist_env_release(fist_env)
104      CALL timestop(handle)
105   END SUBROUTINE fist_create_force_env
106
107END MODULE fist_main
108