LCOV - code coverage report
Current view: top level - vgen - od_vvac.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 45 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_vvac
       8             : CONTAINS
       9           0 :   SUBROUTINE od_vvac(&
      10             :        &     stars,vacuum,cell,&
      11           0 :        &     psq,rht,&
      12           0 :        &     vz)
      13             : 
      14             :     !     subroutine which calculates the non warped part of the
      15             :     !     vacuum potential (m=0,gz=0)
      16             :     !                               Y. Mokrousov
      17             :     !     the potential in this subroutine can be defined in two
      18             :     !     equivalent ways, which nevertheless give a bit defferent 
      19             :     !     results, 2nd one seems to be more precise 
      20             : 
      21             :     USE m_qsf
      22             :     USE m_od_cylbes
      23             :     USE m_types
      24             :     USE m_constants
      25             :     IMPLICIT NONE
      26             :     TYPE(t_vacuum),INTENT(IN)   :: vacuum
      27             :     TYPE(t_stars),INTENT(IN)    :: stars
      28             :     TYPE(t_cell),INTENT(IN)     :: cell
      29             : 
      30             : 
      31             :     COMPLEX, INTENT (IN) :: psq(stars%ng3)
      32             :     REAL,    INTENT (IN) :: rht(:,:) !(vacuum%nmzd,2)
      33             :     REAL,    INTENT (OUT) :: vz(:,:) !(vacuum%nmzd,2)
      34             : 
      35             :     COMPLEX  rhobar
      36             :     INTEGER  k1,k2,irec3,irec2,i,j,ivac,imz,imz1
      37           0 :     REAL     g2 ,a(vacuum%nmzd)
      38             :     REAL     fJ,z,zp,phi
      39           0 :     REAL     rht1(vacuum%nmzd)
      40           0 :     REAL     f2(vacuum%nmzd),f22(vacuum%nmzd)
      41             : 
      42             :     INTRINSIC cmplx
      43             : 
      44             : 
      45           0 :     DO i = 1,vacuum%nmz
      46           0 :        f2(i) = 0.
      47           0 :        f22(i) = 0.
      48           0 :        DO ivac = 1,vacuum%nvac
      49           0 :           vz(i,ivac) = 0.
      50             :        END DO
      51             :     END DO
      52             : 
      53             : 
      54           0 :     rhobar = -psq(1)
      55             : 
      56           0 :     DO  k1 = -stars%mx1,stars%mx1
      57           0 :        DO  k2 = -stars%mx2,stars%mx2
      58           0 :           irec3 = stars%ig(k1,k2,0)
      59           0 :           IF (irec3.NE.0) THEN
      60           0 :              irec2 = stars%ig2(irec3)
      61           0 :              IF (irec2.NE.1) THEN
      62           0 :                 g2 = stars%sk2(irec2)
      63           0 :                 phi = stars%phi2(irec2)
      64           0 :                 CALL od_cylbes(1,cell%z1*g2,fJ)
      65           0 :                 rhobar = rhobar - 2.*psq(irec3)*CMPLX(fJ/(g2*cell%z1),0.0)
      66             : 
      67             :              END IF
      68             :           END IF
      69             :        ENDDO
      70             :     ENDDO
      71             :     !----> 1st equivalent way      
      72             : 
      73           0 :     DO  i=1,vacuum%nmz
      74           0 :        rht1(i) = fpi_const*(cell%z1+(i-1)*vacuum%delz)*rht(i,1)
      75             :     ENDDO
      76           0 :     CALL qsf(vacuum%delz,rht1(1),f2(1),vacuum%nmz,1)
      77             : 
      78           0 :     DO  i = 1,vacuum%nmz
      79           0 :        f2(i) = tpi_const*cell%z1*cell%z1*rhobar-f2(i)
      80             :     ENDDO
      81             : 
      82           0 :     DO  i = 1,vacuum%nmz
      83           0 :        DO  j = 1,vacuum%nmz
      84           0 :           IF (j.LT.i) THEN
      85           0 :              f22(j) = 0.0
      86             :           ELSE
      87           0 :              f22(j) = f2(j)/(cell%z1+vacuum%delz*(j-1))
      88             :           END IF
      89             :        ENDDO
      90           0 :        CALL qsf(vacuum%delz,f22(1),a,vacuum%nmz,0)
      91           0 :        DO  ivac =1,vacuum%nvac
      92           0 :           vz(i,ivac) = -a(1)
      93             :        ENDDO
      94             :     ENDDO
      95             :     !----> 2nd equivalent way (via the Green function)
      96             : 
      97           0 :     DO imz = 1,vacuum%nmz
      98           0 :        z = cell%z1 + (imz-1)*vacuum%delz
      99           0 :        DO imz1 = 1,vacuum%nmz
     100           0 :           zp = cell%z1 +  (imz1-1)*vacuum%delz
     101           0 :           IF (imz1.LE.imz) THEN
     102           0 :              rht1(imz1) = fpi_const*LOG(z)*zp*rht(imz1,1)
     103             :           ELSE
     104           0 :              rht1(imz1) = fpi_const*LOG(zp)*zp*rht(imz1,1)
     105             :           END IF
     106             : 
     107             :        END DO
     108           0 :        CALL qsf(vacuum%delz,rht1,a,vacuum%nmz,0)
     109           0 :        vz(imz,1) = tpi_const*LOG(z)*(cell%z1*cell%z1)*rhobar - a(1)
     110             :     END DO
     111             : 
     112           0 :     RETURN
     113             :   END SUBROUTINE od_vvac
     114             : END MODULE m_od_vvac
     115             : 
     116             : 
     117             :       
     118             :    
     119             :    
     120             : 
     121             : 
     122             : 
     123             : 
     124             : 
     125             : 
     126             :       
     127             : 
     128             : 
     129             : 
     130             :       
     131             : 

Generated by: LCOV version 1.13