LCOV - code coverage report
Current view: top level - cdn_mt - abclocdn1.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 49 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_abclocdn1
       8             :   !*********************************************************************
       9             :   ! Calculates the basis coeffcients (bascof_lo) for the local
      10             :   ! orbitals. 
      11             :   !*********************************************************************
      12             :   !*************** ABBREVIATIONS ***************************************
      13             :   ! nkvec   : stores the number of G-vectors that have been found and
      14             :   !           accepted during the construction of the local orbitals.
      15             :   ! kvec    : k-vector used in hssphn to attach the local orbital 'lo'
      16             :   !           of atom 'na' to it.
      17             :   !*********************************************************************
      18             : CONTAINS
      19           0 :   SUBROUTINE abclocdn1(atoms,sym, con1,phase,ylm,ntyp,na,k,s,nv,&
      20           0 :        nbasf0,alo1,blo1,clo1,kvec, nkvec,enough,bascof_lo )
      21             :     !
      22             :     USE m_types
      23             :     IMPLICIT NONE
      24             :     TYPE(t_sym),INTENT(IN)     :: sym
      25             :     TYPE(t_atoms),INTENT(IN)   :: atoms
      26             :     !     ..
      27             :     !     .. Scalar Arguments ..
      28             :     INTEGER, INTENT (IN) :: k,na,ntyp,nv
      29             :     REAL,    INTENT (IN) :: con1 ,s
      30             :     COMPLEX, INTENT (IN) :: phase
      31             :     !     ..
      32             :     !     .. Array Arguments ..
      33             :     INTEGER, INTENT (IN) :: nbasf0(atoms%nlod,atoms%nat) 
      34             :     REAL,    INTENT (IN) :: alo1(atoms%nlod,atoms%ntype),blo1(atoms%nlod,atoms%ntype)
      35             :     REAL,    INTENT (IN) :: clo1(atoms%nlod,atoms%ntype)
      36             :     COMPLEX, INTENT (IN) :: ylm( (atoms%lmaxd+1)**2 )
      37             :     INTEGER, INTENT (IN) :: kvec(2*(2*atoms%llod+1) ,atoms%nat)
      38             :     LOGICAL, INTENT (OUT) :: enough(atoms%nat)
      39             :     COMPLEX, INTENT (INOUT) :: bascof_lo(3,-atoms%llod:atoms%llod,4*atoms%llod+2,atoms%nlod,atoms%nat)
      40             :     INTEGER, INTENT (INOUT) :: nkvec(atoms%nlod,atoms%nat)
      41             : 
      42             :     !     ..
      43             :     !     .. Local Scalars ..
      44             :     COMPLEX ctmp,term1
      45             :     REAL,PARAMETER:: linindq=1.0e-4,eps=1.0e-30
      46             :     INTEGER i,l,ll1,lm,lo ,mind,nbasf,na2,lmp,m
      47             :     LOGICAL linind
      48             :     !     ..
      49             :     !     .. Local Arrays ..
      50           0 :     COMPLEX clotmp(-atoms%llod:atoms%llod)
      51             :     !     ..
      52           0 :     enough(na) = .TRUE.
      53           0 :     term1 = con1 * ((atoms%rmt(ntyp)**2)/2) * phase
      54             : 
      55             :     !---> the whole program is in hartree units, therefore 1/wronskian is
      56             :     !---> (rmt**2)/2. the factor i**l, which usually appears in the a, b
      57             :     !---> and c coefficients, is included in the t-matrices. thus, it does
      58             :     !---> not show up in the formula above.
      59           0 :     DO lo = 1,atoms%nlo(ntyp)
      60           0 :        l = atoms%llo(lo,ntyp)
      61           0 :        IF (.NOT.((s.LE.eps).AND.(l.GE.1))) THEN
      62           0 :           IF (atoms%invsat(na).EQ.0) THEN
      63             : 
      64           0 :              IF ((nkvec(lo,na)).LT. (2*atoms%llo(lo,ntyp)+1)) THEN
      65           0 :                 enough(na) = .FALSE.
      66           0 :                 nkvec(lo,na) = nkvec(lo,na) + 1
      67           0 :                 nbasf = nbasf0(lo,na) + nkvec(lo,na)
      68           0 :                 l = atoms%llo(lo,ntyp)
      69           0 :                 ll1 = l* (l+1)
      70           0 :                 DO m = -l,l
      71           0 :                    clotmp(m) = term1*CONJG(ylm(ll1+m+1))
      72             :                 END DO
      73           0 :                 IF ( kvec(nkvec(lo,na),lo) == k ) THEN
      74           0 :                    DO m = -l,l
      75           0 :                       lm = ll1 + m
      76             :                       !WRITE(*,*) 'nkvec(lo,na)',nkvec(lo,na)
      77             :                       bascof_lo(1,m,nkvec(lo,na),lo,na) =&
      78           0 :                            &                                           clotmp(m)*alo1(lo,ntyp)
      79             :                       bascof_lo(2,m,nkvec(lo,na),lo,na) =&
      80           0 :                            &                                           clotmp(m)*blo1(lo,ntyp)
      81             :                       bascof_lo(3,m,nkvec(lo,na),lo,na) =&
      82           0 :                            &                                           clotmp(m)*clo1(lo,ntyp)
      83             :                    END DO
      84             :                 ELSE
      85           0 :                    nkvec(lo,na) = nkvec(lo,na) - 1
      86             :                 ENDIF ! linind
      87             :              ENDIF   ! nkvec < 2*atoms%llo
      88             : 
      89           0 :           ELSEIF (atoms%invsat(na).EQ.1) THEN
      90           0 :              IF ((nkvec(lo,na)).LT. (2* (2*atoms%llo(lo,ntyp)+1))) THEN
      91           0 :                 enough(na) = .FALSE.
      92           0 :                 nkvec(lo,na) = nkvec(lo,na) + 1
      93           0 :                 nbasf = nbasf0(lo,na) + nkvec(lo,na)
      94           0 :                 l = atoms%llo(lo,ntyp)
      95           0 :                 ll1 = l* (l+1)
      96           0 :                 DO m = -l,l
      97           0 :                    clotmp(m) = term1*CONJG(ylm(ll1+m+1))
      98             :                 END DO
      99           0 :                 IF ( kvec(nkvec(lo,na),lo) == k ) THEN
     100           0 :                    DO m = -l,l
     101           0 :                       lm = ll1 + m
     102             :                       bascof_lo(1,m,nkvec(lo,na),lo,na) =&
     103           0 :                            &                                           clotmp(m)*alo1(lo,ntyp)
     104             :                       bascof_lo(2,m,nkvec(lo,na),lo,na) =&
     105           0 :                            &                                           clotmp(m)*blo1(lo,ntyp)
     106             :                       bascof_lo(3,m,nkvec(lo,na),lo,na) =&
     107           0 :                            &                                           clotmp(m)*clo1(lo,ntyp)
     108             :                    ENDDO  ! m
     109             :                 ELSE       
     110           0 :                    nkvec(lo,na) = nkvec(lo,na) - 1
     111             :                 ENDIF       ! linind
     112             :              ENDIF         ! nkvec < 2*atoms%llo
     113             :           ELSE
     114           0 :              STOP 'invsat =/= 0 or 1'
     115             :           ENDIF
     116             :        ELSE
     117           0 :           enough(na) = .FALSE.
     118             :        ENDIF  ! s > eps  & l >= 1
     119             :     END DO
     120           0 :     IF ((k.EQ.nv) .AND. (.NOT.enough(na))) THEN
     121             :        WRITE (6,FMT=*)&
     122           0 :             &     'abclocdn did not find enough linearly independent'
     123             :        WRITE (6,FMT=*)&
     124           0 :             &     'ccof coefficient-vectors. the linear independence'
     125           0 :        WRITE (6,FMT=*) 'quality, linindq, is set to: ',linindq,'.'
     126           0 :        WRITE (6,FMT=*) 'this value might be to large.'
     127           0 :        STOP 'abclocdn: did not find enough lin. ind. ccof-vectors'
     128             :     END IF
     129             : 
     130           0 :   END SUBROUTINE abclocdn1
     131             : END MODULE m_abclocdn1

Generated by: LCOV version 1.13