LCOV - code coverage report
Current view: top level - inpgen - setab.f (source / functions) Hit Total Coverage
Test: combined.info Lines: 34 39 87.2 %
Date: 2019-09-08 04:53:50 Functions: 1 1 100.0 %

          Line data    Source code
       1             :       MODULE m_setab
       2             :       use m_juDFT
       3             : !*********************************************************************
       4             : !     set up lattice quantities and matrices 
       5             : !*********************************************************************
       6             :       CONTAINS
       7           3 :       SUBROUTINE setab(
       8             :      >                 a1,a2,a3,aa,scale,
       9             :      <                 amat,bmat,aamat,bbmat,amatinv,omtil)
      10             : 
      11             :       USE m_constants
      12             : 
      13             :       IMPLICIT NONE
      14             : 
      15             : !==>  Arguments
      16             :       REAL, INTENT (IN)  :: aa
      17             :       REAL, INTENT (IN)  :: a1(3),a2(3),a3(3),scale(3)
      18             :       REAL, INTENT (OUT) :: amat(3,3),bmat(3,3),amatinv(3,3)
      19             :       REAL, INTENT (OUT) :: aamat(3,3),bbmat(3,3)
      20             :       REAL, INTENT (OUT) :: omtil
      21             : 
      22             : !==>  Locals
      23             :       INTEGER i, j
      24             :       REAL    volume
      25             :       LOGICAL lerr
      26             :       REAL    tmat(3,3),b1(3),b2(3),b3(3)
      27             : 
      28             : !  volume in scaled Cartesian units
      29             :       volume  = a1(1)*a2(2)*a3(3) + a2(1)*a3(2)*a1(3) +
      30             :      &          a3(1)*a1(2)*a2(3) - a1(3)*a2(2)*a3(1) -
      31           3 :      &          a2(3)*a3(2)*a1(1) - a3(3)*a1(2)*a2(1)
      32             : 
      33             : !  reciprocal lattice vectors in scaled Cartesian units
      34           3 :       b1(1) = (a2(2)*a3(3) - a2(3)*a3(2))/volume
      35           3 :       b1(2) = (a2(3)*a3(1) - a2(1)*a3(3))/volume
      36           3 :       b1(3) = (a2(1)*a3(2) - a2(2)*a3(1))/volume
      37           3 :       b2(1) = (a3(2)*a1(3) - a3(3)*a1(2))/volume
      38           3 :       b2(2) = (a3(3)*a1(1) - a3(1)*a1(3))/volume
      39           3 :       b2(3) = (a3(1)*a1(2) - a3(2)*a1(1))/volume
      40           3 :       b3(1) = (a1(2)*a2(3) - a1(3)*a2(2))/volume
      41           3 :       b3(2) = (a1(3)*a2(1) - a1(1)*a2(3))/volume
      42           3 :       b3(3) = (a1(1)*a2(2) - a1(2)*a2(1))/volume
      43             : 
      44             : !  volume and area (assuming a1 and a2 define surface periodicity)
      45           3 :       omtil = (aa**3)*scale(1)*scale(2)*scale(3)*volume
      46             : 
      47             : !  matrices of lattice vectors in full Cartesian units
      48             : 
      49          12 :       DO i=1,3
      50           9 :          amat(i,1) = aa*scale(i)*a1(i)
      51           9 :          amat(i,2) = aa*scale(i)*a2(i)
      52          12 :          amat(i,3) = aa*scale(i)*a3(i)
      53             :       ENDDO
      54             : 
      55          21 :       DO i=1,3
      56           9 :          bmat(1,i) = (pi_const/(aa*scale(i))) * b1(i)
      57           9 :          bmat(2,i) = (pi_const/(aa*scale(i))) * b2(i)
      58          12 :          bmat(3,i) = (pi_const/(aa*scale(i))) * b3(i)
      59             :       ENDDO
      60             : 
      61          21 :       DO i=1,3
      62           9 :          amatinv(1,i) = (1.0/(aa*scale(i))) * b1(i)
      63           9 :          amatinv(2,i) = (1.0/(aa*scale(i))) * b2(i)
      64          12 :          amatinv(3,i) = (1.0/(aa*scale(i))) * b3(i)
      65             :       ENDDO
      66             : 
      67             : !--->  check that amat and amatinv consistent 
      68             : !      (amat*amatinv should be identity)
      69             : 
      70           3 :       tmat = matmul( amat, amatinv )
      71             :       lerr = .false.
      72          21 :       DO j=1,3
      73           9 :          if( abs( tmat(j,j) - 1.000 ) .gt. 1.e-10 ) lerr = .true.
      74          66 :          DO i=1,3
      75          27 :             if(i.eq.j) cycle
      76          27 :             if( abs( tmat(i,j) ) .gt. 1.e-10 ) lerr = .true.
      77             :          ENDDO
      78             :       ENDDO
      79           3 :       IF (lerr) THEN
      80           0 :          WRITE(6,'(" error in set-up of amat and amatinv matrices")')
      81           0 :          WRITE(6,'(" (",3f12.8," )")') tmat(1,1),tmat(1,2),tmat(1,3)
      82           0 :          WRITE(6,'(" (",3f12.8," )")') tmat(2,1),tmat(2,2),tmat(2,3)
      83           0 :          WRITE(6,'(" (",3f12.8," )")') tmat(3,1),tmat(3,2),tmat(3,3)
      84             :          CALL juDFT_error("ERROR in amat,amatinv matrices",calledby
      85           0 :      +        ="setab")
      86             :       ENDIF
      87             : 
      88           3 :       aamat=matmul(transpose(amat),amat)
      89           3 :       bbmat=matmul(bmat,transpose(bmat))
      90             : 
      91           3 :       END SUBROUTINE setab
      92             :       END MODULE m_setab

Generated by: LCOV version 1.13