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