LCOV - code coverage report
Current view: top level - cdn_mt - abcof.F90 (source / functions) Hit Total Coverage
Test: FLEUR test coverage Lines: 177 177 100.0 %
Date: 2024-04-18 04:21:56 Functions: 1 1 100.0 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2020 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_abcof
       8             : 
       9             : CONTAINS
      10             : 
      11             :   ! The subroutine abcof calculates the A, B, and C coefficients for the
      12             :   ! eigenfunctions. Also some force contributions can be calculated.
      13        9209 :   SUBROUTINE abcof(input,atoms,sym, cell,lapw,ne,usdus,&
      14        9209 :                    noco,nococonv,jspin , acof,bcof,ccof,zMat,eig,force,nat_start,nat_stop)
      15             : #ifdef _OPENACC
      16             : #ifdef __PGI
      17             :     use cublas
      18             : #endif
      19             : #define CPP_ACC acc
      20             : #define CPP_OMP no_OMP_used
      21             : #define zgemm_acc cublaszgemm
      22             : #else
      23             : #define CPP_ACC No_acc_used
      24             : #define CPP_OMP OMP
      25             : #define zgemm_acc zgemm
      26             : #endif
      27             :     USE m_juDFT
      28             :     USE m_types
      29             :     USE m_constants
      30             :     USE m_ylm
      31             :     USE m_setabc1lo
      32             :     USE m_abclocdn
      33             :     USE m_hsmt_fjgj
      34             :     USE m_hsmt_ab
      35             : 
      36             :     IMPLICIT NONE
      37             : 
      38             :     TYPE(t_input),INTENT(IN)             :: input
      39             :     TYPE(t_usdus),INTENT(IN)             :: usdus
      40             :     TYPE(t_lapw),INTENT(IN)              :: lapw
      41             :      
      42             :     TYPE(t_noco),INTENT(IN)              :: noco
      43             :     TYPE(t_nococonv),INTENT(IN)          :: nococonv
      44             :     TYPE(t_sym),INTENT(IN)               :: sym
      45             :     TYPE(t_cell),INTENT(IN)              :: cell
      46             :     TYPE(t_atoms),INTENT(IN)             :: atoms
      47             :     TYPE(t_mat),INTENT(IN)               :: zMat
      48             :     TYPE(t_force),OPTIONAL,INTENT(INOUT) :: force
      49             : 
      50             :     ! scalar arguments
      51             :     INTEGER, INTENT(IN)        :: ne
      52             :     INTEGER, INTENT(IN)        :: jspin
      53             : 
      54             :     ! array arguments
      55             :     COMPLEX, INTENT(OUT)       :: acof(:,0:,:)!(nobd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat)
      56             :     COMPLEX, INTENT(OUT)       :: bcof(:,0:,:)!(nobd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat)
      57             :     COMPLEX, INTENT(OUT)       :: ccof(-atoms%llod:,:,:,:)!(-llod:llod,nobd,atoms%nlod,atoms%nat)
      58             :     REAL, OPTIONAL, INTENT(IN) :: eig(:)!(input%neig)
      59             :     INTEGER,OPTIONAL,INTENT(IN):: nat_start,nat_stop
      60             : 
      61             :     ! Local objects
      62        9209 :     TYPE(t_fjgj) :: fjgj
      63             : 
      64             :     ! Local scalars
      65             :     INTEGER :: i,iLAPW,l,ll1,lm,nap,jAtom,lmp,m,nkvec,iAtom,iType,acof_size,iAtom_l,jatom_l
      66             :     INTEGER :: inv_f,ie,ilo,kspin,iintsp,nintsp,nvmax,lo,inap,abSize
      67             :     REAL    :: tmk, qss(3), s2h
      68             :     COMPLEX :: phase, c_1, c_2
      69             :     LOGICAL :: l_force,l_useinversionsym
      70             : 
      71             :     ! Local arrays
      72             :     REAL    :: fg(3),fgp(3),fgr(3),fk(3),fkp(3),fkr(3)
      73        9209 :     REAL    :: alo1(atoms%nlod,input%jspins),blo1(atoms%nlod,input%jspins)
      74        9209 :     REAL    :: clo1(atoms%nlod,input%jspins)
      75        9209 :     COMPLEX :: ylm((atoms%lmaxd+1)**2)
      76             :     COMPLEX :: ccchi(2,2)
      77        9209 :     REAL,    ALLOCATABLE :: realCoeffs(:,:), imagCoeffs(:,:), workTrans_r(:,:)
      78        9209 :     REAL,    ALLOCATABLE :: fgpl(:,:)
      79        9209 :     COMPLEX, ALLOCATABLE :: s2h_e(:,:)
      80        9209 :     COMPLEX, ALLOCATABLE :: work_c(:,:), workTrans_c(:,:), workTrans_cf(:,:)
      81             :     COMPLEX, ALLOCATABLE :: abCoeffs(:,:)
      82        9209 :     COMPLEX, ALLOCATABLE :: abTemp(:,:)
      83        9209 :     COMPLEX, ALLOCATABLE :: helpMat_c(:,:), helpMat_force(:,:)
      84             : 
      85             : 
      86        9209 :     CALL timestart("abcof")
      87             : 
      88             :     ! Checks
      89        9209 :     IF (zmat%l_real) THEN
      90        3120 :        IF (noco%l_noco) CALL judft_error("BUG in abcof, l_noco but real?")
      91             :     ENDIF
      92             : 
      93             :     ! Allocations
      94       27627 :     CALL fjgj%alloc(MAXVAL(lapw%nv),atoms%lmaxd,jspin,noco)
      95       55254 :     ALLOCATE(abCoeffs(2*atoms%lmaxd*(atoms%lmaxd+2)+2,MAXVAL(lapw%nv)))
      96       36836 :     ALLOCATE(abTemp(SIZE(acof,1),0:2*SIZE(acof,2)-1))
      97       46045 :     ALLOCATE(fgpl(3,MAXVAL(lapw%nv)))
      98       55254 :     ALLOCATE (work_c(MAXVAL(lapw%nv),ne))
      99             : 
     100             :     ! Initializations
     101        9209 :     acof_size=size(acof,1)
     102             :     !$acc enter data create(abTemp,fjgj,fjgj%fj,fjgj%gj,work_c,abcoeffs)
     103    30729207 :     acof(:,:,:)   = CMPLX(0.0,0.0)
     104    30729207 :     bcof(:,:,:)   = CMPLX(0.0,0.0)
     105     1868125 :     ccof(:,:,:,:) = CMPLX(0.0,0.0)
     106        9209 :     l_force = .FALSE.
     107        9209 :     IF(PRESENT(eig).AND.input%l_f) l_force = .TRUE.
     108        9209 :     IF(l_force) THEN
     109       19958 :        force%acoflo  = CMPLX(0.0,0.0)
     110       19958 :        force%bcoflo  = CMPLX(0.0,0.0)
     111      239966 :        force%e1cof   = CMPLX(0.0,0.0)
     112      239966 :        force%e2cof   = CMPLX(0.0,0.0)
     113      921518 :        force%aveccof = CMPLX(0.0,0.0)
     114      921518 :        force%bveccof = CMPLX(0.0,0.0)
     115       64022 :        force%cveccof = CMPLX(0.0,0.0)
     116         434 :        ALLOCATE(helpMat_c(atoms%lmaxd*(atoms%lmaxd+2)+1,MAXVAL(lapw%nv)))
     117         248 :        ALLOCATE(helpMat_force(ne,atoms%lmaxd*(atoms%lmaxd+2)+1))
     118         372 :        ALLOCATE(workTrans_cf(ne,MAXVAL(lapw%nv)))
     119         372 :        ALLOCATE(s2h_e(ne,MAXVAL(lapw%nv)))
     120             :     ENDIF
     121             : 
     122             :     !Use inversion symmetry explicitely
     123       28818 :     l_useinversionsym=any(sym%invsat==2)!.and.(.not.noco%l_soc).and.(.not.present(nat_start))
     124             : 
     125             :     
     126             :     ! loop over atoms
     127       29092 :     DO iAtom = 1,atoms%nat
     128             :        !There might be a parallelization over atoms...
     129       19883 :       iAtom_l=iAtom
     130       19883 :        if (present(nat_start).and.present(nat_stop)) THEN
     131        2059 :          if (iatom<nat_start.or.iatom>nat_stop) cycle
     132        1048 :          iAtom_l=iAtom-nat_start+1
     133             :        endif   
     134       18872 :        if (sym%invsat(iatom)==2.and. l_useinversionsym) cycle
     135       18691 :        iType = atoms%itype(iAtom)
     136             : 
     137       18691 :        CALL timestart("fjgj coefficients")
     138       18691 :        CALL fjgj%calculate(input,atoms,cell,lapw,noco,usdus,iType,jspin)
     139             :        !$acc update device (fjgj%fj,fjgj%gj)
     140       18691 :        CALL timestop("fjgj coefficients")
     141             : 
     142       18691 :        CALL setabc1lo(atoms,iType,usdus,jspin,alo1,blo1,clo1)
     143             : 
     144             :           ! generate the spinors (chi)
     145       31387 :        IF(noco%l_noco) ccchi=conjg(nococonv%umat(itype))
     146             : 
     147             : 
     148       18691 :        nintsp = 1
     149       18691 :        IF (noco%l_ss) nintsp = 2
     150             :        ! loop over the interstitial spin
     151       46659 :        DO iintsp = 1,nintsp
     152             : 
     153       18759 :           nvmax=lapw%nv(jspin)
     154       18759 :           IF (noco%l_ss) nvmax=lapw%nv(iintsp)
     155       93795 :           qss = MERGE(-1.0,1.0,iintsp.EQ.1)*nococonv%qss/2.0
     156             :           
     157             :      
     158             :              ! Filling of work array (modified zMat)
     159       18759 :              CALL timestart("fill work array")
     160       18759 :              IF (noco%l_noco) THEN
     161        2184 :                 IF (noco%l_ss) THEN
     162             :                    !$acc kernels copyin(zmat,zMat%data_c,ccchi,atoms,lapw,lapw%nv) present(work_c)default(none)
     163             :                    ! the coefficients of the spin-down basis functions are
     164             :                    ! stored in the second half of the eigenvector
     165         136 :                    kspin = (iintsp-1)*(lapw%nv(1)+atoms%nlotot)
     166       32232 :                    work_c(:nvmax,:) = ccchi(iintsp,jspin)*zMat%data_c(kspin+1:kspin+nvmax,:ne)
     167             :                    !$acc end kernels
     168             :                 ELSE
     169             :                    ! perform sum over the two interstitial spin directions
     170             :                    ! and take into account the spin boundary conditions
     171             :                    ! (jspin counts the local spin directions inside each MT)
     172             :                    !$acc kernels copyin(atoms,zMat,zMat%data_c,ccchi,lapw) present(work_c) default(none)
     173        2048 :                    kspin = lapw%nv(1)+atoms%nlotot
     174     4392886 :                    work_c(:nvmax,:) = ccchi(1,jspin)*zMat%data_c(:nvmax,:ne) + ccchi(2,jspin)*zMat%data_c(kspin+1:kspin+nvmax,:ne)
     175             :                    !$acc end kernels
     176             :                 END IF
     177             :              ELSE
     178       16575 :                 IF (zmat%l_real) THEN
     179       10000 :                    !$CPP_OMP PARALLEL DO default(shared) private(i)
     180             :                    !$acc kernels copyin(zmat,zMat%data_r)present(work_c)default(none)
     181             :                    DO i = 1, ne
     182             : #ifdef _OPENACC
     183             :                       work_c(:nvmax,i) = zmat%data_r(:nvmax,i)
     184             : #else
     185             :                       work_c(:nvmax,i) = 0.0
     186             :                       CALL dcopy(nvmax,zMat%data_r(:,i),1,work_c(:,i),2)
     187             : #endif
     188             :                    END DO
     189             :                    !$acc end kernels
     190             :                    !$CPP_OMP END PARALLEL DO
     191             :                 ELSE
     192        6575 :                    !$CPP_OMP PARALLEL DO default(shared) private(i)
     193             :                    !$acc kernels copyin(zMat,zMat%data_c)present(work_c) default(none)
     194             :                    DO i = 1, ne
     195             : #ifdef _OPENACC
     196             :                       work_c(:nvmax,i) = zmat%data_c(:nvmax,i)
     197             : #else
     198             :                       CALL zcopy(nvmax,zMat%data_c(:,i),1,work_c(:,i),1)
     199             : #endif
     200             :                    END DO
     201             :                    !$acc end kernels
     202             :                    !$CPP_OMP END PARALLEL DO
     203             :                 END IF
     204             :              END IF
     205             : 
     206       18759 :              CALL timestop("fill work array")
     207             : 
     208             :              ! Calculation of a, b coefficients for LAPW basis functions
     209       18759 :              CALL timestart("hsmt_ab")
     210             :              !!$acc data copyin(fjgj,fjgj%fj,fjgj%gj) copyout(abcoeffs)
     211       18759 :              CALL hsmt_ab(sym,atoms,noco,nococonv,jspin,iintsp,iType,iAtom,cell,lapw,fjgj,abCoeffs,abSize,.FALSE.)
     212             :              !!$acc end data
     213       18759 :              abSize = abSize / 2
     214       18759 :              CALL timestop("hsmt_ab")
     215             : 
     216             :              ! Obtaining A, B coefficients for eigenfunctions
     217       18759 :              CALL timestart("gemm")
     218             : 
     219             :              ! variant with zgemm
     220             : 
     221             : 
     222             :              !$acc host_data use_device(work_c,abCoeffs,abTemp)
     223       56277 :              CALL zgemm_acc("T","T",ne,2*abSize,nvmax,CMPLX(1.0,0.0),work_c,MAXVAL(lapw%nv),abCoeffs,2*atoms%lmaxd*(atoms%lmaxd+2)+2,CMPLX(0.0,0.0),abTemp,acof_size)
     224             :              !$acc end host_data
     225             :              !$acc update self(abTemp)
     226             :              !stop "DEBUG"
     227       18759 :              !$OMP PARALLEL DO default(shared) private(i,lm) collapse(2)
     228             :              DO lm = 0, absize-1
     229             :                 DO i = 1, ne
     230             :                    acof(i,lm,iAtom_l) = acof(i,lm,iAtom_l) + abTemp(i,lm)
     231             :                    bcof(i,lm,iAtom_l) = bcof(i,lm,iAtom_l) + abTemp(i,absize+lm)
     232             :                 END DO
     233             :              END DO
     234             :              !$OMP END PARALLEL DO
     235             : 
     236       18759 :              CALL timestop("gemm")
     237             : 
     238       18759 :              CALL timestart("local orbitals")
     239             :              ! Treatment of local orbitals
     240             :              !!$acc data copyin(alo1,blo1,clo1,ccchi)create(ylm)
     241       38474 :              DO lo = 1, atoms%nlo(iType)               
     242       84644 :                 DO nkvec = 1, lapw%nkvec(lo,iAtom)
     243       46170 :                    iLAPW = lapw%kvec(nkvec,lo,iAtom)
     244      184680 :                    fg(:) = MERGE(lapw%gvec(:,iLAPW,iintsp),lapw%gvec(:,iLAPW,jspin),noco%l_ss) + qss + lapw%qPhon
     245      184680 :                    fk = lapw%bkpt + fg(:)
     246      184680 :                    tmk = tpi_const * DOT_PRODUCT(fk(:),atoms%taual(:,iAtom))
     247       46170 :                    phase = CMPLX(COS(tmk),SIN(tmk))
     248             : 
     249             :                     
     250       46170 :                    nap = sym%ngopr(iAtom)
     251       46170 :                    inap = sym%invtab(nap)
     252     1154250 :                    fkr = MATMUL(TRANSPOSE(sym%mrot(:,:,inap)),fk(:))
     253     1154250 :                    fgr = MATMUL(TRANSPOSE(sym%mrot(:,:,inap)),fg(:))
     254             :                    
     255      600210 :                    fkp = MATMUL(fkr,cell%bmat)
     256      600210 :                    fgp = MATMUL(fgr,cell%bmat)
     257             : 
     258       46170 :                    CALL ylm4(atoms%lmax(iType),fkp,ylm)
     259             :                    !!$acc update device(ylm)
     260             :                    CALL abclocdn(atoms,noco,lapw,cell,ccchi(:,jspin),iintsp,phase,ylm,iType,iAtom,iLAPW,nkvec,&
     261       65885 :                                  lo,ne,alo1(:,jspin),blo1(:,jspin),clo1(:,jspin),acof,bcof,ccof,zMat,l_force,fgp,force,iAtom_l)
     262             :                 END DO
     263             :              END DO ! loop over LOs
     264             :              !!$acc end data
     265       18759 :              CALL timestop("local orbitals")
     266             : 
     267             :             
     268             :              ! Force contributions
     269       18759 :              IF (atoms%l_geo(iType).AND.l_force) THEN
     270             :                !$acc  update self(abcoeffs,work_c)
     271         192 :                CALL timestart("transpose work array")
     272             :                ! For transposing the work array an OpenMP parallelization with explicit loops is used.
     273             :                ! This solution works fastest on all compilers. Note that this section can actually be
     274             :                ! a bottleneck without parallelization if many OpenMP threads are used.
     275         192 :                IF (zmat%l_real) THEN
     276          96 :                   ALLOCATE (workTrans_r(ne,nvmax))
     277          24 :                   !$OMP PARALLEL DO default(shared) private(i,iLAPW) collapse(2)
     278             :                   DO i = 1,ne
     279             :                      DO iLAPW = 1, nvmax
     280             :                         workTrans_r(i,iLAPW) = work_c(iLAPW,i)
     281             :                      END DO
     282             :                   END DO
     283             :                   !$OMP END PARALLEL DO
     284             :                ELSE
     285         672 :                   ALLOCATE (workTrans_c(ne,nvmax))
     286         168 :                   !$OMP PARALLEL DO default(shared) private(i,iLAPW) collapse(2)
     287             :                   DO i = 1,ne
     288             :                      DO iLAPW = 1, nvmax
     289             :                         workTrans_c(i,iLAPW) = work_c(iLAPW,i)
     290             :                      END DO
     291             :                   END DO
     292             :                   !$OMP END PARALLEL DO
     293             :                ENDIF
     294         192 :                CALL timestop("transpose work array")
     295             :             
     296         192 :                 CALL timestart("force contributions")
     297       86818 :                 DO iLAPW = 1,nvmax
     298             : 
     299      346504 :                    fg(:) = MERGE(lapw%gvec(:,iLAPW,iintsp),lapw%gvec(:,iLAPW,jspin),noco%l_ss) + qss
     300      346504 :                    fk = lapw%bkpt + fg(:)
     301     1386016 :                    s2h = 0.5 * DOT_PRODUCT(fk,MATMUL(cell%bbmat,fk))
     302       86626 :                    IF (zmat%l_real) THEN
     303     1524432 :                       s2h_e(:ne,iLAPW) = CMPLX((s2h-eig(:ne)) * workTrans_r(:ne,iLAPW))
     304             :                    ELSE
     305      206322 :                       s2h_e(:ne,iLAPW) = (s2h-eig(:ne)) * workTrans_c(:ne,iLAPW)
     306             :                    ENDIF
     307             :                     
     308       86626 :                       nap = sym%ngopr(iAtom)
     309       86626 :                       inap = sym%invtab(nap)
     310     2165650 :                       fgr = MATMUL(TRANSPOSE(sym%mrot(:,:,inap)),fg(:))
     311             :                    
     312     1386208 :                    fgpl(:,iLAPW) = MATMUL(fgr,cell%bmat)
     313             :                 ENDDO
     314             : 
     315     5361508 :                 helpMat_c = CONJG(abCoeffs(1+abSize:,:)) !TODO: Is this conjugation costly?
     316     1730946 :                 workTrans_cf = 0.0
     317             : 
     318         192 :                 CALL zgemm("N","T",ne,atoms%lmaxd*(atoms%lmaxd+2)+1,nvmax,CMPLX(1.0,0.0),s2h_e,ne,abCoeffs,size(abcoeffs,1),CMPLX(1.0,0.0),force%e1cof(:,:,iAtom),ne)
     319         192 :                 CALL zgemm("N","C",ne,atoms%lmaxd*(atoms%lmaxd+2)+1,nvmax,CMPLX(1.0,0.0),s2h_e,ne,helpMat_c,size(helpMat_c,1),CMPLX(1.0,0.0),force%e2cof(:,:,iAtom),ne)
     320         768 :                 DO i =1,3
     321         576 :                    IF (zmat%l_real) THEN
     322       88020 :                       DO iLAPW = 1,nvmax
     323     4573368 :                          workTrans_cf(:,iLAPW) = CMPLX(workTrans_r(:,iLAPW) * fgpl(i,iLAPW))
     324             :                       ENDDO
     325             :                    ELSE
     326      172434 :                       DO iLAPW = 1,nvmax
     327      619470 :                          workTrans_cf(:,iLAPW) = workTrans_c(:,iLAPW) * fgpl(i,iLAPW)
     328             :                       ENDDO
     329             :                    ENDIF
     330         576 :                    CALL zgemm("N","T",ne,atoms%lmaxd*(atoms%lmaxd+2)+1,nvmax,CMPLX(1.0,0.0),workTrans_cf,ne,abCoeffs,size(abCoeffs,1),CMPLX(0.0,0.0),helpMat_force,ne)
     331      416376 :                    force%aveccof(i,:,:,iAtom) = force%aveccof(i,:,:,iAtom) + helpMat_force(:,:)
     332         576 :                    CALL zgemm("N","C",ne,atoms%lmaxd*(atoms%lmaxd+2)+1,nvmax,CMPLX(1.0,0.0),workTrans_cf,ne,helpMat_c,size(helpMat_c,1),CMPLX(0.0,0.0),helpMat_force,ne)
     333      416568 :                    force%bveccof(i,:,:,iAtom) = force%bveccof(i,:,:,iAtom) + helpMat_force(:,:)
     334             :                 ENDDO
     335         192 :                 CALL timestop("force contributions")
     336             :              END IF
     337       38642 :              IF (atoms%l_geo(iType).AND.l_force) THEN
     338         192 :                 IF (zmat%l_real) THEN
     339          24 :                    DEALLOCATE (workTrans_r)
     340             :                 ELSE
     341         168 :                    DEALLOCATE (workTrans_c)
     342             :                 ENDIF
     343             :              END IF
     344             :        END DO ! loop over interstitial spin
     345             :     END DO ! loop over atoms
     346             :     !$acc exit data delete(abTemp,fjgj%fj,fjgj%gj,work_c,abcoeffs)
     347             :     !$acc exit data delete(fjgj)
     348        9209 :     DEALLOCATE(work_c)
     349        9209 :     IF(l_force) THEN
     350          62 :        DEALLOCATE(helpMat_c)
     351          62 :        DEALLOCATE(helpMat_force)
     352          62 :        DEALLOCATE(workTrans_cf)
     353          62 :        DEALLOCATE(s2h_e)
     354             :     ENDIF
     355             : 
     356             :     ! Treatment of atoms inversion symmetric to others
     357        9209 :     IF (l_useinversionsym) THEN
     358             :        !Comment on SOC case:
     359             :        !
     360             :        !                           -p,n       (l+m)   p,n  *
     361             :        ! Usually, we exploit that A     = (-1)      (A    )  if p and -p are the positions
     362             :        !                           l,m                l,-m
     363             :        ! of two atoms related by inversion symmetry and the coefficients are considered to
     364             :        ! be in the local frame of the representative atom. This is possible, if z is real.
     365             :        ! After SOC, however, the eigenvectors z are complex and this is no longer possible
     366             :        ! so the z has to enter, not z*. This is done within the k-loop.
     367             :        !                                    -p,n       m   p,n  *
     368             :        ! When called from hsohelp, we need A     = (-1)  (A    ) because we don't have to
     369             :        !                                     l,m           l,-m                    l
     370             :        ! rotate, but in the sums in hsoham only products A*  A   enter and the (-1) cancels.
     371             :        !                                                  lm  lm
     372         494 :        DO iAtom = 1, atoms%nat
     373         396 :           iType = atoms%itype(iAtom)
     374         396 :           iAtom_l=iAtom
     375         396 :           if (present(nat_start).and.present(nat_stop)) THEN
     376           6 :             if (iatom<nat_start.or.iatom>nat_stop) cycle
     377           3 :             iAtom_l=iAtom-nat_start+1
     378             :           endif   
     379         491 :           IF (sym%invsat(iAtom).EQ.1) THEN
     380         181 :              jAtom = sym%invsatnr(iAtom)
     381         181 :              jatom_l=jatom
     382         181 :              if (present(nat_start).and.present(nat_stop)) THEN
     383           1 :                if (jatom<nat_start.or.jatom>nat_stop) call judft_bug("MPI distribution failed in 2nd variation SOC")
     384           1 :                jAtom_l=jAtom-nat_start+1
     385             :              endif
     386         324 :              DO ilo = 1,atoms%nlo(iType)
     387         143 :                 l = atoms%llo(ilo,iType)
     388         617 :                 DO m = -l,l
     389         293 :                    inv_f = (-1)**(m+l)
     390       10387 :                    DO ie = 1,ne
     391        9951 :                       ccof(m,ie,ilo,jatom_l) = inv_f * CONJG( ccof(-m,ie,ilo,iatom_l))
     392       10244 :                       IF(l_force) THEN
     393        1632 :                          force%acoflo(m,ie,ilo,jatom_l) = inv_f * CONJG(force%acoflo(-m,ie,ilo,iatom_l))
     394        1632 :                          force%bcoflo(m,ie,ilo,jatom_l) = inv_f * CONJG(force%bcoflo(-m,ie,ilo,iatom_l))
     395        6528 :                          force%cveccof(:,m,ie,ilo,jatom_l) = -inv_f * CONJG(force%cveccof(:,-m,ie,ilo,iatom_l))
     396             :                       END IF
     397             :                    END DO
     398             :                 END DO
     399             :              END DO
     400        1720 :              DO l = 0,atoms%lmax(iType)
     401        1539 :                 ll1 = l* (l+1)
     402       14965 :                 DO m =-l,l
     403       13245 :                    lm  = ll1 + m
     404       13245 :                    lmp = ll1 - m
     405       13245 :                    inv_f = (-1)**(m+l)
     406      326001 :                    acof(:ne,lm,jatom_l) = inv_f * CONJG(acof(:ne,lmp,iatom_l))
     407      326001 :                    bcof(:ne,lm,jatom_l) = inv_f * CONJG(bcof(:ne,lmp,iatom_l))
     408       14784 :                    IF (atoms%l_geo(iType).AND.l_force) THEN
     409      101088 :                       force%e1cof(:ne,lm,jatom_l) = inv_f * CONJG(force%e1cof(:ne,lmp,iatom_l))
     410      101088 :                       force%e2cof(:ne,lm,jatom_l) = inv_f * CONJG(force%e2cof(:ne,lmp,iatom_l))
     411      398520 :                       force%aveccof(:,:ne,lm,jatom_l) = -inv_f * CONJG(force%aveccof(:,:ne,lmp,iatom_l))
     412      398520 :                       force%bveccof(:,:ne,lm,jatom_l) = -inv_f * CONJG(force%bveccof(:,:ne,lmp,iatom_l))
     413             :                    END IF
     414             :                 END DO
     415             :              END DO
     416             :              
     417             :           END IF
     418             :        END DO
     419             :     END IF
     420             : 
     421        9209 :     CALL timestop("abcof")
     422             : 
     423        9209 :   END SUBROUTINE abcof
     424      178966 : END MODULE m_abcof

Generated by: LCOV version 1.14