LCOV - code coverage report
Current view: top level - inpgen - soc_or_ssdw.f (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 72 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 1 0.0 %

          Line data    Source code
       1             :       MODULE m_socorssdw
       2             :       use m_juDFT
       3             :       CONTAINS
       4           0 :       SUBROUTINE soc_or_ssdw(
       5             :      >                       l_soc,l_ss,theta,phi,qss,amat,
       6           0 :      >                       mrot,tau,nop,nop2,nat,atomid,atompos,
       7           0 :      <                       mmrot,ttr,no3,no2,ntype,neq,natmap,
       8             :      <                       ntyrep,natype,natrep,zatom,pos)
       9             : 
      10             :       USE m_sssym
      11             :       USE m_socsym
      12             :       IMPLICIT NONE
      13             : 
      14             :       LOGICAL, INTENT (IN) :: l_soc,l_ss
      15             :       INTEGER, INTENT (IN) :: nop,nop2,nat
      16             :       REAL,    INTENT (IN) :: theta,phi
      17             :       INTEGER, INTENT (OUT):: no3,no2,ntype
      18             : 
      19             :       INTEGER, INTENT (IN) :: mrot(3,3,nop)
      20             :       REAL,    INTENT (IN) :: tau(3,nop),qss(3),amat(3,3)
      21             :       REAL,    INTENT (IN) :: atomid(nat),atompos(3,nat)
      22             :       INTEGER, INTENT (OUT):: mmrot(3,3,nop)
      23             :       REAL,    INTENT (OUT):: ttr(3,nop)
      24             : !--> actually, intent out:
      25             :       INTEGER, ALLOCATABLE :: neq(:), ntyrep(:)              ! these variables are allocated with
      26             :       REAL,    ALLOCATABLE :: zatom(:)                       ! dim 'ntype'
      27             :       INTEGER, ALLOCATABLE :: natype(:),natrep(:),natmap(:)  ! or  'nat'
      28             :       REAL,    ALLOCATABLE :: pos(:,:)                       ! or  '3,nat'
      29             : 
      30           0 :       INTEGER n,nt,i,j,nops,ntypm,ity(nat)
      31             :       REAL    tr(3),eps7
      32             :       LOGICAL lnew
      33           0 :       LOGICAL, ALLOCATABLE :: error(:)
      34             : 
      35           0 :       eps7 = 1.0e-7 
      36             : 
      37           0 :       ALLOCATE ( error(nop) )
      38           0 :       error(:) = .false.
      39           0 :       IF (l_ss) THEN                     ! reduce symmetry if SSDW calculation
      40             :         CALL ss_sym(
      41             :      >              nop,mrot,qss,
      42           0 :      <              error)
      43             :       ENDIF
      44           0 :       IF (l_soc) THEN                    ! reduce symmetry if SOC calculation
      45             :         CALL soc_sym(
      46             :      >               nop,mrot,theta,phi,amat,
      47           0 :      <               error)
      48             :       ENDIF
      49           0 :       IF (l_ss.AND.l_soc)  CALL juDFT_error("no spin-spirals with SOC!"
      50           0 :      +     ,calledby ="soc_or_ssdw")
      51           0 :       no2 = 0                      ! No. of 2D sym.op's allowed by SOC or SS
      52           0 :       DO n = 1, nop2
      53           0 :         IF ( .not.error(n) ) THEN
      54           0 :            no2 = no2 + 1
      55           0 :            mmrot(:,:,no2) = mrot(:,:,n)
      56           0 :            ttr(:,no2) = tau(:,n)
      57             :         ENDIF
      58             :       ENDDO
      59           0 :       no3 = no2                    ! same for 3D sym.op's
      60           0 :       DO n = nop2+1,nop
      61           0 :         IF ( .not.error(n) ) THEN
      62           0 :            no3 = no3 + 1
      63           0 :            mmrot(:,:,no3) = mrot(:,:,n)
      64           0 :            ttr(:,no3) = tau(:,n)
      65             :         ENDIF
      66             :       ENDDO
      67           0 :       DEALLOCATE (error)
      68             : 
      69             : !---> determine the number of distinct atoms based on atomic number,
      70             : !---> etc. (not necessarily symmetry inequivalent)
      71             : 
      72           0 :       ntypm = 1
      73           0 :       ity(1) = 1
      74           0 :       DO n=2, nat
      75             :          lnew = .true.
      76           0 :          DO i=1,n-1
      77           0 :             IF ( abs( atomid(i)-atomid(n) ) < eps7 ) THEN
      78           0 :                ity(n) = ity(i)
      79           0 :                lnew = .false.
      80             :                EXIT
      81             :             ENDIF
      82             :          ENDDO
      83           0 :          IF (lnew) then
      84           0 :             ntypm = ntypm + 1
      85           0 :             ity(n) = ntypm
      86             :          ENDIF
      87             :       ENDDO
      88             : 
      89             : ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      90             : !--->  at this point, the symmetry is correct (assumed here)
      91             : 
      92           0 :       nops = no3
      93           0 :       natype(1:nat) = 0
      94           0 :       ntype = 0
      95           0 :       DO i =1,nat
      96           0 :          IF ( natype(i) .ne. 0 ) cycle
      97           0 :          ntype = ntype + 1   ! new atom type
      98           0 :          natype(i) = ntype   ! atom type
      99           0 :          natrep(i) = i       ! this is the representative
     100             : !--->    rotate representative and get symmetry equavalent atoms
     101           0 :          DO n=1,nops
     102           0 :             tr(:) = matmul( mmrot(:,:,n) , pos(:,i) ) + ttr(:,n)
     103           0 :             tr(:) = tr(:) - anint( tr(:) -eps7 )
     104             : !--->       this (rotated) atom done already? (correct symmetry assumed)
     105           0 :             DO j=i+1,nat
     106           0 :                IF ( natype(j) .ne. 0 ) CYCLE
     107           0 :                IF ( ity(j) .ne. ity(i) ) CYCLE
     108           0 :                IF ( any( abs( tr(:) - pos(:,j) ) > eps7 ) ) CYCLE
     109           0 :                natrep(j) = i      ! representative atom
     110           0 :                natype(j) = ntype  ! atom type
     111           0 :                EXIT
     112             :             ENDDO
     113             :          ENDDO
     114             :       ENDDO
     115             : 
     116             : !      if( ntypd < ntype )then
     117             : !        ntypd = ntype
     118             : !      endif
     119           0 :       IF (ALLOCATED(neq)) DEALLOCATE(neq)
     120           0 :       IF (ALLOCATED(ntyrep)) DEALLOCATE(ntyrep)
     121           0 :       IF (ALLOCATED(zatom)) DEALLOCATE(zatom)
     122           0 :       ALLOCATE( neq(ntype),ntyrep(ntype),zatom(ntype) )
     123             : 
     124           0 :       neq(1:ntype) = 0
     125           0 :       ntyrep(1:ntype) = 0
     126           0 :       DO n=1,nat
     127           0 :          neq( natype(n) ) = neq( natype(n) ) + 1
     128           0 :          zatom( natype(n) ) = NINT(atomid(n))
     129           0 :          IF ( ntyrep( natype(n) ) == 0 ) ntyrep( natype(n) ) = n
     130             :       ENDDO
     131             : 
     132           0 :       natmap(1:nat) = 0
     133             :       j = 0
     134           0 :       DO nt = 1,ntype
     135           0 :          DO n=1,nat
     136           0 :             IF ( natype(n) == nt ) THEN
     137           0 :                j = j+ 1
     138           0 :                natmap(j) = n
     139             :             ENDIF
     140             :          ENDDO
     141             :       ENDDO
     142             : 
     143             : 
     144           0 :       END SUBROUTINE soc_or_ssdw
     145             :       END MODULE m_socorssdw

Generated by: LCOV version 1.13