LCOV - code coverage report
Current view: top level - cdn_mt - abccoflo.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 54 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_abccoflo
       8             :   USE m_juDFT
       9             :   !*********************************************************************
      10             :   ! Calculates the (upper case) A, B and C coefficients for the local
      11             :   ! orbitals.
      12             :   ! Philipp Kurz 99/04
      13             :   !*********************************************************************
      14             : CONTAINS
      15           0 :   SUBROUTINE abccoflo(atoms, con1,rph,cph,ylm,ntyp,na,k,nv, l_lo1,alo1,blo1,&
      16           0 :        clo1, nkvec, enough,alo,blo,clo,kvec)
      17             :     !
      18             :     !*************** ABBREVIATIONS ***************************************
      19             :     ! kvec    : stores the number of the G-vectors, that have been used to
      20             :     !           construct the local orbitals
      21             :     ! nkvec   : stores the number of G-vectors that have been found and
      22             :     !           accepted during the construction of the local orbitals.
      23             :     ! enough  : enough is set to .true. when enough G-vectors have been
      24             :     !           accepted.
      25             :     ! linindq : if the norm of that part of a local orbital (contructed 
      26             :     !           with a trial G-vector) that is orthogonal to the previous
      27             :     !           ones is larger than linindq, then this G-vector is 
      28             :     !           accepted.
      29             :     !*********************************************************************
      30             :     !
      31             :     USE m_constants
      32             :     USE m_types
      33             :     IMPLICIT NONE
      34             : 
      35             :     TYPE(t_atoms),INTENT(IN)   :: atoms
      36             :     !     .. 
      37             :     !     .. Scalar Arguments ..
      38             :     REAL,    INTENT (IN) :: con1,cph ,rph
      39             :     INTEGER, INTENT (IN) :: k,na,ntyp,nv
      40             :     LOGICAL, INTENT (IN) :: l_lo1
      41             :     LOGICAL, INTENT (OUT):: enough
      42             :     !     ..
      43             :     !     .. Array Arguments ..
      44             :     INTEGER, INTENT (IN)::  kvec(2* (2*atoms%llod+1),atoms%nlod )
      45             :     REAL,    INTENT (IN) :: alo1(atoms%nlod),blo1(atoms%nlod),clo1(atoms%nlod)
      46             :     COMPLEX, INTENT (IN) :: ylm( (atoms%lmaxd+1)**2 )
      47             :     COMPLEX, INTENT (OUT):: alo(-atoms%llod:atoms%llod,2* (2*atoms%llod+1),atoms%nlod)  
      48             :     COMPLEX, INTENT (OUT):: blo(-atoms%llod:atoms%llod,2* (2*atoms%llod+1),atoms%nlod)  
      49             :     COMPLEX, INTENT (OUT):: clo(-atoms%llod:atoms%llod,2* (2*atoms%llod+1),atoms%nlod)  
      50             :     INTEGER,INTENT (INOUT):: nkvec(atoms%nlod)
      51             :     !     ..
      52             :     !     .. Local Scalars ..
      53             :     COMPLEX term1
      54             :     REAL,PARAMETER:: linindq=1.e-4
      55             :     INTEGER l,lo ,mind,ll1,lm,m
      56             :     LOGICAL linind
      57             :     !     ..
      58             :     !
      59             :     !---> the whole program is in hartree units, therefore 1/wronskian is
      60             :     !---> (rmt**2)/2. the factor i**l, which usually appears in the a, b
      61             :     !---> and c coefficients, is included in the t-matrices. thus, it does
      62             :     !---> not show up in the formula above.
      63             :     !
      64             :     !-abccoflo1
      65           0 :     IF ( l_lo1) THEN
      66           0 :        DO lo = 1,atoms%nlo(ntyp)
      67           0 :           IF ( (nkvec(lo).EQ.0).AND.(atoms%llo(lo,ntyp).EQ.0) ) THEN
      68           0 :              enough = .FALSE.
      69           0 :              nkvec(lo) = 1
      70           0 :              m = 0
      71           0 :              clo(m,nkvec(lo),lo) = con1* ((atoms%rmt(ntyp)**2)/2) / SQRT(fpi_const)
      72           0 :              alo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*alo1(lo)
      73           0 :              blo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*blo1(lo)
      74           0 :              clo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*clo1(lo)
      75           0 :              IF (kvec(nkvec(lo),lo)/=k)  CALL juDFT_error("abccoflo:1"&
      76           0 :                   &           ,calledby ="abccoflo")
      77             : 
      78             :           ENDIF
      79             :        ENDDO
      80             :     ELSE
      81           0 :        enough = .TRUE.
      82           0 :        term1 = con1* ((atoms%rmt(ntyp)**2)/2)*CMPLX(rph,cph)
      83           0 :        DO lo = 1,atoms%nlo(ntyp)
      84           0 :           IF (atoms%invsat(na).EQ.0) THEN
      85           0 :              IF ((nkvec(lo)).LT. (2*atoms%llo(lo,ntyp)+1)) THEN
      86           0 :                 enough = .FALSE.
      87           0 :                 nkvec(lo) = nkvec(lo) + 1
      88           0 :                 l = atoms%llo(lo,ntyp)
      89           0 :                 ll1 = l*(l+1) + 1
      90           0 :                 DO m = -l,l
      91           0 :                    lm = ll1 + m
      92           0 :                    clo(m,nkvec(lo),lo) = term1*ylm(lm)
      93             :                 END DO
      94           0 :                 IF ( kvec(nkvec(lo),lo) == k ) THEN
      95           0 :                    DO m = -l,l
      96           0 :                       alo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*alo1(lo)
      97           0 :                       blo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*blo1(lo)
      98           0 :                       clo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*clo1(lo)
      99             :                    END DO
     100             :                    !                  WRITE(6,9000) nkvec(lo),k,lo,na,
     101             :                    !     +                          (clo(m,nkvec(lo),lo),m=-l,l)
     102             :                    ! 9000             format(2i4,2i2,7(' (',e9.3,',',e9.3,')'))
     103             :                 ELSE
     104           0 :                    nkvec(lo) = nkvec(lo) - 1
     105             :                 ENDIF
     106             :              ENDIF
     107             :           ELSE
     108           0 :              IF ((atoms%invsat(na).EQ.1) .OR. (atoms%invsat(na).EQ.2)) THEN
     109             :                 !           only invsat=1 is needed invsat=2 for testing
     110           0 :                 IF ((nkvec(lo)).LT. (2* (2*atoms%llo(lo,ntyp)+1))) THEN
     111           0 :                    enough = .FALSE.
     112           0 :                    nkvec(lo) = nkvec(lo) + 1
     113           0 :                    l = atoms%llo(lo,ntyp)
     114           0 :                    ll1 = l*(l+1) + 1
     115           0 :                    DO m = -l,l
     116           0 :                       lm = ll1 + m
     117           0 :                       clo(m,nkvec(lo),lo) = term1*ylm(lm)
     118             :                    END DO
     119           0 :                    IF ( kvec(nkvec(lo),lo) == k ) THEN
     120           0 :                       DO m = -l,l
     121             :                          !                            if(l.eq.1) then
     122             :                          !               WRITE(*,*)'k=',k,' clotmp=',clo(m,nkvec(lo),lo)
     123             :                          !               WRITE(*,*)'clo1=',clo1(lo),' term1=',term1
     124             :                          !                            endif
     125           0 :                          alo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*alo1(lo)
     126           0 :                          blo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*blo1(lo)
     127           0 :                          clo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*clo1(lo)
     128             :                          !                        kvec(nkvec(lo),lo) = k
     129             :                       END DO
     130             :                    ELSE
     131           0 :                       nkvec(lo) = nkvec(lo) - 1
     132             :                    END IF
     133             :                 END IF
     134             :              END IF
     135             :           END IF
     136             :        END DO
     137           0 :        IF ((k.EQ.nv) .AND. (.NOT.enough)) THEN
     138             :           WRITE (6,FMT=*)&
     139           0 :                &     'abccoflo did not find enough linearly independent'
     140             :           WRITE (6,FMT=*)&
     141           0 :                &     'clo coefficient-vectors. the linear independence'
     142           0 :           WRITE (6,FMT=*) 'quality, linindq, is set to: ',linindq,'.'
     143           0 :           WRITE (6,FMT=*) 'this value might be to large.'
     144             :           CALL juDFT_error&
     145             :                &        ("abccoflo: did not find enough lin. ind. clo-vectors"&
     146           0 :                &        ,calledby ="abccoflo")
     147             :        END IF
     148             :     ENDIF  ! abccoflo1
     149             : 
     150           0 :   END SUBROUTINE abccoflo
     151             : END MODULE m_abccoflo

Generated by: LCOV version 1.13