1!--------------------------------------------------------------------------------------------------! 2! CP2K: A general program to perform molecular dynamics simulations ! 3! Copyright (C) 2000 - 2019 CP2K developers group ! 4!--------------------------------------------------------------------------------------------------! 5MODULE optimize_basis 6 USE admm_methods, ONLY: admm_fit_mo_coeffs 7 USE cp_blacs_env, ONLY: cp_blacs_env_type 8 USE cp_fm_types, ONLY: cp_fm_p_type,& 9 cp_fm_release 10 USE cp_log_handling, ONLY: cp_get_default_logger,& 11 cp_logger_get_default_unit_nr,& 12 cp_logger_type 13 USE cp_para_env, ONLY: cp_para_env_create,& 14 cp_para_env_release 15 USE cp_para_types, ONLY: cp_para_env_type 16 USE dbcsr_api, ONLY: dbcsr_p_type 17 USE f77_interface, ONLY: create_force_env,& 18 destroy_force_env,& 19 f_env_add_defaults,& 20 f_env_get_from_id,& 21 f_env_rm_defaults,& 22 f_env_type 23 USE force_env_types, ONLY: force_env_get,& 24 force_env_type 25 USE input_cp2k_read, ONLY: empty_initial_variables,& 26 read_input 27 USE input_section_types, ONLY: section_type,& 28 section_vals_release,& 29 section_vals_type 30 USE kinds, ONLY: default_path_length,& 31 dp 32 USE machine, ONLY: m_chdir,& 33 m_getcwd,& 34 m_walltime 35 USE message_passing, ONLY: mp_bcast,& 36 mp_comm_free,& 37 mp_comm_split,& 38 mp_sum,& 39 mp_sync 40 USE optbas_fenv_manipulation, ONLY: allocate_mo_sets,& 41 calculate_ks_matrix,& 42 calculate_overlap,& 43 calculate_overlap_inverse,& 44 create_opt_admm_env,& 45 modify_input_settings,& 46 update_basis_set 47 USE optbas_opt_utils, ONLY: evaluate_energy,& 48 evaluate_fval 49 USE optimize_basis_types, ONLY: basis_optimization_type,& 50 deallocate_basis_optimization_type,& 51 subset_type 52 USE optimize_basis_utils, ONLY: get_set_and_basis_id,& 53 optimize_basis_init_read_input,& 54 update_derived_basis_sets 55 USE powell, ONLY: powell_optimize 56 USE qs_environment_types, ONLY: get_qs_env,& 57 qs_environment_type 58 USE qs_ks_types, ONLY: qs_ks_env_type 59 USE qs_neighbor_lists, ONLY: build_qs_neighbor_lists 60#include "./base/base_uses.f90" 61 62 IMPLICIT NONE 63 PRIVATE 64 65 PUBLIC :: run_optimize_basis 66 67 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'optimize_basis' 68 69CONTAINS 70 71! ************************************************************************************************** 72!> \brief main entry point for methods aimed at optimizing basis sets 73!> \param input_declaration ... 74!> \param root_section ... 75!> \param para_env ... 76!> \author Florian Schiffmann 77! ************************************************************************************************** 78 SUBROUTINE run_optimize_basis(input_declaration, root_section, para_env) 79 TYPE(section_type), POINTER :: input_declaration 80 TYPE(section_vals_type), POINTER :: root_section 81 TYPE(cp_para_env_type), POINTER :: para_env 82 83 CHARACTER(len=*), PARAMETER :: routineN = 'run_optimize_basis', & 84 routineP = moduleN//':'//routineN 85 86 INTEGER :: handle 87 TYPE(basis_optimization_type) :: opt_bas 88 89 CALL timeset(routineN, handle) 90 91 CALL optimize_basis_init_read_input(opt_bas, root_section, para_env) 92 93 CALL driver_para_opt_basis(opt_bas, input_declaration, para_env) 94 95 CALL deallocate_basis_optimization_type(opt_bas) 96 CALL timestop(handle) 97 98 END SUBROUTINE run_optimize_basis 99 100! ************************************************************************************************** 101!> \brief driver routine for the parallel part of the method 102!> \param opt_bas ... 103!> \param input_declaration ... 104!> \param para_env ... 105!> \author Florian Schiffmann 106! ************************************************************************************************** 107 108 SUBROUTINE driver_para_opt_basis(opt_bas, input_declaration, para_env) 109 TYPE(basis_optimization_type) :: opt_bas 110 TYPE(section_type), POINTER :: input_declaration 111 TYPE(cp_para_env_type), POINTER :: para_env 112 113 CHARACTER(len=*), PARAMETER :: routineN = 'driver_para_opt_basis', & 114 routineP = moduleN//':'//routineN 115 116 INTEGER :: handle, n_groups_created, opt_group 117 INTEGER, DIMENSION(:), POINTER :: group_distribution_p 118 INTEGER, DIMENSION(0:para_env%num_pe-1), TARGET :: group_distribution 119 120 CALL timeset(routineN, handle) 121 group_distribution_p => group_distribution 122 CALL mp_comm_split(para_env%group, opt_group, n_groups_created, group_distribution_p, & 123 n_subgroups=SIZE(opt_bas%group_partition), group_partition=opt_bas%group_partition) 124 opt_bas%opt_id = group_distribution(para_env%mepos) + 1 125 126 CALL driver_optimization_para_low(opt_bas, input_declaration, para_env, opt_group) 127 128 CALL mp_comm_free(opt_group) 129 CALL timestop(handle) 130 131 END SUBROUTINE driver_para_opt_basis 132 133! ************************************************************************************************** 134!> \brief low level optimization routine includes initialization of the subsytems 135!> powell optimizer and deallocation of the various force envs 136!> \param opt_bas ... 137!> \param input_declaration ... 138!> \param para_env_top ... 139!> \param mpi_comm_opt ... 140!> \author Florian Schiffmann 141! ************************************************************************************************** 142 143 SUBROUTINE driver_optimization_para_low(opt_bas, input_declaration, para_env_top, mpi_comm_opt) 144 TYPE(basis_optimization_type) :: opt_bas 145 TYPE(section_type), POINTER :: input_declaration 146 TYPE(cp_para_env_type), POINTER :: para_env_top 147 INTEGER :: mpi_comm_opt 148 149 CHARACTER(len=*), PARAMETER :: routineN = 'driver_optimization_para_low', & 150 routineP = moduleN//':'//routineN 151 152 INTEGER :: handle, icalc, iopt, mp_id, stat 153 INTEGER, ALLOCATABLE, DIMENSION(:) :: f_env_id 154 LOGICAL :: write_basis 155 REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: tot_time 156 TYPE(cp_fm_p_type), ALLOCATABLE, DIMENSION(:) :: matrix_S_inv 157 TYPE(cp_para_env_type), POINTER :: para_env 158 TYPE(f_env_type), POINTER :: f_env 159 160 NULLIFY (f_env) 161 162 CALL timeset(routineN, handle) 163 164 ! ====== initialize the f_env and precompute some matrices ===== 165 mp_id = opt_bas%opt_id 166 NULLIFY (para_env, f_env) 167 ALLOCATE (f_env_id(SIZE(opt_bas%comp_group(mp_id)%member_list))) 168 ALLOCATE (tot_time(opt_bas%ncombinations*opt_bas%ntraining_sets)) 169 ALLOCATE (matrix_s_inv(SIZE(opt_bas%comp_group(mp_id)%member_list))) 170 171 CALL cp_para_env_create(para_env, group=mpi_comm_opt, & 172 owns_group=.FALSE.) 173 174 CALL init_training_force_envs(opt_bas, f_env_id, input_declaration, matrix_s_inv, para_env, mpi_comm_opt) 175 176 CALL init_free_vars(opt_bas) 177 tot_time = 0.0_dp 178 179 ! ======= The real optimization loop ======= 180 DO iopt = 0, opt_bas%powell_param%maxfun 181 CALL compute_residuum_vectors(opt_bas, f_env_id, matrix_S_inv, tot_time, & 182 para_env_top, para_env, iopt) 183 IF (para_env_top%ionode) & 184 CALL powell_optimize(opt_bas%powell_param%nvar, opt_bas%x_opt, opt_bas%powell_param) 185 IF (.NOT. para_env_top%ionode) opt_bas%x_opt = 0.0_dp 186 CALL mp_bcast(opt_bas%powell_param%state, para_env_top%source, para_env_top%group) 187 CALL mp_sum(opt_bas%x_opt, para_env_top%group) 188 CALL update_free_vars(opt_bas) 189 write_basis = MOD(iopt, opt_bas%write_frequency) == 0 190 CALL update_derived_basis_sets(opt_bas, write_basis, opt_bas%output_basis_file, & 191 para_env_top) 192 IF (opt_bas%powell_param%state == -1) EXIT 193 END DO 194 195 ! ======= Update the basis set and print the final basis ======= 196 IF (para_env_top%ionode) THEN 197 opt_bas%powell_param%state = 8 198 CALL powell_optimize(opt_bas%powell_param%nvar, opt_bas%x_opt, opt_bas%powell_param) 199 END IF 200 201 IF (.NOT. para_env_top%ionode) opt_bas%x_opt = 0.0_dp 202 CALL mp_sum(opt_bas%x_opt, para_env_top%group) 203 CALL update_free_vars(opt_bas) 204 CALL update_derived_basis_sets(opt_bas, .TRUE., opt_bas%output_basis_file, & 205 para_env_top) 206 207 ! ====== get rid of the f_env again ===== 208 209 DO icalc = SIZE(opt_bas%comp_group(mp_id)%member_list), 1, -1 210 CALL f_env_get_from_id(f_env_id(icalc), f_env) 211 CALL destroy_force_env(f_env_id(icalc), stat) 212 CALL cp_fm_release(matrix_s_inv(icalc)%matrix) 213 END DO 214 DEALLOCATE (f_env_id); DEALLOCATE (tot_time); DEALLOCATE (matrix_S_inv) 215 CALL cp_para_env_release(para_env) 216 CALL timestop(handle) 217 218 END SUBROUTINE driver_optimization_para_low 219 220! ************************************************************************************************** 221!> \brief compute all ingredients for powell optimizer. Rho_diff, 222!> condition number, energy,... for all ttraining sets in 223!> the computational group 224!> \param opt_bas ... 225!> \param f_env_id ... 226!> \param matrix_S_inv ... 227!> \param tot_time ... 228!> \param para_env_top ... 229!> \param para_env ... 230!> \param iopt ... 231! ************************************************************************************************** 232 233 SUBROUTINE compute_residuum_vectors(opt_bas, f_env_id, matrix_S_inv, tot_time, & 234 para_env_top, para_env, iopt) 235 TYPE(basis_optimization_type) :: opt_bas 236 INTEGER, ALLOCATABLE, DIMENSION(:) :: f_env_id 237 TYPE(cp_fm_p_type), DIMENSION(:) :: matrix_S_inv 238 REAL(KIND=dp), DIMENSION(:) :: tot_time 239 TYPE(cp_para_env_type), POINTER :: para_env_top, para_env 240 INTEGER :: iopt 241 242 CHARACTER(len=*), PARAMETER :: routineN = 'compute_residuum_vectors', & 243 routineP = moduleN//':'//routineN 244 245 INTEGER :: bas_id, handle, icalc, icomb, mp_id, & 246 my_id, ncalc, set_id 247 REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: cond_vec, energy, f_vec, my_time, & 248 start_time 249 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks, matrix_s_aux_fit, & 250 matrix_s_aux_fit_vs_orb 251 TYPE(f_env_type), POINTER :: f_env 252 TYPE(force_env_type), POINTER :: force_env 253 TYPE(qs_environment_type), POINTER :: qs_env 254 TYPE(qs_ks_env_type), POINTER :: ks_env 255 256 CALL timeset(routineN, handle) 257 258 NULLIFY (matrix_ks, matrix_s_aux_fit_vs_orb, matrix_s_aux_fit, ks_env) 259 260 ncalc = opt_bas%ncombinations*opt_bas%ntraining_sets 261 ALLOCATE (f_vec(ncalc)); ALLOCATE (my_time(ncalc)); ALLOCATE (cond_vec(ncalc)); ALLOCATE (energy(ncalc)) 262 f_vec = 0.0_dp; cond_vec = 0.0_dp; my_time = 0.0_dp; energy = 0.0_dp 263 mp_id = opt_bas%opt_id 264 ALLOCATE (start_time(SIZE(opt_bas%comp_group(mp_id)%member_list))) 265 266 DO icalc = 1, SIZE(opt_bas%comp_group(mp_id)%member_list) 267 my_id = opt_bas%comp_group(mp_id)%member_list(icalc) + 1 268 ! setup timings 269 start_time(icalc) = m_walltime() 270 271 CALL get_set_and_basis_id(opt_bas%comp_group(mp_id)%member_list(icalc), opt_bas, set_id, bas_id) 272 CALL f_env_get_from_id(f_env_id(icalc), f_env) 273 force_env => f_env%force_env 274 CALL force_env_get(force_env, qs_env=qs_env) 275 CALL get_qs_env(qs_env, ks_env=ks_env) 276 CALL update_basis_set(opt_bas, bas_id, qs_env) 277 CALL build_qs_neighbor_lists(qs_env, para_env, molecular=.FALSE., force_env_section=qs_env%input) 278 CALL calculate_overlap(ks_env, "S_AB_AUX") 279 CALL get_qs_env(qs_env, & 280 matrix_ks=matrix_ks, & 281 matrix_s_aux_fit_vs_orb=matrix_s_aux_fit_vs_orb, & 282 matrix_s_aux_fit=matrix_s_aux_fit) 283 CALL admm_fit_mo_coeffs(qs_env%admm_env, matrix_s_aux_fit, & 284 matrix_s_aux_fit_vs_orb, qs_env%mos, qs_env%mos_aux_fit, & 285 geometry_did_change=.TRUE.) 286 CALL evaluate_fval(qs_env%mos, qs_env%mos_aux_fit, matrix_s_aux_fit_vs_orb(1)%matrix, & 287 matrix_s_aux_fit(1)%matrix, qs_env%admm_env, f_vec(my_id), cond_vec(my_id)) 288 CALL evaluate_energy(qs_env%mos_aux_fit, matrix_ks, matrix_s_inv(icalc)%matrix, qs_env%admm_env%Q, & 289 qs_env%admm_env%work_aux_aux, energy(my_id)) 290 291 my_time(my_id) = m_walltime() - start_time(icalc) 292 END DO 293 IF (.NOT. para_env%ionode) THEN 294 f_vec = 0.0_dp; cond_vec = 0.0_dp; my_time = 0.0_dp; energy = 0.0_dp 295 END IF 296 297 DEALLOCATE (start_time) 298 299 CALL mp_sum(f_vec, para_env_top%group) 300 CALL mp_sum(cond_vec, para_env_top%group) 301 CALL mp_sum(my_time, para_env_top%group) 302 CALL mp_sum(energy, para_env_top%group) 303 opt_bas%powell_param%f = 0.0_dp 304 DO icalc = 1, SIZE(f_vec) 305 icomb = MOD(icalc - 1, opt_bas%ncombinations) 306 opt_bas%powell_param%f = opt_bas%powell_param%f + & 307 (f_vec(icalc) + energy(icalc))*opt_bas%fval_weight(icomb) 308 IF (opt_bas%use_condition_number) & 309 opt_bas%powell_param%f = opt_bas%powell_param%f + & 310 LOG(cond_vec(icalc))*opt_bas%condition_weight(icomb) 311 END DO 312 313 CALL mp_sync(para_env_top%group) 314 315 ! output info if required 316 CALL output_opt_info(f_vec, cond_vec, my_time, tot_time, opt_bas, iopt, para_env_top) 317 DEALLOCATE (f_vec); DEALLOCATE (my_time); DEALLOCATE (cond_vec); DEALLOCATE (energy) 318 319 CALL timestop(handle) 320 321 END SUBROUTINE compute_residuum_vectors 322 323! ************************************************************************************************** 324!> \brief create the force_envs for every input in the computational group 325!> \param opt_bas ... 326!> \param f_env_id ... 327!> \param input_declaration ... 328!> \param matrix_s_inv ... 329!> \param para_env ... 330!> \param mpi_comm_opt ... 331! ************************************************************************************************** 332 333 SUBROUTINE init_training_force_envs(opt_bas, f_env_id, input_declaration, matrix_s_inv, para_env, mpi_comm_opt) 334 335 TYPE(basis_optimization_type) :: opt_bas 336 INTEGER, ALLOCATABLE, DIMENSION(:) :: f_env_id 337 TYPE(section_type), POINTER :: input_declaration 338 TYPE(cp_fm_p_type), DIMENSION(:) :: matrix_S_inv 339 TYPE(cp_para_env_type), POINTER :: para_env 340 INTEGER :: mpi_comm_opt 341 342 CHARACTER(len=*), PARAMETER :: routineN = 'init_training_force_envs', & 343 routineP = moduleN//':'//routineN 344 345 CHARACTER(len=default_path_length) :: main_dir 346 INTEGER :: bas_id, handle, icalc, ierr, mp_id, & 347 set_id, stat 348 TYPE(cp_blacs_env_type), POINTER :: blacs_env 349 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s 350 TYPE(f_env_type), POINTER :: f_env 351 TYPE(force_env_type), POINTER :: force_env 352 TYPE(qs_environment_type), POINTER :: qs_env 353 TYPE(qs_ks_env_type), POINTER :: ks_env 354 TYPE(section_vals_type), POINTER :: input_file 355 356 CALL timeset(routineN, handle) 357 358 NULLIFY (matrix_s, blacs_env, ks_env) 359 360 mp_id = opt_bas%opt_id 361 CALL m_getcwd(main_dir) 362 363 ! ======= Create f_env for all calculations in MPI group ======= 364 DO icalc = 1, SIZE(opt_bas%comp_group(mp_id)%member_list) 365 NULLIFY (input_file) 366 ! parse the input of the training sets 367 CALL get_set_and_basis_id(opt_bas%comp_group(mp_id)%member_list(icalc), opt_bas, set_id, bas_id) 368 CALL m_chdir(TRIM(opt_bas%training_dir(set_id)), ierr) 369 CPASSERT(ierr == 0) 370 input_file => read_input(input_declaration, & 371 opt_bas%training_input(set_id), & 372 initial_variables=empty_initial_variables, & 373 para_env=para_env) 374 375 CALL modify_input_settings(opt_bas, bas_id, input_file) 376 CALL create_force_env(f_env_id(icalc), & 377 input_declaration=input_declaration, & 378 input_path=opt_bas%training_input(set_id), & 379 input=input_file, & 380 output_path="scrap_information", & 381 mpi_comm=mpi_comm_opt, & 382 ierr=stat) 383 384 ! some weirdness with the default stacks defaults have to be addded to get the 385 ! correct default program name this causes trouble with the timer stack if kept 386 CALL f_env_add_defaults(f_env_id(icalc), f_env) 387 force_env => f_env%force_env 388 CALL force_env_get(force_env, qs_env=qs_env) 389 CALL allocate_mo_sets(qs_env) 390 CALL f_env_rm_defaults(f_env, stat) 391 CALL get_qs_env(qs_env, ks_env=ks_env) 392 CALL build_qs_neighbor_lists(qs_env, para_env, molecular=.FALSE., & 393 force_env_section=qs_env%input) 394 CALL calculate_overlap(ks_env, "S_AB") 395 CALL get_qs_env(qs_env, matrix_s=matrix_s, blacs_env=blacs_env) 396 CALL calculate_overlap_inverse(matrix_s(1)%matrix, matrix_s_inv(icalc)%matrix, & 397 para_env, blacs_env) 398 CALL calculate_ks_matrix(qs_env) 399 400 CALL create_opt_admm_env(qs_env) 401 CALL section_vals_release(input_file) 402 CALL m_chdir(TRIM(ADJUSTL(main_dir)), ierr) 403 END DO 404 405 CALL timestop(handle) 406 407 END SUBROUTINE init_training_force_envs 408 409! ************************************************************************************************** 410!> \brief variable update from the powell vector for all sets 411!> \param opt_bas ... 412!> \author Florian Schiffmann 413! ************************************************************************************************** 414 415 SUBROUTINE update_free_vars(opt_bas) 416 TYPE(basis_optimization_type) :: opt_bas 417 418 CHARACTER(len=*), PARAMETER :: routineN = 'update_free_vars', & 419 routineP = moduleN//':'//routineN 420 421 INTEGER :: handle, ikind, iset, ix 422 423 CALL timeset(routineN, handle) 424 ix = 0 425 DO ikind = 1, opt_bas%nkind 426 DO iset = 1, opt_bas%kind_basis(ikind)%flex_basis(0)%nsets 427 CALL update_subset_freevars(opt_bas%kind_basis(ikind)%flex_basis(0)%subset(iset), ix, opt_bas%x_opt) 428 END DO 429 END DO 430 CALL timestop(handle) 431 432 END SUBROUTINE update_free_vars 433 434! ************************************************************************************************** 435!> \brief low level update for the basis sets. Exponents are transformed according to constraint 436!> \param subset ... 437!> \param ix ... 438!> \param x ... 439!> \author Florian Schiffmann 440! ************************************************************************************************** 441 442 SUBROUTINE update_subset_freevars(subset, ix, x) 443 TYPE(subset_type) :: subset 444 INTEGER :: ix 445 REAL(KIND=dp), DIMENSION(:) :: x 446 447 CHARACTER(len=*), PARAMETER :: routineN = 'update_subset_freevars', & 448 routineP = moduleN//':'//routineN 449 450 INTEGER :: handle, icon1, icon2, icont, iexp, il, & 451 istart 452 REAL(KIND=dp) :: fermi_f, gs_scale 453 454 CALL timeset(routineN, handle) 455 DO iexp = 1, subset%nexp 456 IF (subset%opt_exps(iexp)) THEN 457 ix = ix + 1 458 subset%exps(iexp) = ABS(x(ix)) 459 IF (subset%exp_has_const(iexp)) THEN 460 !use a fermi function to keep expoenents in a given range around their initial value 461 fermi_f = 1.0_dp/(EXP((x(ix) - 1.0_dp)/0.5_dp) + 1.0_dp) 462 subset%exps(iexp) = (2.0_dp*fermi_f - 1.0_dp)*subset%exp_const(iexp)%var_fac*subset%exp_const(iexp)%init + & 463 subset%exp_const(iexp)%init 464 ELSE 465 466 END IF 467 END IF 468 DO icont = 1, subset%ncon_tot 469 IF (subset%opt_coeff(iexp, icont)) THEN 470 ix = ix + 1 471 subset%coeff(iexp, icont) = x(ix) 472 END IF 473 END DO 474 END DO 475 476 ! orthonormalize contraction coefficients using gram schmidt 477 istart = 1 478 DO il = 1, subset%nl 479 DO icon1 = istart, istart + subset%l(il) - 2 480 DO icon2 = icon1 + 1, istart + subset%l(il) - 1 481 gs_scale = DOT_PRODUCT(subset%coeff(:, icon2), subset%coeff(:, icon1))/ & 482 DOT_PRODUCT(subset%coeff(:, icon1), subset%coeff(:, icon1)) 483 subset%coeff(:, icon2) = subset%coeff(:, icon2) - gs_scale*subset%coeff(:, icon1) 484 END DO 485 END DO 486 istart = istart + subset%l(il) 487 END DO 488 489 DO icon1 = 1, subset%ncon_tot 490 subset%coeff(:, icon1) = subset%coeff(:, icon1)/ & 491 SQRT(DOT_PRODUCT(subset%coeff(:, icon1), subset%coeff(:, icon1))) 492 END DO 493 CALL timestop(handle) 494 495 END SUBROUTINE update_subset_freevars 496 497! ************************************************************************************************** 498!> \brief variable initialization for the powell vector for all sets 499!> \param opt_bas ... 500!> \author Florian Schiffmann 501! ************************************************************************************************** 502 503 SUBROUTINE init_free_vars(opt_bas) 504 TYPE(basis_optimization_type) :: opt_bas 505 506 CHARACTER(len=*), PARAMETER :: routineN = 'init_free_vars', routineP = moduleN//':'//routineN 507 508 INTEGER :: handle, ikind, iset, ix 509 510 CALL timeset(routineN, handle) 511 ix = 0 512 DO ikind = 1, opt_bas%nkind 513 DO iset = 1, opt_bas%kind_basis(ikind)%flex_basis(0)%nsets 514 CALL init_subset_freevars(opt_bas%kind_basis(ikind)%flex_basis(0)%subset(iset), ix, opt_bas%x_opt) 515 END DO 516 END DO 517 CALL timestop(handle) 518 519 END SUBROUTINE init_free_vars 520 521! ************************************************************************************************** 522!> \brief variable initialization for the powell vector from low level informations 523!> constraint exponents will be mapped on a fermi function 524!> \param subset ... 525!> \param ix ... 526!> \param x ... 527!> \author Florian Schiffmann 528! ************************************************************************************************** 529 530 SUBROUTINE init_subset_freevars(subset, ix, x) 531 TYPE(subset_type) :: subset 532 INTEGER :: ix 533 REAL(KIND=dp), DIMENSION(:) :: x 534 535 CHARACTER(len=*), PARAMETER :: routineN = 'init_subset_freevars', & 536 routineP = moduleN//':'//routineN 537 538 INTEGER :: handle, icont, iexp 539 REAL(KIND=dp) :: fract 540 541 CALL timeset(routineN, handle) 542 543 DO iexp = 1, subset%nexp 544 IF (subset%opt_exps(iexp)) THEN 545 ix = ix + 1 546 x(ix) = subset%exps(iexp) 547 IF (subset%exp_has_const(iexp)) THEN 548 IF (subset%exp_const(iexp)%const_type == 0) THEN 549 fract = 1.0_dp + (subset%exps(iexp) - subset%exp_const(iexp)%init)/ & 550 (subset%exp_const(iexp)%init*subset%exp_const(iexp)%var_fac) 551 x(ix) = 0.5_dp*LOG((2.0_dp/fract - 1.0_dp)) + 1.0_dp 552 END IF 553 IF (subset%exp_const(iexp)%const_type == 1) THEN 554 x(ix) = 1.0_dp 555 END IF 556 END IF 557 END IF 558 DO icont = 1, subset%ncon_tot 559 IF (subset%opt_coeff(iexp, icont)) THEN 560 ix = ix + 1 561 x(ix) = subset%coeff(iexp, icont) 562 END IF 563 END DO 564 END DO 565 CALL timestop(handle) 566 567 END SUBROUTINE init_subset_freevars 568 569! ************************************************************************************************** 570!> \brief commuticates all info to the master and assembles the output 571!> \param f_vec ... 572!> \param cond_vec ... 573!> \param my_time ... 574!> \param tot_time ... 575!> \param opt_bas ... 576!> \param iopt ... 577!> \param para_env_top ... 578!> \author Florian Schiffmann 579! ************************************************************************************************** 580 581 SUBROUTINE output_opt_info(f_vec, cond_vec, my_time, tot_time, opt_bas, iopt, para_env_top) 582 REAL(KIND=dp), DIMENSION(:) :: f_vec, cond_vec, my_time, tot_time 583 TYPE(basis_optimization_type) :: opt_bas 584 INTEGER :: iopt 585 TYPE(cp_para_env_type), POINTER :: para_env_top 586 587 CHARACTER(len=*), PARAMETER :: routineN = 'output_opt_info', & 588 routineP = moduleN//':'//routineN 589 590 INTEGER :: handle, ibasis, icalc, iset, unit_nr 591 TYPE(cp_logger_type), POINTER :: logger 592 593 CALL timeset(routineN, handle) 594 logger => cp_get_default_logger() 595 596 tot_time = tot_time + my_time 597 598 unit_nr = -1 599 IF (para_env_top%ionode .AND. (MOD(iopt, opt_bas%write_frequency) == 0 .OR. iopt == opt_bas%powell_param%maxfun)) & 600 unit_nr = cp_logger_get_default_unit_nr(logger) 601 602 IF (unit_nr .GT. 0) THEN 603 WRITE (unit_nr, '(1X,A,I8)') "BASOPT| Information at iteration number:", iopt 604 WRITE (unit_nr, '(1X,A)') "BASOPT| Training set | Combination | Rho difference | Condition num. | Time" 605 WRITE (unit_nr, '(1X,A)') "BASOPT| -----------------------------------------------------------------------" 606 icalc = 0 607 DO iset = 1, opt_bas%ntraining_sets 608 DO ibasis = 1, opt_bas%ncombinations 609 icalc = icalc + 1 610 WRITE (unit_nr, '(1X,A,2(5X,I3,5X,A),2(1X,E14.8,1X,A),1X,F8.3)') & 611 'BASOPT| ', iset, "|", ibasis, "|", f_vec(icalc), "|", cond_vec(icalc), "|", tot_time(icalc) 612 END DO 613 END DO 614 WRITE (unit_nr, '(1X,A)') "BASOPT| -----------------------------------------------------------------------" 615 WRITE (unit_nr, '(1X,A,E14.8)') "BASOPT| Total residuum value: ", opt_bas%powell_param%f 616 WRITE (unit_nr, '(A)') "" 617 END IF 618 CALL timestop(handle) 619 END SUBROUTINE output_opt_info 620 621END MODULE optimize_basis 622 623