LCOV - code coverage report
Current view: top level - cdn_mt - abclocdn_pulay.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 95 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_abclocdnpulay
       8             :   USE m_juDFT
       9             : CONTAINS
      10           0 :   SUBROUTINE abclocdn_pulay(&
      11             :        &                          atoms,sym,&
      12             :        &                          noco,ccchi,kspin,iintsp,&
      13           0 :        &                          con1,phase,ylm,ntyp,na,k,fgp,&
      14           0 :        &                          s,nv,ne,nbasf0,alo1,blo1,clo1,&
      15           0 :        &                          kvec,enough,acof,bcof,ccof,&
      16           0 :        &                          acoflo,bcoflo,aveccof,bveccof,cveccof,zMat)
      17             :     !
      18             :     !*********************************************************************
      19             :     ! for details see abclocdn; calles by to_pulay
      20             :     !*********************************************************************
      21             :     !
      22             :     USE m_types
      23             :     IMPLICIT NONE
      24             :     TYPE(t_noco),INTENT(IN)   :: noco
      25             :     TYPE(t_sym),INTENT(IN)    :: sym
      26             :     TYPE(t_atoms),INTENT(IN)  :: atoms
      27             :     TYPE(t_mat),INTENT(IN)    :: zMat
      28             :     !     ..
      29             :     !     .. Scalar Arguments ..
      30             :     INTEGER, INTENT (IN) :: iintsp
      31             :     INTEGER, INTENT (IN) :: k,na,ne,ntyp,nv,kspin
      32             :     REAL,    INTENT (IN) :: con1 ,s
      33             :     COMPLEX, INTENT (IN) :: phase
      34             :     !     ..
      35             :     !     .. Array Arguments ..
      36             :     INTEGER, INTENT (IN) :: nbasf0(atoms%nlod,atoms%nat) 
      37             :     INTEGER, INTENT (IN) :: kvec(2*(2*atoms%llod+1),atoms%nlod)
      38             :     REAL,    INTENT (IN) :: alo1(atoms%nlod,atoms%ntype),blo1(atoms%nlod,atoms%ntype)
      39             :     REAL,    INTENT (IN) :: clo1(atoms%nlod,atoms%ntype)
      40             :     REAL,    INTENT (IN) :: fgp(3)
      41             :     COMPLEX, INTENT (IN) :: ylm( (atoms%lmaxd+1)**2 ),ccchi(2)
      42             :     COMPLEX, INTENT (INOUT) :: acof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
      43             :     COMPLEX, INTENT (INOUT) :: bcof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
      44             :     COMPLEX, INTENT (INOUT) :: ccof(-atoms%llod:,:,:,:)!(-llod:llod,nobd,atoms%nlod,atoms%nat)
      45             :     COMPLEX, INTENT (INOUT) :: acoflo(-atoms%llod:,:,:,:)
      46             :     COMPLEX, INTENT (INOUT) :: bcoflo(-atoms%llod:,:,:,:)
      47             :     COMPLEX, INTENT (INOUT) :: aveccof(:,:,0:,:)!(3,nobd,0:dimension%lmd,atoms%nat)
      48             :     COMPLEX, INTENT (INOUT) :: bveccof(:,:,0:,:)!(3,nobd,0:dimension%lmd,atoms%nat)
      49             :     COMPLEX, INTENT (INOUT) :: cveccof(:,-atoms%llod:,:,:,:)!(3,-atoms%llod:llod,nobd,atoms%nlod,atoms%nat)
      50             :     LOGICAL, INTENT (OUT) :: enough(atoms%nat)
      51           0 :     INTEGER :: nkvec(atoms%nlod,atoms%nat)
      52             :     !     ..
      53             :     !     .. Local Scalars ..
      54             :     COMPLEX ctmp,term1
      55             :     REAL,PARAMETER:: linindq=1.0e-4,eps=1.e-30
      56             :     INTEGER i,ie,l,ll1,lm,lo ,mind,nbasf,na2,lmp,m
      57             :     LOGICAL linind
      58             :     !     ..
      59             :     !     .. Local Arrays ..
      60           0 :     COMPLEX clotmp(-atoms%llod:atoms%llod)
      61             :     !     ..
      62           0 :     nkvec=0
      63           0 :     enough(na) = .TRUE.
      64           0 :     term1 = con1* ((atoms%rmt(ntyp)**2)/2)*phase
      65             :     !
      66             :     !---> the whole program is in hartree units, therefore 1/wronskian is
      67             :     !---> (rmt**2)/2. the factor i**l, which usually appears in the a, b
      68             :     !---> and c coefficients, is included in the t-matrices. thus, it does
      69             :     !---> not show up in the formula above.
      70             :     !
      71           0 :     DO lo = 1,atoms%nlo(ntyp)
      72           0 :        l = atoms%llo(lo,ntyp)
      73           0 :        IF (.NOT.((s.LE.eps).AND.(l.GE.1))) THEN
      74           0 :           IF (atoms%invsat(na).EQ.0) THEN
      75           0 :              IF ((nkvec(lo,na)).LT. (2*atoms%llo(lo,ntyp)+1)) THEN
      76           0 :                 enough(na) = .FALSE.
      77           0 :                 nkvec(lo,na) = nkvec(lo,na) + 1
      78           0 :                 nbasf = nbasf0(lo,na) + nkvec(lo,na)
      79           0 :                 l = atoms%llo(lo,ntyp)
      80           0 :                 ll1 = l* (l+1)
      81           0 :                 DO m = -l,l
      82           0 :                    clotmp(m) = term1*CONJG(ylm(ll1+m+1))
      83             :                 END DO
      84             :                 !
      85           0 :                 IF ( kvec(nkvec(lo,na),lo) == k ) THEN
      86           0 :                    DO ie = 1,ne
      87           0 :                       DO m = -l,l
      88           0 :                          lm = ll1 + m
      89           0 :                          IF (noco%l_noco) THEN
      90           0 :                             IF (noco%l_ss) THEN
      91           0 :                                ctmp = clotmp(m)* ccchi(iintsp)*zMat%data_c(kspin+nbasf,ie)
      92             :                             ELSE
      93           0 :                                ctmp = clotmp(m)*( ccchi(1)*zMat%data_c(nbasf,ie)+ccchi(2)*zMat%data_c(kspin+nbasf,ie) )
      94             :                             ENDIF
      95             :                          ELSE
      96           0 :                             IF (zmat%l_real) THEN
      97           0 :                                ctmp = zMat%data_r(nbasf,ie)*clotmp(m)
      98             :                             ELSE
      99           0 :                                ctmp = zMat%data_c(nbasf,ie)*clotmp(m)
     100             :                             ENDIF
     101             :                          ENDIF
     102           0 :                          acof(ie,lm,na)     = acof(ie,lm,na) +ctmp*alo1(lo,ntyp)
     103           0 :                          bcof(ie,lm,na)     = bcof(ie,lm,na) +ctmp*blo1(lo,ntyp)
     104           0 :                          ccof(m,ie,lo,na)   = ccof(m,ie,lo,na) +ctmp*clo1(lo,ntyp)
     105           0 :                          acoflo(m,ie,lo,na) = acoflo(m,ie,lo,na) +ctmp*alo1(lo,ntyp)
     106           0 :                          bcoflo(m,ie,lo,na) = bcoflo(m,ie,lo,na) +ctmp*blo1(lo,ntyp)
     107           0 :                          DO i = 1,3
     108           0 :                             aveccof(i,ie,lm,na)=aveccof(i,ie,lm,na) +fgp(i)*ctmp*alo1(lo,ntyp)
     109           0 :                             bveccof(i,ie,lm,na)=bveccof(i,ie,lm,na) +fgp(i)*ctmp*blo1(lo,ntyp)
     110           0 :                             cveccof(i,m,ie,lo,na) =cveccof(i,m,ie,lo,na) +fgp(i)*ctmp*clo1(lo,ntyp)
     111             :                          ENDDO
     112             :                       END DO
     113             :                    END DO
     114             :                    !                    write(6,9000) nbasf,k,lo,na,
     115             :                    !     +                          (clo1(lo,ntyp)*clotmp(m),m=-l,l)
     116             :                    ! 9000               format(2i4,2i2,7(' (',e9.3,',',e9.3,')'))
     117             :                 ELSE
     118           0 :                    nkvec(lo,na) = nkvec(lo,na) - 1
     119             :                 END IF
     120             :              END IF
     121           0 :           ELSEIF (atoms%invsat(na).EQ.1) THEN
     122           0 :              IF ((nkvec(lo,na)).LT. (2* (2*atoms%llo(lo,ntyp)+1))) THEN
     123           0 :                 enough(na) = .FALSE.
     124           0 :                 nkvec(lo,na) = nkvec(lo,na) + 1
     125           0 :                 nbasf = nbasf0(lo,na) + nkvec(lo,na)
     126           0 :                 l = atoms%llo(lo,ntyp)
     127           0 :                 ll1 = l* (l+1)
     128           0 :                 DO m = -l,l
     129           0 :                    clotmp(m) = term1*CONJG(ylm(ll1+m+1))
     130             :                 END DO
     131             :                 !
     132           0 :                 IF ( kvec(nkvec(lo,na),lo) == k ) THEN
     133             :                    !                     write(*,*)'k vector nr ',k,' has been accepted'
     134           0 :                    DO ie = 1,ne
     135           0 :                       DO m = -l,l
     136           0 :                          lm = ll1 + m
     137           0 :                          IF (noco%l_noco) THEN
     138           0 :                             IF (noco%l_ss) THEN
     139           0 :                                ctmp = clotmp(m)*ccchi(iintsp)*zMat%data_c(kspin+nbasf,ie)
     140             :                             ELSE
     141           0 :                                ctmp = clotmp(m)*( ccchi(1)*zMat%data_c(nbasf,ie)+ccchi(2)*zMat%data_c(kspin+nbasf,ie) )
     142             :                             ENDIF
     143             :                          ELSE
     144           0 :                             IF (zmat%l_real) THEN
     145           0 :                                ctmp = zMat%data_r(nbasf,ie)*clotmp(m)
     146             :                             ELSE
     147           0 :                                ctmp = zMat%data_c(nbasf,ie)*clotmp(m)
     148             :                             END IF
     149             :                          ENDIF
     150           0 :                          acof(ie,lm,na) = acof(ie,lm,na) +ctmp*alo1(lo,ntyp)
     151           0 :                          bcof(ie,lm,na) = bcof(ie,lm,na) +ctmp*blo1(lo,ntyp)
     152           0 :                          ccof(m,ie,lo,na) = ccof(m,ie,lo,na) +ctmp*clo1(lo,ntyp)
     153           0 :                          acoflo(m,ie,lo,na) = acoflo(m,ie,lo,na) +ctmp*alo1(lo,ntyp)
     154           0 :                          bcoflo(m,ie,lo,na) = bcoflo(m,ie,lo,na) +ctmp*blo1(lo,ntyp)
     155           0 :                          DO i = 1,3
     156           0 :                             aveccof(i,ie,lm,na)=aveccof(i,ie,lm,na) +fgp(i)*ctmp*alo1(lo,ntyp)
     157           0 :                             bveccof(i,ie,lm,na)=bveccof(i,ie,lm,na) +fgp(i)*ctmp*blo1(lo,ntyp)
     158           0 :                             cveccof(i,m,ie,lo,na)=cveccof(i,m,ie,lo,na)+fgp(i)*ctmp*clo1(lo,ntyp)
     159             :                          ENDDO
     160           0 :                          IF (noco%l_soc.AND.sym%invs) THEN
     161           0 :                             ctmp = zMat%data_c(nbasf,ie) * CONJG(clotmp(m))*(-1)**(l-m)
     162           0 :                             na2 = sym%invsatnr(na)
     163           0 :                             lmp = ll1 - m
     164           0 :                             acof(ie,lmp,na2) = acof(ie,lmp,na2) +ctmp*alo1(lo,ntyp)
     165           0 :                             bcof(ie,lmp,na2) = bcof(ie,lmp,na2) +ctmp*blo1(lo,ntyp)
     166           0 :                             ccof(-m,ie,lo,na2) = ccof(-m,ie,lo,na2) + ctmp*clo1(lo,ntyp)
     167           0 :                             acoflo(-m,ie,lo,na2) = acoflo(-m,ie,lo,na2) +ctmp*alo1(lo,ntyp)
     168           0 :                             bcoflo(-m,ie,lo,na2) = bcoflo(-m,ie,lo,na2) +ctmp*blo1(lo,ntyp)
     169           0 :                             DO i = 1,3
     170           0 :                                aveccof(i,ie,lmp,na2)=aveccof(i,ie,lmp,na2)-fgp(i)*ctmp*alo1(lo,ntyp)
     171           0 :                                bveccof(i,ie,lmp,na2)=bveccof(i,ie,lmp,na2)-fgp(i)*ctmp*blo1(lo,ntyp)
     172           0 :                                cveccof(i,-m,ie,lo,na2) =cveccof(i,-m,ie,lo,na2) -fgp(i)*ctmp*clo1(lo,ntyp)
     173             :                             ENDDO
     174             :                          ENDIF
     175             :                       ENDDO ! loop over m
     176             :                    ENDDO    ! loop over eigenstates (ie)
     177             :                 ELSE
     178           0 :                    nkvec(lo,na) = nkvec(lo,na) - 1
     179             :                 END IF   ! linind
     180             :              END IF      ! nkvec(lo,na) < 2*(2*atoms%llo + 1)
     181             :           ELSE
     182           0 :              CALL juDFT_error("invsat =/= 0 or 1",calledby ="abclocdn_pulay")
     183             :           ENDIF
     184             :        ELSE
     185           0 :           enough(na) = .FALSE.
     186             :        ENDIF ! s > eps  & l >= 1  
     187             :     END DO
     188           0 :     IF ((k.EQ.nv) .AND. (.NOT.enough(na))) THEN
     189           0 :        WRITE (6,FMT=*) 'abclocdn did not find enough linearly independent'
     190           0 :        WRITE (6,FMT=*) 'ccof coefficient-vectors. the linear independence'
     191           0 :        WRITE (6,FMT=*) 'quality, linindq, is set to: ',linindq,'.'
     192           0 :        WRITE (6,FMT=*) 'this value might be to large.'
     193           0 :        CALL juDFT_error("did not find enough lin. ind. ccof-vectors" ,calledby ="abclocdn_pulay")
     194             :     END IF
     195             : 
     196           0 :   END SUBROUTINE abclocdn_pulay
     197             : END MODULE m_abclocdnpulay

Generated by: LCOV version 1.13