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              :          use m_juDFT
       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 :       call timestart("wann_lapw_sph_plot")
      39              : 
      40            0 :       sx = 0.0
      41            0 :       DO 50 i = 1,3
      42            0 :          sx = sx + x(i)*x(i)
      43            0 :    50 CONTINUE
      44            0 :       sx = sqrt(sx)
      45            0 :       DO 80 j = jri-1,2,-1
      46            0 :          IF (sx.GE.rmsh(j)) GO TO 90
      47            0 :    80 CONTINUE
      48            0 :    90 jr = j
      49              :       CALL ylm4(
      50              :      >          lmaxn,x,
      51            0 :      <          ylm)
      52            0 :       xd1 = cmplx(0.,0.)
      53            0 :       xd2 = cmplx(0.,0.)
      54            0 :       DO l = 0,lmaxn
      55            0 :        DO 110 m = -l,l
      56            0 :         lm = l*(l+1)+m
      57            0 :         s = ylm(lm+1)*(ImagUnit)**l
      58              :         xd1 = xd1 + (acof(lm)*cmplx(ff(jr,l),0.)+
      59              :      +               bcof(lm)*cmplx(gg(jr,l),0.))*s/
      60            0 :      /               (rmsh(jr)) 
      61              : c        print*,"xd1=",xd1
      62            0 :         IF (jr.EQ.1) GO TO 110
      63              :         xd2 = xd2 + (acof(lm)*cmplx(ff(jr+1,l),0.)+
      64              :      +               bcof(lm)*cmplx(gg(jr+1,l),0.))*s/  
      65            0 :      /               (rmsh(jr+1))
      66              : 
      67            0 :   110  CONTINUE
      68              :       ENDDO
      69              : c..contributions from the local orbitals
      70            0 :       IF (nlo.GE.1) THEN
      71            0 :        DO l = 1,nlo
      72            0 :         DO 111 m = -llo(l),llo(l)
      73            0 :          lm = llo(l)*(llo(l)+1)+m
      74              : 
      75            0 :          s = ylm(lm+1)*(ImagUnit)**l
      76              :          xd1 = xd1 + ccof(m,l)*flo(jr,l)*s/
      77            0 :      /               (rmsh(jr))         
      78              :  
      79            0 :          IF (jr.EQ.1) GO TO 111
      80              :          xd2 = xd2 + ccof(m,l)*flo(jr+1,l)*s/
      81            0 :      /               (rmsh(jr+1))         
      82              : 
      83              :  
      84              : 
      85            0 :   111   CONTINUE
      86              :        ENDDO
      87              :       ENDIF    
      88            0 :       IF (jr.EQ.1) THEN
      89            0 :          xdnout = xd1
      90              :       ELSE
      91              :          xdnout = xd1 + (xd2-xd1) *
      92            0 :      +                  (sx-rmsh(jr)) / (rmsh(jr+1)-rmsh(jr))
      93              :          
      94              :       END IF
      95              : 
      96            0 :       call timestop("wann_lapw_sph_plot")
      97            0 :       END SUBROUTINE wann_lapw_sph_plot
      98              :       END MODULE m_wann_lapw_sph_plot