LCOV - code coverage report
Current view: top level - eigen_soc - hsoham.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 78 78 100.0 %
Date: 2019-09-08 04:53:50 Functions: 1 1 100.0 %

          Line data    Source code
       1             : MODULE m_hsoham
       2             :   !
       3             :   !*********************************************************************
       4             :   ! set up spin-orbit contribution to hamiltonian
       5             :   !*********************************************************************
       6             :   !
       7             : CONTAINS
       8          40 :   SUBROUTINE hsoham(&
       9          40 :        atoms,noco,input,nsz,neigd,chelp,rsoc,ahelp,bhelp,&
      10             :        nat_start,nat_stop,n_rank,n_size,SUB_COMM,&
      11          40 :        hsomtx)
      12             : 
      13             : #include"cpp_double.h"
      14             : 
      15             :     USE m_types
      16             :     IMPLICIT NONE
      17             : #ifdef CPP_MPI
      18             :       INCLUDE 'mpif.h'
      19             :       INTEGER ierr(3)
      20             : #endif
      21             :     TYPE(t_input),INTENT(IN)   :: input
      22             :     TYPE(t_noco),INTENT(IN)    :: noco
      23             :     TYPE(t_atoms),INTENT(IN)   :: atoms
      24             :     TYPE(t_rsoc),INTENT(IN)    :: rsoc
      25             :     !     ..
      26             :     !     .. Scalar Arguments ..
      27             :     !     ..
      28             :     INTEGER, INTENT (IN) ::  nat_start,nat_stop,n_rank,n_size,SUB_COMM,neigd
      29             :     !     .. Array Arguments ..
      30             :     INTEGER, INTENT (IN) :: nsz(:)!(input%jspins)  
      31             :     COMPLEX, INTENT (IN) :: ahelp((atoms%lmaxd+2)*atoms%lmaxd,nat_stop-nat_start+1,neigd,input%jspins)
      32             :     COMPLEX, INTENT (IN) :: bhelp((atoms%lmaxd+2)*atoms%lmaxd,nat_stop-nat_start+1,neigd,input%jspins)
      33             :     COMPLEX, INTENT (IN) :: chelp(-atoms%llod:atoms%llod,neigd,atoms%nlod,nat_stop-nat_start+1,input%jspins)
      34             :     COMPLEX, INTENT (OUT):: hsomtx(neigd,neigd,2,2)
      35             :     !     ..
      36             :     !     .. Local Scalars ..
      37             :     COMPLEX c_1,c_2,c_3,c_4,c_5
      38             :     INTEGER i,j,jsp,jsp1,l,lwn,m1,n,na,nn,i1,j1,ilo,ilop,m,nat_l,na_g,lm,ll1,lm1
      39             :     !     ..
      40             :     !     .. Local Arrays ..
      41          40 :     COMPLEX, ALLOCATABLE :: c_b(:,:),c_a(:,:),c_c(:,:,:),c_buf(:)
      42             :     !     ..
      43             :     !
      44             :     !---------------------------------------------------------------------
      45             :     !  ss'  _
      46             :     ! H  = \  (xhelp(s,i,na,l,m) conjg(yhelp(s',j,na,l,m')*rsoxy(na,l,s,s')
      47             :     !           *<slm|L*S|s'lm'>
      48             :     !  ij  /_
      49             :     !       na,l,m,m'
      50             :     !                       x,y = a,b
      51             :     !---------------------------------------------------------------------
      52             :     !
      53          40 :     nat_l = nat_stop - nat_start + 1  ! atoms processed by this pe
      54             :     !
      55             :     !---> update hamiltonian matrices: upper triangle
      56             :     !
      57             : 
      58             :     ALLOCATE ( c_b((atoms%lmaxd+2)*atoms%lmaxd,nat_l),&
      59             :                c_a((atoms%lmaxd+2)*atoms%lmaxd,nat_l),&
      60          40 :                c_c(-atoms%llod:atoms%llod, atoms%nlod, nat_l) )
      61         200 :     DO i1 = 1,2
      62          80 :        jsp = i1
      63          80 :        IF (input%jspins.EQ.1) jsp = 1
      64         280 :        DO j1 = 1,2
      65         160 :           jsp1 = j1
      66         160 :           IF (input%jspins.EQ.1) jsp1 = 1
      67             :           !!$OMP PARALLEL DEFAULT(none)&
      68             :           !!$OMP PRIVATE(j,na,na_g,n,nn,l,m,m1,ilo,i,lwn,ilop)& 
      69             :           !!$OMP PRIVATE(c_a,c_b,c_c,c_1,c_2,c_3,c_4,c_5) &
      70             :           !!$OMP SHARED(hsomtx,i1,jsp,j1,jsp1,nsz,atoms)& 
      71             :           !!$OMP SHARED(ahelp,bhelp,chelp,noco,nat_start,nat_stop,nat_l)&
      72             :           !!$OMP SHARED(rsoc)
      73             :           !!$OMP DO 
      74             : 
      75        6144 :           DO j = 1,nsz(jsp1)
      76             :              !
      77             :              ! prepare \sum_m' conjg( xhelp(m',l,na,j,jsp1) ) * soangl(l,m,i1,l,m',j1)
      78             :              !
      79        5904 :              na = 0 ; na_g = 0
      80       19376 :              DO n = 1,atoms%ntype
      81       33904 :                 DO nn = 1, atoms%neq(n)
      82       14528 :                    na_g = na_g + 1
      83       28000 :                    IF ((na_g.GE.nat_start).AND.(na_g.LE.nat_stop)) THEN
      84       13112 :                       na = na + 1
      85             :                       !--> regular part
      86       13112 :                       DO l = 1,atoms%lmax(n)
      87      103824 :                          ll1 = l*(l+1) 
      88     1156688 :                          DO m = -l,l
      89     1052864 :                             lm = ll1 + m
      90     1052864 :                             c_a(lm,na) = CMPLX(0.,0.)
      91     1052864 :                             c_b(lm,na) = CMPLX(0.,0.)
      92    14382304 :                             DO m1 = -l,l
      93    13225616 :                                lm1 = ll1 + m1
      94             :                                c_a(lm,na) = c_a(lm,na) + rsoc%soangl(l,m,i1,l,m1,j1)&
      95    13225616 :                                                        * CONJG(ahelp(lm1,na,j,jsp1))
      96             :                                c_b(lm,na) = c_b(lm,na) + rsoc%soangl(l,m,i1,l,m1,j1)&
      97    14278480 :                                                        * CONJG(bhelp(lm1,na,j,jsp1))
      98             :                             ENDDO
      99             :                          ENDDO
     100             :                       ENDDO
     101             :                       !--> LO contribution
     102       14792 :                       DO ilo = 1,atoms%nlo(n)
     103        1680 :                          l = atoms%llo(ilo,n)
     104       14792 :                          IF (l.GT.0) THEN
     105        8304 :                             DO m = -l,l
     106        6624 :                                c_c(m,ilo,na) = CMPLX(0.,0.)
     107       36096 :                                DO m1 = -l,l
     108             :                                   c_c(m,ilo,na) = c_c(m,ilo,na) + CONJG(&
     109       34416 :                                        chelp(m1,j,ilo,na,jsp1))*rsoc%soangl(l,m,i1,l,m1,j1)
     110             :                                ENDDO
     111             :                             ENDDO
     112             :                          ENDIF
     113             :                       ENDDO
     114             :                       ! end lo's
     115             :                    ENDIF
     116             :                 ENDDO  ! nn
     117             :              ENDDO     ! n
     118             :                 !
     119             :              ! continue loop structure
     120             :              !
     121      256464 :              DO i = 1,nsz(jsp)
     122      250400 :                 hsomtx(i,j,i1,j1) = CMPLX(0.,0.)
     123      250400 :                 na = 0 ; na_g = 0
     124             :                 !
     125             :                 !--->    loop over each atom type
     126             :                 !
     127      887792 :                 DO n = 1,atoms%ntype
     128      631488 :                    lwn = atoms%lmax(n)
     129             :                    !
     130             :                    !--->    loop over equivalent atoms
     131             :                    !
     132     1583072 :                    DO  nn = 1,atoms%neq(n)
     133      701184 :                       na_g = na_g + 1
     134     1332672 :                       IF ((na_g.GE.nat_start).AND.(na_g.LE.nat_stop)) THEN
     135      611760 :                          na = na + 1
     136      611760 :                          DO l = 1,lwn
     137     4797728 :                             ll1 = l*(l+1) 
     138    53484192 :                             DO m = -l,l
     139    48686464 :                                lm = ll1 + m
     140             :                                c_1 =   rsoc%rsopp(n,l,i1,j1) * ahelp(lm,na,i,jsp) +&
     141    48686464 :                                       rsoc%rsopdp(n,l,i1,j1) * bhelp(lm,na,i,jsp)
     142             :                                c_2 =  rsoc%rsoppd(n,l,i1,j1) * ahelp(lm,na,i,jsp) +&
     143    48686464 :                                      rsoc%rsopdpd(n,l,i1,j1) * bhelp(lm,na,i,jsp)
     144             :                                hsomtx(i,j,i1,j1) = hsomtx(i,j,i1,j1) +&
     145    53484192 :                                     c_1*c_a(lm,na) + c_2*c_b(lm,na)  
     146             :                             ENDDO
     147             :                             ! 
     148             :                          ENDDO
     149             :                          !--> LO contribution
     150      718608 :                          DO ilo = 1,atoms%nlo(n)
     151      106848 :                             l = atoms%llo(ilo,n)
     152      106848 :                             ll1 = l*(l+1)
     153      718608 :                             IF (l.GT.0) THEN
     154      531936 :                                DO m = -l,l
     155      425088 :                                   lm = ll1 + m
     156             :                                   c_3 = rsoc%rsopplo(n,ilo,i1,j1) *ahelp(lm,na,i,jsp) +&
     157      425088 :                                        rsoc%rsopdplo(n,ilo,i1,j1) *bhelp(lm,na,i,jsp)
     158      425088 :                                   c_4 = rsoc%rsoplop(n,ilo,i1,j1) *chelp(m,i,ilo,na,jsp)
     159      425088 :                                   c_5 =rsoc%rsoplopd(n,ilo,i1,j1) *chelp(m,i,ilo,na,jsp)
     160             :                                   hsomtx(i,j,i1,j1) = hsomtx(i,j,i1,j1) + &
     161             :                                        c_4*c_a(lm,na) + c_5*c_b(lm,na) +&
     162      531936 :                                        c_3*c_c(m,ilo,na)
     163             :                                ENDDO
     164      320544 :                                DO ilop = 1,atoms%nlo(n)
     165      213696 :                                   IF (atoms%llo(ilop,n).EQ.l) THEN
     166      957024 :                                      DO m = -l,l
     167             :                                         hsomtx(i,j,i1,j1) = hsomtx(i,j,i1,j1) + &
     168             :                                              rsoc%rsoploplop(n,ilop,ilo,i1,j1) * &
     169      531936 :                                              chelp(m,i,ilop,na,jsp) * c_c(m,ilo,na)
     170             :                                      ENDDO
     171             :                                   ENDIF
     172             :                                ENDDO
     173             :                             ENDIF
     174             :                          ENDDO
     175             :                          ! end lo's
     176             :                       ENDIF
     177             :                    ENDDO
     178             :                 ENDDO ! atoms
     179             :              ENDDO
     180             :              !!i
     181             :           ENDDO
     182             :           !!j
     183             :           !!$OMP END DO
     184             :           !!$OMP END PARALLEL
     185             :        ENDDO
     186             :        !!jsp1
     187             :     ENDDO
     188             :     !!jsp
     189          40 :     DEALLOCATE (c_a,c_b,c_c)
     190             :     !
     191             :     !---> update hamiltonian matrices: lower triangle
     192             :     !
     193        1516 :     DO i = 1,nsz(1)
     194       64116 :        DO j = 1,nsz(input%jspins)
     195       64076 :           hsomtx(j,i,2,1) = CONJG(hsomtx(i,j,1,2))
     196             :        ENDDO
     197             :     ENDDO
     198             :     !
     199             : #ifdef CPP_MPI
     200          40 :     CALL MPI_BARRIER(SUB_COMM,ierr)
     201          40 :     n = 4*nsz(1)*nsz(input%jspins)
     202          40 :     ALLOCATE(c_buf(n))
     203          40 :     CALL MPI_REDUCE(hsomtx,c_buf,n,CPP_MPI_COMPLEX,MPI_SUM,0,SUB_COMM,ierr)
     204          40 :     IF (n_rank.EQ.0) THEN
     205          38 :         CALL CPP_BLAS_ccopy(n,c_buf,1,hsomtx,1)
     206             :     ENDIF
     207          40 :     DEALLOCATE(c_buf)
     208             : #endif
     209             :     !
     210          40 :     RETURN
     211             :   END SUBROUTINE hsoham
     212             : END MODULE m_hsoham

Generated by: LCOV version 1.13