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

          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_od_abvac
       8             : CONTAINS
       9           0 :   SUBROUTINE od_abvac(&
      10             :        &     cell,vacuum,DIMENSION,stars,&
      11             :        &     oneD,qssbti,&
      12             :        &     n2d_1,&
      13             :        &     wronk,evac,bkpt,MM,vM,&
      14           0 :        &     vz,kvac3,nv2,&
      15           0 :        &     uz,duz,u,udz,dudz,ddnv,ud)
      16             :     !**************************************************************
      17             :     !      determines the nesessary values and derivatives on the 
      18             :     !      vacuum cylindrical boundary for finding a and b coefficients
      19             :     !      for the construcing vacuum charge density in vacden.F
      20             :     !                          Y.Mokrousov, 7th of october 2002
      21             :     !*************************************************************** 
      22             :     USE m_vacuz
      23             :     USE m_vacudz
      24             :     USE m_types
      25             :     IMPLICIT NONE
      26             :     TYPE(t_dimension),INTENT(IN)   :: DIMENSION
      27             :     TYPE(t_oneD),INTENT(IN)        :: oneD
      28             :     TYPE(t_vacuum),INTENT(IN)      :: vacuum
      29             :     TYPE(t_stars),INTENT(IN)       :: stars
      30             :     TYPE(t_cell),INTENT(IN)        :: cell
      31             : 
      32             :     !     .. scalar Arguments..
      33             :     REAL wronk
      34             :     INTEGER, INTENT (in) :: MM ,vM
      35             :     INTEGER, INTENT (in) :: n2d_1,nv2
      36             :     REAL,    INTENT (in) :: evac
      37             :     !     ..array arguments..
      38             : 
      39             :     INTEGER, INTENT (in) :: kvac3(DIMENSION%nv2d)
      40             :     REAL,    INTENT (in) :: bkpt(3),qssbti 
      41             :     REAL,    INTENT (in) :: vz(vacuum%nmzd) 
      42             :     REAL,    INTENT (out):: udz(DIMENSION%nv2d,-vM:vM)
      43             :     REAL,    INTENT (out):: uz(DIMENSION%nv2d,-vM:vM)
      44             :     REAL,    INTENT (out):: dudz(DIMENSION%nv2d,-vM:vM)
      45             :     REAL,    INTENT (out):: duz(DIMENSION%nv2d,-vM:vM)
      46             :     REAL,    INTENT (out):: u(vacuum%nmzd,DIMENSION%nv2d,-vM:vM)
      47             :     REAL,    INTENT (out):: ud(vacuum%nmzd,DIMENSION%nv2d,-vM:vM)
      48             :     REAL,    INTENT (out):: ddnv(DIMENSION%nv2d,-vM:vM)
      49             :     !     ..local scalars..
      50             :     REAL ev,scale,xv,yv,vzero,v1
      51             :     INTEGER i,ik,jk,jspin,jsp1,jsp2 ,l,m
      52             :     INTEGER i1,i2,i3,ind1,ind3
      53             :     !     .. local arrays..
      54           0 :     REAL wdz(DIMENSION%nv2d,-vM:vM),wz(DIMENSION%nv2d,-vM:vM)
      55           0 :     REAL dwdz(DIMENSION%nv2d,-vM:vM),dwz(DIMENSION%nv2d,-vM:vM)
      56             :     REAL v(3),x(vacuum%nmzd)
      57           0 :     REAL  vr0(vacuum%nmzd)
      58           0 :     REAL w(vacuum%nmzd,DIMENSION%nv2d,-vM:vM),wd(vacuum%nmzd,DIMENSION%nv2d,-vM:vM)
      59             : 
      60             :     !     wronksian for the schrodinger equation given by an identity
      61             : 
      62           0 :     wronk = 2.0
      63             : 
      64           0 :     DO  ik = 1,nv2
      65           0 :        DO  m = 0,vM
      66           0 :           v(1) = 0.0
      67           0 :           v(2) = 0.0
      68           0 :           v(3) = bkpt(3) + kvac3(ik) + qssbti
      69           0 :           ev = evac - 0.5*DOT_PRODUCT(v,MATMUL(v,cell%bbmat))
      70             : 
      71             :           !     constructing of the 'pseudopotential'
      72             : 
      73           0 :           DO  i=1,vacuum%nmz
      74             :              v1 = 1./(8.*((cell%z1+(i-1)*vacuum%delz)**2))&
      75           0 :                   &              -(m*m)/(2.*((cell%z1+(i-1)*vacuum%delz)**2))
      76           0 :              vr0(i) = vz(i)-v1
      77             :           ENDDO
      78           0 :           vzero = vr0(vacuum%nmz)
      79             : 
      80             :           !     obtaining solutions with the 'pseudopotential'
      81             : 
      82             :           CALL vacuz(ev,vr0(1),vzero,vacuum%nmz,vacuum%delz,&
      83           0 :                           wz(ik,m),dwz(ik,m),w(1,ik,m))
      84             :           CALL vacudz(ev,vr0(1),vzero,vacuum%nmz,vacuum%delz,&
      85           0 :                wdz(ik,m),dwdz(ik,m),ddnv(ik,m), wd(1,ik,m),dwz(ik,m),w(1,ik,m))
      86             : 
      87             :           scale = wronk/(wdz(ik,m)*dwz(ik,m)-&
      88           0 :                &           dwdz(ik,m)*wz(ik,m))
      89           0 :           wdz(ik,m) = scale*wdz(ik,m)
      90           0 :           dwdz(ik,m) = scale*dwdz(ik,m)
      91           0 :           ddnv(ik,m) = scale*ddnv(ik,m)
      92           0 :           IF (m.GT.0) THEN
      93           0 :              wdz(ik,-m) = wdz(ik,m)
      94           0 :              dwdz(ik,-m) = dwdz(ik,m)
      95           0 :              ddnv(ik,-m) = ddnv(ik,m)
      96             :           END IF
      97           0 :           DO  i = 1,vacuum%nmz
      98           0 :              wd(i,ik,m) = scale*wd(i,ik,m)
      99           0 :              w(i,ik,m) = scale*w(i,ik,m)
     100           0 :              IF (m.GT.0) THEN
     101           0 :                 wd(i,ik,-m) = wd(i,ik,m)
     102           0 :                 w(i,ik,-m) = w(i,ik,m)
     103             :              END IF
     104             :           ENDDO
     105             :           !     constructing 'real' solutions
     106             : 
     107           0 :           DO  i=1,vacuum%nmz
     108           0 :              u(i,ik,m)=w(i,ik,m)/SQRT(cell%z1+(i-1)*vacuum%delz)
     109           0 :              ud(i,ik,m)=wd(i,ik,m)/SQRT(cell%z1+(i-1)*vacuum%delz)
     110           0 :              IF (m.GT.0) THEN
     111           0 :                 u(i,ik,-m) = u(i,ik,m)
     112           0 :                 ud(i,ik,-m) = ud(i,ik,m)
     113             :              END IF
     114             :           ENDDO
     115             :           duz(ik,m)=(-dwz(ik,m))/SQRT(cell%z1)-&
     116           0 :                &           wz(ik,m)/(2.0*((cell%z1)**(1.5)))
     117           0 :           uz(ik,m)=wz(ik,m)/SQRT(cell%z1)
     118             :           dudz(ik,m)=(-dwdz(ik,m))/SQRT(cell%z1)-&
     119           0 :                &           wdz(ik,m)/(2.0*((cell%z1)**(1.5)))
     120           0 :           udz(ik,m)=wdz(ik,m)/SQRT(cell%z1)
     121           0 :           IF (m.GT.0) THEN
     122           0 :              duz(ik,-m) = duz(ik,m)
     123           0 :              uz(ik,-m) = uz(ik,m)
     124           0 :              dudz(ik,-m) = dudz(ik,m)
     125           0 :              udz(ik,-m) = udz(ik,m)
     126             :           END IF
     127             : 
     128             :        ENDDO
     129             :     ENDDO
     130           0 :     RETURN
     131             :   END SUBROUTINE od_abvac
     132             : END MODULE m_od_abvac

Generated by: LCOV version 1.13