LCOV - code coverage report
Current view: top level - io - rw_symfile.f (source / functions) Hit Total Coverage
Test: combined.info Lines: 53 70 75.7 %
Date: 2019-09-08 04:53:50 Functions: 2 2 100.0 %

          Line data    Source code
       1             :       MODULE m_rwsymfile
       2             :       use m_juDFT
       3             : !----------------------------------------------------------------------!
       4             : !     writes spacegroup operations                                     ! 
       5             : !     and                                                              |  
       6             : !     rec. lattice vectors (for external k-point generator)            !
       7             : !----------------------------------------------------------------------!
       8             :       CONTAINS
       9          35 :       SUBROUTINE rw_symfile(
      10             :      >                      rw,symfh,symfn,nopd,bmat,
      11          35 :      X                      mrot,tau,nop,nop2,symor)
      12             : 
      13             :       IMPLICIT NONE
      14             : 
      15             : !===> Arguments
      16             :       CHARACTER(len=1), INTENT (IN)    :: rw
      17             :       CHARACTER(len=7), INTENT (IN)    :: symfn
      18             :       INTEGER,          INTENT (IN)    :: nopd,symfh
      19             :       REAL,             INTENT (IN)    :: bmat(3,3)
      20             :       INTEGER,          INTENT (INOUT) :: nop,nop2
      21             :       INTEGER,          INTENT (INOUT) :: mrot(3,3,nopd)
      22             :       REAL,             INTENT (INOUT) :: tau(3,nopd)
      23             :       LOGICAL,          INTENT (INOUT) :: symor
      24             : 
      25             : !===> Variables
      26          70 :       INTEGER i,j,n,ios,no2,no3,gen1,isrt(nop)
      27             :       REAL    t,d
      28             :       LOGICAL ex,op,l_exist
      29             :       CHARACTER(len=3) :: type
      30             :       CHARACTER(len=7) :: sym2fn
      31             : 
      32          35 :       sym2fn = 'sym.out'
      33             : 
      34          35 :       IF ( SCAN(rw,'wW') > 0 ) THEN
      35             : 
      36             : !===> write symfile
      37             : 
      38           1 :         OPEN (symfh, file=sym2fn, status='unknown', err=911, iostat=ios)
      39           1 :         WRITE (symfh,*) nop,nop2,symor,'    ! nop,nop2,symor '
      40             :         
      41           1 :         IF (nop == 2*nop2) THEN  ! film-calculation
      42           0 :           i = 1 ; j = nop2 + 1
      43           0 :           DO n = 1, nop
      44           0 :             IF (mrot(3,3,n) == 1) THEN
      45           0 :               isrt(n) = i ; i = i + 1
      46             :             ELSE
      47           0 :               isrt(n) = j ; j = j + 1
      48             :             ENDIF
      49             :           ENDDO
      50             :         ELSE
      51          49 :           DO n = 1, nop
      52           1 :             isrt(n) = n
      53             :           ENDDO
      54             :         ENDIF
      55             : 
      56          49 :         DO n = 1, nop
      57          48 :            WRITE (symfh,'(a1,i3)') '!', n
      58             :            WRITE (symfh,'(3i5,5x,f10.5)')
      59          49 :      &           ((mrot(i,j,isrt(n)),j=1,3),tau(i,isrt(n)),i=1,3)
      60             :         ENDDO
      61             : 
      62             : !        WRITE (symfh,*) '! reciprocal lattice vectors'
      63             : !        WRITE (symfh,'(3f25.15)') ((bmat(i,j),j=1,3),i=1,3)
      64             : 
      65          34 :       ELSEIF ( SCAN(rw,'rR') > 0 ) THEN
      66             : 
      67             : !===> read symfile
      68          34 :         INQUIRE(FILE=TRIM(ADJUSTL(symfn)),EXIST=l_exist)
      69          34 :         IF(.NOT.l_exist) THEN
      70             :            CALL juDFT_error("File "//TRIM(ADJUSTL(symfn))//
      71           0 :      +                      " is missing.",calledby="rw_symfile")
      72             :         END IF
      73          34 :         OPEN (symfh, file=trim(symfn),status='old',err=911,iostat=ios)
      74          34 :         READ (symfh,*) nop,nop2,symor
      75          34 :         IF (symfn.EQ.'sym.out') THEN
      76             :           gen1 = 0
      77           0 :         ELSEIF (trim(symfn).EQ.'sym') THEN
      78             :           gen1 = 1
      79             :         ELSE
      80             :            CALL juDFT_error("symfn should be sym or sym.out",calledby
      81           0 :      +          ="rw_symfile")
      82             :         ENDIF
      83         409 :         DO n = 1 + gen1, nop + gen1
      84         375 :           READ (symfh,*)
      85             :           READ (symfh,*) 
      86         409 :      &         ((mrot(i,j,n),j=1,3),tau(i,n),i=1,3)
      87             :         ENDDO
      88          34 :         IF (symor) THEN
      89         346 :           DO n=1,nop
      90         315 :             t= tau(1,n)**2 + tau(2,n)**2 + tau(3,n)**2
      91         315 :             IF (t > 1.e-8)  CALL juDFT_error("not symmorphic",calledby
      92          31 :      +           ="rw_symfile")
      93             :           ENDDO
      94             :         ELSE
      95          63 :           DO n=1,nop
      96         183 :             DO i = 1,3
      97         180 :              IF (ABS(tau(i,n)-0.33333) < 0.00001) THEN
      98           0 :                tau(i,n) = 1./3.
      99             :              ENDIF
     100         180 :              IF (ABS(tau(i,n)+0.33333) < 0.00001) THEN
     101           0 :                tau(i,n) = -1./3.
     102             :              ENDIF
     103         180 :              IF (ABS(tau(i,n)-0.66667) < 0.00001) THEN
     104           0 :                tau(i,n) = 2./3.
     105             :              ENDIF
     106         180 :              IF (ABS(tau(i,n)+0.66667) < 0.00001) THEN
     107           0 :                tau(i,n) = -2./3.
     108             :              ENDIF
     109          60 :              IF (ABS(tau(i,n)) > 0.00001) THEN
     110             :              ENDIF
     111             :             ENDDO
     112             :           ENDDO
     113             :         ENDIF
     114             : 
     115         409 :         DO n = 1,nop
     116             : !
     117             : ! Determine the kind of symmetry operation we have here
     118             : !
     119         375 :           d = det(mrot(:,:,n))
     120         375 :           t =  mrot(1,1,n) + mrot(2,2,n) + mrot(3,3,n)
     121             : 
     122         375 :           IF (d.EQ.-1) THEN
     123         187 :             type = 'm  '
     124         187 :             IF (t.EQ.-3) type = 'I  '
     125         188 :           ELSEIF (d.EQ.1) THEN
     126         188 :             IF (t.EQ.-1) type = 'c_2'
     127         188 :             IF (t.EQ. 0) type = 'c_3'
     128         188 :             IF (t.EQ. 1) type = 'c_4'
     129         188 :             IF (t.EQ. 2) type = 'c_6'
     130         188 :             IF (t.EQ. 3) type = 'E  '
     131             :           ELSE
     132             :              CALL juDFT_error("determinant =/= +/- 1",calledby
     133           0 :      +            ="rw_symfile")
     134             :           ENDIF
     135             :  
     136         375 :           WRITE (6,FMT=8020) n, type
     137             :  8020     FORMAT (/,1x,i3,' : ',a3)
     138        1534 :           DO i = 1,3
     139        1500 :              WRITE (6,FMT=8030) (mrot(i,j,n),j=1,3),tau(i,n)
     140             :           ENDDO
     141             :  8030     FORMAT (5x,3i3,3x,f4.1)
     142             :         ENDDO
     143             : 
     144             :       ELSE
     145           0 :          CALL juDFT_error("ERROR! rw_symfile #1",calledby="rw_symfile")
     146             :       ENDIF
     147          35 :       CLOSE (symfh)
     148             :       RETURN
     149             : 
     150             : ! === errors
     151             :  911  CONTINUE
     152           0 :       WRITE(*,*) 'Error in inquire. IOS=',ios
     153             :  912  CONTINUE
     154           0 :       WRITE(*,*) 'Error in open. IOS=',ios
     155           0 :        CALL juDFT_error("i/o ERROR",calledby="rw_symfile")
     156             : 
     157             :       END SUBROUTINE rw_symfile
     158             : 
     159             : !--------------------------------------------------------------------
     160         375 :       INTEGER FUNCTION det(m)
     161             :         INTEGER m(3,3)
     162             :         det = m(1,1)*m(2,2)*m(3,3) + m(1,2)*m(2,3)*m(3,1) +
     163             :      +        m(2,1)*m(3,2)*m(1,3) - m(1,3)*m(2,2)*m(3,1) -
     164         375 :      +        m(2,3)*m(3,2)*m(1,1) - m(2,1)*m(1,2)*m(3,3)
     165         375 :       END FUNCTION det
     166             : !--------------------------------------------------------------------
     167             : 
     168             : 
     169             :       END MODULE m_rwsymfile

Generated by: LCOV version 1.13