|
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 ! ***************************************************************************** 00023 MODULE cp_output_handling 00024 USE cp_files, ONLY: close_file,& 00025 open_file 00026 USE cp_iter_types, ONLY: cp_iteration_info_release,& 00027 cp_iteration_info_retain,& 00028 cp_iteration_info_type,& 00029 each_desc_labels,& 00030 each_possible_labels 00031 USE f77_blas 00032 USE input_constants, ONLY: add_last_no,& 00033 add_last_numeric,& 00034 add_last_symbolic,& 00035 debug_print_level,& 00036 high_print_level,& 00037 low_print_level,& 00038 medium_print_level,& 00039 silent_print_level 00040 USE input_keyword_types, ONLY: keyword_create,& 00041 keyword_release,& 00042 keyword_type 00043 USE input_section_types, ONLY: section_add_keyword,& 00044 section_add_subsection,& 00045 section_create,& 00046 section_release,& 00047 section_type,& 00048 section_vals_get_subs_vals,& 00049 section_vals_type,& 00050 section_vals_val_get 00051 USE kinds, ONLY: default_path_length,& 00052 default_string_length 00053 USE machine, ONLY: m_mov 00054 USE memory_utilities, ONLY: reallocate 00055 USE string_utilities, ONLY: compress,& 00056 s2a 00057 #include "cp_common_uses.h" 00058 00059 IMPLICIT NONE 00060 PRIVATE 00061 00062 LOGICAL, PRIVATE, PARAMETER :: debug_this_module=.TRUE. 00063 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_output_handling' 00064 PUBLIC :: cp_print_key_should_output, cp_iterate, cp_add_iter_level, cp_rm_iter_level 00065 PUBLIC :: cp_iter_string, cp_print_key_section_create 00066 PUBLIC :: cp_print_key_unit_nr, cp_print_key_finished_output 00067 PUBLIC :: cp_print_key_generate_filename, cp_print_key_log, cp_printkey_is_on 00068 00069 !! flags controlling the printing and storing of a property. 00070 !! 00071 !! cp_out_none: do not calculate the property 00072 !! cp_out_file_if : if the printkey says it calculate and output the property 00073 !! cp_out_store_if : if the printkey says it calculate and store in memory 00074 !! the property 00075 !! cp_out_file_each: calculate and output the property with the same periodicity 00076 !! as said in the printkey (irrespective of the activation of 00077 !! the printkey) 00078 !! cp_out_store_each: calculate and store the property with the same periodicity 00079 !! as said in the printkey (irrespective of the activation of 00080 !! the printkey) 00081 !! cp_out_file: always calculate and output the property 00082 !! cp_out_store: always calculate and store in memory the property 00083 !! cp_out_calc: just calculate the value (indipendently from the fact that there 00084 !! should be output) 00085 !! cp_out_default: the default value for proprety flags (cp_out_file_if) 00086 !! 00087 !! this flags can be ior-ed together: 00088 !! ior(cp_out_file_if,cp_out_store_if): if the printkey says it both print 00089 !! and store the property 00090 !! 00091 !! there is no guarantee that a proprety is not stored if it is not necessary 00092 !! not all printkeys have a control flag 00093 INTEGER, PUBLIC, PARAMETER :: cp_p_file_if=3,cp_p_store_if=4, 00094 cp_p_store=2,cp_p_file=1,cp_p_file_each=5,cp_p_store_each=6,cp_p_calc=7 00095 INTEGER, PUBLIC, PARAMETER :: cp_out_none=0, cp_out_file_if=IBSET(0,cp_p_file_if), 00096 cp_out_store_if=IBSET(0,cp_p_store_if), cp_out_file=IBSET(0,cp_p_file), 00097 cp_out_store=IBSET(0,cp_p_store), cp_out_calc=IBSET(0,cp_p_calc), 00098 cp_out_file_each=IBSET(0,cp_p_file_each), 00099 cp_out_store_each=IBSET(0,cp_p_store_each), 00100 cp_out_default=cp_out_file_if 00101 00102 INTEGER, SAVE, PRIVATE :: last_flags_id=0 00103 00104 ! ***************************************************************************** 00128 TYPE cp_out_flags_type 00129 INTEGER :: ref_count, id_nr, n_flags 00130 CHARACTER(default_string_length), DIMENSION(:), POINTER :: names 00131 INTEGER, DIMENSION(:), POINTER :: control_val 00132 TYPE(section_vals_type), POINTER :: input 00133 TYPE(cp_logger_type), POINTER :: logger 00134 LOGICAL :: strict 00135 INTEGER :: default_val 00136 END TYPE cp_out_flags_type 00137 00138 CONTAINS 00139 00140 ! ***************************************************************************** 00154 SUBROUTINE cp_print_key_section_create(print_key_section, name, description, & 00155 print_level,each_iter_names,each_iter_values,add_last,filename,& 00156 common_iter_levels,citations,supported_feature,unit_str,error) 00157 TYPE(section_type), POINTER :: print_key_section 00158 CHARACTER(len=*), INTENT(IN) :: name, description 00159 INTEGER, INTENT(IN), OPTIONAL :: print_level 00160 CHARACTER(LEN=*), DIMENSION(:), 00161 INTENT(IN), OPTIONAL :: each_iter_names 00162 INTEGER, DIMENSION(:), INTENT(IN), 00163 OPTIONAL :: each_iter_values 00164 INTEGER, INTENT(IN), OPTIONAL :: add_last 00165 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: filename 00166 INTEGER, INTENT(IN), OPTIONAL :: common_iter_levels 00167 INTEGER, DIMENSION(:), OPTIONAL :: citations 00168 LOGICAL, INTENT(IN), OPTIONAL :: supported_feature 00169 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: unit_str 00170 TYPE(cp_error_type), INTENT(INOUT) :: error 00171 00172 CHARACTER(len=*), PARAMETER :: routineN = 'cp_print_key_section_create', 00173 routineP = moduleN//':'//routineN 00174 00175 CHARACTER(len=default_path_length) :: my_filename 00176 INTEGER :: i_each, i_iter, my_add_last, 00177 my_comm_iter_levels, 00178 my_print_level, my_value 00179 LOGICAL :: check, ext_each, failure 00180 TYPE(keyword_type), POINTER :: keyword 00181 TYPE(section_type), POINTER :: subsection 00182 00183 failure=.FALSE. 00184 00185 CPPrecondition(.NOT.ASSOCIATED(print_key_section),cp_failure_level,routineP,error,failure) 00186 IF (.NOT. failure) THEN 00187 my_print_level=debug_print_level 00188 IF (PRESENT(print_level)) my_print_level=print_level 00189 00190 CALL section_create(print_key_section,name=name,description=description,& 00191 n_keywords=2, n_subsections=0, repeats=.FALSE., required=.FALSE.,& 00192 citations=citations, supported_feature=supported_feature, error=error) 00193 00194 NULLIFY(keyword, subsection) 00195 CALL keyword_create(keyword, name="_SECTION_PARAMETERS_",& 00196 description="Level starting at which this proprety is printed",& 00197 usage="silent",& 00198 default_i_val=my_print_level,lone_keyword_i_val=silent_print_level,& 00199 enum_c_vals=s2a("on","off","silent","low","medium","high","debug"),& 00200 enum_i_vals=(/ silent_print_level-1,debug_print_level+1,& 00201 silent_print_level, low_print_level,& 00202 medium_print_level,high_print_level,debug_print_level/),& 00203 supported_feature=supported_feature,error=error) 00204 CALL section_add_keyword(print_key_section,keyword,error=error) 00205 CALL keyword_release(keyword,error=error) 00206 00207 CALL section_create(subsection,name="EACH",& 00208 description="This section specifies how often this proprety is printed."//& 00209 "Each keyword inside this section is mapping to a specific iteration level and "//& 00210 "the value of each of these keywords is matched with the iteration level during "//& 00211 "the calculation. How to handle the last iteration is treated "//& 00212 "separately in ADD_LAST (this mean that each iteration level (MD, GEO_OPT, etc..), "//& 00213 "though equal to 0, might print the last iteration). If an iteration level is specified "//& 00214 "that is not present in the flow of the calculation it is just ignored.",& 00215 n_keywords=2, n_subsections=0, repeats=.FALSE., required=.FALSE.,& 00216 citations=citations, supported_feature=supported_feature, error=error) 00217 00218 ! Enforce the presence or absence of both.. or give an error 00219 check = (PRESENT(each_iter_names)).EQV.(PRESENT(each_iter_values)) 00220 CPPrecondition(check,cp_failure_level,routineP,error,failure) 00221 ext_each = (PRESENT(each_iter_names)).AND.(PRESENT(each_iter_values)) 00222 00223 DO i_each = 1, SIZE(each_possible_labels) 00224 my_value = 1 00225 IF (ext_each) THEN 00226 check = SUM(INDEX(each_iter_names,each_possible_labels(i_each)))<=1 00227 CPPrecondition(check,cp_failure_level,routineP,error,failure) 00228 DO i_iter = 1, SIZE(each_iter_names) 00229 IF (INDEX(TRIM(each_iter_names(i_iter)),TRIM(each_possible_labels(i_each)))/=0) THEN 00230 my_value = each_iter_values(i_iter) 00231 END IF 00232 END DO 00233 END IF 00234 CALL keyword_create(keyword, name=TRIM(each_possible_labels(i_each)),& 00235 description=TRIM(each_desc_labels(i_each)),& 00236 usage=TRIM(each_possible_labels(i_each))//" <INTEGER>",& 00237 default_i_val=my_value, supported_feature=supported_feature, error=error) 00238 CALL section_add_keyword(subsection,keyword,error=error) 00239 CALL keyword_release(keyword,error=error) 00240 END DO 00241 CALL section_add_subsection(print_key_section,subsection,error=error) 00242 CALL section_release(subsection,error=error) 00243 00244 my_add_last = add_last_no 00245 IF (PRESENT(add_last)) THEN 00246 my_add_last = add_last 00247 END IF 00248 CALL keyword_create(keyword, name="ADD_LAST",& 00249 description="If the last iteration should be added, and if it "//& 00250 "should be marked symbolically (with l) or with the iteration "//& 00251 "number."//& 00252 "Not every iteration level is able to identify the last iteration "//& 00253 "early enough to be able to output. When this keyword is activated "//& 00254 "all iteration levels are checked for the last iteration step.",& 00255 usage="ADD_LAST NUMERIC",& 00256 enum_c_vals=s2a("no","numeric","symbolic"),& 00257 enum_i_vals=(/add_last_no, add_last_numeric, add_last_symbolic/),& 00258 default_i_val=my_add_last,supported_feature=supported_feature,error=error) 00259 CALL section_add_keyword(print_key_section,keyword,error=error) 00260 CALL keyword_release(keyword,error=error) 00261 00262 my_comm_iter_levels=0 00263 IF (PRESENT(common_iter_levels)) my_comm_iter_levels=common_iter_levels 00264 CALL keyword_create(keyword, name="COMMON_ITERATION_LEVELS",& 00265 description="How many iterations levels should be written"//& 00266 " in the same file (no extra information about the actual"//& 00267 " iteration level is written to the file)",& 00268 usage="COMMON_ITERATION_LEVELS <INTEGER>",& 00269 default_i_val=my_comm_iter_levels, supported_feature=supported_feature,error=error) 00270 CALL section_add_keyword(print_key_section,keyword,error=error) 00271 CALL keyword_release(keyword,error=error) 00272 00273 my_filename="" 00274 IF (PRESENT(filename)) my_filename=filename 00275 CALL keyword_create(keyword, name="FILENAME",& 00276 description=' controls part of the filename for output. '//& 00277 ' use __STD_OUT__ (exactly as written here) for the screen or standard logger. '//& 00278 ' use filename to obtain projectname-filename. '//& 00279 ' use ./filename to get filename.'//& 00280 ' A middle name (if present), iteration numbers'//& 00281 ' and extension are always added to the filename.'//& 00282 ' if you want to avoid it use =filename, in this'//& 00283 ' case the filename is always exactly as typed.'//& 00284 ' Please note that this can lead to clashes of'//& 00285 ' filenames.',& 00286 usage="FILENAME ./filename ",& 00287 default_lc_val=my_filename, supported_feature=supported_feature,error=error) 00288 CALL section_add_keyword(print_key_section,keyword,error=error) 00289 CALL keyword_release(keyword,error=error) 00290 00291 CALL keyword_create(keyword, name="LOG_PRINT_KEY",& 00292 description="This keywords enables the logger for the print_key (a message is printed on "//& 00293 "screen everytime data, controlled by this print_key, are written)",& 00294 usage="LOG_PRINT_KEY <LOGICAL>", default_l_val=.FALSE., lone_keyword_l_val=.TRUE.,& 00295 supported_feature=supported_feature, error=error) 00296 CALL section_add_keyword(print_key_section,keyword,error=error) 00297 CALL keyword_release(keyword,error=error) 00298 00299 CALL keyword_create(keyword, name="__CONTROL_VAL",& 00300 description=' hidden parameter that controls storage, printing,...'//& 00301 ' of the print_key',& 00302 default_i_val=cp_out_default, supported_feature=supported_feature,error=error) 00303 CALL section_add_keyword(print_key_section,keyword,error=error) 00304 CALL keyword_release(keyword,error=error) 00305 00306 IF (PRESENT(unit_str)) THEN 00307 CALL keyword_create(keyword, name="UNIT",& 00308 description='Specify the unit of measurement for the quantity in output. '//& 00309 "All available CP2K units can be used.",& 00310 usage="UNIT angstrom",default_c_val=TRIM(unit_str),supported_feature=supported_feature,& 00311 error=error) 00312 CALL section_add_keyword(print_key_section,keyword,error=error) 00313 CALL keyword_release(keyword,error=error) 00314 END IF 00315 END IF 00316 END SUBROUTINE cp_print_key_section_create 00317 00318 ! ***************************************************************************** 00336 FUNCTION cp_print_key_should_output(iteration_info,basis_section,& 00337 print_key_path,used_print_key,first_time,error)& 00338 RESULT(res) 00339 TYPE(cp_iteration_info_type), POINTER :: iteration_info 00340 TYPE(section_vals_type), POINTER :: basis_section 00341 CHARACTER(len=*), INTENT(IN), OPTIONAL :: print_key_path 00342 TYPE(section_vals_type), OPTIONAL, 00343 POINTER :: used_print_key 00344 LOGICAL, INTENT(OUT), OPTIONAL :: first_time 00345 TYPE(cp_error_type), INTENT(INOUT) :: error 00346 INTEGER :: res 00347 00348 CHARACTER(len=*), PARAMETER :: routineN = 'cp_print_key_should_output', 00349 routineP = moduleN//':'//routineN 00350 00351 INTEGER :: end_str, my_control_val, 00352 to_path 00353 LOGICAL :: failure, flags, is_iter, is_on 00354 TYPE(section_vals_type), POINTER :: print_key 00355 00356 failure=.FALSE. 00357 res=0 00358 IF (PRESENT(first_time)) first_time=.FALSE. 00359 CPPrecondition(ASSOCIATED(basis_section),cp_failure_level,routineP,error,failure) 00360 CPPrecondition(basis_section%ref_count>0,cp_failure_level,routineP,error,failure) 00361 IF (PRESENT(used_print_key)) NULLIFY(used_print_key) 00362 IF (failure) THEN 00363 IF (iteration_info%print_level>=debug_print_level) res=cp_out_default 00364 RETURN 00365 END IF 00366 00367 IF (PRESENT(print_key_path)) THEN 00368 end_str=LEN_TRIM(print_key_path) 00369 to_path=INDEX(print_key_path,"/") 00370 IF (to_path<1) THEN 00371 to_path=end_str+1 00372 END IF 00373 00374 IF (to_path>1) THEN 00375 print_key => section_vals_get_subs_vals(basis_section,& 00376 print_key_path(1:(to_path-1)),error=error) 00377 ELSE 00378 print_key => basis_section 00379 END IF 00380 CPPrecondition(ASSOCIATED(print_key),cp_failure_level,routineP,error,failure) 00381 CPPrecondition(print_key%ref_count>0,cp_failure_level,routineP,error,failure) 00382 IF (to_path+1<end_str) THEN 00383 CALL section_vals_val_get(print_key,print_key_path((to_path+1):end_str),& 00384 l_val=flags,error=error) 00385 ELSE 00386 flags=.TRUE. 00387 END IF 00388 ELSE 00389 print_key => basis_section 00390 flags=.TRUE. 00391 END IF 00392 IF (PRESENT(used_print_key)) used_print_key => print_key 00393 00394 IF (.NOT.flags) RETURN 00395 00396 CALL section_vals_val_get(print_key,"__CONTROL_VAL",& 00397 i_val=my_control_val,error=error) 00398 is_on=cp_printkey_is_on(iteration_info,print_key,error=error) 00399 is_iter=cp_printkey_is_iter(iteration_info,print_key,first_time=first_time,& 00400 error=error) 00401 00402 IF (BTEST(my_control_val,cp_p_store)) THEN 00403 res=IBSET(res,cp_p_store) 00404 ELSE IF (BTEST(my_control_val,cp_p_store_if).and.is_iter.and.is_on) THEN 00405 res=IBSET(res,cp_p_store) 00406 ELSE IF (BTEST(my_control_val,cp_p_store_each).and.is_iter) THEN 00407 res=IBSET(res,cp_p_store) 00408 END IF 00409 00410 IF (BTEST(my_control_val,cp_p_file)) THEN 00411 res=IBSET(res,cp_p_file) 00412 ELSE IF (BTEST(my_control_val,cp_p_file_if).and.is_iter.and.is_on) THEN 00413 res=IBSET(res,cp_p_file) 00414 ELSE IF (BTEST(my_control_val,cp_p_file_each).and.is_iter) THEN 00415 res=IBSET(res,cp_p_file) 00416 END IF 00417 IF (BTEST(my_control_val,cp_p_calc).OR.res/=0) THEN 00418 res=IBSET(res,cp_p_calc) 00419 END IF 00420 END FUNCTION cp_print_key_should_output 00421 00422 ! ***************************************************************************** 00431 FUNCTION cp_printkey_is_on(iteration_info,print_key,error) RESULT(res) 00432 TYPE(cp_iteration_info_type), POINTER :: iteration_info 00433 TYPE(section_vals_type), POINTER :: print_key 00434 TYPE(cp_error_type), INTENT(INOUT) :: error 00435 LOGICAL :: res 00436 00437 CHARACTER(len=*), PARAMETER :: routineN = 'cp_printkey_is_on', 00438 routineP = moduleN//':'//routineN 00439 00440 INTEGER :: print_level 00441 LOGICAL :: failure 00442 00443 failure=.FALSE. 00444 CPPrecondition(ASSOCIATED(iteration_info),cp_failure_level,routineP,error,failure) 00445 CPPrecondition(iteration_info%ref_count>0,cp_failure_level,routineP,error,failure) 00446 IF (.NOT. failure) THEN 00447 IF (.NOT.ASSOCIATED(print_key)) THEN 00448 res=(iteration_info%print_level > debug_print_level) 00449 ELSE 00450 CPPrecondition(print_key%ref_count>0,cp_failure_level,routineP,error,failure) 00451 CALL section_vals_val_get(print_key,"_SECTION_PARAMETERS_",i_val=print_level,error=error) 00452 res=iteration_info%print_level>=print_level 00453 END IF 00454 END IF 00455 END FUNCTION cp_printkey_is_on 00456 00457 ! ***************************************************************************** 00469 FUNCTION cp_printkey_is_iter(iteration_info,print_key,first_time,error)& 00470 RESULT(res) 00471 TYPE(cp_iteration_info_type), POINTER :: iteration_info 00472 TYPE(section_vals_type), POINTER :: print_key 00473 LOGICAL, INTENT(OUT), OPTIONAL :: first_time 00474 TYPE(cp_error_type), INTENT(INOUT) :: error 00475 LOGICAL :: res 00476 00477 CHARACTER(len=*), PARAMETER :: routineN = 'cp_printkey_is_iter', 00478 routineP = moduleN//':'//routineN 00479 00480 INTEGER :: add_last, ilevel, iter_nr, 00481 ival 00482 LOGICAL :: failure, first, level_passed 00483 00484 failure=.FALSE. 00485 CPPrecondition(ASSOCIATED(iteration_info),cp_failure_level,routineP,error,failure) 00486 CPPrecondition(iteration_info%ref_count>0,cp_failure_level,routineP,error,failure) 00487 IF (.NOT.ASSOCIATED(print_key)) THEN 00488 res=(iteration_info%print_level > debug_print_level) 00489 first=ALL(iteration_info%iteration(1:iteration_info%n_rlevel)==1) 00490 ELSE 00491 CPPrecondition(print_key%ref_count>0,cp_failure_level,routineP,error,failure) 00492 res = .FALSE. 00493 first = .FALSE. 00494 IF (.NOT. failure) THEN 00495 CALL section_vals_val_get(print_key,"ADD_LAST",i_val=add_last,error=error) 00496 res =.TRUE. 00497 first=.TRUE. 00498 DO ilevel=1,iteration_info%n_rlevel 00499 level_passed=.FALSE. 00500 CALL section_vals_val_get(print_key,"EACH%"//TRIM(iteration_info%level_name(ilevel)),& 00501 i_val=ival,error=error) 00502 IF (ival>0) THEN 00503 iter_nr=iteration_info%iteration(ilevel) 00504 IF (iter_nr/ival>1) first=.FALSE. 00505 IF (MODULO(iter_nr,ival)==0) THEN 00506 level_passed=.TRUE. 00507 END IF 00508 END IF 00509 IF (add_last==add_last_numeric .OR. add_last==add_last_symbolic) THEN 00510 IF (iteration_info%last_iter(ilevel)) THEN 00511 level_passed=.TRUE. 00512 END IF 00513 END IF 00514 IF (.NOT.level_passed) res=.FALSE. 00515 END DO 00516 END IF 00517 END IF 00518 first=first.AND.res 00519 IF (PRESENT(first_time)) first_time=first 00520 END FUNCTION cp_printkey_is_iter 00521 00522 ! ***************************************************************************** 00539 FUNCTION cp_iter_string(iter_info,print_key,for_file,error) RESULT(res) 00540 TYPE(cp_iteration_info_type), POINTER :: iter_info 00541 TYPE(section_vals_type), OPTIONAL, 00542 POINTER :: print_key 00543 LOGICAL, INTENT(IN), OPTIONAL :: for_file 00544 TYPE(cp_error_type), INTENT(INOUT) :: error 00545 CHARACTER(len=default_string_length) :: res 00546 00547 CHARACTER(len=*), PARAMETER :: routineN = 'cp_iter_string', 00548 routineP = moduleN//':'//routineN 00549 00550 INTEGER :: add_last, c_i_level, ilevel, 00551 n_rlevel, s_level 00552 LOGICAL :: failure, my_for_file 00553 TYPE(section_vals_type), POINTER :: my_print_key 00554 00555 failure=.FALSE. 00556 00557 res="" 00558 my_for_file=.FALSE. 00559 IF (PRESENT(for_file)) my_for_file=for_file 00560 CPPrecondition(ASSOCIATED(iter_info),cp_failure_level,routineP,error,failure) 00561 CPPrecondition(iter_info%ref_count>0,cp_failure_level,routineP,error,failure) 00562 IF (.NOT. failure) THEN 00563 NULLIFY(my_print_key) 00564 IF (PRESENT(print_key)) my_print_key => print_key 00565 s_level=1 00566 IF (ASSOCIATED(my_print_key)) THEN 00567 CALL section_vals_val_get(my_print_key,"ADD_LAST",i_val=add_last,error=error) 00568 CALL section_vals_val_get(my_print_key,"COMMON_ITERATION_LEVELS",i_val=c_i_level, error=error) 00569 n_rlevel=iter_info%n_rlevel 00570 IF (my_for_file) n_rlevel=MIN(n_rlevel,MAX(0,n_rlevel-c_i_level)) 00571 DO ilevel=s_level,n_rlevel 00572 IF (iter_info%last_iter(ilevel)) THEN 00573 IF (add_last==add_last_symbolic) THEN 00574 WRITE(res(9*ilevel-8:9*ilevel),"('l_')") 00575 ELSE 00576 WRITE(res(9*ilevel-8:9*ilevel),"(i8,'_')") iter_info%iteration(ilevel) 00577 END IF 00578 ELSE 00579 WRITE(res(9*ilevel-8:9*ilevel),"(i8,'_')") iter_info%iteration(ilevel) 00580 END IF 00581 END DO 00582 ELSE 00583 DO ilevel=s_level,iter_info%n_rlevel 00584 WRITE(res(9*ilevel-8:9*ilevel),"(i8,'_')") iter_info%iteration(ilevel) 00585 END DO 00586 END IF 00587 CALL compress(res,.TRUE.) 00588 IF (LEN_TRIM(res)>0) THEN 00589 res(LEN_TRIM(res):LEN_TRIM(res))=" " 00590 END IF 00591 END IF 00592 END FUNCTION cp_iter_string 00593 00594 ! ***************************************************************************** 00604 SUBROUTINE cp_iterate(iteration_info,last,iter_nr,increment,iter_nr_out,error) 00605 TYPE(cp_iteration_info_type), POINTER :: iteration_info 00606 LOGICAL, INTENT(IN), OPTIONAL :: last 00607 INTEGER, INTENT(IN), OPTIONAL :: iter_nr, increment 00608 INTEGER, INTENT(OUT), OPTIONAL :: iter_nr_out 00609 TYPE(cp_error_type), INTENT(INOUT) :: error 00610 00611 CHARACTER(len=*), PARAMETER :: routineN = 'cp_iterate', 00612 routineP = moduleN//':'//routineN 00613 00614 INTEGER :: my_increment 00615 LOGICAL :: failure, my_last 00616 00617 failure=.FALSE. 00618 my_last=.FALSE. 00619 my_increment = 1 00620 IF (PRESENT(last)) my_last = last 00621 IF (PRESENT(increment)) my_increment = increment 00622 IF (PRESENT(iter_nr_out)) iter_nr_out = -1 00623 00624 CPPrecondition(ASSOCIATED(iteration_info),cp_failure_level,routineP,error,failure) 00625 IF (.NOT. failure) THEN 00626 CPPrecondition(iteration_info%ref_count>0,cp_failure_level,routineP,error,failure) 00627 IF (PRESENT(iter_nr)) THEN 00628 iteration_info%iteration(iteration_info%n_rlevel)=iter_nr 00629 ELSE 00630 iteration_info%iteration(iteration_info%n_rlevel)=& 00631 iteration_info%iteration(iteration_info%n_rlevel)+my_increment 00632 END IF 00633 ! If requested provide the value of the iteration level 00634 IF (PRESENT(iter_nr_out)) iter_nr_out = iteration_info%iteration(iteration_info%n_rlevel) 00635 00636 ! Possibly setup the LAST flag 00637 iteration_info%last_iter(iteration_info%n_rlevel)=my_last 00638 END IF 00639 END SUBROUTINE cp_iterate 00640 00641 ! ***************************************************************************** 00651 SUBROUTINE cp_add_iter_level(iteration_info,level_name,n_rlevel_new,error) 00652 TYPE(cp_iteration_info_type), POINTER :: iteration_info 00653 CHARACTER(LEN=*), INTENT(IN) :: level_name 00654 INTEGER, INTENT(OUT), OPTIONAL :: n_rlevel_new 00655 TYPE(cp_error_type), INTENT(INOUT) :: error 00656 00657 CHARACTER(len=*), PARAMETER :: routineN = 'cp_add_iter_level', 00658 routineP = moduleN//':'//routineN 00659 00660 INTEGER :: i 00661 LOGICAL :: failure, found 00662 00663 failure=.FALSE. 00664 00665 CPPrecondition(ASSOCIATED(iteration_info),cp_failure_level,routineP,error,failure) 00666 CPPrecondition(iteration_info%ref_count>0,cp_failure_level,routineP,error,failure) 00667 IF (.NOT. failure) THEN 00668 found = .FALSE. 00669 DO i = 1, SIZE(each_possible_labels) 00670 IF (TRIM(level_name)==TRIM(each_possible_labels(i))) THEN 00671 found = .TRUE. 00672 EXIT 00673 END IF 00674 END DO 00675 IF (found) THEN 00676 CALL cp_iteration_info_retain(iteration_info) 00677 iteration_info%n_rlevel=iteration_info%n_rlevel+1 00678 CALL reallocate(iteration_info%iteration, 1, iteration_info%n_rlevel) 00679 CALL reallocate(iteration_info%level_name, 1, iteration_info%n_rlevel) 00680 CALL reallocate(iteration_info%last_iter, 1, iteration_info%n_rlevel) 00681 iteration_info%iteration(iteration_info%n_rlevel) = 0 00682 iteration_info%level_name(iteration_info%n_rlevel) = level_name 00683 iteration_info%last_iter(iteration_info%n_rlevel) = .FALSE. 00684 IF (PRESENT(n_rlevel_new)) n_rlevel_new=iteration_info%n_rlevel 00685 ELSE 00686 CALL cp_assert(.FALSE.,cp_failure_level,cp_assertion_failed,routineP,& 00687 "Trying to create an iteration level ("//TRIM(level_name)//") not defined."//& 00688 "Please update the module: cp_iter_types."//& 00689 CPSourceFileRef) 00690 END IF 00691 END IF 00692 00693 END SUBROUTINE cp_add_iter_level 00694 00695 ! ***************************************************************************** 00705 SUBROUTINE cp_rm_iter_level(iteration_info,level_name,n_rlevel_att,error) 00706 TYPE(cp_iteration_info_type), POINTER :: iteration_info 00707 CHARACTER(LEN=*), INTENT(IN) :: level_name 00708 INTEGER, INTENT(IN), OPTIONAL :: n_rlevel_att 00709 TYPE(cp_error_type), INTENT(INOUT) :: error 00710 00711 CHARACTER(len=*), PARAMETER :: routineN = 'cp_rm_iter_level', 00712 routineP = moduleN//':'//routineN 00713 00714 LOGICAL :: check, failure 00715 00716 failure=.FALSE. 00717 00718 CPPrecondition(ASSOCIATED(iteration_info),cp_failure_level,routineP,error,failure) 00719 CPPrecondition(iteration_info%ref_count>0,cp_failure_level,routineP,error,failure) 00720 IF (.NOT. failure) THEN 00721 IF (PRESENT(n_rlevel_att)) THEN 00722 CPPrecondition(n_rlevel_att==iteration_info%n_rlevel,cp_failure_level,routineP,error,failure) 00723 END IF 00724 CALL cp_iteration_info_release(iteration_info) 00725 ! This check that the iteration levels are consistently created and destroyed.. 00726 ! Never remove this check.. 00727 check = iteration_info%level_name(iteration_info%n_rlevel)==level_name 00728 CPPrecondition(check,cp_failure_level,routineP,error,failure) 00729 iteration_info%n_rlevel=iteration_info%n_rlevel-1 00730 CALL reallocate(iteration_info%iteration, 1, iteration_info%n_rlevel) 00731 CALL reallocate(iteration_info%level_name, 1, iteration_info%n_rlevel) 00732 CALL reallocate(iteration_info%last_iter, 1, iteration_info%n_rlevel) 00733 END IF 00734 END SUBROUTINE cp_rm_iter_level 00735 00736 ! ***************************************************************************** 00768 FUNCTION cp_print_key_generate_filename(logger,print_key,middle_name,extension,& 00769 my_local, error) RESULT(filename) 00770 TYPE(cp_logger_type), POINTER :: logger 00771 TYPE(section_vals_type), POINTER :: print_key 00772 CHARACTER(len=*), INTENT(IN), OPTIONAL :: middle_name 00773 CHARACTER(len=*), INTENT(IN) :: extension 00774 LOGICAL, INTENT(IN) :: my_local 00775 TYPE(cp_error_type), INTENT(INOUT) :: error 00776 CHARACTER(len=default_path_length) :: filename 00777 00778 CHARACTER(len=default_path_length) :: outPath, postfix, root 00779 CHARACTER(len=default_string_length) :: my_middle_name, outName 00780 INTEGER :: my_ind1, my_ind2 00781 LOGICAL :: has_root 00782 00783 CALL section_vals_val_get(print_key,"FILENAME",c_val=outPath,error=error) 00784 IF (outPath(1:1)=='=') THEN 00785 filename=outPath(2:LEN_TRIM(outPath)) 00786 RETURN 00787 END IF 00788 IF (outPath=="__STD_OUT__") outPath="" 00789 outName=outPath 00790 has_root=.FALSE. 00791 my_ind1=INDEX(outPath,"/") 00792 my_ind2 = LEN_TRIM(outPath) 00793 IF (my_ind1 /= 0) THEN 00794 has_root = .TRUE. 00795 DO WHILE (INDEX(outPath(my_ind1+1:my_ind2),"/")/=0) 00796 my_ind1 = INDEX(outPath(my_ind1+1:my_ind2),"/") + my_ind1 00797 END DO 00798 IF (my_ind1 == my_ind2) THEN 00799 outName="" 00800 ELSE 00801 outName = outPath(my_ind1+1:my_ind2) 00802 END IF 00803 END IF 00804 00805 IF (PRESENT(middle_name)) THEN 00806 IF (outName/="") THEN 00807 my_middle_name="-"//TRIM(outName)//"-"//middle_name 00808 ELSE 00809 my_middle_name="-"//middle_name 00810 END IF 00811 ELSE 00812 IF (outName/="") THEN 00813 my_middle_name="-"//TRIM(outName) 00814 ELSE 00815 my_middle_name = "" 00816 END IF 00817 ENDIF 00818 00819 IF (.not.has_root) THEN 00820 root=TRIM(logger%iter_info%project_name)//TRIM(my_middle_name) 00821 ELSE IF (outName=="") THEN 00822 root=outPath(1:my_ind1)//TRIM(logger%iter_info%project_name)//TRIM(my_middle_name) 00823 ELSE 00824 root=outPath(1:my_ind1)//my_middle_name(2:LEN_TRIM(my_middle_name)) 00825 END IF 00826 00827 ! use the cp_iter_string as a postfix 00828 postfix="-"//TRIM(cp_iter_string(logger%iter_info,print_key=print_key,for_file=.TRUE.,error=error)) 00829 IF (TRIM(postfix)=="-") postfix="" 00830 00831 ! and add the extension 00832 postfix=TRIM(postfix)//extension 00833 ! and let the logger generate the filename 00834 CALL cp_logger_generate_filename(logger,res=filename,& 00835 root=root, postfix=postfix,local=my_local) 00836 00837 END FUNCTION cp_print_key_generate_filename 00838 00839 ! ***************************************************************************** 00840 FUNCTION cp_print_key_unit_nr(logger, basis_section, print_key_path, extension,& 00841 middle_name, local, log_filename,ignore_should_output, file_form, file_position,& 00842 file_action, file_status, do_backup, on_file, is_new_file,error) RESULT(res) 00843 TYPE(cp_logger_type), POINTER :: logger 00844 TYPE(section_vals_type), POINTER :: basis_section 00845 CHARACTER(len=*), INTENT(IN), OPTIONAL :: print_key_path 00846 CHARACTER(len=*), INTENT(IN) :: extension 00847 CHARACTER(len=*), INTENT(IN), OPTIONAL :: middle_name 00848 LOGICAL, INTENT(IN), OPTIONAL :: local, log_filename, 00849 ignore_should_output 00850 CHARACTER(len=*), INTENT(IN), OPTIONAL :: file_form, file_position, 00851 file_action, file_status 00852 LOGICAL, INTENT(IN), OPTIONAL :: do_backup, on_file 00853 LOGICAL, INTENT(OUT), OPTIONAL :: is_new_file 00854 TYPE(cp_error_type), INTENT(INOUT) :: error 00855 INTEGER :: res 00856 00857 CHARACTER(len=*), PARAMETER :: routineN = 'cp_print_key_unit_nr', 00858 routineP = moduleN//':'//routineN 00859 00860 CHARACTER(len=default_path_length) :: filename, filename_bak, 00861 filename_bak_1, filename_bak_2 00862 CHARACTER(len=default_string_length) :: my_file_action, my_file_form, 00863 my_file_position, 00864 my_file_status, outPath 00865 INTEGER :: c_i_level, f_backup_level, i, 00866 my_backup_level, my_nbak, 00867 nbak, s_backup_level 00868 LOGICAL :: do_log, failure, found, 00869 my_do_backup, my_local, 00870 my_on_file, my_should_output 00871 TYPE(cp_iteration_info_type), POINTER :: iteration_info 00872 TYPE(section_vals_type), POINTER :: print_key 00873 00874 failure = .FALSE. 00875 my_local = .FALSE. 00876 my_do_backup = .FALSE. 00877 found = .FALSE. 00878 res = -1 00879 my_file_form = "FORMATTED" 00880 my_file_position = "APPEND" 00881 my_file_action = "WRITE" 00882 my_file_status = "UNKNOWN" 00883 my_on_file = .FALSE. 00884 IF (PRESENT(file_form)) my_file_form = file_form 00885 IF (PRESENT(file_position)) my_file_position = file_position 00886 IF (PRESENT(file_action)) my_file_action = file_action 00887 IF (PRESENT(file_status)) my_file_status = file_status 00888 IF (PRESENT(do_backup)) my_do_backup = do_backup 00889 IF (PRESENT(on_file)) my_on_file = on_file 00890 IF (PRESENT(local)) my_local = local 00891 NULLIFY(print_key) 00892 CPPrecondition(ASSOCIATED(basis_section),cp_failure_level,routineP,error,failure) 00893 CPPrecondition(ASSOCIATED(logger),cp_failure_level,routineP,error,failure) 00894 IF (.NOT.failure) THEN 00895 CPPrecondition(basis_section%ref_count>0,cp_failure_level,routineP,error,failure) 00896 CPPrecondition(logger%ref_count>0,cp_failure_level,routineP,error,failure) 00897 END IF 00898 IF (.NOT.failure) THEN 00899 my_should_output=BTEST(cp_print_key_should_output(logger%iter_info,& 00900 basis_section,print_key_path,used_print_key=print_key,error=error),cp_p_file) 00901 IF (PRESENT(ignore_should_output)) my_should_output=my_should_output.or.ignore_should_output 00902 IF (.NOT.my_should_output) RETURN 00903 IF (my_local.OR.& 00904 logger%para_env%mepos==logger%para_env%source) THEN 00905 00906 CALL section_vals_val_get(print_key,"FILENAME",c_val=outPath,error=error) 00907 IF (outPath=='__STD_OUT__'.AND..NOT.my_on_file) THEN 00908 res=cp_logger_get_default_unit_nr(logger,local=my_local) 00909 ELSE 00910 ! 00911 ! complex logic to build filename: 00912 ! 1) Try to avoid '--' and '-.' 00913 ! 2) If outPath contains '/' (as in ./filename) do not prepend the project_name 00914 ! 00915 ! if it is actually a full path, use it as the root 00916 filename = cp_print_key_generate_filename(logger,print_key,middle_name,extension,& 00917 my_local,error) 00918 ! Give back info about a possible existence of the file if required 00919 IF (PRESENT(is_new_file)) THEN 00920 INQUIRE(FILE=filename,EXIST=found) 00921 is_new_file = .NOT.found 00922 IF (my_file_position=="REWIND") is_new_file = .TRUE. 00923 END IF 00924 ! Check is we have to log any operation performed on the file.. 00925 do_log = .FALSE. 00926 IF (PRESENT(log_filename)) THEN 00927 do_log = log_filename 00928 ELSE 00929 CALL section_vals_val_get(print_key,"LOG_PRINT_KEY",l_val=do_log,error=error) 00930 END IF 00931 ! If required do a backup 00932 IF (my_do_backup) THEN 00933 INQUIRE(FILE=filename,EXIST=found) 00934 CALL section_vals_val_get(print_key,"BACKUP_COPIES",i_val=nbak,error=error) 00935 IF (nbak/=0) THEN 00936 iteration_info => logger%iter_info 00937 s_backup_level = 0 00938 IF (ASSOCIATED(print_key%ibackup)) s_backup_level = SIZE(print_key%ibackup) 00939 CALL section_vals_val_get(print_key,"COMMON_ITERATION_LEVELS",i_val=c_i_level, error=error) 00940 my_backup_level = MAX(1,iteration_info%n_rlevel-c_i_level+1) 00941 f_backup_level = MAX(s_backup_level,my_backup_level) 00942 IF (f_backup_level>s_backup_level) THEN 00943 CALL reallocate(print_key%ibackup,1,f_backup_level) 00944 DO i = s_backup_level+1, f_backup_level 00945 print_key%ibackup(i) = 0 00946 END DO 00947 END IF 00948 IF (found) THEN 00949 print_key%ibackup(my_backup_level)=print_key%ibackup(my_backup_level)+1 00950 my_nbak = print_key%ibackup(my_backup_level) 00951 ! Recent backup copies correspond to lower backup indexes 00952 DO i = MIN(nbak,my_nbak), 2, -1 00953 filename_bak_1=TRIM(filename)//".bak-"//ADJUSTL(cp_to_string(i)) 00954 filename_bak_2=TRIM(filename)//".bak-"//ADJUSTL(cp_to_string(i-1)) 00955 IF (do_log) THEN 00956 CALL cp_log(logger=logger, level=cp_note_level, fromWhere=routineP,& 00957 message="Moving file "//TRIM(filename_bak_2)//" into file "//& 00958 TRIM(filename_bak_1)//".",local=my_local) 00959 END IF 00960 INQUIRE(FILE=filename_bak_2,EXIST=found) 00961 IF (.NOT.found) THEN 00962 IF (do_log) THEN 00963 CALL cp_log(logger=logger, level=cp_note_level, fromWhere=routineP,& 00964 message="File "//TRIM(filename_bak_2)//" not existing..",local=my_local) 00965 END IF 00966 ELSE 00967 CALL m_mov(TRIM(filename_bak_2), TRIM(filename_bak_1)) 00968 END IF 00969 END DO 00970 ! The last backup is always the one with index 1 00971 filename_bak=TRIM(filename)//".bak-"//ADJUSTL(cp_to_string(1)) 00972 IF (do_log) THEN 00973 CALL cp_log(logger=logger, level=cp_note_level, fromWhere=routineP,& 00974 message="Moving file "//TRIM(filename)//" into file "//& 00975 TRIM(filename_bak)//".",local=my_local) 00976 END IF 00977 CALL m_mov(TRIM(filename), TRIM(filename_bak)) 00978 ELSE 00979 ! Zero the backup history for this new iteration level.. 00980 print_key%ibackup(my_backup_level)= 0 00981 END IF 00982 END IF 00983 END IF 00984 CALL open_file(file_name=filename,file_status=my_file_status,& 00985 file_form=my_file_form,file_action=my_file_action,& 00986 file_position=my_file_position,unit_number=res) 00987 IF (do_log) THEN 00988 CALL cp_log(logger=logger, level=cp_note_level, fromWhere=routineP,& 00989 message="Writing "//TRIM(print_key%section%name)//" "//& 00990 TRIM(cp_iter_string(logger%iter_info,error=error))//" to "//& 00991 TRIM(filename),local=my_local) 00992 END IF 00993 END IF 00994 ELSE 00995 res=-1 00996 END IF 00997 END IF 00998 END FUNCTION cp_print_key_unit_nr 00999 01000 ! ***************************************************************************** 01014 SUBROUTINE cp_print_key_finished_output(unit_nr, logger, basis_section,& 01015 print_key_path,local,ignore_should_output,on_file,error) 01016 INTEGER, INTENT(INOUT) :: unit_nr 01017 TYPE(cp_logger_type), POINTER :: logger 01018 TYPE(section_vals_type), POINTER :: basis_section 01019 CHARACTER(len=*), INTENT(IN), OPTIONAL :: print_key_path 01020 LOGICAL, INTENT(IN), OPTIONAL :: local, ignore_should_output, 01021 on_file 01022 TYPE(cp_error_type), INTENT(INOUT) :: error 01023 01024 CHARACTER(len=*), PARAMETER :: routineN = 'cp_print_key_finished_output', 01025 routineP = moduleN//':'//routineN 01026 01027 CHARACTER(len=default_string_length) :: outPath 01028 LOGICAL :: failure, my_local, 01029 my_on_file, my_should_output 01030 TYPE(section_vals_type), POINTER :: print_key 01031 01032 failure=.FALSE. 01033 my_local=.FALSE. 01034 my_on_file=.FALSE. 01035 NULLIFY(print_key) 01036 IF (PRESENT(local)) my_local=local 01037 IF (PRESENT(on_file)) my_on_file=on_file 01038 CPPrecondition(ASSOCIATED(basis_section),cp_failure_level,routineP,error,failure) 01039 CPPrecondition(ASSOCIATED(logger),cp_failure_level,routineP,error,failure) 01040 CPPrecondition(basis_section%ref_count>0,cp_failure_level,routineP,error,failure) 01041 CPPrecondition(logger%ref_count>0,cp_failure_level,routineP,error,failure) 01042 my_should_output=BTEST(cp_print_key_should_output(logger%iter_info,basis_section,& 01043 print_key_path,used_print_key=print_key,error=error),cp_p_file) 01044 IF (PRESENT(ignore_should_output)) my_should_output=my_should_output.or.ignore_should_output 01045 IF (my_should_output.and.(my_local.OR.& 01046 logger%para_env%source==logger%para_env%mepos)) THEN 01047 CALL section_vals_val_get(print_key,"FILENAME",c_val=outPath,error=error) 01048 IF (my_on_file.OR.outPath.NE.'__STD_OUT__') THEN 01049 CPPrecondition(unit_nr>0,cp_failure_level,routineP,error,failure) 01050 CALL close_file(unit_nr,"KEEP") 01051 unit_nr=-1 01052 ELSE 01053 unit_nr=-1 01054 ENDIF 01055 END IF 01056 CPPostcondition(unit_nr==-1,cp_failure_level,routineP,error,failure) 01057 unit_nr=-1 01058 END SUBROUTINE cp_print_key_finished_output 01059 01060 ! ***************************************************************************** 01082 SUBROUTINE cp_print_key_log(logger, basis_section, print_key_path, extension,& 01083 message,middle_name, local, log_filename,ignore_should_output, & 01084 on_file, error) 01085 TYPE(cp_logger_type), POINTER :: logger 01086 TYPE(section_vals_type), POINTER :: basis_section 01087 CHARACTER(len=*), INTENT(IN), OPTIONAL :: print_key_path 01088 CHARACTER(len=*), INTENT(IN) :: extension, message 01089 CHARACTER(len=*), INTENT(IN), OPTIONAL :: middle_name 01090 LOGICAL, INTENT(IN), OPTIONAL :: local, log_filename, 01091 ignore_should_output, on_file 01092 TYPE(cp_error_type), INTENT(INOUT) :: error 01093 01094 CHARACTER(len=*), PARAMETER :: routineN = 'cp_print_key_log', 01095 routineP = moduleN//':'//routineN 01096 01097 INTEGER :: output_unit 01098 LOGICAL :: failure, my_local 01099 01100 failure=.FALSE. 01101 01102 IF (.NOT. failure) THEN 01103 my_local=.FALSE. 01104 IF (PRESENT(local)) my_local=local 01105 IF (my_local .OR. logger%para_env%mepos==logger%para_env%source) THEN 01106 output_unit=cp_print_key_unit_nr(logger, basis_section=basis_section,& 01107 print_key_path=print_key_path,extension=extension,& 01108 middle_name=middle_name, local=local, log_filename=log_filename,& 01109 ignore_should_output=ignore_should_output, & 01110 on_file=on_file, error=error) 01111 IF (output_unit>0) THEN 01112 WRITE(output_unit,"(a)")message 01113 CALL cp_print_key_finished_output(output_unit,logger,& 01114 basis_section=basis_section,print_key_path=print_key_path,& 01115 local=local,ignore_should_output=ignore_should_output,& 01116 on_file=on_file,error=error) 01117 END IF 01118 END IF 01119 END IF 01120 END SUBROUTINE cp_print_key_log 01121 01122 END MODULE cp_output_handling 01123
1.7.3