|
CP2K 2.4 (Revision 12889)
|
00001 !-----------------------------------------------------------------------------! 00002 ! CP2K: A general program to perform molecular dynamics simulations ! 00003 ! Copyright (C) 2000 - 2013 CP2K developers group ! 00004 !-----------------------------------------------------------------------------! 00005 00006 ! ***************************************************************************** 00013 MODULE input_section_types 00014 USE cp2k_info, ONLY: enable_color_tags 00015 USE cp_linked_list_val, ONLY: & 00016 cp_sll_val_create, cp_sll_val_dealloc, cp_sll_val_get_el_at, & 00017 cp_sll_val_get_length, cp_sll_val_get_rest, cp_sll_val_insert_el_at, & 00018 cp_sll_val_next, cp_sll_val_p_type, cp_sll_val_rm_el_at, & 00019 cp_sll_val_set_el_at, cp_sll_val_type 00020 USE f77_blas 00021 USE input_keyword_types, ONLY: & 00022 description_string_length, keyword_describe, keyword_describe_html, & 00023 keyword_p_type, keyword_release, keyword_retain, keyword_type, & 00024 keyword_typo_match, write_keyword_xml 00025 USE input_val_types, ONLY: lchar_t,& 00026 no_t,& 00027 val_create,& 00028 val_duplicate,& 00029 val_get,& 00030 val_release,& 00031 val_type,& 00032 val_write 00033 USE kinds, ONLY: default_path_length,& 00034 default_string_length,& 00035 dp,& 00036 max_line_length 00037 USE reference_manager, ONLY: get_citation_key,& 00038 print_format_journal,& 00039 print_reference 00040 USE string_utilities, ONLY: compress,& 00041 substitute_special_xml_tokens,& 00042 typo_match,& 00043 uppercase 00044 USE termination, ONLY: print_message 00045 #include "cp_common_uses.h" 00046 00047 IMPLICIT NONE 00048 PRIVATE 00049 00050 INTEGER, SAVE, PRIVATE :: last_section_id=0, last_section_vals_id=0 00051 LOGICAL, PRIVATE, PARAMETER :: debug_this_module=.TRUE. 00052 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'input_section_types' 00053 00054 PUBLIC :: section_p_type, section_type 00055 PUBLIC :: section_create,section_retain, section_release, section_describe,& 00056 section_get_subsection, section_get_keyword, section_get,& 00057 section_add_keyword, section_add_subsection, section_describe_html,& 00058 section_describe_index_html 00059 PUBLIC :: section_get_subsection_index, section_get_keyword_index 00060 PUBLIC :: section_typo_match 00061 00062 PUBLIC :: section_vals_p_type,section_vals_type 00063 PUBLIC :: section_vals_create, section_vals_retain, section_vals_release,& 00064 section_vals_get, section_vals_get_subs_vals, section_vals_val_get, section_vals_list_get, & 00065 section_vals_write, section_vals_add_values, section_vals_get_subs_vals2,& 00066 section_vals_val_set, section_vals_val_unset, section_vals_get_subs_vals3,& 00067 section_vals_set_subs_vals, section_vals_duplicate, section_vals_remove_values,& 00068 section_vals_check_release 00069 PUBLIC :: write_section_xml 00070 00071 PUBLIC :: section_get_ival,& 00072 section_get_ivals,& 00073 section_get_rvals,& 00074 section_get_rval,& 00075 section_get_cval,& 00076 section_get_lval 00077 00078 ! ***************************************************************************** 00083 TYPE section_p_type 00084 TYPE(section_type), POINTER :: section 00085 END TYPE section_p_type 00086 00087 ! ***************************************************************************** 00106 TYPE section_type 00107 LOGICAL :: frozen, required, repeats, supported_feature 00108 INTEGER :: id_nr,ref_count, n_keywords, n_subsections 00109 CHARACTER(len=default_string_length) :: name 00110 CHARACTER(len=description_string_length) :: description 00111 INTEGER, POINTER, DIMENSION(:) :: citations 00112 TYPE(keyword_p_type), DIMENSION(:), POINTER :: keywords 00113 TYPE(section_p_type), POINTER, DIMENSION(:) :: subsections 00114 END TYPE section_type 00115 00116 ! ***************************************************************************** 00121 TYPE section_vals_p_type 00122 TYPE(section_vals_type), POINTER :: section_vals 00123 END TYPE section_vals_p_type 00124 00125 ! ***************************************************************************** 00129 TYPE section_vals_type 00130 INTEGER :: ref_count, id_nr 00131 INTEGER, POINTER, DIMENSION(:) :: ibackup 00132 TYPE(section_type),POINTER :: section 00133 TYPE(cp_sll_val_p_type), DIMENSION(:,:), POINTER :: values 00134 TYPE(section_vals_p_type), DIMENSION(:,:), POINTER :: subs_vals 00135 END TYPE section_vals_type 00136 00137 CONTAINS 00138 00139 ! ***************************************************************************** 00152 SUBROUTINE section_create(section,name,description,n_keywords,& 00153 n_subsections, repeats, required, citations, supported_feature, error) 00154 TYPE(section_type), POINTER :: section 00155 CHARACTER(len=*), INTENT(in) :: name, description 00156 INTEGER, INTENT(in), OPTIONAL :: n_keywords, n_subsections 00157 LOGICAL, INTENT(in), OPTIONAL :: repeats, required 00158 INTEGER, DIMENSION(:), INTENT(IN), 00159 OPTIONAL :: citations 00160 LOGICAL, INTENT(in), OPTIONAL :: supported_feature 00161 TYPE(cp_error_type), INTENT(inout) :: error 00162 00163 CHARACTER(len=*), PARAMETER :: routineN = 'section_create', 00164 routineP = moduleN//':'//routineN 00165 00166 INTEGER :: i, my_n_keywords, 00167 my_n_subsections, stat 00168 LOGICAL :: failure 00169 00170 failure=.FALSE. 00171 00172 CPPrecondition(.NOT.ASSOCIATED(section),cp_failure_level,routineP,error,failure) 00173 IF (.NOT. failure) THEN 00174 my_n_keywords=10 00175 IF (PRESENT(n_keywords)) my_n_keywords=n_keywords 00176 my_n_subsections=0 00177 IF (PRESENT(n_subsections)) my_n_subsections=n_subsections 00178 00179 ALLOCATE(section,stat=stat) 00180 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00181 last_section_id=last_section_id+1 00182 section%id_nr=last_section_id 00183 section%ref_count=1 00184 00185 section%n_keywords=0 00186 section%n_subsections=0 00187 section%name=name 00188 CALL uppercase(section%name) 00189 CPPrecondition(LEN_TRIM(description)<=LEN(section%description),cp_warning_level,routineP,error,failure) 00190 section%description=description 00191 section%frozen=.FALSE. 00192 section%required=.FALSE. 00193 section%supported_feature=.FALSE. 00194 section%repeats=.FALSE. 00195 IF (PRESENT(required)) section%required=required 00196 IF (PRESENT(repeats)) section%repeats=repeats 00197 IF (PRESENT(supported_feature)) section%supported_feature=supported_feature 00198 00199 NULLIFY(section%citations) 00200 IF (PRESENT(citations)) THEN 00201 ALLOCATE(section%citations(SIZE(citations)),stat=stat) 00202 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00203 section%citations=citations 00204 ENDIF 00205 00206 ALLOCATE(section%keywords(-1:my_n_keywords),stat=stat) 00207 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00208 IF (.NOT.failure) THEN 00209 DO i=-1,my_n_keywords 00210 NULLIFY(section%keywords(i)%keyword) 00211 END DO 00212 END IF 00213 00214 ALLOCATE(section%subsections(my_n_subsections),stat=stat) 00215 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00216 IF (.NOT.failure) THEN 00217 DO i=1,my_n_subsections 00218 NULLIFY(section%subsections(i)%section) 00219 END DO 00220 END IF 00221 END IF 00222 END SUBROUTINE section_create 00223 00224 ! ***************************************************************************** 00231 SUBROUTINE section_retain(section,error) 00232 TYPE(section_type), POINTER :: section 00233 TYPE(cp_error_type), INTENT(inout) :: error 00234 00235 CHARACTER(len=*), PARAMETER :: routineN = 'section_retain', 00236 routineP = moduleN//':'//routineN 00237 00238 LOGICAL :: failure 00239 00240 failure=.FALSE. 00241 00242 CPPrecondition(ASSOCIATED(section),cp_failure_level,routineP,error,failure) 00243 IF (.NOT. failure) THEN 00244 CPPreconditionNoFail(section%ref_count>0,cp_failure_level,routineP,error) 00245 section%ref_count=section%ref_count+1 00246 END IF 00247 END SUBROUTINE section_retain 00248 00249 ! ***************************************************************************** 00256 RECURSIVE SUBROUTINE section_release(section,error) 00257 TYPE(section_type), POINTER :: section 00258 TYPE(cp_error_type), INTENT(inout) :: error 00259 00260 CHARACTER(len=*), PARAMETER :: routineN = 'section_release', 00261 routineP = moduleN//':'//routineN 00262 00263 INTEGER :: i, stat 00264 LOGICAL :: failure 00265 00266 failure=.FALSE. 00267 00268 IF (ASSOCIATED(section)) THEN 00269 CPPreconditionNoFail(section%ref_count>0,cp_failure_level,routineP,error) 00270 section%ref_count=section%ref_count-1 00271 IF (section%ref_count==0) THEN 00272 IF (ASSOCIATED(section%citations)) THEN 00273 DEALLOCATE(section%citations,stat=stat) 00274 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00275 ENDIF 00276 IF (ASSOCIATED(section%keywords)) THEN 00277 DO i=-1,UBOUND(section%keywords,1) 00278 CALL keyword_release(section%keywords(i)%keyword,error=error) 00279 END DO 00280 DEALLOCATE(section%keywords,stat=stat) 00281 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00282 END IF 00283 section%n_keywords=0 00284 IF (ASSOCIATED(section%subsections)) THEN 00285 DO i=1,SIZE(section%subsections) 00286 CALL section_release(section%subsections(i)%section,error=error) 00287 END DO 00288 DEALLOCATE(section%subsections,stat=stat) 00289 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00290 END IF 00291 DEALLOCATE(section,stat=stat) 00292 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00293 END IF 00294 NULLIFY(section) 00295 END IF 00296 END SUBROUTINE section_release 00297 00298 ! ***************************************************************************** 00302 FUNCTION get_section_info(section, error) RESULT(message) 00303 TYPE(section_type), POINTER :: section 00304 TYPE(cp_error_type), INTENT(inout) :: error 00305 CHARACTER(LEN=default_path_length) :: message 00306 00307 CHARACTER(len=*), PARAMETER :: routineN = 'get_section_info', 00308 routineP = moduleN//':'//routineN 00309 00310 INTEGER :: length 00311 00312 message = " " 00313 length = LEN_TRIM(section%description) 00314 IF (length>0 .AND. section%description(length:length)/=".") message = "." 00315 IF (section%repeats) THEN 00316 message=TRIM(message)//" This section can be repeated and " 00317 ELSE 00318 message=TRIM(message)//" This section can not be repeated and " 00319 END IF 00320 IF (section%required) THEN 00321 message=TRIM(message)//" can not be optional." 00322 ELSE 00323 message=TRIM(message)//" can be optional." 00324 END IF 00325 00326 END FUNCTION get_section_info 00327 00328 ! ***************************************************************************** 00340 RECURSIVE SUBROUTINE section_describe(section, unit_nr, level, hide_root, recurse,error) 00341 TYPE(section_type), POINTER :: section 00342 INTEGER, INTENT(in) :: unit_nr, level 00343 LOGICAL, INTENT(in), OPTIONAL :: hide_root 00344 INTEGER, INTENT(in), OPTIONAL :: recurse 00345 TYPE(cp_error_type), INTENT(inout) :: error 00346 00347 CHARACTER(len=*), PARAMETER :: routineN = 'section_describe', 00348 routineP = moduleN//':'//routineN 00349 00350 CHARACTER(LEN=default_path_length) :: message 00351 INTEGER :: ikeyword, isub, my_recurse 00352 LOGICAL :: failure, my_hide_root 00353 00354 failure =.FALSE. 00355 IF (unit_nr>0) THEN 00356 my_hide_root =.FALSE. 00357 IF (PRESENT(hide_root)) my_hide_root=hide_root 00358 my_recurse=0 00359 IF (PRESENT(recurse)) my_recurse=recurse 00360 IF (ASSOCIATED(section)) THEN 00361 CPPrecondition(section%ref_count>0,cp_failure_level,routineP,error,failure) 00362 00363 IF (.not.my_hide_root)& 00364 WRITE(unit_nr,"('*** section &',a,' ***')")TRIM(section%name) 00365 IF (level>1) THEN 00366 message = get_section_info(section, error) 00367 CALL print_message(TRIM(section%description)//TRIM(message),unit_nr,0,0,0) 00368 END IF 00369 IF (level>0) THEN 00370 IF (ASSOCIATED(section%keywords(-1)%keyword)) THEN 00371 CALL keyword_describe(section%keywords(-1)%keyword,unit_nr,& 00372 level,error=error) 00373 END IF 00374 IF (ASSOCIATED(section%keywords(0)%keyword)) THEN 00375 CALL keyword_describe(section%keywords(0)%keyword,unit_nr,& 00376 level,error=error) 00377 END IF 00378 DO ikeyword=1,section%n_keywords 00379 CALL keyword_describe(section%keywords(ikeyword)%keyword,unit_nr,& 00380 level,error=error) 00381 END DO 00382 END IF 00383 IF (section%n_subsections>0 .and.my_recurse>=0) THEN 00384 IF (.NOT.my_hide_root)& 00385 WRITE(unit_nr,"('** subsections **')") 00386 DO isub=1,section%n_subsections 00387 IF (my_recurse>0) THEN 00388 CALL section_describe(section%subsections(isub)%section,unit_nr,& 00389 level,recurse=my_recurse-1,error=error) 00390 ELSE 00391 WRITE(unit_nr,"(' ',a)") section%subsections(isub)%section%name 00392 END IF 00393 END DO 00394 END IF 00395 IF (.NOT.my_hide_root)& 00396 WRITE(unit_nr,"('*** &end section ',a,' ***')")TRIM(section%name) 00397 ELSE 00398 WRITE(unit_nr,"(a)") '<section *null*>' 00399 END IF 00400 END IF 00401 END SUBROUTINE section_describe 00402 00403 ! ***************************************************************************** 00404 RECURSIVE SUBROUTINE section_describe_html(section, prefix, depth, unit_nr, error) 00405 TYPE(section_type), POINTER :: section 00406 CHARACTER(LEN=*), INTENT(IN) :: prefix 00407 INTEGER, INTENT(in) :: depth, unit_nr 00408 TYPE(cp_error_type), INTENT(inout) :: error 00409 00410 CHARACTER(len=*), PARAMETER :: routineN = 'section_describe_html', 00411 routineP = moduleN//':'//routineN 00412 00413 CHARACTER(LEN=100) :: color_tag 00414 CHARACTER(LEN=1000) :: local_prefix 00415 CHARACTER(LEN=256), DIMENSION(50), SAVE :: location, name 00416 CHARACTER(LEN=default_path_length) :: message 00417 INTEGER :: idepth, ikeyword, iref, isub 00418 LOGICAL :: failure, has_keywords 00419 00420 failure=.FALSE. 00421 IF (ASSOCIATED(section)) THEN 00422 local_prefix=TRIM(prefix//"~"//TRIM(section%name)) 00423 CPPrecondition(section%ref_count>0,cp_failure_level,routineP,error,failure) 00424 OPEN(unit=179,FILE=TRIM(local_prefix)//".html") 00425 WRITE(179,FMT='(A)') "<HTML><BODY>" 00426 WRITE(179,FMT='(A)') "<HEAD><TITLE> The CP2K project : input section "//section%name//"</TITLE></HEAD>" 00427 WRITE(179,FMT='(A)') '<META NAME="description" content="CP2K">' 00428 WRITE(179,FMT='(A)') & 00429 '<META NAME="keywords" contents="scientific,computing,chemistry,physics,'//& 00430 'documentation,help,manual,Fortran,parallel">' 00431 color_tag='<font color="#000000">' 00432 IF (enable_color_tags.AND.section%supported_feature) THEN 00433 color_tag='<font color="#00CC00">' 00434 END IF 00435 WRITE(179,FMT='(A)') "<H1> Section "//TRIM(color_tag)//section%name//"</font> </H1>" 00436 WRITE(179,FMT='(A)') ' <A HREF="index.html">Index of all sections</A>. This section is located at ' 00437 DO idepth=1,depth 00438 WRITE(179,FMT='(A)',ADVANCE="NO") '<A HREF="'//TRIM(location(idepth))//'">'//TRIM(name(idepth))//'</A>%' 00439 ENDDO 00440 location(depth+1)=TRIM(local_prefix)//".html" 00441 name(depth+1)=TRIM(section%name) 00442 WRITE(179,FMT='(A)') '<A HREF="'//TRIM(location(depth+1))//'">'//TRIM(name(depth+1))//'</A>.' 00443 00444 message = get_section_info(section, error) 00445 WRITE(179,FMT='(A)') '<BR><BR>'//TRIM(section%description)//TRIM(message) 00446 00447 IF (ASSOCIATED(section%citations)) THEN 00448 IF (SIZE(section%citations,1)>1) THEN 00449 WRITE(179,FMT='(A)') '<BR><BR> This section cites following references: ' 00450 ELSE 00451 WRITE(179,FMT='(A)') '<BR><BR> This section cites following reference: ' 00452 ENDIF 00453 DO iref=1,SIZE(section%citations,1) 00454 WRITE(179,FMT='(A,I0,A)') '<A HREF="references.html#reference_',section%citations(iref),'" TITLE="' 00455 CALL print_reference(section%citations(iref),FORMAT=print_format_journal,unit=179) 00456 WRITE(179,FMT='(A)') '">['//TRIM(get_citation_key(section%citations(iref)))//']</A>' 00457 ENDDO 00458 ENDIF 00459 00460 WRITE(179,FMT='(A)') "<H2> Subsections</H2>" 00461 IF (section%n_subsections>0) THEN 00462 WRITE(179,FMT='(A)') "<UL>" 00463 DO isub=1,section%n_subsections 00464 color_tag='<font color="#0000FF">' 00465 IF (enable_color_tags.AND.section%subsections(isub)%section%supported_feature) THEN 00466 color_tag='<font color="#00CC00">' 00467 END IF 00468 WRITE(179,FMT='(A)') & 00469 '<LI><A HREF="'//TRIM(local_prefix)//"~"//TRIM(section%subsections(isub)%section%name)//".html"//'">'// & 00470 TRIM(color_tag)//TRIM(section%subsections(isub)%section%name)//'</font> </A>' 00471 END DO 00472 WRITE(179,FMT='(A)') "</UL>" 00473 ELSE 00474 WRITE(179,FMT='(A)') "None" 00475 ENDIF 00476 WRITE(179,FMT='(A)') "<H2> Section keywords </H2>" 00477 has_keywords=ASSOCIATED(section%keywords(-1)%keyword) .OR. & 00478 ASSOCIATED(section%keywords(0)%keyword) .OR. & 00479 section%n_keywords>=1 00480 IF (has_keywords) THEN 00481 WRITE(179,FMT='(A)') "<UL>" 00482 DO ikeyword=-1,section%n_keywords 00483 IF (ASSOCIATED(section%keywords(ikeyword)%keyword)) THEN 00484 color_tag='<font color="#0000FF">' 00485 IF (enable_color_tags.AND.section%keywords(ikeyword)%keyword%supported_feature) THEN 00486 color_tag='<font color="#00CC00">' 00487 END IF 00488 WRITE(179,FMT='(A)') & 00489 '<LI><A HREF="#'//TRIM(section%keywords(ikeyword)%keyword%names(1))//'">'//& 00490 TRIM(color_tag)//TRIM(section%keywords(ikeyword)%keyword%names(1))//"</font> </A>" 00491 END IF 00492 END DO 00493 WRITE(179,FMT='(A)') "</UL>" 00494 WRITE(179,FMT='(A)') "<H2> Keyword descriptions </H2>" 00495 WRITE(179,FMT='(A)') "<TABLE>" 00496 DO ikeyword=-1,section%n_keywords 00497 IF (ASSOCIATED(section%keywords(ikeyword)%keyword)) THEN 00498 CALL keyword_describe_html(section%keywords(ikeyword)%keyword,179,error=error) 00499 END IF 00500 END DO 00501 WRITE(179,FMT='(A)') "</TABLE>" 00502 ELSE 00503 WRITE(179,FMT='(A)') "None" 00504 ENDIF 00505 WRITE(179,FMT='(A)') & 00506 '<BR><hr>Back to the <A HREF="http://www.cp2k.org/">CP2K homepage</A> or '// & 00507 'the latest version of <A HREF="http://manual.cp2k.org/trunk/">this manual</A>' 00508 WRITE(179,FMT='(A)') "</BODY></HTML>" 00509 CLOSE(unit=179) 00510 DO isub=1,section%n_subsections 00511 CALL section_describe_html(section%subsections(isub)%section,TRIM(local_prefix),depth+1,unit_nr,& 00512 error=error) 00513 END DO 00514 END IF 00515 END SUBROUTINE section_describe_html 00516 00517 ! ***************************************************************************** 00518 RECURSIVE SUBROUTINE section_describe_index_html(section,prefix, unit_nr, error) 00519 TYPE(section_type), POINTER :: section 00520 CHARACTER(LEN=*), INTENT(IN) :: prefix 00521 INTEGER, INTENT(in) :: unit_nr 00522 TYPE(cp_error_type), INTENT(inout) :: error 00523 00524 CHARACTER(len=*), PARAMETER :: routineN = 'section_describe_index_html', 00525 routineP = moduleN//':'//routineN 00526 00527 CHARACTER(LEN=100) :: color_tag 00528 CHARACTER(LEN=1000) :: local_prefix 00529 INTEGER :: isub 00530 LOGICAL :: failure 00531 00532 failure=.FALSE. 00533 IF (ASSOCIATED(section)) THEN 00534 CPPrecondition(section%ref_count>0,cp_failure_level,routineP,error,failure) 00535 local_prefix=TRIM(prefix//"~"//TRIM(section%name)) 00536 color_tag='<font color="#0000FF">' 00537 IF (enable_color_tags.AND.section%supported_feature) THEN 00538 color_tag='<font color="#00CC00">' 00539 END IF 00540 WRITE(unit_nr,FMT='(A)') & 00541 '<LI><A HREF="'//TRIM(local_prefix)//'.html">'//TRIM(color_tag)//TRIM(section%name)//"</font></A>" 00542 IF (section%n_subsections>0) THEN 00543 WRITE(unit_nr,FMT='(A)') "<UL>" 00544 DO isub=1,section%n_subsections 00545 CALL section_describe_index_html(section%subsections(isub)%section,TRIM(local_prefix),unit_nr,& 00546 error=error) 00547 END DO 00548 WRITE(unit_nr,FMT='(A)') "</UL>" 00549 ENDIF 00550 ENDIF 00551 END SUBROUTINE section_describe_index_html 00552 00553 ! ***************************************************************************** 00563 FUNCTION section_get_subsection_index(section,subsection_name,error) RESULT(res) 00564 TYPE(section_type), POINTER :: section 00565 CHARACTER(len=*), INTENT(in) :: subsection_name 00566 TYPE(cp_error_type), INTENT(inout) :: error 00567 INTEGER :: res 00568 00569 CHARACTER(len=*), PARAMETER :: routineN = 'section_get_subsection_index', 00570 routineP = moduleN//':'//routineN 00571 00572 CHARACTER(len=default_string_length) :: upc_name 00573 INTEGER :: isub 00574 LOGICAL :: failure 00575 00576 failure=.FALSE. 00577 00578 CPPrecondition(ASSOCIATED(section),cp_failure_level,routineP,error,failure) 00579 CPPrecondition(section%ref_count>0,cp_failure_level,routineP,error,failure) 00580 res=-1 00581 IF (.NOT. failure) THEN 00582 upc_name=subsection_name 00583 CALL uppercase(upc_name) 00584 DO isub=1,section%n_subsections 00585 CPInvariant(ASSOCIATED(section%subsections(isub)%section),cp_failure_level,routineP,error,failure) 00586 IF (section%subsections(isub)%section%name==upc_name) THEN 00587 res=isub 00588 EXIT 00589 END IF 00590 END DO 00591 END IF 00592 END FUNCTION section_get_subsection_index 00593 00594 ! ***************************************************************************** 00602 FUNCTION section_get_subsection(section,subsection_name,error) RESULT(res) 00603 TYPE(section_type), POINTER :: section 00604 CHARACTER(len=*), INTENT(in) :: subsection_name 00605 TYPE(cp_error_type), INTENT(inout) :: error 00606 TYPE(section_type), POINTER :: res 00607 00608 CHARACTER(len=*), PARAMETER :: routineN = 'section_get_subsection', 00609 routineP = moduleN//':'//routineN 00610 00611 INTEGER :: isub 00612 00613 isub=section_get_subsection_index(section,subsection_name,error=error) 00614 IF (isub>0) THEN 00615 res => section%subsections(isub)%section 00616 ELSE 00617 NULLIFY(res) 00618 END IF 00619 END FUNCTION section_get_subsection 00620 00621 ! ***************************************************************************** 00631 FUNCTION section_get_keyword_index(section,keyword_name,error) RESULT(res) 00632 TYPE(section_type), POINTER :: section 00633 CHARACTER(len=*), INTENT(in) :: keyword_name 00634 TYPE(cp_error_type), INTENT(inout) :: error 00635 INTEGER :: res 00636 00637 CHARACTER(len=*), PARAMETER :: routineN = 'section_get_keyword_index', 00638 routineP = moduleN//':'//routineN 00639 00640 INTEGER :: ik, in 00641 CHARACTER(len=default_string_length) :: upc_name 00642 LOGICAL :: failure 00643 00644 failure=.FALSE. 00645 00646 CPPrecondition(ASSOCIATED(section),cp_failure_level,routineP,error,failure) 00647 CPPrecondition(section%ref_count>0,cp_failure_level,routineP,error,failure) 00648 CPPrecondition(ASSOCIATED(section%keywords),cp_failure_level,routineP,error,failure) 00649 res=-2 00650 IF (.NOT. failure) THEN 00651 upc_name=keyword_name 00652 CALL uppercase(upc_name) 00653 DO ik=-1,0 00654 IF (ASSOCIATED(section%keywords(ik)%keyword)) THEN 00655 IF (section%keywords(ik)%keyword%names(1)==upc_name) THEN 00656 res = ik 00657 END IF 00658 END IF 00659 END DO 00660 IF (res==-2) THEN 00661 k_search_loop: DO ik=1,section%n_keywords 00662 CPInvariant(ASSOCIATED(section%keywords(ik)%keyword),cp_failure_level,routineP,error,failure) 00663 DO in=1,SIZE(section%keywords(ik)%keyword%names) 00664 IF (section%keywords(ik)%keyword%names(in)==upc_name) THEN 00665 res = ik 00666 EXIT k_search_loop 00667 END IF 00668 END DO 00669 END DO k_search_loop 00670 END IF 00671 END IF 00672 END FUNCTION section_get_keyword_index 00673 00674 ! ***************************************************************************** 00682 RECURSIVE FUNCTION section_get_keyword(section,keyword_name,error) RESULT(res) 00683 TYPE(section_type), POINTER :: section 00684 CHARACTER(len=*), INTENT(in) :: keyword_name 00685 TYPE(cp_error_type), INTENT(inout) :: error 00686 TYPE(keyword_type), POINTER :: res 00687 00688 CHARACTER(len=*), PARAMETER :: routineN = 'section_get_keyword', 00689 routineP = moduleN//':'//routineN 00690 00691 INTEGER :: ik, my_index 00692 LOGICAL :: failure 00693 00694 failure = .FALSE. 00695 IF (INDEX(keyword_name,"%")/=0) THEN 00696 my_index = INDEX(keyword_name,"%") + 1 00697 CPPrecondition(ASSOCIATED(section%subsections),cp_failure_level,routineP,error,failure) 00698 DO ik = LBOUND(section%subsections,1), UBOUND(section%subsections,1) 00699 IF (section%subsections(ik)%section%name==keyword_name(1:my_index-2)) EXIT 00700 END DO 00701 CPPrecondition(ik<=UBOUND(section%subsections,1),cp_failure_level,routineP,error,failure) 00702 res => section_get_keyword(section%subsections(ik)%section,keyword_name(my_index:),error) 00703 ELSE 00704 ik=section_get_keyword_index(section,keyword_name,error) 00705 IF (ik==-2) THEN 00706 NULLIFY(res) 00707 ELSE 00708 res => section%keywords(ik)%keyword 00709 END IF 00710 END IF 00711 END FUNCTION section_get_keyword 00712 00713 ! ***************************************************************************** 00724 SUBROUTINE section_get(section,frozen, required, repeats,id_nr,ref_count, & 00725 name,description,citations,error) 00726 TYPE(section_type), POINTER :: section 00727 LOGICAL, INTENT(out), OPTIONAL :: frozen, required, repeats 00728 INTEGER, INTENT(out), OPTIONAL :: id_nr, ref_count 00729 CHARACTER(len=*), INTENT(out), OPTIONAL :: name, description 00730 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: citations 00731 TYPE(cp_error_type), INTENT(inout) :: error 00732 00733 CHARACTER(len=*), PARAMETER :: routineN = 'section_get', 00734 routineP = moduleN//':'//routineN 00735 00736 LOGICAL :: failure 00737 00738 failure=.FALSE. 00739 00740 CPPrecondition(ASSOCIATED(section),cp_failure_level,routineP,error,failure) 00741 CPPrecondition(section%ref_count>0,cp_failure_level,routineP,error,failure) 00742 IF (.NOT. failure) THEN 00743 IF (PRESENT(frozen)) frozen=section%frozen 00744 IF (PRESENT(required)) required=section%required 00745 IF (PRESENT(repeats)) repeats=section%repeats 00746 IF (PRESENT(id_nr)) id_nr=section%id_nr 00747 IF (PRESENT(ref_count)) ref_count=section%ref_count 00748 IF (PRESENT(name)) name=section%name 00749 IF (PRESENT(description)) description=section%description 00750 IF (PRESENT(description)) citations=>section%citations 00751 END IF 00752 END SUBROUTINE section_get 00753 00754 ! ***************************************************************************** 00762 SUBROUTINE section_add_keyword(section,keyword,error) 00763 TYPE(section_type), POINTER :: section 00764 TYPE(keyword_type), POINTER :: keyword 00765 TYPE(cp_error_type), INTENT(inout) :: error 00766 00767 CHARACTER(len=*), PARAMETER :: routineN = 'section_add_keyword', 00768 routineP = moduleN//':'//routineN 00769 00770 INTEGER :: i, j, k, stat 00771 LOGICAL :: failure 00772 TYPE(keyword_p_type), DIMENSION(:), 00773 POINTER :: new_keywords 00774 00775 failure=.FALSE. 00776 00777 CPPrecondition(ASSOCIATED(section),cp_failure_level,routineP,error,failure) 00778 CPPrecondition(section%ref_count>0,cp_failure_level,routineP,error,failure) 00779 CPPrecondition(.NOT.section%frozen,cp_failure_level,routineP,error,failure) 00780 CPPrecondition(ASSOCIATED(keyword),cp_failure_level,routineP,error,failure) 00781 CPPrecondition(keyword%ref_count>0,cp_failure_level,routineP,error,failure) 00782 IF (.NOT. failure) THEN 00783 CALL keyword_retain(keyword,error=error) 00784 IF (keyword%names(1)=="_SECTION_PARAMETERS_") THEN 00785 CALL keyword_release(section%keywords(-1)%keyword,error=error) 00786 section%keywords(-1)%keyword => keyword 00787 ELSE IF (keyword%names(1)=="_DEFAULT_KEYWORD_") THEN 00788 CALL keyword_release(section%keywords(0)%keyword,error=error) 00789 section%keywords(0)%keyword => keyword 00790 ELSE 00791 DO k=1,SIZE(keyword%names) 00792 DO i=1,section%n_keywords 00793 DO j=1,SIZE(section%keywords(i)%keyword%names) 00794 IF (keyword%names(k)==section%keywords(i)%keyword%names(j)) THEN 00795 CALL cp_assert(.FALSE., cp_failure_level,cp_assertion_failed,routineP,& 00796 "trying to add a keyword with a name ("//& 00797 TRIM(keyword%names(k))//") that was already used in section "& 00798 //TRIM(section%name),error,failure) 00799 ENDIF 00800 END DO 00801 END DO 00802 END DO 00803 00804 IF (UBOUND(section%keywords,1)==section%n_keywords) THEN 00805 ALLOCATE(new_keywords(-1:section%n_keywords+10),stat=stat) 00806 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00807 DO i=-1,section%n_keywords 00808 new_keywords(i)%keyword => section%keywords(i)%keyword 00809 END DO 00810 DO i=section%n_keywords+1,UBOUND(new_keywords,1) 00811 NULLIFY(new_keywords(i)%keyword) 00812 END DO 00813 DEALLOCATE(section%keywords,stat=stat) 00814 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00815 section%keywords => new_keywords 00816 END IF 00817 section%n_keywords=section%n_keywords+1 00818 section%keywords(section%n_keywords)%keyword => keyword 00819 END IF 00820 END IF 00821 END SUBROUTINE section_add_keyword 00822 00823 ! ***************************************************************************** 00831 SUBROUTINE section_add_subsection(section,subsection,error) 00832 TYPE(section_type), POINTER :: section, subsection 00833 TYPE(cp_error_type), INTENT(inout) :: error 00834 00835 CHARACTER(len=*), PARAMETER :: routineN = 'section_add_subsection', 00836 routineP = moduleN//':'//routineN 00837 00838 INTEGER :: i, stat 00839 LOGICAL :: failure 00840 TYPE(section_p_type), DIMENSION(:), 00841 POINTER :: new_subsections 00842 00843 failure=.FALSE. 00844 00845 CPPrecondition(ASSOCIATED(section),cp_failure_level,routineP,error,failure) 00846 CPPrecondition(section%ref_count>0,cp_failure_level,routineP,error,failure) 00847 CPPrecondition(ASSOCIATED(subsection),cp_failure_level,routineP,error,failure) 00848 CPPrecondition(subsection%ref_count>0,cp_failure_level,routineP,error,failure) 00849 IF (.NOT. failure) THEN 00850 IF (SIZE(section%subsections)<section%n_subsections+1) THEN 00851 ALLOCATE(new_subsections(section%n_subsections+10),stat=stat) 00852 CPPostcondition(stat==0,cp_fatal_level,routineP,error,failure) 00853 DO i=1,section%n_subsections 00854 new_subsections(i)%section => section%subsections(i)%section 00855 END DO 00856 DO i=section%n_subsections+1,SIZE(new_subsections) 00857 NULLIFY(new_subsections(i)%section) 00858 END DO 00859 DEALLOCATE(section%subsections,stat=stat) 00860 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00861 section%subsections => new_subsections 00862 END IF 00863 DO i=1,section%n_subsections 00864 CALL cp_assert(subsection%name/=section%subsections(i)%section%name,& 00865 cp_failure_level,cp_assertion_failed,routineP,& 00866 "trying to add a subsection with a name ("//& 00867 TRIM(subsection%name)//") that was already used in section "& 00868 //TRIM(section%name),error,failure) 00869 END DO 00870 CALL section_retain(subsection,error=error) 00871 section%n_subsections=section%n_subsections+1 00872 section%subsections(section%n_subsections)%section => subsection 00873 END IF 00874 END SUBROUTINE section_add_subsection 00875 00876 ! ***************************************************************************** 00884 RECURSIVE SUBROUTINE section_vals_create(section_vals,section,error) 00885 TYPE(section_vals_type), POINTER :: section_vals 00886 TYPE(section_type), POINTER :: section 00887 TYPE(cp_error_type), INTENT(inout) :: error 00888 00889 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_create', 00890 routineP = moduleN//':'//routineN 00891 00892 INTEGER :: i, stat 00893 LOGICAL :: failure 00894 00895 failure=.FALSE. 00896 00897 CPPrecondition(.NOT.ASSOCIATED(section_vals),cp_failure_level,routineP,error,failure) 00898 ALLOCATE(section_vals,stat=stat) 00899 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00900 IF (.NOT. failure) THEN 00901 last_section_vals_id=last_section_vals_id+1 00902 section_vals%id_nr=last_section_vals_id 00903 section_vals%ref_count=1 00904 CALL section_retain(section,error=error) 00905 section_vals%section => section 00906 section%frozen=.TRUE. 00907 ALLOCATE(section_vals%values(-1:section%n_keywords,0),stat=stat) 00908 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00909 ALLOCATE(section_vals%subs_vals(section%n_subsections,1),stat=stat) 00910 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00911 DO i=1,section%n_subsections 00912 NULLIFY(section_vals%subs_vals(i,1)%section_vals) 00913 CALL section_vals_create(section_vals%subs_vals(i,1)%section_vals,& 00914 section=section%subsections(i)%section,error=error) 00915 END DO 00916 NULLIFY(section_vals%ibackup) 00917 END IF 00918 END SUBROUTINE section_vals_create 00919 00920 ! ***************************************************************************** 00927 SUBROUTINE section_vals_retain(section_vals,error) 00928 TYPE(section_vals_type), POINTER :: section_vals 00929 TYPE(cp_error_type), INTENT(inout) :: error 00930 00931 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_retain', 00932 routineP = moduleN//':'//routineN 00933 00934 LOGICAL :: failure 00935 00936 failure=.FALSE. 00937 CPPrecondition(ASSOCIATED(section_vals),cp_failure_level,routineP,error,failure) 00938 IF (.NOT. failure) THEN 00939 CPPreconditionNoFail(section_vals%ref_count>0,cp_failure_level,routineP,error) 00940 section_vals%ref_count=section_vals%ref_count+1 00941 END IF 00942 END SUBROUTINE section_vals_retain 00943 00944 ! ***************************************************************************** 00951 RECURSIVE SUBROUTINE section_vals_release(section_vals, error) 00952 TYPE(section_vals_type), POINTER :: section_vals 00953 TYPE(cp_error_type), INTENT(inout) :: error 00954 00955 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_release', 00956 routineP = moduleN//':'//routineN 00957 00958 INTEGER :: i, j, stat 00959 LOGICAL :: failure 00960 TYPE(cp_sll_val_type), POINTER :: vals 00961 TYPE(val_type), POINTER :: el 00962 00963 failure=.FALSE. 00964 00965 IF (ASSOCIATED(section_vals)) THEN 00966 CPPreconditionNoFail(section_vals%ref_count>0,cp_failure_level,routineP,error) 00967 section_vals%ref_count=section_vals%ref_count-1 00968 IF (section_vals%ref_count==0) THEN 00969 CALL section_release(section_vals%section,error=error) 00970 DO j=1,SIZE(section_vals%values,2) 00971 DO i=-1,UBOUND(section_vals%values,1) 00972 vals => section_vals%values(i,j)%list 00973 DO WHILE (cp_sll_val_next(vals,el_att=el,error=error)) 00974 CALL val_release(el,error=error) 00975 END DO 00976 CALL cp_sll_val_dealloc(section_vals%values(i,j)%list,error=error) 00977 END DO 00978 END DO 00979 DEALLOCATE(section_vals%values,stat=stat) 00980 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00981 DO j=1,SIZE(section_vals%subs_vals,2) 00982 DO i=1,SIZE(section_vals%subs_vals,1) 00983 CALL section_vals_release(section_vals%subs_vals(i,j)%section_vals,& 00984 error=error) 00985 END DO 00986 END DO 00987 DEALLOCATE(section_vals%subs_vals,stat=stat) 00988 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00989 IF (ASSOCIATED(section_vals%ibackup)) THEN 00990 DEALLOCATE(section_vals%ibackup,stat=stat) 00991 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00992 END IF 00993 DEALLOCATE(section_vals,stat=stat) 00994 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00995 END IF 00996 END IF 00997 END SUBROUTINE section_vals_release 00998 00999 ! ***************************************************************************** 01012 SUBROUTINE section_vals_get(section_vals, ref_count, id_nr, n_repetition,& 01013 n_subs_vals_rep,section,explicit, error) 01014 TYPE(section_vals_type), POINTER :: section_vals 01015 INTEGER, INTENT(out), OPTIONAL :: ref_count, id_nr, 01016 n_repetition, n_subs_vals_rep 01017 TYPE(section_type), OPTIONAL, POINTER :: section 01018 LOGICAL, INTENT(out), OPTIONAL :: explicit 01019 TYPE(cp_error_type), INTENT(inout) :: error 01020 01021 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_get', 01022 routineP = moduleN//':'//routineN 01023 01024 LOGICAL :: failure 01025 01026 failure=.FALSE. 01027 01028 CPPrecondition(ASSOCIATED(section_vals),cp_failure_level,routineP,error,failure) 01029 CPPrecondition(section_vals%ref_count>0,cp_failure_level,routineP,error,failure) 01030 IF (.NOT. failure) THEN 01031 IF (PRESENT(ref_count)) ref_count=section_vals%ref_count 01032 IF (PRESENT(id_nr)) id_nr=section_vals%id_nr 01033 IF (PRESENT(section)) section => section_vals%section 01034 IF (PRESENT(n_repetition)) THEN 01035 n_repetition=SIZE(section_vals%values,2) 01036 IF (.NOT.section_vals%section%required) n_repetition=MAX(1,n_repetition) 01037 END IF 01038 IF (PRESENT(n_subs_vals_rep)) n_subs_vals_rep=SIZE(section_vals%subs_vals,2) 01039 IF (PRESENT(explicit)) explicit=(SIZE(section_vals%values,2)>0) 01040 END IF 01041 END SUBROUTINE section_vals_get 01042 01043 ! ***************************************************************************** 01054 RECURSIVE FUNCTION section_vals_get_subs_vals(section_vals,subsection_name,& 01055 i_rep_section,can_return_null,error) RESULT(res) 01056 TYPE(section_vals_type), POINTER :: section_vals 01057 CHARACTER(len=*), INTENT(in) :: subsection_name 01058 INTEGER, INTENT(in), OPTIONAL :: i_rep_section 01059 LOGICAL, INTENT(in), OPTIONAL :: can_return_null 01060 TYPE(cp_error_type), INTENT(inout) :: error 01061 TYPE(section_vals_type), POINTER :: res 01062 01063 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_get_subs_vals', 01064 routineP = moduleN//':'//routineN 01065 01066 INTEGER :: irep, isection, my_index 01067 LOGICAL :: failure, is_path, 01068 my_can_return_null 01069 01070 failure=.FALSE. 01071 CPPrecondition(ASSOCIATED(section_vals),cp_failure_level,routineP,error,failure) 01072 CPPrecondition(section_vals%ref_count>0,cp_failure_level,routineP,error,failure) 01073 01074 my_can_return_null=.FALSE. 01075 IF (PRESENT(can_return_null)) my_can_return_null=can_return_null 01076 NULLIFY(res) 01077 IF (.NOT. failure) THEN 01078 irep=1 01079 IF (PRESENT(i_rep_section)) irep=i_rep_section 01080 01081 ! prepare for recursive parsing of subsections. i_rep_section will be used for last section 01082 my_index=INDEX(subsection_name,"%") 01083 IF (my_index.EQ.0) THEN 01084 is_path=.FALSE. 01085 my_index=LEN_TRIM(subsection_name) 01086 ELSE 01087 is_path=.TRUE. 01088 irep=1 01089 my_index=my_index-1 01090 ENDIF 01091 01092 CPPrecondition(irep<=SIZE(section_vals%subs_vals,2),cp_failure_level,routineP,error,failure) 01093 END IF 01094 01095 IF (.NOT.failure) THEN 01096 isection=section_get_subsection_index(section_vals%section,subsection_name(1:my_index),& 01097 error=error) 01098 IF (isection>0) res => section_vals%subs_vals(isection,irep)%section_vals 01099 END IF 01100 CALL cp_assert(ASSOCIATED(res).OR.my_can_return_null,cp_failure_level,& 01101 cp_assertion_failed,routineP,& 01102 "could not find subsection "//TRIM(subsection_name(1:my_index))//" in section "//& 01103 TRIM(section_vals%section%name)//" at "//& 01104 CPSourceFileRef,& 01105 error,failure) 01106 IF (is_path .AND. ASSOCIATED(res) ) THEN 01107 res=>section_vals_get_subs_vals(res,subsection_name(my_index+2:LEN_TRIM(subsection_name)),& 01108 i_rep_section,can_return_null,error) 01109 ENDIF 01110 01111 END FUNCTION section_vals_get_subs_vals 01112 01113 ! ***************************************************************************** 01124 FUNCTION section_vals_get_subs_vals2(section_vals,i_section,i_rep_section,error) RESULT(res) 01125 TYPE(section_vals_type), POINTER :: section_vals 01126 INTEGER, INTENT(in) :: i_section 01127 INTEGER, INTENT(in), OPTIONAL :: i_rep_section 01128 TYPE(cp_error_type), INTENT(inout) :: error 01129 TYPE(section_vals_type), POINTER :: res 01130 01131 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_get_subs_vals2', 01132 routineP = moduleN//':'//routineN 01133 01134 INTEGER :: i, irep, isect_att 01135 LOGICAL :: failure 01136 01137 failure=.FALSE. 01138 CPPrecondition(ASSOCIATED(section_vals),cp_failure_level,routineP,error,failure) 01139 CPPrecondition(section_vals%ref_count>0,cp_failure_level,routineP,error,failure) 01140 NULLIFY(res) 01141 IF (.NOT. failure) THEN 01142 irep=1 01143 IF (PRESENT(i_rep_section)) irep=i_rep_section 01144 CPPrecondition(irep<=SIZE(section_vals%subs_vals,2),cp_failure_level,routineP,error,failure) 01145 END IF 01146 IF (.NOT.failure) THEN 01147 isect_att=0 01148 DO i=1,section_vals%section%n_subsections 01149 IF (SIZE(section_vals%subs_vals(i,irep)%section_vals%values,2)>0) THEN 01150 isect_att=isect_att+1 01151 IF (isect_att==i_section) THEN 01152 res => section_vals%subs_vals(i,irep)%section_vals 01153 EXIT 01154 END IF 01155 END IF 01156 END DO 01157 END IF 01158 END FUNCTION section_vals_get_subs_vals2 01159 01160 ! ***************************************************************************** 01171 FUNCTION section_vals_get_subs_vals3(section_vals,subsection_name,& 01172 i_rep_section,error) RESULT(res) 01173 TYPE(section_vals_type), POINTER :: section_vals 01174 CHARACTER(LEN=*), INTENT(IN) :: subsection_name 01175 INTEGER, INTENT(in), OPTIONAL :: i_rep_section 01176 TYPE(cp_error_type), INTENT(inout) :: error 01177 TYPE(section_vals_type), POINTER :: res 01178 01179 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_get_subs_vals3', 01180 routineP = moduleN//':'//routineN 01181 01182 INTEGER :: i_section, irep 01183 LOGICAL :: failure 01184 01185 failure=.FALSE. 01186 CPPrecondition(ASSOCIATED(section_vals),cp_failure_level,routineP,error,failure) 01187 CPPrecondition(section_vals%ref_count>0,cp_failure_level,routineP,error,failure) 01188 NULLIFY(res) 01189 IF (.NOT. failure) THEN 01190 irep=1 01191 IF (PRESENT(i_rep_section)) irep=i_rep_section 01192 CPPrecondition(irep<=SIZE(section_vals%subs_vals,2),cp_failure_level,routineP,error,failure) 01193 END IF 01194 i_section = section_get_subsection_index(section_vals%section,subsection_name,error) 01195 IF (.NOT.failure) THEN 01196 res => section_vals%subs_vals(i_section,irep)%section_vals 01197 END IF 01198 END FUNCTION section_vals_get_subs_vals3 01199 01200 ! ***************************************************************************** 01207 SUBROUTINE section_vals_add_values(section_vals,error) 01208 TYPE(section_vals_type), POINTER :: section_vals 01209 TYPE(cp_error_type), INTENT(inout) :: error 01210 01211 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_add_values', 01212 routineP = moduleN//':'//routineN 01213 01214 INTEGER :: i, j, stat 01215 LOGICAL :: failure 01216 TYPE(cp_sll_val_p_type), 01217 DIMENSION(:, :), POINTER :: new_values 01218 TYPE(section_vals_p_type), 01219 DIMENSION(:, :), POINTER :: new_sps 01220 01221 failure=.FALSE. 01222 01223 CPPrecondition(ASSOCIATED(section_vals),cp_failure_level,routineP,error,failure) 01224 CPPrecondition(section_vals%ref_count>0,cp_failure_level,routineP,error,failure) 01225 IF (.NOT. failure) THEN 01226 ALLOCATE(new_values(-1:UBOUND(section_vals%values,1),SIZE(section_vals%values,2)+1),stat=stat) 01227 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01228 DO j=1,SIZE(section_vals%values,2) 01229 DO i=-1,UBOUND(section_vals%values,1) 01230 new_values(i,j)%list => section_vals%values(i,j)%list 01231 END DO 01232 END DO 01233 DEALLOCATE(section_vals%values,stat=stat) 01234 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 01235 section_vals%values => new_values 01236 j=SIZE ( new_values, 2 ) 01237 DO i=-1,UBOUND(new_values,1) 01238 NULLIFY(new_values(i,j)%list) 01239 END DO 01240 01241 IF (SIZE(new_values,2)>1) THEN 01242 ALLOCATE(new_sps(SIZE(section_vals%subs_vals,1),& 01243 SIZE(section_vals%subs_vals,2)+1),stat=stat) 01244 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01245 DO j=1,SIZE(section_vals%subs_vals,2) 01246 DO i=1,SIZE(section_vals%subs_vals,1) 01247 new_sps(i,j)%section_vals => section_vals%subs_vals(i,j)%section_vals 01248 END DO 01249 END DO 01250 DEALLOCATE(section_vals%subs_vals,stat=stat) 01251 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 01252 section_vals%subs_vals => new_sps 01253 j = SIZE ( new_sps, 2 ) 01254 DO i=1,SIZE(new_sps,1) 01255 NULLIFY(new_sps(i,j)%section_vals) 01256 CALL section_vals_create(new_sps(i,SIZE(new_sps,2))%section_vals,& 01257 section=section_vals%section%subsections(i)%section,error=error) 01258 END DO 01259 END IF 01260 END IF 01261 END SUBROUTINE section_vals_add_values 01262 01263 ! ***************************************************************************** 01270 SUBROUTINE section_vals_remove_values(section_vals,error) 01271 TYPE(section_vals_type), POINTER :: section_vals 01272 TYPE(cp_error_type), INTENT(inout) :: error 01273 01274 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_remove_values', 01275 routineP = moduleN//':'//routineN 01276 01277 INTEGER :: i, j, stat 01278 LOGICAL :: failure 01279 TYPE(cp_sll_val_p_type), 01280 DIMENSION(:, :), POINTER :: new_values 01281 TYPE(cp_sll_val_type), POINTER :: vals 01282 TYPE(val_type), POINTER :: el 01283 01284 failure=.FALSE. 01285 01286 IF (ASSOCIATED(section_vals)) THEN 01287 CPPrecondition(section_vals%ref_count>0,cp_failure_level,routineP,error,failure) 01288 IF (.NOT. failure) THEN 01289 NULLIFY(el, vals) 01290 ! Allocate a null 0 dimension array of values 01291 ALLOCATE(new_values(-1:section_vals%section%n_keywords,0),stat=stat) 01292 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01293 ! Release old values 01294 DO j=1,SIZE(section_vals%values,2) 01295 DO i=-1,UBOUND(section_vals%values,1) 01296 vals => section_vals%values(i,j)%list 01297 DO WHILE (cp_sll_val_next(vals,el_att=el,error=error)) 01298 CALL val_release(el,error=error) 01299 END DO 01300 CALL cp_sll_val_dealloc(section_vals%values(i,j)%list,error=error) 01301 END DO 01302 END DO 01303 DEALLOCATE(section_vals%values,stat=stat) 01304 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 01305 section_vals%values => new_values 01306 END IF 01307 END IF 01308 END SUBROUTINE section_vals_remove_values 01309 01310 ! These accessor functions can be used instead of passing a variable 01311 ! in the parameter list of a subroutine call. This should make the 01312 ! code a lot simpler. See xc_rho_set_and_dset_create in xc.F as 01313 ! an example. 01314 01315 ! ***************************************************************************** 01316 FUNCTION section_get_cval(section_vals,keyword_name,error) RESULT(res) 01317 01318 TYPE(section_vals_type), POINTER :: section_vals 01319 CHARACTER(len=*), INTENT(in) :: keyword_name 01320 TYPE(cp_error_type), INTENT(inout) :: error 01321 CHARACTER(LEN=DEFAULT_STRING_LENGTH) :: res 01322 01323 CALL section_vals_val_get(section_vals, keyword_name, c_val=res, error=error) 01324 01325 END FUNCTION section_get_cval 01326 01327 ! ***************************************************************************** 01328 FUNCTION section_get_rval(section_vals,keyword_name,error) RESULT(res) 01329 01330 TYPE(section_vals_type), POINTER :: section_vals 01331 CHARACTER(len=*), INTENT(in) :: keyword_name 01332 TYPE(cp_error_type), INTENT(inout) :: error 01333 REAL(kind=dp) :: res 01334 01335 CALL section_vals_val_get(section_vals, keyword_name, r_val=res, error=error) 01336 01337 END FUNCTION section_get_rval 01338 01339 ! ***************************************************************************** 01340 FUNCTION section_get_rvals(section_vals,keyword_name,error) RESULT(res) 01341 01342 TYPE(section_vals_type), POINTER :: section_vals 01343 CHARACTER(len=*), INTENT(in) :: keyword_name 01344 TYPE(cp_error_type), INTENT(inout) :: error 01345 REAL(kind=dp), DIMENSION(:), POINTER :: res 01346 01347 CALL section_vals_val_get(section_vals, keyword_name, r_vals=res, error=error) 01348 01349 END FUNCTION section_get_rvals 01350 01351 ! ***************************************************************************** 01352 FUNCTION section_get_ival(section_vals,keyword_name,error) RESULT(res) 01353 01354 TYPE(section_vals_type), POINTER :: section_vals 01355 CHARACTER(len=*), INTENT(in) :: keyword_name 01356 TYPE(cp_error_type), INTENT(inout) :: error 01357 INTEGER :: res 01358 01359 CALL section_vals_val_get(section_vals, keyword_name, i_val=res, error=error) 01360 01361 END FUNCTION section_get_ival 01362 01363 ! ***************************************************************************** 01364 FUNCTION section_get_ivals(section_vals,keyword_name,error) RESULT(res) 01365 01366 TYPE(section_vals_type), POINTER :: section_vals 01367 CHARACTER(len=*), INTENT(in) :: keyword_name 01368 TYPE(cp_error_type), INTENT(inout) :: error 01369 INTEGER, DIMENSION(:), POINTER :: res 01370 01371 CALL section_vals_val_get(section_vals, keyword_name, i_vals=res, error=error) 01372 01373 END FUNCTION section_get_ivals 01374 01375 ! ***************************************************************************** 01376 FUNCTION section_get_lval(section_vals,keyword_name,error) RESULT(res) 01377 01378 TYPE(section_vals_type), POINTER :: section_vals 01379 CHARACTER(len=*), INTENT(in) :: keyword_name 01380 TYPE(cp_error_type), INTENT(inout) :: error 01381 LOGICAL :: res 01382 01383 CALL section_vals_val_get(section_vals, keyword_name, l_val=res, error=error) 01384 01385 END FUNCTION section_get_lval 01386 01387 ! ***************************************************************************** 01404 SUBROUTINE section_vals_val_get(section_vals,keyword_name,i_rep_section,& 01405 i_rep_val,n_rep_val,val,l_val,i_val,r_val,c_val,l_vals,i_vals,r_vals,& 01406 c_vals,ignore_required,explicit,error) 01407 TYPE(section_vals_type), POINTER :: section_vals 01408 CHARACTER(len=*), INTENT(in) :: keyword_name 01409 INTEGER, INTENT(in), OPTIONAL :: i_rep_section, i_rep_val 01410 INTEGER, INTENT(out), OPTIONAL :: n_rep_val 01411 TYPE(val_type), OPTIONAL, POINTER :: val 01412 LOGICAL, INTENT(out), OPTIONAL :: l_val 01413 INTEGER, INTENT(out), OPTIONAL :: i_val 01414 REAL(KIND=DP), INTENT(out), OPTIONAL :: r_val 01415 CHARACTER(LEN=*), INTENT(out), OPTIONAL :: c_val 01416 LOGICAL, DIMENSION(:), OPTIONAL, POINTER :: l_vals 01417 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: i_vals 01418 REAL(KIND=DP), DIMENSION(:), OPTIONAL, 01419 POINTER :: r_vals 01420 CHARACTER(LEN=DEFAULT_STRING_LENGTH), 01421 DIMENSION(:), OPTIONAL, POINTER :: c_vals 01422 LOGICAL, INTENT(in), OPTIONAL :: ignore_required 01423 LOGICAL, INTENT(out), OPTIONAL :: explicit 01424 TYPE(cp_error_type), INTENT(inout) :: error 01425 01426 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_val_get', 01427 routineP = moduleN//':'//routineN 01428 01429 INTEGER :: ik, irk, irs, len_key, 01430 my_index, tmp_index 01431 LOGICAL :: failure, my_ignore_required, 01432 valRequested 01433 TYPE(cp_error_type) :: sub_error 01434 TYPE(cp_sll_val_type), POINTER :: vals 01435 TYPE(keyword_type), POINTER :: keyword 01436 TYPE(section_type), POINTER :: section 01437 TYPE(section_vals_type), POINTER :: s_vals 01438 TYPE(val_type), POINTER :: my_val 01439 01440 failure=.FALSE. 01441 01442 CPPrecondition(ASSOCIATED(section_vals),cp_failure_level,routineP,error,failure) 01443 CPPrecondition(section_vals%ref_count>0,cp_failure_level,routineP,error,failure) 01444 01445 my_ignore_required=.FALSE. 01446 IF (PRESENT(ignore_required)) my_ignore_required=ignore_required 01447 my_index=INDEX(keyword_name,'%')+1 01448 len_key=LEN_TRIM(keyword_name) 01449 IF (my_index>1) THEN 01450 DO 01451 tmp_index=INDEX(keyword_name(my_index:len_key),"%") 01452 IF (tmp_index<=0) EXIT 01453 my_index=my_index+tmp_index 01454 END DO 01455 s_vals => section_vals_get_subs_vals(section_vals,keyword_name(1:my_index-2),& 01456 error=error) 01457 ELSE 01458 s_vals=> section_vals 01459 END IF 01460 01461 irk=1 01462 irs=1 01463 IF (PRESENT(i_rep_section)) irs=i_rep_section 01464 IF (PRESENT(i_rep_val)) irk=i_rep_val 01465 IF (PRESENT(val)) NULLIFY(val) 01466 IF (PRESENT(explicit)) explicit = .FALSE. 01467 section => s_vals%section 01468 valRequested=PRESENT(l_val).or.PRESENT(i_val).or.PRESENT(r_val).OR.& 01469 PRESENT(c_val).OR.PRESENT(l_vals).or.PRESENT(i_vals).OR.& 01470 PRESENT(r_vals).OR.PRESENT(c_vals) 01471 IF (.NOT. failure) THEN 01472 ik=section_get_keyword_index(s_vals%section,keyword_name(my_index:len_key),error=error) 01473 CALL cp_assert(ik/=-2,cp_failure_level,cp_assertion_failed,routineP,& 01474 "section "//TRIM(section%name)//" does not contain keyword "//& 01475 TRIM(keyword_name(my_index:len_key)),error,failure) 01476 IF (.NOT.failure) THEN 01477 keyword => section%keywords(ik)%keyword 01478 END IF 01479 CALL cp_assert(irs>0.AND.irs<=SIZE(s_vals%subs_vals,2),& 01480 cp_failure_level,cp_assertion_failed,routineP,& 01481 "section repetition requested ("//cp_to_string(irs)//& 01482 ") out of bounds (1:"//cp_to_string(SIZE(s_vals%subs_vals,2))& 01483 //")",error,failure) 01484 NULLIFY(my_val) 01485 END IF 01486 IF (.NOT.failure) THEN 01487 IF (PRESENT(n_rep_val)) n_rep_val=0 01488 IF (irs<=SIZE(s_vals%values,2)) THEN ! the section was parsed 01489 vals => s_vals%values(ik,irs)%list 01490 IF (PRESENT(n_rep_val)) n_rep_val=cp_sll_val_get_length(vals,error=error) 01491 IF (.NOT.ASSOCIATED(vals)) THEN 01492 ! this keyword was not parsed 01493 IF ((.NOT.keyword%required.or.my_ignore_required)& 01494 .AND. ASSOCIATED(keyword%default_value)) THEN 01495 my_val => keyword%default_value 01496 IF (PRESENT(n_rep_val)) n_rep_val=1 01497 END IF 01498 ELSE 01499 my_val => cp_sll_val_get_el_at(s_vals%values(ik,irs)%list,& 01500 irk,error=error) 01501 IF (PRESENT(explicit)) explicit = .TRUE. 01502 END IF 01503 ELSE IF (.NOT.my_ignore_required.AND.section%required) THEN 01504 CALL cp_assert(.FALSE.,& 01505 cp_failure_level,cp_assertion_failed,routineP,& 01506 "section "//TRIM(section%name)//& 01507 " is required, and needed but was not found",& 01508 error,failure) 01509 ELSE IF ((my_ignore_required.or..NOT.keyword%required).AND.& 01510 ASSOCIATED(keyword%default_value)) THEN 01511 IF (PRESENT(n_rep_val)) n_rep_val=1 01512 my_val => keyword%default_value 01513 END IF 01514 IF (PRESENT(val)) val => my_val 01515 END IF 01516 IF (.NOT.failure) THEN 01517 IF (valRequested) THEN 01518 CALL cp_assert(ASSOCIATED(my_val),cp_failure_level,cp_assertion_failed,& 01519 routineP,"Value requested, but no value set getting value from "//& 01520 "keyword "//TRIM(keyword_name(my_index:len_key))//" of section "//& 01521 TRIM(section%name),error,failure) 01522 CALL cp_error_init(sub_error,template_error=error,stop_level=cp_fatal_level) 01523 CALL val_get(my_val,l_val=l_val,i_val=i_val,r_val=r_val,& 01524 c_val=c_val,l_vals=l_vals,i_vals=i_vals,r_vals=r_vals,& 01525 c_vals=c_vals,error=sub_error) 01526 CALL cp_error_propagate_error(sub_error,routineP,& 01527 "getting value from keyword "//TRIM(keyword_name(my_index:len_key))//" of section "//& 01528 TRIM(section%name),error=error,failure=failure) 01529 CALL cp_error_dealloc_ref(sub_error) 01530 END IF 01531 01532 END IF 01533 END SUBROUTINE section_vals_val_get 01534 01535 ! ***************************************************************************** 01545 SUBROUTINE section_vals_list_get(section_vals,keyword_name,i_rep_section,& 01546 list,error) 01547 TYPE(section_vals_type), POINTER :: section_vals 01548 CHARACTER(len=*), INTENT(in) :: keyword_name 01549 INTEGER, OPTIONAL :: i_rep_section 01550 TYPE(cp_sll_val_type), POINTER :: list 01551 TYPE(cp_error_type), INTENT(inout) :: error 01552 01553 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_list_get', 01554 routineP = moduleN//':'//routineN 01555 01556 INTEGER :: ik, irs, len_key, my_index, 01557 tmp_index 01558 LOGICAL :: failure 01559 TYPE(section_type), POINTER :: section 01560 TYPE(section_vals_type), POINTER :: s_vals 01561 01562 failure=.FALSE. 01563 01564 CPPrecondition(ASSOCIATED(section_vals),cp_failure_level,routineP,error,failure) 01565 CPPrecondition(section_vals%ref_count>0,cp_failure_level,routineP,error,failure) 01566 NULLIFY(list) 01567 my_index=INDEX(keyword_name,'%')+1 01568 len_key=LEN_TRIM(keyword_name) 01569 IF (my_index>1) THEN 01570 DO 01571 tmp_index=INDEX(keyword_name(my_index:len_key),"%") 01572 IF (tmp_index<=0) EXIT 01573 my_index=my_index+tmp_index 01574 END DO 01575 s_vals => section_vals_get_subs_vals(section_vals,keyword_name(1:my_index-2),& 01576 error=error) 01577 ELSE 01578 s_vals=> section_vals 01579 END IF 01580 01581 irs=1 01582 IF (PRESENT(i_rep_section)) irs=i_rep_section 01583 section => s_vals%section 01584 IF (.NOT. failure) THEN 01585 ik=section_get_keyword_index(s_vals%section,keyword_name(my_index:len_key),error=error) 01586 CALL cp_assert(ik/=-2,cp_failure_level,cp_assertion_failed,routineP,& 01587 "section "//TRIM(section%name)//" does not contain keyword "//& 01588 TRIM(keyword_name(my_index:len_key)),error,failure) 01589 CALL cp_assert(irs>0.AND.irs<=SIZE(s_vals%subs_vals,2),& 01590 cp_failure_level,cp_assertion_failed,routineP,& 01591 "section repetition requested ("//cp_to_string(irs)//& 01592 ") out of bounds (1:"//cp_to_string(SIZE(s_vals%subs_vals,2))& 01593 //")",error,failure) 01594 END IF 01595 IF (.NOT. failure) THEN 01596 list => s_vals%values(ik,irs)%list 01597 ENDIF 01598 01599 END SUBROUTINE section_vals_list_get 01600 01601 ! ***************************************************************************** 01618 SUBROUTINE section_vals_val_set(section_vals,keyword_name,i_rep_section,i_rep_val,& 01619 val,l_val,i_val,r_val,c_val,l_vals_ptr,i_vals_ptr,r_vals_ptr,c_vals_ptr,& 01620 ignore_required,error) 01621 TYPE(section_vals_type), POINTER :: section_vals 01622 CHARACTER(len=*), INTENT(in) :: keyword_name 01623 INTEGER, INTENT(in), OPTIONAL :: i_rep_section, i_rep_val 01624 TYPE(val_type), OPTIONAL, POINTER :: val 01625 LOGICAL, INTENT(in), OPTIONAL :: l_val 01626 INTEGER, INTENT(in), OPTIONAL :: i_val 01627 REAL(KIND=DP), INTENT(in), OPTIONAL :: r_val 01628 CHARACTER(LEN=*), INTENT(in), OPTIONAL :: c_val 01629 LOGICAL, DIMENSION(:), OPTIONAL, POINTER :: l_vals_ptr 01630 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: i_vals_ptr 01631 REAL(KIND=DP), DIMENSION(:), OPTIONAL, 01632 POINTER :: r_vals_ptr 01633 CHARACTER(LEN=DEFAULT_STRING_LENGTH), 01634 DIMENSION(:), OPTIONAL, POINTER :: c_vals_ptr 01635 LOGICAL, INTENT(in), OPTIONAL :: ignore_required 01636 TYPE(cp_error_type), INTENT(inout) :: error 01637 01638 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_val_set', 01639 routineP = moduleN//':'//routineN 01640 01641 INTEGER :: ik, irk, irs, len_key, 01642 my_index, tmp_index 01643 LOGICAL :: failure, my_ignore_required, 01644 valSet 01645 TYPE(cp_error_type) :: sub_error 01646 TYPE(cp_sll_val_type), POINTER :: vals 01647 TYPE(keyword_type), POINTER :: keyword 01648 TYPE(section_type), POINTER :: section 01649 TYPE(section_vals_type), POINTER :: s_vals 01650 TYPE(val_type), POINTER :: my_val, old_val 01651 01652 failure=.FALSE. 01653 01654 CPPrecondition(ASSOCIATED(section_vals),cp_failure_level,routineP,error,failure) 01655 CPPrecondition(section_vals%ref_count>0,cp_failure_level,routineP,error,failure) 01656 01657 my_ignore_required=.FALSE. 01658 IF (PRESENT(ignore_required)) my_ignore_required=ignore_required 01659 my_index=INDEX(keyword_name,'%')+1 01660 len_key=LEN_TRIM(keyword_name) 01661 IF (my_index>1) THEN 01662 DO 01663 tmp_index=INDEX(keyword_name(my_index:len_key),"%") 01664 IF (tmp_index<=0) EXIT 01665 my_index=my_index+tmp_index 01666 END DO 01667 s_vals => section_vals_get_subs_vals(section_vals,keyword_name(1:my_index-2),& 01668 error=error) 01669 ELSE 01670 s_vals=> section_vals 01671 END IF 01672 01673 irk=1 01674 irs=1 01675 IF (PRESENT(i_rep_section)) irs=i_rep_section 01676 IF (PRESENT(i_rep_val)) irk=i_rep_val 01677 section => s_vals%section 01678 IF (.NOT. failure) THEN 01679 ik=section_get_keyword_index(s_vals%section,keyword_name(my_index:len_key),error=error) 01680 CALL cp_assert(ik/=-2,cp_failure_level,cp_assertion_failed,routineP,& 01681 "section "//TRIM(section%name)//" does not contain keyword "//& 01682 TRIM(keyword_name(my_index:len_key)),error,failure) 01683 ! Add values.. 01684 DO 01685 IF (irs<=SIZE(s_vals%values,2)) EXIT 01686 CALL section_vals_add_values(s_vals,error=error) 01687 END DO 01688 CALL cp_assert(irs>0.AND.irs<=SIZE(s_vals%subs_vals,2),& 01689 cp_failure_level,cp_assertion_failed,routineP,& 01690 "section repetition requested ("//cp_to_string(irs)//& 01691 ") out of bounds (1:"//cp_to_string(SIZE(s_vals%subs_vals,2))& 01692 //")",error,failure) 01693 END IF 01694 IF (.NOT.failure) THEN 01695 keyword => s_vals%section%keywords(ik)%keyword 01696 NULLIFY(my_val) 01697 IF (PRESENT(val)) my_val => val 01698 valSet=PRESENT(l_val).OR.PRESENT(i_val).OR.PRESENT(r_val).OR.& 01699 PRESENT(c_val).OR.PRESENT(l_vals_ptr).OR.PRESENT(i_vals_ptr).OR.& 01700 PRESENT(r_vals_ptr).OR.PRESENT(c_vals_ptr) 01701 IF (ASSOCIATED(my_val)) THEN 01702 ! check better? 01703 CALL cp_assert(.NOT.valSet,& 01704 cp_failure_level,cp_assertion_failed,routineP,& 01705 " both val and values present, in setting "//& 01706 "keyword "//TRIM(keyword_name(my_index:len_key))//" of section "//& 01707 TRIM(section%name),error,failure) 01708 ELSE 01709 ! ignore ? 01710 CALL cp_assert(valSet,& 01711 cp_failure_level,cp_assertion_failed,routineP,& 01712 " empty value in setting "//& 01713 "keyword "//TRIM(keyword_name(my_index:len_key))//" of section "//& 01714 TRIM(section%name),error,failure) 01715 CPPrecondition(valSet,cp_failure_level,routineP,error,failure) 01716 CALL cp_error_init(sub_error,template_error=error,& 01717 stop_level=cp_fatal_level) 01718 IF (keyword%type_of_var==lchar_t) THEN 01719 CALL val_create(my_val, lc_val=c_val, lc_vals_ptr=c_vals_ptr,& 01720 error=sub_error) 01721 ELSE 01722 CALL val_create(my_val,l_val=l_val,i_val=i_val,r_val=r_val,& 01723 c_val=c_val,l_vals_ptr=l_vals_ptr,i_vals_ptr=i_vals_ptr,& 01724 r_vals_ptr=r_vals_ptr,& 01725 c_vals_ptr=c_vals_ptr,enum=keyword%enum,error=sub_error) 01726 END IF 01727 CPPostcondition(ASSOCIATED(my_val),cp_failure_level,routineP,sub_error,failure) 01728 CPPostcondition(my_val%type_of_var==keyword%type_of_var,cp_failure_level,routineP,error,failure) 01729 CALL cp_error_propagate_error(sub_error,routineP,& 01730 "setting value from keyword "//TRIM(keyword_name(my_index:len_key))//& 01731 " of section "// TRIM(section%name),error=error,failure=failure) 01732 CALL cp_error_dealloc_ref(sub_error) 01733 END IF 01734 END IF 01735 IF (.NOT.failure) THEN 01736 vals => s_vals%values(ik,irs)%list 01737 IF (irk==-1) THEN 01738 CALL cp_sll_val_insert_el_at(vals,my_val,index=-1,error=error) 01739 ELSE IF (irk <= cp_sll_val_get_length(vals,error)) THEN 01740 CALL cp_assert(irk>0,cp_failure_level,cp_assertion_failed,& 01741 routineP,"invalid irk "//TRIM(ADJUSTL(cp_to_string(irk)))//& 01742 " in keyword "//TRIM(keyword_name(my_index:len_key))//" of section "//& 01743 TRIM(section%name),& 01744 error,failure) 01745 old_val => cp_sll_val_get_el_at(vals,index=irk,error=error) 01746 CALL val_release(old_val,error=error) 01747 CALL cp_sll_val_set_el_at(vals,value=my_val,index=irk,error=error) 01748 ELSE IF (irk>cp_sll_val_get_length(vals,error)+1) THEN 01749 ! change? 01750 CALL cp_assert(.FALSE.,cp_failure_level,cp_assertion_failed,& 01751 routineP,"cannot add extra keyword repetitions to keyword"& 01752 //TRIM(keyword_name(my_index:len_key))//" of section "//& 01753 TRIM(section%name),error,failure) 01754 ELSE 01755 CALL cp_sll_val_insert_el_at(vals,my_val,index=irk,error=error) 01756 END IF 01757 s_vals%values(ik,irs)%list => vals 01758 NULLIFY(my_val) 01759 END IF 01760 END SUBROUTINE section_vals_val_set 01761 01762 ! ***************************************************************************** 01777 SUBROUTINE section_vals_val_unset(section_vals,keyword_name,i_rep_section,& 01778 i_rep_val,error) 01779 TYPE(section_vals_type), POINTER :: section_vals 01780 CHARACTER(len=*), INTENT(in) :: keyword_name 01781 INTEGER, INTENT(in), OPTIONAL :: i_rep_section, i_rep_val 01782 TYPE(cp_error_type), INTENT(inout) :: error 01783 01784 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_val_unset', 01785 routineP = moduleN//':'//routineN 01786 01787 INTEGER :: ik, irk, irs, len_key, 01788 my_index, tmp_index 01789 LOGICAL :: failure 01790 TYPE(cp_sll_val_type), POINTER :: pos 01791 TYPE(section_type), POINTER :: section 01792 TYPE(section_vals_type), POINTER :: s_vals 01793 TYPE(val_type), POINTER :: old_val 01794 01795 failure=.FALSE. 01796 NULLIFY(pos) 01797 CPPrecondition(ASSOCIATED(section_vals),cp_failure_level,routineP,error,failure) 01798 CPPrecondition(section_vals%ref_count>0,cp_failure_level,routineP,error,failure) 01799 01800 my_index=INDEX(keyword_name,'%')+1 01801 len_key=LEN_TRIM(keyword_name) 01802 IF (my_index>1) THEN 01803 DO 01804 tmp_index=INDEX(keyword_name(my_index:len_key),"%") 01805 IF (tmp_index<=0) EXIT 01806 my_index=my_index+tmp_index 01807 END DO 01808 s_vals => section_vals_get_subs_vals(section_vals,keyword_name(1:my_index-2),& 01809 error=error) 01810 ELSE 01811 s_vals=> section_vals 01812 END IF 01813 01814 irk=1 01815 irs=1 01816 IF (PRESENT(i_rep_section)) irs=i_rep_section 01817 IF (PRESENT(i_rep_val)) irk=i_rep_val 01818 section => s_vals%section 01819 IF (.NOT. failure) THEN 01820 ik=section_get_keyword_index(s_vals%section,keyword_name(my_index:len_key),error=error) 01821 CALL cp_assert(ik/=-2,cp_failure_level,cp_assertion_failed,routineP,& 01822 "section "//TRIM(section%name)//" does not contain keyword "//& 01823 TRIM(keyword_name(my_index:len_key)),error,failure) 01824 END IF 01825 IF (.NOT.failure) THEN 01826 ! ignore unset of non set values 01827 IF (irs<=SIZE(s_vals%values,2)) THEN 01828 CALL cp_assert(irs>0.AND.irs<=SIZE(s_vals%subs_vals,2),& 01829 cp_failure_level,cp_assertion_failed,routineP,& 01830 "section repetition requested ("//cp_to_string(irs)//& 01831 ") out of bounds (1:"//cp_to_string(SIZE(s_vals%subs_vals,2))& 01832 //")",error,failure) 01833 IF (irk==-1) THEN 01834 pos => cp_sll_val_get_rest(s_vals%values(ik,irs)%list, iter=-1,error=error) 01835 ELSE 01836 pos => cp_sll_val_get_rest(s_vals%values(ik,irs)%list, iter=irk-1,error=error) 01837 END IF 01838 IF (ASSOCIATED(pos)) THEN 01839 old_val => cp_sll_val_get_el_at(s_vals%values(ik,irs)%list,index=irk,& 01840 error=error) 01841 CALL val_release(old_val,error=error) 01842 CALL cp_sll_val_rm_el_at(s_vals%values(ik,irs)%list,index=irk,& 01843 error=error) 01844 END IF 01845 END IF 01846 END IF 01847 01848 END SUBROUTINE section_vals_val_unset 01849 01850 ! ***************************************************************************** 01861 RECURSIVE SUBROUTINE section_vals_check_release(section_vals,enable_unsupported_features,error) 01862 TYPE(section_vals_type), POINTER :: section_vals 01863 LOGICAL, INTENT(IN) :: enable_unsupported_features 01864 TYPE(cp_error_type), INTENT(inout) :: error 01865 01866 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_check_release', 01867 routineP = moduleN//':'//routineN 01868 01869 INTEGER :: i_rep_s, ik, isec, nr, nval, 01870 output_unit 01871 LOGICAL :: check_key, defaultSection, 01872 failure 01873 TYPE(cp_error_type) :: suberror 01874 TYPE(cp_logger_type), POINTER :: logger 01875 TYPE(cp_sll_val_type), POINTER :: new_pos, vals 01876 TYPE(keyword_type), POINTER :: keyword 01877 TYPE(section_type), POINTER :: section 01878 TYPE(section_vals_type), POINTER :: sval 01879 01880 failure=.FALSE. 01881 NULLIFY(logger) 01882 logger => cp_error_get_logger(error) 01883 output_unit= cp_logger_get_default_io_unit(logger) 01884 01885 CPPrecondition(ASSOCIATED(section_vals),cp_failure_level,routineP,error,failure) 01886 CPPrecondition(section_vals%ref_count>0,cp_failure_level,routineP,error,failure) 01887 CALL cp_error_init(suberror,template_error=error) 01888 IF (.NOT. failure) THEN 01889 CALL section_vals_get(section_vals, n_repetition=nr, section=section, error=error) 01890 DO i_rep_s=1,nr 01891 defaultSection=(SIZE(section_vals%values,2)==0) 01892 IF (.NOT.(section%required.AND.defaultSection)) THEN 01893 IF (.NOT.section%supported_feature) THEN 01894 IF (output_unit>0) THEN 01895 WRITE(output_unit,'(/)') 01896 WRITE(output_unit,'(T2,"RELEASE_ERROR|",1X,A)')& 01897 "Section <"//TRIM(section%name)//"> is not supported for CP2K release version." 01898 IF (enable_unsupported_features) THEN 01899 WRITE(output_unit,'(T2,"RELEASE_ERROR|",1X,A)')& 01900 "Calculation continues but the results could be totally meaningless!" 01901 ELSE 01902 WRITE(output_unit,'(T2,"RELEASE_ERROR|",1X,A)')& 01903 "You may consider to enable the keyword: GLOBAL%ENABLE_UNSUPPORTED_FEATURES or" 01904 WRITE(output_unit,'(T2,"RELEASE_ERROR|",1X,A)')"download a Development Version!" 01905 END IF 01906 END IF 01907 IF (.NOT.enable_unsupported_features) failure = .TRUE. 01908 END IF 01909 DO ik=-1,section%n_keywords 01910 keyword => section%keywords(ik)%keyword 01911 IF (ASSOCIATED(keyword)) THEN 01912 CALL section_vals_val_get(section_vals,keyword%names(1),i_rep_s,n_rep_val=nval,error=error) 01913 check_key = .FALSE. 01914 IF (i_rep_s<=SIZE(section_vals%values,2)) THEN 01915 vals => section_vals%values(ik,i_rep_s)%list 01916 new_pos => vals 01917 IF (ASSOCIATED(new_pos)) THEN 01918 ! Keyword was parsed 01919 check_key = .TRUE. 01920 END IF 01921 ELSEIF (.NOT.keyword%required.AND.ASSOCIATED(keyword%default_value)) THEN 01922 ! Keyword was not parsed but a default value is present 01923 check_key = .TRUE. 01924 END IF 01925 IF ((check_key).AND.(.NOT.keyword%supported_feature)) THEN 01926 IF (output_unit>0) THEN 01927 WRITE(output_unit,'(T2,"RELEASE_ERROR|",2X,A)')& 01928 "Keyword <"//TRIM(keyword%names(1))//"> is not supported for CP2K release version." 01929 IF (enable_unsupported_features) THEN 01930 WRITE(output_unit,'(T2,"RELEASE_ERROR|",2X,A)')& 01931 "Calculation continues but the results could be totally meaningless!" 01932 ELSE 01933 WRITE(output_unit,'(T2,"RELEASE_ERROR|",2X,A)')& 01934 "You may consider to enable the keyword: GLOBAL%ENABLE_UNSUPPORTED_FEATURES or" 01935 WRITE(output_unit,'(T2,"RELEASE_ERROR|",2X,A)')"download a Development Version!" 01936 END IF 01937 END IF 01938 IF (.NOT.enable_unsupported_features) failure = .TRUE. 01939 END IF 01940 END IF 01941 END DO 01942 IF (.NOT.failure) THEN 01943 IF (ASSOCIATED(section_vals%subs_vals)) THEN 01944 DO isec=1,SIZE(section_vals%subs_vals,1) 01945 sval => section_vals%subs_vals(isec,i_rep_s)%section_vals 01946 IF (ASSOCIATED(sval)) THEN 01947 ! Section was parsed 01948 CALL section_vals_check_release(sval,enable_unsupported_features,error) 01949 END IF 01950 END DO 01951 END IF 01952 END IF 01953 CPPrecondition(.NOT.failure,cp_failure_level,routineP,error,failure) 01954 END IF 01955 END DO 01956 END IF 01957 CALL cp_error_dealloc_ref(suberror) 01958 01959 END SUBROUTINE section_vals_check_release 01960 01961 ! ***************************************************************************** 01972 RECURSIVE SUBROUTINE section_vals_write(section_vals,unit_nr,hide_root,hide_defaults,error) 01973 TYPE(section_vals_type), POINTER :: section_vals 01974 INTEGER, INTENT(in) :: unit_nr 01975 LOGICAL, INTENT(in), OPTIONAL :: hide_root, hide_defaults 01976 TYPE(cp_error_type), INTENT(inout) :: error 01977 01978 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_write', 01979 routineP = moduleN//':'//routineN 01980 01981 CHARACTER(len=default_string_length) :: myfmt 01982 INTEGER :: i_rep_s, ik, isec, ival, nr, 01983 nval 01984 INTEGER, SAVE :: indent = 1 01985 LOGICAL :: defaultSection, explicit, 01986 failure, my_hide_defaults, 01987 my_hide_root 01988 TYPE(cp_error_type) :: suberror 01989 TYPE(cp_sll_val_type), POINTER :: new_pos, vals 01990 TYPE(keyword_type), POINTER :: keyword 01991 TYPE(section_type), POINTER :: section 01992 TYPE(section_vals_type), POINTER :: sval 01993 TYPE(val_type), POINTER :: val 01994 01995 failure=.FALSE. 01996 my_hide_root=.FALSE. 01997 my_hide_defaults=.TRUE. 01998 IF (PRESENT(hide_root)) my_hide_root=hide_root 01999 IF (PRESENT(hide_defaults)) my_hide_defaults=hide_defaults 02000 02001 CPPrecondition(ASSOCIATED(section_vals),cp_failure_level,routineP,error,failure) 02002 CPPrecondition(section_vals%ref_count>0,cp_failure_level,routineP,error,failure) 02003 CALL cp_error_init(suberror,template_error=error) 02004 IF ((.NOT.failure).AND.(unit_nr>0)) THEN 02005 CALL section_vals_get(section_vals, explicit=explicit, n_repetition=nr, section=section,& 02006 error=error) 02007 IF (explicit.OR.(.NOT.my_hide_defaults)) THEN 02008 DO i_rep_s=1,nr 02009 IF (.NOT.my_hide_root) THEN 02010 WRITE(myfmt,*)indent,"X" 02011 CALL compress(myfmt,full=.TRUE.) 02012 IF (ASSOCIATED(section%keywords(-1)%keyword)) THEN 02013 WRITE(unit=unit_nr,fmt="("//TRIM(myfmt)//",'&',a,' ')",advance="NO") TRIM(section%name) 02014 ELSE 02015 WRITE(unit=unit_nr,fmt="("//TRIM(myfmt)//",'&',a)") TRIM(section%name) 02016 END IF 02017 END IF 02018 defaultSection=(SIZE(section_vals%values,2)==0) 02019 IF (.NOT.(section%required.AND.defaultSection)) THEN 02020 IF (.NOT.my_hide_root) indent = indent + 2 02021 WRITE(myfmt,*)indent,"X" 02022 CALL compress(myfmt,full=.TRUE.) 02023 DO ik=-1,section%n_keywords 02024 keyword => section%keywords(ik)%keyword 02025 IF (ASSOCIATED(keyword)) THEN 02026 IF (keyword%type_of_var/=no_t.AND.keyword%names(1)(1:2)/="__") THEN 02027 CALL section_vals_val_get(section_vals,keyword%names(1),& 02028 i_rep_s,n_rep_val=nval,error=error) 02029 IF (i_rep_s<=SIZE(section_vals%values,2)) THEN 02030 ! Section was parsed 02031 vals => section_vals%values(ik,i_rep_s)%list 02032 DO ival=1,nval 02033 IF (ival==1) THEN 02034 new_pos => vals 02035 ELSE 02036 new_pos => new_pos%rest 02037 END IF 02038 IF (.NOT.ASSOCIATED(new_pos)) THEN 02039 ! this keyword was not parsed 02040 IF (.NOT.keyword%required.AND. ASSOCIATED(keyword%default_value)) THEN 02041 val => keyword%default_value 02042 IF (my_hide_defaults) CYCLE 02043 END IF 02044 ELSE 02045 val => new_pos%first_el 02046 END IF 02047 CALL cp_error_propagate_error(suberror, fromWhere=routineP,& 02048 message="for val "// TRIM(keyword%names(1))//" in section "//& 02049 TRIM(section%name),error=error, failure=failure) 02050 IF (keyword%names(1)/='_DEFAULT_KEYWORD_'.AND.& 02051 keyword%names(1)/='_SECTION_PARAMETERS_') THEN 02052 WRITE(unit=unit_nr,fmt="("//TRIM(myfmt)//",a,' ')",advance="NO")& 02053 TRIM(keyword%names(1)) 02054 ELSEIF (keyword%names(1) =='_DEFAULT_KEYWORD_' .AND.& 02055 keyword%type_of_var/=lchar_t) THEN 02056 WRITE(unit=unit_nr,fmt="("//TRIM(myfmt)//")",advance="NO") 02057 END IF 02058 CALL val_write(val,unit_nr=unit_nr,unit=keyword%unit,& 02059 fmt=myfmt,error=suberror) 02060 CALL cp_error_propagate_error(suberror, fromWhere=routineP,& 02061 message="for val "// TRIM(keyword%names(1))//" in section "//& 02062 TRIM(section%name),error=error, failure=failure) 02063 IF (failure) EXIT 02064 END DO 02065 ELSEIF (.NOT.keyword%required.AND. ASSOCIATED(keyword%default_value)) THEN 02066 ! Section was not parsed but default for the keywords may exist 02067 IF (my_hide_defaults) CYCLE 02068 val => keyword%default_value 02069 CALL cp_error_propagate_error(suberror, fromWhere=routineP,& 02070 message="for val "// TRIM(keyword%names(1))//" in section "//& 02071 TRIM(section%name),error=error, failure=failure) 02072 IF (keyword%names(1)/='_DEFAULT_KEYWORD_'.AND.& 02073 keyword%names(1)/='_SECTION_PARAMETERS_') THEN 02074 WRITE(unit=unit_nr,fmt="("//TRIM(myfmt)//",a,' ')",advance="NO")& 02075 TRIM(keyword%names(1)) 02076 ELSEIF (keyword%names(1) =='_DEFAULT_KEYWORD_' .AND.& 02077 keyword%type_of_var/=lchar_t) THEN 02078 WRITE(unit=unit_nr,fmt="("//TRIM(myfmt)//")",advance="NO") 02079 END IF 02080 CALL val_write(val,unit_nr=unit_nr,unit=keyword%unit,& 02081 fmt=myfmt,error=suberror) 02082 CALL cp_error_propagate_error(suberror, fromWhere=routineP,& 02083 message="for val "// TRIM(keyword%names(1))//" in section "//& 02084 TRIM(section%name),error=error, failure=failure) 02085 IF (failure) EXIT 02086 END IF 02087 END IF 02088 END IF 02089 IF (failure) EXIT 02090 END DO 02091 IF (.NOT.failure) THEN 02092 IF (ASSOCIATED(section_vals%subs_vals)) THEN 02093 DO isec=1,SIZE(section_vals%subs_vals,1) 02094 sval => section_vals%subs_vals(isec,i_rep_s)%section_vals 02095 IF (ASSOCIATED(sval)) THEN 02096 CALL section_vals_write(sval,unit_nr=unit_nr,hide_defaults=hide_defaults,error=error) 02097 END IF 02098 END DO 02099 END IF 02100 END IF 02101 END IF 02102 IF (.NOT.my_hide_root) THEN 02103 indent = indent - 2 02104 WRITE (UNIT=unit_nr,FMT="(A)")& 02105 REPEAT(" ",indent)//"&END "//TRIM(section%name) 02106 END IF 02107 END DO 02108 END IF 02109 END IF 02110 CALL cp_error_dealloc_ref(suberror) 02111 02112 END SUBROUTINE section_vals_write 02113 02114 ! ***************************************************************************** 02117 RECURSIVE SUBROUTINE write_section_xml(section,level,unit_number,error) 02118 02119 TYPE(section_type), POINTER :: section 02120 INTEGER, INTENT(IN) :: level, unit_number 02121 TYPE(cp_error_type), INTENT(INOUT) :: error 02122 02123 CHARACTER(LEN=*), PARAMETER :: routineN = 'write_section_xml', 02124 routineP = moduleN//':'//routineN 02125 02126 CHARACTER(LEN=3) :: repeats, required 02127 CHARACTER(LEN=8) :: short_string 02128 CHARACTER(LEN=MAX(& description_string_length, & max_line_length)) :: string 02129 INTEGER :: i, l0, l1, l2 02130 LOGICAL :: failure 02131 02132 failure = .FALSE. 02133 02134 IF (ASSOCIATED(section)) THEN 02135 02136 CPPrecondition(section%ref_count>0,cp_failure_level,routineP,error,failure) 02137 02138 ! Indentation for current level, next level, etc. 02139 02140 l0 = level 02141 l1 = level + 1 02142 l2 = level + 2 02143 02144 IF (section%required) THEN 02145 required = "yes" 02146 ELSE 02147 required = "no " 02148 END IF 02149 02150 IF (section%repeats) THEN 02151 repeats = "yes" 02152 ELSE 02153 repeats = "no " 02154 END IF 02155 02156 CALL substitute_special_xml_tokens(section%description,string,ltu=.FALSE.) 02157 02158 WRITE (UNIT=unit_number,FMT="(A)")& 02159 REPEAT(" ",l0)//"<SECTION required="""//TRIM(required)//& 02160 """ repeats="""//TRIM(repeats)//""">",& 02161 REPEAT(" ",l1)//"<NAME>"//TRIM(section%name)//"</NAME>",& 02162 REPEAT(" ",l1)//"<DESCRIPTION>"//TRIM(string)//"</DESCRIPTION>" 02163 02164 IF (ASSOCIATED(section%citations)) THEN 02165 DO i=1,SIZE(section%citations,1) 02166 short_string = "" 02167 WRITE (UNIT=short_string,FMT="(I8)") section%citations(i) 02168 WRITE (UNIT=unit_number,FMT="(A)")& 02169 REPEAT(" ",l1)//"<REFERENCE>",& 02170 REPEAT(" ",l2)//"<NAME>"//TRIM(get_citation_key(section%citations(i)))//"</NAME>",& 02171 REPEAT(" ",l2)//"<NUMBER>"//TRIM(ADJUSTL(short_string))//"</NUMBER>",& 02172 REPEAT(" ",l1)//"</REFERENCE>" 02173 END DO 02174 END IF 02175 02176 DO i=-1,section%n_keywords 02177 IF (ASSOCIATED(section%keywords(i)%keyword)) THEN 02178 CALL write_keyword_xml(section%keywords(i)%keyword,l1,unit_number,& 02179 error) 02180 END IF 02181 END DO 02182 02183 DO i=1,section%n_subsections 02184 CALL write_section_xml(section%subsections(i)%section,l1,unit_number,& 02185 error) 02186 END DO 02187 02188 WRITE (UNIT=unit_number,FMT="(A)") REPEAT(" ",l0)//"</SECTION>" 02189 02190 END IF 02191 02192 END SUBROUTINE write_section_xml 02193 02194 ! ***************************************************************************** 02195 RECURSIVE SUBROUTINE section_typo_match(section,unknown_string,location_string,& 02196 matching_rank,matching_string,error) 02197 02198 TYPE(section_type), POINTER :: section 02199 CHARACTER(LEN=*) :: unknown_string, 02200 location_string 02201 INTEGER, DIMENSION(:), INTENT(INOUT) :: matching_rank 02202 CHARACTER(LEN=*), DIMENSION(:), 02203 INTENT(INOUT) :: matching_string 02204 TYPE(cp_error_type), INTENT(INOUT) :: error 02205 02206 CHARACTER(LEN=*), PARAMETER :: routineN = 'section_typo_match', 02207 routineP = moduleN//':'//routineN 02208 02209 CHARACTER(LEN=LEN(matching_string(1))) :: line 02210 INTEGER :: i, imatch, imax, irank 02211 LOGICAL :: failure 02212 02213 failure = .FALSE. 02214 IF (ASSOCIATED(section)) THEN 02215 CPPrecondition(section%ref_count>0,cp_failure_level,routineP,error,failure) 02216 imatch=typo_match(TRIM(section%name),TRIM(unknown_string)) 02217 IF (imatch>0) THEN 02218 WRITE(line,'(T2,A)') " subsection "//TRIM(section%name)//" in section "//TRIM(location_string) 02219 imax=SIZE(matching_rank,1) 02220 irank=imax+1 02221 DO I=imax,1,-1 02222 IF (imatch>matching_rank(I)) irank=i 02223 ENDDO 02224 IF (irank<=imax) THEN 02225 matching_rank(irank+1:imax)=matching_rank(irank:imax-1) 02226 matching_string(irank+1:imax)=matching_string(irank:imax-1) 02227 matching_rank(irank)=imatch 02228 matching_string(irank)=line 02229 ENDIF 02230 END IF 02231 02232 DO i=-1,section%n_keywords 02233 IF (ASSOCIATED(section%keywords(i)%keyword)) THEN 02234 CALL keyword_typo_match(section%keywords(i)%keyword,unknown_string,location_string// & 02235 "%"//TRIM(section%name),matching_rank,matching_string,error) 02236 END IF 02237 END DO 02238 02239 DO i=1,section%n_subsections 02240 CALL section_typo_match(section%subsections(i)%section,unknown_string,& 02241 location_string//"%"//TRIM(section%name),matching_rank,matching_string,error) 02242 END DO 02243 02244 END IF 02245 02246 END SUBROUTINE section_typo_match 02247 02248 ! ***************************************************************************** 02259 SUBROUTINE section_vals_set_subs_vals(section_vals,subsection_name,& 02260 new_section_vals,i_rep_section,error) 02261 TYPE(section_vals_type), POINTER :: section_vals 02262 CHARACTER(len=*), INTENT(in) :: subsection_name 02263 TYPE(section_vals_type), POINTER :: new_section_vals 02264 INTEGER, INTENT(in), OPTIONAL :: i_rep_section 02265 TYPE(cp_error_type), INTENT(inout) :: error 02266 02267 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_set_subs_vals', 02268 routineP = moduleN//':'//routineN 02269 02270 INTEGER :: irep, isection, len_key, 02271 my_index, tmp_index 02272 LOGICAL :: failure 02273 TYPE(section_vals_type), POINTER :: s_vals 02274 02275 failure=.FALSE. 02276 CPPrecondition(ASSOCIATED(section_vals),cp_failure_level,routineP,error,failure) 02277 CPPrecondition(section_vals%ref_count>0,cp_failure_level,routineP,error,failure) 02278 CPPrecondition(ASSOCIATED(new_section_vals),cp_failure_level,routineP,error,failure) 02279 CPPrecondition(new_section_vals%ref_count>0,cp_failure_level,routineP,error,failure) 02280 02281 IF (.NOT. failure) THEN 02282 irep=1 02283 IF (PRESENT(i_rep_section)) irep=i_rep_section 02284 02285 my_index=INDEX(subsection_name,'%')+1 02286 len_key=LEN_TRIM(subsection_name) 02287 IF (my_index>1) THEN 02288 DO 02289 tmp_index=INDEX(subsection_name(my_index:len_key),"%") 02290 IF (tmp_index<=0) EXIT 02291 my_index=my_index+tmp_index 02292 END DO 02293 s_vals => section_vals_get_subs_vals(section_vals,subsection_name(1:my_index-2),& 02294 error=error) 02295 ELSE 02296 s_vals=> section_vals 02297 END IF 02298 02299 CPPrecondition(irep<=SIZE(s_vals%subs_vals,2),cp_failure_level,routineP,error,failure) 02300 END IF 02301 02302 IF (.NOT.failure) THEN 02303 isection=section_get_subsection_index(s_vals%section,subsection_name(my_index:LEN_TRIM(subsection_name)),& 02304 error=error) 02305 CALL cp_assert(isection>0,cp_failure_level,& 02306 cp_assertion_failed,routineP,& 02307 "could not find subsection "//subsection_name(my_index:LEN_TRIM(subsection_name))//" in section "//& 02308 TRIM(section_vals%section%name)//" at "//& 02309 CPSourceFileRef,& 02310 error,failure) 02311 END IF 02312 IF (.NOT.failure) THEN 02313 CALL section_vals_retain(new_section_vals,error=error) 02314 CALL section_vals_release(s_vals%subs_vals(isection,irep)%section_vals,error=error) 02315 s_vals%subs_vals(isection,irep)%section_vals => new_section_vals 02316 END IF 02317 02318 END SUBROUTINE section_vals_set_subs_vals 02319 02320 ! ***************************************************************************** 02328 SUBROUTINE section_vals_duplicate(section_vals_in,section_vals_out,& 02329 i_rep_start, i_rep_end, error) 02330 TYPE(section_vals_type), POINTER :: section_vals_in, 02331 section_vals_out 02332 INTEGER, INTENT(IN), OPTIONAL :: i_rep_start, i_rep_end 02333 TYPE(cp_error_type), INTENT(inout) :: error 02334 02335 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_duplicate', 02336 routineP = moduleN//':'//routineN 02337 02338 LOGICAL :: failure 02339 02340 failure=.FALSE. 02341 02342 CPPrecondition(ASSOCIATED(section_vals_in),cp_failure_level,routineP,error,failure) 02343 CPPrecondition(.NOT.ASSOCIATED(section_vals_out),cp_failure_level,routineP,error,failure) 02344 IF (.NOT.failure) THEN 02345 CALL section_vals_create(section_vals_out,section_vals_in%section,& 02346 error=error) 02347 CALL section_vals_copy(section_vals_in,section_vals_out,i_rep_start,i_rep_end,error=error) 02348 END IF 02349 END SUBROUTINE section_vals_duplicate 02350 02351 ! ***************************************************************************** 02361 RECURSIVE SUBROUTINE section_vals_copy(section_vals_in,section_vals_out,& 02362 i_rep_low,i_rep_high,error) 02363 TYPE(section_vals_type), POINTER :: section_vals_in, 02364 section_vals_out 02365 INTEGER, INTENT(IN), OPTIONAL :: i_rep_low, i_rep_high 02366 TYPE(cp_error_type), INTENT(inout) :: error 02367 02368 CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_copy', 02369 routineP = moduleN//':'//routineN 02370 02371 INTEGER :: iend, irep, isec, istart, ival 02372 LOGICAL :: failure 02373 TYPE(cp_sll_val_type), POINTER :: v1, v2 02374 TYPE(val_type), POINTER :: el 02375 02376 failure=.FALSE. 02377 NULLIFY(v2,el) 02378 02379 CPPrecondition(ASSOCIATED(section_vals_in),cp_failure_level,routineP,error,failure) 02380 CPPrecondition(ASSOCIATED(section_vals_out),cp_failure_level,routineP,error,failure) 02381 ! CALL cp_assert(section_vals_in%section%id_nr==section_vals_out%section%id_nr,& 02382 ! cp_failure_level,cp_assertion_failed,routineP,& 02383 ! CPSourceFileRef,& 02384 ! error,failure) 02385 IF (.NOT.failure) THEN 02386 istart = 1 02387 iend = SIZE(section_vals_in%values,2) 02388 IF (PRESENT(i_rep_low)) istart=i_rep_low 02389 IF (PRESENT(i_rep_high)) iend=i_rep_high 02390 DO irep=istart,iend 02391 CALL section_vals_add_values(section_vals_out,error=error) 02392 DO ival=LBOUND(section_vals_in%values,1),UBOUND(section_vals_in%values,1) 02393 v1=>section_vals_in%values(ival,irep)%list 02394 IF (ASSOCIATED(v1)) THEN 02395 CALL val_duplicate(v1%first_el,el,error=error) 02396 CALL cp_sll_val_create(v2,el,error=error) 02397 NULLIFY(el) 02398 section_vals_out%values(ival,irep-istart+1)%list => v2 02399 DO 02400 IF (.not.ASSOCIATED(v1%rest)) EXIT 02401 v1 => v1%rest 02402 CALL val_duplicate(v1%first_el,el,error=error) 02403 CALL cp_sll_val_create(v2%rest,first_el=el,error=error) 02404 NULLIFY(el) 02405 v2 => v2%rest 02406 END DO 02407 END IF 02408 END DO 02409 END DO 02410 IF (.NOT.PRESENT(i_rep_low).AND.(.NOT.PRESENT(i_rep_high))) THEN 02411 CALL cp_assert(SIZE(section_vals_in%values,2)==SIZE(section_vals_out%values,2),& 02412 cp_failure_level,cp_assertion_failed,routineP,& 02413 CPSourceFileRef,& 02414 error,failure) 02415 CALL cp_assert(SIZE(section_vals_in%subs_vals,2)==SIZE(section_vals_out%subs_vals,2),& 02416 cp_failure_level,cp_assertion_failed,routineP,& 02417 CPSourceFileRef,& 02418 error,failure) 02419 END IF 02420 iend = SIZE(section_vals_in%subs_vals,2) 02421 IF (PRESENT(i_rep_high)) iend=i_rep_high 02422 DO irep=istart,iend 02423 DO isec=1,SIZE(section_vals_in%subs_vals,1) 02424 CALL section_vals_copy(section_vals_in%subs_vals(isec,irep)%section_vals,& 02425 section_vals_out%subs_vals(isec,irep-istart+1)%section_vals,error=error) 02426 END DO 02427 END DO 02428 END IF 02429 END SUBROUTINE section_vals_copy 02430 02431 END MODULE input_section_types 02432
1.7.3