|
CP2K 2.4 (Revision 12889)
|
00001 !-----------------------------------------------------------------------------! 00002 ! CP2K: A general program to perform molecular auxamics simulations ! 00003 ! Copyright (C) 2000 - 2013 CP2K developers group ! 00004 !-----------------------------------------------------------------------------! 00005 00006 ! ***************************************************************************** 00012 MODULE scp_coeff_types 00013 USE atomic_kind_types, ONLY: atomic_kind_type,& 00014 get_atomic_kind,& 00015 get_atomic_kind_set 00016 USE basis_set_types, ONLY: get_gto_basis_set,& 00017 gto_basis_set_type 00018 USE cp_para_types, ONLY: cp_para_env_type 00019 USE distribution_1d_types, ONLY: distribution_1d_release,& 00020 distribution_1d_retain,& 00021 distribution_1d_type 00022 USE f77_blas 00023 USE input_constants, ONLY: copy_coeff,& 00024 copy_fcoeff,& 00025 use_aux_basis_set 00026 USE kinds, ONLY: dp 00027 USE message_passing, ONLY: mp_max,& 00028 mp_sum 00029 USE termination, ONLY: stop_program 00030 #include "cp_common_uses.h" 00031 00032 IMPLICIT NONE 00033 00034 PRIVATE 00035 00036 ! *** Global parameters (in this module) *** 00037 00038 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'scp_coeff_types' 00039 INTEGER, PRIVATE, SAVE :: last_coeff_id=0 00040 INTEGER, PRIVATE, SAVE :: last_coeff_set_id=0 00041 00042 INTEGER, PARAMETER,PUBLIC :: aux_coeff_replicated=1, aux_coeff_distributed=2 00043 00044 ! ***************************************************************************** 00045 TYPE aux_coeff_set_type 00046 INTEGER :: ref_count, id_nr 00047 INTEGER :: distribution_method 00048 INTEGER :: ncoef_atom_max, ncoef_tot, nel_tot 00049 LOGICAL :: propagate 00050 TYPE ( distribution_1d_type ), POINTER :: distribution 00051 TYPE ( aux_coeff_p_type ), POINTER, DIMENSION(:) :: coeffs_of_kind 00052 END TYPE aux_coeff_set_type 00053 00054 ! ***************************************************************************** 00055 TYPE aux_coeff_set_p_type 00056 TYPE(aux_coeff_set_type), POINTER :: aux_coeff_set 00057 END TYPE aux_coeff_set_p_type 00058 00059 ! ***************************************************************************** 00060 TYPE aux_coeff_type 00061 INTEGER :: ref_count, id_nr 00062 INTEGER :: n_els 00063 INTEGER :: ncoef_atom 00064 REAL(KIND=dp), DIMENSION(:,:), POINTER :: c, fc 00065 END TYPE aux_coeff_type 00066 00067 ! ***************************************************************************** 00068 TYPE aux_coeff_p_type 00069 TYPE(aux_coeff_type), POINTER :: coeffs 00070 END TYPE aux_coeff_p_type 00071 00072 ! *** Public structures *** 00073 00074 PUBLIC :: aux_coeff_set_type, aux_coeff_set_p_type,& 00075 aux_coeff_type, aux_coeff_p_type 00076 00077 ! *** Public Subroutines *** 00078 00079 PUBLIC :: aux_coeff_set_create, aux_coeff_set_initialize,& 00080 aux_coeff_set_release, aux_coeff_set_retain,& 00081 get_aux_coeff_set, aux_coeff_create, setup_aux_coeff, & 00082 aux_coeff_release, get_aux_coeff, aux_coeff_zero_fc, create_replicated_coeff, & 00083 deallocate_replicated_coeff 00084 00085 CONTAINS 00086 00087 ! ***************************************************************************** 00088 SUBROUTINE aux_coeff_set_create(aux_coeff_set,atomic_kind_set,& 00089 distribution, error) 00090 00091 TYPE(aux_coeff_set_type), POINTER :: aux_coeff_set 00092 TYPE(atomic_kind_type), DIMENSION(:), 00093 POINTER :: atomic_kind_set 00094 TYPE(distribution_1d_type), OPTIONAL, 00095 POINTER :: distribution 00096 TYPE(cp_error_type), INTENT(inout) :: error 00097 00098 CHARACTER(len=*), PARAMETER :: routineN = 'aux_coeff_set_create', 00099 routineP = moduleN//':'//routineN 00100 00101 INTEGER :: ikind, n_els, nkind, stat 00102 LOGICAL :: failure 00103 TYPE(atomic_kind_type), POINTER :: atomic_kind 00104 TYPE(gto_basis_set_type), POINTER :: aux_basis_set 00105 00106 failure=.FALSE. 00107 00108 NULLIFY(atomic_kind,aux_basis_set) 00109 ALLOCATE(aux_coeff_set, stat=stat) 00110 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00111 IF (.NOT. failure) THEN 00112 last_coeff_set_id=last_coeff_set_id+1 00113 aux_coeff_set%id_nr=last_coeff_set_id 00114 aux_coeff_set%ref_count=1 00115 NULLIFY(aux_coeff_set%distribution, aux_coeff_set%coeffs_of_kind) 00116 ! set coeffs_of_kind 00117 nkind=SIZE(atomic_kind_set) 00118 IF (PRESENT(distribution)) THEN 00119 IF (ASSOCIATED(distribution)) THEN 00120 ALLOCATE(aux_coeff_set%coeffs_of_kind(nkind), stat=stat) 00121 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00122 aux_coeff_set%distribution_method=aux_coeff_distributed 00123 DO ikind=1,nkind 00124 NULLIFY(aux_coeff_set%coeffs_of_kind(ikind)%coeffs) 00125 atomic_kind => atomic_kind_set(ikind) 00126 CALL get_atomic_kind(atomic_kind,aux_basis_set=aux_basis_set) 00127 n_els = distribution%n_el(ikind) 00128 IF ((.NOT.ASSOCIATED(aux_basis_set)).OR.(n_els ==0)) CYCLE 00129 CALL aux_coeff_create(aux_coeff_set%coeffs_of_kind(ikind)%coeffs,& 00130 error=error) 00131 CALL setup_aux_coeff(aux_coeff_set%coeffs_of_kind(ikind)%coeffs,& 00132 aux_basis_set=aux_basis_set, n_els=n_els, error=error) 00133 END DO 00134 00135 CALL distribution_1d_retain(distribution,error=error) 00136 CALL distribution_1d_release(aux_coeff_set%distribution,error=error) 00137 aux_coeff_set%distribution => distribution 00138 END IF 00139 ELSE 00140 aux_coeff_set%distribution_method=aux_coeff_replicated 00141 CALL stop_program(routineN,moduleN,__LINE__,'Replicated coeffs NYI') 00142 END IF 00143 END IF 00144 00145 END SUBROUTINE aux_coeff_set_create 00146 00147 ! ***************************************************************************** 00148 SUBROUTINE aux_coeff_set_retain(aux_coeff_set, error) 00149 00150 TYPE(aux_coeff_set_type), POINTER :: aux_coeff_set 00151 TYPE(cp_error_type), INTENT(inout) :: error 00152 00153 CHARACTER(len=*), PARAMETER :: routineN = 'aux_coeff_set_retain', 00154 routineP = moduleN//':'//routineN 00155 00156 LOGICAL :: failure 00157 00158 failure=.FALSE. 00159 00160 CPPrecondition(ASSOCIATED(aux_coeff_set),cp_failure_level,routineP,error,failure) 00161 IF (.NOT. failure) THEN 00162 CPPreconditionNoFail(aux_coeff_set%ref_count>0,cp_failure_level,routineP,error) 00163 aux_coeff_set%ref_count=aux_coeff_set%ref_count+1 00164 END IF 00165 00166 END SUBROUTINE aux_coeff_set_retain 00167 00168 ! ***************************************************************************** 00169 SUBROUTINE aux_coeff_zero_fc (aux_coeff_set, error) 00170 00171 TYPE(aux_coeff_set_type), POINTER :: aux_coeff_set 00172 TYPE(cp_error_type), INTENT(inout) :: error 00173 00174 CHARACTER(len=*), PARAMETER :: routineN = 'aux_coeff_zero_fc', 00175 routineP = moduleN//':'//routineN 00176 00177 INTEGER :: ikind 00178 LOGICAL :: failure 00179 REAL(dp), DIMENSION(:, :), POINTER :: force 00180 TYPE(aux_coeff_type), POINTER :: local_coeffs 00181 00182 failure=.FALSE. 00183 NULLIFY ( local_coeffs, force ) 00184 00185 CPPrecondition(ASSOCIATED(aux_coeff_set),cp_failure_level,routineP,error,failure) 00186 IF (.NOT. failure) THEN 00187 DO ikind=1,SIZE(aux_coeff_set%coeffs_of_kind) 00188 local_coeffs => aux_coeff_set%coeffs_of_kind(ikind)%coeffs 00189 IF ( .NOT. ASSOCIATED ( local_coeffs ) ) CYCLE 00190 CALL get_aux_coeff(coeffs=local_coeffs,fc=force,error=error) 00191 force(:,:)=0.0_dp 00192 END DO 00193 END IF 00194 00195 END SUBROUTINE aux_coeff_zero_fc 00196 00197 ! ***************************************************************************** 00198 SUBROUTINE aux_coeff_set_release(aux_coeff_set, error) 00199 00200 TYPE(aux_coeff_set_type), POINTER :: aux_coeff_set 00201 TYPE(cp_error_type), INTENT(inout) :: error 00202 00203 CHARACTER(len=*), PARAMETER :: routineN = 'aux_coeff_set_release', 00204 routineP = moduleN//':'//routineN 00205 00206 INTEGER :: i, stat 00207 LOGICAL :: failure 00208 00209 failure=.FALSE. 00210 00211 IF (ASSOCIATED(aux_coeff_set)) THEN 00212 CPPreconditionNoFail(aux_coeff_set%ref_count>0,cp_failure_level,routineP,error) 00213 aux_coeff_set%ref_count=aux_coeff_set%ref_count-1 00214 IF (aux_coeff_set%ref_count==0) THEN 00215 CALL distribution_1d_release(aux_coeff_set%distribution, error=error) 00216 IF(ASSOCIATED(aux_coeff_set%coeffs_of_kind)) THEN 00217 DO i=1,SIZE(aux_coeff_set%coeffs_of_kind) 00218 IF(ASSOCIATED(aux_coeff_set%coeffs_of_kind(i)%coeffs)) THEN 00219 CALL aux_coeff_release(aux_coeff_set%coeffs_of_kind(i)%coeffs,error=error) 00220 ENDIF 00221 END DO 00222 DEALLOCATE(aux_coeff_set%coeffs_of_kind,stat=stat) 00223 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00224 END IF 00225 DEALLOCATE(aux_coeff_set, stat=stat) 00226 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00227 END IF 00228 END IF 00229 NULLIFY(aux_coeff_set) 00230 00231 END SUBROUTINE aux_coeff_set_release 00232 00233 ! ***************************************************************************** 00234 SUBROUTINE get_aux_coeff_set(aux_coeff_set,distribution, coeffs_of_kind,& 00235 ncoefs,id_nr,ref_count,error) 00236 00237 TYPE(aux_coeff_set_type), POINTER :: aux_coeff_set 00238 TYPE(distribution_1d_type), OPTIONAL, 00239 POINTER :: distribution 00240 TYPE(aux_coeff_p_type), DIMENSION(:), 00241 OPTIONAL, POINTER :: coeffs_of_kind 00242 INTEGER, INTENT(out), OPTIONAL :: ncoefs, id_nr, ref_count 00243 TYPE(cp_error_type), INTENT(inout) :: error 00244 00245 CHARACTER(len=*), PARAMETER :: routineN = 'get_aux_coeff_set', 00246 routineP = moduleN//':'//routineN 00247 00248 INTEGER :: ikind, ncoef_of_kind, nkind 00249 LOGICAL :: failure 00250 TYPE(aux_coeff_type), POINTER :: coeffs_att 00251 00252 failure=.FALSE. 00253 00254 CPPrecondition(ASSOCIATED(aux_coeff_set),cp_failure_level,routineP,error,failure) 00255 CPPrecondition(aux_coeff_set%ref_count>0,cp_failure_level,routineP,error,failure) 00256 IF (.NOT. failure) THEN 00257 IF (PRESENT(id_nr)) id_nr = aux_coeff_set%id_nr 00258 IF (PRESENT(ref_count)) ref_count = aux_coeff_set%ref_count 00259 IF (PRESENT(distribution)) distribution => aux_coeff_set%distribution 00260 IF (PRESENT(coeffs_of_kind)) coeffs_of_kind => aux_coeff_set%coeffs_of_kind 00261 IF (PRESENT(ncoefs))THEN 00262 ncoefs=0 00263 nkind=SIZE(aux_coeff_set%coeffs_of_kind) 00264 DO ikind=1, nkind 00265 coeffs_att=>aux_coeff_set%coeffs_of_kind(ikind)%coeffs 00266 IF(ASSOCIATED(coeffs_att))THEN 00267 CALL get_aux_coeff(coeffs=coeffs_att,ncoef_of_kind=ncoef_of_kind,error=error) 00268 ncoefs=ncoefs+ncoef_of_kind 00269 END IF 00270 END DO 00271 END IF 00272 END IF 00273 END SUBROUTINE get_aux_coeff_set 00274 00275 ! ***************************************************************************** 00276 SUBROUTINE aux_coeff_create(coeffs, error) 00277 00278 TYPE(aux_coeff_type), POINTER :: coeffs 00279 TYPE(cp_error_type), INTENT(inout) :: error 00280 00281 CHARACTER(len=*), PARAMETER :: routineN = 'aux_coeff_create', 00282 routineP = moduleN//':'//routineN 00283 00284 INTEGER :: stat 00285 LOGICAL :: failure 00286 00287 failure=.FALSE. 00288 00289 ALLOCATE(coeffs, stat=stat) 00290 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00291 IF (.NOT. failure) THEN 00292 last_coeff_id=last_coeff_id+1 00293 coeffs%id_nr=last_coeff_id 00294 coeffs%ref_count=1 00295 NULLIFY( coeffs%c, coeffs%fc ) 00296 END IF 00297 00298 END SUBROUTINE aux_coeff_create 00299 00300 ! ***************************************************************************** 00301 SUBROUTINE aux_coeff_release(coeffs, error) 00302 00303 TYPE(aux_coeff_type), POINTER :: coeffs 00304 TYPE(cp_error_type), INTENT(inout) :: error 00305 00306 CHARACTER(len=*), PARAMETER :: routineN = 'aux_coeff_release', 00307 routineP = moduleN//':'//routineN 00308 00309 INTEGER :: stat 00310 LOGICAL :: failure 00311 00312 failure=.FALSE. 00313 IF (ASSOCIATED(coeffs)) THEN 00314 CPPreconditionNoFail(coeffs%ref_count>0,cp_failure_level,routineP,error) 00315 coeffs%ref_count=coeffs%ref_count-1 00316 IF (coeffs%ref_count==0) THEN 00317 IF (ASSOCIATED(coeffs%c)) THEN 00318 DEALLOCATE(coeffs%c,stat=stat) 00319 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00320 END IF 00321 IF (ASSOCIATED(coeffs%fc)) THEN 00322 DEALLOCATE(coeffs%fc,stat=stat) 00323 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00324 END IF 00325 DEALLOCATE(coeffs,stat=stat) 00326 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00327 END IF 00328 END IF 00329 NULLIFY(coeffs) 00330 00331 END SUBROUTINE aux_coeff_release 00332 00333 ! ***************************************************************************** 00334 SUBROUTINE setup_aux_coeff(coeffs,aux_basis_set, n_els, error) 00335 00336 TYPE(aux_coeff_type), POINTER :: coeffs 00337 TYPE(gto_basis_set_type), POINTER :: aux_basis_set 00338 INTEGER, INTENT(in) :: n_els 00339 TYPE(cp_error_type), INTENT(inout) :: error 00340 00341 CHARACTER(len=*), PARAMETER :: routineN = 'setup_aux_coeff', 00342 routineP = moduleN//':'//routineN 00343 00344 INTEGER :: nsgf, stat 00345 LOGICAL :: failure 00346 00347 failure=.FALSE. 00348 CALL get_gto_basis_set(gto_basis_set=aux_basis_set,nsgf=nsgf) 00349 coeffs%ncoef_atom=nsgf 00350 coeffs%n_els=n_els 00351 IF(.NOT.ASSOCIATED(coeffs%c)) THEN 00352 ALLOCATE(coeffs%c(n_els,nsgf),STAT=stat) 00353 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00354 coeffs%c(:,:)=0.0_dp 00355 END IF 00356 IF(.NOT.ASSOCIATED(coeffs%fc)) THEN 00357 ALLOCATE(coeffs%fc(n_els,nsgf),STAT=stat) 00358 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00359 coeffs%fc(:,:)=0.0_dp 00360 END IF 00361 00362 END SUBROUTINE setup_aux_coeff 00363 ! ***************************************************************************** 00364 SUBROUTINE create_replicated_coeff ( rep_coeff, atomic_kind_set, & 00365 local_particles, aux_coeff_set, para_env, & 00366 copy_type_id, copy_in, error ) 00367 00368 REAL(dp), DIMENSION(:, :), POINTER :: rep_coeff 00369 TYPE(atomic_kind_type), POINTER :: atomic_kind_set( : ) 00370 TYPE(distribution_1d_type), POINTER :: local_particles 00371 TYPE(aux_coeff_set_type), POINTER :: aux_coeff_set 00372 TYPE(cp_para_env_type), POINTER :: para_env 00373 INTEGER, INTENT(IN) :: copy_type_id 00374 LOGICAL, INTENT(IN), OPTIONAL :: copy_in 00375 TYPE(cp_error_type), INTENT(inout) :: error 00376 00377 CHARACTER(len=*), PARAMETER :: routineN = 'create_replicated_coeff', 00378 routineP = moduleN//':'//routineN 00379 00380 INTEGER :: iatom, ii, ikind, 00381 iparticle_local, maxgtops, 00382 natoms, nparticle_local, 00383 stat, ub 00384 LOGICAL :: failure, my_copy_in = .TRUE. 00385 REAL(dp), POINTER :: c( :, : ), fc( :, : ) 00386 TYPE(aux_coeff_type), POINTER :: local_coeffs 00387 00388 NULLIFY ( c, fc ) 00389 IF ( PRESENT ( copy_in ) ) my_copy_in = copy_in 00390 00391 ! Ensuring a blank canvas 00392 IF ( ASSOCIATED ( rep_coeff ) ) THEN 00393 CALL deallocate_replicated_coeff ( rep_coeff, atomic_kind_set, local_particles, & 00394 aux_coeff_set, copy_type_id, .FALSE., error ) 00395 00396 END IF 00397 00398 ! Getting dimensions of the replicated coeff array 00399 CALL get_atomic_kind_set ( atomic_kind_set, maxgtops=maxgtops, & 00400 basis_set_id=use_aux_basis_set, natom=natoms ) 00401 00402 ! Allocating the pointer: MAXGTOPS is the maximum number of spherical orbitals in a set * number of sets 00403 ALLOCATE(rep_coeff ( natoms, maxgtops ), stat=stat) 00404 CPPostcondition(stat==0,cp_failure_level,routineN,error,failure) 00405 ! Zero 00406 rep_coeff = 0._dp 00407 IF ( my_copy_in ) THEN 00408 DO ikind = 1, SIZE ( atomic_kind_set ) 00409 local_coeffs=>aux_coeff_set%coeffs_of_kind(ikind)%coeffs 00410 IF (.NOT. ASSOCIATED ( local_coeffs ) ) CYCLE 00411 ! Get the number of particles of ikind ( local ) 00412 nparticle_local = local_particles%n_el(ikind) 00413 ! Loop over the (local) particles 00414 DO iparticle_local=1,nparticle_local 00415 iatom = local_particles%list(ikind)%array(iparticle_local) 00416 ! Assigning the local coefficients: 00417 SELECT CASE ( copy_type_id ) 00418 CASE ( copy_coeff ) 00419 CALL get_aux_coeff(coeffs=local_coeffs,c=c,error=error) 00420 ub = SIZE ( c, 2 ) 00421 CPPostcondition(ub<=maxgtops,cp_failure_level,routineN,error,failure) 00422 DO ii = 1, ub 00423 rep_coeff ( iatom, ii ) = c(iparticle_local,ii ) 00424 END DO 00425 CASE ( copy_fcoeff ) 00426 CALL get_aux_coeff(coeffs=local_coeffs,fc=fc,error=error) 00427 CPPostcondition(ub<=maxgtops,cp_failure_level,routineN,error,failure) 00428 ub = SIZE ( fc, 2 ) 00429 DO ii = 1, ub 00430 rep_coeff ( iatom, ii ) = fc(iparticle_local, ii ) 00431 END DO 00432 END SELECT 00433 END DO 00434 END DO 00435 END IF 00436 CALL mp_sum ( rep_coeff, para_env%group ) 00437 00438 END SUBROUTINE create_replicated_coeff 00439 ! ***************************************************************************** 00440 SUBROUTINE deallocate_replicated_coeff ( rep_coeff, atomic_kind_set, local_particles, & 00441 aux_coeff_set, copy_type_id, copy_out, error ) 00442 00443 REAL(dp), DIMENSION(:, :), POINTER :: rep_coeff 00444 TYPE(atomic_kind_type), POINTER :: atomic_kind_set( : ) 00445 TYPE(distribution_1d_type), POINTER :: local_particles 00446 TYPE(aux_coeff_set_type), POINTER :: aux_coeff_set 00447 INTEGER, INTENT(IN) :: copy_type_id 00448 LOGICAL, INTENT(IN), OPTIONAL :: copy_out 00449 TYPE(cp_error_type), INTENT(inout) :: error 00450 00451 CHARACTER(len=*), PARAMETER :: routineN = 'deallocate_replicated_coeff', 00452 routineP = moduleN//':'//routineN 00453 00454 INTEGER :: iatom, ii, ikind, 00455 iparticle_local, 00456 nparticle_local, stat 00457 LOGICAL :: failure = .FALSE., 00458 my_copy_out = .FALSE. 00459 REAL(dp), POINTER :: c( :, : ), fc( :, : ) 00460 TYPE(aux_coeff_type), POINTER :: local_coeffs 00461 00462 NULLIFY ( c, fc ) 00463 IF ( PRESENT ( copy_out ) ) my_copy_out = copy_out 00464 00465 CPPrecondition(ASSOCIATED(rep_coeff),cp_failure_level,routineN,error,failure) 00466 IF ( .NOT. failure ) THEN 00467 IF ( my_copy_out ) THEN 00468 DO ikind = 1, SIZE ( atomic_kind_set ) 00469 local_coeffs=>aux_coeff_set%coeffs_of_kind(ikind)%coeffs 00470 IF (.NOT. ASSOCIATED ( local_coeffs ) ) CYCLE 00471 ! Get the number of particles of ikind ( local ) 00472 nparticle_local = local_particles%n_el(ikind) 00473 ! Loop over the (local) particles 00474 DO iparticle_local=1,nparticle_local 00475 iatom = local_particles%list(ikind)%array(iparticle_local) 00476 ! Assigning the local coefficients: 00477 SELECT CASE ( copy_type_id ) 00478 CASE ( copy_coeff ) 00479 CALL get_aux_coeff(coeffs=local_coeffs,c=c,error=error) 00480 DO ii = 1, SIZE ( rep_coeff, 2 ) 00481 c(iparticle_local,ii) = c(iparticle_local,ii) + rep_coeff ( iatom, ii ) 00482 END DO 00483 CASE ( copy_fcoeff ) 00484 CALL get_aux_coeff(coeffs=local_coeffs,fc=fc,error=error) 00485 DO ii = 1, SIZE ( rep_coeff, 2 ) 00486 fc(iparticle_local,ii) = fc(iparticle_local,ii) + rep_coeff ( iatom, ii ) 00487 END DO 00488 END SELECT 00489 END DO 00490 END DO 00491 END IF 00492 DEALLOCATE ( rep_coeff, stat=stat ) 00493 CPPostcondition(stat==0,cp_failure_level,routineN,error,failure) 00494 NULLIFY ( rep_coeff ) 00495 END IF 00496 END SUBROUTINE deallocate_replicated_coeff 00497 ! ***************************************************************************** 00498 SUBROUTINE get_aux_coeff(coeffs, c, fc, n_els, ncoef_atom,ncoef_of_kind,id_nr,ref_count,error) 00499 00500 TYPE(aux_coeff_type), POINTER :: coeffs 00501 REAL(KIND=dp), DIMENSION(:, :), 00502 OPTIONAL, POINTER :: c, fc 00503 INTEGER, INTENT(OUT), OPTIONAL :: n_els, ncoef_atom, 00504 ncoef_of_kind, id_nr, 00505 ref_count 00506 TYPE(cp_error_type), INTENT(INOUT) :: error 00507 00508 CHARACTER(len=*), PARAMETER :: routineN = 'get_aux_coeff', 00509 routineP = moduleN//':'//routineN 00510 00511 LOGICAL :: failure 00512 00513 failure=.FALSE. 00514 CPPrecondition(ASSOCIATED(coeffs),cp_failure_level,routineP,error,failure) 00515 IF (.NOT. failure) THEN 00516 IF (PRESENT(id_nr)) id_nr = coeffs%id_nr 00517 IF (PRESENT(ref_count)) ref_count = coeffs%ref_count 00518 IF (PRESENT(n_els)) n_els = coeffs%n_els 00519 IF (PRESENT(ncoef_atom)) ncoef_atom = coeffs%ncoef_atom 00520 IF (PRESENT(ncoef_of_kind)) ncoef_of_kind = coeffs%ncoef_atom*coeffs%n_els 00521 IF (PRESENT(c)) c => coeffs%c 00522 IF (PRESENT(fc)) fc => coeffs%fc 00523 END IF 00524 00525 END SUBROUTINE get_aux_coeff 00526 ! ***************************************************************************** 00527 SUBROUTINE aux_coeff_set_initialize(aux_coeff_set,para_env,error) 00528 00529 TYPE(aux_coeff_set_type), POINTER :: aux_coeff_set 00530 TYPE(cp_para_env_type), POINTER :: para_env 00531 TYPE(cp_error_type), INTENT(inout) :: error 00532 00533 CHARACTER(len=*), PARAMETER :: routineN = 'aux_coeff_set_initialize', 00534 routineP = moduleN//':'//routineN 00535 00536 INTEGER :: group, ikind, n_els, 00537 ncoef_atom, ncoef_atom_max, 00538 ncoef_of_kind, ncoef_tot, 00539 nel_tot, nkind 00540 TYPE(aux_coeff_type), POINTER :: coeffs 00541 00542 group=para_env%group 00543 ! initialize to default values 00544 00545 nel_tot=0 00546 ncoef_tot=0 00547 ncoef_atom_max=0 00548 00549 ! get total numbers 00550 nkind=SIZE(aux_coeff_set%coeffs_of_kind) 00551 DO ikind=1,nkind 00552 coeffs=> aux_coeff_set%coeffs_of_kind(ikind)%coeffs 00553 IF(.NOT.ASSOCIATED(coeffs)) CYCLE 00554 CALL get_aux_coeff(coeffs,n_els=n_els,ncoef_atom=ncoef_atom,& 00555 ncoef_of_kind=ncoef_of_kind,error=error) 00556 nel_tot=nel_tot+n_els 00557 ncoef_tot=ncoef_tot+ncoef_of_kind 00558 ncoef_atom_max=MAX(ncoef_atom_max,ncoef_atom) 00559 END DO 00560 CALL mp_sum(nel_tot,group) 00561 CALL mp_sum(ncoef_tot,group) 00562 CALL mp_max(ncoef_atom_max,group) 00563 00564 aux_coeff_set%nel_tot=nel_tot 00565 aux_coeff_set%ncoef_tot=ncoef_tot 00566 aux_coeff_set%ncoef_atom_max=ncoef_atom_max 00567 00568 END SUBROUTINE aux_coeff_set_initialize 00569 00570 END MODULE scp_coeff_types
1.7.3