1!--------------------------------------------------------------------------------------------------!
2!   CP2K: A general program to perform molecular dynamics simulations                              !
3!   Copyright (C) 2000 - 2019  CP2K developers group                                               !
4!--------------------------------------------------------------------------------------------------!
5
6! **************************************************************************************************
7!> \brief represent the global information of a run: the input file,
8!>      parallel environment (and partially output).
9!>      Use sparingly, try not to send it too deep in your structures.
10!> \par History
11!>      - print keys, basis_set_file name and potential_file_name added to the
12!>        global type (27.02.2001, MK)
13!>      - JGH (28.11.2001) : added pp_library_path to type
14!>      - Merged with MODULE print_keys (17.01.2002, MK)
15!>      -  reference counting, create (08.2004, fawzi)
16!>      - new (parallel) random number generator (11.03.06,MK)
17!> \author JGH,MK,fawzi
18! **************************************************************************************************
19MODULE global_types
20
21   USE cp_blacs_env,                    ONLY: BLACS_GRID_SQUARE
22   USE kinds,                           ONLY: default_path_length,&
23                                              default_string_length,&
24                                              dp
25   USE machine,                         ONLY: m_walltime
26   USE parallel_rng_types,              ONLY: delete_rng_stream,&
27                                              rng_stream_type
28#include "./base/base_uses.f90"
29
30   IMPLICIT NONE
31
32   PRIVATE
33
34   ! Global parameters
35
36   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'global_types'
37
38   INTEGER, PARAMETER :: SILENT = 0, &
39                         LOW = 1, &
40                         MEDIUM = 2, &
41                         HIGH = 3, &
42                         DEBUG = 4
43
44   ! Public parameters
45
46   ! Public data types
47   PUBLIC :: global_environment_type
48
49   ! Public subroutines
50   PUBLIC :: globenv_create, &
51             globenv_retain, &
52             globenv_release
53
54! **************************************************************************************************
55!> \brief contains the initally parsed file and the initial parallel environment
56!> \param id_nr identification number (unique)
57!> \param ref_count reference count (see doc/ReferenceCounting.html)
58!> \param handle handle with the total time of the computation
59!>
60!>      Personally I think that all the other attributes should go away
61!>      (and maybe add  a logger)[fawzi]
62!> \note
63!>      This is not but really should be passed as pointer and use reference
64!>      counting. Use it accordingly wherever possible.
65! **************************************************************************************************
66   TYPE global_environment_type
67      INTEGER :: id_nr, ref_count
68      TYPE(rng_stream_type), POINTER          :: gaussian_rng_stream
69      CHARACTER(LEN=default_string_length)    :: diag_library
70      CHARACTER(LEN=default_string_length)    :: default_fft_library
71      CHARACTER(LEN=default_path_length)      :: fftw_wisdom_file_name
72
73      INTEGER :: fft_pool_scratch_limit !! limit used for fft scratches
74      INTEGER :: fftw_plan_type !! which kind of planning to use with fftw
75      INTEGER :: idum !! random number seed
76      INTEGER :: prog_name_id !! index to define the type of program
77      INTEGER :: run_type_id !! index to define the run_tupe
78      INTEGER :: blacs_grid_layout !! will store the user preference for the blacs grid
79      INTEGER :: k_elpa !! optimized kernel for the ELPA diagonalization library
80      LOGICAL :: elpa_qr !! allow ELPA to use QR during diagonalization
81      LOGICAL :: elpa_print !! if additional information about ELPA diagonalization should be printed
82      LOGICAL :: elpa_qr_unsafe !! enable potentially unsafe ELPA options
83      LOGICAL :: blacs_repeatable !! will store the user preference for the repeatability of blacs collectives
84      REAL(KIND=dp) :: cp2k_start_time, cp2k_target_time
85      INTEGER :: handle
86   END TYPE global_environment_type
87
88CONTAINS
89
90! **************************************************************************************************
91!> \brief creates a globenv
92!> \param globenv the globenv to create
93!> \author fawzi
94! **************************************************************************************************
95   SUBROUTINE globenv_create(globenv)
96      TYPE(global_environment_type), POINTER             :: globenv
97
98      CHARACTER(len=*), PARAMETER :: routineN = 'globenv_create', routineP = moduleN//':'//routineN
99
100      CPASSERT(.NOT. ASSOCIATED(globenv))
101      ALLOCATE (globenv)
102      globenv%ref_count = 1
103      globenv%run_type_id = 0
104      globenv%diag_library = "SL"
105      globenv%k_elpa = 1
106      globenv%elpa_qr = .FALSE.
107      globenv%elpa_print = .FALSE.
108      globenv%default_fft_library = "FFTSG"
109      globenv%fftw_wisdom_file_name = "/etc/fftw/wisdom"
110      globenv%prog_name_id = 0
111      globenv%idum = 0 !! random number seed
112      globenv%blacs_grid_layout = BLACS_GRID_SQUARE
113      globenv%cp2k_start_time = m_walltime()
114      NULLIFY (globenv%gaussian_rng_stream)
115   END SUBROUTINE globenv_create
116
117! **************************************************************************************************
118!> \brief retains the global environment
119!> \param globenv the global environment to retain
120!> \author fawzi
121! **************************************************************************************************
122   SUBROUTINE globenv_retain(globenv)
123      TYPE(global_environment_type), POINTER             :: globenv
124
125      CHARACTER(len=*), PARAMETER :: routineN = 'globenv_retain', routineP = moduleN//':'//routineN
126
127      CPASSERT(ASSOCIATED(globenv))
128      CPASSERT(globenv%ref_count > 0)
129      globenv%ref_count = globenv%ref_count + 1
130   END SUBROUTINE globenv_retain
131
132! **************************************************************************************************
133!> \brief releases the global environment
134!> \param globenv the global environment to release
135!> \author fawzi
136! **************************************************************************************************
137   SUBROUTINE globenv_release(globenv)
138      TYPE(global_environment_type), POINTER             :: globenv
139
140      CHARACTER(len=*), PARAMETER :: routineN = 'globenv_release', &
141         routineP = moduleN//':'//routineN
142
143      IF (ASSOCIATED(globenv)) THEN
144         CPASSERT(globenv%ref_count > 0)
145         globenv%ref_count = globenv%ref_count - 1
146         IF (globenv%ref_count == 0) THEN
147            IF (ASSOCIATED(globenv%gaussian_rng_stream)) THEN
148               CALL delete_rng_stream(globenv%gaussian_rng_stream)
149            END IF
150            DEALLOCATE (globenv)
151         END IF
152      END IF
153      NULLIFY (globenv)
154   END SUBROUTINE globenv_release
155
156END MODULE global_types
157