|
CP2K 2.4 (Revision 12889)
|
00001 !-----------------------------------------------------------------------------! 00002 ! CP2K: A general program to perform molecular dynamics simulations ! 00003 ! Copyright (C) 2000 - 2013 CP2K developers group ! 00004 !-----------------------------------------------------------------------------! 00005 00006 ! ***************************************************************************** 00012 MODULE pair_potential_types 00013 00014 USE f77_blas 00015 USE kinds, ONLY: default_path_length,& 00016 default_string_length,& 00017 dp 00018 USE memory_utilities, ONLY: reallocate 00019 USE splines_types, ONLY: spline_data_p_copy,& 00020 spline_data_p_release,& 00021 spline_data_p_type,& 00022 spline_factor_copy,& 00023 spline_factor_release,& 00024 spline_factor_type 00025 #include "cp_common_uses.h" 00026 00027 IMPLICIT NONE 00028 00029 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'pair_potential_types' 00030 00031 PRIVATE 00032 ! when adding a new nonbonedd potential please update also the list_pot 00033 ! used for the linear scaling screening of potential calculation 00034 INTEGER, PUBLIC, PARAMETER :: multi_type=-1, 00035 nn_type= 0, 00036 lj_type= 1, 00037 lj_charmm_type= 2, 00038 ft_type= 3, 00039 wl_type= 4, 00040 gw_type= 5, 00041 ip_type= 6, 00042 ea_type= 7, 00043 b4_type= 8, 00044 bm_type= 9, 00045 gp_type=10, 00046 tersoff_type=11, 00047 ftd_type=12, 00048 siepmann_type=13 00049 00050 INTEGER, PUBLIC, PARAMETER, DIMENSION(14) :: list_pot = (/nn_type, 00051 lj_type, 00052 lj_charmm_type, 00053 ft_type, 00054 wl_type, 00055 gw_type, 00056 ip_type, 00057 ea_type, 00058 b4_type, 00059 bm_type, 00060 gp_type, 00061 tersoff_type, 00062 ftd_type, 00063 siepmann_type /) 00064 ! Shell model 00065 INTEGER, PUBLIC, PARAMETER :: nosh_nosh=0, 00066 nosh_sh=1, 00067 sh_sh=2 00068 00069 INTEGER, PUBLIC, PARAMETER, DIMENSION(3) :: list_sh_type =(/nosh_nosh,nosh_sh,sh_sh/) 00070 00071 ! Single Spline generation info 00072 REAL(KIND=dp), PARAMETER, PUBLIC :: not_initialized=-HUGE(0.0_dp) 00073 INTEGER, PARAMETER, DIMENSION(2), PUBLIC :: do_potential_single_allocation=(/lj_type,lj_charmm_type/) 00074 INTEGER, PARAMETER, DIMENSION(2), PUBLIC :: no_potential_single_allocation=(/-HUGE(0),-HUGE(0)/) 00075 INTEGER, DIMENSION(2), PUBLIC :: potential_single_allocation 00076 00077 PUBLIC :: pair_potential_type,& 00078 pair_potential_reallocate 00079 00080 PUBLIC :: pair_potential_single_release,& 00081 pair_potential_single_create,& 00082 pair_potential_single_copy,& 00083 pair_potential_single_add,& 00084 pair_potential_single_clean,& 00085 pair_potential_single_type 00086 00087 PUBLIC :: pair_potential_pp_create,& 00088 pair_potential_pp_release,& 00089 pair_potential_pp_type 00090 00091 PUBLIC :: pair_potential_p_type,& 00092 pair_potential_p_release 00093 00094 PUBLIC :: lj_pot_type,& 00095 ft_pot_type,& 00096 williams_pot_type,& 00097 goodwin_pot_type,& 00098 ipbv_pot_type,& 00099 eam_pot_type,& 00100 buck4ran_pot_type,& 00101 buckmorse_pot_type,& 00102 gp_pot_type,& 00103 tersoff_pot_type,& 00104 siepmann_pot_type,& 00105 ftd_pot_type,& 00106 pot_set_type 00107 00108 PUBLIC :: pair_potential_lj_create 00109 PUBLIC :: compare_pot 00110 00111 ! ***************************************************************************** 00112 TYPE ipbv_pot_type 00113 REAL (KIND=dp), DIMENSION (2:15) :: a 00114 REAL (KIND=dp) :: rcore 00115 REAL (KIND=dp) :: m 00116 REAL (KIND=dp) :: b 00117 END TYPE ipbv_pot_type 00118 00119 ! ***************************************************************************** 00120 TYPE lj_pot_type 00121 REAL (KIND=dp) :: epsilon 00122 REAL (KIND=dp) :: sigma6 00123 REAL (KIND=dp) :: sigma12 00124 END TYPE Lj_pot_type 00125 00126 ! ***************************************************************************** 00127 TYPE ft_pot_type 00128 REAL (KIND=dp) :: A 00129 REAL (KIND=dp) :: B 00130 REAL (KIND=dp) :: C 00131 REAL (KIND=dp) :: D 00132 END TYPE ft_pot_type 00133 00134 ! ***************************************************************************** 00135 TYPE ftd_pot_type 00136 REAL (KIND=dp) :: A 00137 REAL (KIND=dp) :: B 00138 REAL (KIND=dp) :: C 00139 REAL (KIND=dp) :: D 00140 REAL (KIND=dp) :: BD 00141 END TYPE ftd_pot_type 00142 00143 ! ***************************************************************************** 00144 TYPE williams_pot_type 00145 REAL (KIND=dp) :: a 00146 REAL (KIND=dp) :: b 00147 REAL (KIND=dp) :: c 00148 END TYPE williams_pot_type 00149 00150 ! ***************************************************************************** 00151 TYPE goodwin_pot_type 00152 REAL (KIND=dp) :: vr0 00153 REAL (KIND=dp) :: m, mc 00154 REAL (KIND=dp) :: d, dc 00155 END TYPE goodwin_pot_type 00156 00157 ! ***************************************************************************** 00158 TYPE eam_pot_type 00159 CHARACTER (LEN=default_path_length) :: eam_file_name 00160 INTEGER :: npoints 00161 REAL (KIND=dp) :: drar, drhoar, acutal 00162 REAL (KIND=dp),POINTER, DIMENSION(:) :: rho, phi, frho, rhoval, rval 00163 REAL (KIND=dp),POINTER, DIMENSION(:) :: rhop, phip, frhop 00164 END TYPE eam_pot_type 00165 00166 ! ***************************************************************************** 00167 TYPE buck4ran_pot_type 00168 REAL (KIND=dp) :: a 00169 REAL (KIND=dp) :: b 00170 REAL (KIND=dp) :: c 00171 REAL (KIND=dp) :: r1 00172 REAL (KIND=dp) :: r2 00173 REAL (KIND=dp) :: r3 00174 INTEGER :: npoly1, npoly2 00175 REAL (KIND=dp), DIMENSION(0:10) :: poly1 00176 REAL (KIND=dp), DIMENSION(0:10) :: poly2 00177 END TYPE buck4ran_pot_type 00178 00179 ! ***************************************************************************** 00180 TYPE buckmorse_pot_type 00181 REAL (KIND=dp) :: f0 00182 REAL (KIND=dp) :: a1 00183 REAL (KIND=dp) :: a2 00184 REAL (KIND=dp) :: b1 00185 REAL (KIND=dp) :: b2 00186 REAL (KIND=dp) :: c 00187 REAL (KIND=dp) :: d 00188 REAL (KIND=dp) :: r0 00189 REAL (KIND=dp) :: beta 00190 END TYPE buckmorse_pot_type 00191 00192 ! ***************************************************************************** 00193 TYPE gp_pot_type 00194 INTEGER :: myid 00195 CHARACTER (LEN=default_path_length) :: potential 00196 CHARACTER (LEN=default_string_length), 00197 POINTER, DIMENSION(:) :: parameters, units 00198 CHARACTER (LEN=default_string_length) :: variables 00199 REAL(KIND=dp), DIMENSION(:), POINTER :: values 00200 END TYPE gp_pot_type 00201 00202 ! ***************************************************************************** 00203 TYPE tersoff_pot_type 00204 ! Get this stuff from the PRB V38, N14 9902 (1988) by Tersoff 00205 REAL (KIND=dp) :: A 00206 REAL (KIND=dp) :: B 00207 REAL (KIND=dp) :: lambda1 00208 REAL (KIND=dp) :: lambda2 00209 REAL (KIND=dp) :: alpha 00210 REAL (KIND=dp) :: beta 00211 REAL (KIND=dp) :: n 00212 REAL (KIND=dp) :: c 00213 REAL (KIND=dp) :: d 00214 REAL (KIND=dp) :: h 00215 REAL (KIND=dp) :: lambda3 00216 REAL (KIND=dp) :: bigR ! Used to be R = Rij + D 00217 REAL (KIND=dp) :: bigD ! Used to be D = Rij - D 00218 REAL (KIND=dp) :: rcutsq ! Always set to (bigR+bigD)^2 00219 END TYPE tersoff_pot_type 00220 00221 ! ***************************************************************************** 00222 TYPE siepmann_pot_type 00223 REAL (KIND=dp) :: B 00224 REAL (KIND=dp) :: D 00225 REAL (KIND=dp) :: E 00226 REAL (KIND=dp) :: F 00227 REAL (KIND=dp) :: alpha 00228 REAL (KIND=dp) :: beta 00229 REAL (KIND=dp) :: rcutsq 00230 END TYPE siepmann_pot_type 00231 00232 ! ***************************************************************************** 00233 TYPE pot_set_type 00234 REAL ( KIND=dp ) :: rmin, rmax 00235 TYPE ( ipbv_pot_type ), POINTER :: ipbv 00236 TYPE ( gp_pot_type), POINTER :: gp 00237 TYPE ( lj_pot_type ), POINTER :: lj 00238 TYPE ( ft_pot_type ), POINTER :: ft 00239 TYPE ( williams_pot_type ), POINTER :: willis 00240 TYPE ( goodwin_pot_type ), POINTER :: goodwin 00241 TYPE ( eam_pot_type ), POINTER :: eam 00242 TYPE ( buck4ran_pot_type ), POINTER :: buck4r 00243 TYPE ( buckmorse_pot_type ), POINTER :: buckmo 00244 TYPE ( tersoff_pot_type ), POINTER :: tersoff 00245 TYPE ( siepmann_pot_type ), POINTER :: siepmann 00246 TYPE ( ftd_pot_type ), POINTER :: ftd 00247 END TYPE pot_set_type 00248 00249 ! ***************************************************************************** 00250 TYPE pair_potential_single_type 00251 REAL (KIND=dp) :: rcutsq 00252 REAL (KIND=dp) :: e_fac 00253 REAL (KIND=dp) :: e_fcc 00254 REAL (KIND=dp) :: e_fcs 00255 REAL (KIND=dp) :: e_fsc 00256 REAL (KIND=dp) :: z1 00257 REAL (KIND=dp) :: z2 00258 REAL (KIND=dp) :: zbl_poly(0:5) 00259 REAL (KIND=dp) :: zbl_rcut(2) 00260 LOGICAL :: undef, ! non-bonding interaction not defined 00261 no_mb, ! no many-body potential 00262 no_pp ! no pair (=two-body) potential 00263 INTEGER :: shell_type 00264 CHARACTER ( LEN = default_string_length ) :: at1 00265 CHARACTER ( LEN = default_string_length ) :: at2 00266 INTEGER, POINTER, DIMENSION(:) :: TYPE 00267 TYPE (pot_set_type), POINTER, DIMENSION(:) :: set 00268 TYPE (spline_data_p_type), POINTER, DIMENSION(:) :: pair_spline_data 00269 TYPE (spline_factor_type), POINTER :: spl_f 00270 END TYPE pair_potential_single_type 00271 00272 ! ***************************************************************************** 00273 TYPE pair_potential_type 00274 TYPE(pair_potential_single_type), POINTER :: pot 00275 END TYPE pair_potential_type 00276 00277 ! ***************************************************************************** 00278 TYPE pair_potential_p_type 00279 TYPE(pair_potential_type), DIMENSION(:), POINTER :: pot 00280 END TYPE pair_potential_p_type 00281 00282 ! ***************************************************************************** 00283 TYPE pair_potential_pp_type 00284 TYPE(pair_potential_type), DIMENSION(:,:), POINTER :: pot 00285 END TYPE pair_potential_pp_type 00286 00287 CONTAINS 00288 00289 ! ***************************************************************************** 00293 SUBROUTINE compare_pot(pot1, pot2, compare, error) 00294 TYPE(pair_potential_single_type), 00295 POINTER :: pot1, pot2 00296 LOGICAL, INTENT(OUT) :: compare 00297 TYPE(cp_error_type), INTENT(inout) :: error 00298 00299 CHARACTER(len=*), PARAMETER :: routineN = 'compare_pot', 00300 routineP = moduleN//':'//routineN 00301 00302 INTEGER :: i 00303 LOGICAL :: failure, mycompare 00304 00305 failure=.FALSE. 00306 compare=.FALSE. 00307 ! Preliminary checks 00308 00309 CPPostcondition(ASSOCIATED(pot1%type),cp_failure_level,routineP,error,failure) 00310 CPPostcondition(ASSOCIATED(pot2%type),cp_failure_level,routineP,error,failure) 00311 IF (SIZE(pot1%type)/=SIZE(pot2%type)) RETURN 00312 IF (ANY(pot1%type/=pot2%type)) RETURN 00313 00314 ! Checking the real values of parameters 00315 CPPostcondition(ASSOCIATED(pot1%set),cp_failure_level,routineP,error,failure) 00316 CPPostcondition(ASSOCIATED(pot2%set),cp_failure_level,routineP,error,failure) 00317 DO i = 1, SIZE(pot1%type) 00318 mycompare = .FALSE. 00319 SELECT CASE(pot1%type(i)) 00320 CASE (lj_type,lj_charmm_type) 00321 IF ((pot1%set(i)%lj%epsilon==pot2%set(i)%lj%epsilon).AND.& 00322 (pot1%set(i)%lj%sigma6 ==pot2%set(i)%lj%sigma6 ).AND.& 00323 (pot1%set(i)%lj%sigma12==pot2%set(i)%lj%sigma12)) mycompare=.TRUE. 00324 CASE (wl_type) 00325 IF ((pot1%set(i)%willis%a==pot2%set(i)%willis%a).AND.& 00326 (pot1%set(i)%willis%b==pot2%set(i)%willis%b).AND.& 00327 (pot1%set(i)%willis%c==pot2%set(i)%willis%c)) mycompare=.TRUE. 00328 CASE (gw_type) 00329 IF ((pot1%set(i)%goodwin%vr0==pot2%set(i)%goodwin%vr0).AND.& 00330 (pot1%set(i)%goodwin%m ==pot2%set(i)%goodwin%m ).AND.& 00331 (pot1%set(i)%goodwin%mc ==pot2%set(i)%goodwin%mc ).AND.& 00332 (pot1%set(i)%goodwin%d ==pot2%set(i)%goodwin%d ).AND.& 00333 (pot1%set(i)%goodwin%dc ==pot2%set(i)%goodwin%dc )) mycompare=.TRUE. 00334 CASE (ea_type) 00335 ! Compare only if EAM have the same number of points 00336 IF (pot1%set(i)%eam%npoints==pot2%set(i)%eam%npoints) THEN 00337 IF ((pot1%set(i)%eam%drar ==pot2%set(i)%eam%drar ).AND.& 00338 (pot1%set(i)%eam%drhoar ==pot2%set(i)%eam%drhoar).AND.& 00339 (pot1%set(i)%eam%acutal ==pot2%set(i)%eam%acutal).AND.& 00340 (SUM(ABS(pot1%set(i)%eam%rho -pot2%set(i)%eam%rho ))==0.0_dp).AND.& 00341 (SUM(ABS(pot1%set(i)%eam%phi -pot2%set(i)%eam%phi ))==0.0_dp).AND.& 00342 (SUM(ABS(pot1%set(i)%eam%frho -pot2%set(i)%eam%frho ))==0.0_dp).AND.& 00343 (SUM(ABS(pot1%set(i)%eam%rhoval-pot2%set(i)%eam%rhoval))==0.0_dp).AND.& 00344 (SUM(ABS(pot1%set(i)%eam%rval -pot2%set(i)%eam%rval ))==0.0_dp).AND.& 00345 (SUM(ABS(pot1%set(i)%eam%rhop -pot2%set(i)%eam%rhop ))==0.0_dp).AND.& 00346 (SUM(ABS(pot1%set(i)%eam%phip -pot2%set(i)%eam%phip ))==0.0_dp).AND.& 00347 (SUM(ABS(pot1%set(i)%eam%frhop -pot2%set(i)%eam%frhop ))==0.0_dp)) mycompare=.TRUE. 00348 END IF 00349 CASE (ft_type) 00350 IF ((pot1%set(i)%ft%A==pot2%set(i)%ft%A).AND.& 00351 (pot1%set(i)%ft%B==pot2%set(i)%ft%B).AND.& 00352 (pot1%set(i)%ft%C==pot2%set(i)%ft%C).AND.& 00353 (pot1%set(i)%ft%D==pot2%set(i)%ft%D)) mycompare=.TRUE. 00354 CASE (ftd_type) 00355 IF ((pot1%set(i)%ftd%A==pot2%set(i)%ftd%A).AND.& 00356 (pot1%set(i)%ftd%B==pot2%set(i)%ftd%B).AND.& 00357 (pot1%set(i)%ftd%C==pot2%set(i)%ftd%C).AND.& 00358 (pot1%set(i)%ftd%D==pot2%set(i)%ftd%D).AND.& 00359 (pot1%set(i)%ftd%BD==pot2%set(i)%ftd%BD)) mycompare=.TRUE. 00360 CASE (ip_type) 00361 IF ((SUM(ABS(pot1%set(i)%ipbv%a-pot2%set(i)%ipbv%a))==0.0_dp).AND.& 00362 (pot1%set(i)%ipbv%rcore==pot2%set(i)%ipbv%rcore).AND.& 00363 (pot1%set(i)%ipbv%m ==pot2%set(i)%ipbv%m ).AND.& 00364 (pot1%set(i)%ipbv%b ==pot2%set(i)%ipbv%b )) mycompare=.TRUE. 00365 CASE (tersoff_type) 00366 IF ((pot1%set(i)%tersoff%A == pot2%set(i)%tersoff%A ).AND.& 00367 (pot1%set(i)%tersoff%B == pot2%set(i)%tersoff%B ).AND.& 00368 (pot1%set(i)%tersoff%lambda1 == pot2%set(i)%tersoff%lambda1 ).AND.& 00369 (pot1%set(i)%tersoff%lambda2 == pot2%set(i)%tersoff%lambda2 ).AND.& 00370 (pot1%set(i)%tersoff%alpha == pot2%set(i)%tersoff%alpha ).AND.& 00371 (pot1%set(i)%tersoff%beta == pot2%set(i)%tersoff%beta ).AND.& 00372 (pot1%set(i)%tersoff%n == pot2%set(i)%tersoff%n ).AND.& 00373 (pot1%set(i)%tersoff%c == pot2%set(i)%tersoff%c ).AND.& 00374 (pot1%set(i)%tersoff%d == pot2%set(i)%tersoff%d ).AND.& 00375 (pot1%set(i)%tersoff%h == pot2%set(i)%tersoff%h ).AND.& 00376 (pot1%set(i)%tersoff%lambda3 == pot2%set(i)%tersoff%lambda3 ).AND.& 00377 (pot1%set(i)%tersoff%rcutsq == pot2%set(i)%tersoff%rcutsq ).AND.& 00378 (pot1%set(i)%tersoff%bigR == pot2%set(i)%tersoff%bigR ).AND.& 00379 (pot1%set(i)%tersoff%bigD == pot2%set(i)%tersoff%bigD )) mycompare=.TRUE. 00380 CASE (siepmann_type) 00381 IF ((pot1%set(i)%siepmann%B == pot2%set(i)%siepmann%B ).AND.& 00382 (pot1%set(i)%siepmann%D == pot2%set(i)%siepmann%D ).AND.& 00383 (pot1%set(i)%siepmann%E == pot2%set(i)%siepmann%E ).AND.& 00384 (pot1%set(i)%siepmann%F == pot2%set(i)%siepmann%F ).AND.& 00385 (pot1%set(i)%siepmann%alpha == pot2%set(i)%siepmann%alpha ).AND.& 00386 (pot1%set(i)%siepmann%beta == pot2%set(i)%siepmann%beta ).AND.& 00387 (pot1%set(i)%siepmann%rcutsq == pot2%set(i)%siepmann%rcutsq )) mycompare=.TRUE. 00388 END SELECT 00389 mycompare = mycompare.AND.& 00390 (pot1%set(i)%rmin == pot2%set(i)%rmin ).AND.(pot1%set(i)%rmax == pot2%set(i)%rmax ) 00391 IF ((mycompare).AND.(i==1)) compare = .TRUE. 00392 compare = compare .AND. mycompare 00393 END DO 00394 00395 END SUBROUTINE compare_pot 00396 00397 ! ***************************************************************************** 00401 SUBROUTINE pair_potential_single_create(potparm, nset, error) 00402 TYPE(pair_potential_single_type), 00403 POINTER :: potparm 00404 INTEGER, INTENT(IN), OPTIONAL :: nset 00405 TYPE(cp_error_type), INTENT(inout) :: error 00406 00407 CHARACTER(len=*), PARAMETER :: routineN = 'pair_potential_single_create', 00408 routineP = moduleN//':'//routineN 00409 00410 INTEGER :: i, lnset, stat 00411 LOGICAL :: failure 00412 00413 failure = .FALSE. 00414 CPPostcondition(.NOT.ASSOCIATED(potparm),cp_failure_level,routineP,error,failure) 00415 IF (.NOT.failure) THEN 00416 ALLOCATE(potparm, stat=stat) 00417 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00418 lnset = 1 00419 IF (PRESENT(nset)) lnset = nset 00420 ! Standard allocation to size 1 00421 ALLOCATE(potparm%type(lnset), stat=stat) 00422 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00423 ALLOCATE(potparm%set(lnset), stat=stat) 00424 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00425 NULLIFY( potparm%spl_f,& 00426 potparm%pair_spline_data) 00427 DO i = 1, lnset 00428 potparm%set(i)%rmin = not_initialized 00429 potparm%set(i)%rmax = not_initialized 00430 NULLIFY( potparm%set(i)%ipbv,& 00431 potparm%set(i)%lj,& 00432 potparm%set(i)%gp,& 00433 potparm%set(i)%ft,& 00434 potparm%set(i)%willis,& 00435 potparm%set(i)%goodwin,& 00436 potparm%set(i)%eam,& 00437 potparm%set(i)%buck4r,& 00438 potparm%set(i)%buckmo,& 00439 potparm%set(i)%tersoff,& 00440 potparm%set(i)%siepmann,& 00441 potparm%set(i)%ftd) 00442 END DO 00443 CALL pair_potential_single_clean(potparm, error) 00444 END IF 00445 END SUBROUTINE pair_potential_single_create 00446 00447 ! ***************************************************************************** 00451 SUBROUTINE pair_potential_single_clean(potparm, error) 00452 TYPE(pair_potential_single_type), 00453 POINTER :: potparm 00454 TYPE(cp_error_type), INTENT(inout) :: error 00455 00456 CHARACTER(len=*), PARAMETER :: routineN = 'pair_potential_single_clean', 00457 routineP = moduleN//':'//routineN 00458 00459 INTEGER :: i 00460 LOGICAL :: failure 00461 00462 failure = .FALSE. 00463 potparm % type = nn_type 00464 potparm % shell_type = nosh_nosh 00465 potparm % undef = .TRUE. 00466 potparm % no_pp = .FALSE. 00467 potparm % no_mb = .FALSE. 00468 potparm % at1 = 'NULL' 00469 potparm % at2 = 'NULL' 00470 potparm % rcutsq = 0.0_dp 00471 IF (ASSOCIATED( potparm % pair_spline_data ))& 00472 CALL spline_data_p_release ( potparm % pair_spline_data ,error=error) 00473 IF (ASSOCIATED( potparm % spl_f ))& 00474 CALL spline_factor_release ( potparm % spl_f ,error=error) 00475 00476 DO i = 1, SIZE(potparm%type) 00477 potparm%set(i)%rmin = not_initialized 00478 potparm%set(i)%rmax = not_initialized 00479 CALL pair_potential_lj_clean (potparm%set(i)%lj, error=error) 00480 CALL pair_potential_williams_clean (potparm%set(i)%willis, error=error) 00481 CALL pair_potential_goodwin_clean (potparm%set(i)%goodwin, error=error) 00482 CALL pair_potential_eam_clean (potparm%set(i)%eam, error=error) 00483 CALL pair_potential_buck4r_clean (potparm%set(i)%buck4r, error=error) 00484 CALL pair_potential_buckmo_clean (potparm%set(i)%buckmo, error=error) 00485 CALL pair_potential_bmhft_clean (potparm%set(i)%ft, error=error) 00486 CALL pair_potential_bmhftd_clean (potparm%set(i)%ftd, error=error) 00487 CALL pair_potential_ipbv_clean (potparm%set(i)%ipbv, error=error) 00488 CALL pair_potential_gp_clean (potparm%set(i)%gp, error=error) 00489 CALL pair_potential_tersoff_clean (potparm%set(i)%tersoff, error=error) 00490 CALL pair_potential_siepmann_clean (potparm%set(i)%siepmann, error=error) 00491 END DO 00492 END SUBROUTINE pair_potential_single_clean 00493 00494 ! ***************************************************************************** 00498 SUBROUTINE pair_potential_single_copy(potparm_source, potparm_dest, error) 00499 TYPE(pair_potential_single_type), 00500 POINTER :: potparm_source, potparm_dest 00501 TYPE(cp_error_type), INTENT(inout) :: error 00502 00503 CHARACTER(len=*), PARAMETER :: routineN = 'pair_potential_single_copy', 00504 routineP = moduleN//':'//routineN 00505 00506 INTEGER :: i 00507 LOGICAL :: failure 00508 00509 failure = .FALSE. 00510 CPPostcondition(ASSOCIATED(potparm_source),cp_failure_level,routineP,error,failure) 00511 IF (.NOT.failure) THEN 00512 IF (.NOT.ASSOCIATED(potparm_dest)) THEN 00513 CALL pair_potential_single_create(potparm_dest,SIZE(potparm_source%type),error) 00514 ELSE 00515 CALL pair_potential_single_clean(potparm_dest, error) 00516 END IF 00517 potparm_dest % type = potparm_source % type 00518 potparm_dest % shell_type = potparm_source % shell_type 00519 potparm_dest % undef = potparm_source % undef 00520 potparm_dest % no_mb = potparm_source % no_mb 00521 potparm_dest % no_pp = potparm_source % no_pp 00522 potparm_dest % at1 = potparm_source % at1 00523 potparm_dest % at2 = potparm_source % at2 00524 potparm_dest % rcutsq = potparm_source % rcutsq 00525 IF (ASSOCIATED( potparm_source % pair_spline_data )) THEN 00526 CALL spline_data_p_copy ( potparm_source % pair_spline_data, potparm_dest % pair_spline_data, error=error ) 00527 END IF 00528 00529 IF (ASSOCIATED( potparm_source % spl_f )) THEN 00530 CALL spline_factor_copy ( potparm_source % spl_f, potparm_dest % spl_f, error=error ) 00531 END IF 00532 00533 DO i = 1, SIZE(potparm_source%type) 00534 potparm_dest%set(i)%rmin = potparm_source%set(i)%rmin 00535 potparm_dest%set(i)%rmax = potparm_source%set(i)%rmax 00536 CALL pair_potential_lj_copy (potparm_source%set(i)%lj, potparm_dest%set(i)%lj, error=error) 00537 CALL pair_potential_williams_copy (potparm_source%set(i)%willis, potparm_dest%set(i)%willis, error=error) 00538 CALL pair_potential_goodwin_copy (potparm_source%set(i)%goodwin, potparm_dest%set(i)%goodwin, error=error) 00539 CALL pair_potential_eam_copy (potparm_source%set(i)%eam, potparm_dest%set(i)%eam, error=error) 00540 CALL pair_potential_bmhft_copy (potparm_source%set(i)%ft, potparm_dest%set(i)%ft, error=error) 00541 CALL pair_potential_bmhftd_copy (potparm_source%set(i)%ftd, potparm_dest%set(i)%ftd, error=error) 00542 CALL pair_potential_ipbv_copy (potparm_source%set(i)%ipbv, potparm_dest%set(i)%ipbv, error=error) 00543 CALL pair_potential_buck4r_copy (potparm_source%set(i)%buck4r, potparm_dest%set(i)%buck4r, error=error) 00544 CALL pair_potential_buckmo_copy (potparm_source%set(i)%buckmo, potparm_dest%set(i)%buckmo, error=error) 00545 CALL pair_potential_gp_copy (potparm_source%set(i)%gp, potparm_dest%set(i)%gp, error=error) 00546 CALL pair_potential_tersoff_copy (potparm_source%set(i)%tersoff, potparm_dest%set(i)%tersoff, error=error) 00547 CALL pair_potential_siepmann_copy (potparm_source%set(i)%siepmann, potparm_dest%set(i)%siepmann, error=error) 00548 END DO 00549 END IF 00550 END SUBROUTINE pair_potential_single_copy 00551 00552 ! ***************************************************************************** 00557 SUBROUTINE pair_potential_single_add(potparm_source, potparm_dest, error) 00558 TYPE(pair_potential_single_type), 00559 POINTER :: potparm_source, potparm_dest 00560 TYPE(cp_error_type), INTENT(inout) :: error 00561 00562 CHARACTER(len=*), PARAMETER :: routineN = 'pair_potential_single_add', 00563 routineP = moduleN//':'//routineN 00564 00565 INTEGER :: i, j, size_dest, size_source 00566 LOGICAL :: allocate_new, check, failure 00567 TYPE(pair_potential_single_type), 00568 POINTER :: potparm_tmp 00569 00570 failure = .FALSE. 00571 CPPostcondition(ASSOCIATED(potparm_source),cp_failure_level,routineP,error,failure) 00572 IF (.NOT.failure) THEN 00573 ! At this level we expect all splines types 00574 ! be not allocated.. No sense add splines at this level.. in case fail! 00575 check = (.NOT.ASSOCIATED( potparm_source % pair_spline_data )).AND.& 00576 (.NOT.ASSOCIATED( potparm_source % spl_f )) 00577 CPPostcondition(check,cp_failure_level,routineP,error,failure) 00578 check = (.NOT.ASSOCIATED( potparm_dest % pair_spline_data )).AND.& 00579 (.NOT.ASSOCIATED( potparm_dest % spl_f )) 00580 CPPostcondition(check,cp_failure_level,routineP,error,failure) 00581 ! Increase the size of the destination potparm (in case) and copy the new data 00582 size_source = SIZE(potparm_source%type) 00583 allocate_new = .NOT.ASSOCIATED(potparm_dest) 00584 IF (.NOT.allocate_new) THEN 00585 size_dest = SIZE(potparm_dest%type) 00586 IF (size_dest==1) THEN 00587 check = (ASSOCIATED(potparm_dest%set(1)%lj)).OR.& 00588 (ASSOCIATED(potparm_dest%set(1)%willis)).OR.& 00589 (ASSOCIATED(potparm_dest%set(1)%goodwin)).OR.& 00590 (ASSOCIATED(potparm_dest%set(1)%eam)).OR.& 00591 (ASSOCIATED(potparm_dest%set(1)%ft)).OR.& 00592 (ASSOCIATED(potparm_dest%set(1)%ftd)).OR.& 00593 (ASSOCIATED(potparm_dest%set(1)%ipbv)).OR.& 00594 (ASSOCIATED(potparm_dest%set(1)%buck4r)).OR.& 00595 (ASSOCIATED(potparm_dest%set(1)%buckmo)).OR.& 00596 (ASSOCIATED(potparm_dest%set(1)%gp)).OR.& 00597 (ASSOCIATED(potparm_dest%set(1)%tersoff)).OR.& 00598 (ASSOCIATED(potparm_dest%set(1)%siepmann)) 00599 IF (.NOT.check) THEN 00600 allocate_new = .TRUE. 00601 CALL pair_potential_single_release(potparm_dest, error) 00602 END IF 00603 END IF 00604 END IF 00605 IF (allocate_new) THEN 00606 size_dest = 0 00607 CALL pair_potential_single_create(potparm_dest,size_source,error) 00608 potparm_dest % shell_type = potparm_source % shell_type 00609 potparm_dest % undef = potparm_source % undef 00610 potparm_dest % no_mb = potparm_source % no_mb 00611 potparm_dest % no_pp = potparm_source % no_pp 00612 potparm_dest % at1 = potparm_source % at1 00613 potparm_dest % at2 = potparm_source % at2 00614 potparm_dest % rcutsq = potparm_source % rcutsq 00615 ELSE 00616 size_dest = SIZE(potparm_dest%type) 00617 NULLIFY(potparm_tmp) 00618 CALL pair_potential_single_copy(potparm_dest,potparm_tmp,error) 00619 CALL pair_potential_single_release(potparm_dest, error) 00620 CALL pair_potential_single_create(potparm_dest,size_dest+size_source,error) 00621 ! Copy back original informations.. 00622 potparm_dest % shell_type = potparm_tmp % shell_type 00623 potparm_dest % undef = potparm_tmp % undef 00624 potparm_dest % no_mb = potparm_tmp % no_mb 00625 potparm_dest % no_pp = potparm_tmp % no_pp 00626 potparm_dest % at1 = potparm_tmp % at1 00627 potparm_dest % at2 = potparm_tmp % at2 00628 potparm_dest % rcutsq = potparm_tmp % rcutsq 00629 DO i = 1, size_dest 00630 potparm_dest%type(i) = potparm_tmp%type(i) 00631 potparm_dest%set(i)%rmin = potparm_tmp%set(i)%rmin 00632 potparm_dest%set(i)%rmax = potparm_tmp%set(i)%rmax 00633 CALL pair_potential_lj_copy (potparm_tmp%set(i)%lj, potparm_dest%set(i)%lj, error=error) 00634 CALL pair_potential_williams_copy (potparm_tmp%set(i)%willis, potparm_dest%set(i)%willis, error=error) 00635 CALL pair_potential_goodwin_copy (potparm_tmp%set(i)%goodwin, potparm_dest%set(i)%goodwin, error=error) 00636 CALL pair_potential_eam_copy (potparm_tmp%set(i)%eam, potparm_dest%set(i)%eam, error=error) 00637 CALL pair_potential_bmhft_copy (potparm_tmp%set(i)%ft, potparm_dest%set(i)%ft, error=error) 00638 CALL pair_potential_bmhftd_copy (potparm_tmp%set(i)%ftd, potparm_dest%set(i)%ftd, error=error) 00639 CALL pair_potential_ipbv_copy (potparm_tmp%set(i)%ipbv, potparm_dest%set(i)%ipbv, error=error) 00640 CALL pair_potential_buck4r_copy (potparm_tmp%set(i)%buck4r, potparm_dest%set(i)%buck4r, error=error) 00641 CALL pair_potential_buckmo_copy (potparm_tmp%set(i)%buckmo, potparm_dest%set(i)%buckmo, error=error) 00642 CALL pair_potential_gp_copy (potparm_tmp%set(i)%gp, potparm_dest%set(i)%gp, error=error) 00643 CALL pair_potential_tersoff_copy (potparm_tmp%set(i)%tersoff, potparm_dest%set(i)%tersoff, error=error) 00644 CALL pair_potential_siepmann_copy (potparm_tmp%set(i)%siepmann, potparm_dest%set(i)%siepmann, error=error) 00645 END DO 00646 CALL pair_potential_single_release ( potparm_tmp, error ) 00647 END IF 00648 ! Further check with main option with source and dest (already filled with few informations) 00649 check= (potparm_dest % shell_type == potparm_source % shell_type).AND.& 00650 (potparm_dest % undef .EQV.potparm_source % undef ).AND.& 00651 (potparm_dest % no_mb .EQV.potparm_source % no_mb ).AND.& 00652 (potparm_dest % no_pp .EQV.potparm_source % no_pp ).AND.& 00653 (potparm_dest % at1 == potparm_source % at1 ).AND.& 00654 (potparm_dest % at2 == potparm_source % at2 ).AND.& 00655 (potparm_dest % rcutsq == potparm_source % rcutsq ) 00656 CPPostcondition(check,cp_failure_level,routineP,error,failure) 00657 ! Now copy the new pair_potential type 00658 DO i = size_dest+1, size_dest+size_source 00659 j = i-size_dest 00660 potparm_dest%type(i) = potparm_source%type(j) 00661 potparm_dest%set(i)%rmin = potparm_source%set(j)%rmin 00662 potparm_dest%set(i)%rmax = potparm_source%set(j)%rmax 00663 CALL pair_potential_lj_copy (potparm_source%set(j)%lj, potparm_dest%set(i)%lj, error=error) 00664 CALL pair_potential_williams_copy (potparm_source%set(j)%willis, potparm_dest%set(i)%willis, error=error) 00665 CALL pair_potential_goodwin_copy (potparm_source%set(j)%goodwin, potparm_dest%set(i)%goodwin, error=error) 00666 CALL pair_potential_eam_copy (potparm_source%set(j)%eam, potparm_dest%set(i)%eam, error=error) 00667 CALL pair_potential_bmhft_copy (potparm_source%set(j)%ft, potparm_dest%set(i)%ft, error=error) 00668 CALL pair_potential_bmhftd_copy (potparm_source%set(j)%ftd, potparm_dest%set(i)%ftd, error=error) 00669 CALL pair_potential_ipbv_copy (potparm_source%set(j)%ipbv, potparm_dest%set(i)%ipbv, error=error) 00670 CALL pair_potential_buck4r_copy (potparm_source%set(j)%buck4r, potparm_dest%set(i)%buck4r, error=error) 00671 CALL pair_potential_buckmo_copy (potparm_source%set(j)%buckmo, potparm_dest%set(i)%buckmo, error=error) 00672 CALL pair_potential_gp_copy (potparm_source%set(j)%gp, potparm_dest%set(i)%gp, error=error) 00673 CALL pair_potential_tersoff_copy (potparm_source%set(j)%tersoff, potparm_dest%set(i)%tersoff, error=error) 00674 CALL pair_potential_siepmann_copy (potparm_source%set(j)%siepmann, potparm_dest%set(i)%siepmann, error=error) 00675 END DO 00676 END IF 00677 END SUBROUTINE pair_potential_single_add 00678 00679 ! ***************************************************************************** 00683 SUBROUTINE pair_potential_copy(potparm_source, potparm_dest, error) 00684 TYPE(pair_potential_type), POINTER :: potparm_source, potparm_dest 00685 TYPE(cp_error_type), INTENT(inout) :: error 00686 00687 CHARACTER(len=*), PARAMETER :: routineN = 'pair_potential_copy', 00688 routineP = moduleN//':'//routineN 00689 00690 LOGICAL :: failure 00691 00692 failure = .FALSE. 00693 00694 CPPostcondition(ASSOCIATED(potparm_source),cp_failure_level,routineP,error,failure) 00695 CPPostcondition(ASSOCIATED(potparm_dest),cp_failure_level,routineP,error,failure) 00696 IF (.NOT.failure) THEN 00697 IF (.NOT.ASSOCIATED(potparm_dest%pot)) THEN 00698 CALL pair_potential_single_create(potparm_dest%pot, SIZE(potparm_source%pot%type), error) 00699 END IF 00700 CALL pair_potential_single_copy(potparm_source%pot, potparm_dest%pot, error=error) 00701 END IF 00702 END SUBROUTINE pair_potential_copy 00703 00704 ! ***************************************************************************** 00708 SUBROUTINE pair_potential_single_release ( potparm, error ) 00709 TYPE(pair_potential_single_type), 00710 POINTER :: potparm 00711 TYPE(cp_error_type), INTENT(inout) :: error 00712 00713 CHARACTER(len=*), PARAMETER :: 00714 routineN = 'pair_potential_single_release', 00715 routineP = moduleN//':'//routineN 00716 00717 INTEGER :: i, stat 00718 LOGICAL :: failure 00719 00720 failure = .FALSE. 00721 IF (.NOT.failure) THEN 00722 CPPostcondition(ASSOCIATED(potparm),cp_failure_level,routineP,error,failure) 00723 CALL spline_data_p_release( potparm% pair_spline_data ,error=error) 00724 CALL spline_factor_release( potparm% spl_f, error=error ) 00725 DO i = 1, SIZE(potparm%type) 00726 CALL pair_potential_ipbv_release ( potparm%set(i)%ipbv, error=error ) 00727 CALL pair_potential_lj_release ( potparm%set(i)%lj, error=error ) 00728 CALL pair_potential_bmhft_release ( potparm%set(i)%ft, error=error ) 00729 CALL pair_potential_bmhftd_release ( potparm%set(i)%ftd, error=error ) 00730 CALL pair_potential_williams_release ( potparm%set(i)%willis, error=error ) 00731 CALL pair_potential_goodwin_release ( potparm%set(i)%goodwin, error=error ) 00732 CALL pair_potential_eam_release ( potparm%set(i)%eam, error=error ) 00733 CALL pair_potential_buck4r_release ( potparm%set(i)%buck4r, error=error ) 00734 CALL pair_potential_buckmo_release ( potparm%set(i)%buckmo, error=error ) 00735 CALL pair_potential_gp_release ( potparm%set(i)%gp, error=error ) 00736 CALL pair_potential_tersoff_release ( potparm%set(i)%tersoff, error=error ) 00737 CALL pair_potential_siepmann_release ( potparm%set(i)%siepmann, error=error ) 00738 END DO 00739 DEALLOCATE(potparm%type, stat=stat) 00740 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00741 DEALLOCATE(potparm%set, stat=stat) 00742 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00743 DEALLOCATE(potparm, stat=stat) 00744 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00745 END IF 00746 NULLIFY ( potparm ) 00747 END SUBROUTINE pair_potential_single_release 00748 00749 ! ***************************************************************************** 00753 SUBROUTINE pair_potential_pp_create ( potparm, nkinds, error ) 00754 TYPE(pair_potential_pp_type), POINTER :: potparm 00755 INTEGER, INTENT(IN) :: nkinds 00756 TYPE(cp_error_type), INTENT(inout) :: error 00757 00758 CHARACTER(len=*), PARAMETER :: routineN = 'pair_potential_pp_create', 00759 routineP = moduleN//':'//routineN 00760 00761 INTEGER :: i, j, stat 00762 LOGICAL :: failure 00763 00764 failure=.FALSE. 00765 IF (.NOT.failure) THEN 00766 CPPostcondition(.NOT.ASSOCIATED(potparm),cp_failure_level,routineP,error,failure) 00767 ALLOCATE ( potparm, stat=stat) 00768 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00769 ALLOCATE ( potparm%pot( nkinds, nkinds ), stat=stat) 00770 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00771 DO i = 1, nkinds 00772 DO j = 1, nkinds 00773 NULLIFY ( potparm%pot(i,j)%pot ) 00774 END DO 00775 END DO 00776 ! Use no-redundancy in the potential definition 00777 DO i = 1, nkinds 00778 DO j = i, nkinds 00779 CALL pair_potential_single_create(potparm%pot( i, j)%pot, error=error) 00780 potparm%pot( j, i )%pot => potparm%pot( i, j )%pot 00781 END DO 00782 END DO 00783 END IF 00784 END SUBROUTINE pair_potential_pp_create 00785 00786 ! ***************************************************************************** 00793 SUBROUTINE pair_potential_pp_release ( potparm, error ) 00794 TYPE(pair_potential_pp_type), POINTER :: potparm 00795 TYPE(cp_error_type), INTENT(inout) :: error 00796 00797 CHARACTER(len=*), PARAMETER :: routineN = 'pair_potential_pp_release', 00798 routineP = moduleN//':'//routineN 00799 00800 INTEGER :: i, j, stat 00801 LOGICAL :: failure 00802 00803 failure = .FALSE. 00804 IF ( ASSOCIATED ( potparm ) ) THEN 00805 IF (ASSOCIATED (potparm%pot)) THEN 00806 DO i = 1, SIZE ( potparm%pot, 1 ) 00807 DO j = i, SIZE ( potparm%pot, 2 ) 00808 CALL pair_potential_single_release(potparm%pot( i, j )%pot, error) 00809 NULLIFY(potparm%pot( j, i )%pot) 00810 END DO 00811 END DO 00812 DEALLOCATE(potparm%pot, stat=stat) 00813 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00814 END IF 00815 DEALLOCATE ( potparm, stat = stat ) 00816 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00817 END IF 00818 NULLIFY ( potparm ) 00819 END SUBROUTINE pair_potential_pp_release 00820 00821 ! ***************************************************************************** 00825 SUBROUTINE pair_potential_p_create ( potparm, ndim, ub, lb, error ) 00826 TYPE(pair_potential_p_type), POINTER :: potparm 00827 INTEGER, INTENT(IN), OPTIONAL :: ndim, ub, lb 00828 TYPE(cp_error_type), INTENT(inout) :: error 00829 00830 CHARACTER(len=*), PARAMETER :: routineN = 'pair_potential_p_create', 00831 routineP = moduleN//':'//routineN 00832 00833 INTEGER :: i, loc_lb, loc_ub, stat 00834 LOGICAL :: failure 00835 00836 failure=.FALSE. 00837 IF (.NOT.failure) THEN 00838 CPPostcondition(.NOT.ASSOCIATED(potparm),cp_failure_level,routineP,error,failure) 00839 ALLOCATE ( potparm, stat=stat) 00840 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00841 IF (PRESENT(ndim)) THEN 00842 loc_lb = 1 00843 loc_ub = ndim 00844 ALLOCATE ( potparm%pot( loc_lb : loc_ub ), stat=stat) 00845 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00846 IF (PRESENT(lb).OR.PRESENT(ub)) THEN 00847 CPPostcondition(.FALSE.,cp_failure_level,routineP,error,failure) 00848 END IF 00849 ELSE IF (PRESENT(lb).AND.PRESENT(ub)) THEN 00850 loc_lb = lb 00851 loc_ub = ub 00852 ALLOCATE ( potparm%pot( loc_lb : loc_ub ), stat=stat) 00853 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00854 IF (PRESENT(ndim)) THEN 00855 CPPostcondition(.FALSE.,cp_failure_level,routineP,error,failure) 00856 END IF 00857 ELSE 00858 CPPostcondition(.FALSE.,cp_failure_level,routineP,error,failure) 00859 END IF 00860 DO i = loc_lb, loc_ub 00861 NULLIFY ( potparm%pot(i)%pot) 00862 CALL pair_potential_single_create(potparm%pot(i)%pot, error=error) 00863 END DO 00864 END IF 00865 END SUBROUTINE pair_potential_p_create 00866 00867 ! ***************************************************************************** 00874 SUBROUTINE pair_potential_p_release ( potparm, error ) 00875 TYPE(pair_potential_p_type), POINTER :: potparm 00876 TYPE(cp_error_type), INTENT(inout) :: error 00877 00878 CHARACTER(len=*), PARAMETER :: routineN = 'pair_potential_p_release', 00879 routineP = moduleN//':'//routineN 00880 00881 INTEGER :: i, stat 00882 LOGICAL :: failure 00883 00884 failure = .FALSE. 00885 00886 IF ( ASSOCIATED ( potparm ) ) THEN 00887 IF (ASSOCIATED (potparm%pot)) THEN 00888 DO i = 1, SIZE ( potparm%pot ) 00889 CALL pair_potential_single_release(potparm%pot( i )%pot, error) 00890 END DO 00891 DEALLOCATE(potparm%pot, stat=stat) 00892 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00893 END IF 00894 DEALLOCATE ( potparm, stat = stat ) 00895 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00896 END IF 00897 NULLIFY ( potparm ) 00898 END SUBROUTINE pair_potential_p_release 00899 00900 ! ***************************************************************************** 00904 SUBROUTINE pair_potential_p_copy(source, dest, istart, iend, error) 00905 TYPE(pair_potential_p_type), POINTER :: source, dest 00906 INTEGER, INTENT(IN), OPTIONAL :: istart, iend 00907 TYPE(cp_error_type), INTENT(inout) :: error 00908 00909 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_p_copy', 00910 routineP = moduleN//':'//routineN 00911 00912 INTEGER :: i, l_end, l_start 00913 LOGICAL :: failure 00914 00915 failure = .FALSE. 00916 CPPostcondition(ASSOCIATED(source),cp_failure_level,routineP,error,failure) 00917 CPPostcondition(ASSOCIATED(dest),cp_failure_level,routineP,error,failure) 00918 l_start = LBOUND(source%pot,1) 00919 l_end = UBOUND(source%pot,1) 00920 IF (PRESENT(istart)) l_start = istart 00921 IF (PRESENT(iend)) l_end = iend 00922 IF (.NOT.failure) THEN 00923 DO i = l_start, l_end 00924 IF (.NOT.ASSOCIATED(source%pot(i)%pot)) & 00925 CALL pair_potential_single_create(source%pot(i)%pot, error=error) 00926 CALL pair_potential_single_copy(source%pot(i)%pot,dest%pot(i)%pot,error=error) 00927 END DO 00928 END IF 00929 END SUBROUTINE pair_potential_p_copy 00930 00931 ! ***************************************************************************** 00935 SUBROUTINE pair_potential_reallocate(p,lb1_new,ub1_new,lj,lj_charmm,williams,& 00936 goodwin,eam,bmhft,bmhftd,ipbv,buck4r,buckmo,gp,tersoff,& 00937 siepmann,error) 00938 TYPE(pair_potential_p_type), POINTER :: p 00939 INTEGER, INTENT(IN) :: lb1_new, ub1_new 00940 LOGICAL, INTENT(IN), OPTIONAL :: lj, lj_charmm, williams, 00941 goodwin, eam, bmhft, bmhftd, 00942 ipbv, buck4r, buckmo, gp, 00943 tersoff, siepmann 00944 TYPE(cp_error_type), INTENT(inout) :: error 00945 00946 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_reallocate', 00947 routineP = moduleN//':'//routineN 00948 00949 INTEGER :: i, ipot, lb1_old, std_dim, 00950 ub1_old 00951 LOGICAL :: check, failure, lbmhft, lbmhftd, lbuck4r, lbuckmo, leam, 00952 lgoodwin, lgp, lipbv, llj, llj_charmm, lsiepmann, ltersoff, lwilliams 00953 TYPE(pair_potential_p_type), POINTER :: work 00954 00955 NULLIFY(work) 00956 failure = .FALSE. 00957 ipot = 0 00958 llj = .FALSE. ; IF (PRESENT(lj)) llj = lj 00959 llj_charmm= .FALSE. ; IF (PRESENT(lj_charmm)) llj_charmm= lj_charmm 00960 lwilliams = .FALSE. ; IF (PRESENT(williams)) lwilliams = williams 00961 lgoodwin = .FALSE. ; IF (PRESENT(goodwin)) lgoodwin = goodwin 00962 leam = .FALSE. ; IF (PRESENT(eam)) leam = eam 00963 lbmhft = .FALSE. ; IF (PRESENT(bmhft)) lbmhft = bmhft 00964 lbmhftd = .FALSE. ; IF (PRESENT(bmhftd)) lbmhftd = bmhftd 00965 lipbv = .FALSE. ; IF (PRESENT(ipbv)) lipbv = ipbv 00966 lbuck4r = .FALSE. ; IF (PRESENT(buck4r)) lbuck4r = buck4r 00967 lbuckmo = .FALSE. ; IF (PRESENT(buckmo)) lbuckmo = buckmo 00968 lgp = .FALSE. ; IF (PRESENT(gp)) lgp = gp 00969 ltersoff = .FALSE. ; IF (PRESENT(tersoff)) ltersoff = tersoff 00970 lsiepmann = .FALSE. ; IF (PRESENT(siepmann)) lsiepmann = siepmann 00971 00972 IF (llj) THEN 00973 ipot = lj_type 00974 check = .NOT.(llj_charmm.OR.lwilliams.OR.lgoodwin.OR.leam.OR.lbmhft& 00975 .OR.lbmhftd.OR.lipbv.OR.lbuck4r.OR.lbuckmo.OR.lgp.OR.ltersoff& 00976 .OR.lsiepmann) 00977 CPPostcondition(check,cp_failure_level,routineP,error,failure) 00978 END IF 00979 IF (llj_charmm) THEN 00980 ipot = lj_charmm_type 00981 check = .NOT.(llj.OR.lwilliams.OR.lgoodwin.OR.leam.OR.lbmhft.OR.lbmhftd.OR.lipbv& 00982 .OR.lbuck4r.OR.lbuckmo.OR.lgp.OR.ltersoff.OR.lsiepmann) 00983 CPPostcondition(check,cp_failure_level,routineP,error,failure) 00984 END IF 00985 IF (lwilliams) THEN 00986 ipot = wl_type 00987 check = .NOT.(llj.OR.llj_charmm.OR.lgoodwin.OR.leam.OR.lbmhft.OR.lbmhftd.OR.lipbv& 00988 .OR.lbuck4r.OR.lbuckmo.OR.lgp.OR.ltersoff.OR.lsiepmann) 00989 CPPostcondition(check,cp_failure_level,routineP,error,failure) 00990 END IF 00991 IF (lgoodwin) THEN 00992 ipot = gw_type 00993 check = .NOT.(llj.OR.llj_charmm.OR.lwilliams.OR.leam.OR.lbmhft.OR.lbmhftd.OR.lipbv& 00994 .OR.lbuck4r.OR.lbuckmo.OR.lgp.OR.ltersoff.OR.lsiepmann) 00995 CPPostcondition(check,cp_failure_level,routineP,error,failure) 00996 END IF 00997 IF (leam) THEN 00998 ipot = ea_type 00999 check = .NOT.(llj.OR.llj_charmm.OR.lgoodwin.OR.lwilliams.OR.lbmhft.OR.lbmhftd.OR.lipbv& 01000 .OR.lbuck4r.OR.lbuckmo.OR.lgp.OR.ltersoff.OR.lsiepmann) 01001 CPPostcondition(check,cp_failure_level,routineP,error,failure) 01002 END IF 01003 IF (lbmhft) THEN 01004 ipot = ft_type 01005 check = .NOT.(llj.OR.llj_charmm.OR.lgoodwin.OR.leam.OR.lwilliams.OR.lbmhftd.OR.lipbv& 01006 .OR.lbuck4r.OR.lbuckmo.OR.lgp.OR.ltersoff.OR.lsiepmann) 01007 CPPostcondition(check,cp_failure_level,routineP,error,failure) 01008 END IF 01009 IF (lbmhftd) THEN 01010 ipot = ftd_type 01011 check = .NOT.(llj.OR.llj_charmm.OR.lgoodwin.OR.leam.OR.lwilliams.OR.lbmhft.OR.lipbv& 01012 .OR.lbuck4r.OR.lbuckmo.OR.lgp.OR.ltersoff.OR.lsiepmann) 01013 CPPostcondition(check,cp_failure_level,routineP,error,failure) 01014 END IF 01015 IF (lipbv) THEN 01016 ipot = ip_type 01017 check = .NOT.(llj.OR.llj_charmm.OR.lgoodwin.OR.leam.OR.lwilliams.OR.lbmhft.OR.lbmhftd& 01018 .OR.lbuck4r.OR.lbuckmo.OR.lgp.OR.ltersoff.OR.lsiepmann) 01019 CPPostcondition(check,cp_failure_level,routineP,error,failure) 01020 END IF 01021 IF (lbuck4r) THEN 01022 ipot = b4_type 01023 check = .NOT.(llj.OR.llj_charmm.OR.lgoodwin.OR.leam.OR.lwilliams.OR.lbmhft.OR.lbmhftd& 01024 .OR.lipbv.OR.lbuckmo.OR.lgp.OR.ltersoff.OR.lsiepmann) 01025 CPPostcondition(check,cp_failure_level,routineP,error,failure) 01026 END IF 01027 IF (lbuckmo) THEN 01028 ipot = bm_type 01029 check = .NOT.(llj.OR.llj_charmm.OR.lgoodwin.OR.leam.OR.lwilliams.OR.lbmhft.OR.lbmhftd& 01030 .OR.lipbv.OR.lbuck4r.OR.lgp.OR.ltersoff.OR.lsiepmann) 01031 CPPostcondition(check,cp_failure_level,routineP,error,failure) 01032 END IF 01033 IF (ltersoff) THEN 01034 ipot = tersoff_type 01035 check = .NOT.(llj.OR.llj_charmm.OR.lgoodwin.OR.leam.OR.lwilliams.OR.lbmhft.OR.lbmhftd& 01036 .OR.lipbv.OR.lbuck4r.OR.lbuckmo.OR.lgp.OR.lsiepmann) 01037 CPPostcondition(check,cp_failure_level,routineP,error,failure) 01038 END IF 01039 IF (lsiepmann) THEN 01040 ipot = siepmann_type 01041 check = .NOT.(llj.OR.llj_charmm.OR.lgoodwin.OR.leam.OR.lwilliams.OR.lbmhft.OR.lbmhftd& 01042 .OR.lipbv.OR.lbuck4r.OR.lbuckmo.OR.lgp.OR.ltersoff) 01043 CPPostcondition(check,cp_failure_level,routineP,error,failure) 01044 END IF 01045 IF (lgp) THEN 01046 ipot = gp_type 01047 check = .NOT.(llj.OR.llj_charmm.OR.lgoodwin.OR.leam.OR.lwilliams.OR.lbmhft.OR.lbmhftd& 01048 .OR.lipbv.OR.lbuck4r.OR.lbuckmo.OR.ltersoff.OR.lsiepmann) 01049 CPPostcondition(check,cp_failure_level,routineP,error,failure) 01050 END IF 01051 01052 IF (.NOT.failure) THEN 01053 lb1_old = 0 01054 ub1_old = 0 01055 IF (ASSOCIATED(p)) THEN 01056 lb1_old = LBOUND(p%pot,1) 01057 ub1_old = UBOUND(p%pot,1) 01058 CALL pair_potential_p_create(work, lb=lb1_old, ub=ub1_old, error=error) 01059 CALL pair_potential_p_copy(p, work, error=error) 01060 CALL pair_potential_p_release(p, error=error) 01061 END IF 01062 01063 CALL pair_potential_p_create(p, lb=lb1_new, ub=ub1_new, error=error) 01064 IF (ASSOCIATED(work)) THEN 01065 CALL pair_potential_p_copy(work, p, istart=lb1_old, iend=ub1_old, error=error) 01066 END IF 01067 std_dim = 1 01068 DO i = ub1_old+1, ub1_new 01069 check = (SIZE(p%pot(i)%pot%type)==std_dim).AND.(SIZE(p%pot(i)%pot%type)==std_dim) 01070 CPPostcondition(check,cp_failure_level,routineP,error,failure) 01071 p % pot ( i ) % pot % type = nn_type 01072 p % pot ( i ) % pot % shell_type = nosh_nosh 01073 p % pot ( i ) % pot % undef = .TRUE. 01074 p % pot ( i ) % pot % no_mb = .FALSE. 01075 p % pot ( i ) % pot % no_pp = .FALSE. 01076 p % pot ( i ) % pot % at1 = 'NULL' 01077 p % pot ( i ) % pot % at2 = 'NULL' 01078 p % pot ( i ) % pot % set(std_dim) % rmin = not_initialized 01079 p % pot ( i ) % pot % set(std_dim) % rmax = not_initialized 01080 SELECT CASE (ipot) 01081 CASE (lj_type,lj_charmm_type) 01082 CALL pair_potential_lj_create(p%pot(i)%pot%set(std_dim)%lj, error=error) 01083 CASE (wl_type) 01084 CALL pair_potential_williams_create(p%pot(i)%pot%set(std_dim)%willis, error=error) 01085 CASE (gw_type) 01086 CALL pair_potential_goodwin_create(p%pot(i)%pot%set(std_dim)%goodwin, error=error) 01087 CASE (ea_type) 01088 CALL pair_potential_eam_create(p%pot(i)%pot%set(std_dim)%eam, error=error) 01089 CASE (ft_type) 01090 CALL pair_potential_bmhft_create(p%pot(i)%pot%set(std_dim)%ft, error=error) 01091 CASE (ftd_type) 01092 CALL pair_potential_bmhftd_create(p%pot(i)%pot%set(std_dim)%ftd, error=error) 01093 CASE (ip_type) 01094 CALL pair_potential_ipbv_create(p%pot(i)%pot%set(std_dim)%ipbv, error=error) 01095 CASE (b4_type) 01096 CALL pair_potential_buck4r_create(p%pot(i)%pot%set(std_dim)%buck4r, error=error) 01097 CASE (bm_type) 01098 CALL pair_potential_buckmo_create(p%pot(i)%pot%set(std_dim)%buckmo, error=error) 01099 CASE (gp_type) 01100 CALL pair_potential_gp_create(p%pot(i)%pot%set(std_dim)%gp, error=error) 01101 CASE (tersoff_type) 01102 CALL pair_potential_tersoff_create(p%pot(i)%pot%set(std_dim)%tersoff, error=error) 01103 CASE (siepmann_type) 01104 CALL pair_potential_siepmann_create(p%pot(i)%pot%set(std_dim)%siepmann, error=error) 01105 END SELECT 01106 NULLIFY ( p%pot(i)%pot%spl_f ) 01107 NULLIFY ( p%pot(i)%pot%pair_spline_data ) 01108 END DO 01109 01110 IF (ASSOCIATED(work)) CALL pair_potential_p_release(work, error=error) 01111 END IF 01112 END SUBROUTINE pair_potential_reallocate 01113 01114 ! ***************************************************************************** 01118 SUBROUTINE pair_potential_gp_create(gp, error) 01119 TYPE(gp_pot_type), POINTER :: gp 01120 TYPE(cp_error_type), INTENT(inout) :: error 01121 01122 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_gp_create', 01123 routineP = moduleN//':'//routineN 01124 01125 INTEGER :: stat 01126 LOGICAL :: failure 01127 01128 failure = .FALSE. 01129 IF (.NOT.failure) THEN 01130 CPPostcondition(.NOT.ASSOCIATED(gp),cp_failure_level,routineP,error,failure) 01131 ALLOCATE(gp, stat=stat) 01132 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01133 NULLIFY (gp%parameters) 01134 NULLIFY (gp%values) 01135 CALL pair_potential_gp_clean(gp, error=error) 01136 END IF 01137 END SUBROUTINE pair_potential_gp_create 01138 01139 ! ***************************************************************************** 01143 SUBROUTINE pair_potential_gp_copy(gp_source, gp_dest, error) 01144 TYPE(gp_pot_type), POINTER :: gp_source, gp_dest 01145 TYPE(cp_error_type), INTENT(inout) :: error 01146 01147 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_gp_copy', 01148 routineP = moduleN//':'//routineN 01149 01150 INTEGER :: idim, stat 01151 LOGICAL :: failure 01152 01153 failure = .FALSE. 01154 IF (.NOT.failure) THEN 01155 IF (.NOT.ASSOCIATED(gp_source)) RETURN 01156 IF (ASSOCIATED(gp_dest)) CALL pair_potential_gp_release(gp_dest, error=error) 01157 CALL pair_potential_gp_create(gp_dest, error=error) 01158 gp_dest%myid = gp_source%myid 01159 gp_dest%potential = gp_source%potential 01160 gp_dest%variables = gp_source%variables 01161 IF (ASSOCIATED(gp_source%parameters)) THEN 01162 idim = SIZE(gp_source%parameters) 01163 ALLOCATE(gp_dest%parameters(idim),stat=stat) 01164 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01165 gp_dest%parameters = gp_source%parameters 01166 END IF 01167 IF (ASSOCIATED(gp_source%values)) THEN 01168 idim = SIZE(gp_source%values) 01169 ALLOCATE(gp_dest%values(idim),stat=stat) 01170 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01171 gp_dest%values = gp_source%values 01172 END IF 01173 END IF 01174 END SUBROUTINE pair_potential_gp_copy 01175 01176 ! ***************************************************************************** 01180 SUBROUTINE pair_potential_gp_clean(gp, error) 01181 TYPE(gp_pot_type), POINTER :: gp 01182 TYPE(cp_error_type), INTENT(inout) :: error 01183 01184 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_gp_clean', 01185 routineP = moduleN//':'//routineN 01186 01187 INTEGER :: stat 01188 LOGICAL :: failure 01189 01190 failure = .FALSE. 01191 IF (.NOT.failure) THEN 01192 IF (.NOT.ASSOCIATED(gp)) RETURN 01193 gp%myid = 0 01194 gp%potential = "" 01195 gp%variables = "" 01196 IF (ASSOCIATED(gp%values)) THEN 01197 DEALLOCATE(gp%values,stat=stat) 01198 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01199 END IF 01200 IF (ASSOCIATED(gp%parameters)) THEN 01201 DEALLOCATE(gp%parameters,stat=stat) 01202 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01203 END IF 01204 END IF 01205 END SUBROUTINE pair_potential_gp_clean 01206 01207 ! ***************************************************************************** 01211 SUBROUTINE pair_potential_gp_release(gp, error) 01212 TYPE(gp_pot_type), POINTER :: gp 01213 TYPE(cp_error_type), INTENT(inout) :: error 01214 01215 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_gp_release', 01216 routineP = moduleN//':'//routineN 01217 01218 INTEGER :: stat 01219 LOGICAL :: failure 01220 01221 failure = .FALSE. 01222 IF (.NOT.failure) THEN 01223 IF (ASSOCIATED(gp)) THEN 01224 IF (ASSOCIATED(gp%parameters)) THEN 01225 DEALLOCATE(gp%parameters, stat=stat) 01226 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01227 END IF 01228 IF (ASSOCIATED(gp%values)) THEN 01229 DEALLOCATE(gp%values, stat=stat) 01230 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01231 END IF 01232 DEALLOCATE(gp, stat=stat) 01233 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01234 END IF 01235 NULLIFY(gp) 01236 END IF 01237 END SUBROUTINE pair_potential_gp_release 01238 01239 ! ***************************************************************************** 01243 SUBROUTINE pair_potential_lj_create(lj, error) 01244 TYPE(lj_pot_type), POINTER :: lj 01245 TYPE(cp_error_type), INTENT(inout) :: error 01246 01247 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_lj_create', 01248 routineP = moduleN//':'//routineN 01249 01250 INTEGER :: stat 01251 LOGICAL :: failure 01252 01253 failure = .FALSE. 01254 IF (.NOT.failure) THEN 01255 CPPostcondition(.NOT.ASSOCIATED(lj),cp_failure_level,routineP,error,failure) 01256 ALLOCATE(lj, stat=stat) 01257 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01258 CALL pair_potential_lj_clean(lj, error=error) 01259 END IF 01260 END SUBROUTINE pair_potential_lj_create 01261 01262 ! ***************************************************************************** 01266 SUBROUTINE pair_potential_lj_copy(lj_source, lj_dest, error) 01267 TYPE(lj_pot_type), POINTER :: lj_source, lj_dest 01268 TYPE(cp_error_type), INTENT(inout) :: error 01269 01270 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_lj_copy', 01271 routineP = moduleN//':'//routineN 01272 01273 LOGICAL :: failure 01274 01275 failure = .FALSE. 01276 IF (.NOT.failure) THEN 01277 IF (.NOT.ASSOCIATED(lj_source)) RETURN 01278 IF (ASSOCIATED(lj_dest)) CALL pair_potential_lj_release(lj_dest, error=error) 01279 CALL pair_potential_lj_create(lj_dest, error=error) 01280 lj_dest%epsilon = lj_source%epsilon 01281 lj_dest%sigma6 = lj_source%sigma6 01282 lj_dest%sigma12 = lj_source%sigma12 01283 END IF 01284 END SUBROUTINE pair_potential_lj_copy 01285 01286 ! ***************************************************************************** 01290 SUBROUTINE pair_potential_lj_clean(lj, error) 01291 TYPE(lj_pot_type), POINTER :: lj 01292 TYPE(cp_error_type), INTENT(inout) :: error 01293 01294 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_lj_clean', 01295 routineP = moduleN//':'//routineN 01296 01297 LOGICAL :: failure 01298 01299 failure = .FALSE. 01300 IF (.NOT.failure) THEN 01301 IF (.NOT.ASSOCIATED(lj)) RETURN 01302 lj%epsilon = 0.0_dp 01303 lj%sigma6 = 0.0_dp 01304 lj%sigma12 = 0.0_dp 01305 END IF 01306 END SUBROUTINE pair_potential_lj_clean 01307 01308 ! ***************************************************************************** 01312 SUBROUTINE pair_potential_lj_release(lj, error) 01313 TYPE(lj_pot_type), POINTER :: lj 01314 TYPE(cp_error_type), INTENT(inout) :: error 01315 01316 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_lj_release', 01317 routineP = moduleN//':'//routineN 01318 01319 INTEGER :: stat 01320 LOGICAL :: failure 01321 01322 failure = .FALSE. 01323 IF (.NOT.failure) THEN 01324 IF (ASSOCIATED(lj)) THEN 01325 DEALLOCATE(lj, stat=stat) 01326 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01327 END IF 01328 NULLIFY(lj) 01329 END IF 01330 END SUBROUTINE pair_potential_lj_release 01331 01332 ! ***************************************************************************** 01336 SUBROUTINE pair_potential_williams_create(willis, error) 01337 TYPE(williams_pot_type), POINTER :: willis 01338 TYPE(cp_error_type), INTENT(inout) :: error 01339 01340 CHARACTER(LEN=*), PARAMETER :: 01341 routineN = 'pair_potential_williams_create', 01342 routineP = moduleN//':'//routineN 01343 01344 INTEGER :: stat 01345 LOGICAL :: failure 01346 01347 failure = .FALSE. 01348 IF (.NOT.failure) THEN 01349 CPPostcondition(.NOT.ASSOCIATED(willis),cp_failure_level,routineP,error,failure) 01350 ALLOCATE(willis, stat=stat) 01351 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01352 CALL pair_potential_williams_clean(willis, error=error) 01353 END IF 01354 END SUBROUTINE pair_potential_williams_create 01355 01356 ! ***************************************************************************** 01360 SUBROUTINE pair_potential_williams_copy(willis_source, willis_dest, error) 01361 TYPE(williams_pot_type), POINTER :: willis_source, willis_dest 01362 TYPE(cp_error_type), INTENT(inout) :: error 01363 01364 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_williams_copy', 01365 routineP = moduleN//':'//routineN 01366 01367 LOGICAL :: failure 01368 01369 failure = .FALSE. 01370 IF (.NOT.failure) THEN 01371 IF (.NOT.ASSOCIATED(willis_source)) RETURN 01372 IF (ASSOCIATED(willis_dest)) CALL pair_potential_williams_release(willis_dest, error=error) 01373 CALL pair_potential_williams_create(willis_dest, error=error) 01374 willis_dest%a = willis_source%a 01375 willis_dest%b = willis_source%b 01376 willis_dest%c = willis_source%c 01377 END IF 01378 END SUBROUTINE pair_potential_williams_copy 01379 01380 ! ***************************************************************************** 01384 SUBROUTINE pair_potential_williams_clean(willis, error) 01385 TYPE(williams_pot_type), POINTER :: willis 01386 TYPE(cp_error_type), INTENT(inout) :: error 01387 01388 CHARACTER(LEN=*), PARAMETER :: 01389 routineN = 'pair_potential_williams_clean', 01390 routineP = moduleN//':'//routineN 01391 01392 LOGICAL :: failure 01393 01394 failure = .FALSE. 01395 IF (.NOT.failure) THEN 01396 IF(.NOT.ASSOCIATED(willis)) RETURN 01397 willis%a = 0.0_dp 01398 willis%b = 0.0_dp 01399 willis%c = 0.0_dp 01400 END IF 01401 END SUBROUTINE pair_potential_williams_clean 01402 01403 ! ***************************************************************************** 01407 SUBROUTINE pair_potential_williams_release(willis, error) 01408 TYPE(williams_pot_type), POINTER :: willis 01409 TYPE(cp_error_type), INTENT(inout) :: error 01410 01411 CHARACTER(LEN=*), PARAMETER :: 01412 routineN = 'pair_potential_williams_release', 01413 routineP = moduleN//':'//routineN 01414 01415 INTEGER :: stat 01416 LOGICAL :: failure 01417 01418 failure = .FALSE. 01419 IF (.NOT.failure) THEN 01420 IF (ASSOCIATED(willis)) THEN 01421 DEALLOCATE(willis, stat=stat) 01422 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01423 END IF 01424 NULLIFY(willis) 01425 END IF 01426 END SUBROUTINE pair_potential_williams_release 01427 01428 ! ***************************************************************************** 01432 SUBROUTINE pair_potential_goodwin_create(goodwin, error) 01433 TYPE(goodwin_pot_type), POINTER :: goodwin 01434 TYPE(cp_error_type), INTENT(inout) :: error 01435 01436 CHARACTER(LEN=*), PARAMETER :: 01437 routineN = 'pair_potential_goodwin_create', 01438 routineP = moduleN//':'//routineN 01439 01440 INTEGER :: stat 01441 LOGICAL :: failure 01442 01443 failure = .FALSE. 01444 IF (.NOT.failure) THEN 01445 CPPostcondition(.NOT.ASSOCIATED(goodwin),cp_failure_level,routineP,error,failure) 01446 ALLOCATE(goodwin, stat=stat) 01447 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01448 CALL pair_potential_goodwin_clean(goodwin, error=error) 01449 END IF 01450 END SUBROUTINE pair_potential_goodwin_create 01451 01452 ! ***************************************************************************** 01456 SUBROUTINE pair_potential_goodwin_copy(goodwin_source, goodwin_dest, error) 01457 TYPE(goodwin_pot_type), POINTER :: goodwin_source, goodwin_dest 01458 TYPE(cp_error_type), INTENT(inout) :: error 01459 01460 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_goodwin_copy', 01461 routineP = moduleN//':'//routineN 01462 01463 LOGICAL :: failure 01464 01465 failure = .FALSE. 01466 IF (.NOT.failure) THEN 01467 IF (.NOT.ASSOCIATED(goodwin_source)) RETURN 01468 IF (ASSOCIATED(goodwin_dest)) CALL pair_potential_goodwin_release(goodwin_dest, error=error) 01469 CALL pair_potential_goodwin_create(goodwin_dest, error=error) 01470 goodwin_dest%vr0 = goodwin_source%vr0 01471 goodwin_dest%d = goodwin_source%d 01472 goodwin_dest%dc = goodwin_source%dc 01473 goodwin_dest%m = goodwin_source%m 01474 goodwin_dest%mc = goodwin_source%mc 01475 END IF 01476 END SUBROUTINE pair_potential_goodwin_copy 01477 01478 ! ***************************************************************************** 01482 SUBROUTINE pair_potential_goodwin_clean(goodwin, error) 01483 TYPE(goodwin_pot_type), POINTER :: goodwin 01484 TYPE(cp_error_type), INTENT(inout) :: error 01485 01486 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_goodwin_clean', 01487 routineP = moduleN//':'//routineN 01488 01489 LOGICAL :: failure 01490 01491 failure = .FALSE. 01492 IF (.NOT.failure) THEN 01493 IF(.NOT.ASSOCIATED(goodwin)) RETURN 01494 goodwin%vr0 = 0.0_dp 01495 goodwin%d = 0.0_dp 01496 goodwin%dc = 0.0_dp 01497 goodwin%m = 0.0_dp 01498 goodwin%mc = 0.0_dp 01499 END IF 01500 END SUBROUTINE pair_potential_goodwin_clean 01501 01502 ! ***************************************************************************** 01506 SUBROUTINE pair_potential_goodwin_release(goodwin, error) 01507 TYPE(goodwin_pot_type), POINTER :: goodwin 01508 TYPE(cp_error_type), INTENT(inout) :: error 01509 01510 CHARACTER(LEN=*), PARAMETER :: 01511 routineN = 'pair_potential_goodwin_release', 01512 routineP = moduleN//':'//routineN 01513 01514 INTEGER :: stat 01515 LOGICAL :: failure 01516 01517 failure = .FALSE. 01518 IF (.NOT.failure) THEN 01519 IF (ASSOCIATED(goodwin)) THEN 01520 DEALLOCATE(goodwin, stat=stat) 01521 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01522 END IF 01523 NULLIFY(goodwin) 01524 END IF 01525 END SUBROUTINE pair_potential_goodwin_release 01526 01527 ! ***************************************************************************** 01531 SUBROUTINE pair_potential_eam_create(eam, error) 01532 TYPE(eam_pot_type), POINTER :: eam 01533 TYPE(cp_error_type), INTENT(inout) :: error 01534 01535 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_eam_create', 01536 routineP = moduleN//':'//routineN 01537 01538 INTEGER :: stat 01539 LOGICAL :: failure 01540 01541 failure = .FALSE. 01542 IF (.NOT.failure) THEN 01543 CPPostcondition(.NOT.ASSOCIATED(eam),cp_failure_level,routineP,error,failure) 01544 ALLOCATE(eam, stat=stat) 01545 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01546 NULLIFY(eam%rho, eam%phi, eam%frho, eam%rhoval, eam%rval,& 01547 eam%rhop, eam%phip, eam%frhop) 01548 CALL pair_potential_eam_clean(eam, error=error) 01549 END IF 01550 END SUBROUTINE pair_potential_eam_create 01551 01552 ! ***************************************************************************** 01556 SUBROUTINE pair_potential_eam_copy(eam_source, eam_dest, error) 01557 TYPE(eam_pot_type), POINTER :: eam_source, eam_dest 01558 TYPE(cp_error_type), INTENT(inout) :: error 01559 01560 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_eam_copy', 01561 routineP = moduleN//':'//routineN 01562 01563 LOGICAL :: failure 01564 01565 failure = .FALSE. 01566 IF (.NOT.failure) THEN 01567 IF (.NOT.ASSOCIATED(eam_source)) RETURN 01568 IF (ASSOCIATED(eam_dest)) CALL pair_potential_eam_release(eam_dest, error=error) 01569 CALL pair_potential_eam_create(eam_dest, error=error) 01570 eam_dest%eam_file_name = eam_source%eam_file_name 01571 eam_dest%drar = eam_source%drar 01572 eam_dest%drhoar = eam_source%drhoar 01573 eam_dest%acutal = eam_source%acutal 01574 eam_dest%npoints = eam_source%npoints 01575 ! Allocate arrays with the proper size 01576 CALL reallocate(eam_dest%rho, 1, eam_dest%npoints) 01577 CALL reallocate(eam_dest%rhop, 1, eam_dest%npoints) 01578 CALL reallocate(eam_dest%phi, 1, eam_dest%npoints) 01579 CALL reallocate(eam_dest%phip, 1, eam_dest%npoints) 01580 CALL reallocate(eam_dest%frho, 1, eam_dest%npoints) 01581 CALL reallocate(eam_dest%frhop, 1, eam_dest%npoints) 01582 CALL reallocate(eam_dest%rval, 1, eam_dest%npoints) 01583 CALL reallocate(eam_dest%rhoval,1, eam_dest%npoints) 01584 eam_dest%rho = eam_source%rho 01585 eam_dest%phi = eam_source%phi 01586 eam_dest%frho = eam_source%frho 01587 eam_dest%rhoval = eam_source%rhoval 01588 eam_dest%rval = eam_source%rval 01589 eam_dest%rhop = eam_source%rhop 01590 eam_dest%phip = eam_source%phip 01591 eam_dest%frhop = eam_source%frhop 01592 END IF 01593 END SUBROUTINE pair_potential_eam_copy 01594 01595 ! ***************************************************************************** 01599 SUBROUTINE pair_potential_eam_clean(eam, error) 01600 TYPE(eam_pot_type), POINTER :: eam 01601 TYPE(cp_error_type), INTENT(inout) :: error 01602 01603 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_eam_clean', 01604 routineP = moduleN//':'//routineN 01605 01606 LOGICAL :: failure 01607 01608 failure = .FALSE. 01609 IF (.NOT.failure) THEN 01610 IF(.NOT.ASSOCIATED(eam)) RETURN 01611 eam%eam_file_name = 'NULL' 01612 eam%drar = 0.0_dp 01613 eam%drhoar = 0.0_dp 01614 eam%acutal = 0.0_dp 01615 eam%npoints = 0 01616 CALL reallocate(eam%rho, 1, eam%npoints) 01617 CALL reallocate(eam%rhop, 1, eam%npoints) 01618 CALL reallocate(eam%phi, 1, eam%npoints) 01619 CALL reallocate(eam%phip, 1, eam%npoints) 01620 CALL reallocate(eam%frho, 1, eam%npoints) 01621 CALL reallocate(eam%frhop, 1, eam%npoints) 01622 CALL reallocate(eam%rval, 1, eam%npoints) 01623 CALL reallocate(eam%rhoval,1, eam%npoints) 01624 END IF 01625 END SUBROUTINE pair_potential_eam_clean 01626 01627 ! ***************************************************************************** 01631 SUBROUTINE pair_potential_eam_release(eam, error) 01632 TYPE(eam_pot_type), POINTER :: eam 01633 TYPE(cp_error_type), INTENT(inout) :: error 01634 01635 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_eam_release', 01636 routineP = moduleN//':'//routineN 01637 01638 INTEGER :: stat 01639 LOGICAL :: failure 01640 01641 failure = .FALSE. 01642 IF (.NOT.failure) THEN 01643 IF (ASSOCIATED(eam)) THEN 01644 IF (ASSOCIATED(eam%rho)) THEN 01645 DEALLOCATE(eam%rho, stat=stat) 01646 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01647 END IF 01648 IF (ASSOCIATED(eam%rhop)) THEN 01649 DEALLOCATE(eam%rhop, stat=stat) 01650 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01651 END IF 01652 IF (ASSOCIATED(eam%phi)) THEN 01653 DEALLOCATE(eam%phi, stat=stat) 01654 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01655 END IF 01656 IF (ASSOCIATED(eam%phip)) THEN 01657 DEALLOCATE(eam%phip, stat=stat) 01658 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01659 END IF 01660 IF (ASSOCIATED(eam%frho)) THEN 01661 DEALLOCATE(eam%frho, stat=stat) 01662 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01663 END IF 01664 IF (ASSOCIATED(eam%frhop)) THEN 01665 DEALLOCATE(eam%frhop, stat=stat) 01666 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01667 END IF 01668 IF (ASSOCIATED(eam%rval)) THEN 01669 DEALLOCATE(eam%rval, stat=stat) 01670 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01671 END IF 01672 IF (ASSOCIATED(eam%rhoval)) THEN 01673 DEALLOCATE(eam%rhoval, stat=stat) 01674 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01675 END IF 01676 DEALLOCATE(eam, stat=stat) 01677 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01678 END IF 01679 END IF 01680 END SUBROUTINE pair_potential_eam_release 01681 01682 ! ***************************************************************************** 01686 SUBROUTINE pair_potential_bmhft_create(ft, error) 01687 TYPE(ft_pot_type), POINTER :: ft 01688 TYPE(cp_error_type), INTENT(inout) :: error 01689 01690 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_bmhft_create', 01691 routineP = moduleN//':'//routineN 01692 01693 INTEGER :: stat 01694 LOGICAL :: failure 01695 01696 failure = .FALSE. 01697 IF (.NOT.failure) THEN 01698 CPPostcondition(.NOT.ASSOCIATED(ft),cp_failure_level,routineP,error,failure) 01699 ALLOCATE(ft, stat=stat) 01700 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01701 CALL pair_potential_bmhft_clean(ft, error=error) 01702 END IF 01703 END SUBROUTINE pair_potential_bmhft_create 01704 01705 ! ***************************************************************************** 01709 SUBROUTINE pair_potential_bmhft_copy(ft_source, ft_dest, error) 01710 TYPE(ft_pot_type), POINTER :: ft_source, ft_dest 01711 TYPE(cp_error_type), INTENT(inout) :: error 01712 01713 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_bmhft_copy', 01714 routineP = moduleN//':'//routineN 01715 01716 LOGICAL :: failure 01717 01718 failure = .FALSE. 01719 IF (.NOT.failure) THEN 01720 IF (.NOT.ASSOCIATED(ft_source)) RETURN 01721 IF (ASSOCIATED(ft_dest)) CALL pair_potential_bmhft_release(ft_dest, error=error) 01722 CALL pair_potential_bmhft_create(ft_dest, error=error) 01723 ft_dest%A = ft_source%A 01724 ft_dest%B = ft_source%B 01725 ft_dest%C = ft_source%C 01726 ft_dest%D = ft_source%D 01727 END IF 01728 END SUBROUTINE pair_potential_bmhft_copy 01729 01730 ! ***************************************************************************** 01734 SUBROUTINE pair_potential_bmhft_clean(ft, error) 01735 TYPE(ft_pot_type), POINTER :: ft 01736 TYPE(cp_error_type), INTENT(inout) :: error 01737 01738 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_bmhft_clean', 01739 routineP = moduleN//':'//routineN 01740 01741 LOGICAL :: failure 01742 01743 failure = .FALSE. 01744 IF (.NOT.failure) THEN 01745 IF(.NOT.ASSOCIATED(ft)) RETURN 01746 ft%A = 0.0_dp 01747 ft%B = 0.0_dp 01748 ft%C = 0.0_dp 01749 ft%D = 0.0_dp 01750 END IF 01751 END SUBROUTINE pair_potential_bmhft_clean 01752 01753 ! ***************************************************************************** 01757 SUBROUTINE pair_potential_bmhft_release(ft, error) 01758 TYPE(ft_pot_type), POINTER :: ft 01759 TYPE(cp_error_type), INTENT(inout) :: error 01760 01761 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_bmhft_release', 01762 routineP = moduleN//':'//routineN 01763 01764 INTEGER :: stat 01765 LOGICAL :: failure 01766 01767 failure = .FALSE. 01768 IF (.NOT.failure) THEN 01769 IF (ASSOCIATED(ft)) THEN 01770 DEALLOCATE(ft, stat=stat) 01771 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01772 END IF 01773 NULLIFY(ft) 01774 END IF 01775 END SUBROUTINE pair_potential_bmhft_release 01776 01777 ! ***************************************************************************** 01781 SUBROUTINE pair_potential_bmhftd_create(ftd, error) 01782 TYPE(ftd_pot_type), POINTER :: ftd 01783 TYPE(cp_error_type), INTENT(inout) :: error 01784 01785 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_bmhftd_create', 01786 routineP = moduleN//':'//routineN 01787 01788 INTEGER :: stat 01789 LOGICAL :: failure 01790 01791 failure = .FALSE. 01792 IF (.NOT.failure) THEN 01793 CPPostcondition(.NOT.ASSOCIATED(ftd),cp_failure_level,routineP,error,failure) 01794 ALLOCATE(ftd, stat=stat) 01795 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01796 CALL pair_potential_bmhftd_clean(ftd, error=error) 01797 END IF 01798 END SUBROUTINE pair_potential_bmhftd_create 01799 01800 ! ***************************************************************************** 01804 SUBROUTINE pair_potential_bmhftd_copy(ftd_source, ftd_dest, error) 01805 TYPE(ftd_pot_type), POINTER :: ftd_source, ftd_dest 01806 TYPE(cp_error_type), INTENT(inout) :: error 01807 01808 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_bmhftd_copy', 01809 routineP = moduleN//':'//routineN 01810 01811 LOGICAL :: failure 01812 01813 failure = .FALSE. 01814 IF (.NOT.failure) THEN 01815 IF (.NOT.ASSOCIATED(ftd_source)) RETURN 01816 IF (ASSOCIATED(ftd_dest)) CALL pair_potential_bmhftd_release(ftd_dest, error=error) 01817 CALL pair_potential_bmhftd_create(ftd_dest, error=error) 01818 ftd_dest%A = ftd_source%A 01819 ftd_dest%B = ftd_source%B 01820 ftd_dest%C = ftd_source%C 01821 ftd_dest%D = ftd_source%D 01822 ftd_dest%BD = ftd_source%BD 01823 END IF 01824 END SUBROUTINE pair_potential_bmhftd_copy 01825 01826 ! ***************************************************************************** 01830 SUBROUTINE pair_potential_bmhftd_clean(ftd, error) 01831 TYPE(ftd_pot_type), POINTER :: ftd 01832 TYPE(cp_error_type), INTENT(inout) :: error 01833 01834 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_bmhftd_clean', 01835 routineP = moduleN//':'//routineN 01836 01837 LOGICAL :: failure 01838 01839 failure = .FALSE. 01840 IF (.NOT.failure) THEN 01841 IF(.NOT.ASSOCIATED(ftd)) RETURN 01842 ftd%A = 0.0_dp 01843 ftd%B = 0.0_dp 01844 ftd%C = 0.0_dp 01845 ftd%D = 0.0_dp 01846 ftd%BD = 0.0_dp 01847 END IF 01848 END SUBROUTINE pair_potential_bmhftd_clean 01849 01850 ! ***************************************************************************** 01854 SUBROUTINE pair_potential_bmhftd_release(ftd, error) 01855 TYPE(ftd_pot_type), POINTER :: ftd 01856 TYPE(cp_error_type), INTENT(inout) :: error 01857 01858 CHARACTER(LEN=*), PARAMETER :: 01859 routineN = 'pair_potential_bmhftd_release', 01860 routineP = moduleN//':'//routineN 01861 01862 INTEGER :: stat 01863 LOGICAL :: failure 01864 01865 failure = .FALSE. 01866 IF (.NOT.failure) THEN 01867 IF (ASSOCIATED(ftd)) THEN 01868 DEALLOCATE(ftd, stat=stat) 01869 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01870 END IF 01871 NULLIFY(ftd) 01872 END IF 01873 END SUBROUTINE pair_potential_bmhftd_release 01874 01875 ! ***************************************************************************** 01879 SUBROUTINE pair_potential_ipbv_create(ipbv, error) 01880 TYPE(ipbv_pot_type), POINTER :: ipbv 01881 TYPE(cp_error_type), INTENT(inout) :: error 01882 01883 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_ipbv_create', 01884 routineP = moduleN//':'//routineN 01885 01886 INTEGER :: stat 01887 LOGICAL :: failure 01888 01889 failure = .FALSE. 01890 IF (.NOT.failure) THEN 01891 CPPostcondition(.NOT.ASSOCIATED(ipbv),cp_failure_level,routineP,error,failure) 01892 ALLOCATE(ipbv, stat=stat) 01893 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01894 CALL pair_potential_ipbv_clean(ipbv, error=error) 01895 END IF 01896 END SUBROUTINE pair_potential_ipbv_create 01897 01898 ! ***************************************************************************** 01902 SUBROUTINE pair_potential_ipbv_copy(ipbv_source, ipbv_dest, error) 01903 TYPE(ipbv_pot_type), POINTER :: ipbv_source, ipbv_dest 01904 TYPE(cp_error_type), INTENT(inout) :: error 01905 01906 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_ipbv_copy', 01907 routineP = moduleN//':'//routineN 01908 01909 LOGICAL :: failure 01910 01911 failure = .FALSE. 01912 IF (.NOT.failure) THEN 01913 IF (.NOT.ASSOCIATED(ipbv_source)) RETURN 01914 IF (ASSOCIATED(ipbv_dest)) CALL pair_potential_ipbv_release(ipbv_dest, error=error) 01915 CALL pair_potential_ipbv_create(ipbv_dest, error=error) 01916 ipbv_dest%a = ipbv_source%a 01917 ipbv_dest%rcore = ipbv_source%rcore 01918 ipbv_dest%b = ipbv_source%b 01919 ipbv_dest%m = ipbv_source%m 01920 END IF 01921 END SUBROUTINE pair_potential_ipbv_copy 01922 01923 ! ***************************************************************************** 01927 SUBROUTINE pair_potential_ipbv_clean(ipbv, error) 01928 TYPE(ipbv_pot_type), POINTER :: ipbv 01929 TYPE(cp_error_type), INTENT(inout) :: error 01930 01931 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_ipbv_clean', 01932 routineP = moduleN//':'//routineN 01933 01934 LOGICAL :: failure 01935 01936 failure = .FALSE. 01937 IF (.NOT.failure) THEN 01938 IF(.NOT.ASSOCIATED(ipbv)) RETURN 01939 ipbv%a = 0.0_dp 01940 ipbv%rcore = 0.0_dp 01941 ipbv%b = 0.0_dp 01942 ipbv%m = 0.0_dp 01943 END IF 01944 END SUBROUTINE pair_potential_ipbv_clean 01945 01946 ! ***************************************************************************** 01950 SUBROUTINE pair_potential_ipbv_release(ipbv, error) 01951 TYPE(ipbv_pot_type), POINTER :: ipbv 01952 TYPE(cp_error_type), INTENT(inout) :: error 01953 01954 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_ipbv_release', 01955 routineP = moduleN//':'//routineN 01956 01957 INTEGER :: stat 01958 LOGICAL :: failure 01959 01960 failure = .FALSE. 01961 IF (.NOT.failure) THEN 01962 IF (ASSOCIATED(ipbv)) THEN 01963 DEALLOCATE(ipbv, stat=stat) 01964 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01965 END IF 01966 NULLIFY(ipbv) 01967 END IF 01968 END SUBROUTINE pair_potential_ipbv_release 01969 01970 ! ***************************************************************************** 01974 SUBROUTINE pair_potential_buck4r_create(buck4r, error) 01975 TYPE(buck4ran_pot_type), POINTER :: buck4r 01976 TYPE(cp_error_type), INTENT(inout) :: error 01977 01978 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_buck4r_create', 01979 routineP = moduleN//':'//routineN 01980 01981 INTEGER :: stat 01982 LOGICAL :: failure 01983 01984 failure = .FALSE. 01985 IF (.NOT.failure) THEN 01986 CPPostcondition(.NOT.ASSOCIATED(buck4r),cp_failure_level,routineP,error,failure) 01987 ALLOCATE(buck4r, stat=stat) 01988 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 01989 CALL pair_potential_buck4r_clean(buck4r, error=error) 01990 END IF 01991 END SUBROUTINE pair_potential_buck4r_create 01992 01993 ! ***************************************************************************** 01997 SUBROUTINE pair_potential_buck4r_copy(buck4r_source, buck4r_dest, error) 01998 TYPE(buck4ran_pot_type), POINTER :: buck4r_source, buck4r_dest 01999 TYPE(cp_error_type), INTENT(inout) :: error 02000 02001 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_buck4r_copy', 02002 routineP = moduleN//':'//routineN 02003 02004 LOGICAL :: failure 02005 02006 failure = .FALSE. 02007 IF (.NOT.failure) THEN 02008 IF (.NOT.ASSOCIATED(buck4r_source)) RETURN 02009 IF (ASSOCIATED(buck4r_dest)) CALL pair_potential_buck4r_release(buck4r_dest, error=error) 02010 CALL pair_potential_buck4r_create(buck4r_dest, error=error) 02011 buck4r_dest%a = buck4r_source%a 02012 buck4r_dest%b = buck4r_source%b 02013 buck4r_dest%c = buck4r_source%c 02014 buck4r_dest%r1 = buck4r_source%r1 02015 buck4r_dest%r2 = buck4r_source%r2 02016 buck4r_dest%r3 = buck4r_source%r3 02017 buck4r_dest%poly1 = buck4r_source%poly1 02018 buck4r_dest%poly2 = buck4r_source%poly2 02019 buck4r_dest%npoly1 = buck4r_source%npoly1 02020 buck4r_dest%npoly2 = buck4r_source%npoly2 02021 END IF 02022 END SUBROUTINE pair_potential_buck4r_copy 02023 02024 ! ***************************************************************************** 02028 SUBROUTINE pair_potential_buck4r_clean(buck4r, error) 02029 TYPE(buck4ran_pot_type), POINTER :: buck4r 02030 TYPE(cp_error_type), INTENT(inout) :: error 02031 02032 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_buck4r_clean', 02033 routineP = moduleN//':'//routineN 02034 02035 LOGICAL :: failure 02036 02037 failure = .FALSE. 02038 IF (.NOT.failure) THEN 02039 IF(.NOT.ASSOCIATED(buck4r)) RETURN 02040 buck4r%a = 0.0_dp 02041 buck4r%b = 0.0_dp 02042 buck4r%c = 0.0_dp 02043 buck4r%r1 = 0.0_dp 02044 buck4r%r2 = 0.0_dp 02045 buck4r%r3 = 0.0_dp 02046 buck4r%poly1 = 0.0_dp 02047 buck4r%npoly1 = 0 02048 buck4r%poly2 = 0.0_dp 02049 buck4r%npoly2 = 0 02050 END IF 02051 END SUBROUTINE pair_potential_buck4r_clean 02052 02053 ! ***************************************************************************** 02057 SUBROUTINE pair_potential_buck4r_release(buck4r, error) 02058 TYPE(buck4ran_pot_type), POINTER :: buck4r 02059 TYPE(cp_error_type), INTENT(inout) :: error 02060 02061 CHARACTER(LEN=*), PARAMETER :: 02062 routineN = 'pair_potential_buck4r_release', 02063 routineP = moduleN//':'//routineN 02064 02065 INTEGER :: stat 02066 LOGICAL :: failure 02067 02068 failure = .FALSE. 02069 IF (.NOT.failure) THEN 02070 IF (ASSOCIATED(buck4r)) THEN 02071 DEALLOCATE(buck4r, stat=stat) 02072 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 02073 END IF 02074 NULLIFY(buck4r) 02075 END IF 02076 END SUBROUTINE pair_potential_buck4r_release 02077 02078 ! ***************************************************************************** 02082 SUBROUTINE pair_potential_buckmo_create(buckmo, error) 02083 TYPE(buckmorse_pot_type), POINTER :: buckmo 02084 TYPE(cp_error_type), INTENT(inout) :: error 02085 02086 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_buckmo_create', 02087 routineP = moduleN//':'//routineN 02088 02089 INTEGER :: stat 02090 LOGICAL :: failure 02091 02092 failure = .FALSE. 02093 IF (.NOT.failure) THEN 02094 CPPostcondition(.NOT.ASSOCIATED(buckmo),cp_failure_level,routineP,error,failure) 02095 ALLOCATE(buckmo, stat=stat) 02096 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 02097 CALL pair_potential_buckmo_clean(buckmo, error=error) 02098 END IF 02099 END SUBROUTINE pair_potential_buckmo_create 02100 02101 ! ***************************************************************************** 02105 SUBROUTINE pair_potential_buckmo_copy(buckmo_source, buckmo_dest, error) 02106 TYPE(buckmorse_pot_type), POINTER :: buckmo_source, buckmo_dest 02107 TYPE(cp_error_type), INTENT(inout) :: error 02108 02109 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_buckmo_copy', 02110 routineP = moduleN//':'//routineN 02111 02112 LOGICAL :: failure 02113 02114 failure = .FALSE. 02115 IF (.NOT.failure) THEN 02116 IF (.NOT.ASSOCIATED(buckmo_source)) RETURN 02117 IF (ASSOCIATED(buckmo_dest)) CALL pair_potential_buckmo_release(buckmo_dest, error=error) 02118 CALL pair_potential_buckmo_create(buckmo_dest, error=error) 02119 buckmo_dest%f0 = buckmo_source%f0 02120 buckmo_dest%a1 = buckmo_source%a1 02121 buckmo_dest%a2 = buckmo_source%a2 02122 buckmo_dest%b1 = buckmo_source%b1 02123 buckmo_dest%b2 = buckmo_source%b2 02124 buckmo_dest%c = buckmo_source%c 02125 buckmo_dest%d = buckmo_source%d 02126 buckmo_dest%r0 = buckmo_source%r0 02127 buckmo_dest%beta = buckmo_source%beta 02128 END IF 02129 END SUBROUTINE pair_potential_buckmo_copy 02130 02131 ! ***************************************************************************** 02135 SUBROUTINE pair_potential_buckmo_clean(buckmo, error) 02136 TYPE(buckmorse_pot_type), POINTER :: buckmo 02137 TYPE(cp_error_type), INTENT(inout) :: error 02138 02139 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_buckmo_clean', 02140 routineP = moduleN//':'//routineN 02141 02142 LOGICAL :: failure 02143 02144 failure = .FALSE. 02145 IF (.NOT.failure) THEN 02146 IF(.NOT.ASSOCIATED(buckmo)) RETURN 02147 buckmo%f0 = 0.0_dp 02148 buckmo%a1 = 0.0_dp 02149 buckmo%a2 = 0.0_dp 02150 buckmo%b1 = 0.0_dp 02151 buckmo%b2 = 0.0_dp 02152 buckmo%c = 0.0_dp 02153 buckmo%d = 0.0_dp 02154 buckmo%r0 = 0.0_dp 02155 buckmo%beta = 0.0_dp 02156 END IF 02157 END SUBROUTINE pair_potential_buckmo_clean 02158 02159 ! ***************************************************************************** 02163 SUBROUTINE pair_potential_buckmo_release(buckmo, error) 02164 TYPE(buckmorse_pot_type), POINTER :: buckmo 02165 TYPE(cp_error_type), INTENT(inout) :: error 02166 02167 CHARACTER(LEN=*), PARAMETER :: 02168 routineN = 'pair_potential_buckmo_release', 02169 routineP = moduleN//':'//routineN 02170 02171 INTEGER :: stat 02172 LOGICAL :: failure 02173 02174 failure = .FALSE. 02175 IF (.NOT.failure) THEN 02176 IF (ASSOCIATED(buckmo)) THEN 02177 DEALLOCATE(buckmo, stat=stat) 02178 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 02179 END IF 02180 NULLIFY(buckmo) 02181 END IF 02182 END SUBROUTINE pair_potential_buckmo_release 02183 02184 ! ***************************************************************************** 02188 SUBROUTINE pair_potential_tersoff_create(tersoff, error) 02189 TYPE(tersoff_pot_type), POINTER :: tersoff 02190 TYPE(cp_error_type), INTENT(inout) :: error 02191 02192 CHARACTER(LEN=*), PARAMETER :: 02193 routineN = 'pair_potential_tersoff_create', 02194 routineP = moduleN//':'//routineN 02195 02196 INTEGER :: stat 02197 LOGICAL :: failure 02198 02199 failure = .FALSE. 02200 IF (.NOT.failure) THEN 02201 CPPostcondition(.NOT.ASSOCIATED(tersoff),cp_failure_level,routineP,error,failure) 02202 ALLOCATE(tersoff, stat=stat) 02203 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 02204 CALL pair_potential_tersoff_clean(tersoff, error=error) 02205 END IF 02206 END SUBROUTINE pair_potential_tersoff_create 02207 02208 ! ***************************************************************************** 02212 SUBROUTINE pair_potential_tersoff_copy(tersoff_source, tersoff_dest, error) 02213 TYPE(tersoff_pot_type), POINTER :: tersoff_source, tersoff_dest 02214 TYPE(cp_error_type), INTENT(inout) :: error 02215 02216 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_tersoff_copy', 02217 routineP = moduleN//':'//routineN 02218 02219 LOGICAL :: failure 02220 02221 failure = .FALSE. 02222 IF (.NOT.failure) THEN 02223 IF (.NOT.ASSOCIATED(tersoff_source)) RETURN 02224 IF (ASSOCIATED(tersoff_dest)) CALL pair_potential_tersoff_release(tersoff_dest, error=error) 02225 CALL pair_potential_tersoff_create(tersoff_dest, error=error) 02226 tersoff_dest%A = tersoff_source%A 02227 tersoff_dest%B = tersoff_source%B 02228 tersoff_dest%lambda1 = tersoff_source%lambda1 02229 tersoff_dest%lambda2 = tersoff_source%lambda2 02230 tersoff_dest%alpha = tersoff_source%alpha 02231 tersoff_dest%beta = tersoff_source%beta 02232 tersoff_dest%n = tersoff_source%n 02233 tersoff_dest%c = tersoff_source%c 02234 tersoff_dest%d = tersoff_source%d 02235 tersoff_dest%h = tersoff_source%h 02236 tersoff_dest%lambda3 = tersoff_source%lambda3 02237 tersoff_dest%bigR = tersoff_source%bigR 02238 tersoff_dest%bigD = tersoff_source%bigD 02239 tersoff_dest%rcutsq = tersoff_source%rcutsq 02240 END IF 02241 END SUBROUTINE pair_potential_tersoff_copy 02242 02243 ! ***************************************************************************** 02247 SUBROUTINE pair_potential_tersoff_clean(tersoff, error) 02248 TYPE(tersoff_pot_type), POINTER :: tersoff 02249 TYPE(cp_error_type), INTENT(inout) :: error 02250 02251 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_tersoff_clean', 02252 routineP = moduleN//':'//routineN 02253 02254 LOGICAL :: failure 02255 02256 failure = .FALSE. 02257 IF (.NOT.failure) THEN 02258 IF(.NOT.ASSOCIATED(tersoff)) RETURN 02259 tersoff%A = 0.0_dp 02260 tersoff%B = 0.0_dp 02261 tersoff%lambda1 = 0.0_dp 02262 tersoff%lambda2 = 0.0_dp 02263 tersoff%alpha = 0.0_dp 02264 tersoff%beta = 0.0_dp 02265 tersoff%n = 0.0_dp 02266 tersoff%c = 0.0_dp 02267 tersoff%d = 0.0_dp 02268 tersoff%h = 0.0_dp 02269 tersoff%lambda3 = 0.0_dp 02270 tersoff%bigR = 0.0_dp 02271 tersoff%bigD = 0.0_dp 02272 tersoff%rcutsq = 0.0_dp 02273 END IF 02274 END SUBROUTINE pair_potential_tersoff_clean 02275 02276 ! ***************************************************************************** 02280 SUBROUTINE pair_potential_tersoff_release(tersoff, error) 02281 TYPE(tersoff_pot_type), POINTER :: tersoff 02282 TYPE(cp_error_type), INTENT(inout) :: error 02283 02284 CHARACTER(LEN=*), PARAMETER :: 02285 routineN = 'pair_potential_tersoff_release', 02286 routineP = moduleN//':'//routineN 02287 02288 INTEGER :: stat 02289 LOGICAL :: failure 02290 02291 failure = .FALSE. 02292 IF (.NOT.failure) THEN 02293 IF (ASSOCIATED(tersoff)) THEN 02294 DEALLOCATE(tersoff, stat=stat) 02295 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 02296 END IF 02297 NULLIFY(tersoff) 02298 END IF 02299 END SUBROUTINE pair_potential_tersoff_release 02300 02301 ! ***************************************************************************** 02305 SUBROUTINE pair_potential_siepmann_create(siepmann, error) 02306 TYPE(siepmann_pot_type), POINTER :: siepmann 02307 TYPE(cp_error_type), INTENT(inout) :: error 02308 02309 CHARACTER(LEN=*), PARAMETER :: 02310 routineN = 'pair_potential_siepmann_create', 02311 routineP = moduleN//':'//routineN 02312 02313 INTEGER :: stat 02314 LOGICAL :: failure 02315 02316 failure = .FALSE. 02317 IF (.NOT.failure) THEN 02318 CPPostcondition(.NOT.ASSOCIATED(siepmann),cp_failure_level,routineP,error,failure) 02319 ALLOCATE(siepmann, stat=stat) 02320 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 02321 CALL pair_potential_siepmann_clean(siepmann, error=error) 02322 END IF 02323 END SUBROUTINE pair_potential_siepmann_create 02324 ! ***************************************************************************** 02328 SUBROUTINE pair_potential_siepmann_copy(siepmann_source, siepmann_dest, error) 02329 TYPE(siepmann_pot_type), POINTER :: siepmann_source, siepmann_dest 02330 TYPE(cp_error_type), INTENT(inout) :: error 02331 02332 CHARACTER(LEN=*), PARAMETER :: routineN = 'pair_potential_siepmann_copy', 02333 routineP = moduleN//':'//routineN 02334 02335 LOGICAL :: failure 02336 02337 failure = .FALSE. 02338 IF (.NOT.failure) THEN 02339 IF (.NOT.ASSOCIATED(siepmann_source)) RETURN 02340 IF (ASSOCIATED(siepmann_dest)) CALL pair_potential_siepmann_release(siepmann_dest, error=error) 02341 CALL pair_potential_siepmann_create(siepmann_dest, error=error) 02342 siepmann_dest%B = siepmann_source%B 02343 siepmann_dest%D = siepmann_source%D 02344 siepmann_dest%E = siepmann_source%E 02345 siepmann_dest%F = siepmann_source%F 02346 siepmann_dest%alpha = siepmann_source%alpha 02347 siepmann_dest%beta = siepmann_source%beta 02348 siepmann_dest%rcutsq = siepmann_source%rcutsq 02349 END IF 02350 END SUBROUTINE pair_potential_siepmann_copy 02351 02352 ! ***************************************************************************** 02356 SUBROUTINE pair_potential_siepmann_clean(siepmann, error) 02357 TYPE(siepmann_pot_type), POINTER :: siepmann 02358 TYPE(cp_error_type), INTENT(inout) :: error 02359 02360 CHARACTER(LEN=*), PARAMETER :: 02361 routineN = 'pair_potential_siepmann_clean', 02362 routineP = moduleN//':'//routineN 02363 02364 LOGICAL :: failure 02365 02366 failure = .FALSE. 02367 IF (.NOT.failure) THEN 02368 IF(.NOT.ASSOCIATED(siepmann)) RETURN 02369 siepmann%B = 0.0_dp 02370 siepmann%D = 0.0_dp 02371 siepmann%E = 0.0_dp 02372 siepmann%F = 0.0_dp 02373 siepmann%alpha = 0.0_dp 02374 siepmann%beta = 0.0_dp 02375 siepmann%rcutsq = 0.0_dp 02376 END IF 02377 END SUBROUTINE pair_potential_siepmann_clean 02378 02379 ! ***************************************************************************** 02383 SUBROUTINE pair_potential_siepmann_release(siepmann, error) 02384 TYPE(siepmann_pot_type), POINTER :: siepmann 02385 TYPE(cp_error_type), INTENT(inout) :: error 02386 02387 CHARACTER(LEN=*), PARAMETER :: 02388 routineN = 'pair_potential_siepmann_release', 02389 routineP = moduleN//':'//routineN 02390 02391 INTEGER :: stat 02392 LOGICAL :: failure 02393 02394 failure = .FALSE. 02395 IF (.NOT.failure) THEN 02396 IF (ASSOCIATED(siepmann)) THEN 02397 DEALLOCATE(siepmann, stat=stat) 02398 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 02399 END IF 02400 NULLIFY(siepmann) 02401 END IF 02402 END SUBROUTINE pair_potential_siepmann_release 02403 02404 END MODULE pair_potential_types 02405
1.7.3