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

          Line data    Source code
       1             :       MODULE m_nshell
       2             :       use m_juDFT
       3             : c-------------------------------------------------------------------
       4             : c     Constructs the neighbouring shells up to the given number nsh
       5             : c                                                 M. Lezaic '04
       6             : c-------------------------------------------------------------------
       7             :       CONTAINS
       8           0 :       SUBROUTINE nshell(
       9             :      >                  amat,t,nsh,dims,nmax,shmax,film,zcoord,
      10           0 :      <                  nat,R,lenR,nop,mrot,deltaz)
      11             :       IMPLICIT NONE
      12             : c     ..
      13             : c     .. Scalar Arguments ..
      14             :       INTEGER, INTENT (IN)  :: nsh,dims,nmax,shmax,nop
      15             :       LOGICAL, INTENT (IN)  :: film
      16             :       REAL,    INTENT (IN)   :: zcoord,deltaz
      17             : c     ..
      18             : c     .. Array Arguments ..
      19             :       REAL,    INTENT (IN)   :: amat(3,3),t(3)
      20             :       INTEGER, INTENT (IN)   :: mrot(3,3,nop)
      21             :       INTEGER, INTENT (OUT)  :: nat(dims)
      22             :       REAL,    INTENT (OUT)  :: R(3,shmax,dims),lenR(dims)
      23             : 
      24             : c     
      25             : c     .. Local Scalars ..
      26             :       INTEGER n,i,c,n1,n2,n3,fill,fill1,xmax,ymax,zmax
      27             :       REAL lentn,t3
      28             :       REAL, PARAMETER:: tol=0.0000001
      29             : c
      30             : c     .. Local Arrays
      31           0 :       REAL tnC(3),tn(3),Raux(3,nop),Raux1(3,shmax),Rrot(3)
      32             : c    
      33             : c     .. Intrinsic Functions ..
      34             :       INTRINSIC SQRT,ABS,REAL,MIN
      35             : c------------------------------------------------------------------
      36           0 :       c=0
      37           0 :       nat(:)=0
      38           0 :       R(:,:,:)=0.
      39           0 :       lenR(:)=0.
      40             : 
      41           0 :       IF (film) THEN  !Added for Film-Jij calculations 10/23/06 B. Hardrat
      42           0 :         zmax = 0
      43           0 :         t3 = deltaz    !Added for films with more than one monolayer 07/10  S.Schroeder
      44             :       ELSE             !format of coordinates in file shells in case of film:
      45           0 :        zmax=nmax       !x (relative coord.),y (relative coord.), z (a.u.)
      46           0 :        t3 = t(3)
      47             :       END IF
      48             : 
      49           0 :       xmax=nmax
      50           0 :       ymax=nmax
      51             : 
      52           0 :       fst: DO n3=-zmax,zmax
      53           0 :         snd: DO n2=-ymax,ymax
      54           0 :           trd: DO n1=-xmax,xmax
      55           0 :             tn(1)=t(1)-REAL(n1)
      56           0 :             tn(2)=t(2)-REAL(n2)
      57           0 :             tn(3)=t3  -REAL(n3)
      58             :             IF ( (ABS(tn(1)).LT.tol).AND.
      59           0 :      &           (ABS(tn(2)).LT.tol).AND.
      60             :      &           (ABS(tn(3)).LT.tol) ) CYCLE trd
      61             : 
      62           0 :             tnC(:)=tn(1)*amat(:,1)+tn(2)*amat(:,2)+tn(3)*amat(:,3)
      63           0 :             lentn = SQRT( tnC(1)**2+tnC(2)**2+tnC(3)**2 )
      64           0 :             DO i = 1, c
      65           0 :               IF (ABS(lentn-lenR(i)).LT.tol) THEN
      66           0 :                 DO n = 1, nat(i)
      67             :                   IF( (ABS(tn(1)-R(1,n,i)).LT.tol).AND.
      68           0 :      &                (ABS(tn(2)-R(2,n,i)).LT.tol).AND.
      69           0 :      &                (ABS(tn(3)-R(3,n,i)).LT.tol) ) CYCLE trd
      70             :                 ENDDO
      71           0 :                 nat(i) = nat(i) + 1
      72           0 :                 R(:,nat(i),i) = tn(:)
      73           0 :                   IF (film) THEN
      74           0 :                    R(3,nat(i),i) = zcoord
      75             :                   ENDIF
      76             :                 CYCLE trd
      77             :               ENDIF
      78             :             ENDDO
      79           0 :             c=c+1
      80           0 :             DO i = 1, c-1
      81           0 :               IF (ABS(min(lentn,lenR(i))-lentn).LT.tol) THEN
      82           0 :                 DO n=1,c-i
      83           0 :                   nat(c-n+1) = nat(c-n)
      84           0 :                   lenR(c-n+1) = lenR(c-n)
      85           0 :                   R(:,:,c-n+1) =R (:,:,c-n)
      86             :                 ENDDO
      87           0 :                 nat(i) = 1
      88           0 :                 lenR(i) = lentn
      89           0 :                 R(:,1,i) = tn(:)
      90           0 :                   IF (film) THEN
      91           0 :                      R(3,1,i) = zcoord
      92             :                   ENDIF
      93             : 
      94             :                 CYCLE trd
      95             :               ENDIF
      96             :             ENDDO
      97           0 :             nat(c) = 1
      98           0 :             lenR(c) = lentn
      99           0 :             R(:,1,c) = tn(:)
     100           0 :               IF (film) THEN
     101           0 :                 R(3,1,c) = zcoord
     102             :               ENDIF
     103             : 
     104             :           ENDDO trd
     105             :         ENDDO snd
     106             :       ENDDO fst
     107             : 
     108             : 
     109             : c-----------------------------------------------------
     110             : c ..
     111             : c .. Checking for inequivalent shells with the same lenR(i)
     112             : c ..
     113           0 :       dimsl: DO i = 1, dims
     114           0 :         IF (i.GT.c) EXIT dimsl
     115           0 :         Raux(:,1) = R(:,1,i)
     116             :         fill = 1
     117             : 
     118           0 :         nopl: DO n = 1, nop 
     119             :           Rrot(1)=Raux(1,1)*mrot(1,1,n) + Raux(2,1)*mrot(1,2,n) +
     120           0 :      +            Raux(3,1)*mrot(1,3,n)
     121             :           Rrot(2)=Raux(1,1)*mrot(2,1,n) + Raux(2,1)*mrot(2,2,n) +
     122           0 :      +            Raux(3,1)*mrot(2,3,n)
     123             :           Rrot(3)=Raux(1,1)*mrot(3,1,n) + Raux(2,1)*mrot(3,2,n) +
     124           0 :      +            Raux(3,1)*mrot(3,3,n)
     125             :          
     126           0 :           DO n1 = 1, fill
     127             :             IF((ABS(Rrot(1)-Raux(1,n1)).LT.tol).AND.
     128           0 :      &         (ABS(Rrot(2)-Raux(2,n1)).LT.tol).AND.
     129           0 :      &         (ABS(Rrot(3)-Raux(3,n1)).LT.tol)) CYCLE nopl
     130             :           ENDDO
     131             : 
     132           0 :           fill=fill+1              
     133           0 :           Raux(:,fill)=Rrot(:)
     134             :         
     135             :         ENDDO nopl
     136             : 
     137           0 :         IF (fill.LT.nat(i)) THEN
     138             :           fill1=0
     139           0 :           eqat: DO n = 1, nat(i)
     140           0 :             DO n1 = 1, fill
     141             :               IF(((ABS(R(1,n,i)-Raux(1,n1)).LT.tol).AND.
     142             :      &            (ABS(R(2,n,i)-Raux(2,n1)).LT.tol).AND.
     143           0 :      &            (ABS(R(3,n,i)-Raux(3,n1)).LT.tol)).OR.
     144             :      &           ((ABS(R(1,n,i)+Raux(1,n1)).LT.tol).AND.
     145             :      &            (ABS(R(2,n,i)+Raux(2,n1)).LT.tol).AND.
     146           0 :      &            (ABS(R(3,n,i)+Raux(3,n1)).LT.tol))) CYCLE eqat
     147             :             ENDDO
     148             : 
     149           0 :             fill1=fill1+1
     150           0 :             Raux1(:,fill1)=R(:,n,i)
     151             :           
     152             :           ENDDO eqat
     153             : 
     154           0 :           IF(fill1.GT.0) THEN
     155           0 :             c=c+1
     156           0 :             IF (c.GT.dims)  CALL juDFT_error("nshell:1")
     157           0 :             DO n = 1, c-i-1
     158           0 :               nat(c-n+1) = nat(c-n)
     159           0 :               lenR(c-n+1) = lenR(c-n)
     160           0 :               R(:,:,c-n+1) = R(:,:,c-n)
     161             :             ENDDO
     162             : 
     163           0 :             DO n = 1, fill1
     164           0 :               R(:,n,i+1) = Raux1(:,n)
     165             :             ENDDO
     166           0 :             lenR(i+1) = lenR(i)
     167           0 :             nat(i+1) = fill1
     168             : 
     169           0 :             DO n = 1, fill
     170           0 :               R(:,n,i) = Raux(:,n)
     171             :             ENDDO
     172           0 :             nat(i)=fill
     173             :           ENDIF
     174             :         ENDIF    ! fill < nat(i)
     175             :       ENDDO dimsl
     176             : c --------------------------------------------------
     177           0 :       DO i=1,c
     178           0 :         WRITE(117,5005) i,lenR(i),nat(i)
     179           0 :         DO n=1,nat(i)
     180           0 :           WRITE(117,5519) R(1,n,i),R(2,n,i),R(3,n,i)
     181             :         ENDDO
     182           0 :         WRITE(117,*) 
     183             :       ENDDO 
     184             :  5005 FORMAT(i4,1x,f14.10,1x,i4)
     185             :  5519 FORMAT(3(1x,f14.10))
     186             : 
     187           0 :       IF (nsh>c) THEN
     188             :          CALL juDFT_error("nsh greater than dimensioned",calledby
     189           0 :      +        ="nshell",hint ='increase nmax in jcoff2')
     190             :       ENDIF
     191             : 
     192           0 :       END SUBROUTINE nshell
     193             :       END MODULE m_nshell

Generated by: LCOV version 1.13