Line data    Source code

       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : 
       7             :       MODULE m_wann_lapw_sph_plot
       8             : 
       9             : c*****************************************************************
      10             : c            plot wannierfunction in muffin tins
      11             : c            Frank Freimuth, November 2006
      12             : c*****************************************************************
      13             :       CONTAINS
      14           0 :       SUBROUTINE wann_lapw_sph_plot(ff,gg,flo,acof,bcof,ccof,x,
      15           0 :      >         nlo,jmtd,lmaxd,nlod,llod,lmd,rmsh,lmaxn,llo,jri,
      16             :      <         xdnout)
      17             : 
      18             :       USE m_ylm
      19             :       use m_constants
      20             : 
      21             :       implicit none
      22             :       integer,intent(in)::jmtd,lmaxd,nlod,llod,lmd,lmaxn,nlo
      23             :       integer,intent(in)::llo(nlod),jri
      24             :       real,intent(in)::rmsh(jmtd)
      25             :       real,intent(in)::x(3)
      26             :       real,intent(in)::ff(jmtd,0:lmaxd)
      27             :       real,intent(in)::gg(jmtd,0:lmaxd)
      28             :       real,intent(in)::flo(jmtd,nlod)
      29             :       complex,intent(in)::acof(0:lmd)
      30             :       complex,intent(in)::bcof(0:lmd)
      31             :       complex,intent(in)::ccof(-llod:llod,nlod)
      32             :       complex,intent(out)::xdnout
      33             : 
      34             :       real sx
      35             :       integer i,j,jr,l,m,lm
      36           0 :       complex ylm((lmaxd+1)**2),xd1,xd2,s
      37             : 
      38           0 :       sx = 0.0
      39           0 :       DO 50 i = 1,3
      40           0 :          sx = sx + x(i)*x(i)
      41           0 :    50 CONTINUE
      42           0 :       sx = sqrt(sx)
      43           0 :       DO 80 j = jri-1,2,-1
      44           0 :          IF (sx.GE.rmsh(j)) GO TO 90
      45           0 :    80 CONTINUE
      46           0 :    90 jr = j
      47             :       CALL ylm4(
      48             :      >          lmaxn,x,
      49           0 :      <          ylm)
      50           0 :       xd1 = cmplx(0.,0.)
      51           0 :       xd2 = cmplx(0.,0.)
      52           0 :       DO l = 0,lmaxn
      53           0 :        DO 110 m = -l,l
      54           0 :         lm = l*(l+1)+m
      55           0 :         s = ylm(lm+1)*(ImagUnit)**l
      56             :         xd1 = xd1 + (acof(lm)*cmplx(ff(jr,l),0.)+
      57             :      +               bcof(lm)*cmplx(gg(jr,l),0.))*s/
      58           0 :      /               (rmsh(jr)) 
      59             : c        print*,"xd1=",xd1
      60           0 :         IF (jr.EQ.1) GO TO 110
      61             :         xd2 = xd2 + (acof(lm)*cmplx(ff(jr+1,l),0.)+
      62             :      +               bcof(lm)*cmplx(gg(jr+1,l),0.))*s/  
      63           0 :      /               (rmsh(jr+1))
      64             : 
      65           0 :   110  CONTINUE
      66             :       ENDDO
      67             : c..contributions from the local orbitals
      68           0 :       IF (nlo.GE.1) THEN
      69           0 :        DO l = 1,nlo
      70           0 :         DO 111 m = -llo(l),llo(l)
      71           0 :          lm = llo(l)*(llo(l)+1)+m
      72             : 
      73           0 :          s = ylm(lm+1)*(ImagUnit)**l
      74             :          xd1 = xd1 + ccof(m,l)*flo(jr,l)*s/
      75           0 :      /               (rmsh(jr))         
      76             :  
      77           0 :          IF (jr.EQ.1) GO TO 111
      78             :          xd2 = xd2 + ccof(m,l)*flo(jr+1,l)*s/
      79           0 :      /               (rmsh(jr+1))         
      80             : 
      81             :  
      82             : 
      83           0 :   111   CONTINUE
      84             :        ENDDO
      85             :       ENDIF    
      86           0 :       IF (jr.EQ.1) THEN
      87           0 :          xdnout = xd1
      88             :       ELSE
      89             :          xdnout = xd1 + (xd2-xd1) *
      90           0 :      +                  (sx-rmsh(jr)) / (rmsh(jr+1)-rmsh(jr))
      91             :          
      92             :       END IF
      93             : 
      94           0 :       END SUBROUTINE wann_lapw_sph_plot
      95             :       END MODULE m_wann_lapw_sph_plot