LCOV - code coverage report
Current view: top level - init - boxdim.f (source / functions) Hit Total Coverage
Test: combined.info Lines: 26 28 92.9 %
Date: 2019-09-08 04:53:50 Functions: 1 1 100.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_boxdim
       8             :       CONTAINS
       9        6592 :       SUBROUTINE boxdim(
      10             :      >                  bmat,
      11             :      <                  arltv1,arltv2,arltv3)
      12             : c*********************************************************************
      13             : c      This subroutine determines the maximum number L, M and N
      14             : c      nrgvl, nrgvm, nrgvn, of reciprocal lattice vectors G(L,M,N) 
      15             : c      along the directions G(1), G(2), G(3), respectively, for which 
      16             : c
      17             : c                     | G(L,M,N) | <= GMAX.
      18             : c
      19             : c      This equation defines a "sphere" and the nrgvl,m,n define
      20             : c      the DIMension of the BOX in which the sphere is placed.
      21             : c
      22             : c      In reality the G(i)'s, do not form a carteasian coordinate 
      23             : c      system. Therefore the "sphere" is not a sphere, but an 
      24             : c      ellipsoid. For this ellipsoid the largest L, M and N component 
      25             : c      is determined as arltv1, arltv2, arltv3 to construct the boxes and
      26             : c
      27             : c                    nrgvl  = int( gmax/arltv1 ) + 1
      28             : c                    nrgvm  = int( gmax/arltv2 ) + 1
      29             : c                    nrgvn  = int( gmax/arltv3 ) + 1
      30             : c
      31             : c      G(i,xyz) is stored in bmat(i,xyz)
      32             : c
      33             : c      routine by s.bluegel from carpar-program
      34             : c 
      35             : c                         S. Bl"ugel, IFF, 13. Nov. 97    
      36             : c               tested by S. Heinze , IFF, 
      37             : c*********************************************************************
      38             :       use m_juDFT
      39             : c
      40             : C     .. Parameters ..
      41             :       IMPLICIT NONE
      42             : C
      43             : C     .. Scalar Arguments ..
      44             :       REAL,    INTENT (OUT) :: arltv1,arltv2,arltv3
      45             : C     ..
      46             : C     .. Array Arguments ..
      47             :       REAL,    INTENT (IN)  :: bmat(3,3)
      48             : C     ..
      49             : C     .. Local Scalars ..
      50             :       INTEGER ixyz,j,k
      51             :       REAL    denom,eps,one,zero
      52             : C     ..
      53             : C     .. Local Arrays ..
      54             :       REAL det(3,3),rr(3,3)
      55             : c     ..
      56             :       DATA one,eps,zero/1.0,1e-10,0.0/      
      57             : c
      58             : c--->  build up quadratic form for ellipsoid
      59             : c
      60       26368 :       DO j = 1 , 3
      61      145024 :          DO k = 1 , 3
      62       59328 :             rr(k,j) = zero
      63      257088 :             DO ixyz = 1 , 3
      64      237312 :                rr(k,j) = rr(k,j) + bmat(k,ixyz)*bmat(j,ixyz)
      65             :             ENDDO
      66             :          ENDDO
      67             :       ENDDO
      68             : c
      69             : c---> build determinants for Cramer's rule
      70             : c
      71        6592 :       det(1,1) = rr(2,2)*rr(3,3) - rr(3,2)*rr(2,3)
      72        6592 :       det(1,2) = rr(2,1)*rr(3,3) - rr(3,1)*rr(2,3)
      73        6592 :       det(1,3) = rr(2,1)*rr(3,2) - rr(3,1)*rr(2,2)
      74        6592 :       det(2,1) = rr(1,2)*rr(3,3) - rr(3,2)*rr(1,3)
      75        6592 :       det(2,2) = rr(1,1)*rr(3,3) - rr(3,1)*rr(1,3)
      76        6592 :       det(2,3) = rr(1,1)*rr(3,2) - rr(3,1)*rr(1,2)
      77        6592 :       det(3,1) = rr(1,2)*rr(2,3) - rr(2,2)*rr(1,3)
      78        6592 :       det(3,2) = rr(1,1)*rr(2,3) - rr(2,1)*rr(1,3)
      79        6592 :       det(3,3) = rr(1,1)*rr(2,2) - rr(2,1)*rr(1,2)
      80             : c
      81             : c---> check on the zeros of some determinants
      82             : c
      83       26368 :       DO j = 1 , 3
      84       26368 :          IF ( det(j,j) .lt. eps ) THEN
      85             :             WRITE (6,
      86           0 :      +                '('' problem with det('',i1,'','',i1,'')'')') j,j
      87           0 :             CALL juDFT_error(" boxdim: determinant",calledby ="boxdim")
      88             :          END IF
      89             :       ENDDO    
      90             : c
      91             : c---> scale determinants
      92             : c
      93       46144 :       DO k = 1 , 3
      94       19776 :          denom = one / det(k,k)
      95       79104 :          DO j = 1 , 3
      96       79104 :             det(k,j) = denom * det(k,j)
      97             :          ENDDO
      98       26368 :          det(k,k) = one / denom
      99             :       ENDDO
     100             : c
     101             : c---> calculate the maximum l, m, n components of the ellipsoid
     102             : c
     103             :       arltv1 = sqrt( rr(1,1) + rr(2,2)*det(1,2)*det(1,2)
     104             :      >                       + rr(3,3)*det(1,3)*det(1,3)
     105             :      >                       - (rr(1,2)+rr(1,2))*det(1,2)
     106             :      >                       + (rr(1,3)+rr(1,3))*det(1,3)
     107        6592 :      >                       - (rr(2,3)+rr(2,3))*det(1,2)*det(1,3))
     108             :       arltv2 = sqrt( rr(2,2) + rr(1,1)*det(2,1)*det(2,1)
     109             :      >                       + rr(3,3)*det(2,3)*det(2,3)
     110             :      >                       - (rr(1,2)+rr(1,2))*det(2,1)
     111             :      >                       + (rr(1,3)+rr(1,3))*det(2,1)*det(2,3)
     112        6592 :      >                       - (rr(2,3)+rr(2,3))*det(2,3))
     113             :       arltv3 = sqrt( rr(3,3) + rr(1,1)*det(3,1)*det(3,1)
     114             :      >                       + rr(2,2)*det(3,2)*det(3,2)
     115             :      >                       - (rr(1,2)+rr(1,2))*det(3,1)*det(3,2)
     116             :      >                       + (rr(1,3)+rr(1,3))*det(3,1)
     117        6592 :      >                       - (rr(2,3)+rr(2,3))*det(3,2))
     118             : 
     119        6592 :       RETURN
     120             :       END SUBROUTINE
     121             :       END

Generated by: LCOV version 1.13