LCOV - code coverage report
Current view: top level - eigen_secvar - aline_muff.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 20 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_alinemuff
       8             :   !************************************************************************
       9             :   !*                                                                      *
      10             :   !*     eigensystem-solver for moderatly-well converged potentials       *
      11             :   !*     a*z=e*b*z is transformed to h*z'=e*s*z' , whereby                *
      12             :   !*     h=C^T*a*C, s=C^T*b*C and z'=C^(-1)*z, when C is z of the last    *
      13             :   !*     iteration (lapw%nv*ne-array)                                          *
      14             :   !*     For ne<<lapw%nv the matrixsize is significantly reduced               *
      15             :   !*     aline uses ESSL-calls (use LAPACK's reduc3, tred3, bisect,       *
      16             :   !*     tinvit, trback and rebk3  if no ESSL available):                 *
      17             :   !*     SSPEV:  eigensystem-solver for symmetric, real packes h          *
      18             :   !*             here we have no s-matrix                                 *
      19             :   !*     For all eigenvalues are needed, SSPEV should perform better      *
      20             :   !*     then seclr4 (hope so)                                            *
      21             :   !*                                                     Gustav           *
      22             :   !*                                                                      *
      23             :   !************************************************************************
      24             : CONTAINS
      25           0 :   SUBROUTINE aline_muff(atoms,DIMENSION,sym, cell, jsp,ne, usdus,td, bkpt,lapw, eig,z_r,z_c,realdata)
      26             : 
      27             : #include"cpp_double.h"
      28             : 
      29             :     USE m_hnonmuff
      30             :     USE m_types
      31             :     IMPLICIT NONE
      32             :     TYPE(t_dimension),INTENT(IN)   :: DIMENSION
      33             :     TYPE(t_sym),INTENT(IN)         :: sym
      34             :     TYPE(t_cell),INTENT(IN)        :: cell
      35             :     TYPE(t_atoms),INTENT(IN)       :: atoms
      36             :     TYPE(t_usdus),INTENT(IN)       :: usdus
      37             :     TYPE(t_lapw),INTENT(IN)        :: lapw
      38             :     TYPE(t_tlmplm),INTENT(IN)      :: td
      39             :     !     ..
      40             :     !     .. Scalar Arguments ..
      41             :     INTEGER, INTENT (IN) :: jsp,ne   
      42             :     !     ..
      43             :     !     .. Array Arguments ..
      44             :     REAL,    INTENT (IN) :: bkpt(3)   
      45             :     REAL,    INTENT (INOUT) :: eig(DIMENSION%neigd)
      46             : 
      47             :     REAL,    OPTIONAL,INTENT (INOUT) :: z_r(DIMENSION%nbasfcn,ne)
      48             :     COMPLEX, OPTIONAL,INTENT (INOUT) :: z_c(DIMENSION%nbasfcn,ne)
      49             :     LOGICAL,OPTIONAL,INTENT(IN):: realdata
      50             :     !     ..
      51             :     !     .. Local Scalars ..
      52             :     INTEGER i,info,j,ii
      53             :     !     ..
      54             :     !     .. Local Arrays ..
      55           0 :     REAL h(ne*(ne+1)/2),help(3*ne),z1(ne,ne)
      56             :     !     ..
      57             :     !     .. External Functions ..
      58             :     REAL CPP_BLAS_sdot
      59             :     EXTERNAL CPP_BLAS_sdot
      60             :     !     ..
      61             :     !     .. External Subroutines ..
      62             :     EXTERNAL CPP_LAPACK_ssygv
      63             :     LOGICAL l_real
      64             : 
      65           0 :     l_real=present(z_r)
      66           0 :     if (present(realdata)) l_real=realdata
      67             : 
      68             :     !     ..
      69             :     !---> initialize the hamiltonian and overlap matrix
      70           0 :        h = 0.0
      71             :        !---> add the diagonal (muffin-tin) terms
      72           0 :        DO i = 1,ne
      73           0 :           ii = (i-1)*i/2 + i
      74           0 :           h(ii) = eig(i)
      75             :        END DO
      76             :    
      77             :     !---> add the off-diagonal (non-muffin-tin) terms
      78           0 :     CALL h_nonmuff(atoms,DIMENSION,sym, cell, jsp,ne, usdus,td, bkpt,lapw, h,l_real,z_r,z_c)
      79             : 
      80             :     !---> DIAGONALIZE THE HAMILTONIAN USING LIBRARY-ROUTINES
      81             : #ifdef CPP_ESSL
      82             :     !---> ESSL call, IBM AIX
      83             :     CALL CPP_LAPACK_sspev (21, h, eig,z1, ne,ne,help,3*ne)
      84             : #else
      85             :     !---> LAPACK call
      86           0 :     CALL CPP_LAPACK_sspev ('V','U',ne, h, eig,z1, ne,help, info)
      87           0 :     WRITE (6,FMT=8000) info
      88             : 8000 FORMAT (' AFTER CPP_LAPACK_sspev: info=',i4)
      89             : #endif
      90             : 
      91             :     !---> store eigenvectors on array z
      92           0 :     DO i = 1,lapw%nv(jsp)
      93           0 :        if (l_real) THEN
      94           0 :           help(:ne)=z_r(i,:ne)
      95           0 :           DO j = 1,ne
      96           0 :              z_r(i,j) = CPP_BLAS_sdot(ne,help,1,z1(1,j),1)
      97             :           END DO
      98             :        else
      99           0 :           help(:ne)=z_c(i,:ne)
     100           0 :           DO j = 1,ne
     101           0 :              z_c(i,j) = CPP_BLAS_sdot(ne,help,1,z1(1,j),1)
     102             :           END DO
     103             :        endif
     104             :     END DO
     105             : 
     106           0 :   END SUBROUTINE aline_muff
     107             : END MODULE m_alinemuff

Generated by: LCOV version 1.13