|
CP2K 2.5 (Revision 12981)
|
00001 !-----------------------------------------------------------------------------! 00002 ! CP2K: A general program to perform molecular dynamics simulations ! 00003 ! Copyright (C) 2000 - 2013 CP2K developers group ! 00004 !-----------------------------------------------------------------------------! 00005 00006 ! ***************************************************************************** 00010 MODULE cp_control_types 00011 USE cp_fm_types, ONLY: cp_fm_p_type,& 00012 cp_fm_release 00013 USE f77_blas 00014 USE input_constants, ONLY: do_full_density 00015 USE kinds, ONLY: default_path_length,& 00016 default_string_length,& 00017 dp 00018 USE pw_types, ONLY: pw_p_type 00019 USE xas_control, ONLY: xas_control_create,& 00020 xas_control_release,& 00021 xas_control_type 00022 #include "cp_common_uses.h" 00023 00024 IMPLICIT NONE 00025 00026 PRIVATE 00027 00028 ! ***************************************************************************** 00029 ! \brief Control parameters for pw grids 00030 ! ***************************************************************************** 00031 TYPE pw_grid_option 00032 LOGICAL :: spherical 00033 LOGICAL :: fullspace 00034 INTEGER, DIMENSION(2) :: distribution_layout 00035 INTEGER :: blocked 00036 END TYPE pw_grid_option 00037 00038 ! ***************************************************************************** 00039 ! \brief Control parameters for SCP calculations 00040 ! ***************************************************************************** 00041 TYPE scp_control_type 00042 LOGICAL :: dispersion 00043 INTEGER :: coeff_guess 00044 END TYPE scp_control_type 00045 00046 ! ***************************************************************************** 00047 ! \brief Control parameters for REAL_TIME_PROPAGATION calculations 00048 ! ***************************************************************************** 00049 TYPE rtp_control_type 00050 LOGICAL :: converged 00051 REAL(KIND = dp) :: eps_ener 00052 INTEGER :: max_iter 00053 INTEGER :: mat_exp 00054 INTEGER :: propagator 00055 LOGICAL :: fixed_ions 00056 INTEGER :: initial_wfn 00057 REAL(dp) :: eps_exp 00058 LOGICAL :: initial_step 00059 LOGICAL :: hfx_redistribute 00060 INTEGER :: aspc_order 00061 INTEGER :: extrapolation 00062 INTEGER :: sc_check_start 00063 LOGICAL :: apply_delta_pulse 00064 LOGICAL :: periodic 00065 INTEGER, DIMENSION(3) :: delta_pulse_direction 00066 REAL(KIND=dp) :: delta_pulse_scale 00067 END TYPE rtp_control_type 00068 ! ***************************************************************************** 00069 ! \brief Control parameters for DFTB calculations 00070 ! ***************************************************************************** 00071 TYPE dftb_control_type 00072 LOGICAL :: self_consistent 00073 LOGICAL :: orthogonal_basis 00074 LOGICAL :: dispersion 00075 LOGICAL :: hb_sr_damp 00076 REAL(KIND = dp) :: eps_disp 00077 LOGICAL :: do_ewald 00078 CHARACTER(LEN=default_path_length) :: sk_file_path 00079 CHARACTER(LEN=default_path_length) :: sk_file_list 00080 CHARACTER(LEN=default_string_length), 00081 DIMENSION(:,:), POINTER :: sk_pair_list 00082 CHARACTER(LEN=default_path_length) :: uff_force_field 00083 END TYPE dftb_control_type 00084 00085 ! ***************************************************************************** 00086 ! \brief Control parameters for SCPTB calculations 00087 ! ***************************************************************************** 00088 TYPE scptb_control_type 00089 LOGICAL :: dispersion 00090 LOGICAL :: do_ewald 00091 LOGICAL :: do_scc 00092 LOGICAL :: do_scp 00093 INTEGER :: sto_ng 00094 REAL(KIND = dp) :: rcdisp 00095 REAL(KIND = dp) :: epscn 00096 REAL(KIND = dp), DIMENSION(3) :: sd3 00097 CHARACTER(LEN=default_path_length) :: parameter_file 00098 CHARACTER(LEN=default_path_length) :: dispersion_parameter_file 00099 REAL(KIND = dp) :: epspair 00100 END TYPE scptb_control_type 00101 00102 ! ***************************************************************************** 00103 ! \brief Control parameters for semi empirical calculations 00104 ! ***************************************************************************** 00105 TYPE semi_empirical_control_type 00106 LOGICAL :: orthogonal_basis 00107 LOGICAL :: analytical_gradients 00108 LOGICAL :: force_kdsod_EX 00109 LOGICAL :: do_ewald, do_ewald_r3, do_ewald_gks 00110 LOGICAL :: scp 00111 INTEGER :: integral_screening, periodic_type 00112 INTEGER :: max_multipole 00113 INTEGER :: ga_ncells 00114 REAL(KIND = dp) :: delta 00115 ! Parameters controlling the evaluation of the integrals 00116 REAL(KIND = dp) :: cutoff_lrc, taper_lrc, range_lrc 00117 REAL(KIND = dp) :: cutoff_cou, taper_cou, range_cou 00118 REAL(KIND = dp) :: cutoff_exc, taper_exc, range_exc 00119 REAL(KIND = dp) :: taper_scr , range_scr 00120 END TYPE semi_empirical_control_type 00121 00122 ! ***************************************************************************** 00123 ! \brief Control parameters for GAPW method within QUICKSTEP *** 00124 ! eps_3c_reduce:to reduce the cutoff value for the interaction of 00125 ! the primitive Gaussian-type 00126 ! functions with the GAPW projectors in the construction of 00127 ! the 3 center terms. This factor multiplies eps_pgf_orb in 00128 ! the calculation of a shorter radius that can be used for 00129 ! the construction of the OCE coefficients. The default is 1 00130 ! (no effects). Larger values can be used to reduce the memory 00131 ! allocations, but should be tested first. 00132 ! ***************************************************************************** 00133 TYPE gapw_control_type 00134 REAL(KIND = dp) :: eps_3c_reduce, 00135 eps_fit, 00136 eps_iso, 00137 eps_Vrho0, 00138 eps_svd, 00139 eps_cpc 00140 INTEGER :: ladd_rho0, 00141 lmax_rho0, 00142 lmax_sphere, 00143 quadrature 00144 LOGICAL :: lrho1_eq_lrho0 00145 LOGICAL :: alpha0_hard_from_input, 00146 force_paw, 00147 non_paw_atoms, 00148 nopaw_as_gpw 00149 REAL(KIND = dp) :: alpha0_hard 00150 REAL(KIND = dp) :: max_rad_local 00151 END TYPE gapw_control_type 00152 ! ***************************************************************************** 00153 ! \brief Control parameters for LRIPAW method within QUICKSTEP *** 00154 ! ***************************************************************************** 00155 TYPE lripaw_control_type 00156 REAL(KIND = dp) :: eps_fit 00157 INTEGER :: quadrature 00158 REAL(KIND = dp) :: alpha0 00159 END TYPE lripaw_control_type 00160 00161 ! ***************************************************************************** 00162 ! \brief parameters for calculations involving a time dependent electric field 00163 ! ***************************************************************************** 00164 TYPE efield_type 00165 REAL(KIND = dp) :: actual_time 00166 REAL(KIND = dp), DIMENSION(:),POINTER :: polarisation 00167 INTEGER :: envelop_id 00168 REAL(kind=dp),DIMENSION(:), 00169 POINTER :: envelop_r_vars 00170 INTEGER,DIMENSION(:), 00171 POINTER :: envelop_i_vars 00172 REAL(kind=dp) :: strength 00173 REAL(KIND=dp) :: phase_offset 00174 REAL(KIND=dp) :: wavelength 00175 END TYPE efield_type 00176 00177 TYPE efield_p_type 00178 TYPE(efield_type),POINTER :: efield 00179 END TYPE efield_p_type 00180 ! ***************************************************************************** 00181 ! \brief parameters for calculations involving a time dependent electric field 00182 ! ***************************************************************************** 00183 TYPE period_efield_type 00184 REAL(KIND = dp), DIMENSION(:),POINTER :: polarisation 00185 REAL(kind=dp) :: strength 00186 END TYPE period_efield_type 00187 00188 ! ***************************************************************************** 00189 ! \brief some parameters useful for mulliken_restraints 00190 ! ***************************************************************************** 00191 TYPE mulliken_restraint_type 00192 INTEGER :: ref_count 00193 REAL(KIND = dp) :: strength 00194 REAL(KIND = dp) :: TARGET 00195 INTEGER :: natoms 00196 INTEGER, POINTER, DIMENSION(:) :: atoms 00197 END TYPE mulliken_restraint_type 00198 00199 ! ***************************************************************************** 00200 ! \brief some parameters useful for ddapc_restraints 00201 ! ***************************************************************************** 00202 TYPE ddapc_restraint_type 00203 INTEGER :: ref_count 00204 REAL(KIND = dp) :: strength 00205 REAL(KIND = dp) :: TARGET 00206 REAL(KIND = dp) :: ddapc_order_p 00207 INTEGER :: functional_form 00208 INTEGER :: natoms 00209 INTEGER, POINTER, DIMENSION(:) :: atoms 00210 REAL(KIND=dp), POINTER, DIMENSION(:) :: coeff 00211 INTEGER :: density_type 00212 END TYPE ddapc_restraint_type 00213 00214 ! ***************************************************************************** 00215 ! \brief provides a vector of pointers to ddapc_restraint_type 00216 ! ***************************************************************************** 00217 TYPE ddapc_restraint_p_type 00218 TYPE(ddapc_restraint_type),POINTER:: ddapc_restraint_control 00219 END TYPE ddapc_restraint_p_type 00220 00221 ! ***************************************************************************** 00222 ! \brief some parameters useful for becke_restraints 00223 ! ***************************************************************************** 00224 TYPE becke_restraint_type 00225 INTEGER :: ref_count 00226 REAL(KIND = dp) :: strength 00227 REAL(KIND = dp) :: TARGET 00228 REAL(KIND = dp) :: becke_order_p 00229 INTEGER :: functional_form 00230 INTEGER :: natoms 00231 INTEGER, POINTER, DIMENSION(:) :: atoms 00232 TYPE(pw_p_type) :: becke_pot 00233 LOGICAL :: need_pot 00234 REAL(KIND=dp), POINTER, DIMENSION(:) :: coeff 00235 INTEGER :: density_type 00236 END TYPE becke_restraint_type 00237 00238 ! ***************************************************************************** 00239 ! \brief some parameters useful for s2_restraints 00240 ! ***************************************************************************** 00241 TYPE s2_restraint_type 00242 INTEGER :: ref_count 00243 REAL(KIND = dp) :: strength 00244 REAL(KIND = dp) :: TARGET 00245 REAL(KIND = dp) :: s2_order_p 00246 INTEGER :: functional_form 00247 END TYPE s2_restraint_type 00248 00249 ! ***************************************************************************** 00250 ! \brief some parameters useful for auxiliary density matrix method 00251 ! ***************************************************************************** 00252 TYPE admm_control_type 00253 INTEGER :: method_id 00254 INTEGER :: purification_method 00255 INTEGER :: block_projection_method 00256 INTEGER :: block_purification_method 00257 END TYPE admm_control_type 00258 00259 ! ***************************************************************************** 00260 ! \brief Control parameters for a QUICKSTEP and KIM-GORDON calculation *** 00261 ! eps_pgf_orb: Cutoff value for the interaction of the primitive 00262 ! Gaussian-type functions (primitive basis functions). 00263 ! ***************************************************************************** 00264 TYPE qs_control_type 00265 CHARACTER(LEN=10) :: method 00266 INTEGER :: method_id 00267 REAL(KIND = dp) :: eps_core_charge, 00268 eps_kg_orb, 00269 eps_pgf_orb, 00270 eps_ppl, 00271 eps_ppnl, 00272 eps_rho_gspace, 00273 eps_rho_rspace, 00274 eps_filter_matrix, 00275 eps_gvg_rspace, 00276 progression_factor, 00277 relative_cutoff 00278 LOGICAL :: do_ls_scf 00279 LOGICAL :: do_kg 00280 LOGICAL :: commensurate_mgrids 00281 LOGICAL :: realspace_mgrids 00282 LOGICAL :: map_consistent 00283 LOGICAL :: gapw,gapw_xc,gpw,pao 00284 LOGICAL :: lripaw 00285 LOGICAL :: ofgpw 00286 LOGICAL :: dftb 00287 LOGICAL :: scptb 00288 LOGICAL :: scp 00289 LOGICAL :: semi_empirical 00290 LOGICAL :: mulliken_restraint 00291 LOGICAL :: ddapc_restraint 00292 LOGICAL :: ddapc_restraint_is_spin 00293 LOGICAL :: ddapc_explicit_potential 00294 LOGICAL :: becke_restraint 00295 LOGICAL :: et_coupling_calc 00296 LOGICAL :: s2_restraint 00297 INTEGER :: do_ppl_method 00298 INTEGER :: wf_interpolation_method_nr 00299 INTEGER :: wf_extrapolation_order 00300 REAL(KIND = dp) :: cutoff 00301 REAL(KIND = dp), DIMENSION(:), POINTER :: e_cutoff 00302 TYPE (mulliken_restraint_type), POINTER :: mulliken_restraint_control 00303 TYPE (ddapc_restraint_p_type), DIMENSION(:),POINTER :: ddapc_restraint_control 00304 TYPE (becke_restraint_type), POINTER :: becke_control 00305 TYPE (s2_restraint_type), POINTER :: s2_restraint_control 00306 TYPE (dftb_control_type),POINTER :: dftb_control 00307 TYPE (scptb_control_type),POINTER :: scptb_control 00308 TYPE (semi_empirical_control_type),POINTER :: se_control 00309 TYPE (gapw_control_type), POINTER :: gapw_control 00310 TYPE (lripaw_control_type), POINTER :: lripaw_control 00311 TYPE (pw_grid_option) :: pw_grid_opt 00312 LOGICAL :: check_bcsr_code 00313 INTEGER :: bcsr_code 00314 LOGICAL :: skip_load_balance_distributed 00315 END TYPE qs_control_type 00316 00317 ! ***************************************************************************** 00318 ! \brief Control parameters for a TIME-DEPENDENT PERTURBATION calculation 00319 ! \par ATTRIBUTES 00320 ! - n_ev : number of eigenvalues to calculate 00321 ! - n_reortho : how many time to reorthogonalize (in the lanczos algorithm) 00322 ! - do_kernel : wether to evaluate the kernel (this is a debugging option) 00323 ! - res_etype : { SINGLET | TRIPLET } which excitations 00324 ! to calculate 00325 ! - lumos_eigenvalues : holds the eigenvalues of the lumos (if calculated in QS) 00326 ! 00327 ! \par NOTES 00328 ! The lumos are helpfull in choosing a initial vector for the TDDFPT 00329 ! calculation, since they can be used to construct the solutions of the 00330 ! TDDFPT operator without the perturbation kernel. 00331 ! ***************************************************************************** 00332 TYPE tddfpt_control_type 00333 TYPE(cp_fm_p_type), DIMENSION(:), POINTER :: lumos 00334 REAL(KIND=dp) :: tolerance 00335 INTEGER :: n_ev 00336 INTEGER :: max_kv 00337 INTEGER :: n_restarts 00338 INTEGER :: n_reortho 00339 LOGICAL :: do_kernel 00340 LOGICAL :: lsd_singlets 00341 LOGICAL :: invert_S 00342 LOGICAL :: precond 00343 LOGICAL :: drho_by_collocation 00344 LOGICAL :: use_kinetic_energy_density 00345 INTEGER :: res_etype 00346 INTEGER :: diag_method 00347 INTEGER :: oe_corr 00348 INTEGER :: sic_method_id 00349 INTEGER :: sic_list_id 00350 REAL(KIND=dp) :: sic_scaling_a,sic_scaling_b 00351 REAL(KIND = dp), DIMENSION(:,:), POINTER :: lumos_eigenvalues 00352 END TYPE tddfpt_control_type 00353 00354 ! ***************************************************************************** 00355 ! \brief Control parameters for a DFT calculation 00356 ! ***************************************************************************** 00357 TYPE dft_control_type 00358 TYPE(qs_control_type), POINTER :: qs_control 00359 TYPE(tddfpt_control_type),POINTER :: tddfpt_control 00360 TYPE(xas_control_type), POINTER :: xas_control 00361 TYPE(scp_control_type),POINTER :: scp_control 00362 TYPE(rtp_control_type),POINTER :: rtp_control 00363 TYPE(admm_control_type), POINTER 00364 :: admm_control 00365 TYPE(efield_p_type),POINTER, 00366 DIMENSION(:) :: efield_fields 00367 TYPE(period_efield_type),POINTER :: period_efield 00368 INTEGER :: nspins, 00369 charge, 00370 multiplicity, 00371 sic_method_id, 00372 ref_count, 00373 id_nr, 00374 plus_u_method_id 00375 INTEGER :: sic_list_id 00376 REAL(KIND=dp) :: relax_multiplicity, 00377 sic_scaling_a, 00378 sic_scaling_b 00379 LOGICAL :: do_tddfpt_calculation, 00380 do_xas_calculation, 00381 drho_by_collocation, 00382 use_kinetic_energy_density, 00383 restricted, 00384 roks, 00385 uks, 00386 lsd, 00387 dft_plus_u, 00388 scp, 00389 apply_efield_field, 00390 apply_period_efield, 00391 apply_external_potential, 00392 eval_external_potential, 00393 do_admm, 00394 smear, 00395 low_spin_roks 00396 END TYPE dft_control_type 00397 00398 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_control_types' 00399 INTEGER, SAVE :: last_dft_control_id=0 00400 00401 ! *** Public data types *** 00402 00403 PUBLIC :: dft_control_type,& 00404 qs_control_type,& 00405 gapw_control_type,& 00406 lripaw_control_type,& 00407 tddfpt_control_type,& 00408 efield_type,& 00409 period_efield_type,& 00410 efield_p_type,& 00411 pw_grid_option,& 00412 mulliken_restraint_type,& 00413 ddapc_restraint_type,& 00414 ddapc_restraint_p_type,& 00415 dftb_control_type,& 00416 scptb_control_type,& 00417 scp_control_type,& 00418 becke_restraint_type,& 00419 semi_empirical_control_type,& 00420 s2_restraint_type,& 00421 admm_control_type,& 00422 rtp_control_type 00423 00424 ! *** Public subroutines *** 00425 00426 PUBLIC :: dft_control_retain,& 00427 dft_control_release,& 00428 dft_control_create,& 00429 scp_control_create,& 00430 xas_control_create,& 00431 tddfpt_control_create,& 00432 admm_control_create,& 00433 ddapc_control_create 00434 00435 CONTAINS 00436 00437 ! ***************************************************************************** 00442 SUBROUTINE mulliken_control_create(mulliken_restraint_control,error) 00443 TYPE(mulliken_restraint_type), POINTER :: mulliken_restraint_control 00444 TYPE(cp_error_type), INTENT(inout) :: error 00445 00446 CHARACTER(len=*), PARAMETER :: routineN = 'mulliken_control_create', 00447 routineP = moduleN//':'//routineN 00448 00449 INTEGER :: stat 00450 LOGICAL :: failure 00451 00452 failure=.FALSE. 00453 00454 CPPrecondition(.NOT.ASSOCIATED(mulliken_restraint_control),cp_failure_level,routineP,error,failure) 00455 ALLOCATE(mulliken_restraint_control,stat=stat) 00456 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00457 00458 mulliken_restraint_control%ref_count=1 00459 mulliken_restraint_control%strength=0.1_dp 00460 mulliken_restraint_control%target=1.0_dp 00461 mulliken_restraint_control%natoms=0 00462 NULLIFY(mulliken_restraint_control%atoms) 00463 END SUBROUTINE mulliken_control_create 00464 00465 ! ***************************************************************************** 00470 SUBROUTINE mulliken_control_release(mulliken_restraint_control,error) 00471 TYPE(mulliken_restraint_type), POINTER :: mulliken_restraint_control 00472 TYPE(cp_error_type), INTENT(inout) :: error 00473 00474 CHARACTER(len=*), PARAMETER :: routineN = 'mulliken_control_release', 00475 routineP = moduleN//':'//routineN 00476 00477 LOGICAL :: failure 00478 00479 failure=.FALSE. 00480 CPPrecondition(ASSOCIATED(mulliken_restraint_control),cp_failure_level,routineP,error,failure) 00481 CPPrecondition(mulliken_restraint_control%ref_count>0,cp_failure_level,routineP,error,failure) 00482 mulliken_restraint_control%ref_count=mulliken_restraint_control%ref_count-1 00483 IF (mulliken_restraint_control%ref_count==0) THEN 00484 IF (ASSOCIATED(mulliken_restraint_control%atoms)) & 00485 DEALLOCATE(mulliken_restraint_control%atoms) 00486 mulliken_restraint_control%ref_count=0 00487 mulliken_restraint_control%strength=0.0_dp 00488 mulliken_restraint_control%target=0.0_dp 00489 mulliken_restraint_control%natoms=0 00490 DEALLOCATE(mulliken_restraint_control) 00491 ENDIF 00492 END SUBROUTINE mulliken_control_release 00493 00494 ! ***************************************************************************** 00499 SUBROUTINE mulliken_control_retain(mulliken_restraint_control,error) 00500 TYPE(mulliken_restraint_type), POINTER :: mulliken_restraint_control 00501 TYPE(cp_error_type), INTENT(inout) :: error 00502 00503 CHARACTER(len=*), PARAMETER :: routineN = 'mulliken_control_retain', 00504 routineP = moduleN//':'//routineN 00505 00506 LOGICAL :: failure 00507 00508 failure=.FALSE. 00509 CPPrecondition(ASSOCIATED(mulliken_restraint_control),cp_failure_level,routineP,error,failure) 00510 00511 mulliken_restraint_control%ref_count=mulliken_restraint_control%ref_count+1 00512 END SUBROUTINE mulliken_control_retain 00513 00514 ! ***************************************************************************** 00519 SUBROUTINE ddapc_control_create(ddapc_restraint_control,error) 00520 TYPE(ddapc_restraint_type), POINTER :: ddapc_restraint_control 00521 TYPE(cp_error_type), INTENT(inout) :: error 00522 00523 CHARACTER(len=*), PARAMETER :: routineN = 'ddapc_control_create', 00524 routineP = moduleN//':'//routineN 00525 00526 INTEGER :: stat 00527 LOGICAL :: failure 00528 00529 failure=.FALSE. 00530 00531 CPPrecondition(.NOT.ASSOCIATED(ddapc_restraint_control),cp_failure_level,routineP,error,failure) 00532 ALLOCATE(ddapc_restraint_control,stat=stat) 00533 CPPrecondition(stat==0,cp_failure_level,routineP,error,failure) 00534 00535 ddapc_restraint_control%density_type=do_full_density 00536 ddapc_restraint_control%ref_count=1 00537 ddapc_restraint_control%strength=0.1_dp 00538 ddapc_restraint_control%ddapc_order_p=0.0_dp 00539 ddapc_restraint_control%functional_form=-1 00540 ddapc_restraint_control%target=1.0_dp 00541 ddapc_restraint_control%natoms=0 00542 NULLIFY(ddapc_restraint_control%atoms) 00543 NULLIFY(ddapc_restraint_control%coeff) 00544 00545 END SUBROUTINE ddapc_control_create 00546 00547 ! ***************************************************************************** 00552 SUBROUTINE ddapc_control_release(ddapc_restraint_control,error) 00553 TYPE(ddapc_restraint_type), POINTER :: ddapc_restraint_control 00554 TYPE(cp_error_type), INTENT(inout) :: error 00555 00556 CHARACTER(len=*), PARAMETER :: routineN = 'ddapc_control_release', 00557 routineP = moduleN//':'//routineN 00558 00559 LOGICAL :: failure 00560 00561 failure=.FALSE. 00562 CPPrecondition(ASSOCIATED(ddapc_restraint_control),cp_failure_level,routineP,error,failure) 00563 CPPrecondition(ddapc_restraint_control%ref_count>0,cp_failure_level,routineP,error,failure) 00564 ddapc_restraint_control%ref_count=ddapc_restraint_control%ref_count-1 00565 IF (ddapc_restraint_control%ref_count==0) THEN 00566 IF (ASSOCIATED(ddapc_restraint_control%atoms)) & 00567 DEALLOCATE(ddapc_restraint_control%atoms) 00568 IF (ASSOCIATED(ddapc_restraint_control%coeff)) & 00569 DEALLOCATE(ddapc_restraint_control%coeff) 00570 ddapc_restraint_control%ref_count=0 00571 ddapc_restraint_control%strength=0.0_dp 00572 ddapc_restraint_control%target=0.0_dp 00573 ddapc_restraint_control%natoms=0 00574 DEALLOCATE(ddapc_restraint_control) 00575 ENDIF 00576 END SUBROUTINE ddapc_control_release 00577 00578 ! ***************************************************************************** 00583 SUBROUTINE ddapc_control_retain(ddapc_restraint_control,error) 00584 TYPE(ddapc_restraint_type), POINTER :: ddapc_restraint_control 00585 TYPE(cp_error_type), INTENT(inout) :: error 00586 00587 CHARACTER(len=*), PARAMETER :: routineN = 'ddapc_control_retain', 00588 routineP = moduleN//':'//routineN 00589 00590 LOGICAL :: failure 00591 00592 failure=.FALSE. 00593 CPPrecondition(ASSOCIATED(ddapc_restraint_control),cp_failure_level,routineP,error,failure) 00594 00595 ddapc_restraint_control%ref_count=ddapc_restraint_control%ref_count+1 00596 END SUBROUTINE ddapc_control_retain 00597 00598 ! ***************************************************************************** 00603 SUBROUTINE becke_control_create(becke_control,error) 00604 TYPE(becke_restraint_type), POINTER :: becke_control 00605 TYPE(cp_error_type), INTENT(inout) :: error 00606 00607 CHARACTER(len=*), PARAMETER :: routineN = 'becke_control_create', 00608 routineP = moduleN//':'//routineN 00609 00610 INTEGER :: stat 00611 LOGICAL :: failure 00612 00613 failure=.FALSE. 00614 00615 CPPrecondition(.NOT.ASSOCIATED(becke_control),cp_failure_level,routineP,error,failure) 00616 ALLOCATE(becke_control,stat=stat) 00617 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00618 00619 00620 becke_control%ref_count=1 00621 becke_control%density_type=do_full_density 00622 becke_control%strength=0.1_dp 00623 becke_control%becke_order_p=0.0_dp 00624 becke_control%functional_form=-1 00625 becke_control%target=1.0_dp 00626 becke_control%natoms=0 00627 becke_control%need_pot=.TRUE. 00628 NULLIFY(becke_control%atoms) 00629 NULLIFY(becke_control%coeff) 00630 END SUBROUTINE becke_control_create 00631 00632 ! ***************************************************************************** 00637 SUBROUTINE becke_control_release(becke_control,error) 00638 TYPE(becke_restraint_type), POINTER :: becke_control 00639 TYPE(cp_error_type), INTENT(inout) :: error 00640 00641 CHARACTER(len=*), PARAMETER :: routineN = 'becke_control_release', 00642 routineP = moduleN//':'//routineN 00643 00644 LOGICAL :: failure 00645 00646 failure=.FALSE. 00647 CPPrecondition(ASSOCIATED(becke_control),cp_failure_level,routineP,error,failure) 00648 CPPrecondition(becke_control%ref_count>0,cp_failure_level,routineP,error,failure) 00649 becke_control%ref_count=becke_control%ref_count-1 00650 IF (becke_control%ref_count==0) THEN 00651 IF (ASSOCIATED(becke_control%atoms)) & 00652 DEALLOCATE(becke_control%atoms) 00653 IF (ASSOCIATED(becke_control%coeff)) & 00654 DEALLOCATE(becke_control%coeff) 00655 becke_control%ref_count=0 00656 becke_control%strength=0.0_dp 00657 becke_control%target=0.0_dp 00658 becke_control%natoms=0 00659 DEALLOCATE(becke_control) 00660 ENDIF 00661 END SUBROUTINE becke_control_release 00662 00663 ! ***************************************************************************** 00668 SUBROUTINE becke_control_retain(becke_control,error) 00669 TYPE(becke_restraint_type), POINTER :: becke_control 00670 TYPE(cp_error_type), INTENT(inout) :: error 00671 00672 CHARACTER(len=*), PARAMETER :: routineN = 'becke_control_retain', 00673 routineP = moduleN//':'//routineN 00674 00675 LOGICAL :: failure 00676 00677 failure=.FALSE. 00678 CPPrecondition(ASSOCIATED(becke_control),cp_failure_level,routineP,error,failure) 00679 becke_control%ref_count=becke_control%ref_count+1 00680 END SUBROUTINE becke_control_retain 00681 00682 ! ***************************************************************************** 00687 SUBROUTINE s2_control_create(s2_restraint_control,error) 00688 TYPE(s2_restraint_type), POINTER :: s2_restraint_control 00689 TYPE(cp_error_type), INTENT(inout) :: error 00690 00691 CHARACTER(len=*), PARAMETER :: routineN = 's2_control_create', 00692 routineP = moduleN//':'//routineN 00693 00694 INTEGER :: stat 00695 LOGICAL :: failure 00696 00697 failure=.FALSE. 00698 00699 CPPrecondition(.NOT.ASSOCIATED(s2_restraint_control),cp_failure_level,routineP,error,failure) 00700 ALLOCATE(s2_restraint_control,stat=stat) 00701 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00702 00703 s2_restraint_control%ref_count=1 00704 s2_restraint_control%strength=0.1_dp 00705 s2_restraint_control%s2_order_p=0.0_dp 00706 s2_restraint_control%functional_form=-1 00707 s2_restraint_control%target=1.0_dp 00708 END SUBROUTINE s2_control_create 00709 00710 ! ***************************************************************************** 00715 SUBROUTINE s2_control_release(s2_restraint_control,error) 00716 TYPE(s2_restraint_type), POINTER :: s2_restraint_control 00717 TYPE(cp_error_type), INTENT(inout) :: error 00718 00719 CHARACTER(len=*), PARAMETER :: routineN = 's2_control_release', 00720 routineP = moduleN//':'//routineN 00721 00722 LOGICAL :: failure 00723 00724 failure=.FALSE. 00725 CPPrecondition(ASSOCIATED(s2_restraint_control),cp_failure_level,routineP,error,failure) 00726 CPPrecondition(s2_restraint_control%ref_count>0,cp_failure_level,routineP,error,failure) 00727 s2_restraint_control%ref_count=s2_restraint_control%ref_count-1 00728 IF (s2_restraint_control%ref_count==0) THEN 00729 s2_restraint_control%ref_count=0 00730 s2_restraint_control%strength=0.0_dp 00731 s2_restraint_control%target=0.0_dp 00732 DEALLOCATE(s2_restraint_control) 00733 ENDIF 00734 END SUBROUTINE s2_control_release 00735 00736 ! ***************************************************************************** 00741 SUBROUTINE s2_control_retain(s2_restraint_control,error) 00742 TYPE(s2_restraint_type), POINTER :: s2_restraint_control 00743 TYPE(cp_error_type), INTENT(inout) :: error 00744 00745 CHARACTER(len=*), PARAMETER :: routineN = 's2_control_retain', 00746 routineP = moduleN//':'//routineN 00747 00748 LOGICAL :: failure 00749 00750 failure=.FALSE. 00751 CPPrecondition(ASSOCIATED(s2_restraint_control),cp_failure_level,routineP,error,failure) 00752 s2_restraint_control%ref_count=s2_restraint_control%ref_count+1 00753 END SUBROUTINE s2_control_retain 00754 00755 ! ***************************************************************************** 00764 SUBROUTINE dft_control_create(dft_control, error) 00765 TYPE(dft_control_type), POINTER :: dft_control 00766 TYPE(cp_error_type), INTENT(inout) :: error 00767 00768 CHARACTER(len=*), PARAMETER :: routineN = 'dft_control_create', 00769 routineP = moduleN//':'//routineN 00770 00771 INTEGER :: stat 00772 LOGICAL :: failure 00773 00774 failure=.FALSE. 00775 00776 CPPrecondition(.NOT.ASSOCIATED(dft_control),cp_failure_level,routineP,error,failure) 00777 IF (.NOT. failure) THEN 00778 ALLOCATE (dft_control,STAT=stat) 00779 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00780 END IF 00781 IF (.NOT.failure) THEN 00782 dft_control%ref_count=1 00783 last_dft_control_id=last_dft_control_id+1 00784 dft_control%id_nr=last_dft_control_id 00785 NULLIFY(dft_control%xas_control) 00786 NULLIFY(dft_control%scp_control) 00787 NULLIFY(dft_control%qs_control) 00788 NULLIFY(dft_control%tddfpt_control) 00789 NULLIFY(dft_control%efield_fields) 00790 NULLIFY(dft_control%period_efield) 00791 NULLIFY(dft_control%admm_control) 00792 NULLIFY(dft_control%rtp_control) 00793 CALL qs_control_create(dft_control%qs_control, error=error) 00794 END IF 00795 END SUBROUTINE dft_control_create 00796 00797 ! ***************************************************************************** 00802 SUBROUTINE dft_control_retain(dft_control,error) 00803 TYPE(dft_control_type), POINTER :: dft_control 00804 TYPE(cp_error_type), INTENT(inout) :: error 00805 00806 CHARACTER(len=*), PARAMETER :: routineN = 'dft_control_retain', 00807 routineP = moduleN//':'//routineN 00808 00809 LOGICAL :: failure 00810 00811 failure=.FALSE. 00812 CPPrecondition(ASSOCIATED(dft_control),cp_failure_level,routineP,error,failure) 00813 IF (.NOT. failure) THEN 00814 CPPreconditionNoFail(dft_control%ref_count>0,cp_failure_level,routineP,error) 00815 dft_control%ref_count=dft_control%ref_count+1 00816 END IF 00817 END SUBROUTINE dft_control_retain 00818 00819 ! ***************************************************************************** 00824 SUBROUTINE dft_control_release(dft_control,error) 00825 TYPE(dft_control_type), POINTER :: dft_control 00826 TYPE(cp_error_type), INTENT(inout) :: error 00827 00828 CHARACTER(len=*), PARAMETER :: routineN = 'dft_control_release', 00829 routineP = moduleN//':'//routineN 00830 00831 INTEGER :: stat 00832 LOGICAL :: failure 00833 00834 failure=.FALSE. 00835 IF (ASSOCIATED(dft_control)) THEN 00836 CPPreconditionNoFail(dft_control%ref_count>0,cp_failure_level,routineP,error) 00837 dft_control%ref_count=dft_control%ref_count-1 00838 IF (dft_control%ref_count==0) THEN 00839 CALL qs_control_release(dft_control%qs_control, error=error) 00840 CALL tddfpt_control_release(dft_control%tddfpt_control, error=error) 00841 CALL xas_control_release(dft_control%xas_control, error=error) 00842 CALL scp_control_release(dft_control%scp_control, error=error) 00843 CALL admm_control_release(dft_control%admm_control, error=error) 00844 CALL efield_fields_release(dft_control%efield_fields, error=error) 00845 IF (ASSOCIATED(dft_control%period_efield))THEN 00846 DEALLOCATE(dft_control%period_efield%polarisation,stat=stat) 00847 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00848 DEALLOCATE(dft_control%period_efield,stat=stat) 00849 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00850 END IF 00851 IF (ASSOCIATED(dft_control%rtp_control)) THEN 00852 DEALLOCATE(dft_control%rtp_control,stat=stat) 00853 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00854 ENDIF 00855 DEALLOCATE(dft_control, stat=stat) 00856 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00857 END IF 00858 END IF 00859 END SUBROUTINE dft_control_release 00860 00861 ! ***************************************************************************** 00862 SUBROUTINE gapw_control_create(gapw_control, error) 00863 TYPE(gapw_control_type), POINTER :: gapw_control 00864 TYPE(cp_error_type), INTENT(inout) :: error 00865 00866 CHARACTER(len=*), PARAMETER :: routineN = 'gapw_control_create', 00867 routineP = moduleN//':'//routineN 00868 00869 INTEGER :: stat 00870 LOGICAL :: failure 00871 00872 failure=.FALSE. 00873 CPPrecondition(.NOT.ASSOCIATED(gapw_control),cp_failure_level,routineP,error,failure) 00874 IF (.NOT. failure) THEN 00875 ALLOCATE (gapw_control,STAT=stat) 00876 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00877 END IF 00878 END SUBROUTINE gapw_control_create 00879 ! ***************************************************************************** 00880 SUBROUTINE lripaw_control_create(lripaw_control, error) 00881 TYPE(lripaw_control_type), POINTER :: lripaw_control 00882 TYPE(cp_error_type), INTENT(inout) :: error 00883 00884 CHARACTER(len=*), PARAMETER :: routineN = 'lripaw_control_create', 00885 routineP = moduleN//':'//routineN 00886 00887 INTEGER :: stat 00888 LOGICAL :: failure 00889 00890 failure=.FALSE. 00891 CPPrecondition(.NOT.ASSOCIATED(lripaw_control),cp_failure_level,routineP,error,failure) 00892 IF (.NOT. failure) THEN 00893 ALLOCATE (lripaw_control,STAT=stat) 00894 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00895 END IF 00896 END SUBROUTINE lripaw_control_create 00897 00898 ! ***************************************************************************** 00899 SUBROUTINE qs_control_create(qs_control, error) 00900 TYPE(qs_control_type), POINTER :: qs_control 00901 TYPE(cp_error_type), INTENT(inout) :: error 00902 00903 CHARACTER(len=*), PARAMETER :: routineN = 'qs_control_create', 00904 routineP = moduleN//':'//routineN 00905 00906 INTEGER :: stat 00907 LOGICAL :: failure 00908 00909 failure = .FALSE. 00910 CPPrecondition(.NOT.ASSOCIATED(qs_control),cp_failure_level,routineP,error,failure) 00911 IF (.NOT. failure) THEN 00912 ALLOCATE (qs_control,STAT=stat) 00913 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00914 00915 NULLIFY(qs_control%e_cutoff) 00916 NULLIFY(qs_control%gapw_control) 00917 NULLIFY(qs_control%lripaw_control) 00918 NULLIFY(qs_control%mulliken_restraint_control) 00919 NULLIFY(qs_control%ddapc_restraint_control) 00920 NULLIFY(qs_control%s2_restraint_control) 00921 NULLIFY(qs_control%se_control) 00922 NULLIFY(qs_control%dftb_control) 00923 NULLIFY(qs_control%scptb_control) 00924 NULLIFY(qs_control%becke_control) 00925 NULLIFY(qs_control%ddapc_restraint_control) 00926 00927 CALL mulliken_control_create(qs_control%mulliken_restraint_control,error=error) 00928 CALL becke_control_create(qs_control%becke_control,error=error) 00929 CALL s2_control_create(qs_control%s2_restraint_control,error=error) 00930 CALL gapw_control_create(qs_control%gapw_control, error=error) 00931 CALL lripaw_control_create(qs_control%lripaw_control, error=error) 00932 CALL se_control_create(qs_control%se_control,error=error) 00933 CALL dftb_control_create(qs_control%dftb_control,error=error) 00934 CALL scptb_control_create(qs_control%scptb_control,error=error) 00935 END IF 00936 END SUBROUTINE qs_control_create 00937 00938 ! ***************************************************************************** 00939 SUBROUTINE qs_control_release(qs_control, error) 00940 TYPE(qs_control_type), POINTER :: qs_control 00941 TYPE(cp_error_type), INTENT(inout) :: error 00942 00943 CHARACTER(len=*), PARAMETER :: routineN = 'qs_control_release', 00944 routineP = moduleN//':'//routineN 00945 00946 INTEGER :: i, stat 00947 LOGICAL :: failure 00948 00949 failure = .FALSE. 00950 IF (ASSOCIATED(qs_control)) THEN 00951 CALL mulliken_control_release(qs_control%mulliken_restraint_control,error=error) 00952 CALL s2_control_release(qs_control%s2_restraint_control,error=error) 00953 CALL se_control_release(qs_control%se_control,error=error) 00954 CALL dftb_control_release(qs_control%dftb_control,error=error) 00955 CALL scptb_control_release(qs_control%scptb_control,error=error) 00956 CALL becke_control_release(qs_control%becke_control,error=error) 00957 00958 IF (ASSOCIATED(qs_control%e_cutoff)) THEN 00959 DEALLOCATE(qs_control%e_cutoff,stat=stat) 00960 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00961 END IF 00962 IF (ASSOCIATED(qs_control%gapw_control))THEN 00963 DEALLOCATE(qs_control%gapw_control,stat=stat) 00964 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00965 END IF 00966 IF (ASSOCIATED(qs_control%lripaw_control))THEN 00967 DEALLOCATE(qs_control%lripaw_control,stat=stat) 00968 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00969 END IF 00970 IF(ASSOCIATED(qs_control%ddapc_restraint_control))THEN 00971 DO i = 1 , SIZE(qs_control%ddapc_restraint_control) 00972 CALL ddapc_control_release(qs_control%ddapc_restraint_control(i)%ddapc_restraint_control,& 00973 error=error) 00974 END DO 00975 DEALLOCATE(qs_control%ddapc_restraint_control) 00976 END IF 00977 DEALLOCATE(qs_control,stat=stat) 00978 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00979 END IF 00980 END SUBROUTINE qs_control_release 00981 00982 ! ***************************************************************************** 00983 SUBROUTINE tddfpt_control_create(tddfpt_control, error) 00984 TYPE(tddfpt_control_type), POINTER :: tddfpt_control 00985 TYPE(cp_error_type), INTENT(inout) :: error 00986 00987 CHARACTER(len=*), PARAMETER :: routineN = 'tddfpt_control_create', 00988 routineP = moduleN//':'//routineN 00989 00990 INTEGER :: stat 00991 LOGICAL :: failure 00992 00993 failure = .FALSE. 00994 CPPrecondition(.NOT.ASSOCIATED(tddfpt_control),cp_failure_level,routineP,error,failure) 00995 IF (.NOT. failure) THEN 00996 ALLOCATE (tddfpt_control,STAT=stat) 00997 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00998 NULLIFY(tddfpt_control%lumos) 00999 NULLIFY(tddfpt_control%lumos_eigenvalues) 01000 END IF 01001 01002 END SUBROUTINE tddfpt_control_create 01003 01004 ! ***************************************************************************** 01005 SUBROUTINE tddfpt_control_release(tddfpt_control, error) 01006 TYPE(tddfpt_control_type), POINTER :: tddfpt_control 01007 TYPE(cp_error_type), INTENT(inout) :: error 01008 01009 CHARACTER(len=*), PARAMETER :: routineN = 'tddfpt_control_release', 01010 routineP = moduleN//':'//routineN 01011 01012 INTEGER :: ispin, stat 01013 LOGICAL :: dummy, failure 01014 01015 failure = .FALSE. 01016 IF (ASSOCIATED(tddfpt_control)) THEN 01017 IF (ASSOCIATED(tddfpt_control%lumos)) THEN 01018 DO ispin=1, SIZE(tddfpt_control%lumos) 01019 CALL cp_fm_release(tddfpt_control%lumos(ispin)%matrix,error=error) 01020 !MK the following line just avoids a crash of TDDFT runs using 01021 !MK the sdbg version compiled with the NAG compiler when 01022 !MK tddfpt_control%lumos is deallocated. This is most likely a 01023 !MK compiler bug and thus the line might become obsolete 01024 dummy = ASSOCIATED(tddfpt_control%lumos(ispin)%matrix) 01025 END DO 01026 DEALLOCATE(tddfpt_control%lumos,stat=stat) 01027 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01028 END IF 01029 IF (ASSOCIATED(tddfpt_control%lumos_eigenvalues)) THEN 01030 DEALLOCATE(tddfpt_control%lumos_eigenvalues,stat=stat) 01031 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01032 END IF 01033 DEALLOCATE(tddfpt_control,stat=stat) 01034 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01035 END IF 01036 END SUBROUTINE tddfpt_control_release 01037 01038 01039 ! ***************************************************************************** 01040 SUBROUTINE efield_fields_release(efield_fields, error) 01041 TYPE(efield_p_type), DIMENSION(:), 01042 POINTER :: efield_fields 01043 TYPE(cp_error_type), INTENT(inout) :: error 01044 01045 CHARACTER(len=*), PARAMETER :: routineN = 'efield_fields_release', 01046 routineP = moduleN//':'//routineN 01047 01048 INTEGER :: i, stat 01049 LOGICAL :: failure 01050 01051 failure = .FALSE. 01052 IF (ASSOCIATED(efield_fields)) THEN 01053 DO i=1,SIZE(efield_fields) 01054 IF(ASSOCIATED(efield_fields(i)%efield))THEN 01055 IF(ASSOCIATED(efield_fields(i)%efield%envelop_r_vars))THEN 01056 DEALLOCATE(efield_fields(i)%efield%envelop_r_vars,stat=stat) 01057 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01058 END IF 01059 IF(ASSOCIATED(efield_fields(i)%efield%envelop_i_vars))THEN 01060 DEALLOCATE(efield_fields(i)%efield%envelop_i_vars,stat=stat) 01061 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01062 END IF 01063 IF(ASSOCIATED(efield_fields(i)%efield%polarisation))THEN 01064 DEALLOCATE(efield_fields(i)%efield%polarisation,stat=stat) 01065 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01066 END IF 01067 DEALLOCATE(efield_fields(i)%efield,stat=stat) 01068 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01069 END IF 01070 END DO 01071 DEALLOCATE(efield_fields,stat=stat) 01072 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01073 END IF 01074 END SUBROUTINE efield_fields_release 01075 01076 ! ***************************************************************************** 01077 SUBROUTINE scp_control_create(scp_control,error) 01078 TYPE(scp_control_type), POINTER :: scp_control 01079 TYPE(cp_error_type), INTENT(inout) :: error 01080 01081 CHARACTER(len=*), PARAMETER :: routineN = 'scp_control_create', 01082 routineP = moduleN//':'//routineN 01083 01084 INTEGER :: stat 01085 LOGICAL :: failure 01086 01087 failure=.FALSE. 01088 01089 CPPrecondition(.NOT.ASSOCIATED(scp_control),cp_failure_level,routineP,error,failure) 01090 ALLOCATE(scp_control,stat=stat) 01091 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01092 01093 END SUBROUTINE scp_control_create 01094 01095 ! ***************************************************************************** 01096 SUBROUTINE scp_control_release(scp_control,error) 01097 TYPE(scp_control_type), POINTER :: scp_control 01098 TYPE(cp_error_type), INTENT(inout) :: error 01099 01100 CHARACTER(len=*), PARAMETER :: routineN = 'scp_control_release', 01101 routineP = moduleN//':'//routineN 01102 01103 INTEGER :: stat 01104 LOGICAL :: failure 01105 01106 failure=.FALSE. 01107 01108 IF (ASSOCIATED(scp_control)) THEN 01109 DEALLOCATE(scp_control,stat=stat) 01110 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 01111 END IF 01112 END SUBROUTINE scp_control_release 01113 01114 ! ***************************************************************************** 01115 SUBROUTINE dftb_control_create(dftb_control,error) 01116 TYPE(dftb_control_type), POINTER :: dftb_control 01117 TYPE(cp_error_type), INTENT(inout) :: error 01118 01119 CHARACTER(len=*), PARAMETER :: routineN = 'dftb_control_create', 01120 routineP = moduleN//':'//routineN 01121 01122 INTEGER :: stat 01123 LOGICAL :: failure 01124 01125 failure=.FALSE. 01126 01127 CPPrecondition(.NOT.ASSOCIATED(dftb_control),cp_failure_level,routineP,error,failure) 01128 ALLOCATE(dftb_control,stat=stat) 01129 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01130 01131 NULLIFY(dftb_control%sk_pair_list) 01132 END SUBROUTINE dftb_control_create 01133 01134 ! ***************************************************************************** 01135 SUBROUTINE dftb_control_release(dftb_control,error) 01136 TYPE(dftb_control_type), POINTER :: dftb_control 01137 TYPE(cp_error_type), INTENT(inout) :: error 01138 01139 CHARACTER(len=*), PARAMETER :: routineN = 'dftb_control_release', 01140 routineP = moduleN//':'//routineN 01141 01142 INTEGER :: stat 01143 LOGICAL :: failure 01144 01145 failure=.FALSE. 01146 01147 IF (ASSOCIATED(dftb_control)) THEN 01148 IF (ASSOCIATED(dftb_control%sk_pair_list)) THEN 01149 DEALLOCATE(dftb_control%sk_pair_list,stat=stat) 01150 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 01151 END IF 01152 DEALLOCATE(dftb_control,stat=stat) 01153 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 01154 END IF 01155 END SUBROUTINE dftb_control_release 01156 01157 ! ***************************************************************************** 01158 SUBROUTINE scptb_control_create(scptb_control,error) 01159 TYPE(scptb_control_type), POINTER :: scptb_control 01160 TYPE(cp_error_type), INTENT(inout) :: error 01161 01162 CHARACTER(len=*), PARAMETER :: routineN = 'scptb_control_create', 01163 routineP = moduleN//':'//routineN 01164 01165 INTEGER :: stat 01166 LOGICAL :: failure 01167 01168 failure=.FALSE. 01169 01170 CPPrecondition(.NOT.ASSOCIATED(scptb_control),cp_failure_level,routineP,error,failure) 01171 ALLOCATE(scptb_control,stat=stat) 01172 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01173 01174 END SUBROUTINE scptb_control_create 01175 01176 ! ***************************************************************************** 01177 SUBROUTINE scptb_control_release(scptb_control,error) 01178 TYPE(scptb_control_type), POINTER :: scptb_control 01179 TYPE(cp_error_type), INTENT(inout) :: error 01180 01181 CHARACTER(len=*), PARAMETER :: routineN = 'scptb_control_release', 01182 routineP = moduleN//':'//routineN 01183 01184 INTEGER :: stat 01185 LOGICAL :: failure 01186 01187 failure=.FALSE. 01188 01189 IF (ASSOCIATED(scptb_control)) THEN 01190 DEALLOCATE(scptb_control,stat=stat) 01191 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 01192 END IF 01193 END SUBROUTINE scptb_control_release 01194 01195 ! ***************************************************************************** 01196 SUBROUTINE se_control_create(se_control,error) 01197 TYPE(semi_empirical_control_type), 01198 POINTER :: se_control 01199 TYPE(cp_error_type), INTENT(inout) :: error 01200 01201 CHARACTER(len=*), PARAMETER :: routineN = 'se_control_create', 01202 routineP = moduleN//':'//routineN 01203 01204 INTEGER :: stat 01205 LOGICAL :: failure 01206 01207 failure=.FALSE. 01208 01209 CPPrecondition(.NOT.ASSOCIATED(se_control),cp_failure_level,routineP,error,failure) 01210 ALLOCATE(se_control,stat=stat) 01211 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01212 se_control%scp = .FALSE. ! Flag is needed even in non-semiempirical methods 01213 END SUBROUTINE se_control_create 01214 01215 ! ***************************************************************************** 01216 SUBROUTINE se_control_release(se_control,error) 01217 TYPE(semi_empirical_control_type), 01218 POINTER :: se_control 01219 TYPE(cp_error_type), INTENT(inout) :: error 01220 01221 CHARACTER(len=*), PARAMETER :: routineN = 'se_control_release', 01222 routineP = moduleN//':'//routineN 01223 01224 INTEGER :: stat 01225 LOGICAL :: failure 01226 01227 failure=.FALSE. 01228 01229 IF (ASSOCIATED(se_control)) THEN 01230 DEALLOCATE(se_control,stat=stat) 01231 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 01232 END IF 01233 END SUBROUTINE se_control_release 01234 01235 ! ***************************************************************************** 01236 SUBROUTINE admm_control_create(admm_control,error) 01237 TYPE(admm_control_type), POINTER :: admm_control 01238 TYPE(cp_error_type), INTENT(inout) :: error 01239 01240 CHARACTER(len=*), PARAMETER :: routineN = 'admm_control_create', 01241 routineP = moduleN//':'//routineN 01242 01243 INTEGER :: stat 01244 LOGICAL :: failure 01245 01246 failure=.FALSE. 01247 01248 CPPrecondition(.NOT.ASSOCIATED(admm_control),cp_failure_level,routineP,error,failure) 01249 ALLOCATE(admm_control,stat=stat) 01250 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01251 01252 END SUBROUTINE admm_control_create 01253 01254 ! ***************************************************************************** 01255 SUBROUTINE admm_control_release(admm_control,error) 01256 TYPE(admm_control_type), POINTER :: admm_control 01257 TYPE(cp_error_type), INTENT(inout) :: error 01258 01259 CHARACTER(len=*), PARAMETER :: routineN = 'admm_control_release', 01260 routineP = moduleN//':'//routineN 01261 01262 INTEGER :: stat 01263 LOGICAL :: failure 01264 01265 failure=.FALSE. 01266 01267 IF (ASSOCIATED(admm_control)) THEN 01268 DEALLOCATE(admm_control,stat=stat) 01269 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 01270 END IF 01271 END SUBROUTINE admm_control_release 01272 01273 END MODULE cp_control_types 01274
1.7.3