|
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 ! ***************************************************************************** 00010 MODULE scptb_types 00011 00012 USE cp_output_handling, ONLY: cp_p_file,& 00013 cp_print_key_finished_output,& 00014 cp_print_key_should_output,& 00015 cp_print_key_unit_nr 00016 USE cp_para_types, ONLY: cp_para_env_type 00017 USE f77_blas 00018 USE input_section_types, ONLY: section_vals_type 00019 USE kinds, ONLY: default_string_length,& 00020 dp 00021 USE message_passing, ONLY: mp_sum 00022 #include "cp_common_uses.h" 00023 00024 IMPLICIT NONE 00025 00026 PRIVATE 00027 00028 ! *** Global parameters *** 00029 00030 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'scptb_types' 00031 00032 ! ***************************************************************************** 00033 TYPE scptb_parameter_type 00034 ! PRIVATE 00035 CHARACTER(LEN=default_string_length) :: key 00036 CHARACTER(LEN=default_string_length) :: parameterization 00037 CHARACTER(LEN=default_string_length) :: atomname 00038 LOGICAL :: defined 00039 INTEGER :: z !atomic number 00040 REAL(KIND=dp) :: zeff !effective core charge 00041 INTEGER :: natorb !total number of orbitals 00042 INTEGER :: lmaxorb !max angular momentum orbitals 00043 INTEGER :: lmaxscp !max angular momentum scp density 00044 INTEGER, DIMENSION(0:3) :: norb !number of orbitals per l QN 00045 INTEGER, DIMENSION(10,0:3) :: nqm !principal quantum numbers 00046 REAL(KIND=dp), DIMENSION(10,0:3) :: zeta !orbital exponents 00047 REAL(KIND=dp), DIMENSION(10,0:3) :: hcore !core potential energy 00048 REAL(KIND=dp), DIMENSION(10,0:3) :: occupation !free atom occupation 00049 REAL(KIND=dp) :: energy !free atom energy 00050 REAL(KIND=dp), DIMENSION(3) :: crep !core repulsion parameters 00051 REAL(KIND=dp), DIMENSION(1:3) :: pol !polarization for SCP 00052 REAL(KIND=dp) :: ag !width of SCP charge 00053 REAL(KIND=dp) :: rcpair !cutoff radius for core pair potentials 00054 END TYPE scptb_parameter_type 00055 00056 TYPE scptb_parameter_p_type 00057 TYPE(scptb_parameter_type), POINTER :: scptb_param 00058 END TYPE scptb_parameter_p_type 00059 00060 ! ***************************************************************************** 00061 00062 TYPE scp_kind_vector_type 00063 INTEGER :: natom 00064 INTEGER :: nbasis 00065 REAL(dp), DIMENSION(:,:), POINTER :: vmat 00066 END TYPE scp_kind_vector_type 00067 00068 TYPE scp_vector_type 00069 INTEGER :: total_length 00070 TYPE(scp_kind_vector_type), DIMENSION(:), POINTER :: vector 00071 END TYPE scp_vector_type 00072 00073 TYPE scp_vector_p_type 00074 TYPE(scp_vector_type), POINTER :: vec 00075 END TYPE scp_vector_p_type 00076 00077 ! ***************************************************************************** 00078 00079 PUBLIC :: scptb_parameter_type, & 00080 scptb_parameter_p_type, & 00081 allocate_scptb_parameter,& 00082 deallocate_scptb_parameter,& 00083 get_scptb_parameter,& 00084 set_scptb_parameter,& 00085 write_scptb_parameter 00086 00087 PUBLIC :: scp_kind_vector_type,& 00088 scp_vector_type,& 00089 scp_vector_p_type,& 00090 scp_vector_create,& 00091 scp_vector_release,& 00092 scp_vector_set,& 00093 scp_vector_add,& 00094 scp_vector_mult,& 00095 scp_vector_copy,& 00096 scp_vector_scale,& 00097 scp_vector_dot,& 00098 scp_vector_norm,& 00099 scp_vector_print,& 00100 scp_vector_sync 00101 00102 ! ***************************************************************************** 00103 00104 CONTAINS 00105 00106 ! ***************************************************************************** 00107 SUBROUTINE allocate_scptb_parameter(scptb_parameter,error) 00108 00109 TYPE(scptb_parameter_type), POINTER :: scptb_parameter 00110 TYPE(cp_error_type), INTENT(INOUT) :: error 00111 00112 CHARACTER(LEN=*), PARAMETER :: routineN = 'allocate_scptb_parameter', 00113 routineP = moduleN//':'//routineN 00114 00115 INTEGER :: istat 00116 LOGICAL :: failure 00117 00118 IF (ASSOCIATED(scptb_parameter)) & 00119 CALL deallocate_scptb_parameter(scptb_parameter,error) 00120 00121 ALLOCATE (scptb_parameter,STAT=istat) 00122 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00123 00124 scptb_parameter % key = "" 00125 scptb_parameter % parameterization = "" 00126 scptb_parameter % atomname = "" 00127 scptb_parameter % defined = .FALSE. 00128 scptb_parameter % z = -1 00129 scptb_parameter % zeff = -1.0_dp 00130 scptb_parameter % natorb = 0 00131 scptb_parameter % lmaxorb = -1 00132 scptb_parameter % lmaxscp = -1 00133 scptb_parameter % norb = 0 00134 scptb_parameter % nqm = 0 00135 scptb_parameter % zeta = 0.0_dp 00136 scptb_parameter % hcore = 0.0_dp 00137 scptb_parameter % occupation = 0.0_dp 00138 scptb_parameter % energy = 0.0_dp 00139 scptb_parameter % crep = 0.0_dp 00140 scptb_parameter % pol = 0.0_dp 00141 scptb_parameter % ag = 0.0_dp 00142 scptb_parameter % rcpair = 0.0_dp 00143 00144 END SUBROUTINE allocate_scptb_parameter 00145 00146 ! ***************************************************************************** 00147 SUBROUTINE deallocate_scptb_parameter(scptb_parameter,error) 00148 00149 TYPE(scptb_parameter_type), POINTER :: scptb_parameter 00150 TYPE(cp_error_type), INTENT(INOUT) :: error 00151 00152 CHARACTER(LEN=*), PARAMETER :: routineN = 'deallocate_scptb_parameter', 00153 routineP = moduleN//':'//routineN 00154 00155 INTEGER :: istat 00156 LOGICAL :: failure 00157 00158 CPPrecondition(ASSOCIATED(scptb_parameter),cp_failure_level,routineP,error,failure) 00159 DEALLOCATE (scptb_parameter,STAT=istat) 00160 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00161 00162 END SUBROUTINE deallocate_scptb_parameter 00163 00164 ! ***************************************************************************** 00165 SUBROUTINE get_scptb_parameter(scptb_parameter,key,atomname,parameterization,defined,z,zeff,natorb,& 00166 lmaxorb,lmaxscp,norb,nqm,zeta,hcore,occupation,energy,crep,pol,ag,rcpair,error) 00167 00168 TYPE(scptb_parameter_type), POINTER :: scptb_parameter 00169 CHARACTER(LEN=*), INTENT(OUT), OPTIONAL :: key, atomname, 00170 parameterization 00171 LOGICAL, INTENT(OUT), OPTIONAL :: defined 00172 INTEGER, INTENT(OUT), OPTIONAL :: z 00173 REAL(KIND=dp), INTENT(OUT), OPTIONAL :: zeff 00174 INTEGER, INTENT(OUT), OPTIONAL :: natorb, lmaxorb, lmaxscp 00175 INTEGER, DIMENSION(0:3), OPTIONAL :: norb 00176 INTEGER, DIMENSION(10, 0:3), OPTIONAL :: nqm 00177 REAL(KIND=dp), DIMENSION(10, 0:3), 00178 OPTIONAL :: zeta, hcore, occupation 00179 REAL(KIND=dp), OPTIONAL :: energy 00180 REAL(KIND=dp), DIMENSION(3), OPTIONAL :: crep 00181 REAL(KIND=dp), DIMENSION(1:3), OPTIONAL :: pol 00182 REAL(KIND=dp), OPTIONAL :: ag, rcpair 00183 TYPE(cp_error_type), INTENT(INOUT), 00184 OPTIONAL :: error 00185 00186 CHARACTER(LEN=*), PARAMETER :: routineN = 'get_scptb_parameter', 00187 routineP = moduleN//':'//routineN 00188 00189 LOGICAL :: failure 00190 00191 CPPrecondition(ASSOCIATED(scptb_parameter),cp_failure_level,routineP,error,failure) 00192 00193 IF (PRESENT(key)) key = scptb_parameter%key 00194 IF (PRESENT(atomname)) atomname = scptb_parameter%atomname 00195 IF (PRESENT(parameterization)) parameterization = scptb_parameter%parameterization 00196 IF (PRESENT(defined)) defined = scptb_parameter%defined 00197 IF (PRESENT(z)) z = scptb_parameter%z 00198 IF (PRESENT(zeff)) zeff = scptb_parameter%zeff 00199 IF (PRESENT(natorb)) natorb = scptb_parameter%natorb 00200 IF (PRESENT(lmaxorb)) lmaxorb = scptb_parameter%lmaxorb 00201 IF (PRESENT(lmaxscp)) lmaxscp = scptb_parameter%lmaxscp 00202 IF (PRESENT(norb)) norb = scptb_parameter%norb 00203 IF (PRESENT(nqm)) nqm = scptb_parameter%nqm 00204 IF (PRESENT(zeta)) zeta = scptb_parameter%zeta 00205 IF (PRESENT(hcore)) hcore = scptb_parameter%hcore 00206 IF (PRESENT(occupation)) occupation = scptb_parameter%occupation 00207 IF (PRESENT(energy)) energy = scptb_parameter%energy 00208 IF (PRESENT(crep)) crep = scptb_parameter%crep 00209 IF (PRESENT(pol)) pol = scptb_parameter%pol 00210 IF (PRESENT(ag)) ag = scptb_parameter%ag 00211 IF (PRESENT(rcpair)) rcpair = scptb_parameter%rcpair 00212 00213 END SUBROUTINE get_scptb_parameter 00214 00215 ! ***************************************************************************** 00216 SUBROUTINE set_scptb_parameter(scptb_parameter,key,atomname,parameterization,defined,z,zeff,natorb,& 00217 lmaxorb,lmaxscp,norb,nqm,zeta,hcore,occupation,energy,crep,pol,ag,rcpair,error) 00218 00219 TYPE(scptb_parameter_type), POINTER :: scptb_parameter 00220 CHARACTER(LEN=*), OPTIONAL :: key, atomname, 00221 parameterization 00222 LOGICAL, OPTIONAL :: defined 00223 INTEGER, OPTIONAL :: z 00224 REAL(KIND=dp), OPTIONAL :: zeff 00225 INTEGER, OPTIONAL :: natorb, lmaxorb, lmaxscp 00226 INTEGER, DIMENSION(0:3), OPTIONAL :: norb 00227 INTEGER, DIMENSION(10, 0:3), OPTIONAL :: nqm 00228 REAL(KIND=dp), DIMENSION(10, 0:3), 00229 OPTIONAL :: zeta, hcore, occupation 00230 REAL(KIND=dp), OPTIONAL :: energy 00231 REAL(KIND=dp), DIMENSION(3), OPTIONAL :: crep 00232 REAL(KIND=dp), DIMENSION(1:3), OPTIONAL :: pol 00233 REAL(KIND=dp), OPTIONAL :: ag, rcpair 00234 TYPE(cp_error_type), INTENT(INOUT), 00235 OPTIONAL :: error 00236 00237 CHARACTER(LEN=*), PARAMETER :: routineN = 'set_scptb_parameter', 00238 routineP = moduleN//':'//routineN 00239 00240 LOGICAL :: failure 00241 00242 CPPrecondition(ASSOCIATED(scptb_parameter),cp_failure_level,routineP,error,failure) 00243 00244 IF (PRESENT(key)) scptb_parameter%key = key 00245 IF (PRESENT(atomname)) scptb_parameter%atomname = atomname 00246 IF (PRESENT(parameterization)) scptb_parameter%parameterization = parameterization 00247 IF (PRESENT(defined)) scptb_parameter%defined = defined 00248 IF (PRESENT(z)) scptb_parameter%z = z 00249 IF (PRESENT(zeff)) scptb_parameter%zeff = zeff 00250 IF (PRESENT(natorb)) scptb_parameter%natorb = natorb 00251 IF (PRESENT(lmaxorb)) scptb_parameter%lmaxorb = lmaxorb 00252 IF (PRESENT(lmaxscp)) scptb_parameter%lmaxscp = lmaxscp 00253 IF (PRESENT(norb)) scptb_parameter%norb = norb 00254 IF (PRESENT(nqm)) scptb_parameter%nqm = nqm 00255 IF (PRESENT(zeta)) scptb_parameter%zeta = zeta 00256 IF (PRESENT(hcore)) scptb_parameter%hcore = hcore 00257 IF (PRESENT(occupation)) scptb_parameter%occupation = occupation 00258 IF (PRESENT(energy)) scptb_parameter%energy = energy 00259 IF (PRESENT(crep)) scptb_parameter%crep = crep 00260 IF (PRESENT(pol)) scptb_parameter%pol = pol 00261 IF (PRESENT(ag)) scptb_parameter%ag = ag 00262 IF (PRESENT(rcpair)) scptb_parameter%rcpair = rcpair 00263 00264 END SUBROUTINE set_scptb_parameter 00265 00266 ! ***************************************************************************** 00267 SUBROUTINE write_scptb_parameter(scptb_parameter,section,error) 00268 00269 TYPE(scptb_parameter_type), POINTER :: scptb_parameter 00270 TYPE(section_vals_type), POINTER :: section 00271 TYPE(cp_error_type), INTENT(inout) :: error 00272 00273 CHARACTER(LEN=*), PARAMETER :: routineN = 'write_scptb_parameter', 00274 routineP = moduleN//':'//routineN 00275 00276 CHARACTER(LEN=default_string_length) :: atomname, key, 00277 parameterization 00278 INTEGER :: i, l, lmaxorb, lmaxscp, 00279 natorb, output_unit 00280 INTEGER, DIMENSION(0:3) :: norb 00281 INTEGER, DIMENSION(10, 0:3) :: nqm 00282 LOGICAL :: defined 00283 REAL(KIND=dp) :: ag, energy, rcpair, zeff 00284 REAL(KIND=dp), DIMENSION(10, 0:3) :: hcore, zeta 00285 REAL(KIND=dp), DIMENSION(1:3) :: pol 00286 REAL(KIND=dp), DIMENSION(3) :: crep 00287 TYPE(cp_logger_type), POINTER :: logger 00288 00289 NULLIFY(logger) 00290 logger => cp_error_get_logger(error) 00291 IF (ASSOCIATED(scptb_parameter).AND.& 00292 BTEST(cp_print_key_should_output(logger%iter_info,section,& 00293 "PRINT%KINDS/POTENTIAL",error=error),cp_p_file)) THEN 00294 00295 output_unit = cp_print_key_unit_nr(logger,section,"PRINT%KINDS",& 00296 extension=".Log",error=error) 00297 00298 IF (output_unit >0) THEN 00299 CALL get_scptb_parameter(scptb_parameter,key=key,atomname=atomname,& 00300 parameterization=parameterization,defined=defined,error=error) 00301 00302 WRITE (UNIT=output_unit,FMT="(/,T10,A,T67,A14)") " SCPTB parameters: ",TRIM(atomname) 00303 WRITE (UNIT=output_unit,FMT="(T67,A14)") TRIM(key) 00304 WRITE (UNIT=output_unit,FMT="(T67,A14)") TRIM(parameterization) 00305 IF ( defined ) THEN 00306 CALL get_scptb_parameter(scptb_parameter,& 00307 zeff=zeff,natorb=natorb,lmaxorb=lmaxorb,lmaxscp=lmaxscp,& 00308 norb=norb,nqm=nqm,zeta=zeta,hcore=hcore,& 00309 energy=energy,crep=crep,pol=pol,ag=ag,rcpair=rcpair,& 00310 error=error) 00311 WRITE (UNIT=output_unit,FMT="(T16,A,T71,F10.2)") "Effective core charge:",zeff 00312 WRITE (UNIT=output_unit,FMT="(T16,A,T71,I10)") "Total number of orbitals:",natorb 00313 WRITE (UNIT=output_unit,FMT="(T16,A,T30,A,T71,A)") "l-QM n-QM i","Exponent","H core" 00314 DO l=0,lmaxorb 00315 DO i=1,norb(l) 00316 WRITE (UNIT=output_unit,FMT="(T16,3I4,T30,F12.6,T71,F10.3)") & 00317 l,i,nqm(i,l),zeta(i,l),hcore(i,l) 00318 END DO 00319 END DO 00320 WRITE (UNIT=output_unit,FMT="(T16,A,T61,F20.10)") "Energy of free atom [au]:",energy 00321 WRITE (UNIT=output_unit,FMT="(T16,A,T41,4F10.4)") "Core repulsion potential ",(crep(i),i=1,4) 00322 WRITE (UNIT=output_unit,FMT="(T16,A,T41,4F10.4)") "SCP Polarization ",(pol(l),l=1,lmaxscp) 00323 WRITE (UNIT=output_unit,FMT="(T16,A,T61,F20.5)") "Gaussian exponents for SCP ",ag 00324 WRITE (UNIT=output_unit,FMT="(T16,A,T61,F20.5)") "Pair potential cutoff (core) [bohr]:",rcpair 00325 ELSE 00326 WRITE (UNIT=output_unit,FMT="(T55,A)")& 00327 "Parameters are not defined" 00328 END IF 00329 END IF 00330 CALL cp_print_key_finished_output(output_unit,logger,section,& 00331 "PRINT%KINDS",error=error) 00332 END IF 00333 00334 END SUBROUTINE write_scptb_parameter 00335 00336 ! ***************************************************************************** 00337 SUBROUTINE scp_vector_create(scp_vec, nkind, natoms, nbasis, error) 00338 TYPE(scp_vector_type), POINTER :: scp_vec 00339 INTEGER, INTENT(IN) :: nkind 00340 INTEGER, DIMENSION(:), INTENT(IN) :: natoms, nbasis 00341 TYPE(cp_error_type), INTENT(inout) :: error 00342 00343 CHARACTER(len=*), PARAMETER :: routineN = 'scp_vector_create', 00344 routineP = moduleN//':'//routineN 00345 00346 INTEGER :: ikind, istat, tl 00347 LOGICAL :: failure 00348 00349 CALL scp_vector_release(scp_vec, error) 00350 00351 ALLOCATE(scp_vec,stat=istat) 00352 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00353 ALLOCATE(scp_vec%vector(nkind),stat=istat) 00354 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00355 00356 tl=0 00357 DO ikind=1,nkind 00358 scp_vec%vector(ikind)%natom = natoms(ikind) 00359 scp_vec%vector(ikind)%nbasis = nbasis(ikind) 00360 tl=tl+natoms(ikind)*nbasis(ikind) 00361 ALLOCATE(scp_vec%vector(ikind)%vmat(nbasis(ikind),natoms(ikind)),stat=istat) 00362 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00363 scp_vec%vector(ikind)%vmat=0._dp 00364 END DO 00365 scp_vec%total_length = tl 00366 00367 END SUBROUTINE scp_vector_create 00368 00369 SUBROUTINE scp_vector_release(scp_vec, error) 00370 TYPE(scp_vector_type), POINTER :: scp_vec 00371 TYPE(cp_error_type), INTENT(inout) :: error 00372 00373 CHARACTER(len=*), PARAMETER :: routineN = 'scp_vector_release', 00374 routineP = moduleN//':'//routineN 00375 00376 INTEGER :: ikind, istat 00377 LOGICAL :: failure 00378 00379 IF(ASSOCIATED(scp_vec)) THEN 00380 IF(ASSOCIATED(scp_vec%vector)) THEN 00381 DO ikind=1,SIZE(scp_vec%vector) 00382 DEALLOCATE(scp_vec%vector(ikind)%vmat,stat=istat) 00383 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00384 END DO 00385 DEALLOCATE(scp_vec%vector,stat=istat) 00386 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00387 NULLIFY(scp_vec%vector) 00388 END IF 00389 DEALLOCATE(scp_vec,stat=istat) 00390 CPPostcondition(istat==0,cp_failure_level,routineP,error,failure) 00391 END IF 00392 00393 END SUBROUTINE scp_vector_release 00394 00395 SUBROUTINE scp_vector_set(scp_vec, value, error) 00396 TYPE(scp_vector_type) :: scp_vec 00397 REAL(KIND=dp), INTENT(IN) :: value 00398 TYPE(cp_error_type), INTENT(inout) :: error 00399 00400 CHARACTER(len=*), PARAMETER :: routineN = 'scp_vector_set', 00401 routineP = moduleN//':'//routineN 00402 00403 INTEGER :: i 00404 00405 DO i=1,SIZE(scp_vec%vector) 00406 scp_vec%vector(i)%vmat(:,:) = value 00407 END DO 00408 00409 END SUBROUTINE scp_vector_set 00410 00411 SUBROUTINE scp_vector_add(alpha, vecx, vecy, error) 00412 REAL(KIND=dp), INTENT(IN) :: alpha 00413 TYPE(scp_vector_type) :: vecx, vecy 00414 TYPE(cp_error_type), INTENT(inout) :: error 00415 00416 CHARACTER(len=*), PARAMETER :: routineN = 'scp_vector_add', 00417 routineP = moduleN//':'//routineN 00418 00419 INTEGER :: i 00420 00421 DO i=1,SIZE(vecx%vector) 00422 vecy%vector(i)%vmat(:,:) = vecy%vector(i)%vmat(:,:) + alpha*vecx%vector(i)%vmat(:,:) 00423 END DO 00424 00425 END SUBROUTINE scp_vector_add 00426 00427 SUBROUTINE scp_vector_copy(vec_in, vec_out, error) 00428 TYPE(scp_vector_type) :: vec_in, vec_out 00429 TYPE(cp_error_type), INTENT(inout) :: error 00430 00431 CHARACTER(len=*), PARAMETER :: routineN = 'scp_vector_copy', 00432 routineP = moduleN//':'//routineN 00433 00434 INTEGER :: i 00435 00436 DO i=1,SIZE(vec_in%vector) 00437 vec_out%vector(i)%vmat(:,:) = vec_in%vector(i)%vmat(:,:) 00438 END DO 00439 00440 END SUBROUTINE scp_vector_copy 00441 00442 SUBROUTINE scp_vector_scale(scale, vec, error) 00443 REAL(KIND=dp), INTENT(IN) :: scale 00444 TYPE(scp_vector_type) :: vec 00445 TYPE(cp_error_type), INTENT(inout) :: error 00446 00447 CHARACTER(len=*), PARAMETER :: routineN = 'scp_vector_scale', 00448 routineP = moduleN//':'//routineN 00449 00450 INTEGER :: i 00451 00452 DO i=1,SIZE(vec%vector) 00453 vec%vector(i)%vmat(:,:) = scale*vec%vector(i)%vmat(:,:) 00454 END DO 00455 00456 END SUBROUTINE scp_vector_scale 00457 00458 SUBROUTINE scp_vector_mult(vecx, vecy, error) 00459 TYPE(scp_vector_type) :: vecx, vecy 00460 TYPE(cp_error_type), INTENT(inout) :: error 00461 00462 CHARACTER(len=*), PARAMETER :: routineN = 'scp_vector_mult', 00463 routineP = moduleN//':'//routineN 00464 00465 INTEGER :: i 00466 00467 DO i=1,SIZE(vecx%vector) 00468 vecy%vector(i)%vmat(:,:) = vecy%vector(i)%vmat(:,:) * vecx%vector(i)%vmat(:,:) 00469 END DO 00470 00471 END SUBROUTINE scp_vector_mult 00472 00473 SUBROUTINE scp_vector_dot(RESULT, vec1, vec2, error) 00474 REAL(KIND=dp), INTENT(OUT) :: RESULT 00475 TYPE(scp_vector_type) :: vec1, vec2 00476 TYPE(cp_error_type), INTENT(inout) :: error 00477 00478 CHARACTER(len=*), PARAMETER :: routineN = 'scp_vector_dot', 00479 routineP = moduleN//':'//routineN 00480 00481 INTEGER :: i 00482 00483 RESULT = 0._dp 00484 DO i=1,SIZE(vec1%vector) 00485 RESULT = RESULT + SUM(vec1%vector(i)%vmat(:,:)*vec2%vector(i)%vmat(:,:)) 00486 END DO 00487 00488 END SUBROUTINE scp_vector_dot 00489 00490 SUBROUTINE scp_vector_norm(RESULT, vec, error) 00491 REAL(KIND=dp), INTENT(OUT) :: RESULT 00492 TYPE(scp_vector_type) :: vec 00493 TYPE(cp_error_type), INTENT(inout) :: error 00494 00495 CHARACTER(len=*), PARAMETER :: routineN = 'scp_vector_norm', 00496 routineP = moduleN//':'//routineN 00497 00498 INTEGER :: i 00499 00500 RESULT = 0._dp 00501 DO i=1,SIZE(vec%vector) 00502 RESULT = RESULT + SUM(vec%vector(i)%vmat(:,:)*vec%vector(i)%vmat(:,:)) 00503 END DO 00504 RESULT = SQRT ( RESULT/REAL(vec%total_length,KIND=dp) ) 00505 00506 END SUBROUTINE scp_vector_norm 00507 00508 SUBROUTINE scp_vector_sync(vec, para_env, error) 00509 TYPE(scp_vector_type) :: vec 00510 TYPE(cp_para_env_type), POINTER :: para_env 00511 TYPE(cp_error_type), INTENT(inout) :: error 00512 00513 CHARACTER(len=*), PARAMETER :: routineN = 'scp_vector_sync', 00514 routineP = moduleN//':'//routineN 00515 00516 INTEGER :: i 00517 00518 DO i=1,SIZE(vec%vector) 00519 CALL mp_sum(vec%vector(i)%vmat(:,:),para_env%group) 00520 END DO 00521 00522 END SUBROUTINE scp_vector_sync 00523 00524 SUBROUTINE scp_vector_print(vec, error) 00525 TYPE(scp_vector_type) :: vec 00526 TYPE(cp_error_type), INTENT(inout) :: error 00527 00528 CHARACTER(len=*), PARAMETER :: routineN = 'scp_vector_print', 00529 routineP = moduleN//':'//routineN 00530 00531 INTEGER :: i, ia, ib, j, na, nb 00532 00533 WRITE(*,*) "Index Type Atom Basis Value" 00534 j = 0 00535 DO i=1,SIZE(vec%vector) 00536 na = vec%vector(i)%natom 00537 nb = vec%vector(i)%nbasis 00538 DO ia = 1,na 00539 DO ib = 1,nb 00540 j = j+1 00541 WRITE(*,"(i5,i7,i7,i7,F20.10)") j,i,ia,ib,vec%vector(i)%vmat(ib,ia) 00542 END DO 00543 END DO 00544 END DO 00545 00546 END SUBROUTINE scp_vector_print 00547 00548 ! ***************************************************************************** 00549 00550 END MODULE scptb_types 00551
1.7.3