Line data    Source code

       1             :       MODULE m_gtest
       2             :       use m_juDFT
       3             : !*********************************************************************
       4             : !     test the gaussian integration mesh for this l
       5             : !     1) integrate each ylm, 2) get normalization of each ylm,
       6             : !     3) (ylm(lmax,m=lmax | ylm) for all lm
       7             : !*********************************************************************
       8             :       CONTAINS
       9         372 :       SUBROUTINE gtest(lmax,ngpts,vgauss,wt)
      10             : 
      11             :       USE m_constants
      12             :       USE m_ylm
      13             :       IMPLICIT NONE
      14             : !
      15             :       INTEGER, INTENT (IN) :: lmax,ngpts
      16             :       REAL,    INTENT (IN) :: vgauss(3,*),wt(*) !   gaussian integration points
      17             : 
      18             :       INTEGER :: lm,lmmax,nn
      19             :       LOGICAL :: lerr
      20             :       COMPLEX :: temp
      21             :       REAL    :: v(3)
      22         372 :       COMPLEX, DIMENSION((lmax+1)**2) :: ylm,s1,s2,s3
      23             : 
      24             :       REAL, PARAMETER :: del = 1.e-10
      25             : 
      26         372 :       lmmax = (lmax+1)**2
      27       35272 :       DO lm = 1, lmmax
      28       34900 :          s1(lm)=cmplx(0.0,0.0)
      29       34900 :          s2(lm)=cmplx(0.0,0.0)
      30       35272 :          s3(lm)=cmplx(0.0,0.0)
      31             :       ENDDO
      32             : 
      33             : !---> loop over points
      34       73356 :       DO nn = 1, ngpts
      35      291936 :          v(:) = vgauss(:,nn)
      36             :          CALL ylm4(
      37             :      >             lmax,v,
      38       72984 :      <             ylm)
      39     7686500 :          DO lm = 1, lmmax
      40     7613144 :             s1(lm) = s1(lm) + wt(nn)*ylm(lm)
      41     7613144 :             s2(lm) = s2(lm) + wt(nn)*conjg(ylm(lm))*ylm(lm)
      42     7686128 :             s3(lm) = s3(lm) + wt(nn)*conjg(ylm(lmmax))*ylm(lm)
      43             :          ENDDO
      44             :       ENDDO
      45             : 
      46             : !---> check for non-zero elements
      47         372 :       lerr = .false.
      48       35272 :       DO lm=1,lmmax
      49       34900 :          IF ((abs(s1(lm)).GT.del).AND.(lm.GT.1)) THEN
      50           0 :             WRITE (oUnit,1000) lm,s1(lm)
      51           0 :             lerr = .true.
      52             :          ENDIF
      53             :  1000    FORMAT (20x,' integration of s.h. lm=',i3,1p,2e14.6)
      54             : 
      55       34900 :          temp = s2(lm) - cmplx(1.0,0.0)
      56       34900 :          IF (abs(temp).GT.del) THEN
      57           0 :             WRITE (oUnit,1001) lm,temp
      58           0 :             lerr = .true.
      59             :          ENDIF
      60             :  1001    FORMAT (20x,' normalization error lm=',i3,1p,2e14.6)
      61             : 
      62       35272 :          IF (abs(s3(lm)).GT.del) THEN
      63         372 :             IF(lm.ne.lmmax) THEN
      64           0 :               WRITE (oUnit,1002) lm,s3(lm)
      65           0 :               lerr = .true.
      66         372 :             ELSEIF( abs(abs(s3(lm))-1.0).GT.del ) THEN
      67           0 :               WRITE (oUnit,1002) lm,s3(lm)
      68           0 :               lerr = .true.
      69             :             ENDIF
      70             :          ENDIF
      71             :  1002    FORMAT (20x,' (ylm(lmax,lmax) | ylm)    lm=',i3,1p,2e14.6)
      72             :       ENDDO
      73             : 
      74         372 :       IF (lerr) THEN
      75           0 :         WRITE (oUnit,'(/,'' error in gaussian points'')')
      76           0 :          CALL juDFT_error("Error in gaussian points",calledby="gtest")
      77             :       ENDIF
      78             : 
      79         372 :       RETURN
      80             :       END SUBROUTINE gtest
      81             :       END MODULE m_gtest