1!--------------------------------------------------------------------------------------------------! 2! CP2K: A general program to perform molecular dynamics simulations ! 3! Copyright (C) 2000 - 2019 CP2K developers group ! 4!--------------------------------------------------------------------------------------------------! 5 6! ************************************************************************************************** 7!> \brief objects that represent the structure of input sections and the data 8!> contained in an input section 9!> \par History 10!> 06.2004 created [fawzi] 11!> \author fawzi 12! ************************************************************************************************** 13MODULE input_section_types 14 USE cp_linked_list_input, ONLY: & 15 cp_sll_val_create, cp_sll_val_dealloc, cp_sll_val_get_el_at, cp_sll_val_get_length, & 16 cp_sll_val_get_rest, cp_sll_val_insert_el_at, cp_sll_val_next, cp_sll_val_p_type, & 17 cp_sll_val_rm_el_at, cp_sll_val_set_el_at, cp_sll_val_type 18 USE cp_log_handling, ONLY: cp_to_string 19 USE input_keyword_types, ONLY: keyword_describe,& 20 keyword_p_type,& 21 keyword_release,& 22 keyword_retain,& 23 keyword_type,& 24 keyword_typo_match,& 25 write_keyword_xml 26 USE input_val_types, ONLY: lchar_t,& 27 no_t,& 28 val_create,& 29 val_duplicate,& 30 val_get,& 31 val_release,& 32 val_type,& 33 val_write 34 USE kinds, ONLY: default_path_length,& 35 default_string_length,& 36 dp 37 USE print_messages, ONLY: print_message 38 USE reference_manager, ONLY: get_citation_key 39 USE string_utilities, ONLY: a2s,& 40 compress,& 41 substitute_special_xml_tokens,& 42 typo_match,& 43 uppercase 44#include "../base/base_uses.f90" 45 46 IMPLICIT NONE 47 PRIVATE 48 49 INTEGER, SAVE, PRIVATE :: last_section_id = 0, last_section_vals_id = 0 50 LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE. 51 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'input_section_types' 52 53 PUBLIC :: section_type 54 PUBLIC :: section_create, section_release, section_describe, & 55 section_get_subsection, section_get_keyword, & 56 section_add_keyword, section_add_subsection 57 PUBLIC :: section_get_subsection_index, section_get_keyword_index 58 59 PUBLIC :: section_vals_type 60 PUBLIC :: section_vals_create, section_vals_retain, section_vals_release, & 61 section_vals_get, section_vals_get_subs_vals, section_vals_val_get, section_vals_list_get, & 62 section_vals_write, section_vals_add_values, section_vals_get_subs_vals2, & 63 section_vals_val_set, section_vals_val_unset, section_vals_get_subs_vals3, & 64 section_vals_set_subs_vals, section_vals_duplicate, section_vals_remove_values 65 PUBLIC :: write_section_xml 66 67 PUBLIC :: section_get_ival, & 68 section_get_ivals, & 69 section_get_rval, & 70 section_get_lval 71 PUBLIC :: section_typo_match, typo_match_section, typo_matching_rank, typo_matching_line 72 73! ************************************************************************************************** 74!> \brief represent a pointer to a section (to make arrays of pointers) 75!> \param section the pointer to the section 76!> \author fawzi 77! ************************************************************************************************** 78 TYPE section_p_type 79 TYPE(section_type), POINTER :: section 80 END TYPE section_p_type 81 82! ************************************************************************************************** 83!> \brief represent a section of the input file 84!> \note 85!> - frozen: if the section has been frozen (and no keyword/subsections 86!> can be added) 87!> - repeats: if the section can be repeated more than once in the same 88!> context 89!> - id_nr: identification number (different in each instance) 90!> - ref_count: reference count (see doc/ReferenceCounting.html) 91!> - n_keywords: the number of keywords in this section 92!> - name: name of the section 93!> - location where in the source code (file and line) the section is created 94!> - description: description of the section 95!> - citations: references to literature associated to this section 96!> - keywords: array with the keywords of this section (might be 97!> oversized) 98!> - subsections: sections contained in this section 99!> \author fawzi 100! ************************************************************************************************** 101 TYPE section_type 102 LOGICAL :: frozen, repeats 103 INTEGER :: id_nr, ref_count, n_keywords, n_subsections 104 CHARACTER(len=default_string_length) :: name 105 CHARACTER(len=default_string_length) :: location 106 CHARACTER, DIMENSION(:), POINTER :: description => Null() 107 INTEGER, POINTER, DIMENSION(:) :: citations 108 TYPE(keyword_p_type), DIMENSION(:), POINTER :: keywords 109 TYPE(section_p_type), POINTER, DIMENSION(:) :: subsections 110 END TYPE section_type 111 112! ************************************************************************************************** 113!> \brief repesents a pointer to a parsed section (to make arrays of pointers) 114!> \param section_vals the pointer to the parsed section 115!> \author fawzi 116! ************************************************************************************************** 117 TYPE section_vals_p_type 118 TYPE(section_vals_type), POINTER :: section_vals 119 END TYPE section_vals_p_type 120 121! ************************************************************************************************** 122!> \brief stores the values of a section 123!> \author fawzi 124! ************************************************************************************************** 125 TYPE section_vals_type 126 INTEGER :: ref_count, id_nr 127 INTEGER, POINTER, DIMENSION(:) :: ibackup 128 TYPE(section_type), POINTER :: section 129 TYPE(cp_sll_val_p_type), DIMENSION(:, :), POINTER :: values 130 TYPE(section_vals_p_type), DIMENSION(:, :), POINTER :: subs_vals 131 END TYPE section_vals_type 132 133 TYPE(section_type), POINTER, SAVE :: typo_match_section => NULL() 134 INTEGER, PARAMETER :: n_typo_matches = 5 135 INTEGER, DIMENSION(n_typo_matches) :: typo_matching_rank = 0 136 CHARACTER(LEN=default_string_length*5), DIMENSION(n_typo_matches):: typo_matching_line = "" 137 138CONTAINS 139 140! ************************************************************************************************** 141!> \brief creates a list of keywords 142!> \param section the list to be created 143!> \param location from where in the source code section_create() is called 144!> \param name ... 145!> \param description ... 146!> \param n_keywords hint about the number of keywords, defaults to 10 147!> \param n_subsections a hint about how many sections will be added to this 148!> structure, defaults to 0 149!> \param repeats if this section can repeat (defaults to false) 150!> \param citations ... 151!> \author fawzi 152! ************************************************************************************************** 153 SUBROUTINE section_create(section, location, name, description, n_keywords, & 154 n_subsections, repeats, citations) 155 TYPE(section_type), POINTER :: section 156 CHARACTER(len=*), INTENT(in) :: location, name, description 157 INTEGER, INTENT(in), OPTIONAL :: n_keywords, n_subsections 158 LOGICAL, INTENT(in), OPTIONAL :: repeats 159 INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: citations 160 161 CHARACTER(len=*), PARAMETER :: routineN = 'section_create', routineP = moduleN//':'//routineN 162 163 INTEGER :: i, my_n_keywords, my_n_subsections, n 164 165 CPASSERT(.NOT. ASSOCIATED(section)) 166 my_n_keywords = 10 167 IF (PRESENT(n_keywords)) my_n_keywords = n_keywords 168 my_n_subsections = 0 169 IF (PRESENT(n_subsections)) my_n_subsections = n_subsections 170 171 ALLOCATE (section) 172 last_section_id = last_section_id + 1 173 section%id_nr = last_section_id 174 section%ref_count = 1 175 176 section%n_keywords = 0 177 section%n_subsections = 0 178 section%location = location 179 section%name = name 180 CALL uppercase(section%name) 181 182 n = LEN_TRIM(description) 183 ALLOCATE (section%description(n)) 184 DO i = 1, n 185 section%description(i) = description(i:i) 186 END DO 187 188 section%frozen = .FALSE. 189 section%repeats = .FALSE. 190 IF (PRESENT(repeats)) section%repeats = repeats 191 192 NULLIFY (section%citations) 193 IF (PRESENT(citations)) THEN 194 ALLOCATE (section%citations(SIZE(citations))) 195 section%citations = citations 196 ENDIF 197 198 ALLOCATE (section%keywords(-1:my_n_keywords)) 199 DO i = -1, my_n_keywords 200 NULLIFY (section%keywords(i)%keyword) 201 END DO 202 203 ALLOCATE (section%subsections(my_n_subsections)) 204 DO i = 1, my_n_subsections 205 NULLIFY (section%subsections(i)%section) 206 END DO 207 END SUBROUTINE section_create 208 209! ************************************************************************************************** 210!> \brief retains the given keyword list (see doc/ReferenceCounting.html) 211!> \param section the list to retain 212!> \author fawzi 213! ************************************************************************************************** 214 SUBROUTINE section_retain(section) 215 TYPE(section_type), POINTER :: section 216 217 CHARACTER(len=*), PARAMETER :: routineN = 'section_retain', routineP = moduleN//':'//routineN 218 219 CPASSERT(ASSOCIATED(section)) 220 CPASSERT(section%ref_count > 0) 221 section%ref_count = section%ref_count + 1 222 END SUBROUTINE section_retain 223 224! ************************************************************************************************** 225!> \brief releases the given keyword list (see doc/ReferenceCounting.html) 226!> \param section the list to release 227!> \author fawzi 228! ************************************************************************************************** 229 RECURSIVE SUBROUTINE section_release(section) 230 TYPE(section_type), POINTER :: section 231 232 CHARACTER(len=*), PARAMETER :: routineN = 'section_release', & 233 routineP = moduleN//':'//routineN 234 235 INTEGER :: i 236 237 IF (ASSOCIATED(section)) THEN 238 CPASSERT(section%ref_count > 0) 239 section%ref_count = section%ref_count - 1 240 IF (section%ref_count == 0) THEN 241 IF (ASSOCIATED(section%citations)) THEN 242 DEALLOCATE (section%citations) 243 ENDIF 244 IF (ASSOCIATED(section%keywords)) THEN 245 DO i = -1, UBOUND(section%keywords, 1) 246 CALL keyword_release(section%keywords(i)%keyword) 247 END DO 248 DEALLOCATE (section%keywords) 249 END IF 250 section%n_keywords = 0 251 IF (ASSOCIATED(section%subsections)) THEN 252 DO i = 1, SIZE(section%subsections) 253 CALL section_release(section%subsections(i)%section) 254 END DO 255 DEALLOCATE (section%subsections) 256 END IF 257 DEALLOCATE (section%description) 258 DEALLOCATE (section) 259 END IF 260 NULLIFY (section) 261 END IF 262 END SUBROUTINE section_release 263 264! ************************************************************************************************** 265!> \brief collects additional information on the section for IO + documentation 266!> \param section ... 267!> \return ... 268!> \author fawzi 269! ************************************************************************************************** 270 FUNCTION get_section_info(section) RESULT(message) 271 TYPE(section_type), POINTER :: section 272 CHARACTER(LEN=default_path_length) :: message 273 274 CHARACTER(len=*), PARAMETER :: routineN = 'get_section_info', & 275 routineP = moduleN//':'//routineN 276 277 INTEGER :: length 278 279 message = " " 280 length = LEN_TRIM(a2s(section%description)) 281 IF (length > 0) THEN 282 IF (section%description(length) /= ".") THEN 283 message = "." 284 ENDIF 285 ENDIF 286 IF (section%repeats) THEN 287 message = TRIM(message)//" This section can be repeated." 288 ELSE 289 message = TRIM(message)//" This section can not be repeated." 290 END IF 291 292 END FUNCTION get_section_info 293 294! ************************************************************************************************** 295!> \brief prints a description of the given section 296!> \param section the section to describe 297!> \param unit_nr the unit to write to 298!> \param level the level of output: 0: just section name, 1:keywords, 299!> then see keyword_describe :-) 300!> \param hide_root if the name of the first section should be hidden 301!> (defaults to false). 302!> \param recurse ... 303!> \author fawzi 304! ************************************************************************************************** 305 RECURSIVE SUBROUTINE section_describe(section, unit_nr, level, hide_root, recurse) 306 TYPE(section_type), POINTER :: section 307 INTEGER, INTENT(in) :: unit_nr, level 308 LOGICAL, INTENT(in), OPTIONAL :: hide_root 309 INTEGER, INTENT(in), OPTIONAL :: recurse 310 311 CHARACTER(len=*), PARAMETER :: routineN = 'section_describe', & 312 routineP = moduleN//':'//routineN 313 314 CHARACTER(LEN=default_path_length) :: message 315 INTEGER :: ikeyword, isub, my_recurse 316 LOGICAL :: my_hide_root 317 318 IF (unit_nr > 0) THEN 319 my_hide_root = .FALSE. 320 IF (PRESENT(hide_root)) my_hide_root = hide_root 321 my_recurse = 0 322 IF (PRESENT(recurse)) my_recurse = recurse 323 IF (ASSOCIATED(section)) THEN 324 CPASSERT(section%ref_count > 0) 325 326 IF (.NOT. my_hide_root) & 327 WRITE (unit_nr, "('*** section &',a,' ***')") TRIM(section%name) 328 IF (level > 1) THEN 329 message = get_section_info(section) 330 CALL print_message(TRIM(a2s(section%description))//TRIM(message), unit_nr, 0, 0, 0) 331 END IF 332 IF (level > 0) THEN 333 IF (ASSOCIATED(section%keywords(-1)%keyword)) THEN 334 CALL keyword_describe(section%keywords(-1)%keyword, unit_nr, & 335 level) 336 END IF 337 IF (ASSOCIATED(section%keywords(0)%keyword)) THEN 338 CALL keyword_describe(section%keywords(0)%keyword, unit_nr, & 339 level) 340 END IF 341 DO ikeyword = 1, section%n_keywords 342 CALL keyword_describe(section%keywords(ikeyword)%keyword, unit_nr, & 343 level) 344 END DO 345 END IF 346 IF (section%n_subsections > 0 .AND. my_recurse >= 0) THEN 347 IF (.NOT. my_hide_root) & 348 WRITE (unit_nr, "('** subsections **')") 349 DO isub = 1, section%n_subsections 350 IF (my_recurse > 0) THEN 351 CALL section_describe(section%subsections(isub)%section, unit_nr, & 352 level, recurse=my_recurse - 1) 353 ELSE 354 WRITE (unit_nr, "(' ',a)") section%subsections(isub)%section%name 355 END IF 356 END DO 357 END IF 358 IF (.NOT. my_hide_root) & 359 WRITE (unit_nr, "('*** &end section ',a,' ***')") TRIM(section%name) 360 ELSE 361 WRITE (unit_nr, "(a)") '<section *null*>' 362 END IF 363 END IF 364 END SUBROUTINE section_describe 365 366! ************************************************************************************************** 367!> \brief returns the index of requested subsection (-1 if not found) 368!> \param section the root section 369!> \param subsection_name the name of the subsection you want to get 370!> \return ... 371!> \author fawzi 372!> \note 373!> private utility function 374! ************************************************************************************************** 375 FUNCTION section_get_subsection_index(section, subsection_name) RESULT(res) 376 TYPE(section_type), POINTER :: section 377 CHARACTER(len=*), INTENT(in) :: subsection_name 378 INTEGER :: res 379 380 CHARACTER(len=*), PARAMETER :: routineN = 'section_get_subsection_index', & 381 routineP = moduleN//':'//routineN 382 383 CHARACTER(len=default_string_length) :: upc_name 384 INTEGER :: isub 385 386 CPASSERT(ASSOCIATED(section)) 387 CPASSERT(section%ref_count > 0) 388 res = -1 389 upc_name = subsection_name 390 CALL uppercase(upc_name) 391 DO isub = 1, section%n_subsections 392 CPASSERT(ASSOCIATED(section%subsections(isub)%section)) 393 IF (section%subsections(isub)%section%name == upc_name) THEN 394 res = isub 395 EXIT 396 END IF 397 END DO 398 END FUNCTION section_get_subsection_index 399 400! ************************************************************************************************** 401!> \brief returns the requested subsection 402!> \param section the root section 403!> \param subsection_name the name of the subsection you want to get 404!> \return ... 405!> \author fawzi 406! ************************************************************************************************** 407 FUNCTION section_get_subsection(section, subsection_name) RESULT(res) 408 TYPE(section_type), POINTER :: section 409 CHARACTER(len=*), INTENT(in) :: subsection_name 410 TYPE(section_type), POINTER :: res 411 412 CHARACTER(len=*), PARAMETER :: routineN = 'section_get_subsection', & 413 routineP = moduleN//':'//routineN 414 415 INTEGER :: isub 416 417 isub = section_get_subsection_index(section, subsection_name) 418 IF (isub > 0) THEN 419 res => section%subsections(isub)%section 420 ELSE 421 NULLIFY (res) 422 END IF 423 END FUNCTION section_get_subsection 424 425! ************************************************************************************************** 426!> \brief returns the index of the requested keyword (or -2 if not found) 427!> \param section the section the keyword is in 428!> \param keyword_name the keyword you are interested in 429!> \return ... 430!> \author fawzi 431!> \note 432!> private utility function 433! ************************************************************************************************** 434 FUNCTION section_get_keyword_index(section, keyword_name) RESULT(res) 435 TYPE(section_type), POINTER :: section 436 CHARACTER(len=*), INTENT(in) :: keyword_name 437 INTEGER :: res 438 439 CHARACTER(len=*), PARAMETER :: routineN = 'section_get_keyword_index', & 440 routineP = moduleN//':'//routineN 441 442 INTEGER :: ik, in 443 CHARACTER(len=default_string_length) :: upc_name 444 445 CPASSERT(ASSOCIATED(section)) 446 CPASSERT(section%ref_count > 0) 447 CPASSERT(ASSOCIATED(section%keywords)) 448 res = -2 449 upc_name = keyword_name 450 CALL uppercase(upc_name) 451 DO ik = -1, 0 452 IF (ASSOCIATED(section%keywords(ik)%keyword)) THEN 453 IF (section%keywords(ik)%keyword%names(1) == upc_name) THEN 454 res = ik 455 END IF 456 END IF 457 END DO 458 IF (res == -2) THEN 459 k_search_loop: DO ik = 1, section%n_keywords 460 CPASSERT(ASSOCIATED(section%keywords(ik)%keyword)) 461 DO in = 1, SIZE(section%keywords(ik)%keyword%names) 462 IF (section%keywords(ik)%keyword%names(in) == upc_name) THEN 463 res = ik 464 EXIT k_search_loop 465 END IF 466 END DO 467 END DO k_search_loop 468 END IF 469 END FUNCTION section_get_keyword_index 470 471! ************************************************************************************************** 472!> \brief returns the requested keyword 473!> \param section the section the keyword is in 474!> \param keyword_name the keyword you are interested in 475!> \return ... 476!> \author fawzi 477! ************************************************************************************************** 478 RECURSIVE FUNCTION section_get_keyword(section, keyword_name) RESULT(res) 479 TYPE(section_type), POINTER :: section 480 CHARACTER(len=*), INTENT(in) :: keyword_name 481 TYPE(keyword_type), POINTER :: res 482 483 CHARACTER(len=*), PARAMETER :: routineN = 'section_get_keyword', & 484 routineP = moduleN//':'//routineN 485 486 INTEGER :: ik, my_index 487 488 IF (INDEX(keyword_name, "%") /= 0) THEN 489 my_index = INDEX(keyword_name, "%") + 1 490 CPASSERT(ASSOCIATED(section%subsections)) 491 DO ik = LBOUND(section%subsections, 1), UBOUND(section%subsections, 1) 492 IF (section%subsections(ik)%section%name == keyword_name(1:my_index - 2)) EXIT 493 END DO 494 CPASSERT(ik <= UBOUND(section%subsections, 1)) 495 res => section_get_keyword(section%subsections(ik)%section, keyword_name(my_index:)) 496 ELSE 497 ik = section_get_keyword_index(section, keyword_name) 498 IF (ik == -2) THEN 499 NULLIFY (res) 500 ELSE 501 res => section%keywords(ik)%keyword 502 END IF 503 END IF 504 END FUNCTION section_get_keyword 505 506! ************************************************************************************************** 507!> \brief adds a keyword to the given section 508!> \param section the section to which the keyword should be added 509!> \param keyword the keyword to add 510!> \author fawzi 511! ************************************************************************************************** 512 SUBROUTINE section_add_keyword(section, keyword) 513 TYPE(section_type), POINTER :: section 514 TYPE(keyword_type), POINTER :: keyword 515 516 CHARACTER(len=*), PARAMETER :: routineN = 'section_add_keyword', & 517 routineP = moduleN//':'//routineN 518 519 INTEGER :: i, j, k 520 TYPE(keyword_p_type), DIMENSION(:), POINTER :: new_keywords 521 522 CPASSERT(ASSOCIATED(section)) 523 CPASSERT(section%ref_count > 0) 524 CPASSERT(.NOT. section%frozen) 525 CPASSERT(ASSOCIATED(keyword)) 526 CPASSERT(keyword%ref_count > 0) 527 CALL keyword_retain(keyword) 528 IF (keyword%names(1) == "_SECTION_PARAMETERS_") THEN 529 CALL keyword_release(section%keywords(-1)%keyword) 530 section%keywords(-1)%keyword => keyword 531 ELSE IF (keyword%names(1) == "_DEFAULT_KEYWORD_") THEN 532 CALL keyword_release(section%keywords(0)%keyword) 533 section%keywords(0)%keyword => keyword 534 ELSE 535 DO k = 1, SIZE(keyword%names) 536 DO i = 1, section%n_keywords 537 DO j = 1, SIZE(section%keywords(i)%keyword%names) 538 IF (keyword%names(k) == section%keywords(i)%keyword%names(j)) THEN 539 CALL cp_abort(__LOCATION__, & 540 "trying to add a keyword with a name ("// & 541 TRIM(keyword%names(k))//") that was already used in section " & 542 //TRIM(section%name)) 543 ENDIF 544 END DO 545 END DO 546 END DO 547 548 IF (UBOUND(section%keywords, 1) == section%n_keywords) THEN 549 ALLOCATE (new_keywords(-1:section%n_keywords + 10)) 550 DO i = -1, section%n_keywords 551 new_keywords(i)%keyword => section%keywords(i)%keyword 552 END DO 553 DO i = section%n_keywords + 1, UBOUND(new_keywords, 1) 554 NULLIFY (new_keywords(i)%keyword) 555 END DO 556 DEALLOCATE (section%keywords) 557 section%keywords => new_keywords 558 END IF 559 section%n_keywords = section%n_keywords + 1 560 section%keywords(section%n_keywords)%keyword => keyword 561 END IF 562 END SUBROUTINE section_add_keyword 563 564! ************************************************************************************************** 565!> \brief adds a subsection to the given section 566!> \param section to section to which you want to add a subsection 567!> \param subsection the subsection to add 568!> \author fawzi 569! ************************************************************************************************** 570 SUBROUTINE section_add_subsection(section, subsection) 571 TYPE(section_type), POINTER :: section, subsection 572 573 CHARACTER(len=*), PARAMETER :: routineN = 'section_add_subsection', & 574 routineP = moduleN//':'//routineN 575 576 INTEGER :: i 577 TYPE(section_p_type), DIMENSION(:), POINTER :: new_subsections 578 579 CPASSERT(ASSOCIATED(section)) 580 CPASSERT(section%ref_count > 0) 581 CPASSERT(ASSOCIATED(subsection)) 582 CPASSERT(subsection%ref_count > 0) 583 IF (SIZE(section%subsections) < section%n_subsections + 1) THEN 584 ALLOCATE (new_subsections(section%n_subsections + 10)) 585 DO i = 1, section%n_subsections 586 new_subsections(i)%section => section%subsections(i)%section 587 END DO 588 DO i = section%n_subsections + 1, SIZE(new_subsections) 589 NULLIFY (new_subsections(i)%section) 590 END DO 591 DEALLOCATE (section%subsections) 592 section%subsections => new_subsections 593 END IF 594 DO i = 1, section%n_subsections 595 IF (subsection%name == section%subsections(i)%section%name) & 596 CALL cp_abort(__LOCATION__, & 597 "trying to add a subsection with a name ("// & 598 TRIM(subsection%name)//") that was already used in section " & 599 //TRIM(section%name)) 600 END DO 601 CALL section_retain(subsection) 602 section%n_subsections = section%n_subsections + 1 603 section%subsections(section%n_subsections)%section => subsection 604 END SUBROUTINE section_add_subsection 605 606! ************************************************************************************************** 607!> \brief creates a object where to store the values of a section 608!> \param section_vals the parsed section that will be created 609!> \param section the structure of the section that you want to parse 610!> \author fawzi 611! ************************************************************************************************** 612 RECURSIVE SUBROUTINE section_vals_create(section_vals, section) 613 TYPE(section_vals_type), POINTER :: section_vals 614 TYPE(section_type), POINTER :: section 615 616 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_create', & 617 routineP = moduleN//':'//routineN 618 619 INTEGER :: i 620 621 CPASSERT(.NOT. ASSOCIATED(section_vals)) 622 ALLOCATE (section_vals) 623 last_section_vals_id = last_section_vals_id + 1 624 section_vals%id_nr = last_section_vals_id 625 section_vals%ref_count = 1 626 CALL section_retain(section) 627 section_vals%section => section 628 section%frozen = .TRUE. 629 ALLOCATE (section_vals%values(-1:section%n_keywords, 0)) 630 ALLOCATE (section_vals%subs_vals(section%n_subsections, 1)) 631 DO i = 1, section%n_subsections 632 NULLIFY (section_vals%subs_vals(i, 1)%section_vals) 633 CALL section_vals_create(section_vals%subs_vals(i, 1)%section_vals, & 634 section=section%subsections(i)%section) 635 END DO 636 NULLIFY (section_vals%ibackup) 637 END SUBROUTINE section_vals_create 638 639! ************************************************************************************************** 640!> \brief retains the given section values (see doc/ReferenceCounting.html) 641!> \param section_vals the object to retain 642!> \author fawzi 643! ************************************************************************************************** 644 SUBROUTINE section_vals_retain(section_vals) 645 TYPE(section_vals_type), POINTER :: section_vals 646 647 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_retain', & 648 routineP = moduleN//':'//routineN 649 650 CPASSERT(ASSOCIATED(section_vals)) 651 CPASSERT(section_vals%ref_count > 0) 652 section_vals%ref_count = section_vals%ref_count + 1 653 END SUBROUTINE section_vals_retain 654 655! ************************************************************************************************** 656!> \brief releases the given object 657!> \param section_vals the section_vals to release 658!> \author fawzi 659! ************************************************************************************************** 660 RECURSIVE SUBROUTINE section_vals_release(section_vals) 661 TYPE(section_vals_type), POINTER :: section_vals 662 663 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_release', & 664 routineP = moduleN//':'//routineN 665 666 INTEGER :: i, j 667 TYPE(cp_sll_val_type), POINTER :: vals 668 TYPE(val_type), POINTER :: el 669 670 IF (ASSOCIATED(section_vals)) THEN 671 CPASSERT(section_vals%ref_count > 0) 672 section_vals%ref_count = section_vals%ref_count - 1 673 IF (section_vals%ref_count == 0) THEN 674 CALL section_release(section_vals%section) 675 DO j = 1, SIZE(section_vals%values, 2) 676 DO i = -1, UBOUND(section_vals%values, 1) 677 vals => section_vals%values(i, j)%list 678 DO WHILE (cp_sll_val_next(vals, el_att=el)) 679 CALL val_release(el) 680 END DO 681 CALL cp_sll_val_dealloc(section_vals%values(i, j)%list) 682 END DO 683 END DO 684 DEALLOCATE (section_vals%values) 685 DO j = 1, SIZE(section_vals%subs_vals, 2) 686 DO i = 1, SIZE(section_vals%subs_vals, 1) 687 CALL section_vals_release(section_vals%subs_vals(i, j)%section_vals) 688 END DO 689 END DO 690 DEALLOCATE (section_vals%subs_vals) 691 IF (ASSOCIATED(section_vals%ibackup)) THEN 692 DEALLOCATE (section_vals%ibackup) 693 END IF 694 DEALLOCATE (section_vals) 695 END IF 696 END IF 697 END SUBROUTINE section_vals_release 698 699! ************************************************************************************************** 700!> \brief returns various attributes about the section_vals 701!> \param section_vals the section vals you want information from 702!> \param ref_count ... 703!> \param id_nr ... 704!> \param n_repetition number of repetitions of the section 705!> \param n_subs_vals_rep number of repetitions of the subsections values 706!> (max(1,n_repetition)) 707!> \param section ... 708!> \param explicit if the section was explicitly present in 709!> \author fawzi 710!> \note For the other arguments see the attributes of section_vals_type 711! ************************************************************************************************** 712 SUBROUTINE section_vals_get(section_vals, ref_count, id_nr, n_repetition, & 713 n_subs_vals_rep, section, explicit) 714 TYPE(section_vals_type), POINTER :: section_vals 715 INTEGER, INTENT(out), OPTIONAL :: ref_count, id_nr, n_repetition, & 716 n_subs_vals_rep 717 TYPE(section_type), OPTIONAL, POINTER :: section 718 LOGICAL, INTENT(out), OPTIONAL :: explicit 719 720 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_get', & 721 routineP = moduleN//':'//routineN 722 723 CPASSERT(ASSOCIATED(section_vals)) 724 CPASSERT(section_vals%ref_count > 0) 725 IF (PRESENT(ref_count)) ref_count = section_vals%ref_count 726 IF (PRESENT(id_nr)) id_nr = section_vals%id_nr 727 IF (PRESENT(section)) section => section_vals%section 728 IF (PRESENT(n_repetition)) n_repetition = SIZE(section_vals%values, 2) 729 IF (PRESENT(n_subs_vals_rep)) n_subs_vals_rep = SIZE(section_vals%subs_vals, 2) 730 IF (PRESENT(explicit)) explicit = (SIZE(section_vals%values, 2) > 0) 731 END SUBROUTINE section_vals_get 732 733! ************************************************************************************************** 734!> \brief returns the values of the requested subsection 735!> \param section_vals the root section 736!> \param subsection_name the name of the requested subsection 737!> \param i_rep_section index of the repetition of section_vals from which 738!> you want to extract the subsection (defaults to 1) 739!> \param can_return_null if the results can be null (defaults to false) 740!> \return ... 741!> \author fawzi 742! ************************************************************************************************** 743 RECURSIVE FUNCTION section_vals_get_subs_vals(section_vals, subsection_name, & 744 i_rep_section, can_return_null) RESULT(res) 745 TYPE(section_vals_type), POINTER :: section_vals 746 CHARACTER(len=*), INTENT(in) :: subsection_name 747 INTEGER, INTENT(in), OPTIONAL :: i_rep_section 748 LOGICAL, INTENT(in), OPTIONAL :: can_return_null 749 TYPE(section_vals_type), POINTER :: res 750 751 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_get_subs_vals', & 752 routineP = moduleN//':'//routineN 753 754 INTEGER :: irep, isection, my_index 755 LOGICAL :: is_path, my_can_return_null 756 757 CPASSERT(ASSOCIATED(section_vals)) 758 CPASSERT(section_vals%ref_count > 0) 759 760 my_can_return_null = .FALSE. 761 IF (PRESENT(can_return_null)) my_can_return_null = can_return_null 762 NULLIFY (res) 763 irep = 1 764 IF (PRESENT(i_rep_section)) irep = i_rep_section 765 766 ! prepare for recursive parsing of subsections. i_rep_section will be used for last section 767 my_index = INDEX(subsection_name, "%") 768 IF (my_index .EQ. 0) THEN 769 is_path = .FALSE. 770 my_index = LEN_TRIM(subsection_name) 771 ELSE 772 is_path = .TRUE. 773 irep = 1 774 my_index = my_index - 1 775 ENDIF 776 777 CPASSERT(irep <= SIZE(section_vals%subs_vals, 2)) 778 779 isection = section_get_subsection_index(section_vals%section, subsection_name(1:my_index)) 780 IF (isection > 0) res => section_vals%subs_vals(isection, irep)%section_vals 781 IF (.NOT. (ASSOCIATED(res) .OR. my_can_return_null)) & 782 CALL cp_abort(__LOCATION__, & 783 "could not find subsection "//TRIM(subsection_name(1:my_index))//" in section "// & 784 TRIM(section_vals%section%name)//" at ") 785 IF (is_path .AND. ASSOCIATED(res)) THEN 786 res => section_vals_get_subs_vals(res, subsection_name(my_index + 2:LEN_TRIM(subsection_name)), & 787 i_rep_section, can_return_null) 788 ENDIF 789 790 END FUNCTION section_vals_get_subs_vals 791 792! ************************************************************************************************** 793!> \brief returns the values of the n-th non default subsection (null if no 794!> such section exists (not so many non default section)) 795!> \param section_vals the root section 796!> \param i_section index of the section 797!> \param i_rep_section index of the repetition of section_vals from which 798!> you want to extract the subsection (defaults to 1) 799!> \return ... 800!> \author fawzi 801! ************************************************************************************************** 802 FUNCTION section_vals_get_subs_vals2(section_vals, i_section, i_rep_section) RESULT(res) 803 TYPE(section_vals_type), POINTER :: section_vals 804 INTEGER, INTENT(in) :: i_section 805 INTEGER, INTENT(in), OPTIONAL :: i_rep_section 806 TYPE(section_vals_type), POINTER :: res 807 808 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_get_subs_vals2', & 809 routineP = moduleN//':'//routineN 810 811 INTEGER :: i, irep, isect_att 812 813 CPASSERT(ASSOCIATED(section_vals)) 814 CPASSERT(section_vals%ref_count > 0) 815 NULLIFY (res) 816 irep = 1 817 IF (PRESENT(i_rep_section)) irep = i_rep_section 818 CPASSERT(irep <= SIZE(section_vals%subs_vals, 2)) 819 isect_att = 0 820 DO i = 1, section_vals%section%n_subsections 821 IF (SIZE(section_vals%subs_vals(i, irep)%section_vals%values, 2) > 0) THEN 822 isect_att = isect_att + 1 823 IF (isect_att == i_section) THEN 824 res => section_vals%subs_vals(i, irep)%section_vals 825 EXIT 826 END IF 827 END IF 828 END DO 829 END FUNCTION section_vals_get_subs_vals2 830 831! ************************************************************************************************** 832!> \brief returns the values of the n-th non default subsection (null if no 833!> such section exists (not so many non default section)) 834!> \param section_vals the root section 835!> \param subsection_name ... 836!> \param i_rep_section index of the repetition of section_vals from which 837!> you want to extract the subsection (defaults to 1) 838!> \return ... 839!> \author fawzi 840! ************************************************************************************************** 841 FUNCTION section_vals_get_subs_vals3(section_vals, subsection_name, & 842 i_rep_section) RESULT(res) 843 TYPE(section_vals_type), POINTER :: section_vals 844 CHARACTER(LEN=*), INTENT(IN) :: subsection_name 845 INTEGER, INTENT(in), OPTIONAL :: i_rep_section 846 TYPE(section_vals_type), POINTER :: res 847 848 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_get_subs_vals3', & 849 routineP = moduleN//':'//routineN 850 851 INTEGER :: i_section, irep 852 853 CPASSERT(ASSOCIATED(section_vals)) 854 CPASSERT(section_vals%ref_count > 0) 855 NULLIFY (res) 856 irep = 1 857 IF (PRESENT(i_rep_section)) irep = i_rep_section 858 CPASSERT(irep <= SIZE(section_vals%subs_vals, 2)) 859 i_section = section_get_subsection_index(section_vals%section, subsection_name) 860 res => section_vals%subs_vals(i_section, irep)%section_vals 861 END FUNCTION section_vals_get_subs_vals3 862 863! ************************************************************************************************** 864!> \brief adds the place to store the values of a repetition of the section 865!> \param section_vals the section you want to extend 866!> \author fawzi 867! ************************************************************************************************** 868 SUBROUTINE section_vals_add_values(section_vals) 869 TYPE(section_vals_type), POINTER :: section_vals 870 871 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_add_values', & 872 routineP = moduleN//':'//routineN 873 874 INTEGER :: i, j 875 TYPE(cp_sll_val_p_type), DIMENSION(:, :), POINTER :: new_values 876 TYPE(section_vals_p_type), DIMENSION(:, :), & 877 POINTER :: new_sps 878 879 CPASSERT(ASSOCIATED(section_vals)) 880 CPASSERT(section_vals%ref_count > 0) 881 ALLOCATE (new_values(-1:UBOUND(section_vals%values, 1), SIZE(section_vals%values, 2) + 1)) 882 DO j = 1, SIZE(section_vals%values, 2) 883 DO i = -1, UBOUND(section_vals%values, 1) 884 new_values(i, j)%list => section_vals%values(i, j)%list 885 END DO 886 END DO 887 DEALLOCATE (section_vals%values) 888 section_vals%values => new_values 889 j = SIZE(new_values, 2) 890 DO i = -1, UBOUND(new_values, 1) 891 NULLIFY (new_values(i, j)%list) 892 END DO 893 894 IF (SIZE(new_values, 2) > 1) THEN 895 ALLOCATE (new_sps(SIZE(section_vals%subs_vals, 1), & 896 SIZE(section_vals%subs_vals, 2) + 1)) 897 DO j = 1, SIZE(section_vals%subs_vals, 2) 898 DO i = 1, SIZE(section_vals%subs_vals, 1) 899 new_sps(i, j)%section_vals => section_vals%subs_vals(i, j)%section_vals 900 END DO 901 END DO 902 DEALLOCATE (section_vals%subs_vals) 903 section_vals%subs_vals => new_sps 904 j = SIZE(new_sps, 2) 905 DO i = 1, SIZE(new_sps, 1) 906 NULLIFY (new_sps(i, j)%section_vals) 907 CALL section_vals_create(new_sps(i, SIZE(new_sps, 2))%section_vals, & 908 section=section_vals%section%subsections(i)%section) 909 END DO 910 END IF 911 END SUBROUTINE section_vals_add_values 912 913! ************************************************************************************************** 914!> \brief removes the values of a repetition of the section 915!> \param section_vals the section you want to extend 916!> \author fawzi 917! ************************************************************************************************** 918 SUBROUTINE section_vals_remove_values(section_vals) 919 TYPE(section_vals_type), POINTER :: section_vals 920 921 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_remove_values', & 922 routineP = moduleN//':'//routineN 923 924 INTEGER :: i, j 925 TYPE(cp_sll_val_p_type), DIMENSION(:, :), POINTER :: new_values 926 TYPE(cp_sll_val_type), POINTER :: vals 927 TYPE(val_type), POINTER :: el 928 929 IF (ASSOCIATED(section_vals)) THEN 930 CPASSERT(section_vals%ref_count > 0) 931 NULLIFY (el, vals) 932 ! Allocate a null 0 dimension array of values 933 ALLOCATE (new_values(-1:section_vals%section%n_keywords, 0)) 934 ! Release old values 935 DO j = 1, SIZE(section_vals%values, 2) 936 DO i = -1, UBOUND(section_vals%values, 1) 937 vals => section_vals%values(i, j)%list 938 DO WHILE (cp_sll_val_next(vals, el_att=el)) 939 CALL val_release(el) 940 END DO 941 CALL cp_sll_val_dealloc(section_vals%values(i, j)%list) 942 END DO 943 END DO 944 DEALLOCATE (section_vals%values) 945 section_vals%values => new_values 946 END IF 947 END SUBROUTINE section_vals_remove_values 948 949! These accessor functions can be used instead of passing a variable 950! in the parameter list of a subroutine call. This should make the 951! code a lot simpler. See xc_rho_set_and_dset_create in xc.F as 952! an example. 953 954! ************************************************************************************************** 955!> \brief ... 956!> \param section_vals ... 957!> \param keyword_name ... 958!> \return ... 959! ************************************************************************************************** 960 FUNCTION section_get_cval(section_vals, keyword_name) RESULT(res) 961 962 TYPE(section_vals_type), POINTER :: section_vals 963 CHARACTER(len=*), INTENT(in) :: keyword_name 964 CHARACTER(LEN=default_string_length) :: res 965 966 CALL section_vals_val_get(section_vals, keyword_name, c_val=res) 967 968 END FUNCTION section_get_cval 969 970! ************************************************************************************************** 971!> \brief ... 972!> \param section_vals ... 973!> \param keyword_name ... 974!> \return ... 975! ************************************************************************************************** 976 FUNCTION section_get_rval(section_vals, keyword_name) RESULT(res) 977 978 TYPE(section_vals_type), POINTER :: section_vals 979 CHARACTER(len=*), INTENT(in) :: keyword_name 980 REAL(kind=dp) :: res 981 982 CALL section_vals_val_get(section_vals, keyword_name, r_val=res) 983 984 END FUNCTION section_get_rval 985 986! ************************************************************************************************** 987!> \brief ... 988!> \param section_vals ... 989!> \param keyword_name ... 990!> \return ... 991! ************************************************************************************************** 992 FUNCTION section_get_rvals(section_vals, keyword_name) RESULT(res) 993 994 TYPE(section_vals_type), POINTER :: section_vals 995 CHARACTER(len=*), INTENT(in) :: keyword_name 996 REAL(kind=dp), DIMENSION(:), POINTER :: res 997 998 CALL section_vals_val_get(section_vals, keyword_name, r_vals=res) 999 1000 END FUNCTION section_get_rvals 1001 1002! ************************************************************************************************** 1003!> \brief ... 1004!> \param section_vals ... 1005!> \param keyword_name ... 1006!> \return ... 1007! ************************************************************************************************** 1008 FUNCTION section_get_ival(section_vals, keyword_name) RESULT(res) 1009 1010 TYPE(section_vals_type), POINTER :: section_vals 1011 CHARACTER(len=*), INTENT(in) :: keyword_name 1012 INTEGER :: res 1013 1014 CALL section_vals_val_get(section_vals, keyword_name, i_val=res) 1015 1016 END FUNCTION section_get_ival 1017 1018! ************************************************************************************************** 1019!> \brief ... 1020!> \param section_vals ... 1021!> \param keyword_name ... 1022!> \return ... 1023! ************************************************************************************************** 1024 FUNCTION section_get_ivals(section_vals, keyword_name) RESULT(res) 1025 1026 TYPE(section_vals_type), POINTER :: section_vals 1027 CHARACTER(len=*), INTENT(in) :: keyword_name 1028 INTEGER, DIMENSION(:), POINTER :: res 1029 1030 CALL section_vals_val_get(section_vals, keyword_name, i_vals=res) 1031 1032 END FUNCTION section_get_ivals 1033 1034! ************************************************************************************************** 1035!> \brief ... 1036!> \param section_vals ... 1037!> \param keyword_name ... 1038!> \return ... 1039! ************************************************************************************************** 1040 FUNCTION section_get_lval(section_vals, keyword_name) RESULT(res) 1041 1042 TYPE(section_vals_type), POINTER :: section_vals 1043 CHARACTER(len=*), INTENT(in) :: keyword_name 1044 LOGICAL :: res 1045 1046 CALL section_vals_val_get(section_vals, keyword_name, l_val=res) 1047 1048 END FUNCTION section_get_lval 1049 1050! ************************************************************************************************** 1051!> \brief returns the requested value 1052!> \param section_vals ... 1053!> \param keyword_name the name of the keyword you want 1054!> \param i_rep_section which repetition of the section you are interested in 1055!> (defaults to 1) 1056!> \param i_rep_val which repetition of the keyword/val you are interested in 1057!> (defaults to 1) 1058!> \param n_rep_val returns number of val available 1059!> \param val ... 1060!> \param l_val ,i_val,r_val,c_val: returns the logical,integer,real or 1061!> character value 1062!> \param i_val ... 1063!> \param r_val ... 1064!> \param c_val ... 1065!> \param l_vals ,i_vals,r_vals,c_vals: returns the logical,integer,real or 1066!> character arrays. The val reamins the owner of the array 1067!> \param i_vals ... 1068!> \param r_vals ... 1069!> \param c_vals ... 1070!> \param explicit ... 1071!> \author fawzi 1072! ************************************************************************************************** 1073 SUBROUTINE section_vals_val_get(section_vals, keyword_name, i_rep_section, & 1074 i_rep_val, n_rep_val, val, l_val, i_val, r_val, c_val, l_vals, i_vals, r_vals, & 1075 c_vals, explicit) 1076 TYPE(section_vals_type), POINTER :: section_vals 1077 CHARACTER(len=*), INTENT(in) :: keyword_name 1078 INTEGER, INTENT(in), OPTIONAL :: i_rep_section, i_rep_val 1079 INTEGER, INTENT(out), OPTIONAL :: n_rep_val 1080 TYPE(val_type), OPTIONAL, POINTER :: val 1081 LOGICAL, INTENT(out), OPTIONAL :: l_val 1082 INTEGER, INTENT(out), OPTIONAL :: i_val 1083 REAL(KIND=DP), INTENT(out), OPTIONAL :: r_val 1084 CHARACTER(LEN=*), INTENT(out), OPTIONAL :: c_val 1085 LOGICAL, DIMENSION(:), OPTIONAL, POINTER :: l_vals 1086 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: i_vals 1087 REAL(KIND=DP), DIMENSION(:), OPTIONAL, POINTER :: r_vals 1088 CHARACTER(LEN=default_string_length), & 1089 DIMENSION(:), OPTIONAL, POINTER :: c_vals 1090 LOGICAL, INTENT(out), OPTIONAL :: explicit 1091 1092 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_val_get', & 1093 routineP = moduleN//':'//routineN 1094 1095 INTEGER :: ik, irk, irs, len_key, my_index, & 1096 tmp_index 1097 LOGICAL :: valRequested 1098 TYPE(cp_sll_val_type), POINTER :: vals 1099 TYPE(keyword_type), POINTER :: keyword 1100 TYPE(section_type), POINTER :: section 1101 TYPE(section_vals_type), POINTER :: s_vals 1102 TYPE(val_type), POINTER :: my_val 1103 1104 CPASSERT(ASSOCIATED(section_vals)) 1105 CPASSERT(section_vals%ref_count > 0) 1106 1107 my_index = INDEX(keyword_name, '%') + 1 1108 len_key = LEN_TRIM(keyword_name) 1109 IF (my_index > 1) THEN 1110 DO 1111 tmp_index = INDEX(keyword_name(my_index:len_key), "%") 1112 IF (tmp_index <= 0) EXIT 1113 my_index = my_index + tmp_index 1114 END DO 1115 s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2)) 1116 ELSE 1117 s_vals => section_vals 1118 END IF 1119 1120 irk = 1 1121 irs = 1 1122 IF (PRESENT(i_rep_section)) irs = i_rep_section 1123 IF (PRESENT(i_rep_val)) irk = i_rep_val 1124 IF (PRESENT(val)) NULLIFY (val) 1125 IF (PRESENT(explicit)) explicit = .FALSE. 1126 section => s_vals%section 1127 valRequested = PRESENT(l_val) .OR. PRESENT(i_val) .OR. PRESENT(r_val) .OR. & 1128 PRESENT(c_val) .OR. PRESENT(l_vals) .OR. PRESENT(i_vals) .OR. & 1129 PRESENT(r_vals) .OR. PRESENT(c_vals) 1130 ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key)) 1131 IF (ik == -2) & 1132 CALL cp_abort(__LOCATION__, & 1133 "section "//TRIM(section%name)//" does not contain keyword "// & 1134 TRIM(keyword_name(my_index:len_key))) 1135 keyword => section%keywords(ik)%keyword 1136 IF (.NOT. (irs > 0 .AND. irs <= SIZE(s_vals%subs_vals, 2))) & 1137 CALL cp_abort(__LOCATION__, & 1138 "section repetition requested ("//cp_to_string(irs)// & 1139 ") out of bounds (1:"//cp_to_string(SIZE(s_vals%subs_vals, 2)) & 1140 //")") 1141 NULLIFY (my_val) 1142 IF (PRESENT(n_rep_val)) n_rep_val = 0 1143 IF (irs <= SIZE(s_vals%values, 2)) THEN ! the section was parsed 1144 vals => s_vals%values(ik, irs)%list 1145 IF (PRESENT(n_rep_val)) n_rep_val = cp_sll_val_get_length(vals) 1146 IF (.NOT. ASSOCIATED(vals)) THEN 1147 ! this keyword was not parsed 1148 IF (ASSOCIATED(keyword%default_value)) THEN 1149 my_val => keyword%default_value 1150 IF (PRESENT(n_rep_val)) n_rep_val = 1 1151 END IF 1152 ELSE 1153 my_val => cp_sll_val_get_el_at(s_vals%values(ik, irs)%list, & 1154 irk) 1155 IF (PRESENT(explicit)) explicit = .TRUE. 1156 END IF 1157 ELSE IF (ASSOCIATED(keyword%default_value)) THEN 1158 IF (PRESENT(n_rep_val)) n_rep_val = 1 1159 my_val => keyword%default_value 1160 END IF 1161 IF (PRESENT(val)) val => my_val 1162 IF (valRequested) THEN 1163 IF (.NOT. ASSOCIATED(my_val)) & 1164 CALL cp_abort(__LOCATION__, & 1165 "Value requested, but no value set getting value from "// & 1166 "keyword "//TRIM(keyword_name(my_index:len_key))//" of section "// & 1167 TRIM(section%name)) 1168 CALL val_get(my_val, l_val=l_val, i_val=i_val, r_val=r_val, & 1169 c_val=c_val, l_vals=l_vals, i_vals=i_vals, r_vals=r_vals, & 1170 c_vals=c_vals) 1171 END IF 1172 1173 END SUBROUTINE section_vals_val_get 1174 1175! ************************************************************************************************** 1176!> \brief returns the requested list 1177!> \param section_vals ... 1178!> \param keyword_name the name of the keyword you want 1179!> \param i_rep_section which repetition of the section you are interested in 1180!> (defaults to 1) 1181!> \param list ... 1182!> \author Joost VandeVondele 1183!> \note 1184!> - most useful if the full list is needed anyway, so that faster iteration can be used 1185! ************************************************************************************************** 1186 SUBROUTINE section_vals_list_get(section_vals, keyword_name, i_rep_section, & 1187 list) 1188 TYPE(section_vals_type), POINTER :: section_vals 1189 CHARACTER(len=*), INTENT(in) :: keyword_name 1190 INTEGER, OPTIONAL :: i_rep_section 1191 TYPE(cp_sll_val_type), POINTER :: list 1192 1193 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_list_get', & 1194 routineP = moduleN//':'//routineN 1195 1196 INTEGER :: ik, irs, len_key, my_index, tmp_index 1197 TYPE(section_type), POINTER :: section 1198 TYPE(section_vals_type), POINTER :: s_vals 1199 1200 CPASSERT(ASSOCIATED(section_vals)) 1201 CPASSERT(section_vals%ref_count > 0) 1202 NULLIFY (list) 1203 my_index = INDEX(keyword_name, '%') + 1 1204 len_key = LEN_TRIM(keyword_name) 1205 IF (my_index > 1) THEN 1206 DO 1207 tmp_index = INDEX(keyword_name(my_index:len_key), "%") 1208 IF (tmp_index <= 0) EXIT 1209 my_index = my_index + tmp_index 1210 END DO 1211 s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2)) 1212 ELSE 1213 s_vals => section_vals 1214 END IF 1215 1216 irs = 1 1217 IF (PRESENT(i_rep_section)) irs = i_rep_section 1218 section => s_vals%section 1219 ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key)) 1220 IF (ik == -2) & 1221 CALL cp_abort(__LOCATION__, & 1222 "section "//TRIM(section%name)//" does not contain keyword "// & 1223 TRIM(keyword_name(my_index:len_key))) 1224 IF (.NOT. (irs > 0 .AND. irs <= SIZE(s_vals%subs_vals, 2))) & 1225 CALL cp_abort(__LOCATION__, & 1226 "section repetition requested ("//cp_to_string(irs)// & 1227 ") out of bounds (1:"//cp_to_string(SIZE(s_vals%subs_vals, 2)) & 1228 //")") 1229 list => s_vals%values(ik, irs)%list 1230 1231 END SUBROUTINE section_vals_list_get 1232 1233! ************************************************************************************************** 1234!> \brief sets the requested value 1235!> \param section_vals ... 1236!> \param keyword_name the name of the keyword you want (can be a path 1237!> separated by '%') 1238!> \param i_rep_section isection which repetition of the section you are 1239!> nterested in (defaults to 1) 1240!> \param i_rep_val which repetition of the keyword/val you are interested in 1241!> (defaults to 1) 1242!> \param val ... 1243!> \param l_val ,i_val,r_val,c_val: sets the logical,integer,real or 1244!> character value 1245!> \param i_val ... 1246!> \param r_val ... 1247!> \param c_val ... 1248!> \param l_vals_ptr ,i_vals_ptr,r_vals,c_vals: sets the logical,integer,real or 1249!> character arrays. The val becomes the owner of the array 1250!> \param i_vals_ptr ... 1251!> \param r_vals_ptr ... 1252!> \param c_vals_ptr ... 1253!> \author fawzi 1254! ************************************************************************************************** 1255 SUBROUTINE section_vals_val_set(section_vals, keyword_name, i_rep_section, i_rep_val, & 1256 val, l_val, i_val, r_val, c_val, l_vals_ptr, i_vals_ptr, r_vals_ptr, c_vals_ptr) 1257 TYPE(section_vals_type), POINTER :: section_vals 1258 CHARACTER(len=*), INTENT(in) :: keyword_name 1259 INTEGER, INTENT(in), OPTIONAL :: i_rep_section, i_rep_val 1260 TYPE(val_type), OPTIONAL, POINTER :: val 1261 LOGICAL, INTENT(in), OPTIONAL :: l_val 1262 INTEGER, INTENT(in), OPTIONAL :: i_val 1263 REAL(KIND=DP), INTENT(in), OPTIONAL :: r_val 1264 CHARACTER(LEN=*), INTENT(in), OPTIONAL :: c_val 1265 LOGICAL, DIMENSION(:), OPTIONAL, POINTER :: l_vals_ptr 1266 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: i_vals_ptr 1267 REAL(KIND=DP), DIMENSION(:), OPTIONAL, POINTER :: r_vals_ptr 1268 CHARACTER(LEN=default_string_length), & 1269 DIMENSION(:), OPTIONAL, POINTER :: c_vals_ptr 1270 1271 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_val_set', & 1272 routineP = moduleN//':'//routineN 1273 1274 INTEGER :: ik, irk, irs, len_key, my_index, & 1275 tmp_index 1276 LOGICAL :: valSet 1277 TYPE(cp_sll_val_type), POINTER :: vals 1278 TYPE(keyword_type), POINTER :: keyword 1279 TYPE(section_type), POINTER :: section 1280 TYPE(section_vals_type), POINTER :: s_vals 1281 TYPE(val_type), POINTER :: my_val, old_val 1282 1283 CPASSERT(ASSOCIATED(section_vals)) 1284 CPASSERT(section_vals%ref_count > 0) 1285 1286 my_index = INDEX(keyword_name, '%') + 1 1287 len_key = LEN_TRIM(keyword_name) 1288 IF (my_index > 1) THEN 1289 DO 1290 tmp_index = INDEX(keyword_name(my_index:len_key), "%") 1291 IF (tmp_index <= 0) EXIT 1292 my_index = my_index + tmp_index 1293 END DO 1294 s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2)) 1295 ELSE 1296 s_vals => section_vals 1297 END IF 1298 1299 irk = 1 1300 irs = 1 1301 IF (PRESENT(i_rep_section)) irs = i_rep_section 1302 IF (PRESENT(i_rep_val)) irk = i_rep_val 1303 section => s_vals%section 1304 ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key)) 1305 IF (ik == -2) & 1306 CALL cp_abort(__LOCATION__, & 1307 "section "//TRIM(section%name)//" does not contain keyword "// & 1308 TRIM(keyword_name(my_index:len_key))) 1309 ! Add values.. 1310 DO 1311 IF (irs <= SIZE(s_vals%values, 2)) EXIT 1312 CALL section_vals_add_values(s_vals) 1313 END DO 1314 IF (.NOT. (irs > 0 .AND. irs <= SIZE(s_vals%subs_vals, 2))) & 1315 CALL cp_abort(__LOCATION__, & 1316 "section repetition requested ("//cp_to_string(irs)// & 1317 ") out of bounds (1:"//cp_to_string(SIZE(s_vals%subs_vals, 2)) & 1318 //")") 1319 keyword => s_vals%section%keywords(ik)%keyword 1320 NULLIFY (my_val) 1321 IF (PRESENT(val)) my_val => val 1322 valSet = PRESENT(l_val) .OR. PRESENT(i_val) .OR. PRESENT(r_val) .OR. & 1323 PRESENT(c_val) .OR. PRESENT(l_vals_ptr) .OR. PRESENT(i_vals_ptr) .OR. & 1324 PRESENT(r_vals_ptr) .OR. PRESENT(c_vals_ptr) 1325 IF (ASSOCIATED(my_val)) THEN 1326 ! check better? 1327 IF (valSet) & 1328 CALL cp_abort(__LOCATION__, & 1329 " both val and values present, in setting "// & 1330 "keyword "//TRIM(keyword_name(my_index:len_key))//" of section "// & 1331 TRIM(section%name)) 1332 ELSE 1333 ! ignore ? 1334 IF (.NOT. valSet) & 1335 CALL cp_abort(__LOCATION__, & 1336 " empty value in setting "// & 1337 "keyword "//TRIM(keyword_name(my_index:len_key))//" of section "// & 1338 TRIM(section%name)) 1339 CPASSERT(valSet) 1340 IF (keyword%type_of_var == lchar_t) THEN 1341 CALL val_create(my_val, lc_val=c_val, lc_vals_ptr=c_vals_ptr) 1342 ELSE 1343 CALL val_create(my_val, l_val=l_val, i_val=i_val, r_val=r_val, & 1344 c_val=c_val, l_vals_ptr=l_vals_ptr, i_vals_ptr=i_vals_ptr, & 1345 r_vals_ptr=r_vals_ptr, & 1346 c_vals_ptr=c_vals_ptr, enum=keyword%enum) 1347 END IF 1348 CPASSERT(ASSOCIATED(my_val)) 1349 CPASSERT(my_val%type_of_var == keyword%type_of_var) 1350 END IF 1351 vals => s_vals%values(ik, irs)%list 1352 IF (irk == -1) THEN 1353 CALL cp_sll_val_insert_el_at(vals, my_val, index=-1) 1354 ELSE IF (irk <= cp_sll_val_get_length(vals)) THEN 1355 IF (irk <= 0) & 1356 CALL cp_abort(__LOCATION__, & 1357 "invalid irk "//TRIM(ADJUSTL(cp_to_string(irk)))// & 1358 " in keyword "//TRIM(keyword_name(my_index:len_key))//" of section "// & 1359 TRIM(section%name)) 1360 old_val => cp_sll_val_get_el_at(vals, index=irk) 1361 CALL val_release(old_val) 1362 CALL cp_sll_val_set_el_at(vals, value=my_val, index=irk) 1363 ELSE IF (irk > cp_sll_val_get_length(vals) + 1) THEN 1364 ! change? 1365 CALL cp_abort(__LOCATION__, & 1366 "cannot add extra keyword repetitions to keyword" & 1367 //TRIM(keyword_name(my_index:len_key))//" of section "// & 1368 TRIM(section%name)) 1369 ELSE 1370 CALL cp_sll_val_insert_el_at(vals, my_val, index=irk) 1371 END IF 1372 s_vals%values(ik, irs)%list => vals 1373 NULLIFY (my_val) 1374 END SUBROUTINE section_vals_val_set 1375 1376! ************************************************************************************************** 1377!> \brief unsets (removes) the requested value (if it is a keyword repetitions 1378!> removes the repetition, so be careful: the repetition indices bigger 1379!> than the actual change. 1380!> \param section_vals ... 1381!> \param keyword_name the name of the keyword you want (can be a path 1382!> separated by '%') 1383!> \param i_rep_section which repetition of the section you are interested in 1384!> (defaults to 1) 1385!> \param i_rep_val which repetition of the keyword/val you are interested in 1386!> (defaults to 1) 1387!> \author fawzi 1388! ************************************************************************************************** 1389 SUBROUTINE section_vals_val_unset(section_vals, keyword_name, i_rep_section, & 1390 i_rep_val) 1391 TYPE(section_vals_type), POINTER :: section_vals 1392 CHARACTER(len=*), INTENT(in) :: keyword_name 1393 INTEGER, INTENT(in), OPTIONAL :: i_rep_section, i_rep_val 1394 1395 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_val_unset', & 1396 routineP = moduleN//':'//routineN 1397 1398 INTEGER :: ik, irk, irs, len_key, my_index, & 1399 tmp_index 1400 TYPE(cp_sll_val_type), POINTER :: pos 1401 TYPE(section_type), POINTER :: section 1402 TYPE(section_vals_type), POINTER :: s_vals 1403 TYPE(val_type), POINTER :: old_val 1404 1405 NULLIFY (pos) 1406 CPASSERT(ASSOCIATED(section_vals)) 1407 CPASSERT(section_vals%ref_count > 0) 1408 1409 my_index = INDEX(keyword_name, '%') + 1 1410 len_key = LEN_TRIM(keyword_name) 1411 IF (my_index > 1) THEN 1412 DO 1413 tmp_index = INDEX(keyword_name(my_index:len_key), "%") 1414 IF (tmp_index <= 0) EXIT 1415 my_index = my_index + tmp_index 1416 END DO 1417 s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2)) 1418 ELSE 1419 s_vals => section_vals 1420 END IF 1421 1422 irk = 1 1423 irs = 1 1424 IF (PRESENT(i_rep_section)) irs = i_rep_section 1425 IF (PRESENT(i_rep_val)) irk = i_rep_val 1426 section => s_vals%section 1427 ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key)) 1428 IF (ik == -2) & 1429 CALL cp_abort(__LOCATION__, & 1430 "section "//TRIM(section%name)//" does not contain keyword "// & 1431 TRIM(keyword_name(my_index:len_key))) 1432 ! ignore unset of non set values 1433 IF (irs <= SIZE(s_vals%values, 2)) THEN 1434 IF (.NOT. (irs > 0 .AND. irs <= SIZE(s_vals%subs_vals, 2))) & 1435 CALL cp_abort(__LOCATION__, & 1436 "section repetition requested ("//cp_to_string(irs)// & 1437 ") out of bounds (1:"//cp_to_string(SIZE(s_vals%subs_vals, 2)) & 1438 //")") 1439 IF (irk == -1) THEN 1440 pos => cp_sll_val_get_rest(s_vals%values(ik, irs)%list, iter=-1) 1441 ELSE 1442 pos => cp_sll_val_get_rest(s_vals%values(ik, irs)%list, iter=irk - 1) 1443 END IF 1444 IF (ASSOCIATED(pos)) THEN 1445 old_val => cp_sll_val_get_el_at(s_vals%values(ik, irs)%list, index=irk) 1446 CALL val_release(old_val) 1447 CALL cp_sll_val_rm_el_at(s_vals%values(ik, irs)%list, index=irk) 1448 END IF 1449 END IF 1450 1451 END SUBROUTINE section_vals_val_unset 1452 1453! ************************************************************************************************** 1454!> \brief writes the values in the given section in a way that is suitable to 1455!> the automatic parsing 1456!> \param section_vals the section to write out 1457!> \param unit_nr the unit where to write to 1458!> \param hide_root ... 1459!> \param hide_defaults ... 1460!> \author fawzi 1461!> \note 1462!> skips required sections which weren't read 1463! ************************************************************************************************** 1464 RECURSIVE SUBROUTINE section_vals_write(section_vals, unit_nr, hide_root, hide_defaults) 1465 TYPE(section_vals_type), POINTER :: section_vals 1466 INTEGER, INTENT(in) :: unit_nr 1467 LOGICAL, INTENT(in), OPTIONAL :: hide_root, hide_defaults 1468 1469 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_write', & 1470 routineP = moduleN//':'//routineN 1471 1472 CHARACTER(len=default_string_length) :: myfmt 1473 INTEGER :: i_rep_s, ik, isec, ival, nr, nval 1474 INTEGER, SAVE :: indent = 1 1475 LOGICAL :: defaultSection, explicit, & 1476 my_hide_defaults, my_hide_root 1477 TYPE(cp_sll_val_type), POINTER :: new_pos, vals 1478 TYPE(keyword_type), POINTER :: keyword 1479 TYPE(section_type), POINTER :: section 1480 TYPE(section_vals_type), POINTER :: sval 1481 TYPE(val_type), POINTER :: val 1482 1483 my_hide_root = .FALSE. 1484 my_hide_defaults = .TRUE. 1485 IF (PRESENT(hide_root)) my_hide_root = hide_root 1486 IF (PRESENT(hide_defaults)) my_hide_defaults = hide_defaults 1487 1488 CPASSERT(ASSOCIATED(section_vals)) 1489 CPASSERT(section_vals%ref_count > 0) 1490 IF (unit_nr > 0) THEN 1491 CALL section_vals_get(section_vals, explicit=explicit, n_repetition=nr, section=section) 1492 IF (explicit .OR. (.NOT. my_hide_defaults)) THEN 1493 DO i_rep_s = 1, nr 1494 IF (.NOT. my_hide_root) THEN 1495 WRITE (myfmt, *) indent, "X" 1496 CALL compress(myfmt, full=.TRUE.) 1497 IF (ASSOCIATED(section%keywords(-1)%keyword)) THEN 1498 WRITE (unit=unit_nr, fmt="("//TRIM(myfmt)//",'&',a,' ')", advance="NO") TRIM(section%name) 1499 ELSE 1500 WRITE (unit=unit_nr, fmt="("//TRIM(myfmt)//",'&',a)") TRIM(section%name) 1501 END IF 1502 END IF 1503 defaultSection = (SIZE(section_vals%values, 2) == 0) 1504 IF (.NOT. defaultSection) THEN 1505 IF (.NOT. my_hide_root) indent = indent + 2 1506 WRITE (myfmt, *) indent, "X" 1507 CALL compress(myfmt, full=.TRUE.) 1508 DO ik = -1, section%n_keywords 1509 keyword => section%keywords(ik)%keyword 1510 IF (ASSOCIATED(keyword)) THEN 1511 IF (keyword%type_of_var /= no_t .AND. keyword%names(1) (1:2) /= "__") THEN 1512 CALL section_vals_val_get(section_vals, keyword%names(1), & 1513 i_rep_s, n_rep_val=nval) 1514 IF (i_rep_s <= SIZE(section_vals%values, 2)) THEN 1515 ! Section was parsed 1516 vals => section_vals%values(ik, i_rep_s)%list 1517 DO ival = 1, nval 1518 IF (ival == 1) THEN 1519 new_pos => vals 1520 ELSE 1521 new_pos => new_pos%rest 1522 END IF 1523 IF (.NOT. ASSOCIATED(new_pos)) THEN 1524 ! this keyword was not parsed 1525 IF (ASSOCIATED(keyword%default_value)) THEN 1526 val => keyword%default_value 1527 IF (my_hide_defaults) CYCLE 1528 END IF 1529 ELSE 1530 val => new_pos%first_el 1531 END IF 1532 IF (keyword%names(1) /= '_DEFAULT_KEYWORD_' .AND. & 1533 keyword%names(1) /= '_SECTION_PARAMETERS_') THEN 1534 WRITE (unit=unit_nr, fmt="("//TRIM(myfmt)//",a,' ')", advance="NO") & 1535 TRIM(keyword%names(1)) 1536 ELSEIF (keyword%names(1) == '_DEFAULT_KEYWORD_' .AND. & 1537 keyword%type_of_var /= lchar_t) THEN 1538 WRITE (unit=unit_nr, fmt="("//TRIM(myfmt)//")", advance="NO") 1539 END IF 1540 CALL val_write(val, unit_nr=unit_nr, unit=keyword%unit, & 1541 fmt=myfmt) 1542 END DO 1543 ELSEIF (ASSOCIATED(keyword%default_value)) THEN 1544 ! Section was not parsed but default for the keywords may exist 1545 IF (my_hide_defaults) CYCLE 1546 val => keyword%default_value 1547 IF (keyword%names(1) /= '_DEFAULT_KEYWORD_' .AND. & 1548 keyword%names(1) /= '_SECTION_PARAMETERS_') THEN 1549 WRITE (unit=unit_nr, fmt="("//TRIM(myfmt)//",a,' ')", advance="NO") & 1550 TRIM(keyword%names(1)) 1551 ELSEIF (keyword%names(1) == '_DEFAULT_KEYWORD_' .AND. & 1552 keyword%type_of_var /= lchar_t) THEN 1553 WRITE (unit=unit_nr, fmt="("//TRIM(myfmt)//")", advance="NO") 1554 END IF 1555 CALL val_write(val, unit_nr=unit_nr, unit=keyword%unit, & 1556 fmt=myfmt) 1557 END IF 1558 END IF 1559 END IF 1560 END DO 1561 IF (ASSOCIATED(section_vals%subs_vals)) THEN 1562 DO isec = 1, SIZE(section_vals%subs_vals, 1) 1563 sval => section_vals%subs_vals(isec, i_rep_s)%section_vals 1564 IF (ASSOCIATED(sval)) THEN 1565 CALL section_vals_write(sval, unit_nr=unit_nr, hide_defaults=hide_defaults) 1566 END IF 1567 END DO 1568 END IF 1569 END IF 1570 IF (.NOT. my_hide_root) THEN 1571 indent = indent - 2 1572 WRITE (UNIT=unit_nr, FMT="(A)") & 1573 REPEAT(" ", indent)//"&END "//TRIM(section%name) 1574 END IF 1575 END DO 1576 END IF 1577 END IF 1578 1579 END SUBROUTINE section_vals_write 1580 1581! ************************************************************************************************** 1582!> \brief writes the values in the given section in xml 1583!> \param section ... 1584!> \param level ... 1585!> \param unit_number ... 1586! ************************************************************************************************** 1587 RECURSIVE SUBROUTINE write_section_xml(section, level, unit_number) 1588 1589 TYPE(section_type), POINTER :: section 1590 INTEGER, INTENT(IN) :: level, unit_number 1591 1592 CHARACTER(LEN=*), PARAMETER :: routineN = 'write_section_xml', & 1593 routineP = moduleN//':'//routineN 1594 1595 CHARACTER(LEN=3) :: repeats 1596 CHARACTER(LEN=8) :: short_string 1597 INTEGER :: i, l0, l1, l2 1598 1599 IF (ASSOCIATED(section)) THEN 1600 1601 CPASSERT(section%ref_count > 0) 1602 1603 ! Indentation for current level, next level, etc. 1604 1605 l0 = level 1606 l1 = level + 1 1607 l2 = level + 2 1608 1609 IF (section%repeats) THEN 1610 repeats = "yes" 1611 ELSE 1612 repeats = "no " 1613 END IF 1614 1615 WRITE (UNIT=unit_number, FMT="(A)") & 1616 REPEAT(" ", l0)//"<SECTION repeats="""//TRIM(repeats)//""">", & 1617 REPEAT(" ", l1)//"<NAME>"//TRIM(section%name)//"</NAME>", & 1618 REPEAT(" ", l1)//"<DESCRIPTION>"// & 1619 TRIM(substitute_special_xml_tokens(a2s(section%description))) & 1620 //"</DESCRIPTION>" 1621 1622 IF (ASSOCIATED(section%citations)) THEN 1623 DO i = 1, SIZE(section%citations, 1) 1624 short_string = "" 1625 WRITE (UNIT=short_string, FMT="(I8)") section%citations(i) 1626 WRITE (UNIT=unit_number, FMT="(A)") & 1627 REPEAT(" ", l1)//"<REFERENCE>", & 1628 REPEAT(" ", l2)//"<NAME>"//TRIM(get_citation_key(section%citations(i)))//"</NAME>", & 1629 REPEAT(" ", l2)//"<NUMBER>"//TRIM(ADJUSTL(short_string))//"</NUMBER>", & 1630 REPEAT(" ", l1)//"</REFERENCE>" 1631 END DO 1632 END IF 1633 1634 WRITE (UNIT=unit_number, FMT="(A)") & 1635 REPEAT(" ", l1)//"<LOCATION>"//TRIM(section%location)//"</LOCATION>" 1636 1637 DO i = -1, section%n_keywords 1638 IF (ASSOCIATED(section%keywords(i)%keyword)) THEN 1639 CALL write_keyword_xml(section%keywords(i)%keyword, l1, unit_number) 1640 END IF 1641 END DO 1642 1643 DO i = 1, section%n_subsections 1644 CALL write_section_xml(section%subsections(i)%section, l1, unit_number) 1645 END DO 1646 1647 WRITE (UNIT=unit_number, FMT="(A)") REPEAT(" ", l0)//"</SECTION>" 1648 1649 END IF 1650 1651 END SUBROUTINE write_section_xml 1652 1653! ************************************************************************************************** 1654!> \brief ... 1655!> \param section ... 1656!> \param section_name ... 1657!> \param unknown_string ... 1658!> \param location_string ... 1659!> \param matching_rank ... 1660!> \param matching_string ... 1661!> \param bonus ... 1662! ************************************************************************************************** 1663 RECURSIVE SUBROUTINE section_typo_match(section, section_name, unknown_string, location_string, & 1664 matching_rank, matching_string, bonus) 1665 1666 TYPE(section_type), POINTER :: section 1667 CHARACTER(LEN=*) :: section_name, unknown_string, & 1668 location_string 1669 INTEGER, DIMENSION(:), INTENT(INOUT) :: matching_rank 1670 CHARACTER(LEN=*), DIMENSION(:), INTENT(INOUT) :: matching_string 1671 INTEGER, INTENT(IN) :: bonus 1672 1673 CHARACTER(LEN=*), PARAMETER :: routineN = 'section_typo_match', & 1674 routineP = moduleN//':'//routineN 1675 1676 CHARACTER(LEN=LEN(matching_string(1))) :: line 1677 INTEGER :: i, imatch, imax, irank, newbonus 1678 1679 IF (ASSOCIATED(section)) THEN 1680 CPASSERT(section%ref_count > 0) 1681 imatch = typo_match(TRIM(section%name), TRIM(unknown_string)) 1682 IF (imatch > 0) THEN 1683 imatch = imatch + bonus 1684 WRITE (line, '(T2,A)') " subsection "//TRIM(section%name)//" in section "//TRIM(location_string) 1685 imax = SIZE(matching_rank, 1) 1686 irank = imax + 1 1687 DO I = imax, 1, -1 1688 IF (imatch > matching_rank(I)) irank = i 1689 ENDDO 1690 IF (irank <= imax) THEN 1691 matching_rank(irank + 1:imax) = matching_rank(irank:imax - 1) 1692 matching_string(irank + 1:imax) = matching_string(irank:imax - 1) 1693 matching_rank(irank) = imatch 1694 matching_string(irank) = line 1695 ENDIF 1696 END IF 1697 1698 IF (section_name == section%name) THEN 1699 newbonus = 10 1700 ELSE 1701 newbonus = 0 1702 ENDIF 1703 1704 DO i = -1, section%n_keywords 1705 IF (ASSOCIATED(section%keywords(i)%keyword)) THEN 1706 CALL keyword_typo_match(section%keywords(i)%keyword, unknown_string, location_string// & 1707 "%"//TRIM(section%name), matching_rank, matching_string, newbonus) 1708 END IF 1709 END DO 1710 1711 DO i = 1, section%n_subsections 1712 CALL section_typo_match(section%subsections(i)%section, section_name, unknown_string, & 1713 location_string//"%"//TRIM(section%name), matching_rank, matching_string, newbonus) 1714 END DO 1715 1716 END IF 1717 1718 END SUBROUTINE section_typo_match 1719 1720! ************************************************************************************************** 1721!> \brief replaces of the requested subsection with the one given 1722!> \param section_vals the root section 1723!> \param subsection_name the name of the subsection to replace 1724!> \param new_section_vals the new section_vals to use 1725!> \param i_rep_section index of the repetition of section_vals of which 1726!> you want to replace the subsection (defaults to 1) 1727!> \author fawzi 1728! ************************************************************************************************** 1729 SUBROUTINE section_vals_set_subs_vals(section_vals, subsection_name, & 1730 new_section_vals, i_rep_section) 1731 TYPE(section_vals_type), POINTER :: section_vals 1732 CHARACTER(len=*), INTENT(in) :: subsection_name 1733 TYPE(section_vals_type), POINTER :: new_section_vals 1734 INTEGER, INTENT(in), OPTIONAL :: i_rep_section 1735 1736 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_set_subs_vals', & 1737 routineP = moduleN//':'//routineN 1738 1739 INTEGER :: irep, isection, len_key, my_index, & 1740 tmp_index 1741 TYPE(section_vals_type), POINTER :: s_vals 1742 1743 CPASSERT(ASSOCIATED(section_vals)) 1744 CPASSERT(section_vals%ref_count > 0) 1745 CPASSERT(ASSOCIATED(new_section_vals)) 1746 CPASSERT(new_section_vals%ref_count > 0) 1747 1748 irep = 1 1749 IF (PRESENT(i_rep_section)) irep = i_rep_section 1750 1751 my_index = INDEX(subsection_name, '%') + 1 1752 len_key = LEN_TRIM(subsection_name) 1753 IF (my_index > 1) THEN 1754 DO 1755 tmp_index = INDEX(subsection_name(my_index:len_key), "%") 1756 IF (tmp_index <= 0) EXIT 1757 my_index = my_index + tmp_index 1758 END DO 1759 s_vals => section_vals_get_subs_vals(section_vals, subsection_name(1:my_index - 2)) 1760 ELSE 1761 s_vals => section_vals 1762 END IF 1763 1764 CPASSERT(irep <= SIZE(s_vals%subs_vals, 2)) 1765 1766 isection = section_get_subsection_index(s_vals%section, subsection_name(my_index:LEN_TRIM(subsection_name))) 1767 IF (isection <= 0) & 1768 CALL cp_abort(__LOCATION__, & 1769 "could not find subsection "//subsection_name(my_index:LEN_TRIM(subsection_name))//" in section "// & 1770 TRIM(section_vals%section%name)//" at ") 1771 CALL section_vals_retain(new_section_vals) 1772 CALL section_vals_release(s_vals%subs_vals(isection, irep)%section_vals) 1773 s_vals%subs_vals(isection, irep)%section_vals => new_section_vals 1774 1775 END SUBROUTINE section_vals_set_subs_vals 1776 1777! ************************************************************************************************** 1778!> \brief creates a deep copy from section_vals_in to section_vals_out 1779!> \param section_vals_in the section_vals to copy 1780!> \param section_vals_out the section_vals to create 1781!> \param i_rep_start ... 1782!> \param i_rep_end ... 1783!> \author fawzi 1784! ************************************************************************************************** 1785 SUBROUTINE section_vals_duplicate(section_vals_in, section_vals_out, & 1786 i_rep_start, i_rep_end) 1787 TYPE(section_vals_type), POINTER :: section_vals_in, section_vals_out 1788 INTEGER, INTENT(IN), OPTIONAL :: i_rep_start, i_rep_end 1789 1790 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_duplicate', & 1791 routineP = moduleN//':'//routineN 1792 1793 CPASSERT(ASSOCIATED(section_vals_in)) 1794 CPASSERT(.NOT. ASSOCIATED(section_vals_out)) 1795 CALL section_vals_create(section_vals_out, section_vals_in%section) 1796 CALL section_vals_copy(section_vals_in, section_vals_out, i_rep_start, i_rep_end) 1797 END SUBROUTINE section_vals_duplicate 1798 1799! ************************************************************************************************** 1800!> \brief deep copy from section_vals_in to section_vals_out 1801!> \param section_vals_in the section_vals to copy 1802!> \param section_vals_out the section_vals where to copy 1803!> \param i_rep_low ... 1804!> \param i_rep_high ... 1805!> \author fawzi 1806!> \note 1807!> private, only works with a newly initialized section_vals_out 1808! ************************************************************************************************** 1809 RECURSIVE SUBROUTINE section_vals_copy(section_vals_in, section_vals_out, & 1810 i_rep_low, i_rep_high) 1811 TYPE(section_vals_type), POINTER :: section_vals_in, section_vals_out 1812 INTEGER, INTENT(IN), OPTIONAL :: i_rep_low, i_rep_high 1813 1814 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_copy', & 1815 routineP = moduleN//':'//routineN 1816 1817 INTEGER :: iend, irep, isec, istart, ival 1818 TYPE(cp_sll_val_type), POINTER :: v1, v2 1819 TYPE(val_type), POINTER :: el 1820 1821 NULLIFY (v2, el) 1822 1823 CPASSERT(ASSOCIATED(section_vals_in)) 1824 CPASSERT(ASSOCIATED(section_vals_out)) 1825 ! IF(section_vals_in%section%id_nr/=section_vals_out%section%id_nr)& 1826 ! CPABORT("") 1827 1828 istart = 1 1829 iend = SIZE(section_vals_in%values, 2) 1830 IF (PRESENT(i_rep_low)) istart = i_rep_low 1831 IF (PRESENT(i_rep_high)) iend = i_rep_high 1832 DO irep = istart, iend 1833 CALL section_vals_add_values(section_vals_out) 1834 DO ival = LBOUND(section_vals_in%values, 1), UBOUND(section_vals_in%values, 1) 1835 v1 => section_vals_in%values(ival, irep)%list 1836 IF (ASSOCIATED(v1)) THEN 1837 CALL val_duplicate(v1%first_el, el) 1838 CALL cp_sll_val_create(v2, el) 1839 NULLIFY (el) 1840 section_vals_out%values(ival, irep - istart + 1)%list => v2 1841 DO 1842 IF (.NOT. ASSOCIATED(v1%rest)) EXIT 1843 v1 => v1%rest 1844 CALL val_duplicate(v1%first_el, el) 1845 CALL cp_sll_val_create(v2%rest, first_el=el) 1846 NULLIFY (el) 1847 v2 => v2%rest 1848 END DO 1849 END IF 1850 END DO 1851 END DO 1852 IF (.NOT. PRESENT(i_rep_low) .AND. (.NOT. PRESENT(i_rep_high))) THEN 1853 IF (.NOT. (SIZE(section_vals_in%values, 2) == SIZE(section_vals_out%values, 2))) & 1854 CPABORT("") 1855 IF (.NOT. (SIZE(section_vals_in%subs_vals, 2) == SIZE(section_vals_out%subs_vals, 2))) & 1856 CPABORT("") 1857 END IF 1858 iend = SIZE(section_vals_in%subs_vals, 2) 1859 IF (PRESENT(i_rep_high)) iend = i_rep_high 1860 DO irep = istart, iend 1861 DO isec = 1, SIZE(section_vals_in%subs_vals, 1) 1862 CALL section_vals_copy(section_vals_in%subs_vals(isec, irep)%section_vals, & 1863 section_vals_out%subs_vals(isec, irep - istart + 1)%section_vals) 1864 END DO 1865 END DO 1866 END SUBROUTINE section_vals_copy 1867 1868END MODULE input_section_types 1869