LCOV - code coverage report
Current view: top level - cdn_mt - abclocdn.F90 (source / functions) Hit Total Coverage
Test: FLEUR test coverage Lines: 34 35 97.1 %
Date: 2024-03-28 04:22:06 Functions: 1 1 100.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_abclocdn
       8             :   USE m_juDFT
       9             :   !*********************************************************************
      10             :   ! Calculates the (upper case) A, B and C coefficients for the local
      11             :   ! orbitals. The difference to abccoflo is, that a summation over the
      12             :   ! Gs ist performed. The A, B and C coeff. are set up for each eigen-
      13             :   ! state.
      14             :   ! Philipp Kurz 99/04
      15             :   !*********************************************************************
      16             :   !*************** ABBREVIATIONS ***************************************
      17             :   ! nkvec   : stores the number of G-vectors that have been found and
      18             :   !           accepted during the construction of the local orbitals.
      19             :   ! kvec    : k-vector used in hssphn to attach the local orbital 'lo'
      20             :   !           of atom 'na' to it.
      21             :   !*********************************************************************
      22             : CONTAINS
      23       46170 :   SUBROUTINE abclocdn(atoms,noco,lapw,cell,ccchi,iintsp,phase,ylm,&
      24       46170 :        ntyp,na,k,nkvec,lo,ne,alo1,blo1,clo1,acof,bcof,ccof,zMat,l_force,fgp,force,na_index)
      25             : 
      26             :     USE m_types
      27             :     USE m_constants
      28             : 
      29             :     IMPLICIT NONE
      30             : 
      31             :     TYPE(t_noco),  INTENT(IN) :: noco
      32             :     TYPE(t_atoms), INTENT(IN) :: atoms
      33             :     TYPE(t_lapw),  INTENT(IN) :: lapw
      34             :     TYPE(t_cell),  INTENT(IN) :: cell
      35             :     TYPE(t_mat),   INTENT(IN) :: zMat
      36             :     TYPE(t_force), OPTIONAL, INTENT(INOUT) :: force
      37             :     
      38             :     !     .. Scalar Arguments ..
      39             :     INTEGER, INTENT (IN) :: iintsp
      40             :     INTEGER, INTENT (IN) :: k,na,ne,ntyp,nkvec,lo
      41             :     COMPLEX, INTENT (IN) :: phase
      42             :     LOGICAL, INTENT (IN) :: l_force
      43             :     INTEGER,INTENT(IN),OPTIONAL :: na_index
      44             : 
      45             :     !     .. Array Arguments ..
      46             :     REAL,    INTENT (IN) :: alo1(:),blo1(:),clo1(:)
      47             :     COMPLEX, INTENT (IN) :: ylm( (atoms%lmaxd+1)**2 )
      48             :     COMPLEX, INTENT (IN) :: ccchi(2)
      49             :     COMPLEX, INTENT (INOUT) :: acof(:,0:,:)!(nobd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat)
      50             :     COMPLEX, INTENT (INOUT) :: bcof(:,0:,:)!(nobd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat)
      51             :     COMPLEX, INTENT (INOUT) :: ccof(-atoms%llod:,:,:,:)!(-atoms%llod:atoms%llod,nobd,atoms%nlod,atoms%nat)
      52             :     REAL,    OPTIONAL, INTENT (IN)    :: fgp(3)
      53             : 
      54             :     !     .. Local Scalars ..
      55       46170 :     COMPLEX ctmp,term1,work(ne)
      56             :     INTEGER i,j,l,ll1,lm,nbasf,m,na2,lmp,na_l
      57             :     !     ..
      58             :     !     ..
      59       46170 :     na_l=na
      60       46170 :     if (present(na_index)) na_l=na_index
      61       46170 :     term1 = 2 * tpi_const/SQRT(cell%omtil) * ((atoms%rmt(ntyp)**2)/2) * phase
      62             :     !---> the whole program is in hartree units, therefore 1/wronskian is
      63             :     !---> (rmt**2)/2. the factor i**l, which usually appears in the a, b
      64             :     !---> and c coefficients, is included in the t-matrices. thus, it does
      65             :     !---> not show up in the formula above.
      66       46170 :     l = atoms%llo(lo,ntyp)
      67       46170 :     ll1 = l* (l+1)
      68       46170 :     nbasf=lapw%nv(iintsp)+lapw%index_lo(lo,na)+nkvec
      69       46170 :     if (noco%l_noco) Then
      70        4148 :       if (noco%l_ss) THEN
      71           0 :         work = ccchi(iintsp)*zMat%data_c((iintsp-1)*(lapw%nv(1)+atoms%nlotot)+nbasf,:ne)
      72             :       else
      73       80756 :         work= ccchi(1)*zMat%data_c(nbasf,:ne)+ccchi(2)*zMat%data_c(lapw%nv(1)+atoms%nlotot+nbasf,:ne)
      74             :       ENDIF
      75             :     ELSE
      76       42022 :       if (zmat%l_real) Then
      77      258198 :           work=zmat%data_r(nbasf,:ne)
      78             :         else
      79      568093 :           work=zmat%data_c(nbasf,:ne)
      80             :         endif
      81             :     endif
      82             : 
      83             :     !!$acc kernels default(none) present(acof,bcof,ccof,alo1,blo1,clo1,ccchi,ylm)create(ctmp) &
      84             :     !!$acc copyin(work,na,term1,l,ne,ll1,noco)
      85             :     !!$acc loop seq private(i,m,lm,ctmp,na2,lmp)
      86      907047 :     DO i = 1,ne
      87             :       !!$acc loop seq
      88     3241232 :       DO m = -l,l
      89     2334185 :           lm = ll1 + m
      90     2334185 :           ctmp=term1*conjg(ylm(ll1+m+1))*work(i)
      91     2334185 :           acof(i,lm,na_l) = acof(i,lm,na_l) + ctmp*alo1(lo)
      92     2334185 :           bcof(i,lm,na_l) = bcof(i,lm,na_l) + ctmp*blo1(lo)
      93     3195062 :           ccof(m,i,lo,na_l) = ccof(m,i,lo,na_l) + ctmp*clo1(lo)
      94             :         END DO
      95             :         !!$acc end loop
      96             :     END DO
      97             :     !!$acc end loop
      98             :     !!$acc end kernels
      99             : 
     100       46170 :     IF (l_force) THEN
     101        3328 :       DO i = 1,ne
     102       11488 :         DO m = -l,l
     103        8160 :           lm = ll1 + m
     104        8160 :           ctmp=term1*conjg(ylm(ll1+m+1))*work(i)
     105        8160 :           force%acoflo(m,i,lo,na) = force%acoflo(m,i,lo,na) + ctmp*alo1(lo)
     106        8160 :           force%bcoflo(m,i,lo,na) = force%bcoflo(m,i,lo,na) + ctmp*blo1(lo)
     107       35904 :           DO j = 1,3
     108       24480 :             force%aveccof(j,i,lm,na)   = force%aveccof(j,i,lm,na)   + fgp(j)*ctmp*alo1(lo)
     109       24480 :             force%bveccof(j,i,lm,na)   = force%bveccof(j,i,lm,na)   + fgp(j)*ctmp*blo1(lo)
     110       32640 :             force%cveccof(j,m,i,lo,na) = force%cveccof(j,m,i,lo,na) + fgp(j)*ctmp*clo1(lo)
     111             :           END DO
     112             :         END DO
     113             :       END DO
     114             :     END IF
     115       46170 :   END SUBROUTINE abclocdn
     116             : END MODULE m_abclocdn

Generated by: LCOV version 1.14