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          108 :       SUBROUTINE metr_z0(
      18              :      >                   nz,
      19          108 :      <                   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        19008 :       wght(:)=0.0
      48          108 :       nsteps = (nz-1)/nz6
      49          108 :       iz0 = nz-nz6*nsteps
      50          432 :       DO iz = 1, iz0-1
      51              : c
      52              : c---> for iz-points, 1<iz<iz0<7, use lagrange interpolation, error: h**9
      53         2700 :          DO jz = 1, nz7
      54         2592 :             wght(nz+1-iz) = wght(nz+1-iz)+ a(jz,iz)/432.0
      55              :          ENDDO
      56              :       ENDDO
      57              : c---> weights for simpson integration
      58          108 :       iz0 = nz - iz0 + 2
      59         3186 :       DO j=1,nsteps
      60        24624 :          DO i=1,nz7
      61        24624 :             wght(iz0-i) = wght(iz0-i) + ih(i)
      62              :          ENDDO
      63         3186 :          iz0 = iz0 - nz6
      64              :       ENDDO
      65          108 :       IF (iz0-1.ne.1)  CALL juDFT_error("iz0><nz0",calledby="metr_z0")
      66        19008 :       wght(:)=wght(:)/h0
      67              : 
      68          108 :       END SUBROUTINE metr_z0
      69              :       END MODULE m_metrz0
      70              :