|
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 ! ***************************************************************************** 00013 MODULE hfx_libint_wrapper 00014 00015 #if defined (__LIBINT) 00016 00017 #if !defined (__HAS_NO_ISO_C_BINDING) 00018 #if !defined (__HAS_ISO_C_BINDING) 00019 #define __HAS_ISO_C_BINDING 00020 #endif 00021 #endif 00022 00023 #if defined (__HAS_ISO_C_BINDING) 00024 USE, INTRINSIC :: ISO_C_BINDING 00025 #endif 00026 #endif 00027 00028 USE kinds, ONLY: dp 00029 USE mathconstants 00030 USE hfx_libint_wrapper_types 00031 USE orbital_pointers 00032 00033 USE f77_blas 00034 #include "cp_common_uses.h" 00035 00036 IMPLICIT NONE 00037 PRIVATE 00038 PUBLIC initialize_libint, terminate_libint,& 00039 initialize_libderiv, & 00040 get_eris, get_derivs, terminate_libderiv 00041 00042 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'hfx_libint_wrapper' 00043 00044 #if defined (__LIBINT) 00045 00046 !****************************************************************************! 00047 !****************************************************************************! 00048 !*** ***! 00049 !*** WHAT FOLLOWS IS CODE FOR COMPILERS THAT EITHER FULLY SUPPORT THE ***! 00050 !*** ISO_C_BINDING FORTRAN 2003 STANDARD OR NOT. IF NOT, ALL CALLS TO ***! 00051 !*** LIBINT ARE REDIRECTED TO A C++ WRAPPER ***! 00052 !*** ***! 00053 !****************************************************************************! 00054 !****************************************************************************! 00055 00056 #if defined (__HAS_ISO_C_BINDING) 00057 TYPE(C_FUNPTR), DIMENSION(0:build_eri_size,0:build_eri_size,0:build_eri_size,0:build_eri_size), BIND(C) :: build_eri 00058 TYPE(C_FUNPTR), DIMENSION(0:build_deriv1_eri_size,0:build_deriv1_eri_size,& 0:build_deriv1_eri_size,0:build_deriv1_eri_size), BIND(C) :: build_deriv1_eri 00059 00060 INTERFACE 00061 FUNCTION build(lib, np) BIND(C) 00062 USE hfx_libint_wrapper_types 00063 USE, INTRINSIC :: ISO_C_BINDING 00064 TYPE(C_PTR) :: build 00065 TYPE(lib_int) :: lib 00066 INTEGER(KIND=C_INT), VALUE :: np 00067 END FUNCTION build 00068 00069 FUNCTION init_lib(lib, max_am, np) BIND(C, name="init_libint") 00070 USE hfx_libint_wrapper_types 00071 USE, INTRINSIC :: ISO_C_BINDING 00072 INTEGER(KIND=C_INT) :: init_lib 00073 TYPE(lib_int) :: lib 00074 INTEGER(KIND=C_INT), VALUE :: max_am 00075 INTEGER(KIND=C_INT), VALUE :: np 00076 END FUNCTION init_lib 00077 00078 SUBROUTINE init_base() BIND(C, name="init_libint_base") 00079 END SUBROUTINE init_base 00080 00081 SUBROUTINE free_lib_int(lib) BIND(C, name="free_libint") 00082 USE hfx_libint_wrapper_types 00083 USE, INTRINSIC :: ISO_C_BINDING 00084 TYPE(lib_int) :: lib 00085 END SUBROUTINE free_lib_int 00086 00087 SUBROUTINE init_deriv_base() BIND(C, name="init_libderiv_base") 00088 END SUBROUTINE init_deriv_base 00089 00090 FUNCTION init_deriv1(deriv, max_am, np, ccs) BIND(C, name="init_libderiv1") 00091 USE hfx_libint_wrapper_types 00092 USE, INTRINSIC :: ISO_C_BINDING 00093 INTEGER(KIND=C_INT) :: init_deriv1 00094 TYPE(lib_deriv) :: deriv 00095 INTEGER(KIND=C_INT), VALUE :: max_am 00096 INTEGER(KIND=C_INT), VALUE :: np 00097 INTEGER(KIND=C_INT), VALUE :: ccs 00098 END FUNCTION init_deriv1 00099 00100 SUBROUTINE build_deriv1(deriv, np) BIND(C) 00101 USE hfx_libint_wrapper_types 00102 USE, INTRINSIC :: ISO_C_BINDING 00103 TYPE(lib_deriv) :: deriv 00104 INTEGER(KIND=C_INT),VALUE :: np 00105 END SUBROUTINE build_deriv1 00106 00107 SUBROUTINE free_lib_deriv(deriv) BIND(C, name="free_libderiv") 00108 USE hfx_libint_wrapper_types 00109 USE, INTRINSIC :: ISO_C_BINDING 00110 TYPE(lib_deriv) :: deriv 00111 END SUBROUTINE free_lib_deriv 00112 END INTERFACE 00113 #endif 00114 00115 CONTAINS 00116 00117 SUBROUTINE initialize_libint(lib,max_am,error) 00118 TYPE(lib_int) :: lib 00119 INTEGER :: max_am 00120 TYPE(cp_error_type), INTENT(inout) :: error 00121 00122 CHARACTER(LEN=*), PARAMETER :: routineN = 'initialize_libint', 00123 routineP = moduleN//':'//routineN 00124 00125 LOGICAL :: failure 00126 #if defined (__HAS_ISO_C_BINDING) 00127 INTEGER(KIND=C_INT) :: lib_storage, max_am_local, 00128 max_prim 00129 #else 00130 INTEGER :: lib_storage, max_am_local, 00131 max_prim 00132 EXTERNAL wrapper_init_lib 00133 #endif 00134 00135 failure = .FALSE. 00136 max_am_local= max_am 00137 max_prim = 1 00138 #if defined (__HAS_ISO_C_BINDING) 00139 CALL init_base() 00140 lib_storage = init_lib(lib, max_am_local, max_prim) 00141 #else 00142 CALL wrapper_init_lib(lib, max_am_local, max_prim, lib_storage) 00143 #endif 00144 00145 IF (lib_storage<0) THEN 00146 CALL cp_assert( .FALSE. , cp_failure_level,cp_assertion_failed,routineP,& 00147 " the angular momentum needed exceeds the value assumed when configuring libint ", & 00148 error,failure) 00149 ENDIF 00150 END SUBROUTINE initialize_libint 00151 00152 SUBROUTINE initialize_libderiv(deriv,max_am,error) 00153 TYPE(lib_deriv) :: deriv 00154 INTEGER :: max_am 00155 TYPE(cp_error_type), INTENT(inout) :: error 00156 00157 CHARACTER(LEN=*), PARAMETER :: routineN = 'initialize_libderiv', 00158 routineP = moduleN//':'//routineN 00159 LOGICAL :: failure 00160 #if defined (__HAS_ISO_C_BINDING) 00161 INTEGER(KIND=C_INT) :: lib_deriv_storage, 00162 max_am_local, max_classes, 00163 max_prim 00164 #else 00165 INTEGER :: lib_deriv_storage, 00166 max_am_local, max_classes, 00167 max_prim 00168 EXTERNAL wrapper_init_deriv 00169 #endif 00170 00171 failure = .FALSE. 00172 max_am_local= max_am 00173 max_prim = 1 00174 max_classes = nco(max_am)**4 00175 00176 #if defined (__HAS_ISO_C_BINDING) 00177 CALL init_deriv_base() 00178 lib_deriv_storage = init_deriv1(deriv, max_am_local, max_prim, max_classes) 00179 #else 00180 CALL wrapper_init_deriv(deriv, max_am_local, max_prim, max_classes, lib_deriv_storage) 00181 #endif 00182 IF (lib_deriv_storage<0) THEN 00183 CALL cp_assert( .FALSE. , cp_failure_level,cp_assertion_failed,routineP,& 00184 " the angular momentum needed exceeds the value assumed when configuring libderiv ", & 00185 error,failure) 00186 ENDIF 00187 END SUBROUTINE initialize_libderiv 00188 00189 SUBROUTINE terminate_libint(lib) 00190 TYPE(lib_int) :: lib 00191 #if defined (__HAS_ISO_C_BINDING) 00192 CALL free_lib_int(lib) 00193 #else 00194 EXTERNAL wrapper_free_libint 00195 CALL wrapper_free_libint(lib) 00196 #endif 00197 END SUBROUTINE terminate_libint 00198 00199 SUBROUTINE terminate_libderiv(deriv) 00200 TYPE(lib_deriv) :: deriv 00201 00202 #if defined (__HAS_ISO_C_BINDING) 00203 CALL free_lib_deriv(deriv) 00204 #else 00205 EXTERNAL wrapper_free_libderiv 00206 CALL wrapper_free_libderiv(deriv) 00207 #endif 00208 END SUBROUTINE terminate_libderiv 00209 00210 SUBROUTINE get_eris(n_d, n_c, n_b, n_a, lib, prim, p_work, a_mysize) 00211 INTEGER, INTENT(IN) :: n_d, n_c, n_b, n_a 00212 TYPE(lib_int) :: lib 00213 TYPE(prim_data), TARGET :: prim 00214 REAL(dp), DIMENSION(:), POINTER :: p_work 00215 INTEGER :: a_mysize(1) 00216 00217 #if defined (__HAS_ISO_C_BINDING) 00218 PROCEDURE(build), POINTER :: pbuild 00219 TYPE(C_PTR) :: pc_result 00220 REAL(dp), DIMENSION(:), POINTER :: p_tmp 00221 #else 00222 EXTERNAL wrapper_build_eri 00223 #endif 00224 00225 #if defined (__HAS_ISO_C_BINDING) 00226 lib%PrimQuartet = C_LOC(prim) 00227 CALL C_F_PROCPOINTER(build_eri(n_d,n_c,n_b,n_a),pbuild) 00228 pc_result = pbuild(lib,1) 00229 CALL C_F_POINTER(pc_result, p_tmp, a_mysize) 00230 p_work => p_tmp 00231 #else 00232 CALL wrapper_build_eri(n_a, n_b, n_c, n_d, lib, a_mysize(1), p_work(1), prim) 00233 #endif 00234 END SUBROUTINE get_eris 00235 00236 SUBROUTINE get_derivs(n_d, n_c, n_b, n_a, deriv, prim, work_forces, a_mysize) 00237 INTEGER, INTENT(IN) :: n_d, n_c, n_b, n_a 00238 TYPE(lib_deriv) :: deriv 00239 TYPE(prim_data), TARGET :: prim 00240 REAL(dp), DIMENSION(nco(n_a)*nco(n_b)*& nco(n_c)*nco(n_d), 12) :: work_forces 00241 INTEGER :: a_mysize(1) 00242 00243 #if defined (__HAS_ISO_C_BINDING) 00244 PROCEDURE(build_deriv1), POINTER :: pbuild_deriv1 00245 TYPE(C_PTR) :: pc_result 00246 REAL(C_DOUBLE), DIMENSION(:), POINTER :: tmp_data 00247 #else 00248 EXTERNAL wrapper_build_deriv1_eri 00249 #endif 00250 INTEGER :: i, k 00251 00252 #if defined (__HAS_ISO_C_BINDING) 00253 deriv%PrimQuartet = C_LOC(prim) 00254 CALL C_F_PROCPOINTER(build_deriv1_eri(n_d,n_c,n_b,n_a),pbuild_deriv1) 00255 CALL pbuild_deriv1(deriv,1) 00256 00257 DO k=1,12 00258 IF(k==4 .OR. k==5 .OR. k==6) CYCLE 00259 pc_result = deriv%ABCD(k) 00260 CALL C_F_POINTER(pc_result, tmp_data , a_mysize) 00261 DO i=1,a_mysize(1) 00262 work_forces(i,k) = tmp_data(i) 00263 ENDDO 00264 END DO 00265 #else 00266 CALL wrapper_build_deriv1_eri(n_a, n_b, n_c, n_d, deriv, a_mysize(1), work_forces(1,1),prim) 00267 #endif 00268 END SUBROUTINE get_derivs 00269 00270 #else 00271 00272 !****************************************************************************! 00273 !****************************************************************************! 00274 !*** ***! 00275 !*** WHAT FOLLOWS IS CODE THAT USES BOGUS SUBROUTINES AND TYPES IN ***! 00276 !*** ORDER TO ALLOW ALL COMPILERS TO COMPILE CP2K ***! 00277 !*** ***! 00278 !****************************************************************************! 00279 !****************************************************************************! 00280 00281 CONTAINS 00282 00283 SUBROUTINE initialize_libint(lib,max_am,error) 00284 TYPE(lib_int) :: lib 00285 INTEGER :: max_am 00286 TYPE(cp_error_type), INTENT(inout) :: error 00287 00288 CHARACTER(LEN=*), PARAMETER :: routineN = 'initialize_libint', 00289 routineP = moduleN//':'//routineN 00290 00291 LOGICAL :: failure 00292 00293 failure = .FALSE. 00294 CALL cp_assert( .FALSE. , cp_failure_level,cp_assertion_failed,routineP,& 00295 " This CP2K executable has not been linked against the library libint, required for HFX.", & 00296 error,failure) 00297 00298 END SUBROUTINE initialize_libint 00299 00300 SUBROUTINE initialize_libderiv(deriv,max_am,error) 00301 TYPE(lib_deriv) :: deriv 00302 INTEGER :: max_am 00303 TYPE(cp_error_type), INTENT(inout) :: error 00304 00305 CHARACTER(LEN=*), PARAMETER :: routineN = 'initialize_libderiv', 00306 routineP = moduleN//':'//routineN 00307 00308 LOGICAL :: failure 00309 00310 failure = .FALSE. 00311 CALL cp_assert( .FALSE. , cp_failure_level,cp_assertion_failed,routineP,& 00312 " This CP2K executable has not been linked against the library libint, required for HFX.", & 00313 error,failure) 00314 00315 END SUBROUTINE initialize_libderiv 00316 00317 SUBROUTINE terminate_libint(lib) 00318 TYPE(lib_int) :: lib 00319 00320 END SUBROUTINE terminate_libint 00321 00322 SUBROUTINE terminate_libderiv(deriv) 00323 TYPE(lib_deriv) :: deriv 00324 00325 END SUBROUTINE terminate_libderiv 00326 00327 SUBROUTINE get_eris(n_d, n_c, n_b, n_a, lib, prim, p_work, a_mysize) 00328 INTEGER, INTENT(IN) :: n_d, n_c, n_b, n_a 00329 TYPE(lib_int) :: lib 00330 TYPE(prim_data), TARGET :: prim 00331 REAL(dp), DIMENSION(:), POINTER :: p_work 00332 INTEGER :: a_mysize(1) 00333 00334 END SUBROUTINE get_eris 00335 00336 SUBROUTINE get_derivs(n_d, n_c, n_b, n_a, deriv, prim, work_forces, a_mysize) 00337 INTEGER, INTENT(IN) :: n_d, n_c, n_b, n_a 00338 TYPE(lib_deriv) :: deriv 00339 TYPE(prim_data), TARGET :: prim 00340 REAL(dp), DIMENSION(nco(n_a)*nco(n_b)*& nco(n_c)*nco(n_d), 12) :: work_forces 00341 INTEGER :: a_mysize(1) 00342 00343 END SUBROUTINE get_derivs 00344 #endif 00345 00346 END MODULE hfx_libint_wrapper 00347
1.7.3