LCOV - code coverage report
Current view: top level - cdn - q_int_sl.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 45 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 1 0.0 %

          Line data    Source code
       1             : MODULE m_qintsl
       2             :   USE m_juDFT
       3             : CONTAINS
       4           0 :   SUBROUTINE q_int_sl(isp,ikpt,stars,atoms,sym,cell,ne,lapw,slab,oneD,zMat)          
       5             :     !     *******************************************************
       6             :     !     calculate the charge of the En(k) state 
       7             :     !     in the interstitial region of each leyer
       8             :     !                                             Yu.M. Koroteev
       9             :     !             From pwden_old.F and pwint.F by  c.l.fu
      10             :     !     *******************************************************
      11             : #include"cpp_double.h"
      12             :     USE m_pwintsl
      13             :     USE m_types
      14             :     IMPLICIT NONE
      15             : 
      16             :     TYPE(t_lapw),INTENT(IN)   :: lapw
      17             :     TYPE(t_oneD),INTENT(IN)   :: oneD
      18             :     TYPE(t_sym),INTENT(IN)    :: sym
      19             :     TYPE(t_stars),INTENT(IN)  :: stars
      20             :     TYPE(t_cell),INTENT(IN)   :: cell
      21             :     TYPE(t_atoms),INTENT(IN)  :: atoms
      22             :     TYPE(t_mat),INTENT(IN)    :: zMat
      23             :     TYPE(t_slab),INTENT(INOUT):: slab
      24             :     !
      25             :     !     .. Scalar Arguments ..
      26             :     INTEGER, INTENT (IN) :: ne,isp,ikpt
      27             :     !     ..
      28             :     !     .. Local Scalars ..
      29             :     REAL q1,zsl1,zsl2,qi,volsli,volintsli
      30             :     INTEGER i ,indp,ix1,iy1,iz1,j,n,ns,ind
      31             :     COMPLEX x,phase,phasep
      32             :     !     ..
      33             :     !     .. Local Arrays ..
      34           0 :     COMPLEX, ALLOCATABLE :: stfunint(:,:),z_z(:)
      35             : 
      36             :     !     ..
      37           0 :     IF (oneD%odi%d1) CALL juDFT_error("well, does not work with 1D. Not clear how to define a layer.",calledby ="q_int_sl")
      38             :     !
      39             :     !     calculate the star function expansion coefficients of
      40             :     !     the plane wave charge density for each En(k)
      41             :     !    
      42             :     !     ----> g=0 star
      43             :     !
      44           0 :     ALLOCATE ( stfunint(stars%ng3,slab%nsl), z_z(stars%ng3) ) 
      45             :     !
      46             :     !  -----> calculate the integrals of star functions over
      47             :     !                     the layer interstitial
      48             :     !
      49           0 :     DO i = 1,slab%nsl
      50           0 :        zsl1 = slab%zsl(1,i)
      51           0 :        zsl2 = slab%zsl(2,i)
      52           0 :        volsli = slab%volsl(i)
      53           0 :        volintsli = slab%volintsl(i)
      54           0 :        DO j = 1,stars%ng3
      55             :           CALL pwint_sl(stars,atoms,sym,zsl1,zsl2,&
      56           0 :                         volsli,volintsli,cell,slab%nmtsl(1,i),stars%kv3(1,j),x)
      57           0 :           stfunint(j,i) =  x*stars%nstr(j)
      58             :        ENDDO  ! over 3D stars
      59             :     ENDDO     ! over vacuum%layers
      60             :     !
      61             :     ! Here, I reordered the stuff to save memory
      62             :     !
      63           0 :     DO  n = 1,ne
      64           0 :        z_z(:) = CMPLX(0.0,0.0)
      65           0 :        q1 = 0.0
      66           0 :        IF (zmat%l_real) THEN
      67           0 :           DO  i = 1,lapw%nv(isp)
      68           0 :              q1 = q1 + zMat%data_r(i,n)*zMat%data_r(i,n)
      69             :           ENDDO
      70             :        ELSE
      71           0 :           DO  i = 1,lapw%nv(isp)
      72           0 :              q1 = q1 + REAL(zMat%data_c(i,n)*CONJG(zMat%data_c(i,n)))
      73             :           ENDDO
      74             :        ENDIF
      75           0 :        z_z(1) = q1/cell%omtil
      76             :        !
      77             :        !     ----> g.ne.0 stars
      78             :        !
      79           0 :        DO  i = 1,lapw%nv(isp)
      80           0 :           DO  j = 1,i-1
      81           0 :              ix1 = lapw%k1(j,isp) - lapw%k1(i,isp)
      82           0 :              iy1 = lapw%k2(j,isp) - lapw%k2(i,isp)
      83           0 :              iz1 = lapw%k3(j,isp) - lapw%k3(i,isp)
      84           0 :              IF (iabs(ix1).GT.stars%mx1) CYCLE
      85           0 :              IF (iabs(iy1).GT.stars%mx2) CYCLE
      86           0 :              IF (iabs(iz1).GT.stars%mx3) CYCLE
      87           0 :              ind = stars%ig(ix1,iy1,iz1)
      88           0 :              indp = stars%ig(-ix1,-iy1,-iz1)
      89           0 :              IF (ind.EQ.0 .OR. indp.EQ.0) CYCLE
      90           0 :              phase = stars%rgphs(ix1,iy1,iz1)/ (stars%nstr(ind)*cell%omtil)
      91           0 :              phasep = stars%rgphs(-ix1,-iy1,-iz1)/ (stars%nstr(indp)*cell%omtil)
      92           0 :              IF (zmat%l_real) THEN
      93           0 :                 z_z(ind)  = z_z(ind)  + zMat%data_r(j,n)*zMat%data_r(i,n)*REAL(phase)
      94           0 :                 z_z(indp) = z_z(indp) + zMat%data_r(i,n)*zMat%data_r(j,n)*REAL(phasep)
      95             :              ELSE
      96           0 :                 z_z(ind) = z_z(ind) +zMat%data_c(j,n)*CONJG(zMat%data_c(i,n))*phase
      97           0 :                 z_z(indp)= z_z(indp)+zMat%data_c(i,n)*CONJG(zMat%data_c(j,n))*phasep
      98             :              ENDIF
      99             :           ENDDO
     100             :        ENDDO
     101             :        ! ----> calculate a charge in the layer interstitial region of the film
     102             :        !
     103           0 :        DO i = 1,slab%nsl
     104             :           qi = 0.0
     105           0 :           DO j = 1,stars%ng3
     106           0 :              qi = qi + z_z(j)*stfunint(j,i)
     107             :           ENDDO
     108           0 :           slab%qintsl(i,n,ikpt,isp) = qi 
     109             :        ENDDO    ! over vacuum%layers         
     110             : 
     111             :     ENDDO ! over states
     112             : 
     113           0 :     DEALLOCATE ( stfunint, z_z ) 
     114             : 
     115           0 :   END SUBROUTINE q_int_sl
     116             : END MODULE m_qintsl

Generated by: LCOV version 1.13