1!--------------------------------------------------------------------------------------------------! 2! CP2K: A general program to perform molecular dynamics simulations ! 3! Copyright (C) 2000 - 2020 CP2K developers group ! 4!--------------------------------------------------------------------------------------------------! 5 6! ************************************************************************************************** 7!> \brief Defines control structures, which contain the parameters and the 8!> settings for the DFT-based calculations. 9! ************************************************************************************************** 10MODULE cp_control_types 11 USE cp_fm_types, ONLY: cp_fm_p_type,& 12 cp_fm_release 13 USE input_constants, ONLY: do_full_density 14 USE kinds, ONLY: default_path_length,& 15 default_string_length,& 16 dp 17 USE qs_cdft_types, ONLY: cdft_control_create,& 18 cdft_control_release,& 19 cdft_control_type 20 USE xas_control, ONLY: xas_control_release,& 21 xas_control_type 22#include "./base/base_uses.f90" 23 24 IMPLICIT NONE 25 26 PRIVATE 27 28! ************************************************************************************************** 29! \brief Control parameters for pw grids 30! ************************************************************************************************** 31 TYPE pw_grid_option 32 LOGICAL :: spherical 33 LOGICAL :: fullspace 34 INTEGER, DIMENSION(2) :: distribution_layout 35 INTEGER :: blocked 36 END TYPE pw_grid_option 37 38! ************************************************************************************************** 39! \brief Control parameters for REAL_TIME_PROPAGATION calculations 40! ************************************************************************************************** 41 TYPE rtp_control_type 42 LOGICAL :: converged 43 REAL(KIND=dp) :: eps_ener 44 INTEGER :: max_iter 45 INTEGER :: mat_exp 46 INTEGER :: propagator 47 LOGICAL :: fixed_ions 48 INTEGER :: initial_wfn 49 REAL(dp) :: eps_exp 50 LOGICAL :: initial_step 51 LOGICAL :: hfx_redistribute 52 INTEGER :: aspc_order 53 INTEGER :: sc_check_start 54 LOGICAL :: apply_delta_pulse 55 LOGICAL :: periodic 56 LOGICAL :: linear_scaling 57 LOGICAL :: write_restart 58 INTEGER :: mcweeny_max_iter 59 INTEGER :: acc_ref 60 REAL(dp) :: mcweeny_eps 61 INTEGER, DIMENSION(3) :: delta_pulse_direction 62 REAL(KIND=dp) :: delta_pulse_scale 63 END TYPE rtp_control_type 64! ************************************************************************************************** 65! \brief Control parameters for DFTB calculations 66! ************************************************************************************************** 67 TYPE dftb_control_type 68 LOGICAL :: self_consistent 69 LOGICAL :: orthogonal_basis 70 LOGICAL :: dispersion 71 INTEGER :: dispersion_type 72 LOGICAL :: dftb3_diagonal 73 LOGICAL :: hb_sr_damp 74 REAL(KIND=dp) :: hb_sr_para 75 REAL(KIND=dp) :: eps_disp 76 REAL(KIND=dp) :: epscn 77 REAL(KIND=dp) :: rcdisp 78 REAL(KIND=dp), DIMENSION(3) :: sd3 79 LOGICAL :: do_ewald 80 CHARACTER(LEN=default_path_length) :: sk_file_path 81 CHARACTER(LEN=default_path_length) :: sk_file_list 82 CHARACTER(LEN=default_string_length), & 83 DIMENSION(:, :), POINTER :: sk_pair_list 84 CHARACTER(LEN=default_path_length) :: uff_force_field 85 CHARACTER(LEN=default_path_length) :: dispersion_parameter_file 86 END TYPE dftb_control_type 87 88! ************************************************************************************************** 89! \brief Control parameters for xTB calculations 90! ************************************************************************************************** 91 TYPE xtb_control_type 92 ! 93 LOGICAL :: do_ewald 94 ! 95 INTEGER :: sto_ng 96 INTEGER :: h_sto_ng 97 ! 98 CHARACTER(LEN=default_path_length) :: parameter_file_path 99 CHARACTER(LEN=default_path_length) :: parameter_file_name 100 ! 101 CHARACTER(LEN=default_path_length) :: dispersion_parameter_file 102 REAL(KIND=dp) :: epscn 103 REAL(KIND=dp) :: rcdisp 104 REAL(KIND=dp) :: s6, s8 105 REAL(KIND=dp) :: a1, a2 106 ! 107 REAL(KIND=dp) :: ks, kp, kd, ksp, k2sh 108 REAL(KIND=dp) :: kg, kf 109 REAL(KIND=dp) :: kcns, kcnp, kcnd 110 REAL(KIND=dp) :: ken 111 REAL(KIND=dp) :: kxr, kx2 112 ! 113 LOGICAL :: xb_interaction 114 LOGICAL :: coulomb_interaction 115 LOGICAL :: tb3_interaction 116 LOGICAL :: check_atomic_charges 117 ! 118 REAL(KIND=dp) :: xb_radius 119 ! 120 CHARACTER(LEN=default_string_length), & 121 DIMENSION(:, :), POINTER :: kab_param 122 INTEGER, DIMENSION(:, :), POINTER :: kab_types 123 INTEGER :: kab_nval 124 REAL, DIMENSION(:), POINTER :: kab_vals 125 END TYPE xtb_control_type 126 127! ************************************************************************************************** 128! \brief Control parameters for semi empirical calculations 129! ************************************************************************************************** 130 TYPE semi_empirical_control_type 131 LOGICAL :: orthogonal_basis 132 LOGICAL :: analytical_gradients 133 LOGICAL :: force_kdsod_EX 134 LOGICAL :: do_ewald, do_ewald_r3, do_ewald_gks 135 INTEGER :: integral_screening, periodic_type 136 INTEGER :: max_multipole 137 INTEGER :: ga_ncells 138 REAL(KIND=dp) :: delta 139 ! Dispersion pair potential 140 LOGICAL :: dispersion 141 REAL(KIND=dp) :: rcdisp 142 REAL(KIND=dp) :: epscn 143 REAL(KIND=dp), DIMENSION(3) :: sd3 144 CHARACTER(LEN=default_path_length) :: dispersion_parameter_file 145 ! Parameters controlling the evaluation of the integrals 146 REAL(KIND=dp) :: cutoff_lrc, taper_lrc, range_lrc 147 REAL(KIND=dp) :: cutoff_cou, taper_cou, range_cou 148 REAL(KIND=dp) :: cutoff_exc, taper_exc, range_exc 149 REAL(KIND=dp) :: taper_scr, range_scr 150 END TYPE semi_empirical_control_type 151 152! ************************************************************************************************** 153! \brief Control parameters for GAPW method within QUICKSTEP *** 154! ************************************************************************************************** 155 TYPE gapw_control_type 156 REAL(KIND=dp) :: eps_fit, & 157 eps_iso, & 158 eps_Vrho0, & 159 eps_svd, & 160 eps_cpc 161 INTEGER :: ladd_rho0, & 162 lmax_rho0, & 163 lmax_sphere, & 164 quadrature 165 LOGICAL :: lrho1_eq_lrho0 166 LOGICAL :: alpha0_hard_from_input, & 167 force_paw, & 168 non_paw_atoms, & 169 nopaw_as_gpw 170 REAL(KIND=dp) :: alpha0_hard 171 REAL(KIND=dp) :: max_rad_local 172 END TYPE gapw_control_type 173! ************************************************************************************************** 174! \brief parameters for calculations involving a time dependent electric field 175! ************************************************************************************************** 176 TYPE efield_type 177 REAL(KIND=dp) :: actual_time 178 REAL(KIND=dp), DIMENSION(:), POINTER :: polarisation 179 INTEGER :: envelop_id 180 REAL(KIND=dp), DIMENSION(:), POINTER :: envelop_r_vars 181 INTEGER, DIMENSION(:), POINTER :: envelop_i_vars 182 REAL(KIND=dp) :: strength 183 REAL(KIND=dp) :: phase_offset 184 REAL(KIND=dp) :: wavelength 185 END TYPE efield_type 186 187 TYPE efield_p_type 188 TYPE(efield_type), POINTER :: efield 189 END TYPE efield_p_type 190! ************************************************************************************************** 191! \brief parameters for calculations involving a time dependent electric field 192! ************************************************************************************************** 193 TYPE period_efield_type 194 LOGICAL :: displacement_field 195 REAL(KIND=dp), DIMENSION(3) :: polarisation 196 REAL(KIND=dp), DIMENSION(3) :: d_filter 197 REAL(KIND=dp) :: strength 198 END TYPE period_efield_type 199 200! ************************************************************************************************** 201! \brief some parameters useful for mulliken_restraints 202! ************************************************************************************************** 203 TYPE mulliken_restraint_type 204 INTEGER :: ref_count 205 REAL(KIND=dp) :: strength 206 REAL(KIND=dp) :: TARGET 207 INTEGER :: natoms 208 INTEGER, POINTER, DIMENSION(:) :: atoms 209 END TYPE mulliken_restraint_type 210 211! ************************************************************************************************** 212! \brief some parameters useful for ddapc_restraints 213! ************************************************************************************************** 214 TYPE ddapc_restraint_type 215 INTEGER :: ref_count 216 REAL(KIND=dp) :: strength 217 REAL(KIND=dp) :: TARGET 218 REAL(KIND=dp) :: ddapc_order_p 219 INTEGER :: functional_form 220 INTEGER :: natoms 221 INTEGER, POINTER, DIMENSION(:) :: atoms 222 REAL(KIND=dp), POINTER, DIMENSION(:) :: coeff 223 INTEGER :: density_type 224 END TYPE ddapc_restraint_type 225 226! ************************************************************************************************** 227! \brief provides a vector of pointers to ddapc_restraint_type 228! ************************************************************************************************** 229 TYPE ddapc_restraint_p_type 230 TYPE(ddapc_restraint_type), POINTER :: ddapc_restraint_control 231 END TYPE ddapc_restraint_p_type 232 233! ************************************************************************************************** 234! \brief some parameters useful for s2_restraints 235! ************************************************************************************************** 236 TYPE s2_restraint_type 237 INTEGER :: ref_count 238 REAL(KIND=dp) :: strength 239 REAL(KIND=dp) :: TARGET 240 REAL(KIND=dp) :: s2_order_p 241 INTEGER :: functional_form 242 END TYPE s2_restraint_type 243 244! ************************************************************************************************** 245! \brief some parameters useful for auxiliary density matrix method 246! ************************************************************************************************** 247 TYPE admm_block_type 248 INTEGER, DIMENSION(:), ALLOCATABLE :: list 249 END TYPE admm_block_type 250 251 TYPE admm_control_type 252 REAL(KIND=dp) :: eps_filter 253 INTEGER :: purification_method 254 INTEGER :: method 255 LOGICAL :: charge_constrain 256 INTEGER :: scaling_model 257 INTEGER :: aux_exch_func 258 LOGICAL :: aux_exch_func_param 259 REAL(KIND=dp), DIMENSION(3) :: aux_x_param 260 TYPE(admm_block_type), DIMENSION(:), & 261 ALLOCATABLE :: blocks 262 END TYPE admm_control_type 263 264! ************************************************************************************************** 265! \brief Control parameters for a QUICKSTEP and KIM-GORDON calculation *** 266! eps_pgf_orb: Cutoff value for the interaction of the primitive 267! Gaussian-type functions (primitive basis functions). 268! ************************************************************************************************** 269 TYPE qs_control_type 270 INTEGER :: method_id 271 REAL(KIND=dp) :: eps_core_charge, & 272 eps_kg_orb, & 273 eps_pgf_orb, & 274 eps_ppl, & 275 eps_ppnl, & 276 eps_rho_gspace, & 277 eps_rho_rspace, & 278 eps_filter_matrix, & 279 eps_gvg_rspace, & 280 progression_factor, & 281 relative_cutoff 282 LOGICAL :: do_almo_scf 283 LOGICAL :: do_ls_scf 284 LOGICAL :: do_kg 285 LOGICAL :: commensurate_mgrids 286 LOGICAL :: realspace_mgrids 287 LOGICAL :: gapw, gapw_xc, gpw, pao 288 LOGICAL :: lrigpw, rigpw 289 LOGICAL :: lri_optbas 290 LOGICAL :: ofgpw 291 LOGICAL :: dftb 292 LOGICAL :: xtb 293 LOGICAL :: semi_empirical 294 LOGICAL :: mulliken_restraint 295 LOGICAL :: ddapc_restraint 296 LOGICAL :: ddapc_restraint_is_spin 297 LOGICAL :: ddapc_explicit_potential 298 LOGICAL :: cdft 299 LOGICAL :: et_coupling_calc 300 LOGICAL :: s2_restraint 301 INTEGER :: do_ppl_method 302 INTEGER :: wf_interpolation_method_nr 303 INTEGER :: wf_extrapolation_order 304 REAL(KIND=dp) :: cutoff 305 REAL(KIND=dp), DIMENSION(:), POINTER :: e_cutoff 306 TYPE(mulliken_restraint_type), & 307 POINTER :: mulliken_restraint_control 308 TYPE(ddapc_restraint_p_type), & 309 DIMENSION(:), POINTER :: ddapc_restraint_control 310 TYPE(cdft_control_type), POINTER :: cdft_control 311 TYPE(s2_restraint_type), POINTER :: s2_restraint_control 312 TYPE(dftb_control_type), POINTER :: dftb_control 313 TYPE(xtb_control_type), POINTER :: xtb_control 314 TYPE(semi_empirical_control_type), & 315 POINTER :: se_control 316 TYPE(gapw_control_type), POINTER :: gapw_control 317 TYPE(pw_grid_option) :: pw_grid_opt 318 LOGICAL :: skip_load_balance_distributed 319 ! Types of subsystems for embedding 320 LOGICAL :: ref_embed_subsys 321 LOGICAL :: cluster_embed_subsys 322 LOGICAL :: high_level_embed_subsys 323 LOGICAL :: dfet_embedded 324 LOGICAL :: dmfet_embedded 325 END TYPE qs_control_type 326 327! ************************************************************************************************** 328! \brief Control parameters for the SCCS models 329! ************************************************************************************************** 330 TYPE sccs_control_type 331 LOGICAL :: sccs_activated 332 INTEGER :: derivative_method, & 333 max_iter, & 334 method_id, & 335 ref_count 336 REAL(KIND=dp) :: alpha_solvent, & 337 beta, & 338 beta_solvent, & 339 delta_rho, & 340 eps_sccs, & 341 eps_scf, & 342 epsilon_solvent, & 343 gamma_solvent, & 344 mixing, & 345 rho_zero, & 346 rho_max, & 347 rho_min 348 END TYPE sccs_control_type 349 350! ************************************************************************************************** 351! \brief Control parameters for a TIME-DEPENDENT PERTURBATION calculation 352! \par ATTRIBUTES 353! - n_ev : number of eigenvalues to calculate 354! - n_reortho : how many time to reorthogonalize (in the lanczos algorithm) 355! - do_kernel : wether to evaluate the kernel (this is a debugging option) 356! - res_etype : { SINGLET | TRIPLET } which excitations 357! to calculate 358! - lumos_eigenvalues : holds the eigenvalues of the lumos (if calculated in QS) 359! 360! \par NOTES 361! The lumos are helpful in choosing a initial vector for the TDDFPT 362! calculation, since they can be used to construct the solutions of the 363! TDDFPT operator without the perturbation kernel. 364! ************************************************************************************************** 365 TYPE tddfpt_control_type 366 TYPE(cp_fm_p_type), DIMENSION(:), & 367 POINTER :: lumos 368 REAL(KIND=dp) :: tolerance 369 INTEGER :: n_ev 370 INTEGER :: max_kv 371 INTEGER :: n_restarts 372 INTEGER :: n_reortho 373 LOGICAL :: do_kernel 374 LOGICAL :: lsd_singlets 375 LOGICAL :: invert_S 376 LOGICAL :: precond 377 LOGICAL :: drho_by_collocation 378 LOGICAL :: use_kinetic_energy_density 379 INTEGER :: res_etype 380 INTEGER :: diag_method 381 INTEGER :: oe_corr 382 INTEGER :: sic_method_id 383 INTEGER :: sic_list_id 384 REAL(KIND=dp) :: sic_scaling_a, sic_scaling_b 385 REAL(KIND=dp), DIMENSION(:, :), & 386 POINTER :: lumos_eigenvalues 387 END TYPE tddfpt_control_type 388 389! ************************************************************************************************** 390! \brief Control parameters for simplified Tamm Dancoff approximation (sTDA) 391! \par ATTRIBUTES 392! \par NOTES 393! ************************************************************************************************** 394 TYPE stda_control_type 395 LOGICAL :: do_ewald 396 REAL(KIND=dp) :: hfx_fraction 397 REAL(KIND=dp) :: eps_td_filter 398 END TYPE stda_control_type 399 400! ************************************************************************************************** 401! \brief Control parameters for a Time-Dependent DFT calculation. 402! ************************************************************************************************** 403 TYPE tddfpt2_control_type 404 !> compute TDDFPT excitation energies and oscillator strengths 405 LOGICAL :: enabled 406 !> number of excited states to converge 407 INTEGER :: nstates 408 !> maximal number of iterations to be performed 409 INTEGER :: niters 410 !> maximal number of Krylov space vectors 411 INTEGER :: nkvs 412 !> number of unoccupied (virtual) molecular orbitals to consider 413 INTEGER :: nlumo 414 !> minimal number of MPI processes to be used per excited state 415 INTEGER :: nprocs 416 !> type of kernel function/approximation to use 417 INTEGER :: kernel 418 !> options used in sTDA calculation (Kernel) 419 TYPE(stda_control_type) :: stda_control 420 !> algorithm to correct orbital energies 421 INTEGER :: oe_corr 422 !> eigenvalue shifts 423 REAL(KIND=dp) :: ev_shift, eos_shift 424 !> target accuracy 425 REAL(kind=dp) :: conv 426 !> the smallest excitation amplitude to print 427 REAL(kind=dp) :: min_excitation_amplitude 428 !> threshold which controls when two wave functions considered to be orthogonal: 429 !> maxabs(Ci^T * S * Cj) <= orthogonal_eps 430 REAL(kind=dp) :: orthogonal_eps 431 !> read guess wave functions from restart file if exists 432 LOGICAL :: is_restart 433 !> compute triplet excited states using spin-unpolarised molecular orbitals 434 LOGICAL :: rks_triplets 435 ! 436 ! DIPOLE_MOMENTS subsection 437 ! 438 ! form of the dipole operator used to compute oscillator strengths 439 INTEGER :: dipole_form 440 !> type of the reference point used for calculation of electrostatic dipole moments 441 INTEGER :: dipole_reference 442 !> user-defined reference point 443 REAL(kind=dp), DIMENSION(:), POINTER :: dipole_ref_point 444 ! 445 ! MGRID subsection 446 ! 447 !> number of plain-wave grids 448 INTEGER :: mgrid_ngrids 449 !> create commensurate grids (progression factor and cutoff values of sub-grids will be ignored) 450 LOGICAL :: mgrid_commensurate_mgrids 451 !> signals that MGRID section has been explicitly given. Other mgrid_* variables 452 !> are not initialised when it is equal to .FALSE. as in this case the default 453 !> set of plain-wave grids will be used 454 LOGICAL :: mgrid_is_explicit 455 !> same as qs_control%realspace_mgrids 456 LOGICAL :: mgrid_realspace_mgrids 457 !> do not perform load balancing 458 LOGICAL :: mgrid_skip_load_balance 459 !> cutoff value at the finest grid level 460 REAL(kind=dp) :: mgrid_cutoff 461 !> cutoff at the next grid level will be smaller then the cutoff 462 !> at the current grid by this number of times 463 REAL(kind=dp) :: mgrid_progression_factor 464 !> cutoff that determines to which grid a particular Gaussian function will be mapped 465 REAL(kind=dp) :: mgrid_relative_cutoff 466 !> manually provided the list of cutoff values for each grid level 467 !> (when it is null(), the cutoff values will be assigned automatically) 468 REAL(kind=dp), DIMENSION(:), POINTER :: mgrid_e_cutoff 469 END TYPE tddfpt2_control_type 470 471! ************************************************************************************************** 472! \brief Control parameters for a DFT calculation 473! \par History 474! 10.2019 added variables related to surface dipole correction [Soumya Ghosh] 475! ************************************************************************************************** 476 TYPE dft_control_type 477 TYPE(admm_control_type), POINTER :: admm_control 478 TYPE(period_efield_type), POINTER :: period_efield 479 TYPE(qs_control_type), POINTER :: qs_control 480 TYPE(rtp_control_type), POINTER :: rtp_control 481 TYPE(sccs_control_type), POINTER :: sccs_control 482 TYPE(tddfpt_control_type), POINTER :: tddfpt_control 483 TYPE(tddfpt2_control_type), POINTER :: tddfpt2_control 484 TYPE(xas_control_type), POINTER :: xas_control 485 TYPE(efield_p_type), POINTER, & 486 DIMENSION(:) :: efield_fields 487 INTEGER :: nspins, & 488 charge, & 489 multiplicity, & 490 sic_method_id, & 491 ref_count, & 492 id_nr, & 493 plus_u_method_id, & 494 dir_surf_dip, & 495 nimages = 1 496 INTEGER :: sic_list_id 497 INTEGER :: auto_basis_ri_aux = 1, & 498 auto_basis_aux_fit = 1, & 499 auto_basis_lri_aux = 1, & 500 auto_basis_ri_hxc = 1, & 501 auto_basis_ri_xas = 1, & 502 auto_basis_ri_hfx = 1 503 REAL(KIND=dp) :: relax_multiplicity, & 504 sic_scaling_a, & 505 sic_scaling_b, & 506 pos_dir_surf_dip 507 LOGICAL :: do_tddfpt_calculation, & 508 do_xas_calculation, & 509 do_xas_tdp_calculation, & 510 drho_by_collocation, & 511 use_kinetic_energy_density, & 512 restricted, & 513 roks, & 514 uks, & 515 lsd, & 516 dft_plus_u, & 517 apply_efield, & 518 apply_efield_field, & 519 apply_period_efield, & 520 apply_external_potential, & 521 eval_external_potential, & 522 do_admm, & 523 do_admm_dm, & 524 do_admm_mo, & 525 smear, & 526 low_spin_roks, & 527 apply_external_density, & 528 read_external_density, & 529 apply_external_vxc, & 530 read_external_vxc, & 531 correct_surf_dip, & 532 surf_dip_correct_switch, & 533 switch_surf_dip, & 534 correct_el_density_dip, & 535 do_sccs, & 536 apply_embed_pot, & 537 apply_dmfet_pot 538 END TYPE dft_control_type 539 540 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_control_types' 541 INTEGER, SAVE :: last_dft_control_id = 0 542 543 ! Public data types 544 545 PUBLIC :: dft_control_type, & 546 qs_control_type, & 547 gapw_control_type, & 548 tddfpt_control_type, & 549 tddfpt2_control_type, & 550 efield_type, & 551 mulliken_restraint_type, & 552 ddapc_restraint_type, & 553 dftb_control_type, & 554 xtb_control_type, & 555 semi_empirical_control_type, & 556 s2_restraint_type, & 557 admm_control_type, & 558 rtp_control_type, & 559 sccs_control_type, & 560 stda_control_type 561 562 ! Public subroutines 563 564 PUBLIC :: dft_control_retain, & 565 dft_control_release, & 566 dft_control_create, & 567 tddfpt_control_create, & 568 admm_control_create, & 569 ddapc_control_create, & 570 sccs_control_create 571 572CONTAINS 573 574! ************************************************************************************************** 575!> \brief create the mulliken_restraint_type 576!> \param mulliken_restraint_control ... 577!> \par History 578!> 02.2005 created [Joost VandeVondele] 579! ************************************************************************************************** 580 SUBROUTINE mulliken_control_create(mulliken_restraint_control) 581 TYPE(mulliken_restraint_type), POINTER :: mulliken_restraint_control 582 583 CHARACTER(len=*), PARAMETER :: routineN = 'mulliken_control_create', & 584 routineP = moduleN//':'//routineN 585 586 CPASSERT(.NOT. ASSOCIATED(mulliken_restraint_control)) 587 ALLOCATE (mulliken_restraint_control) 588 589 mulliken_restraint_control%ref_count = 1 590 mulliken_restraint_control%strength = 0.1_dp 591 mulliken_restraint_control%target = 1.0_dp 592 mulliken_restraint_control%natoms = 0 593 NULLIFY (mulliken_restraint_control%atoms) 594 END SUBROUTINE mulliken_control_create 595 596! ************************************************************************************************** 597!> \brief release the mulliken_restraint_type 598!> \param mulliken_restraint_control ... 599!> \par History 600!> 02.2005 created [Joost VandeVondele] 601! ************************************************************************************************** 602 SUBROUTINE mulliken_control_release(mulliken_restraint_control) 603 TYPE(mulliken_restraint_type), POINTER :: mulliken_restraint_control 604 605 CHARACTER(len=*), PARAMETER :: routineN = 'mulliken_control_release', & 606 routineP = moduleN//':'//routineN 607 608 CPASSERT(ASSOCIATED(mulliken_restraint_control)) 609 CPASSERT(mulliken_restraint_control%ref_count > 0) 610 mulliken_restraint_control%ref_count = mulliken_restraint_control%ref_count - 1 611 IF (mulliken_restraint_control%ref_count == 0) THEN 612 IF (ASSOCIATED(mulliken_restraint_control%atoms)) & 613 DEALLOCATE (mulliken_restraint_control%atoms) 614 mulliken_restraint_control%ref_count = 0 615 mulliken_restraint_control%strength = 0.0_dp 616 mulliken_restraint_control%target = 0.0_dp 617 mulliken_restraint_control%natoms = 0 618 DEALLOCATE (mulliken_restraint_control) 619 ENDIF 620 END SUBROUTINE mulliken_control_release 621 622! ************************************************************************************************** 623!> \brief retain the mulliken_restraint_type 624!> \param mulliken_restraint_control ... 625!> \par History 626!> 02.2005 created [Joost VandeVondele] 627! ************************************************************************************************** 628 SUBROUTINE mulliken_control_retain(mulliken_restraint_control) 629 TYPE(mulliken_restraint_type), POINTER :: mulliken_restraint_control 630 631 CHARACTER(len=*), PARAMETER :: routineN = 'mulliken_control_retain', & 632 routineP = moduleN//':'//routineN 633 634 CPASSERT(ASSOCIATED(mulliken_restraint_control)) 635 636 mulliken_restraint_control%ref_count = mulliken_restraint_control%ref_count + 1 637 END SUBROUTINE mulliken_control_retain 638 639! ************************************************************************************************** 640!> \brief create the ddapc_restraint_type 641!> \param ddapc_restraint_control ... 642!> \par History 643!> 02.2006 created [Joost VandeVondele] 644! ************************************************************************************************** 645 SUBROUTINE ddapc_control_create(ddapc_restraint_control) 646 TYPE(ddapc_restraint_type), POINTER :: ddapc_restraint_control 647 648 CHARACTER(len=*), PARAMETER :: routineN = 'ddapc_control_create', & 649 routineP = moduleN//':'//routineN 650 651 CPASSERT(.NOT. ASSOCIATED(ddapc_restraint_control)) 652 ALLOCATE (ddapc_restraint_control) 653 654 ddapc_restraint_control%density_type = do_full_density 655 ddapc_restraint_control%ref_count = 1 656 ddapc_restraint_control%strength = 0.1_dp 657 ddapc_restraint_control%ddapc_order_p = 0.0_dp 658 ddapc_restraint_control%functional_form = -1 659 ddapc_restraint_control%target = 1.0_dp 660 ddapc_restraint_control%natoms = 0 661 NULLIFY (ddapc_restraint_control%atoms) 662 NULLIFY (ddapc_restraint_control%coeff) 663 664 END SUBROUTINE ddapc_control_create 665 666! ************************************************************************************************** 667!> \brief release the ddapc_restraint_type 668!> \param ddapc_restraint_control ... 669!> \par History 670!> 02.2006 created [Joost VandeVondele] 671! ************************************************************************************************** 672 SUBROUTINE ddapc_control_release(ddapc_restraint_control) 673 TYPE(ddapc_restraint_type), POINTER :: ddapc_restraint_control 674 675 CHARACTER(len=*), PARAMETER :: routineN = 'ddapc_control_release', & 676 routineP = moduleN//':'//routineN 677 678 CPASSERT(ASSOCIATED(ddapc_restraint_control)) 679 CPASSERT(ddapc_restraint_control%ref_count > 0) 680 ddapc_restraint_control%ref_count = ddapc_restraint_control%ref_count - 1 681 IF (ddapc_restraint_control%ref_count == 0) THEN 682 IF (ASSOCIATED(ddapc_restraint_control%atoms)) & 683 DEALLOCATE (ddapc_restraint_control%atoms) 684 IF (ASSOCIATED(ddapc_restraint_control%coeff)) & 685 DEALLOCATE (ddapc_restraint_control%coeff) 686 ddapc_restraint_control%ref_count = 0 687 ddapc_restraint_control%strength = 0.0_dp 688 ddapc_restraint_control%target = 0.0_dp 689 ddapc_restraint_control%natoms = 0 690 DEALLOCATE (ddapc_restraint_control) 691 ENDIF 692 END SUBROUTINE ddapc_control_release 693 694! ************************************************************************************************** 695!> \brief retain the ddapc_restraint_type 696!> \param ddapc_restraint_control ... 697!> \par History 698!> 02.2006 created [Joost VandeVondele] 699! ************************************************************************************************** 700 SUBROUTINE ddapc_control_retain(ddapc_restraint_control) 701 TYPE(ddapc_restraint_type), POINTER :: ddapc_restraint_control 702 703 CHARACTER(len=*), PARAMETER :: routineN = 'ddapc_control_retain', & 704 routineP = moduleN//':'//routineN 705 706 CPASSERT(ASSOCIATED(ddapc_restraint_control)) 707 708 ddapc_restraint_control%ref_count = ddapc_restraint_control%ref_count + 1 709 END SUBROUTINE ddapc_control_retain 710 711! ************************************************************************************************** 712!> \brief create the s2_restraint_type 713!> \param s2_restraint_control ... 714!> \par History 715!> 03.2006 created [Joost VandeVondele] 716! ************************************************************************************************** 717 SUBROUTINE s2_control_create(s2_restraint_control) 718 TYPE(s2_restraint_type), POINTER :: s2_restraint_control 719 720 CHARACTER(len=*), PARAMETER :: routineN = 's2_control_create', & 721 routineP = moduleN//':'//routineN 722 723 CPASSERT(.NOT. ASSOCIATED(s2_restraint_control)) 724 ALLOCATE (s2_restraint_control) 725 726 s2_restraint_control%ref_count = 1 727 s2_restraint_control%strength = 0.1_dp 728 s2_restraint_control%s2_order_p = 0.0_dp 729 s2_restraint_control%functional_form = -1 730 s2_restraint_control%target = 1.0_dp 731 END SUBROUTINE s2_control_create 732 733! ************************************************************************************************** 734!> \brief release the s2_restraint_type 735!> \param s2_restraint_control ... 736!> \par History 737!> 03.2006 created [Joost VandeVondele] 738! ************************************************************************************************** 739 SUBROUTINE s2_control_release(s2_restraint_control) 740 TYPE(s2_restraint_type), POINTER :: s2_restraint_control 741 742 CHARACTER(len=*), PARAMETER :: routineN = 's2_control_release', & 743 routineP = moduleN//':'//routineN 744 745 CPASSERT(ASSOCIATED(s2_restraint_control)) 746 CPASSERT(s2_restraint_control%ref_count > 0) 747 s2_restraint_control%ref_count = s2_restraint_control%ref_count - 1 748 IF (s2_restraint_control%ref_count == 0) THEN 749 s2_restraint_control%ref_count = 0 750 s2_restraint_control%strength = 0.0_dp 751 s2_restraint_control%target = 0.0_dp 752 DEALLOCATE (s2_restraint_control) 753 ENDIF 754 END SUBROUTINE s2_control_release 755 756! ************************************************************************************************** 757!> \brief retain the s2_restraint_type 758!> \param s2_restraint_control ... 759!> \par History 760!> 03.2006 created [Joost VandeVondele] 761! ************************************************************************************************** 762 SUBROUTINE s2_control_retain(s2_restraint_control) 763 TYPE(s2_restraint_type), POINTER :: s2_restraint_control 764 765 CHARACTER(len=*), PARAMETER :: routineN = 's2_control_retain', & 766 routineP = moduleN//':'//routineN 767 768 CPASSERT(ASSOCIATED(s2_restraint_control)) 769 s2_restraint_control%ref_count = s2_restraint_control%ref_count + 1 770 END SUBROUTINE s2_control_retain 771 772! ************************************************************************************************** 773!> \brief allocates and perform a very basic initialization 774!> \param dft_control the object to create 775!> \par History 776!> 02.2003 created [fawzi] 777!> \author fawzi 778! ************************************************************************************************** 779 SUBROUTINE dft_control_create(dft_control) 780 TYPE(dft_control_type), POINTER :: dft_control 781 782 CHARACTER(len=*), PARAMETER :: routineN = 'dft_control_create', & 783 routineP = moduleN//':'//routineN 784 785 CPASSERT(.NOT. ASSOCIATED(dft_control)) 786 ALLOCATE (dft_control) 787 dft_control%ref_count = 1 788 last_dft_control_id = last_dft_control_id + 1 789 dft_control%id_nr = last_dft_control_id 790 NULLIFY (dft_control%xas_control) 791 NULLIFY (dft_control%qs_control) 792 NULLIFY (dft_control%tddfpt_control) 793 NULLIFY (dft_control%tddfpt2_control) 794 NULLIFY (dft_control%efield_fields) 795 NULLIFY (dft_control%period_efield) 796 NULLIFY (dft_control%admm_control) 797 NULLIFY (dft_control%rtp_control) 798 NULLIFY (dft_control%sccs_control) 799 dft_control%do_sccs = .FALSE. 800 dft_control%apply_embed_pot = .FALSE. 801 dft_control%apply_dmfet_pot = .FALSE. 802 CALL qs_control_create(dft_control%qs_control) 803 CALL tddfpt2_control_create(dft_control%tddfpt2_control) 804 END SUBROUTINE dft_control_create 805 806! ************************************************************************************************** 807!> \brief ... 808!> \param dft_control ... 809!> \par History 810!> 02.2003 created [fawzi] 811!> \author fawzi 812! ************************************************************************************************** 813 SUBROUTINE dft_control_retain(dft_control) 814 TYPE(dft_control_type), POINTER :: dft_control 815 816 CHARACTER(len=*), PARAMETER :: routineN = 'dft_control_retain', & 817 routineP = moduleN//':'//routineN 818 819 CPASSERT(ASSOCIATED(dft_control)) 820 CPASSERT(dft_control%ref_count > 0) 821 dft_control%ref_count = dft_control%ref_count + 1 822 END SUBROUTINE dft_control_retain 823 824! ************************************************************************************************** 825!> \brief ... 826!> \param dft_control ... 827!> \par History 828!> 02.2003 created [fawzi] 829!> \author fawzi 830! ************************************************************************************************** 831 SUBROUTINE dft_control_release(dft_control) 832 TYPE(dft_control_type), POINTER :: dft_control 833 834 CHARACTER(len=*), PARAMETER :: routineN = 'dft_control_release', & 835 routineP = moduleN//':'//routineN 836 837 IF (ASSOCIATED(dft_control)) THEN 838 CPASSERT(dft_control%ref_count > 0) 839 dft_control%ref_count = dft_control%ref_count - 1 840 IF (dft_control%ref_count == 0) THEN 841 CALL qs_control_release(dft_control%qs_control) 842 CALL tddfpt_control_release(dft_control%tddfpt_control) 843 CALL tddfpt2_control_release(dft_control%tddfpt2_control) 844 CALL xas_control_release(dft_control%xas_control) 845 CALL admm_control_release(dft_control%admm_control) 846 CALL efield_fields_release(dft_control%efield_fields) 847 CALL sccs_control_release(dft_control%sccs_control) 848 IF (ASSOCIATED(dft_control%period_efield)) THEN 849 DEALLOCATE (dft_control%period_efield) 850 END IF 851 IF (ASSOCIATED(dft_control%rtp_control)) THEN 852 DEALLOCATE (dft_control%rtp_control) 853 END IF 854 DEALLOCATE (dft_control) 855 END IF 856 END IF 857 858 END SUBROUTINE dft_control_release 859 860! ************************************************************************************************** 861!> \brief ... 862!> \param gapw_control ... 863! ************************************************************************************************** 864 SUBROUTINE gapw_control_create(gapw_control) 865 TYPE(gapw_control_type), POINTER :: gapw_control 866 867 CHARACTER(len=*), PARAMETER :: routineN = 'gapw_control_create', & 868 routineP = moduleN//':'//routineN 869 870 CPASSERT(.NOT. ASSOCIATED(gapw_control)) 871 ALLOCATE (gapw_control) 872 END SUBROUTINE gapw_control_create 873 874! ************************************************************************************************** 875!> \brief ... 876!> \param qs_control ... 877! ************************************************************************************************** 878 SUBROUTINE qs_control_create(qs_control) 879 TYPE(qs_control_type), POINTER :: qs_control 880 881 CHARACTER(len=*), PARAMETER :: routineN = 'qs_control_create', & 882 routineP = moduleN//':'//routineN 883 884 CPASSERT(.NOT. ASSOCIATED(qs_control)) 885 ALLOCATE (qs_control) 886 887 NULLIFY (qs_control%e_cutoff) 888 NULLIFY (qs_control%gapw_control) 889 NULLIFY (qs_control%mulliken_restraint_control) 890 NULLIFY (qs_control%ddapc_restraint_control) 891 NULLIFY (qs_control%s2_restraint_control) 892 NULLIFY (qs_control%se_control) 893 NULLIFY (qs_control%dftb_control) 894 NULLIFY (qs_control%xtb_control) 895 NULLIFY (qs_control%cdft_control) 896 NULLIFY (qs_control%ddapc_restraint_control) 897 898 CALL mulliken_control_create(qs_control%mulliken_restraint_control) 899 CALL s2_control_create(qs_control%s2_restraint_control) 900 CALL gapw_control_create(qs_control%gapw_control) 901 CALL se_control_create(qs_control%se_control) 902 CALL dftb_control_create(qs_control%dftb_control) 903 CALL xtb_control_create(qs_control%xtb_control) 904 CALL cdft_control_create(qs_control%cdft_control) 905 END SUBROUTINE qs_control_create 906 907! ************************************************************************************************** 908!> \brief ... 909!> \param qs_control ... 910! ************************************************************************************************** 911 SUBROUTINE qs_control_release(qs_control) 912 TYPE(qs_control_type), POINTER :: qs_control 913 914 CHARACTER(len=*), PARAMETER :: routineN = 'qs_control_release', & 915 routineP = moduleN//':'//routineN 916 917 INTEGER :: i 918 919 IF (ASSOCIATED(qs_control)) THEN 920 CALL mulliken_control_release(qs_control%mulliken_restraint_control) 921 CALL s2_control_release(qs_control%s2_restraint_control) 922 CALL se_control_release(qs_control%se_control) 923 CALL dftb_control_release(qs_control%dftb_control) 924 CALL xtb_control_release(qs_control%xtb_control) 925 CALL cdft_control_release(qs_control%cdft_control) 926 927 IF (ASSOCIATED(qs_control%e_cutoff)) THEN 928 DEALLOCATE (qs_control%e_cutoff) 929 END IF 930 IF (ASSOCIATED(qs_control%gapw_control)) THEN 931 DEALLOCATE (qs_control%gapw_control) 932 END IF 933 IF (ASSOCIATED(qs_control%ddapc_restraint_control)) THEN 934 DO i = 1, SIZE(qs_control%ddapc_restraint_control) 935 CALL ddapc_control_release(qs_control%ddapc_restraint_control(i)%ddapc_restraint_control) 936 END DO 937 DEALLOCATE (qs_control%ddapc_restraint_control) 938 END IF 939 DEALLOCATE (qs_control) 940 END IF 941 END SUBROUTINE qs_control_release 942 943! ************************************************************************************************** 944!> \brief ... 945!> \param tddfpt_control ... 946! ************************************************************************************************** 947 SUBROUTINE tddfpt_control_create(tddfpt_control) 948 TYPE(tddfpt_control_type), POINTER :: tddfpt_control 949 950 CHARACTER(len=*), PARAMETER :: routineN = 'tddfpt_control_create', & 951 routineP = moduleN//':'//routineN 952 953 CPASSERT(.NOT. ASSOCIATED(tddfpt_control)) 954 ALLOCATE (tddfpt_control) 955 NULLIFY (tddfpt_control%lumos) 956 NULLIFY (tddfpt_control%lumos_eigenvalues) 957 958 END SUBROUTINE tddfpt_control_create 959 960! ************************************************************************************************** 961!> \brief ... 962!> \param tddfpt_control ... 963! ************************************************************************************************** 964 SUBROUTINE tddfpt_control_release(tddfpt_control) 965 TYPE(tddfpt_control_type), POINTER :: tddfpt_control 966 967 CHARACTER(len=*), PARAMETER :: routineN = 'tddfpt_control_release', & 968 routineP = moduleN//':'//routineN 969 970 INTEGER :: ispin 971 LOGICAL :: dummy 972 973 IF (ASSOCIATED(tddfpt_control)) THEN 974 IF (ASSOCIATED(tddfpt_control%lumos)) THEN 975 DO ispin = 1, SIZE(tddfpt_control%lumos) 976 CALL cp_fm_release(tddfpt_control%lumos(ispin)%matrix) 977 !MK the following line just avoids a crash of TDDFT runs using 978 !MK the sdbg version compiled with the NAG compiler when 979 !MK tddfpt_control%lumos is deallocated. This is most likely a 980 !MK compiler bug and thus the line might become obsolete 981 dummy = ASSOCIATED(tddfpt_control%lumos(ispin)%matrix) 982 END DO 983 DEALLOCATE (tddfpt_control%lumos) 984 END IF 985 IF (ASSOCIATED(tddfpt_control%lumos_eigenvalues)) THEN 986 DEALLOCATE (tddfpt_control%lumos_eigenvalues) 987 END IF 988 DEALLOCATE (tddfpt_control) 989 END IF 990 END SUBROUTINE tddfpt_control_release 991 992! ************************************************************************************************** 993!> \brief allocate control options for Time-Dependent Density Functional Theory calculation 994!> \param tddfpt_control an object to create 995!> \par History 996!> * 05.2016 created [Sergey Chulkov] 997! ************************************************************************************************** 998 SUBROUTINE tddfpt2_control_create(tddfpt_control) 999 TYPE(tddfpt2_control_type), POINTER :: tddfpt_control 1000 1001 CHARACTER(len=*), PARAMETER :: routineN = 'tddfpt2_control_create', & 1002 routineP = moduleN//':'//routineN 1003 1004 INTEGER :: handle 1005 1006 CPASSERT(.NOT. ASSOCIATED(tddfpt_control)) 1007 CALL timeset(routineN, handle) 1008 1009 ALLOCATE (tddfpt_control) 1010 1011 CALL timestop(handle) 1012 END SUBROUTINE tddfpt2_control_create 1013 1014! ************************************************************************************************** 1015!> \brief release memory allocated for TDDFT control options 1016!> \param tddfpt_control an object to release 1017!> \par History 1018!> * 05.2016 created [Sergey Chulkov] 1019! ************************************************************************************************** 1020 SUBROUTINE tddfpt2_control_release(tddfpt_control) 1021 TYPE(tddfpt2_control_type), POINTER :: tddfpt_control 1022 1023 CHARACTER(len=*), PARAMETER :: routineN = 'tddfpt2_control_release', & 1024 routineP = moduleN//':'//routineN 1025 1026 INTEGER :: handle 1027 1028 CALL timeset(routineN, handle) 1029 1030 IF (ASSOCIATED(tddfpt_control)) THEN 1031 DEALLOCATE (tddfpt_control) 1032 END IF 1033 1034 CALL timestop(handle) 1035 END SUBROUTINE tddfpt2_control_release 1036 1037! ************************************************************************************************** 1038!> \brief ... 1039!> \param efield_fields ... 1040! ************************************************************************************************** 1041 SUBROUTINE efield_fields_release(efield_fields) 1042 TYPE(efield_p_type), DIMENSION(:), POINTER :: efield_fields 1043 1044 CHARACTER(len=*), PARAMETER :: routineN = 'efield_fields_release', & 1045 routineP = moduleN//':'//routineN 1046 1047 INTEGER :: i 1048 1049 IF (ASSOCIATED(efield_fields)) THEN 1050 DO i = 1, SIZE(efield_fields) 1051 IF (ASSOCIATED(efield_fields(i)%efield)) THEN 1052 IF (ASSOCIATED(efield_fields(i)%efield%envelop_r_vars)) THEN 1053 DEALLOCATE (efield_fields(i)%efield%envelop_r_vars) 1054 END IF 1055 IF (ASSOCIATED(efield_fields(i)%efield%envelop_i_vars)) THEN 1056 DEALLOCATE (efield_fields(i)%efield%envelop_i_vars) 1057 END IF 1058 IF (ASSOCIATED(efield_fields(i)%efield%polarisation)) THEN 1059 DEALLOCATE (efield_fields(i)%efield%polarisation) 1060 END IF 1061 DEALLOCATE (efield_fields(i)%efield) 1062 END IF 1063 END DO 1064 DEALLOCATE (efield_fields) 1065 END IF 1066 END SUBROUTINE efield_fields_release 1067 1068! ************************************************************************************************** 1069!> \brief ... 1070!> \param dftb_control ... 1071! ************************************************************************************************** 1072 SUBROUTINE dftb_control_create(dftb_control) 1073 TYPE(dftb_control_type), POINTER :: dftb_control 1074 1075 CHARACTER(len=*), PARAMETER :: routineN = 'dftb_control_create', & 1076 routineP = moduleN//':'//routineN 1077 1078 CPASSERT(.NOT. ASSOCIATED(dftb_control)) 1079 ALLOCATE (dftb_control) 1080 1081 NULLIFY (dftb_control%sk_pair_list) 1082 END SUBROUTINE dftb_control_create 1083 1084! ************************************************************************************************** 1085!> \brief ... 1086!> \param dftb_control ... 1087! ************************************************************************************************** 1088 SUBROUTINE dftb_control_release(dftb_control) 1089 TYPE(dftb_control_type), POINTER :: dftb_control 1090 1091 CHARACTER(len=*), PARAMETER :: routineN = 'dftb_control_release', & 1092 routineP = moduleN//':'//routineN 1093 1094 IF (ASSOCIATED(dftb_control)) THEN 1095 IF (ASSOCIATED(dftb_control%sk_pair_list)) THEN 1096 DEALLOCATE (dftb_control%sk_pair_list) 1097 END IF 1098 DEALLOCATE (dftb_control) 1099 END IF 1100 END SUBROUTINE dftb_control_release 1101 1102! ************************************************************************************************** 1103!> \brief ... 1104!> \param xtb_control ... 1105! ************************************************************************************************** 1106 SUBROUTINE xtb_control_create(xtb_control) 1107 TYPE(xtb_control_type), POINTER :: xtb_control 1108 1109 CHARACTER(len=*), PARAMETER :: routineN = 'xtb_control_create', & 1110 routineP = moduleN//':'//routineN 1111 1112 CPASSERT(.NOT. ASSOCIATED(xtb_control)) 1113 ALLOCATE (xtb_control) 1114 1115 NULLIFY (xtb_control%kab_param) 1116 NULLIFY (xtb_control%kab_vals) 1117 NULLIFY (xtb_control%kab_types) 1118 1119 END SUBROUTINE xtb_control_create 1120 1121! ************************************************************************************************** 1122!> \brief ... 1123!> \param xtb_control ... 1124! ************************************************************************************************** 1125 SUBROUTINE xtb_control_release(xtb_control) 1126 TYPE(xtb_control_type), POINTER :: xtb_control 1127 1128 CHARACTER(len=*), PARAMETER :: routineN = 'xtb_control_release', & 1129 routineP = moduleN//':'//routineN 1130 1131 IF (ASSOCIATED(xtb_control)) THEN 1132 IF (ASSOCIATED(xtb_control%kab_param)) THEN 1133 DEALLOCATE (xtb_control%kab_param) 1134 END IF 1135 IF (ASSOCIATED(xtb_control%kab_vals)) THEN 1136 DEALLOCATE (xtb_control%kab_vals) 1137 END IF 1138 IF (ASSOCIATED(xtb_control%kab_types)) THEN 1139 DEALLOCATE (xtb_control%kab_types) 1140 END IF 1141 DEALLOCATE (xtb_control) 1142 END IF 1143 END SUBROUTINE xtb_control_release 1144 1145! ************************************************************************************************** 1146!> \brief ... 1147!> \param se_control ... 1148! ************************************************************************************************** 1149 SUBROUTINE se_control_create(se_control) 1150 TYPE(semi_empirical_control_type), POINTER :: se_control 1151 1152 CHARACTER(len=*), PARAMETER :: routineN = 'se_control_create', & 1153 routineP = moduleN//':'//routineN 1154 1155 CPASSERT(.NOT. ASSOCIATED(se_control)) 1156 ALLOCATE (se_control) 1157 END SUBROUTINE se_control_create 1158 1159! ************************************************************************************************** 1160!> \brief ... 1161!> \param se_control ... 1162! ************************************************************************************************** 1163 SUBROUTINE se_control_release(se_control) 1164 TYPE(semi_empirical_control_type), POINTER :: se_control 1165 1166 CHARACTER(len=*), PARAMETER :: routineN = 'se_control_release', & 1167 routineP = moduleN//':'//routineN 1168 1169 IF (ASSOCIATED(se_control)) THEN 1170 DEALLOCATE (se_control) 1171 END IF 1172 END SUBROUTINE se_control_release 1173 1174! ************************************************************************************************** 1175!> \brief ... 1176!> \param admm_control ... 1177! ************************************************************************************************** 1178 SUBROUTINE admm_control_create(admm_control) 1179 TYPE(admm_control_type), POINTER :: admm_control 1180 1181 CHARACTER(len=*), PARAMETER :: routineN = 'admm_control_create', & 1182 routineP = moduleN//':'//routineN 1183 1184 CPASSERT(.NOT. ASSOCIATED(admm_control)) 1185 ALLOCATE (admm_control) 1186 1187 END SUBROUTINE admm_control_create 1188 1189! ************************************************************************************************** 1190!> \brief ... 1191!> \param admm_control ... 1192! ************************************************************************************************** 1193 SUBROUTINE admm_control_release(admm_control) 1194 TYPE(admm_control_type), POINTER :: admm_control 1195 1196 CHARACTER(len=*), PARAMETER :: routineN = 'admm_control_release', & 1197 routineP = moduleN//':'//routineN 1198 1199 IF (ASSOCIATED(admm_control)) THEN 1200 DEALLOCATE (admm_control) 1201 END IF 1202 END SUBROUTINE admm_control_release 1203 1204! ************************************************************************************************** 1205!> \brief Create sccs_control_type 1206!> \param sccs_control ... 1207!> \par History 1208!> - Creation (11.10.2013,MK) 1209!> \author Matthias Krack (MK) 1210!> \version 1.0 1211! ************************************************************************************************** 1212 SUBROUTINE sccs_control_create(sccs_control) 1213 TYPE(sccs_control_type), POINTER :: sccs_control 1214 1215 CHARACTER(LEN=*), PARAMETER :: routineN = 'sccs_control_create', & 1216 routineP = moduleN//':'//routineN 1217 1218 CPASSERT(.NOT. ASSOCIATED(sccs_control)) 1219 ALLOCATE (sccs_control) 1220 1221 sccs_control%ref_count = 1 1222 sccs_control%derivative_method = 0 1223 sccs_control%max_iter = 0 1224 sccs_control%method_id = 0 1225 sccs_control%alpha_solvent = 0.0_dp 1226 sccs_control%beta = 0.0_dp 1227 sccs_control%beta_solvent = 0.0_dp 1228 sccs_control%delta_rho = 0.0_dp 1229 sccs_control%eps_sccs = 0.0_dp 1230 sccs_control%eps_scf = 0.0_dp 1231 sccs_control%epsilon_solvent = 0.0_dp 1232 sccs_control%gamma_solvent = 0.0_dp 1233 sccs_control%mixing = 0.0_dp 1234 sccs_control%rho_max = 0.0_dp 1235 sccs_control%rho_min = 0.0_dp 1236 sccs_control%rho_zero = 0.0_dp 1237 sccs_control%sccs_activated = .FALSE. 1238 1239 END SUBROUTINE sccs_control_create 1240 1241! ************************************************************************************************** 1242!> \brief Release sccs_control_type 1243!> \param sccs_control ... 1244!> \par History 1245!> - Creation (11.10.2013,MK) 1246!> \author Matthias Krack (MK) 1247!> \version 1.0 1248! ************************************************************************************************** 1249 SUBROUTINE sccs_control_release(sccs_control) 1250 TYPE(sccs_control_type), POINTER :: sccs_control 1251 1252 CHARACTER(LEN=*), PARAMETER :: routineN = 'sccs_control_release', & 1253 routineP = moduleN//':'//routineN 1254 1255 IF (ASSOCIATED(sccs_control)) THEN 1256 CPASSERT(sccs_control%ref_count > 0) 1257 sccs_control%ref_count = sccs_control%ref_count - 1 1258 IF (sccs_control%ref_count == 0) THEN 1259 DEALLOCATE (sccs_control) 1260 END IF 1261 END IF 1262 1263 END SUBROUTINE sccs_control_release 1264 1265END MODULE cp_control_types 1266