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_metrz0
       8             :       use m_juDFT
       9             : c     *****************************************************
      10             : c     calculates weights for a 7-point simpson integration
      11             : c     in analogy to intgz0
      12             : c                         r.pentcheva,24.06.96,kfa
      13             : c     work array whelp eliminated
      14             : c                         s.bluegel,  BNL 9.Aug.96
      15             : c     *****************************************************
      16             :       CONTAINS
      17          40 :       SUBROUTINE metr_z0(
      18             :      >                   nz,
      19          40 :      <                   wght)
      20             : 
      21             :       IMPLICIT NONE
      22             : C     ..
      23             : C     .. Scalar Arguments ..
      24             :       INTEGER, INTENT (IN) :: nz
      25             : C     ..
      26             : C     .. Array Arguments ..
      27             :       REAL,    INTENT (OUT) :: wght(nz)
      28             : C     ..
      29             : C     .. Local Scalars ..
      30             :       INTEGER i,iz,j,iz0,jz,nsteps
      31             :       INTEGER, PARAMETER :: nz7  = 7 , nz6 = 6
      32             :       REAL,    PARAMETER :: h0 = 140. 
      33             : C     ..
      34             : C     .. Local Arrays ..
      35             : !
      36             : ! lagrangian integration coefficients (simpson 7 point rule: error  h**9)
      37             : !
      38             :       INTEGER, DIMENSION(7),   PARAMETER :: ih =
      39             :      +                                       (/41,216,27,272,27,216,41/)
      40             :       REAL,    DIMENSION(7,5), PARAMETER :: a = RESHAPE(
      41             :      +  (/19087.,65112.,-46461., 37504.,-20211., 6312.,-863.,
      42             :      +     -863.,25128., 46989.,-16256.,  7299.,-2088., 271.,
      43             :      +      271.,-2760., 30819., 37504., -6771., 1608.,-191.,
      44             :      +     -191., 1608., -6771., 37504., 30819.,-2760., 271.,
      45             :      +      271.,-2088.,  7299.,-16256., 46989.,25128.,-863./),(/7,5/))
      46             : C     ..
      47        7040 :       wght(:)=0.0
      48          40 :       nsteps = (nz-1)/nz6
      49          40 :       iz0 = nz-nz6*nsteps
      50         160 :       DO iz = 1, iz0-1
      51             : c
      52             : c---> for iz-points, 1<iz<iz0<7, use lagrange interpolation, error: h**9
      53        1000 :          DO jz = 1, nz7
      54         960 :             wght(nz+1-iz) = wght(nz+1-iz)+ a(jz,iz)/432.0
      55             :          ENDDO
      56             :       ENDDO
      57             : c---> weights for simpson integration
      58          40 :       iz0 = nz - iz0 + 2
      59        1180 :       DO j=1,nsteps
      60        9120 :          DO i=1,nz7
      61        9120 :             wght(iz0-i) = wght(iz0-i) + ih(i)
      62             :          ENDDO
      63        1180 :          iz0 = iz0 - nz6
      64             :       ENDDO
      65          40 :       IF (iz0-1.ne.1)  CALL juDFT_error("iz0><nz0",calledby="metr_z0")
      66        7040 :       wght(:)=wght(:)/h0
      67             : 
      68          40 :       END SUBROUTINE metr_z0
      69             :       END MODULE m_metrz0
      70             :