LCOV - code coverage report
Current view: top level - eigen_secvar - aline.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 68 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_aline
       8             :   USE m_juDFT
       9             : CONTAINS
      10           0 :   SUBROUTINE aline(eig_id, nk,atoms,DIMENSION,sym,&
      11           0 :        cell,input, jsp,el,usdus,lapw,tlmplm, noco, oneD,eig,ne,zMat,hmat,smat)
      12             :     !************************************************************************
      13             :     !*                                                                      *
      14             :     !*     eigensystem-solver for moderatly-well converged potentials       *
      15             :     !*     a*z=e*b*z is transformed to h*z'=e*s*z' , whereby                *
      16             :     !*     h=C^T*a*C, s=C^T*b*C and z'=C^(-1)*z, when C is z of the last    *
      17             :     !*     iteration (lapw%nv*ne-array)                                          *
      18             :     !*     For ne<<lapw%nv the matrixsize is significantly reduced               *
      19             :     !*     aline uses ESSL-calls (use LAPACK's reduc3, tred3, bisect,       *
      20             :     !*     tinvit, trback and rebk3  if no ESSL available):                 *
      21             :     !*     SSPMV:  matrix-vector multiplication for symmetric matrices      *
      22             :     !*             in packed storage.                                       *
      23             :     !*     SSYGV:  eigensystem-solver for symmetric, real h and positive    *
      24             :     !*             definite, real, symmetric s using Cholesky-factorisation *
      25             :     !*             tridiagonalisation and a QL-algorithm.                   *
      26             :     !*     For all eigenvalues are needed, DSYGV should perform better      *
      27             :     !*     then seclr4 (hope so)                                            *
      28             :     !*                                                     Gustav           * *                                                                      *
      29             :     !************************************************************************
      30             : 
      31             : #include"cpp_double.h"
      32             :     USE m_abcof
      33             :     USE m_hssrwu
      34             :     USE m_eig66_io
      35             :     USE m_types
      36             :     IMPLICIT NONE
      37             :     TYPE(t_dimension),INTENT(IN)   :: DIMENSION
      38             :     TYPE(t_oneD),INTENT(IN)        :: oneD
      39             :     TYPE(t_input),INTENT(IN)       :: input
      40             :     TYPE(t_noco),INTENT(IN)        :: noco
      41             :     TYPE(t_sym),INTENT(IN)         :: sym
      42             :     TYPE(t_cell),INTENT(IN)        :: cell
      43             :     TYPE(t_atoms),INTENT(IN)       :: atoms
      44             :     TYPE(t_usdus),INTENT(IN)       :: usdus
      45             :     TYPE(t_tlmplm),INTENT(IN)      :: tlmplm
      46             :     TYPE(t_lapw),INTENT(INOUT)     :: lapw
      47             :     TYPE(t_mat),INTENT(INOUT)      :: zMat
      48             : 
      49             :     !     ..
      50             :     !     .. Scalar Arguments ..
      51             :     INTEGER, INTENT (IN) :: eig_id
      52             :     INTEGER, INTENT (IN) :: jsp,nk
      53             :     INTEGER, INTENT (OUT):: ne
      54             :     !     ..
      55             :     !     .. Array Arguments ..
      56             :     REAL,    INTENT (IN)  :: el(0:atoms%lmaxd,atoms%ntype,input%jspins)
      57             :     REAL,    INTENT (OUT) :: eig(DIMENSION%neigd)
      58             :     TYPE(t_mat),INTENT(IN):: hmat,smat
      59             : 
      60             :     !     ..
      61             :     !     .. Local Scalars ..
      62             :     INTEGER lhelp
      63             :     INTEGER i,info,j 
      64             :     !     ..
      65             :     !     .. Local Arrays ..
      66           0 :     COMPLEX, ALLOCATABLE :: acof(:,:,:),bcof(:,:,:),ccof(:,:,:,:)
      67             : 
      68           0 :     REAL,    ALLOCATABLE :: help_r(:),h_r(:,:),s_r(:,:) 
      69             :     REAL     CPP_BLAS_sdot
      70             :     EXTERNAL CPP_BLAS_sdot,CPP_BLAS_sspmv
      71             : 
      72             :     COMPLEX,   PARAMETER :: one_c=(1.0,0.0), zro_c=(0.0,0.0)
      73           0 :     COMPLEX, ALLOCATABLE :: help_c(:),h_c(:,:),s_c(:,:) 
      74             :     COMPLEX  CPP_BLAS_cdotc
      75             :     EXTERNAL CPP_BLAS_cdotc,CPP_BLAS_chpmv
      76           0 :     REAL,    ALLOCATABLE :: rwork(:)
      77             : 
      78             :     LOGICAL:: l_real
      79           0 :     l_real=zMat%l_real
      80             : 
      81             : 
      82           0 :     lhelp= MAX(lapw%nmat,(DIMENSION%neigd+2)*DIMENSION%neigd)
      83           0 :     CALL read_eig(eig_id,nk,jsp,neig=ne, eig=eig,zmat=zmat)
      84           0 :     IF (l_real) THEN
      85           0 :        ALLOCATE ( h_r(DIMENSION%neigd,DIMENSION%neigd),s_r(DIMENSION%neigd,DIMENSION%neigd) )
      86           0 :        h_r = 0.0 ; s_r=0.0
      87           0 :        ALLOCATE ( help_r(lhelp) )
      88             :     ELSE
      89             :        !     in outeig z is complex conjugated to make it usable for abcof. Here we 
      90             :        !                       first have to undo this  complex conjugation for the 
      91             :        ! multiplication with a and b matrices.
      92             : 
      93           0 :        zmat%data_c=conjg(zmat%data_c)
      94           0 :        ALLOCATE ( h_c(DIMENSION%neigd,DIMENSION%neigd),s_c(DIMENSION%neigd,DIMENSION%neigd) )
      95           0 :        h_c = 0.0 ; s_c=0.0
      96           0 :        ALLOCATE ( help_r(lhelp) )
      97             :     ENDIF
      98             :     !
      99           0 :     DO i = 1,ne
     100           0 :        IF (l_real) THEN
     101           0 :           help_r=MATMUL(hmat%data_r,zmat%data_r(:,i))
     102             :        ELSE
     103           0 :           help_c=MATMUL(hmat%data_c,zmat%data_c(:,i))
     104             :        ENDIF
     105           0 :        DO j = i,ne
     106           0 :           IF (l_real) THEN
     107           0 :              h_r(j,i)=dot_PRODUCT(zmat%data_r(:,j),help_r)
     108             :           ELSE
     109           0 :              h_c(j,i)=dot_PRODUCT(zmat%data_c(:,j),help_c)
     110             :           ENDIF
     111             :        END DO
     112             :     END DO
     113             : 
     114           0 :     DO i = 1,ne
     115           0 :        IF (l_real) THEN
     116           0 :           help_r=MATMUL(smat%data_r,zmat%data_r(:,i))
     117             :        ELSE
     118           0 :           help_c=MATMUL(smat%data_c,zmat%data_c(:,i))
     119             :        ENDIF
     120           0 :        DO j = i,ne
     121           0 :           IF (l_real) THEN
     122           0 :              s_r(j,i) = dot_product(zmat%data_r(:,j),help_r)
     123             :           ELSE
     124           0 :              s_c(j,i) =dot_PRODUCT(zmat%data_c(:,j),help_c)
     125             :           ENDIF
     126             :        END DO
     127             :     END DO
     128             : 
     129           0 :     ALLOCATE ( acof(DIMENSION%neigd,0:DIMENSION%lmd,atoms%nat),bcof(DIMENSION%neigd,0:DIMENSION%lmd,atoms%nat) )
     130           0 :     ALLOCATE ( ccof(-atoms%llod:atoms%llod,DIMENSION%neigd,atoms%nlod,atoms%nat) ) 
     131             : 
     132             :     !     conjugate again for use with abcof; finally use cdotc to revert again
     133           0 :     IF (.NOT.l_real) zMat%data_c = CONJG(zMat%data_c)
     134           0 :     if (noco%l_soc)  CALL juDFT_error("no SOC & reduced diagonalization",calledby="aline")
     135             : 
     136             :     CALL abcof(input,atoms,sym,cell,lapw,ne,&
     137           0 :          usdus,noco,1,oneD,acof,bcof,ccof,zMat)  ! ispin = 1&
     138             : 
     139             : 
     140             :     !
     141           0 :     CALL timestart("aline: hssr_wu")
     142           0 :     IF (l_real) THEN
     143             :        CALL hssr_wu(atoms,DIMENSION,sym, jsp,el,ne,usdus,lapw,input,&
     144           0 :             tlmplm, acof,bcof,ccof, h_r,s_r)
     145             :     ELSE
     146             :        CALL hssr_wu(atoms,DIMENSION,sym, jsp,el,ne,usdus,lapw,input,&
     147           0 :             tlmplm, acof,bcof,ccof, h_c=h_c,s_c=s_c)
     148             :     ENDIF
     149             : 
     150           0 :     DEALLOCATE ( ccof, bcof, acof )
     151           0 :     CALL timestop("aline: hssr_wu")
     152           0 :     CALL timestart("aline: seclr4")
     153             : 
     154             :     !
     155           0 :     IF (l_real) THEN
     156             :        !---> LAPACK call
     157           0 :        CALL CPP_LAPACK_ssygv(1,'V','L',ne,h_r,DIMENSION%neigd,s_r,DIMENSION%neigd,eig,help_r,lhelp,info)
     158             :     ELSE
     159           0 :        ALLOCATE ( rwork(MAX(1,3*ne-2)) )
     160           0 :        CALL CPP_LAPACK_chegv(1,'V','L',ne,h_c,DIMENSION%neigd,s_c,DIMENSION%neigd,eig,help_c,lhelp,rwork,info)
     161           0 :        DEALLOCATE ( rwork )
     162             :     ENDIF
     163           0 :     IF (info /= 0) THEN
     164           0 :        WRITE (6,FMT=8000) info
     165           0 :        IF (i < 0) THEN
     166           0 :           WRITE(6,'(a7,i3,a22)') 'element',info,' has an illegal value'
     167           0 :        ELSEIF (i > ne) THEN
     168           0 :           WRITE(6,'(a2,i3,a22)') 's:',info-ne,' not positive definite'
     169             :        ELSE
     170           0 :           WRITE(6,'(a8,i3,a15)') 'argument',info,' not  converged'
     171             :        ENDIF
     172           0 :        CALL juDFT_error("Diagonalisation failed",calledby ='aline')
     173             :     ENDIF
     174             : 8000 FORMAT (' AFTER CPP_LAPACK_ssygv: info=',i4)
     175           0 :     CALL timestop("aline: seclr4")
     176             : 
     177           0 :     DO i = 1,lapw%nmat
     178           0 :        IF (l_real) THEN
     179           0 :           help_r(:ne)=zMat%data_r(i,:ne)
     180             :        ELSE
     181           0 :           help_c(:ne)=zMat%data_c(i,:ne)
     182             :        END IF
     183           0 :        DO j = 1,ne
     184           0 :           IF (l_real) THEN
     185             :              !--->       for LAPACK call
     186           0 :              zMat%data_r(i,j) = CPP_BLAS_sdot(ne,help_r,1,h_r(1,j),1)
     187             :           ELSE
     188           0 :              zMat%data_c(i,j) = CPP_BLAS_cdotc(ne,help_c,1,h_c(1,j),1)
     189             :           ENDIF
     190             :        END DO
     191             :     END DO
     192             : 
     193           0 :   END SUBROUTINE aline
     194             : END MODULE m_aline

Generated by: LCOV version 1.13