scnc
/
quantum-espresso
mirror of https://gitlab.com/QEF/q-e.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Moved the debugging subroutines to a more logical place. 

git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@12104 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
timrov 2016-02-07 15:10:04 +00:00
parent ed9cf0f779
commit 6937dd5d57
6 changed files with 168 additions and 178 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
TDDFPT/src/lr_dav_main.f90
View File

@ -40,9 +40,6 @@ PROGRAM lr_dav_main
USE plugin_flags, ONLY : use_environ
USE environ_info, ONLY : environ_summary
#endif
!Debugging
USE lr_variables, ONLY: check_all_bands_gamma, check_density_gamma,check_vector_gamma
!
IMPLICIT NONE
INTEGER :: ibnd_occ,ibnd_virt,ibnd,ip

167
TDDFPT/src/lr_dot.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2001-2015 Quantum ESPRESSO group
! Copyright (C) 2001-2016 Quantum ESPRESSO group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
@ -181,3 +181,168 @@ CONTAINS
!
END FUNCTION lr_dot
!-----------------------------------------------------------------------
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!! Debugging subroutines
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SUBROUTINE check_vector_gamma (x)
!----------------------------------------------------------------------------
! Checks the inner product for a given vector, and its imaginary and real component
! input: evc
! output : screen output
!
USE kinds, ONLY : dp
USE mp_global, ONLY : inter_pool_comm, intra_bgrp_comm
USE mp, ONLY : mp_sum
USE klist , ONLY : npw_k=>ngk
USE gvect, ONLY : gstart
USE io_global, ONLY : stdout
!
IMPLICIT NONE
!input/output
COMPLEX(kind=dp),INTENT(in) :: x(:)
!
! local variables
!
REAL(kind=dp) :: temp_gamma
REAL(kind=dp), EXTERNAL :: DDOT
!
temp_gamma = 2.D0*DDOT(2*npw_k(1),x(:),1,x(:),1)
!
IF (gstart==2) temp_gamma = temp_gamma - dble(x(1))*dble(x(1))
!
#ifdef __MPI
CALL mp_sum(temp_gamma, intra_bgrp_comm)
#endif
!
WRITE(stdout,'("<x> = ",E15.8)') temp_gamma
!
RETURN
!
END SUBROUTINE check_vector_gamma
SUBROUTINE check_vector_f (x)
!-----------------------------------------------------------------------
!
! Checks the inner product for a given vector, and its imaginary and real component
! input: evc
! output: screen output
!
USE kinds, ONLY : dp
USE mp_global, ONLY : inter_pool_comm, intra_bgrp_comm
USE mp, ONLY : mp_sum
USE klist , ONLY : npw_k=>ngk
USE gvect, ONLY : gstart
USE io_global, ONLY : stdout
!
IMPLICIT NONE
!input/output
COMPLEX(kind=dp),INTENT(in) :: x(:)
!
! local variables
!
COMPLEX(kind=dp) :: temp_f
COMPLEX(kind=dp), EXTERNAL :: ZDOTC
!
temp_f = ZDOTC(npw_k(1),x(:),1,x(:),1)
!
#ifdef __MPI
CALL mp_sum(temp_f, intra_bgrp_comm)
#endif
!
WRITE(stdout,'("<x> = ",2E15.8,1X)') temp_f
!
RETURN
!
END SUBROUTINE check_vector_f
SUBROUTINE check_all_bands_gamma (x,sx,nbnd1,nbnd2)
!----------------------------------------------------------------------
!
! Checks all bands of given KS states for orthoganilty
! input: evc and sevc
! output : screen output
!
USE kinds, ONLY : dp
USE mp_global, ONLY : inter_pool_comm, intra_bgrp_comm
USE mp, ONLY : mp_sum
USE klist , ONLY : npw_k=>ngk
USE io_global, ONLY : stdout
USE gvect, ONLY : gstart
!
IMPLICIT NONE
!input/output
INTEGER, INTENT(in) :: nbnd1,nbnd2 !Total number of bands for x and sx
COMPLEX(kind=dp),INTENT(in) :: x(:,:), sx(:,:)
!
! local variables
!
INTEGER :: ibnd, jbnd
REAL(kind=dp) :: temp_gamma
REAL(kind=dp), EXTERNAL :: DDOT
!
DO ibnd=1,nbnd1
DO jbnd=ibnd,nbnd2
!
temp_gamma = 2.D0*DDOT(2*npw_k(1),x(:,ibnd),1,sx(:,jbnd),1)
!
IF (gstart==2) temp_gamma = temp_gamma - dble(x(1,ibnd))*dble(sx(1,jbnd))
!
#ifdef __MPI
CALL mp_sum(temp_gamma, intra_bgrp_comm)
#endif
!
WRITE(stdout,'("<x,",I02,"|S|x,",I02,"> =",E15.8)') ibnd,jbnd,temp_gamma
ENDDO
ENDDO
!
RETURN
!
END SUBROUTINE check_all_bands_gamma
SUBROUTINE check_density_gamma (rx,nbnd)
!---------------------------------------------------------------------------------
!
! Checks the contirbution of a given function transformed into real space
! input: revc
! output : screen output
!
USE kinds, ONLY : dp
USE mp_global, ONLY : inter_pool_comm, intra_bgrp_comm
USE mp, ONLY : mp_sum
USE wvfct, ONLY : wg
USE fft_base, ONLY : dfftp
USE io_global, ONLY : stdout
USE cell_base, ONLY : omega
!
IMPLICIT NONE
!input/output
INTEGER, INTENT(in) :: nbnd !Total number of bands for x and sx
COMPLEX(kind=dp),INTENT(in) :: rx(:,:)
!
! local variables
!
INTEGER :: ibnd
REAL(kind=dp) :: temp_gamma,w1,w2
!
DO ibnd=1,nbnd,2
w1 = wg(ibnd,1)/omega
!
IF (ibnd<nbnd) THEN
w2 = wg(ibnd+1,1)/omega
ELSE
w2 = w1
ENDIF
temp_gamma = sum(w1*dble(rx(1:dfftp%nnr,ibnd))*dble(rx(1:dfftp%nnr,ibnd))&
+ w2*aimag(rx(1:dfftp%nnr,ibnd))*aimag(rx(1:dfftp%nnr,ibnd)))
#ifdef __MPI
CALL mp_sum(temp_gamma, intra_bgrp_comm)
#endif
WRITE(stdout,'("Contribution of bands ",I02," and ",I02," to total density",E15.8)') ibnd,ibnd+1,temp_gamma
!
ENDDO
!
RETURN
!
END SUBROUTINE check_density_gamma

1
TDDFPT/src/lr_lanczos.f90
View File

@ -59,7 +59,6 @@ SUBROUTINE one_lanczos_step()
USE lr_us, ONLY : lr_apply_s
USE noncollin_module, ONLY : npol
! Debugging
USE lr_variables, ONLY : check_all_bands_gamma, check_density_gamma, check_vector_gamma
USE iso_c_binding, ONLY : c_int
USE qpoint, ONLY : nksq

4
TDDFPT/src/lr_main.f90
View File

@ -52,10 +52,6 @@ PROGRAM lr_main
USE plugin_flags, ONLY : use_environ
USE environ_info, ONLY : environ_summary
#endif
!Debugging
USE lr_variables, ONLY : check_all_bands_gamma, check_density_gamma, &
& check_vector_gamma
!
IMPLICIT NONE
!

4
TDDFPT/src/lr_read_wf.f90
View File

@ -104,9 +104,7 @@ SUBROUTINE normal_read()
!
! The usual way of reading wavefunctions
!
USE lr_variables, ONLY : check_all_bands_gamma, &
& check_density_gamma, &
& check_vector_gamma, tg_revc0
USE lr_variables, ONLY : tg_revc0
USE wavefunctions_module, ONLY : psic
USE realus, ONLY : tg_psic
USE mp_global, ONLY : me_bgrp

167
TDDFPT/src/lr_variables.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2001-2015 Quantum ESPRESSO group
! Copyright (C) 2001-2016 Quantum ESPRESSO group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
@ -165,169 +165,4 @@ MODULE lr_variables
INTEGER :: plot_type ! dumps rho as: 1=xyzd 2=xsf 3=cube
INTEGER :: sum_rule ! currently supported sum rules : -2 for alpha(w->0)
!
! I. Timrov's comment: It is not a proper place for debugging subroutines
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!! Debugging subroutines
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
CONTAINS
SUBROUTINE check_vector_gamma (x)
!----------------------------------------------------------------------------
! Checks the inner product for a given vector, and its imaginary and real component
! input: evc
! output : screen output
!
USE mp_global, ONLY : inter_pool_comm, intra_bgrp_comm
USE mp, ONLY : mp_sum
USE klist , ONLY : npw_k=>ngk
USE gvect, ONLY : gstart
USE io_global, ONLY : stdout
!
IMPLICIT NONE
!input/output
COMPLEX(kind=dp),INTENT(in) :: x(:)
!
! local variables
!
REAL(kind=dp) :: temp_gamma
REAL(kind=dp), EXTERNAL :: DDOT
!
temp_gamma = 2.D0*DDOT(2*npw_k(1),x(:),1,x(:),1)
!
IF (gstart==2) temp_gamma = temp_gamma - dble(x(1))*dble(x(1))
!
#ifdef __MPI
CALL mp_sum(temp_gamma, intra_bgrp_comm)
#endif
!
WRITE(stdout,'("<x> = ",E15.8)') temp_gamma
!
RETURN
!
END SUBROUTINE check_vector_gamma
SUBROUTINE check_vector_f (x)
!-----------------------------------------------------------------------
!
! Checks the inner product for a given vector, and its imaginary and real component
! input: evc
! output: screen output
!
USE mp_global, ONLY : inter_pool_comm, intra_bgrp_comm
USE mp, ONLY : mp_sum
USE klist , ONLY : npw_k=>ngk
USE gvect, ONLY : gstart
USE io_global, ONLY : stdout
!
IMPLICIT NONE
!input/output
COMPLEX(kind=dp),INTENT(in) :: x(:)
!
! local variables
!
COMPLEX(kind=dp) :: temp_f
COMPLEX(kind=dp), EXTERNAL :: ZDOTC
!
temp_f = ZDOTC(npw_k(1),x(:),1,x(:),1)
!
#ifdef __MPI
CALL mp_sum(temp_f, intra_bgrp_comm)
#endif
!
WRITE(stdout,'("<x> = ",2E15.8,1X)') temp_f
!
RETURN
!
END SUBROUTINE check_vector_f
SUBROUTINE check_all_bands_gamma (x,sx,nbnd1,nbnd2)
!----------------------------------------------------------------------
!
! Checks all bands of given KS states for orthoganilty
! input: evc and sevc
! output : screen output
!
USE mp_global, ONLY : inter_pool_comm, intra_bgrp_comm
USE mp, ONLY : mp_sum
USE klist , ONLY : npw_k=>ngk
USE io_global, ONLY : stdout
USE gvect, ONLY : gstart
!
IMPLICIT NONE
!input/output
INTEGER, INTENT(in) :: nbnd1,nbnd2 !Total number of bands for x and sx
COMPLEX(kind=dp),INTENT(in) :: x(:,:), sx(:,:)
!
! local variables
!
INTEGER :: ibnd, jbnd
REAL(kind=dp) :: temp_gamma
REAL(kind=dp), EXTERNAL :: DDOT
!
DO ibnd=1,nbnd1
DO jbnd=ibnd,nbnd2
!
temp_gamma = 2.D0*DDOT(2*npw_k(1),x(:,ibnd),1,sx(:,jbnd),1)
!
IF (gstart==2) temp_gamma = temp_gamma - dble(x(1,ibnd))*dble(sx(1,jbnd))
!
#ifdef __MPI
CALL mp_sum(temp_gamma, intra_bgrp_comm)
#endif
!
WRITE(stdout,'("<x,",I02,"|S|x,",I02,"> =",E15.8)') ibnd,jbnd,temp_gamma
ENDDO
ENDDO
!
RETURN
!
END SUBROUTINE check_all_bands_gamma
SUBROUTINE check_density_gamma (rx,nbnd)
!---------------------------------------------------------------------------------
!
! Checks the contirbution of a given function transformed into real space
! input: revc
! output : screen output
!
USE mp_global, ONLY : inter_pool_comm, intra_bgrp_comm
USE mp, ONLY : mp_sum
USE wvfct, ONLY : wg
USE fft_base, ONLY : dfftp
USE io_global, ONLY : stdout
USE cell_base, ONLY : omega
!
IMPLICIT NONE
!input/output
INTEGER, INTENT(in) :: nbnd !Total number of bands for x and sx
COMPLEX(kind=dp),INTENT(in) :: rx(:,:)
!
! local variables
!
INTEGER :: ibnd
REAL(kind=dp) :: temp_gamma,w1,w2
!
DO ibnd=1,nbnd,2
w1 = wg(ibnd,1)/omega
!
IF (ibnd<nbnd) THEN
w2 = wg(ibnd+1,1)/omega
ELSE
w2 = w1
ENDIF
temp_gamma = sum(w1*dble(rx(1:dfftp%nnr,ibnd))*dble(rx(1:dfftp%nnr,ibnd))&
+ w2*aimag(rx(1:dfftp%nnr,ibnd))*aimag(rx(1:dfftp%nnr,ibnd)))
#ifdef __MPI
CALL mp_sum(temp_gamma, intra_bgrp_comm)
#endif
WRITE(stdout,'("Contribution of bands ",I02," and ",I02," to total density",E15.8)') ibnd,ibnd+1,temp_gamma
!
ENDDO
!
RETURN
!
END SUBROUTINE check_density_gamma
END MODULE lr_variables