Line data    Source code

       1             : MODULE m_pwintsl
       2             : CONTAINS
       3           0 :   SUBROUTINE pwint_sl(stars,atoms,sym,zsl1,zsl2, volsl,volintsl, cell,nmtsl1, kv, x)
       4             :     !     ******************************************************************
       5             :     !     calculate the integral of a star function over the layer 
       6             :     !     interstial region of a film                Yury Koroteev  
       7             :     !                                   from  pwint.F  by  c.l.fu              
       8             :     !     ******************************************************************
       9             :     USE m_spgrot
      10             :     USE m_constants,ONLY: tpi_const
      11             :     USE m_types
      12             :     IMPLICIT NONE
      13             :     TYPE(t_sym),INTENT(IN)     :: sym
      14             :     TYPE(t_stars),INTENT(IN)   :: stars
      15             :     TYPE(t_cell),INTENT(IN)    :: cell
      16             :     TYPE(t_atoms),INTENT(IN)   :: atoms
      17             :     !     ..
      18             :     !     .. Scalar Arguments ..
      19             :     REAL,    INTENT (IN) :: zsl1,zsl2,volsl,volintsl
      20             :     COMPLEX, INTENT (OUT):: x
      21             :     !     ..
      22             :     !     .. Array Arguments ..
      23             :     INTEGER, INTENT (IN) :: kv(3)  
      24             :     INTEGER, INTENT (IN) :: nmtsl1(atoms%ntype) 
      25             :     !     ..
      26             :     !     .. Local Scalars ..
      27             :     COMPLEX s1,sfs
      28             :     REAL arg,g,s,srmt,gm,gp,zslm,zslp
      29             :     INTEGER ig2d,ig3d,n,nn,nat 
      30             :     !     ..
      31             :     !     .. Local Arrays ..
      32           0 :     COMPLEX ph(sym%nop)
      33           0 :     INTEGER kr(3,sym%nop)
      34             :     !     ..
      35           0 :     ig3d = stars%ig(kv(1),kv(2),kv(3))
      36             :     !
      37             :     !     -----> interstitial contributions
      38             :     !
      39           0 :     IF (ig3d.EQ.0) THEN
      40           0 :        x = (0.,0.)
      41           0 :        RETURN
      42             :     END IF
      43           0 :     IF (ig3d.EQ.1) THEN
      44           0 :        x = CMPLX(volintsl,0.0)
      45           0 :        RETURN
      46             :     ELSE
      47           0 :        ig2d = stars%ig2(ig3d)
      48           0 :        IF (ig2d.EQ.1) THEN
      49           0 :           zslm = 0.5*(zsl2 - zsl1) 
      50           0 :           zslp = 0.5*(zsl2 + zsl1)
      51           0 :           g = kv(3)*cell%bmat(3,3)
      52           0 :           gm = g*zslm
      53           0 :           gp = g*zslp
      54           0 :           x = volsl*SIN(gm)/gm*CMPLX(COS(gp),SIN(gp))
      55             :        ELSE
      56           0 :           x = (0.0,0.0)
      57             :        END IF
      58             :     END IF
      59             :     !
      60             :     !     -----> sphere contributions
      61             :     !
      62           0 :     s = stars%sk3(ig3d)
      63           0 :     DO n = 1,atoms%ntype
      64           0 :        nat = atoms%firstAtom(n)
      65           0 :        srmt = s*atoms%rmt(n)
      66           0 :        CALL spgrot(sym%nop,sym%symor,sym%mrot,sym%tau,sym%invtab, kv, kr,ph)
      67           0 :        sfs = (0.0,0.0)
      68           0 :        DO  nn = 1,sym%nop
      69           0 :           arg = tpi_const* dot_product(real(kr(:,nn)),atoms%taual(:,nat))
      70           0 :           sfs = sfs + CMPLX(COS(arg),SIN(arg))*ph(nn)
      71             :        ENDDO
      72           0 :        sfs = sfs/sym%nop
      73             :        !
      74             :        !     -----3*ji(gr)/gr term
      75             :        !
      76           0 :        s1 = 3.* (SIN(srmt)/srmt-COS(srmt))/ (srmt*srmt)
      77           0 :        x = x - atoms%volmts(n)*nmtsl1(n)*s1*sfs
      78             :     ENDDO
      79             :     !
      80             :   END SUBROUTINE pwint_sl
      81             : END MODULE m_pwintsl