CP2K: qs_linres_nmr_epr_common_utils.f90 Source File

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 ! *****************************************************************************
00015 MODULE qs_linres_nmr_epr_common_utils
00016   USE cell_types,                      ONLY: cell_type
00017   USE f77_blas
00018   USE kinds,                           ONLY: dp
00019   USE mathconstants,                   ONLY: gaussi
00020   USE pw_grid_types,                   ONLY: pw_grid_type
00021   USE pw_methods,                      ONLY: pw_transfer
00022   USE pw_pool_types,                   ONLY: pw_pool_create_pw,&
00023                                              pw_pool_give_back_pw,&
00024                                              pw_pool_type
00025   USE pw_types,                        ONLY: COMPLEXDATA1D,&
00026                                              RECIPROCALSPACE,&
00027                                              pw_p_type,&
00028                                              pw_type
00029   USE timings,                         ONLY: timeset,&
00030                                              timestop
00031 #include "cp_common_uses.h"
00032 
00033   IMPLICIT NONE
00034 
00035   PRIVATE
00036 
00037   ! *** Public subroutines ***
00038   PUBLIC :: mult_G_ov_G2_grid
00039 
00040   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_linres_nmr_epr_common_utils'
00041 
00042 CONTAINS
00043 
00044 ! *****************************************************************************
00058   SUBROUTINE  mult_G_ov_G2_grid(cell,pw_pool,rho_gspace,funcG_times_rho,idir,my_chi,error)
00059 
00060     TYPE(cell_type), POINTER                 :: cell
00061     TYPE(pw_pool_type), POINTER              :: pw_pool
00062     TYPE(pw_p_type), POINTER                 :: rho_gspace
00063     TYPE(pw_p_type)                          :: funcG_times_rho
00064     INTEGER, INTENT(IN)                      :: idir
00065     REAL(dp), INTENT(IN)                     :: my_chi
00066     TYPE(cp_error_type), INTENT(inout)       :: error
00067 
00068     INTEGER                                  :: handle, ig, ng
00069     LOGICAL                                  :: failure
00070     REAL(dp)                                 :: g2
00071     TYPE(pw_grid_type), POINTER              :: grid
00072     CHARACTER(len=*), PARAMETER :: routineN = 'mult_G_ov_G2_grid', 
00073       routineP = moduleN//':'//routineN
00074 
00075     TYPE(pw_type), POINTER                   :: frho, influence_fn
00076 
00077     failure = .FALSE.
00078     CALL timeset(routineN,handle)
00079 
00080     CPPrecondition(ASSOCIATED(cell),cp_failure_level,routineP,error,failure)
00081 
00082     CALL pw_pool_create_pw ( pw_pool, influence_fn,&
00083                use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE ,error=error)
00084 
00085     grid => influence_fn % pw_grid
00086     DO ig = grid % first_gne0, grid % ngpts_cut_local
00087        g2 = grid % gsq ( ig )
00088        influence_fn%cc(ig) = gaussi * grid % g(idir,ig)/g2
00089     END DO  ! ig
00090     IF ( grid % have_g0 )  influence_fn%cc ( 1 ) = 0.0_dp
00091 
00092     frho => funcG_times_rho%pw
00093     CALL pw_transfer (rho_gspace%pw,frho,error=error)
00094 
00095     ng = SIZE(grid % gsq)
00096     frho%cc(1:ng) = frho%cc(1:ng)*influence_fn % cc  ( 1 : ng )
00097     IF ( grid % have_g0 ) frho%cc(1) = my_chi
00098 
00099     CALL pw_pool_give_back_pw(pw_pool,influence_fn,&
00100          accept_non_compatible=.TRUE.,error=error)
00101 
00102     CALL timestop(handle)
00103 
00104   END SUBROUTINE  mult_G_ov_G2_grid
00105 
00106 END MODULE qs_linres_nmr_epr_common_utils