LCOV - code coverage report
Current view: top level - eigen_soc - ssomat.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 176 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 2 0.0 %

          Line data    Source code
       1             : MODULE m_ssomat
       2             :   USE m_judft
       3             :   IMPLICIT NONE
       4             : CONTAINS
       5           0 :   SUBROUTINE ssomat(seigvso,theta,phi,eig_id,DIMENSION,atoms,kpts,sym,&
       6             :        cell,noco, input,mpi, oneD,enpara,v,results )
       7             :     
       8             :     USE m_types_mat
       9             :     USE m_types_setup
      10             :     USE m_types_mpi
      11             :     USE m_types_enpara
      12             :     USE m_types_potden
      13             :     USE m_types_misc
      14             :     USE m_types_kpts
      15             :     USE m_types_tlmplm
      16             :     USE m_types_usdus
      17             :     USE m_types_lapw
      18             :     USE m_constants
      19             :     USE m_eig66_io
      20             :     USE m_spnorb 
      21             :     USE m_abcof 
      22             :     IMPLICIT NONE
      23             : 
      24             :     TYPE(t_mpi),INTENT(IN)         :: mpi
      25             :     TYPE(t_dimension),INTENT(IN)   :: dimension
      26             :     TYPE(t_oneD),INTENT(IN)        :: oneD
      27             :     TYPE(t_input),INTENT(IN)       :: input
      28             :     TYPE(t_noco),INTENT(IN)        :: noco
      29             :     TYPE(t_sym),INTENT(IN)         :: sym
      30             :     TYPE(t_cell),INTENT(IN)        :: cell
      31             :     TYPE(t_kpts),INTENT(IN)        :: kpts
      32             :     TYPE(t_atoms),INTENT(IN)       :: atoms
      33             :     TYPE(t_enpara),INTENT(IN)      :: enpara
      34             :     TYPE(t_potden),INTENT(IN)      :: v
      35             :     TYPE(t_results),INTENT(IN)     :: results
      36             :     INTEGER,INTENT(IN)             :: eig_id
      37             :     REAL,INTENT(in)                :: theta(:),phi(:) ! more than a single angle at once...
      38             :     REAL,INTENT(OUT)               :: seigvso(:)
      39             :     !     ..
      40             :     !     .. Locals ..
      41             : #ifdef CPP_MPI
      42             :     INTEGER:: ierr
      43             :     include 'mpif.h'
      44             : #endif
      45             :     INTEGER :: neigf=1  !not full-matrix
      46             :     INTEGER :: ilo,js,jsloc,nk,n,l ,lm,band,nr,ne,nat,m
      47             :     INTEGER :: na 
      48             :     REAL    :: r1,r2  
      49             :     COMPLEX :: c1,c2  
      50             : 
      51           0 :     COMPLEX, ALLOCATABLE :: matel(:,:,:) 
      52           0 :     REAL,    ALLOCATABLE :: eig_shift(:,:,:) 
      53             : 
      54           0 :     COMPLEX, ALLOCATABLE :: acof(:,:,:,:,:), bcof(:,:,:,:,:)
      55           0 :     COMPLEX, ALLOCATABLE :: ccof(:,:,:,:,:,:)
      56           0 :     COMPLEX,ALLOCATABLE  :: soangl(:,:,:,:,:,:,:)
      57             :   
      58           0 :     TYPE(t_rsoc) :: rsoc
      59           0 :     TYPE(t_mat)  :: zmat
      60           0 :     TYPE(t_usdus):: usdus
      61           0 :     TYPE(t_lapw) :: lapw
      62             : 
      63           0 :     IF (ANY(atoms%neq/=1)) CALL judft_error('(spin spiral + soc) does not work'//&
      64           0 :          ' properly for more than one atom per type!',calledby="ssomat")
      65             : 
      66             : 
      67             :     
      68             :     ! needed directly for calculating matrix elements  
      69           0 :     seigvso=0.0
      70           0 :     ALLOCATE(eig_shift(DIMENSION%neigd,kpts%nkpt,SIZE(theta)));eig_shift=0.0
      71             :     ALLOCATE( acof(dimension%neigd,0:dimension%lmd,atoms%nat,2,2),&
      72           0 :          bcof(dimension%neigd,0:dimension%lmd,atoms%nat,2,2) )
      73           0 :     ALLOCATE( ccof(-atoms%llod:atoms%llod,dimension%neigd,atoms%nlod,atoms%nat,2,2) )
      74             : 
      75           0 :     ALLOCATE( matel(neigf,DIMENSION%neigd,0:atoms%ntype) )
      76             : 
      77             :   
      78             : 
      79           0 :     CALL usdus%init(atoms,2)
      80             : 
      81             : 
      82             :     !Calculate radial and angular matrix elements of SOC
      83             :     !many directions of SOC at once...
      84           0 :     CALL spnorb(atoms,noco,input,mpi, enpara, v%mt, usdus, rsoc,.FALSE.)
      85             : 
      86             :     ALLOCATE(soangl(atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2,&
      87           0 :          atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2,SIZE(theta)))
      88           0 :     soangl=0.0
      89           0 :     DO nr=1,SIZE(theta)
      90           0 :        CALL spnorb_angles(atoms,mpi,theta(nr),phi(nr),soangl(:,:,:,:,:,:,nr))
      91             :     ENDDO
      92             :     
      93           0 :     DO nk=mpi%irank+1,kpts%nkpt,mpi%isize
      94           0 :        CALL lapw%init(input,noco, kpts,atoms,sym,nk,cell,.false.)
      95           0 :        zMat%matsize1=lapw%nv(1)+lapw%nv(2)+2*atoms%nlotot
      96           0 :        zmat%matsize2=DIMENSION%neigd
      97           0 :        zmat%l_real=.FALSE.
      98           0 :        IF (ALLOCATED(zmat%data_c)) DEALLOCATE(zmat%data_c)
      99           0 :        ALLOCATE(zmat%data_c(zMat%matsize1,zmat%matsize2))
     100           0 :        CALL read_eig(eig_id,nk,1,neig=ne,eig=eig_shift(:,nk,1),zmat=zmat)
     101           0 :        DO jsloc= 1,2 
     102           0 :           eig_shift(:,nk,1)=0.0 !not needed
     103             :           CALL abcof(input,atoms,sym, cell,lapw,ne,usdus,noco,jsloc,oneD, &
     104           0 :                acof(:,:,:,jsloc,1),bcof(:,:,:,jsloc,1),ccof(:,:,:,:,jsloc,1),zMat)
     105             :        ENDDO
     106             : 
     107             :        ! rotate abcof into global spin coordinate frame 
     108             :        nat= 0 
     109           0 :        DO n= 1,atoms%ntype  
     110           0 :           DO na= 1,atoms%neq(n)
     111           0 :              nat= nat+1 
     112           0 :              r1= noco%alph(n) 
     113           0 :              r2= noco%beta(n) 
     114           0 :              DO lm= 0,DIMENSION%lmd
     115           0 :                 DO band= 1,DIMENSION%neigd
     116           0 :                    c1= acof(band,lm,nat,1,1)
     117           0 :                    c2= acof(band,lm,nat,2,1)
     118           0 :                    acof(band,lm,nat,1,1)= CMPLX(COS(r1/2.),-SIN(r1/2.)) *CMPLX( COS(r2/2.),0.) *c1
     119           0 :                    acof(band,lm,nat,2,1)= CMPLX(COS(r1/2.),-SIN(r1/2.)) *CMPLX(-SIN(r2/2.),0.) *c2
     120           0 :                    acof(band,lm,nat,1,2)= CMPLX(COS(r1/2.),+SIN(r1/2.)) *CMPLX(+SIN(r2/2.),0.) *c1
     121           0 :                    acof(band,lm,nat,2,2)= CMPLX(COS(r1/2.),+SIN(r1/2.)) *CMPLX( COS(r2/2.),0.) *c2
     122           0 :                    c1= bcof(band,lm,nat,1,1)
     123           0 :                    c2= bcof(band,lm,nat,2,1)
     124           0 :                    bcof(band,lm,nat,1,1)= CMPLX(COS(r1/2.),-SIN(r1/2.)) *CMPLX( COS(r2/2.),0.) *c1
     125           0 :                    bcof(band,lm,nat,2,1)= CMPLX(COS(r1/2.),-SIN(r1/2.)) *CMPLX(-SIN(r2/2.),0.) *c2
     126           0 :                    bcof(band,lm,nat,1,2)= CMPLX(COS(r1/2.),+SIN(r1/2.)) *CMPLX(+SIN(r2/2.),0.) *c1
     127           0 :                    bcof(band,lm,nat,2,2)= CMPLX(COS(r1/2.),+SIN(r1/2.)) *CMPLX( COS(r2/2.),0.) *c2
     128             :                 ENDDO ! band
     129             :              ENDDO   ! lm
     130           0 :              DO ilo = 1,atoms%nlo(n)
     131           0 :                 l = atoms%llo(ilo,n)
     132           0 :                 DO band= 1,DIMENSION%neigd
     133           0 :                    DO m = -l, l
     134           0 :                       c1= ccof(m,band,ilo,nat,1,1)
     135           0 :                       c2= ccof(m,band,ilo,nat,2,1)
     136           0 :                       ccof(m,band,ilo,nat,1,1)= CMPLX(COS(r1/2.),-SIN(r1/2.))*CMPLX( COS(r2/2.),0.)*c1
     137           0 :                       ccof(m,band,ilo,nat,2,1)= CMPLX(COS(r1/2.),-SIN(r1/2.))*CMPLX(-SIN(r2/2.),0.)*c2
     138           0 :                       ccof(m,band,ilo,nat,1,2)= CMPLX(COS(r1/2.),+SIN(r1/2.))*CMPLX(+SIN(r2/2.),0.)*c1
     139           0 :                       ccof(m,band,ilo,nat,2,2)= CMPLX(COS(r1/2.),+SIN(r1/2.))*CMPLX( COS(r2/2.),0.)*c2
     140             :                    ENDDO
     141             :                 ENDDO
     142             :              ENDDO
     143             :           ENDDO
     144             :        ENDDO
     145           0 :        DO nr=1,size(theta) !loop over angles
     146             :           ! matrix elements within k
     147             :           CALL ssomatel(neigf,dimension,atoms, noco, &
     148             :                soangl(:,:,:,:,:,:,nr),rsoc%rsopp(:,:,:,:),rsoc%rsoppd(:,:,:,:),&
     149             :                rsoc%rsopdp(:,:,:,:),rsoc%rsopdpd(:,:,:,:),rsoc%rsoplop(:,:,:,:), &
     150             :                rsoc%rsoplopd(:,:,:,:),rsoc%rsopdplo(:,:,:,:),rsoc%rsopplo(:,:,:,:),&
     151             :                rsoc%rsoploplop(:,:,:,:,:),&
     152             :                .TRUE.,&
     153             :                acof,bcof, ccof,&
     154             :                acof,bcof, ccof,&
     155           0 :                matel )
     156           0 :           eig_shift(:,nk,nr)=matel(1,:,0)
     157             :        ENDDO
     158             :     ENDDO
     159             : 
     160             :     !Collect data from distributed k-loop
     161             : #ifdef CPP_MPI
     162           0 :     IF (mpi%irank==0) THEN
     163           0 :        CALL MPI_REDUCE(MPI_IN_PLACE,eig_shift,SIZE(eig_shift),MPI_DOUBLE_PRECISION,MPI_SUM,0,mpi%mpi_comm,ierr)
     164             :     ELSE
     165           0 :        CALL MPI_REDUCE(eig_shift,eig_shift,SIZE(eig_shift),MPI_DOUBLE_PRECISION,MPI_SUM,0,mpi%mpi_comm,ierr)
     166             :     ENDIF
     167             : #endif
     168             : 
     169           0 :     IF (mpi%irank==0) THEN
     170             :        !Sum all shift using weights
     171           0 :        DO nr=1,SIZE(theta)
     172           0 :           DO nk=1,kpts%nkpt
     173           0 :              seigvso(nr)=seigvso(nr)+dot_PRODUCT(results%w_iks(:,nk,1),eig_shift(:,nk,nr))
     174             :           ENDDO
     175             :        ENDDO
     176           0 :        seigvso= results%seigv+seigvso
     177             :     ENDIF
     178           0 :   END SUBROUTINE ssomat
     179             : 
     180             :   ! ==================================================================== ! 
     181             : 
     182           0 :   SUBROUTINE ssomatel(neigf,dimension,atoms, noco,&
     183           0 :        soangl,rsopp,rsoppd,rsopdp,rsopdpd,rsoplop,&
     184           0 :        rsoplopd,rsopdplo,rsopplo,rsoploplop,&
     185             :        diag, &
     186           0 :        acof1,bcof1,ccof1,acof2,bcof2,ccof2,&
     187           0 :        matel )
     188             :     USE m_types
     189             :     IMPLICIT NONE
     190             :     TYPE(t_dimension),INTENT(IN)   :: dimension
     191             :     TYPE(t_noco),INTENT(IN)        :: noco
     192             :     TYPE(t_atoms),INTENT(IN)       :: atoms
     193             : 
     194             :     LOGICAL, INTENT(IN)  :: diag 
     195             :     INTEGER, INTENT(IN)  :: neigf   
     196             :     REAL,    INTENT(IN)  :: &
     197             :          rsopp(:,:,:,:), rsoppd(:,:,:,:),&
     198             :          rsopdp(:,:,:,:), rsopdpd(:,:,:,:),  &
     199             :          rsoplop(:,:,:,:),rsoplopd(:,:,:,:),&
     200             :          rsopdplo(:,:,:,:),rsopplo(:,:,:,:),&
     201             :          rsoploplop(:,:,:,:,:)
     202             :     COMPLEX, INTENT(IN)  :: &
     203             :          soangl(:,-atoms%lmaxd:,:,:,-atoms%lmaxd:,:),  &
     204             :          acof1(:,0:,:,:,:), &
     205             :          bcof1(:,0:,:,:,:),&
     206             :          ccof1(-atoms%llod:,:,:,:,:,:),&
     207             :          acof2(:,0:,:,:,:), &
     208             :          bcof2(:,0:,:,:,:),&
     209             :          ccof2(-atoms%llod:,:,:,:,:,:)
     210             :  
     211             :     Complex, INTENT(OUT) :: matel(neigf,dimension%neigd,0:atoms%ntype)
     212             : 
     213             :     INTEGER :: band1,band2,bandf, n ,na, l,m1,m2,lm1,lm2,&
     214             :          jsloc1,jsloc2, js1,js2,jsnumber,ilo,ilop,nat
     215           0 :     COMPLEX, ALLOCATABLE :: sa(:,:),sb(:,:),sc(:,:,:),ral(:,:,:)
     216           0 :     COMPLEX, ALLOCATABLE :: ra(:,:),rb(:,:),rc(:,:,:),rbl(:,:,:)
     217             : 
     218             :     ! with the following nesting of loops the calculation of the 
     219             :     ! matrix-elements is of order
     220             :     ! natall*lmd*neigd*(lmd+neigd) ; note that  lmd+neigd << lmd*neigd
     221             : 
     222           0 :     matel(:,:,:)= CMPLX(0.,0.) 
     223           0 :     ALLOCATE ( sa(2,0:dimension%lmd),sb(2,0:dimension%lmd),ra(2,0:dimension%lmd),rb(2,0:dimension%lmd) )
     224           0 :     ALLOCATE ( sc(2,-atoms%llod:atoms%llod,atoms%nlod),rc(2,-atoms%llod:atoms%llod,atoms%nlod) )
     225           0 :     ALLOCATE ( ral(2,-atoms%llod:atoms%llod,atoms%nlod),rbl(2,-atoms%llod:atoms%llod,atoms%nlod) )
     226             : 
     227             :     ! within one k-point loop over global spin 
     228           0 :     IF (diag) THEN 
     229             :        jsnumber= 2
     230             :     ELSE 
     231           0 :        jsnumber= 1
     232             :     ENDIF
     233           0 :     DO js2= 1,jsnumber 
     234           0 :        IF (diag) THEN
     235           0 :           js1= js2
     236             :        ELSE
     237             :           js1= 2
     238             :        ENDIF
     239             : 
     240             :        ! loop over MT 
     241           0 :        na= 0 
     242           0 :        DO n= 1,atoms%ntype  
     243           0 :           DO nat= 1,atoms%neq(n) 
     244           0 :              na= na+1 
     245             : 
     246           0 :              DO band2= 1,dimension%neigd ! loop over eigenstates 2
     247             : 
     248           0 :                 DO l= 1,atoms%lmax(n) ! loop over l
     249           0 :                    DO m1= -l,l   ! loop over m1
     250           0 :                       lm1= l*(l+1) + m1
     251             : 
     252           0 :                       DO jsloc2= 1,2
     253           0 :                          sa(jsloc2,lm1) = CMPLX(0.,0.)
     254           0 :                          sb(jsloc2,lm1) = CMPLX(0.,0.)
     255           0 :                          DO m2= -l,l
     256           0 :                             lm2= l*(l+1) + m2
     257             : 
     258             :                             sa(jsloc2,lm1)= sa(jsloc2,lm1) + &
     259             :                                  CONJG(acof2(band2,lm2,na,jsloc2,js2))&
     260           0 :                                  * soangl(l,m2,js2,l,m1,js1)
     261             :                             sb(jsloc2,lm1)= sb(jsloc2,lm1) + &
     262             :                                  CONJG(bcof2(band2,lm2,na,jsloc2,js2))&
     263           0 :                                  * soangl(l,m2,js2,l,m1,js1)
     264             : 
     265             :                          ENDDO ! m2  
     266             :                       ENDDO   ! jsloc2
     267             : 
     268             :                    ENDDO ! m1
     269             :                 ENDDO   ! l
     270             : 
     271           0 :                 DO ilo = 1, atoms%nlo(n) ! LO-part
     272           0 :                    l = atoms%llo(ilo,n)
     273           0 :                    DO m1 = -l, l
     274           0 :                       DO jsloc2= 1,2
     275           0 :                          sc(jsloc2,m1,ilo) = CMPLX(0.,0.)
     276           0 :                          IF (l==0) CYCLE
     277           0 :                          DO m2= -l, l
     278             :                             sc(jsloc2,m1,ilo) = sc(jsloc2,m1,ilo) +&
     279             :                                  CONJG(ccof2(m2,band2,ilo,na,jsloc2,js2))&
     280           0 :                                  * soangl(l,m2,js2,l,m1,js1)
     281             :                          ENDDO
     282             :                       ENDDO
     283             :                    ENDDO
     284             :                 ENDDO ! ilo
     285             : 
     286           0 :                 DO l= 1,atoms%lmax(n) ! loop over l
     287           0 :                    DO m1= -l,l   ! loop over m1
     288           0 :                       lm1= l*(l+1) + m1
     289             : 
     290           0 :                       DO jsloc1= 1,2
     291           0 :                          ra(jsloc1,lm1)= CMPLX(0.,0.) 
     292           0 :                          rb(jsloc1,lm1)= CMPLX(0.,0.) 
     293           0 :                          DO jsloc2= 1,2
     294             :                             ra(jsloc1,lm1)= ra(jsloc1,lm1) +  &
     295             :                                  sa(jsloc2,lm1) * rsopp(n,l,jsloc1,jsloc2) &
     296           0 :                                  + sb(jsloc2,lm1) * rsoppd(n,l,jsloc1,jsloc2) 
     297             :                             rb(jsloc1,lm1)= rb(jsloc1,lm1) +&
     298             :                                  sa(jsloc2,lm1) * rsopdp(n,l,jsloc1,jsloc2)&
     299           0 :                                  + sb(jsloc2,lm1) * rsopdpd(n,l,jsloc1,jsloc2)
     300             :                          ENDDO ! jsloc2
     301             :                       ENDDO   ! jsloc1 
     302             : 
     303             :                    ENDDO ! m1
     304             :                 ENDDO   ! l
     305             : 
     306           0 :                 DO ilo = 1, atoms%nlo(n) ! LO-part
     307           0 :                    l = atoms%llo(ilo,n)
     308           0 :                    DO m1 = -l, l
     309           0 :                       lm1= l*(l+1) + m1
     310           0 :                       DO jsloc1= 1,2
     311           0 :                          ral(jsloc1,m1,ilo) = CMPLX(0.,0.)
     312           0 :                          rbl(jsloc1,m1,ilo) = CMPLX(0.,0.)
     313           0 :                          rc(jsloc1,m1,ilo)  = CMPLX(0.,0.)
     314           0 :                          DO jsloc2= 1,2
     315             :                             ral(jsloc1,m1,ilo) = ral(jsloc1,m1,ilo) +&
     316           0 :                                  sc(jsloc2,m1,ilo) * rsopplo(n,ilo,jsloc1,jsloc2)
     317             :                             rbl(jsloc1,m1,ilo) = rbl(jsloc1,m1,ilo) +&
     318           0 :                                  sc(jsloc2,m1,ilo) * rsopdplo(n,ilo,jsloc1,jsloc2)
     319             :                             rc(jsloc1,m1,ilo) = rc(jsloc1,m1,ilo) +&
     320             :                                  sa(jsloc2,lm1) * rsoplop(n,ilo,jsloc1,jsloc2)&
     321           0 :                                  + sb(jsloc2,lm1) * rsoplopd(n,ilo,jsloc1,jsloc2)
     322             :                          ENDDO
     323             :                       ENDDO
     324             :                    ENDDO
     325             :                 ENDDO ! ilo
     326             : 
     327           0 :                 DO l= 1,atoms%lmax(n) ! loop over l
     328           0 :                    DO m1= -l,l   ! loop over m1
     329           0 :                       lm1= l*(l+1) + m1
     330             : 
     331           0 :                       DO jsloc1= 1,2
     332           0 :                          DO bandf= 1,neigf
     333           0 :                             IF (neigf==dimension%neigd) THEN
     334             :                                band1= bandf
     335             :                             ELSE
     336           0 :                                band1= band2
     337             :                             ENDIF
     338             :                             matel(bandf,band2,n)= matel(bandf,band2,n) +&
     339             :                                  acof1(band1,lm1,na,jsloc1,js1)*ra(jsloc1,lm1)   &
     340           0 :                                  + bcof1(band1,lm1,na,jsloc1,js1)*rb(jsloc1,lm1)   
     341             :                          ENDDO ! band1
     342             :                       ENDDO   ! jsloc1 
     343             : 
     344             :                    ENDDO ! m1,lm1 
     345             :                 ENDDO   ! l
     346             : 
     347           0 :                 DO ilo = 1, atoms%nlo(n) ! LO-part
     348           0 :                    l = atoms%llo(ilo,n)
     349           0 :                    IF (l==0) CYCLE
     350           0 :                    DO m1 = -l, l
     351           0 :                       lm1= l*(l+1) + m1
     352             : 
     353           0 :                       DO jsloc1= 1,2
     354           0 :                          DO bandf= 1,neigf
     355           0 :                             IF (neigf==dimension%neigd) THEN
     356             :                                band1= bandf
     357             :                             ELSE
     358           0 :                                band1= band2
     359             :                             ENDIF
     360             :                             matel(bandf,band2,n)= matel(bandf,band2,n) +&
     361             :                                  ccof1(m1,band1,ilo,na,jsloc1,js1)*rc(jsloc1,m1,ilo)&
     362             :                                  + acof1(band1,lm1,na,jsloc1,js1)*ral(jsloc1,m1,ilo)&
     363           0 :                                  + bcof1(band1,lm1,na,jsloc1,js1)*rbl(jsloc1,m1,ilo)
     364             :                          ENDDO ! band1
     365             :                       ENDDO   ! jsloc1 
     366             : 
     367           0 :                       DO ilop = 1,atoms%nlo(n)
     368           0 :                          IF (atoms%llo(ilop,n).EQ.l) THEN
     369           0 :                             DO jsloc1= 1,2
     370           0 :                                DO bandf= 1,neigf
     371           0 :                                   IF (neigf==dimension%neigd) THEN
     372             :                                      band1= bandf
     373             :                                   ELSE
     374           0 :                                      band1= band2
     375             :                                   ENDIF
     376           0 :                                   DO jsloc2= 1,2 
     377             :                                      matel(bandf,band2,n)= matel(bandf,band2,n) +&
     378             :                                           ccof1(m1,band1,ilo,na,jsloc1,js1)*&
     379             :                                           rsoploplop(n,ilo,ilop,jsloc1,jsloc2)*&
     380           0 :                                           sc(jsloc2,m1,ilop)
     381             :                                   ENDDO   ! jsloc2
     382             :                                ENDDO     ! band1
     383             :                             ENDDO   ! jsloc1
     384             :                          ENDIF
     385             :                       ENDDO ! ilop
     386             : 
     387             :                    ENDDO   ! m1 
     388             :                 ENDDO     ! ilo
     389             : 
     390             :              ENDDO     ! band2
     391             :           ENDDO       ! nat,na 
     392             :        ENDDO         ! n        
     393             :     ENDDO           ! js2,js1
     394             : 
     395           0 :     DO n= 1,atoms%ntype 
     396           0 :           DO band2= 1,dimension%neigd 
     397           0 :              DO bandf= 1,neigf 
     398           0 :                 matel(bandf,band2,0)= matel(bandf,band2,0) + matel(bandf,band2,n) 
     399             :              ENDDO
     400             :           ENDDO
     401             :     ENDDO
     402             : 
     403           0 :     IF (diag) THEN 
     404           0 :        DO n= 1,atoms%ntype
     405           0 :           DO band2= 1,dimension%neigd
     406           0 :              IF (neigf==dimension%neigd) THEN
     407           0 :                 bandf= band2 
     408             :              ELSE
     409           0 :                 bandf= 1 
     410             :              ENDIF
     411           0 :              IF (ABS(AIMAG(matel(bandf,band2,n)))>1.e-12) THEN
     412           0 :                 PRINT *,bandf,band2,n,AIMAG(matel(bandf,band2,n))
     413           0 :                 CALL judft_error('Stop in ssomatel:  diagonal matrix element not real')
     414             :              ENDIF
     415             :           ENDDO
     416             :        ENDDO
     417             :     ENDIF
     418             : 
     419           0 :     DEALLOCATE ( sa,sb,ra,rb )
     420             : 
     421           0 :   END SUBROUTINE ssomatel
     422             : END MODULE m_ssomat

Generated by: LCOV version 1.13