|
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 ! ***************************************************************************** 00012 MODULE input_keyword_types 00013 USE cp2k_info, ONLY: enable_color_tags 00014 USE cp_units, ONLY: cp_unit_create,& 00015 cp_unit_desc,& 00016 cp_unit_release,& 00017 cp_unit_type 00018 USE f77_blas 00019 USE input_enumeration_types, ONLY: enum_create,& 00020 enum_release,& 00021 enum_retain,& 00022 enumeration_type 00023 USE input_val_types, ONLY: & 00024 char_t, enum_t, integer_t, lchar_t, logical_t, no_t, real_t, & 00025 val_create, val_release, val_retain, val_type, val_write, & 00026 val_write_internal 00027 USE kinds, ONLY: default_string_length,& 00028 dp 00029 USE reference_manager, ONLY: get_citation_key,& 00030 print_format_journal,& 00031 print_reference 00032 USE string_utilities, ONLY: compress,& 00033 substitute_special_xml_tokens,& 00034 typo_match,& 00035 uppercase 00036 USE termination, ONLY: print_message 00037 #include "cp_common_uses.h" 00038 00039 IMPLICIT NONE 00040 PRIVATE 00041 00042 LOGICAL, PRIVATE, PARAMETER :: debug_this_module=.TRUE. 00043 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'input_keyword_types' 00044 00045 INTEGER, PARAMETER, PUBLIC :: description_string_length=15*default_string_length, 00046 usage_string_length=default_string_length*2 00047 INTEGER, SAVE, PRIVATE :: last_keyword_id=0 00048 00049 PUBLIC :: keyword_p_type, keyword_type, keyword_create, keyword_retain,& 00050 keyword_release, keyword_get, keyword_describe,& 00051 keyword_describe_html, write_keyword_xml, keyword_typo_match 00052 00053 ! ***************************************************************************** 00058 TYPE keyword_p_type 00059 TYPE(keyword_type), POINTER :: keyword 00060 END TYPE keyword_p_type 00061 00062 ! ***************************************************************************** 00091 TYPE keyword_type 00092 INTEGER :: ref_count,id_nr 00093 CHARACTER(LEN=default_string_length), DIMENSION(:), POINTER:: names 00094 CHARACTER(LEN=usage_string_length) :: usage 00095 CHARACTER(LEN=description_string_length) :: description 00096 INTEGER, POINTER, DIMENSION(:) :: citations 00097 INTEGER :: type_of_var,n_var 00098 LOGICAL :: repeats, required, supported_feature 00099 TYPE(enumeration_type), POINTER :: enum 00100 TYPE(cp_unit_type), POINTER :: unit 00101 TYPE(val_type), POINTER :: default_value 00102 TYPE(val_type), POINTER :: lone_keyword_value 00103 END TYPE keyword_type 00104 00105 CONTAINS 00106 00107 ! ***************************************************************************** 00115 SUBROUTINE keyword_create(keyword, name, description, usage, type_of_var,& 00116 n_var,repeats,variants,required,default_val,& 00117 default_l_val, default_r_val, default_lc_val, default_c_val, default_i_val,& 00118 default_l_vals, default_r_vals, default_c_vals, default_i_vals,& 00119 lone_keyword_val, lone_keyword_l_val, lone_keyword_r_val, lone_keyword_c_val,& 00120 lone_keyword_i_val, lone_keyword_l_vals, lone_keyword_r_vals, & 00121 lone_keyword_c_vals, lone_keyword_i_vals, enum_c_vals, enum_i_vals, & 00122 enum,enum_strict,enum_desc,unit_str,citations,supported_feature,error) 00123 TYPE(keyword_type), POINTER :: keyword 00124 CHARACTER(len=*), INTENT(in) :: name, description 00125 CHARACTER(len=*), INTENT(in), OPTIONAL :: usage 00126 INTEGER, INTENT(in), OPTIONAL :: type_of_var, n_var 00127 LOGICAL, INTENT(in), OPTIONAL :: repeats 00128 CHARACTER(len=*), DIMENSION(:), 00129 INTENT(in), OPTIONAL :: variants 00130 LOGICAL, INTENT(in), OPTIONAL :: required 00131 TYPE(val_type), OPTIONAL, POINTER :: default_val 00132 LOGICAL, INTENT(in), OPTIONAL :: default_l_val 00133 REAL(KIND=DP), INTENT(in), OPTIONAL :: default_r_val 00134 CHARACTER(len=*), INTENT(in), OPTIONAL :: default_lc_val, default_c_val 00135 INTEGER, INTENT(in), OPTIONAL :: default_i_val 00136 LOGICAL, DIMENSION(:), INTENT(in), 00137 OPTIONAL :: default_l_vals 00138 REAL(KIND=DP), DIMENSION(:), 00139 INTENT(in), OPTIONAL :: default_r_vals 00140 CHARACTER(len=*), DIMENSION(:), 00141 INTENT(in), OPTIONAL :: default_c_vals 00142 INTEGER, DIMENSION(:), INTENT(in), 00143 OPTIONAL :: default_i_vals 00144 TYPE(val_type), OPTIONAL, POINTER :: lone_keyword_val 00145 LOGICAL, INTENT(in), OPTIONAL :: lone_keyword_l_val 00146 REAL(KIND=DP), INTENT(in), OPTIONAL :: lone_keyword_r_val 00147 CHARACTER(len=*), INTENT(in), OPTIONAL :: lone_keyword_c_val 00148 INTEGER, INTENT(in), OPTIONAL :: lone_keyword_i_val 00149 LOGICAL, DIMENSION(:), INTENT(in), 00150 OPTIONAL :: lone_keyword_l_vals 00151 REAL(KIND=DP), DIMENSION(:), 00152 INTENT(in), OPTIONAL :: lone_keyword_r_vals 00153 CHARACTER(len=*), DIMENSION(:), 00154 INTENT(in), OPTIONAL :: lone_keyword_c_vals 00155 INTEGER, DIMENSION(:), INTENT(in), 00156 OPTIONAL :: lone_keyword_i_vals 00157 CHARACTER(len=*), DIMENSION(:), 00158 INTENT(in), OPTIONAL :: enum_c_vals 00159 INTEGER, DIMENSION(:), INTENT(in), 00160 OPTIONAL :: enum_i_vals 00161 TYPE(enumeration_type), OPTIONAL, 00162 POINTER :: enum 00163 LOGICAL, INTENT(in), OPTIONAL :: enum_strict 00164 CHARACTER(len=*), DIMENSION(:), 00165 INTENT(in), OPTIONAL :: enum_desc 00166 CHARACTER(len=*), INTENT(in), OPTIONAL :: unit_str 00167 INTEGER, DIMENSION(:), INTENT(in), 00168 OPTIONAL :: citations 00169 LOGICAL, INTENT(in), OPTIONAL :: supported_feature 00170 TYPE(cp_error_type), INTENT(inout) :: error 00171 00172 CHARACTER(len=*), PARAMETER :: routineN = 'keyword_create', 00173 routineP = moduleN//':'//routineN 00174 00175 INTEGER :: i, stat 00176 LOGICAL :: check, failure 00177 00178 failure=.FALSE. 00179 00180 CPPrecondition(.NOT.ASSOCIATED(keyword),cp_failure_level,routineP,error,failure) 00181 ALLOCATE(keyword,stat=stat) 00182 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00183 IF (.NOT. failure) THEN 00184 keyword%ref_count=1 00185 last_keyword_id=last_keyword_id+1 00186 keyword%id_nr=last_keyword_id 00187 NULLIFY(keyword%unit) 00188 00189 IF (PRESENT(variants)) THEN 00190 ALLOCATE(keyword%names(SIZE(variants)+1),stat=stat) 00191 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00192 IF (.NOT.failure) THEN 00193 keyword%names(1)=name 00194 DO i=1,SIZE(variants) 00195 keyword%names(i+1)=variants(i) 00196 END DO 00197 END IF 00198 ELSE 00199 ALLOCATE(keyword%names(1),stat=stat) 00200 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00201 IF (.not.failure) keyword%names(1)=name 00202 END IF 00203 DO i=1,SIZE(keyword%names) 00204 CALL uppercase(keyword%names(i)) 00205 END DO 00206 00207 IF (PRESENT(usage)) THEN 00208 CPPrecondition(LEN_TRIM(usage)<=LEN(keyword%usage),cp_failure_level,routineP,error,failure) 00209 keyword%usage=usage 00210 ELSE 00211 keyword%usage="" 00212 END IF 00213 CPPrecondition(LEN_TRIM(description)<=LEN(keyword%description),cp_failure_level,routineP,error,failure) 00214 keyword%description=description 00215 00216 IF (PRESENT(citations)) THEN 00217 ALLOCATE(keyword%citations(SIZE(citations,1)),stat=stat) 00218 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00219 keyword%citations=citations 00220 ELSE 00221 NULLIFY(keyword%citations) 00222 ENDIF 00223 00224 keyword%repeats=.FALSE. 00225 IF (PRESENT(repeats)) keyword%repeats=repeats 00226 keyword%required=.FALSE. 00227 IF (PRESENT(required)) keyword%required=required 00228 keyword%supported_feature=.FALSE. 00229 IF (PRESENT(supported_feature)) keyword%supported_feature=supported_feature 00230 00231 NULLIFY(keyword%enum) 00232 IF (PRESENT(enum)) THEN 00233 keyword%enum => enum 00234 IF (ASSOCIATED(enum)) CALL enum_retain(enum,error=error) 00235 END IF 00236 IF (PRESENT(enum_i_vals)) THEN 00237 CPPrecondition(PRESENT(enum_c_vals),cp_failure_level,routineP,error,failure) 00238 CPPrecondition(.NOT.ASSOCIATED(keyword%enum),cp_failure_level,routineP,error,failure) 00239 CALL enum_create(keyword%enum,c_vals=enum_c_vals,i_vals=enum_i_vals,& 00240 desc=enum_desc,strict=enum_strict,error=error) 00241 ELSE 00242 CPPrecondition(.NOT.PRESENT(enum_c_vals),cp_failure_level,routineP,error,failure) 00243 END IF 00244 00245 NULLIFY(keyword%default_value, keyword%lone_keyword_value) 00246 IF (PRESENT(default_val)) THEN 00247 CALL cp_assert(.NOT.(PRESENT(default_l_val).OR.PRESENT(default_l_vals).OR.& 00248 PRESENT(default_i_val).OR.PRESENT(default_i_vals).OR.& 00249 PRESENT(default_r_val).or.PRESENT(default_r_vals).OR.& 00250 PRESENT(default_c_val).OR.PRESENT(default_c_vals)),cp_failure_level,& 00251 cp_assertion_failed,routineP,& 00252 "you should pass either default_val or a default value, not both",& 00253 error,failure) 00254 keyword%default_value => default_val 00255 IF (ASSOCIATED(default_val%enum)) THEN 00256 IF (ASSOCIATED(keyword%enum)) THEN 00257 CPAssert(keyword%enum%id_nr==default_val%enum%id_nr,cp_failure_level,routineP,error,failure) 00258 ELSE 00259 keyword%enum => default_val%enum 00260 CALL enum_retain(keyword%enum,error=error) 00261 END IF 00262 ELSE 00263 CPAssert(.NOT.ASSOCIATED(keyword%enum),cp_failure_level,routineP,error,failure) 00264 END IF 00265 CALL val_retain(default_val,error=error) 00266 END IF 00267 IF (.not.ASSOCIATED(keyword%default_value)) THEN 00268 CALL val_create(keyword%default_value,l_val=default_l_val,& 00269 l_vals=default_l_vals,i_val=default_i_val,i_vals=default_i_vals,& 00270 r_val=default_r_val,r_vals=default_r_vals,c_val=default_c_val,& 00271 c_vals=default_c_vals,lc_val=default_lc_val,enum=keyword%enum,error=error) 00272 END IF 00273 00274 keyword%type_of_var=keyword%default_value%type_of_var 00275 IF (keyword%default_value%type_of_var==no_t) THEN 00276 CALL val_release(keyword%default_value,error=error) 00277 END IF 00278 00279 IF (keyword%type_of_var==no_t) THEN 00280 IF (PRESENT(type_of_var)) THEN 00281 keyword%type_of_var=type_of_var 00282 ELSE 00283 CALL cp_assert(.FALSE.,cp_warning_level,cp_assertion_failed,routineP,& 00284 "keyword "//TRIM(keyword%names(1))//& 00285 " assumed undefined type by default",error,failure) 00286 END IF 00287 ELSE IF (PRESENT(type_of_var)) THEN 00288 CALL cp_assert(keyword%type_of_var==type_of_var,cp_failure_level,& 00289 cp_assertion_failed,routineP, & 00290 "keyword "//TRIM(keyword%names(1))//& 00291 " has a type different from the type of the default_value",& 00292 error,failure) 00293 keyword%type_of_var=type_of_var 00294 END IF 00295 00296 IF (keyword%type_of_var==no_t) THEN 00297 CALL val_create(keyword%default_value,error=error) 00298 END IF 00299 END IF 00300 00301 IF (.NOT.failure) THEN 00302 IF (PRESENT(lone_keyword_val)) THEN 00303 CALL cp_assert(.NOT.(PRESENT(lone_keyword_l_val).OR.PRESENT(lone_keyword_l_vals).OR.& 00304 PRESENT(lone_keyword_i_val).OR.PRESENT(lone_keyword_i_vals).OR.& 00305 PRESENT(lone_keyword_r_val).OR.PRESENT(lone_keyword_r_vals).OR.& 00306 PRESENT(lone_keyword_c_val).OR.PRESENT(lone_keyword_c_vals)),& 00307 cp_failure_level, cp_assertion_failed,routineP,& 00308 "you should pass either lone_keyword_val or a lone_keyword value, not both",& 00309 error,failure) 00310 keyword%lone_keyword_value => lone_keyword_val 00311 CALL val_retain(lone_keyword_val,error=error) 00312 IF (ASSOCIATED(lone_keyword_val%enum)) THEN 00313 IF (ASSOCIATED(keyword%enum)) THEN 00314 CALL cp_assert(keyword%enum%id_nr==lone_keyword_val%enum%id_nr, & 00315 cp_failure_level,cp_assertion_failed,routineP, & 00316 "keyword%enum%id_nr==lone_keyword_val%enum%id_nr", & 00317 error,failure) 00318 ELSE 00319 IF (ASSOCIATED(keyword%lone_keyword_value)) THEN 00320 CALL cp_assert(.FALSE., cp_failure_level, cp_precondition_failed, & 00321 routineP, ".NOT. ASSOCIATED(keyword%lone_keyword_value)", & 00322 error, failure) 00323 END IF 00324 keyword%enum => lone_keyword_val%enum 00325 CALL enum_retain(keyword%enum,error=error) 00326 END IF 00327 ELSE 00328 CPAssert(.NOT.ASSOCIATED(keyword%enum),cp_failure_level,routineP,error,failure) 00329 END IF 00330 END IF 00331 IF (.NOT.ASSOCIATED(keyword%lone_keyword_value)) THEN 00332 CALL val_create(keyword%lone_keyword_value,l_val=lone_keyword_l_val,& 00333 l_vals=lone_keyword_l_vals,i_val=lone_keyword_i_val,i_vals=lone_keyword_i_vals,& 00334 r_val=lone_keyword_r_val,r_vals=lone_keyword_r_vals,c_val=lone_keyword_c_val,& 00335 c_vals=lone_keyword_c_vals,enum=keyword%enum,error=error) 00336 END IF 00337 IF (ASSOCIATED(keyword%lone_keyword_value)) THEN 00338 IF (keyword%lone_keyword_value%type_of_var==no_t) THEN 00339 CALL val_release(keyword%lone_keyword_value,error=error) 00340 ELSE 00341 CALL cp_assert(keyword%lone_keyword_value%type_of_var==keyword%type_of_var,& 00342 cp_failure_level,cp_assertion_failed,routineP,& 00343 "lone_keyword_value type incompatible with "//& 00344 "keyword type",error,failure) 00345 ! lc_val cannot have lone_keyword_value! 00346 IF (keyword%type_of_var==enum_t) THEN 00347 IF (keyword%enum%strict) THEN 00348 check = .FALSE. 00349 DO i=1, SIZE(keyword%enum%i_vals) 00350 check = check .OR. (keyword%default_value%i_val(1)==keyword%enum%i_vals(i)) 00351 END DO 00352 CALL cp_assert(check,cp_failure_level,& 00353 cp_assertion_failed,routineP,"default value not in enumeration : "//keyword%names(1), & 00354 error,failure) 00355 ENDIF 00356 ENDIF 00357 END IF 00358 END IF 00359 00360 keyword%n_var=1 00361 IF (ASSOCIATED(keyword%default_value)) THEN 00362 SELECT CASE(keyword%default_value%type_of_var) 00363 CASE(logical_t) 00364 keyword%n_var=SIZE(keyword%default_value%l_val) 00365 CASE(integer_t) 00366 keyword%n_var=SIZE(keyword%default_value%i_val) 00367 CASE(enum_t) 00368 IF (keyword%enum%strict) THEN 00369 check = .FALSE. 00370 DO i=1, SIZE(keyword%enum%i_vals) 00371 check = check .OR. (keyword%default_value%i_val(1)==keyword%enum%i_vals(i)) 00372 END DO 00373 CALL cp_assert(check,cp_failure_level,& 00374 cp_assertion_failed,routineP,"default value not in enumeration : "//& 00375 keyword%names(1), error,failure) 00376 ENDIF 00377 keyword%n_var=SIZE(keyword%default_value%i_val) 00378 CASE(real_t) 00379 keyword%n_var=SIZE(keyword%default_value%r_val) 00380 CASE(char_t) 00381 keyword%n_var=SIZE(keyword%default_value%c_val) 00382 CASE(lchar_t) 00383 keyword%n_var=1 00384 CASE(no_t) 00385 keyword%n_var=0 00386 CASE default 00387 CPAssert(.FALSE.,cp_failure_level,routineP,error,failure) 00388 END SELECT 00389 END IF 00390 IF (PRESENT(n_var)) keyword%n_var=n_var 00391 CALL cp_assert(keyword%type_of_var/=lchar_t.or.keyword%n_var==1,cp_failure_level,& 00392 cp_assertion_failed,routineP,"arrays of lchar_t not supported : "& 00393 //keyword%names(1), error,failure) 00394 00395 IF (PRESENT(unit_str)) THEN 00396 CALL cp_unit_create(keyword%unit,unit_str,error=error) 00397 END IF 00398 END IF 00399 END SUBROUTINE keyword_create 00400 00401 ! ***************************************************************************** 00408 SUBROUTINE keyword_retain(keyword, error) 00409 TYPE(keyword_type), POINTER :: keyword 00410 TYPE(cp_error_type), INTENT(inout) :: error 00411 00412 CHARACTER(len=*), PARAMETER :: routineN = 'keyword_retain', 00413 routineP = moduleN//':'//routineN 00414 00415 LOGICAL :: failure 00416 00417 failure=.FALSE. 00418 CPPrecondition(ASSOCIATED(keyword),cp_failure_level,routineP,error,failure) 00419 IF (.NOT. failure) THEN 00420 CPPreconditionNoFail(keyword%ref_count>0,cp_failure_level,routineP,error) 00421 keyword%ref_count=keyword%ref_count+1 00422 END IF 00423 END SUBROUTINE keyword_retain 00424 00425 ! ***************************************************************************** 00432 SUBROUTINE keyword_release(keyword, error) 00433 TYPE(keyword_type), POINTER :: keyword 00434 TYPE(cp_error_type), INTENT(inout) :: error 00435 00436 CHARACTER(len=*), PARAMETER :: routineN = 'keyword_release', 00437 routineP = moduleN//':'//routineN 00438 00439 INTEGER :: stat 00440 LOGICAL :: failure 00441 00442 failure=.FALSE. 00443 IF (ASSOCIATED(keyword)) THEN 00444 CPPreconditionNoFail(keyword%ref_count>0,cp_failure_level,routineP,error) 00445 keyword%ref_count=keyword%ref_count-1 00446 IF (keyword%ref_count==0) THEN 00447 DEALLOCATE(keyword%names,stat=stat) 00448 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00449 CALL val_release(keyword%default_value,error=error) 00450 CALL val_release(keyword%lone_keyword_value,error=error) 00451 CALL enum_release(keyword%enum,error=error) 00452 CALL cp_unit_release(keyword%unit,error=error) 00453 IF (ASSOCIATED(keyword%citations)) THEN 00454 DEALLOCATE(keyword%citations,stat=stat) 00455 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00456 ENDIF 00457 DEALLOCATE(keyword,stat=stat) 00458 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00459 END IF 00460 END IF 00461 NULLIFY(keyword) 00462 END SUBROUTINE keyword_release 00463 00464 ! ***************************************************************************** 00469 SUBROUTINE keyword_get(keyword,names,usage,description,type_of_var,n_var,& 00470 default_value, lone_keyword_value,required,repeats,enum,citations,error) 00471 TYPE(keyword_type), POINTER :: keyword 00472 CHARACTER(len=default_string_length), 00473 DIMENSION(:), OPTIONAL, POINTER :: names 00474 CHARACTER(len=*), INTENT(out), OPTIONAL :: usage, description 00475 INTEGER, INTENT(out), OPTIONAL :: type_of_var, n_var 00476 TYPE(val_type), OPTIONAL, POINTER :: default_value, 00477 lone_keyword_value 00478 LOGICAL, INTENT(out), OPTIONAL :: required, repeats 00479 TYPE(enumeration_type), OPTIONAL, 00480 POINTER :: enum 00481 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: citations 00482 TYPE(cp_error_type), INTENT(inout) :: error 00483 00484 CHARACTER(len=*), PARAMETER :: routineN = 'keyword_get', 00485 routineP = moduleN//':'//routineN 00486 00487 LOGICAL :: failure 00488 00489 failure=.FALSE. 00490 00491 CPPrecondition(ASSOCIATED(keyword),cp_failure_level,routineP,error,failure) 00492 CPPrecondition(keyword%ref_count>0,cp_failure_level,routineP,error,failure) 00493 IF (.NOT. failure) THEN 00494 IF (PRESENT(names)) names => keyword%names 00495 IF (PRESENT(usage)) usage=keyword%usage 00496 IF (PRESENT(description)) description=keyword%description 00497 IF (PRESENT(type_of_var)) type_of_var=keyword%type_of_var 00498 IF (PRESENT(n_var)) n_var=keyword%n_var 00499 IF (PRESENT(repeats)) repeats=keyword%repeats 00500 IF (PRESENT(required)) required=keyword%required 00501 IF (PRESENT(default_value)) default_value => keyword%default_value 00502 IF (PRESENT(lone_keyword_value)) lone_keyword_value => keyword%lone_keyword_value 00503 IF (PRESENT(enum)) enum => keyword%enum 00504 IF (PRESENT(citations)) citations => keyword%citations 00505 END IF 00506 END SUBROUTINE keyword_get 00507 00508 ! ***************************************************************************** 00519 SUBROUTINE keyword_describe(keyword, unit_nr, level,error) 00520 TYPE(keyword_type), POINTER :: keyword 00521 INTEGER, INTENT(in) :: unit_nr, level 00522 TYPE(cp_error_type), INTENT(inout) :: error 00523 00524 CHARACTER(len=*), PARAMETER :: routineN = 'keyword_describe', 00525 routineP = moduleN//':'//routineN 00526 00527 CHARACTER(len=default_string_length) :: c_string 00528 INTEGER :: i, l 00529 LOGICAL :: failure 00530 00531 failure=.FALSE. 00532 00533 CPPrecondition(ASSOCIATED(keyword),cp_failure_level,routineP,error,failure) 00534 CPPrecondition(keyword%ref_count>0,cp_failure_level,routineP,error,failure) 00535 IF (.NOT. failure.AND.level>0.AND.(unit_nr>0)) THEN 00536 WRITE(unit_nr,"(a,a,a)") " ---",& 00537 TRIM(keyword%names(1)),"---" 00538 IF (level>1) THEN 00539 WRITE(unit_nr,"(a,a)") "usage : ",TRIM(keyword%usage) 00540 END IF 00541 IF (level>2) THEN 00542 WRITE(unit_nr,"(a)")"description : " 00543 CALL print_message(TRIM(keyword%description),unit_nr,0,0,0) 00544 IF (level>3) THEN 00545 SELECT CASE(keyword%type_of_var) 00546 CASE (logical_t) 00547 IF (keyword%n_var==-1) THEN 00548 WRITE(unit_nr,"(' A list of logicals is expected')") 00549 ELSE IF (keyword%n_var==1) THEN 00550 WRITE(unit_nr,"(' A logical is expected')") 00551 ELSE 00552 WRITE(unit_nr,"(i6,' logicals are expected')") keyword%n_var 00553 END IF 00554 WRITE(unit_nr,"(' (T,TRUE,YES,ON) and (F,FALSE,NO,OFF) are synonyms')") 00555 CASE (integer_t) 00556 IF (keyword%n_var==-1) THEN 00557 WRITE(unit_nr,"(' A list of integers is expected')") 00558 ELSE IF (keyword%n_var==1) THEN 00559 WRITE(unit_nr,"(' An integer is expected')") 00560 ELSE 00561 WRITE(unit_nr,"(i6,' integers are expected')") keyword%n_var 00562 END IF 00563 CASE (real_t) 00564 IF (keyword%n_var==-1) THEN 00565 WRITE(unit_nr,"(' A list of reals is expected')") 00566 ELSE IF (keyword%n_var==1) THEN 00567 WRITE(unit_nr,"(' A real is expected')") 00568 ELSE 00569 WRITE(unit_nr,"(i6,' reals are expected')") keyword%n_var 00570 END IF 00571 IF (ASSOCIATED(keyword%unit)) THEN 00572 c_string=cp_unit_desc(keyword%unit,accept_undefined=.TRUE.,& 00573 error=error) 00574 WRITE(unit_nr,"('the default unit of measure is ',a)")& 00575 TRIM(c_string) 00576 END IF 00577 CASE (char_t) 00578 IF (keyword%n_var==-1) THEN 00579 WRITE(unit_nr,"(' A list of words is expected')") 00580 ELSE IF (keyword%n_var==1) THEN 00581 WRITE(unit_nr,"(' A word is expected')") 00582 ELSE 00583 WRITE(unit_nr,"(i6,' words are expected')") keyword%n_var 00584 END IF 00585 CASE (lchar_t) 00586 WRITE(unit_nr,"(' A string is expected')") 00587 CASE (enum_t) 00588 IF (keyword%n_var==-1) THEN 00589 WRITE(unit_nr,"(' A list of keywords is expected')") 00590 ELSE IF (keyword%n_var==1) THEN 00591 WRITE(unit_nr,"(' A keyword is expected')") 00592 ELSE 00593 WRITE(unit_nr,"(i6,' keywords are expected')") keyword%n_var 00594 END IF 00595 CASE (no_t) 00596 WRITE(unit_nr,"(' Non-standard type.')") 00597 CASE default 00598 CPAssert(.FALSE.,cp_warning_level,routineP,error,failure) 00599 END SELECT 00600 END IF 00601 IF (keyword%type_of_var==enum_t) THEN 00602 IF (level>3) THEN 00603 WRITE(unit_nr,"(' valid keywords:')") 00604 DO i=1,SIZE(keyword%enum%c_vals) 00605 c_string=keyword%enum%c_vals(i) 00606 IF (LEN_TRIM(keyword%enum%desc(i))>0) THEN 00607 WRITE (unit_nr,"(' - ',a,' : ',a,'.')") & 00608 TRIM(c_string),TRIM(keyword%enum%desc(i)) 00609 ELSE 00610 WRITE (unit_nr,"(' - ',a)") TRIM(c_string) 00611 END IF 00612 END DO 00613 ELSE 00614 WRITE(unit_nr,"(' valid keywords:')",advance='NO') 00615 l=17 00616 DO i=1,SIZE(keyword%enum%c_vals) 00617 c_string=keyword%enum%c_vals(i) 00618 IF (l+LEN_TRIM(c_string)>72.AND.l>14) THEN 00619 WRITE (unit_nr,"(/,' ')",advance='NO') 00620 l=4 00621 END IF 00622 WRITE (unit_nr,"(' ',a)",advance='NO') TRIM(c_string) 00623 l=LEN_TRIM(c_string)+3 00624 END DO 00625 WRITE (unit_nr,"()") 00626 END IF 00627 IF (.NOT.keyword%enum%strict) THEN 00628 WRITE (unit_nr,"(' other integer values are also accepted.')") 00629 END IF 00630 END IF 00631 IF (ASSOCIATED(keyword%default_value).AND.keyword%type_of_var/=no_t) THEN 00632 WRITE(unit_nr,"('default_value : ')",advance="NO") 00633 CALL val_write(keyword%default_value,unit_nr=unit_nr,error=error) 00634 END IF 00635 IF (ASSOCIATED(keyword%lone_keyword_value).AND.keyword%type_of_var/=no_t) THEN 00636 WRITE(unit_nr,"('lone_keyword : ')",advance="NO") 00637 CALL val_write(keyword%lone_keyword_value,unit_nr=unit_nr,error=error) 00638 END IF 00639 IF (keyword%required) THEN 00640 WRITE(unit_nr,"(' This keyword is required')",advance="NO") 00641 ELSE 00642 WRITE(unit_nr,"(' This keyword is optional')",advance="NO") 00643 END IF 00644 IF (keyword%repeats) THEN 00645 WRITE(unit_nr,"(' and it can be repeated more than once')",advance="NO") 00646 END IF 00647 WRITE(unit_nr,"()") 00648 IF (SIZE(keyword%names)>1) THEN 00649 WRITE(unit_nr,"(a)",advance="NO") "variants : " 00650 DO i=2,SIZE(keyword%names) 00651 WRITE(unit_nr,"(a,' ')",advance="NO") keyword%names(i) 00652 END DO 00653 WRITE(unit_nr,"()") 00654 ENDIF 00655 END IF 00656 END IF 00657 END SUBROUTINE keyword_describe 00658 00659 ! ***************************************************************************** 00667 SUBROUTINE keyword_describe_html(keyword, unit_nr, error) 00668 TYPE(keyword_type), POINTER :: keyword 00669 INTEGER, INTENT(in) :: unit_nr 00670 TYPE(cp_error_type), INTENT(inout) :: error 00671 00672 CHARACTER(len=*), PARAMETER :: routineN = 'keyword_describe_html', 00673 routineP = moduleN//':'//routineN 00674 00675 CHARACTER(len=default_string_length) :: c_string, color_tag, my_unit 00676 INTEGER :: i, iref 00677 LOGICAL :: failure 00678 00679 failure=.FALSE. 00680 00681 CPPrecondition(ASSOCIATED(keyword),cp_failure_level,routineP,error,failure) 00682 CPPrecondition(keyword%ref_count>0,cp_failure_level,routineP,error,failure) 00683 IF (.NOT. failure) THEN 00684 color_tag='<font color="#000000">' 00685 IF (enable_color_tags.AND.keyword%supported_feature) THEN 00686 color_tag='<font color="#00CC00">' 00687 END IF 00688 WRITE(unit_nr,'(a)') '<TR><TD WITDH="20%">'// & 00689 '<A NAME="'//TRIM(keyword%names(1))//'"><u>'//TRIM(color_tag)//TRIM(keyword%names(1))//'</font></u></A>'// & 00690 '<TD WIDTH="80%">' 00691 WRITE(unit_nr,'(a)') '<TR><TD WIDTH="20%"><TD WIDTH="80%">'//TRIM(keyword%usage) 00692 WRITE(unit_nr,'(a)') '<TR><TD WIDTH="20%"><TD WIDTH="80%"><i>'//TRIM(keyword%description)//'</i>' 00693 IF (keyword%required) THEN 00694 WRITE(unit_nr,"(a)",advance="NO") '<TR><TD WIDTH="10%"><TD> This required keyword ' 00695 ELSE 00696 WRITE(unit_nr,"(a)",advance="NO") '<TR><TD WIDTH="10%"><TD> This optional keyword ' 00697 END IF 00698 SELECT CASE(keyword%type_of_var) 00699 CASE (logical_t) 00700 IF (keyword%n_var==-1) THEN 00701 WRITE(unit_nr,'(a)',ADVANCE="NO") 'expects a list of logicals' 00702 ELSE IF (keyword%n_var==1) THEN 00703 WRITE(unit_nr,'(a)',ADVANCE="NO") 'expects a logical' 00704 ELSE 00705 WRITE(unit_nr,'(a,i6,a)',ADVANCE="NO") 'expects precisely',keyword%n_var,' logicals' 00706 END IF 00707 ! (provide a link to this info) WRITE(unit_nr,"(' (T,TRUE,YES,ON) and (F,FALSE,NO,OFF) are synonyms')") 00708 CASE (integer_t) 00709 IF (keyword%n_var==-1) THEN 00710 WRITE(unit_nr,'(a)',ADVANCE="NO") 'expects a list of integers' 00711 ELSE IF (keyword%n_var==1) THEN 00712 WRITE(unit_nr,'(a)',ADVANCE="NO") 'expects an integer' 00713 ELSE 00714 WRITE(unit_nr,'(a,i6,a)',ADVANCE="NO") 'expects precisely',keyword%n_var,' integers' 00715 END IF 00716 CASE (real_t) 00717 IF (keyword%n_var==-1) THEN 00718 WRITE(unit_nr,'(a)',ADVANCE="NO") 'expects a list of reals' 00719 ELSE IF (keyword%n_var==1) THEN 00720 WRITE(unit_nr,'(a)',ADVANCE="NO") 'expects a real' 00721 ELSE 00722 WRITE(unit_nr,'(a,i6,a)',ADVANCE="NO") 'expects precisely',keyword%n_var,' reals' 00723 END IF 00724 CASE (char_t) 00725 IF (keyword%n_var==-1) THEN 00726 WRITE(unit_nr,'(a)',ADVANCE="NO") 'expects a list of words' 00727 ELSE IF (keyword%n_var==1) THEN 00728 WRITE(unit_nr,'(a)',ADVANCE="NO") 'expects a word' 00729 ELSE 00730 WRITE(unit_nr,'(a,i6,a)',ADVANCE="NO") 'expects precisely',keyword%n_var,' words' 00731 END IF 00732 CASE (lchar_t) 00733 WRITE(unit_nr,'(a)',ADVANCE="NO") 'expects a string' 00734 CASE (enum_t) 00735 IF (keyword%n_var==-1) THEN 00736 WRITE(unit_nr,'(a)',ADVANCE="NO") 'expects a list of keywords' 00737 ELSE IF (keyword%n_var==1) THEN 00738 WRITE(unit_nr,'(a)',ADVANCE="NO") 'expects a keyword' 00739 ELSE 00740 WRITE(unit_nr,'(a,i6,a)',ADVANCE="NO") 'expects precisely',keyword%n_var,' keywords' 00741 END IF 00742 CASE (no_t) 00743 WRITE(unit_nr,'(a)',ADVANCE="NO") 'expects a non-standard input type' 00744 CASE DEFAULT 00745 CPAssert(.FALSE.,cp_warning_level,routineP,error,failure) 00746 END SELECT 00747 IF (keyword%repeats) THEN 00748 WRITE(unit_nr,"(', and may repeat')",ADVANCE="NO") 00749 END IF 00750 IF (ASSOCIATED(keyword%lone_keyword_value).AND.keyword%type_of_var/=no_t) THEN 00751 WRITE(unit_nr,'(a)',advance="NO") '<TR><TD WIDTH="10%"><TD>This keyword behaves as a switch' 00752 CALL val_write(keyword%lone_keyword_value,unit_nr=unit_nr,error=error) 00753 END IF 00754 IF (ASSOCIATED(keyword%default_value).AND.keyword%type_of_var/=no_t) THEN 00755 IF (ASSOCIATED(keyword%unit)) THEN 00756 my_unit=cp_unit_desc(keyword%unit,accept_undefined=.TRUE.,error=error) 00757 WRITE(unit_nr,'(a)',advance="NO") '. Default unit: ' // '[' // TRIM(my_unit)// '], default value: ' 00758 ELSE 00759 WRITE(unit_nr,'(a)',advance="NO") '. Default value: ' 00760 ENDIF 00761 CALL val_write(keyword%default_value,unit=keyword%unit,unit_nr=unit_nr,error=error) 00762 IF (ASSOCIATED(keyword%unit)) THEN 00763 WRITE(unit_nr,'(a)',advance="NO") TRIM(my_unit) 00764 END IF 00765 ELSE 00766 IF (ASSOCIATED(keyword%unit)) THEN 00767 my_unit=cp_unit_desc(keyword%unit,accept_undefined=.TRUE.,error=error) 00768 WRITE(unit_nr,'(a)',advance="NO") '. Default unit: ' // '[' // TRIM(my_unit)// '].' 00769 END IF 00770 ENDIF 00771 00772 IF (keyword%type_of_var==enum_t) THEN 00773 IF (ANY(keyword%enum%desc.NE."")) THEN 00774 WRITE(unit_nr,'(a)',advance='NO') '<TR><TD WIDTH="10%"><TD> valid keywords:<ul> ' 00775 DO i=1,SIZE(keyword%enum%c_vals) 00776 c_string=keyword%enum%c_vals(i) 00777 WRITE (unit_nr,'(a,a,a,a,a)') "<li><code>",& 00778 TRIM(c_string), "</code>: ",TRIM(keyword%enum%desc(i)),"</li>" 00779 END DO 00780 WRITE (unit_nr,'(a)',advance='NO') '</ul>' 00781 ELSE 00782 WRITE(unit_nr,'(a)',advance='NO') '<TR><TD WIDTH="10%"><TD> valid keywords: ' 00783 IF (SIZE(keyword%enum%c_vals)>0) & 00784 WRITE (unit_nr,'(a)',advance='NO') TRIM(keyword%enum%c_vals(1)) 00785 DO i=2,SIZE(keyword%enum%c_vals) 00786 c_string=keyword%enum%c_vals(i) 00787 WRITE (unit_nr,'(a)',advance='NO') ", "//TRIM(c_string) 00788 END DO 00789 ENDIF 00790 IF (.NOT.keyword%enum%strict) THEN 00791 WRITE (unit_nr,"(' other integer values are also accepted.')") 00792 END IF 00793 END IF 00794 IF (SIZE(keyword%names)>1) THEN 00795 WRITE(unit_nr,"(a)",advance="NO") '<TR><TD WIDTH="10%"><TD>variants: ' 00796 DO i=2,SIZE(keyword%names) 00797 WRITE(unit_nr,"(a)",advance="NO") TRIM(keyword%names(i)) 00798 IF (i .NE. SIZE(keyword%names)) THEN 00799 WRITE (unit_nr,'(a)',advance='NO') ', ' 00800 ENDIF 00801 END DO 00802 ENDIF 00803 ENDIF 00804 IF (ASSOCIATED(keyword%citations)) THEN 00805 IF (SIZE(keyword%citations,1)>1) THEN 00806 WRITE(unit_nr,FMT='(A)') '<BR> This keyword cites following references: ' 00807 ELSE 00808 WRITE(unit_nr,FMT='(A)') '<BR> This keyword cites following reference: ' 00809 ENDIF 00810 DO iref=1,SIZE(keyword%citations,1) 00811 WRITE(unit_nr,FMT='(A,I0,A)') & 00812 '<A HREF="references.html#reference_',keyword%citations(iref),'" TITLE="' 00813 CALL print_reference(keyword%citations(iref),FORMAT=print_format_journal,unit=unit_nr) 00814 WRITE(179,FMT='(A)') & 00815 '">[' // TRIM(get_citation_key( keyword%citations(iref) )) // ']</A>' 00816 ENDDO 00817 ENDIF 00818 00819 END SUBROUTINE keyword_describe_html 00820 00821 ! ***************************************************************************** 00829 SUBROUTINE write_keyword_xml(keyword,level,unit_number,error) 00830 00831 TYPE(keyword_type), POINTER :: keyword 00832 INTEGER, INTENT(IN) :: level, unit_number 00833 TYPE(cp_error_type), INTENT(INOUT) :: error 00834 00835 CHARACTER(LEN=*), PARAMETER :: routineN = 'write_keyword_xml', 00836 routineP = moduleN//':'//routineN 00837 00838 CHARACTER(LEN=1000) :: string 00839 CHARACTER(LEN=3) :: repeats, required 00840 CHARACTER(LEN=8) :: short_string 00841 INTEGER :: i, l0, l1, l2, l3, l4 00842 LOGICAL :: failure 00843 00844 failure = .FALSE. 00845 CPPrecondition(ASSOCIATED(keyword),cp_failure_level,routineP,error,failure) 00846 CPPrecondition(keyword%ref_count>0,cp_failure_level,routineP,error,failure) 00847 00848 IF (.NOT.failure) THEN 00849 00850 ! Indentation for current level, next level, etc. 00851 00852 l0 = level 00853 l1 = level + 1 00854 l2 = level + 2 00855 l3 = level + 3 00856 l4 = level + 4 00857 00858 IF (keyword%required) THEN 00859 required = "yes" 00860 ELSE 00861 required = "no " 00862 END IF 00863 00864 IF (keyword%repeats) THEN 00865 repeats = "yes" 00866 ELSE 00867 repeats = "no " 00868 END IF 00869 00870 ! Write (special) keyword element 00871 00872 IF (keyword%names(1) == "_SECTION_PARAMETERS_") THEN 00873 WRITE (UNIT=unit_number,FMT="(A)")& 00874 REPEAT(" ",l0)//"<SECTION_PARAMETERS required="""//TRIM(required)//& 00875 """ repeats="""//TRIM(repeats)//""">",& 00876 REPEAT(" ",l1)//"<NAME type=""default"">SECTION_PARAMETERS</NAME>" 00877 ELSE IF (keyword%names(1) == "_DEFAULT_KEYWORD_") THEN 00878 WRITE (UNIT=unit_number,FMT="(A)")& 00879 REPEAT(" ",l0)//"<DEFAULT_KEYWORD required="""//TRIM(required)//& 00880 """ repeats="""//TRIM(repeats)//""">",& 00881 REPEAT(" ",l1)//"<NAME type=""default"">DEFAULT_KEYWORD</NAME>" 00882 ELSE 00883 WRITE (UNIT=unit_number,FMT="(A)")& 00884 REPEAT(" ",l0)//"<KEYWORD required="""//TRIM(required)//& 00885 """ repeats="""//TRIM(repeats)//""">",& 00886 REPEAT(" ",l1)//"<NAME type=""default"">"//& 00887 TRIM(keyword%names(1))//"</NAME>" 00888 END IF 00889 00890 DO i=2,SIZE(keyword%names) 00891 WRITE (UNIT=unit_number,FMT="(A)")& 00892 REPEAT(" ",l1)//"<NAME type=""alias"">"//& 00893 TRIM(keyword%names(i))//"</NAME>" 00894 END DO 00895 00896 SELECT CASE(keyword%type_of_var) 00897 CASE (logical_t) 00898 WRITE (UNIT=unit_number,FMT="(A)")& 00899 REPEAT(" ",l1)//"<DATA_TYPE kind=""logical"">" 00900 CASE (integer_t) 00901 WRITE (UNIT=unit_number,FMT="(A)")& 00902 REPEAT(" ",l1)//"<DATA_TYPE kind=""integer"">" 00903 CASE (real_t) 00904 WRITE (UNIT=unit_number,FMT="(A)")& 00905 REPEAT(" ",l1)//"<DATA_TYPE kind=""real"">" 00906 CASE (char_t) 00907 WRITE (UNIT=unit_number,FMT="(A)")& 00908 REPEAT(" ",l1)//"<DATA_TYPE kind=""word"">" 00909 CASE (lchar_t) 00910 WRITE (UNIT=unit_number,FMT="(A)")& 00911 REPEAT(" ",l1)//"<DATA_TYPE kind=""string"">" 00912 CASE (enum_t) 00913 WRITE (UNIT=unit_number,FMT="(A)")& 00914 REPEAT(" ",l1)//"<DATA_TYPE kind=""keyword"">" 00915 IF (keyword%enum%strict) THEN 00916 WRITE (UNIT=unit_number,FMT="(A)")& 00917 REPEAT(" ",l2)//"<ENUMERATION strict=""yes"">" 00918 ELSE 00919 WRITE (UNIT=unit_number,FMT="(A)")& 00920 REPEAT(" ",l2)//"<ENUMERATION strict=""no"">" 00921 END IF 00922 DO i=1,SIZE(keyword%enum%c_vals) 00923 CALL substitute_special_xml_tokens(keyword%enum%desc(i),string,& 00924 ltu=.FALSE.) 00925 WRITE (UNIT=unit_number,FMT="(A)")& 00926 REPEAT(" ",l3)//"<ITEM>",& 00927 REPEAT(" ",l4)//"<NAME>"//& 00928 TRIM(ADJUSTL(keyword%enum%c_vals(i)))//"</NAME>",& 00929 REPEAT(" ",l4)//"<DESCRIPTION>"//& 00930 TRIM(ADJUSTL(string))//"</DESCRIPTION>",& 00931 REPEAT(" ",l3)//"</ITEM>" 00932 END DO 00933 WRITE (UNIT=unit_number,FMT="(A)") REPEAT(" ",l2)//"</ENUMERATION>" 00934 CASE (no_t) 00935 WRITE (UNIT=unit_number,FMT="(A)")& 00936 REPEAT(" ",l1)//"<DATA_TYPE kind=""non-standard type"">" 00937 CASE DEFAULT 00938 CPAssert(.FALSE.,cp_warning_level,routineP,error,failure) 00939 END SELECT 00940 00941 short_string = "" 00942 WRITE (UNIT=short_string,FMT="(I8)") keyword%n_var 00943 WRITE (UNIT=unit_number,FMT="(A)")& 00944 REPEAT(" ",l2)//"<N_VAR>"//TRIM(ADJUSTL(short_string))//"</N_VAR>",& 00945 REPEAT(" ",l1)//"</DATA_TYPE>" 00946 00947 CALL substitute_special_xml_tokens(keyword%usage,string,ltu=.TRUE.) 00948 WRITE (UNIT=unit_number,FMT="(A)")& 00949 REPEAT(" ",l1)//"<USAGE>"//TRIM(string)//"</USAGE>" 00950 00951 CALL substitute_special_xml_tokens(keyword%description,string,ltu=.FALSE.) 00952 WRITE (UNIT=unit_number,FMT="(A)")& 00953 REPEAT(" ",l1)//"<DESCRIPTION>"//TRIM(string)//"</DESCRIPTION>" 00954 00955 IF (ASSOCIATED(keyword%default_value).AND.& 00956 (keyword%type_of_var /= no_t)) THEN 00957 IF (ASSOCIATED(keyword%unit)) THEN 00958 CALL val_write_internal(val=keyword%default_value,& 00959 string=string,& 00960 unit=keyword%unit,& 00961 error=error) 00962 ELSE 00963 CALL val_write_internal(val=keyword%default_value,& 00964 string=string,& 00965 error=error) 00966 END IF 00967 CALL compress(string) 00968 WRITE (UNIT=unit_number,FMT="(A)")& 00969 REPEAT(" ",l1)//"<DEFAULT_VALUE>"//& 00970 TRIM(ADJUSTL(string))//"</DEFAULT_VALUE>" 00971 END IF 00972 00973 IF (ASSOCIATED(keyword%unit)) THEN 00974 string = cp_unit_desc(keyword%unit,accept_undefined=.TRUE.,error=error) 00975 WRITE (UNIT=unit_number,FMT="(A)")& 00976 REPEAT(" ",l1)//"<DEFAULT_UNIT>"//& 00977 TRIM(ADJUSTL(string))//"</DEFAULT_UNIT>" 00978 END IF 00979 00980 IF (ASSOCIATED(keyword%lone_keyword_value).AND.& 00981 (keyword%type_of_var /= no_t)) THEN 00982 CALL val_write_internal(val=keyword%lone_keyword_value,& 00983 string=string,& 00984 error=error) 00985 WRITE (UNIT=unit_number,FMT="(A)")& 00986 REPEAT(" ",l1)//"<LONE_KEYWORD_VALUE>"//& 00987 TRIM(ADJUSTL(string))//"</LONE_KEYWORD_VALUE>" 00988 END IF 00989 00990 IF (ASSOCIATED(keyword%citations)) THEN 00991 DO i=1,SIZE(keyword%citations,1) 00992 short_string = "" 00993 WRITE (UNIT=short_string,FMT="(I8)") keyword%citations(i) 00994 WRITE (UNIT=unit_number,FMT="(A)")& 00995 REPEAT(" ",l1)//"<REFERENCE>",& 00996 REPEAT(" ",l2)//"<NAME>"//TRIM(get_citation_key(keyword%citations(i)))//"</NAME>",& 00997 REPEAT(" ",l2)//"<NUMBER>"//TRIM(ADJUSTL(short_string))//"</NUMBER>",& 00998 REPEAT(" ",l1)//"</REFERENCE>" 00999 END DO 01000 END IF 01001 01002 ! Close (special) keyword section 01003 01004 IF (keyword%names(1) == "_SECTION_PARAMETERS_") THEN 01005 WRITE (UNIT=unit_number,FMT="(A)")& 01006 REPEAT(" ",l0)//"</SECTION_PARAMETERS>" 01007 ELSE IF (keyword%names(1) == "_DEFAULT_KEYWORD_") THEN 01008 WRITE (UNIT=unit_number,FMT="(A)")& 01009 REPEAT(" ",l0)//"</DEFAULT_KEYWORD>" 01010 ELSE 01011 WRITE (UNIT=unit_number,FMT="(A)")& 01012 REPEAT(" ",l0)//"</KEYWORD>" 01013 END IF 01014 01015 END IF 01016 01017 END SUBROUTINE write_keyword_xml 01018 01019 ! ***************************************************************************** 01020 SUBROUTINE keyword_typo_match(keyword,unknown_string,location_string,matching_rank,matching_string,error) 01021 01022 TYPE(keyword_type), POINTER :: keyword 01023 CHARACTER(LEN=*) :: unknown_string, 01024 location_string 01025 INTEGER, DIMENSION(:), INTENT(INOUT) :: matching_rank 01026 CHARACTER(LEN=*), DIMENSION(:), 01027 INTENT(INOUT) :: matching_string 01028 TYPE(cp_error_type), INTENT(INOUT) :: error 01029 01030 CHARACTER(LEN=*), PARAMETER :: routineN = 'keyword_typo_match', 01031 routineP = moduleN//':'//routineN 01032 01033 CHARACTER(LEN=LEN(matching_string(1))) :: line 01034 INTEGER :: i, imatch, imax, irank, j, k 01035 LOGICAL :: failure 01036 01037 failure = .FALSE. 01038 CPPrecondition(ASSOCIATED(keyword),cp_failure_level,routineP,error,failure) 01039 CPPrecondition(keyword%ref_count>0,cp_failure_level,routineP,error,failure) 01040 01041 IF (.NOT.failure) THEN 01042 01043 DO i=1,SIZE(keyword%names) 01044 imatch=typo_match(TRIM(keyword%names(i)),TRIM(unknown_string)) 01045 IF (imatch>0) THEN 01046 WRITE(line,'(T2,A)') " keyword "//TRIM(keyword%names(i))//" in section "//TRIM(location_string) 01047 imax=SIZE(matching_rank,1) 01048 irank=imax+1 01049 DO k=imax,1,-1 01050 IF (imatch>matching_rank(k)) irank=k 01051 ENDDO 01052 IF (irank<=imax) THEN 01053 matching_rank(irank+1:imax)=matching_rank(irank:imax-1) 01054 matching_string(irank+1:imax)=matching_string(irank:imax-1) 01055 matching_rank(irank)=imatch 01056 matching_string(irank)=line 01057 ENDIF 01058 END IF 01059 01060 IF (keyword%type_of_var==enum_t) THEN 01061 DO j=1,SIZE(keyword%enum%c_vals) 01062 imatch=typo_match(TRIM(keyword%enum%c_vals(j)),TRIM(unknown_string)) 01063 IF (imatch>0) THEN 01064 WRITE(line,'(T2,A)') " enum "//TRIM(keyword%enum%c_vals(j))//& 01065 " in section "//TRIM(location_string)// & 01066 " for keyword "//TRIM(keyword%names(i)) 01067 imax=SIZE(matching_rank,1) 01068 irank=imax+1 01069 DO k=imax,1,-1 01070 IF (imatch>matching_rank(k)) irank=k 01071 ENDDO 01072 IF (irank<=imax) THEN 01073 matching_rank(irank+1:imax)=matching_rank(irank:imax-1) 01074 matching_string(irank+1:imax)=matching_string(irank:imax-1) 01075 matching_rank(irank)=imatch 01076 matching_string(irank)=line 01077 ENDIF 01078 END IF 01079 END DO 01080 END IF 01081 ENDDO 01082 END IF 01083 01084 END SUBROUTINE keyword_typo_match 01085 01086 END MODULE input_keyword_types
1.7.3