1!--------------------------------------------------------------------------------------------------!
2!   CP2K: A general program to perform molecular dynamics simulations                              !
3!   Copyright (C) 2000 - 2019  CP2K developers group                                               !
4!--------------------------------------------------------------------------------------------------!
5
6! **************************************************************************************************
7!> \brief Utility routines to read data from files.
8!>      Kept as close as possible to the old parser because
9!>        1. string handling is a weak point of fortran compilers, and it is
10!>           easy to write correct things that do not work
11!>        2. conversion of old code
12!> \par History
13!>      22.11.1999 first version of the old parser (called qs_parser)
14!>                 Matthias Krack
15!>      06.2004 removed module variables, cp_parser_type, new module [fawzi]
16!>      08.2008 Added buffering [tlaino]
17!> \author fawzi
18! **************************************************************************************************
19MODULE cp_parser_types
20   USE cp_files,                        ONLY: close_file,&
21                                              open_file
22   USE cp_para_env,                     ONLY: cp_para_env_create,&
23                                              cp_para_env_release,&
24                                              cp_para_env_retain
25   USE cp_para_types,                   ONLY: cp_para_env_type
26   USE cp_parser_buffer_types,          ONLY: buffer_type,&
27                                              create_buffer_type,&
28                                              release_buffer_type
29   USE cp_parser_ilist_types,           ONLY: create_ilist_type,&
30                                              ilist_type,&
31                                              release_ilist_type
32   USE cp_parser_inpp_types,            ONLY: create_inpp_type,&
33                                              inpp_type,&
34                                              release_inpp_type
35   USE cp_parser_status_types,          ONLY: create_status_type,&
36                                              release_status_type,&
37                                              status_type
38   USE kinds,                           ONLY: default_path_length,&
39                                              default_string_length,&
40                                              max_line_length
41   USE message_passing,                 ONLY: mp_comm_self
42   USE string_utilities,                ONLY: compress
43#include "../base/base_uses.f90"
44
45   IMPLICIT NONE
46
47   PRIVATE
48
49   PUBLIC :: cp_parser_type, parser_release, parser_create, &
50             parser_reset, empty_initial_variables
51
52   ! this is a zero sized array by choice, and convenience
53   CHARACTER(LEN=default_path_length), DIMENSION(2, 1:0) :: empty_initial_variables
54
55   ! Private parameters
56   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_parser_types'
57   INTEGER, SAVE, PRIVATE               :: last_parser_id = 0
58
59   ! Global variables
60   CHARACTER(LEN=1), PARAMETER, PUBLIC   :: default_continuation_character = CHAR(92) ! backslash
61   CHARACTER(LEN=4), PARAMETER, PUBLIC   :: default_separators = ",:;="
62   CHARACTER(LEN=3), PARAMETER, PUBLIC   :: default_end_section_label = "END"
63   CHARACTER(LEN=1), PARAMETER, PUBLIC   :: default_comment_character(2) = (/"#", "!"/), &
64                                            default_section_character = "&", &
65                                            default_quote_character = '"'
66   INTEGER, PARAMETER, PUBLIC            :: max_unit_number = 999
67
68! **************************************************************************************************
69!> \brief represent a parser
70!> \param icol Number of the current column in the current input line,
71!>  -1 if at the end of the file
72!>  icol1            : First column of the current input string
73!>  icol2            : Last column of the current input string
74!> \param input_line_number Number of the current input line read from the input file
75!> \param input_unit Logical unit number of the input file
76!> \author fawzi
77! **************************************************************************************************
78   TYPE cp_parser_type
79      INTEGER                                        :: id_nr, ref_count
80      CHARACTER(LEN=default_string_length)           :: end_section, start_section
81      CHARACTER(LEN=10)                              :: separators
82      CHARACTER(LEN=1)                               :: comment_character(2), &
83                                                        continuation_character, &
84                                                        quote_character, &
85                                                        section_character
86      CHARACTER(LEN=default_path_length)             :: input_file_name
87      CHARACTER(LEN=max_line_length)                 :: input_line
88      INTEGER                                        :: icol, icol1, icol2
89      INTEGER                                        :: input_unit, input_line_number
90      LOGICAL                                        :: first_separator, &
91                                                        apply_preprocessing, &
92                                                        parse_white_lines
93      CHARACTER(len=default_path_length), DIMENSION(:, :), POINTER :: initial_variables
94      TYPE(buffer_type), POINTER                     :: buffer
95      TYPE(status_type), POINTER                     :: status
96      TYPE(cp_para_env_type), POINTER                :: para_env
97      TYPE(inpp_type), POINTER                       :: inpp
98      TYPE(ilist_type), POINTER                      :: ilist
99   END TYPE cp_parser_type
100
101CONTAINS
102
103! **************************************************************************************************
104!> \brief retains the given parser
105!> \param parser the parser to retain
106!> \author fawzi
107! **************************************************************************************************
108   SUBROUTINE parser_retain(parser)
109      TYPE(cp_parser_type), POINTER                      :: parser
110
111      CHARACTER(len=*), PARAMETER :: routineN = 'parser_retain', routineP = moduleN//':'//routineN
112
113      CPASSERT(ASSOCIATED(parser))
114      CPASSERT(parser%ref_count > 0)
115      parser%ref_count = parser%ref_count + 1
116   END SUBROUTINE parser_retain
117
118! **************************************************************************************************
119!> \brief   releases the parser
120!> \param parser ...
121!> \date    14.02.2001
122!> \author  MK
123!> \version 1.0
124! **************************************************************************************************
125   SUBROUTINE parser_release(parser)
126      TYPE(cp_parser_type), POINTER                      :: parser
127
128      CHARACTER(LEN=*), PARAMETER :: routineN = 'parser_release', routineP = moduleN//':'//routineN
129
130      IF (ASSOCIATED(parser)) THEN
131         CPASSERT(parser%ref_count > 0)
132         parser%ref_count = parser%ref_count - 1
133         IF (parser%ref_count == 0) THEN
134            IF (parser%input_unit >= 0) THEN
135               CALL close_file(unit_number=parser%input_unit)
136            END IF
137            CALL cp_para_env_release(parser%para_env)
138            CALL release_inpp_type(parser%inpp)
139            CALL release_ilist_type(parser%ilist)
140            CALL release_buffer_type(parser%buffer)
141            CALL release_status_type(parser%status)
142            IF (ASSOCIATED(parser%initial_variables)) THEN
143               DEALLOCATE (parser%initial_variables)
144            ENDIF
145            DEALLOCATE (parser)
146         END IF
147      END IF
148   END SUBROUTINE parser_release
149
150! **************************************************************************************************
151!> \brief   Start a parser run. Initial variables allow to @SET stuff before opening the file
152!> \param parser ...
153!> \param file_name ...
154!> \param unit_nr ...
155!> \param para_env ...
156!> \param end_section_label ...
157!> \param separator_chars ...
158!> \param comment_char ...
159!> \param continuation_char ...
160!> \param quote_char ...
161!> \param section_char ...
162!> \param parse_white_lines ...
163!> \param initial_variables ...
164!> \param apply_preprocessing ...
165!> \date    14.02.2001
166!> \author  MK
167!> \version 1.0
168! **************************************************************************************************
169   SUBROUTINE parser_create(parser, file_name, unit_nr, para_env, end_section_label, &
170                            separator_chars, comment_char, continuation_char, quote_char, &
171                            section_char, parse_white_lines, initial_variables, apply_preprocessing)
172      TYPE(cp_parser_type), POINTER                      :: parser
173      CHARACTER(LEN=*), INTENT(IN), OPTIONAL             :: file_name
174      INTEGER, INTENT(in), OPTIONAL                      :: unit_nr
175      TYPE(cp_para_env_type), OPTIONAL, POINTER          :: para_env
176      CHARACTER(LEN=*), INTENT(IN), OPTIONAL             :: end_section_label, separator_chars
177      CHARACTER(LEN=1), INTENT(IN), OPTIONAL             :: comment_char, continuation_char, &
178                                                            quote_char, section_char
179      LOGICAL, INTENT(IN), OPTIONAL                      :: parse_white_lines
180      CHARACTER(len=*), DIMENSION(:, :), OPTIONAL        :: initial_variables
181      LOGICAL, INTENT(IN), OPTIONAL                      :: apply_preprocessing
182
183      CHARACTER(LEN=*), PARAMETER :: routineN = 'parser_create', routineP = moduleN//':'//routineN
184
185      CPASSERT(.NOT. ASSOCIATED(parser))
186      ALLOCATE (parser)
187      last_parser_id = last_parser_id + 1
188      parser%id_nr = last_parser_id
189      parser%ref_count = 1
190
191      parser%input_unit = -1
192      parser%input_file_name = ""
193      NULLIFY (parser%initial_variables)
194
195      ! Load the default values and overwrite them, if requested
196      parser%separators = default_separators
197      IF (PRESENT(separator_chars)) parser%separators = separator_chars
198      parser%comment_character = default_comment_character
199      IF (PRESENT(comment_char)) parser%comment_character = comment_char
200      parser%continuation_character = default_continuation_character
201      IF (PRESENT(continuation_char)) parser%continuation_character = continuation_char
202      parser%quote_character = default_quote_character
203      IF (PRESENT(quote_char)) parser%quote_character = quote_char
204      parser%section_character = default_section_character
205      IF (PRESENT(section_char)) parser%section_character = section_char
206      parser%end_section = parser%section_character//default_end_section_label
207      IF (PRESENT(end_section_label)) THEN
208         parser%end_section = parser%section_character//TRIM(end_section_label)
209      END IF
210      parser%parse_white_lines = .FALSE.
211      IF (PRESENT(parse_white_lines)) THEN
212         parser%parse_white_lines = parse_white_lines
213      END IF
214      parser%apply_preprocessing = .TRUE.
215      IF (PRESENT(apply_preprocessing)) THEN
216         parser%apply_preprocessing = apply_preprocessing
217      END IF
218
219      CALL compress(parser%end_section) ! needed?
220
221      ! para_env
222      IF (PRESENT(para_env)) THEN
223         parser%para_env => para_env
224         CALL cp_para_env_retain(para_env)
225      ELSE
226         NULLIFY (parser%para_env)
227         CALL cp_para_env_create(parser%para_env, group=mp_comm_self, source=0, &
228                                 mepos=0, num_pe=1, owns_group=.FALSE.)
229      END IF
230
231      !   *** Get the logical output unit number for error messages ***
232      IF (parser%para_env%ionode) THEN
233         IF (PRESENT(unit_nr)) THEN
234            parser%input_unit = unit_nr
235            IF (PRESENT(file_name)) parser%input_file_name = file_name
236         ELSE
237            IF (.NOT. PRESENT(file_name)) &
238               CPABORT("at least one of filename and unit_nr must be present")
239            CALL open_file(file_name=TRIM(file_name), &
240                           unit_number=parser%input_unit)
241            parser%input_file_name = file_name
242         END IF
243      END IF
244
245      IF (PRESENT(initial_variables)) THEN
246         IF (SIZE(initial_variables, 2) > 0) THEN
247            ALLOCATE (parser%initial_variables(2, SIZE(initial_variables, 2)))
248            parser%initial_variables = initial_variables
249         ENDIF
250      ENDIF
251
252      parser%input_line_number = 0
253      parser%icol = 0
254      parser%icol1 = 0
255      parser%icol2 = 0
256      parser%first_separator = .TRUE.
257      NULLIFY (parser%buffer)
258      NULLIFY (parser%status)
259      NULLIFY (parser%inpp)
260      NULLIFY (parser%ilist)
261      CALL create_inpp_type(parser%inpp, parser%initial_variables)
262      CALL create_ilist_type(parser%ilist)
263      CALL create_buffer_type(parser%buffer)
264      CALL create_status_type(parser%status)
265   END SUBROUTINE parser_create
266
267! **************************************************************************************************
268!> \brief   Resets the parser: rewinding the unit and re-initializing all
269!>          parser structures
270!> \param parser ...
271!> \date    12.2008
272!> \author  Teodoro Laino [tlaino]
273! **************************************************************************************************
274   SUBROUTINE parser_reset(parser)
275      TYPE(cp_parser_type), POINTER                      :: parser
276
277      CHARACTER(LEN=*), PARAMETER :: routineN = 'parser_reset', routineP = moduleN//':'//routineN
278
279      CPASSERT(ASSOCIATED(parser))
280      ! Rewind units
281      IF (parser%input_unit > 0) REWIND (parser%input_unit)
282      ! Restore initial settings
283      parser%input_line_number = 0
284      parser%icol = 0
285      parser%icol1 = 0
286      parser%icol2 = 0
287      parser%first_separator = .TRUE.
288      ! Release substructures
289      CALL release_inpp_type(parser%inpp)
290      CALL release_ilist_type(parser%ilist)
291      CALL release_buffer_type(parser%buffer)
292      CALL release_status_type(parser%status)
293      ! Reallocate substructures
294      CALL create_inpp_type(parser%inpp, parser%initial_variables)
295      CALL create_ilist_type(parser%ilist)
296      CALL create_buffer_type(parser%buffer)
297      CALL create_status_type(parser%status)
298   END SUBROUTINE parser_reset
299
300END MODULE cp_parser_types
301