1!--------------------------------------------------------------------------------------------------!
2!   CP2K: A general program to perform molecular dynamics simulations                              !
3!   Copyright (C) 2000 - 2020  CP2K developers group                                               !
4!--------------------------------------------------------------------------------------------------!
5
6! **************************************************************************************************
7!> \note
8!>      Routine to initialize a real space grid from a given input section
9!> \par History
10!>      01.2014 moved routine from realspace_grid_types into separate file.
11!> \author Ole Schuett
12! **************************************************************************************************
13MODULE cp_realspace_grid_init
14   USE input_section_types,             ONLY: section_vals_get,&
15                                              section_vals_type,&
16                                              section_vals_val_get
17   USE kinds,                           ONLY: dp
18   USE realspace_grid_types,            ONLY: realspace_grid_input_type,&
19                                              rsgrid_automatic,&
20                                              rsgrid_replicated
21#include "./base/base_uses.f90"
22
23   IMPLICIT NONE
24
25   PRIVATE
26
27   PUBLIC :: init_input_type
28
29   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_realspace_grid_init'
30
31CONTAINS
32
33! **************************************************************************************************
34!> \brief parses an input section to assign the proper values to the input type
35!> \param input_settings ...
36!> \param nsmax ...
37!> \param rs_grid_section ...
38!> \param ilevel ...
39!> \param higher_grid_layout the layout of a higher level grid. layouts with
40!>       negative or zero values are ignored
41!> \par History
42!>      01.2008 created [Joost VandeVondele]
43!> \note
44!>      if rs_grid_section is not present we setup for an replicated setup
45! **************************************************************************************************
46   SUBROUTINE init_input_type(input_settings, nsmax, rs_grid_section, ilevel, higher_grid_layout)
47      TYPE(realspace_grid_input_type), INTENT(OUT)       :: input_settings
48      INTEGER, INTENT(IN)                                :: nsmax
49      TYPE(section_vals_type), OPTIONAL, POINTER         :: rs_grid_section
50      INTEGER, INTENT(IN)                                :: ilevel
51      INTEGER, DIMENSION(3), INTENT(IN)                  :: higher_grid_layout
52
53      INTEGER                                            :: isection, max_distributed_level, nsection
54      INTEGER, DIMENSION(:), POINTER                     :: tmp
55
56      IF (PRESENT(rs_grid_section)) THEN
57         input_settings%nsmax = nsmax
58         ! we use the section corresponding to the level, or the largest available one
59         ! i.e. the last section defines all following ones
60         CALL section_vals_get(rs_grid_section, n_repetition=nsection)
61         isection = MAX(1, MIN(ilevel, nsection))
62         CALL section_vals_val_get(rs_grid_section, "DISTRIBUTION_TYPE", &
63                                   i_rep_section=isection, &
64                                   i_val=input_settings%distribution_type)
65         CALL section_vals_val_get(rs_grid_section, "DISTRIBUTION_LAYOUT", &
66                                   i_rep_section=isection, &
67                                   i_vals=tmp)
68         input_settings%distribution_layout = tmp
69         CALL section_vals_val_get(rs_grid_section, "MEMORY_FACTOR", &
70                                   i_rep_section=isection, &
71                                   r_val=input_settings%memory_factor)
72         CALL section_vals_val_get(rs_grid_section, "HALO_REDUCTION_FACTOR", &
73                                   i_rep_section=isection, &
74                                   r_val=input_settings%halo_reduction_factor)
75         CALL section_vals_val_get(rs_grid_section, "LOCK_DISTRIBUTION", &
76                                   i_rep_section=isection, &
77                                   l_val=input_settings%lock_distribution)
78         CALL section_vals_val_get(rs_grid_section, "MAX_DISTRIBUTED_LEVEL", &
79                                   i_rep_section=isection, &
80                                   i_val=max_distributed_level)
81
82         ! multigrids that are to coarse are not distributed in the automatic scheme
83         IF (input_settings%distribution_type == rsgrid_automatic) THEN
84            IF (ilevel > max_distributed_level) THEN
85               input_settings%distribution_type = rsgrid_replicated
86            ENDIF
87         ENDIF
88      ELSE
89         input_settings%nsmax = -1
90         input_settings%distribution_type = rsgrid_replicated
91         input_settings%lock_distribution = .FALSE.
92         input_settings%halo_reduction_factor = 1.0_dp
93      ENDIF
94      IF (input_settings%lock_distribution) THEN
95         IF (ALL(higher_grid_layout > 0)) input_settings%distribution_layout = higher_grid_layout
96      ENDIF
97   END SUBROUTINE init_input_type
98
99END MODULE cp_realspace_grid_init
100