LCOV - code coverage report
Current view: top level - dos - grp_k.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 477 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 4 0.0 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : 
       7             : MODULE m_grp_k
       8             :   USE m_juDFT
       9             : 
      10             :   IMPLICIT NONE
      11             : 
      12             :   PRIVATE
      13             :   PUBLIC :: grp_k, euler
      14             : 
      15             : CONTAINS 
      16             : 
      17           0 :   SUBROUTINE grp_k(sym,mrot_k,cell,bk,nclass,nirr,char_table,&
      18           0 :        &    grpname,irrname,su,sp_alph,sp_beta)
      19             : 
      20             :     !************************************************************
      21             :     !
      22             :     !   Determines the group of k, returns the number of classes, the name of the
      23             :     !   group, the irreducible representations and the character table.
      24             :     !   All the groups are not implemented yet, and the identification is not tested for 
      25             :     !   the groups. 
      26             :     !
      27             :     !  The subroutine works also with double groups, however, no double groups are 
      28             :     !  tabulated at the moment.
      29             :     !
      30             :     ! 
      31             :     !   Character tables are taken from 
      32             :     !   T. Inui, Y Tanabe, and Y. Onodera, "Group theory and its applications in physics",
      33             :     !   Springer (1996)
      34             :     !
      35             :     !   Jussi Enkovaara, Juelich 2004
      36             :     !**************************************************************
      37             : 
      38             :     !      USE m_mrot2su
      39             :     USE m_inv3
      40             :     USE m_constants, ONLY : pi_const
      41             :     USE m_socsym,    ONLY : soc_sym, cross
      42             :     USE m_types
      43             :     IMPLICIT NONE
      44             : 
      45             :     TYPE(t_sym),INTENT(IN)   :: sym
      46             :     TYPE(t_cell),INTENT(IN)   :: cell
      47             :    
      48             : 
      49             :     REAL,INTENT(IN)      :: bk(3)
      50             :     COMPLEX, INTENT(OUT) :: char_table(:,:)
      51             :     INTEGER, INTENT(OUT) :: mrot_k(:,:,:),nclass,nirr
      52             :     CHARACTER(LEN=7),  INTENT(OUT) :: grpname
      53             :     CHARACTER(LEN=5),  INTENT(OUT) :: irrname(:)
      54             :     COMPLEX, OPTIONAL, INTENT(OUT) :: su(:,:,:)
      55             :     REAL,    OPTIONAL, INTENT(IN)  :: sp_alph,sp_beta ! spin quant. axis
      56             : 
      57             :     ! locals
      58             :     INTEGER ::  nopk,c
      59           0 :     LOGICAL, ALLOCATABLE :: error(:)
      60             :     INTEGER :: mrot2(3,3,48)
      61             :     REAL    :: ktest(3),rtmp,rtmp2(4),kt(3)
      62             :     INTEGER :: mtest(3,3),mtmp(3,3),mtmpinv(3,3),munit(3,3)
      63             :     INTEGER :: n,n2 ,i,itmp
      64             :     INTEGER :: elem(48),belongs(48),members(48)
      65             :     LOGICAL :: soc,l_sorted
      66             :     ! COMPLEX :: sutmp(2,2), sutmpinv(2,2), su2(2,2,48)
      67             :     COMPLEX :: sutest(2,2)
      68             :     INTEGER :: d,det(48),rot(12),rot_type(48)
      69             :     REAL :: alpha,beta,gamma,theta(48),rax(4,48)
      70             :     REAL,PARAMETER :: eps=0.000001
      71             :     COMPLEX :: omega
      72             :     COMPLEX,PARAMETER :: one=CMPLX(1.0,0.0),zero=CMPLX(0.0,0.0)
      73             :     COMPLEX,PARAMETER :: imi=CMPLX(0.0,1.0)
      74             : 
      75             : 
      76           0 :     soc=.FALSE.
      77           0 :     IF (PRESENT(su)) soc=.TRUE.
      78             :     !sym%nop=SIZE(sym%mrot,3)
      79             : 
      80           0 :     ALLOCATE(error(sym%nop))
      81           0 :     error=.FALSE.
      82             :     ! Reduce the symmetry due to spin-orbit
      83           0 :     IF (soc.AND.PRESENT(sp_alph)) THEN
      84             :        CALL soc_sym(&
      85             :             &        sym%nop,sym%mrot,sp_beta,sp_alph,cell%amat,&
      86           0 :             &        error)!keep
      87             :     ENDIF
      88             : 
      89             :     ! determine the group of k
      90             :     nopk=0
      91           0 :     ksymloop: DO n=1,sym%nop
      92             :        ktest(1)=bk(1)-sym%mrot(1,1,n)*bk(1)-sym%mrot(2,1,n)*bk(2)&
      93           0 :             &        -sym%mrot(3,1,n)*bk(3)
      94             :        ktest(2)=bk(2)-sym%mrot(1,2,n)*bk(1)-sym%mrot(2,2,n)*bk(2)&
      95           0 :             &        -sym%mrot(3,2,n)*bk(3)
      96             :        ktest(3)=bk(3)-sym%mrot(1,3,n)*bk(1)-sym%mrot(2,3,n)*bk(2)&
      97           0 :             &        -sym%mrot(3,3,n)*bk(3)
      98             :        IF (( ABS( ktest(1) - NINT(ktest(1)) ) < eps ) .AND.&
      99             :             &         ( ABS( ktest(2) - NINT(ktest(2)) ) < eps ) .AND.&
     100           0 :             &         ( ABS( ktest(3) - NINT(ktest(3)) ) < eps ) .AND.&
     101           0 :             &         (.NOT.error(n)) ) THEN
     102           0 :           nopk=nopk+1
     103           0 :           mrot_k(:,:,nopk)=sym%mrot(:,:,n)
     104             :           CYCLE ksymloop
     105             :        ENDIF
     106             :     ENDDO ksymloop
     107             : 
     108           0 :     DEALLOCATE(error)
     109             : 
     110             :     ! Determine the spin-rotations
     111             :     ! Double groups not used at the moment, the groups are classified 
     112             :     ! without the spin rotations
     113             :     !       IF (soc) CALL mrot2su(mrot_k(:,:,1:nopk),amat,su)
     114             : 
     115             :     ! identify the group
     116             :     ! first determine the classes
     117           0 :     members=1
     118           0 :     nclass=1
     119           0 :     elem(nclass)=1
     120           0 :     belongs(1)=1
     121             :     !       IF (soc) THEN 
     122             :     ! double group
     123             :     !         DO n=1,nopk        
     124             :     !            mrot_k(:,:,n+nopk)=mrot_k(:,:,n)
     125             :     !            su(:,:,n+nopk)=-su(:,:,n)
     126             :     !         ENDDO
     127             :     !         nopk=2*nopk
     128             :     !       ENDIF
     129             : 
     130           0 :     cloop: DO n=2,nopk
     131           0 :        DO n2=1,nopk
     132           0 :           mtmp=mrot_k(:,:,n2)
     133           0 :           CALL inv3(mrot_k(:,:,n2),mtmpinv,d)
     134           0 :           mtest=MATMUL(MATMUL(mtmp,mrot_k(:,:,n)),mtmpinv)
     135             :           !            IF (soc) THEN
     136             :           !               sutmp=su(:,:,n2)
     137             :           !               sutmpinv=CONJG(TRANSPOSE(sutmp))
     138             :           !               sutest=MATMUL(MATMUL(sutmp,su(:,:,n)),sutmpinv)
     139             :           !            ENDIF
     140           0 :           DO c=1,nclass
     141             :              !               IF (soc) THEN
     142             :              !                  IF (ALL((mtest-mrot_k(:,:,elem(c))).EQ.0).AND.
     143             :              !c     &   ALL(ABS(REAL(sutest-su(:,:,elem(c)))).LE.0.0001).AND.
     144             :              !     &   ALL(ABS(AIMAG(sutest-su(:,:,elem(c)))).LE.0.0001)) THEN
     145             :              !                     belongs(n)=c
     146             :              !                     CYCLE classloop
     147             :              !                  ENDIF
     148             :              !               ELSE
     149           0 :              IF (ALL((mtest-mrot_k(:,:,elem(c))).EQ.0)) THEN 
     150           0 :                 belongs(n)=c
     151           0 :                 members(c)=members(c)+1
     152           0 :                 CYCLE cloop
     153             :              ENDIF
     154             :              !               ENDIF
     155             :           ENDDO
     156             :        ENDDO
     157           0 :        nclass=nclass+1
     158           0 :        elem(nclass)=n
     159           0 :        belongs(n)=nclass
     160             :     ENDDO cloop
     161           0 :     nirr=nclass
     162           0 :     IF (soc) nirr=2*nclass
     163             : 
     164             :     ! sort the classes according the rotation type
     165           0 :     mrot2(:,:,1:nopk)=mrot_k(:,:,1:nopk)
     166           0 :     DO c=1,nclass
     167           0 :        mrot_k(:,:,c)=mrot2(:,:,elem(c))
     168             :     ENDDO
     169             :     !        IF (soc) THEN
     170             :     !           su2(:,:,1:nopk)=su(:,:,1:nopk)
     171             :     !           DO c=1,nclass
     172             :     !              su(:,:,c)=su2(:,:,elem(c))
     173             :     !           ENDDO
     174             :     !        ENDIF
     175             : 
     176             : 
     177             : 
     178             :     ! identify the group
     179           0 :     rot=0
     180           0 :     rot_type=0
     181             :     ! rot_type: 2=two fold rot, 3=three fold rot, etc, 7=identity
     182             :     !           8=two fold improper rot, ...
     183           0 :     munit=0
     184           0 :     munit(1,1)=1
     185           0 :     munit(2,2)=1
     186           0 :     munit(3,3)=1
     187             :     ! determine the number of different rotations
     188           0 :     DO c=1,nclass
     189             :        det(c)=&
     190             :             &      mrot_k(1,1,c)*mrot_k(2,2,c)*mrot_k(3,3,c)+&
     191             :             &      mrot_k(1,2,c)*mrot_k(2,3,c)*mrot_k(3,1,c)+&
     192             :             &      mrot_k(2,1,c)*mrot_k(3,2,c)*mrot_k(1,3,c)-&
     193             :             &      mrot_k(1,3,c)*mrot_k(2,2,c)*mrot_k(3,1,c)-&
     194             :             &      mrot_k(2,3,c)*mrot_k(3,2,c)*mrot_k(1,1,c)-&
     195           0 :             &      mrot_k(2,1,c)*mrot_k(1,2,c)*mrot_k(3,3,c)
     196           0 :        mtest=det(c)*mrot_k(:,:,c)
     197           0 :        rotloop: DO i=1,6
     198           0 :           IF (ALL((mtest-munit).EQ.0)) THEN
     199           0 :              rot(i+(1-det(c))*3)=rot(i+(1-det(c))*3)+1
     200           0 :              IF (i.EQ.1) THEN
     201           0 :                 rot_type(c)=7-(1-det(c))*3
     202             :              ELSE
     203           0 :                 rot_type(c)=i-(1-det(c))*3
     204             :              ENDIF
     205             :              EXIT rotloop
     206             :           ENDIF
     207           0 :           mtest=MATMUL(det(c)*mrot_k(:,:,c),mtest)
     208             :        ENDDO rotloop
     209           0 :        IF (ANY((mtest-munit).NE.0)) THEN
     210           0 :           WRITE(6,*) 'grp_k: Cannot find the order of rotation'
     211             :        ENDIF
     212           0 :        IF ((rot(5).GT.0).OR.(rot(11).GT.0)) THEN
     213           0 :           WRITE(6,*) 'grp_k: 5 fold rotation found!'
     214             :        ENDIF
     215           0 :        CALL euler(c,sym,cell,alpha,beta,gamma)
     216           0 :        CALL rotaxis(alpha,beta,gamma,rax(1:4,c),theta(c))
     217           0 :        IF (soc) THEN
     218           0 :           su(1,1,c)=COS(beta/2.0)*EXP(CMPLX(0.0,-(alpha+gamma)/2.0))
     219           0 :           su(1,2,c)=-SIN(beta/2.0)*EXP(CMPLX(0.0,-(alpha-gamma)/2.0))
     220           0 :           su(2,1,c)=SIN(beta/2.0)*EXP(CMPLX(0.0,(alpha-gamma)/2.0))
     221           0 :           su(2,2,c)=COS(beta/2.0)*EXP(CMPLX(0.0,(alpha+gamma)/2.0))
     222             :        ENDIF
     223             :     ENDDO
     224             : 
     225             :     !<-- Sort the classes
     226             :     ! The group elements are sorted in the following way:
     227             :     ! First the proper rotations, then improper ones, with increasing rotation angle
     228             :     ! Rotations with the same angle are arranged with increasing magnitude of the rotation
     229             :     ! axis, e.g. (I, 90 deg around 001, 90 around 110, mirror, ...
     230             : 
     231             :     l_sorted=.FALSE.
     232           0 :     DO WHILE (.NOT.l_sorted)
     233           0 :        l_sorted=.TRUE.
     234           0 :        DO c=1,nclass-1
     235           0 :           IF (rot_type(c).LT.rot_type(c+1)) THEN
     236           0 :              mtest=mrot_k(:,:,c)
     237           0 :              mrot_k(:,:,c)=mrot_k(:,:,c+1)
     238           0 :              mrot_k(:,:,c+1)=mtest
     239           0 :              rtmp=theta(c)
     240           0 :              theta(c)=theta(c+1)
     241           0 :              theta(c+1)=rtmp
     242           0 :              rtmp2=rax(:,c)
     243           0 :              rax(:,c)=rax(:,c+1)
     244           0 :              rax(:,c+1)=rtmp2
     245           0 :              itmp=det(c)
     246           0 :              det(c)=det(c+1)
     247           0 :              det(c+1)=itmp
     248           0 :              itmp=rot_type(c)
     249           0 :              rot_type(c)=rot_type(c+1)
     250           0 :              rot_type(c+1)=itmp
     251           0 :              itmp=members(c)
     252           0 :              members(c)=members(c+1)
     253           0 :              members(c+1)=itmp
     254           0 :              IF (soc) THEN
     255           0 :                 sutest=su(:,:,c)
     256           0 :                 su(:,:,c)=su(:,:,c+1)
     257           0 :                 su(:,:,c+1)=sutest
     258             :              ENDIF
     259             :              l_sorted=.FALSE.
     260             :           ENDIF
     261           0 :           IF ((rot_type(c).EQ.rot_type(c+1)).AND.&
     262             :                &            (theta(c).GT.theta(c+1))) THEN
     263             :              !              IF (theta(c)+(1-det(c))*2.0*pi.GT.
     264             :              !     &             theta(c+1)+(1-det(c+1))*2.0*pi) THEN
     265           0 :              mtest=mrot_k(:,:,c)
     266           0 :              mrot_k(:,:,c)=mrot_k(:,:,c+1)
     267           0 :              mrot_k(:,:,c+1)=mtest
     268           0 :              rtmp=theta(c)
     269           0 :              theta(c)=theta(c+1)
     270           0 :              theta(c+1)=rtmp
     271           0 :              rtmp2=rax(:,c)
     272           0 :              rax(:,c)=rax(:,c+1)
     273           0 :              rax(:,c+1)=rtmp2
     274           0 :              itmp=det(c)
     275           0 :              det(c)=det(c+1)
     276           0 :              det(c+1)=itmp
     277           0 :              itmp=members(c)
     278           0 :              members(c)=members(c+1)
     279           0 :              members(c+1)=itmp
     280           0 :              IF (soc) THEN
     281           0 :                 sutest=su(:,:,c)
     282           0 :                 su(:,:,c)=su(:,:,c+1)
     283           0 :                 su(:,:,c+1)=sutest
     284             :              ENDIF
     285             :              l_sorted=.FALSE.
     286             :           ENDIF
     287             :           IF ((rot_type(c).EQ.rot_type(c+1)).AND.&
     288           0 :                &            (ABS(theta(c)-theta(c+1)).LT.0.0001).AND.    &
     289           0 :                &            (rax(4,c).GT.rax(4,c+1))) THEN
     290             :              !              IF ((ABS(theta(c)+(1-det(c))*2.0*pi-
     291             :              !     &           theta(c+1)-(1-det(c+1))*2.0*pi).LT.0.0001).AND.
     292             :              !     &           (rax(4,c).GT.rax(4,c+1))) THEN
     293           0 :              mtest=mrot_k(:,:,c)
     294           0 :              mrot_k(:,:,c)=mrot_k(:,:,c+1)
     295           0 :              mrot_k(:,:,c+1)=mtest
     296           0 :              rtmp2=rax(:,c)
     297           0 :              rax(:,c)=rax(:,c+1)
     298           0 :              rax(:,c+1)=rtmp2
     299           0 :              itmp=members(c)
     300           0 :              members(c)=members(c+1)
     301           0 :              members(c+1)=itmp
     302           0 :              IF (soc) THEN
     303           0 :                 sutest=su(:,:,c)
     304           0 :                 su(:,:,c)=su(:,:,c+1)
     305           0 :                 su(:,:,c+1)=sutest
     306             :              ENDIF
     307             :              l_sorted=.FALSE.
     308             :           ENDIF
     309             :        ENDDO
     310             :     ENDDO
     311             :     !>
     312             : 
     313             : 
     314           0 :     WRITE(24,110) bk
     315           0 :     DO c=1,nclass
     316           0 :        IF (det(c).EQ.1) THEN
     317           0 :           WRITE(24,111) NINT(theta(c)*180/pi_const),(rax(1:3,c)),members(c)
     318             :        ELSE
     319           0 :           WRITE(24,112) NINT(theta(c)*180/pi_const),(rax(1:3,c)),members(c)
     320             :        ENDIF
     321             :     ENDDO
     322             : 110 FORMAT('Symmetry operations of group of k=',3f6.3)
     323             : 111 FORMAT(i3,1x,'degree proper rotation around ',3f6.2,3x,&
     324             :          &      i3,' members in class')
     325             : 112 FORMAT(i3,1x,'degree improper rotation around ',3f6.2,3x,i3&
     326             :          &       ,' members in class')
     327             : 
     328             : 
     329             :     !<-- Character tables
     330             : 
     331           0 :     char_table=0.0
     332           0 :     char_table(1,:)=1.0
     333           0 :     grpname='Unknown'
     334           0 :     irrname='Unkno'   ! Only 5 characters wide, cf. ../sympsi.F.
     335             :     ! First look the number of classes, within groups with the same number of classes
     336             :     ! check the number of different rotations
     337           0 :     SELECT CASE(nclass)
     338             :     CASE(1)                           ! only C1
     339           0 :        grpname='C1'
     340           0 :        char_table(1,1)=1.0
     341           0 :        irrname(1)='Gam1'
     342           0 :        IF (soc) THEN
     343           0 :           char_table(2,1)=1.0
     344           0 :           irrname(2)='Gam2'
     345             :        ENDIF
     346             :     CASE(2)                           ! C-1, C2 and Cs
     347           0 :        IF (rot(2).GT.0) THEN
     348           0 :           grpname='C2'
     349           0 :           char_table(1,1:2)=(/1.0,  1.0/)
     350           0 :           char_table(2,1:2)=(/1.0, -1.0/)
     351           0 :           irrname(1)='Gam1'
     352           0 :           irrname(2)='Gam2'
     353             :        ELSE
     354           0 :           grpname='C1h'
     355           0 :           char_table(1,1:2)=(/1.0,  1.0/)
     356           0 :           char_table(2,1:2)=(/1.0, -1.0/)
     357           0 :           irrname(1)='Gam1'
     358           0 :           irrname(2)='Gam2'
     359           0 :           IF (soc) THEN
     360           0 :              char_table(3,1:2)=(/one, -imi/)
     361           0 :              char_table(4,1:2)=(/one,  imi/)
     362           0 :              irrname(3)='Gam3'
     363           0 :              irrname(4)='Gam4'
     364             :           ENDIF
     365             :        ENDIF
     366             :     CASE(3)                           ! C3, D3 and C3v
     367           0 :        IF (ANY(det(1:3).EQ.-1)) THEN
     368           0 :           grpname='C3v'
     369           0 :           char_table(1,1:3)=(/1.0,  1.0,  1.0/)
     370           0 :           char_table(2,1:3)=(/1.0,  1.0, -1.0/)
     371           0 :           char_table(3,1:3)=(/2.0, -1.0,  0.0/)
     372           0 :           irrname(1)='Lam1'
     373           0 :           irrname(2)='Lam2'
     374           0 :           irrname(3)='Lam3'
     375           0 :           IF (soc) THEN
     376           0 :              nirr=6
     377           0 :              char_table(4,1:3)=(/2.0,  1.0,  0.0/)
     378           0 :              char_table(5,1:3)=(/one, -one,  imi/)
     379           0 :              char_table(6,1:3)=(/one, -one, -imi/)
     380           0 :              irrname(4)='Lam6'
     381           0 :              irrname(5)='Lam4'
     382           0 :              irrname(6)='Lam5'
     383             :           ENDIF
     384             :        ELSE
     385           0 :           grpname='C3'
     386           0 :           omega=EXP(CMPLX(0.0,-2*pi_const/3.0))
     387           0 :           char_table(1,1:3)=(/1.0,  1.0,  1.0/)
     388           0 :           char_table(2,1:3)=(/one, omega, omega**2/)
     389           0 :           char_table(3,1:3)=(/one, omega**2, omega /)
     390           0 :           irrname(1)='Gam1'
     391           0 :           irrname(2)='Gam2'
     392           0 :           irrname(3)='Gam3'
     393             :        ENDIF
     394             :     CASE(4)                           ! C2h, D2, C2v, C4, S4, and T
     395           0 :        IF((rot(2).EQ.1).AND.(rot(8).EQ.2)) THEN
     396           0 :           grpname='C2v'
     397           0 :           char_table(1,1:4)=(/1.0,  1.0,  1.0,  1.0/)
     398           0 :           char_table(2,1:4)=(/1.0,  1.0, -1.0, -1.0/)
     399           0 :           char_table(3,1:4)=(/1.0, -1.0, -1.0,  1.0/)
     400           0 :           char_table(4,1:4)=(/1.0, -1.0,  1.0, -1.0/)
     401           0 :           irrname(1)='Z1'
     402           0 :           irrname(2)='Z2'
     403           0 :           irrname(3)='Z3'
     404           0 :           irrname(4)='Z4'            
     405           0 :        ELSE IF (rot(3).GT.1) THEN
     406           0 :           grpname='T'
     407           0 :           omega=EXP(CMPLX(0.0,-2*pi_const/3.0))
     408           0 :           char_table(1,1:4)=(/1.0,  1.0,  1.0,  1.0/)
     409           0 :           char_table(2,1:4)=(/one,  one, omega, omega**2/)
     410           0 :           char_table(3,1:4)=(/one,  one, omega**2,  omega/)
     411           0 :           char_table(4,1:4)=(/3.0, -1.0,  0.0,  0.0/)
     412           0 :           irrname(1)='Gam1'
     413           0 :           irrname(2)='Gam2'
     414           0 :           irrname(3)='Gam3'
     415           0 :           irrname(4)='Gam4'
     416           0 :        ELSE IF ((rot(4).GT.1).OR.(rot(10).GT.1)) THEN
     417           0 :           IF (rot(4).GT.1) grpname='C4'
     418           0 :           IF (rot(10).GT.1) grpname='S4'
     419           0 :           char_table(1,1:4)=(/1.0,  1.0,  1.0,  1.0/)
     420           0 :           char_table(2,1:4)=(/1.0, -1.0,  1.0, -1.0/)
     421           0 :           char_table(3,1:4)=(/one, -imi, -one,  imi/)
     422           0 :           char_table(4,1:4)=(/one,  imi, -one, -imi/)
     423           0 :           irrname(1)='Gam1'
     424           0 :           irrname(2)='Gam2'
     425           0 :           irrname(3)='Gam3'
     426           0 :           irrname(4)='Gam4'
     427           0 :           IF (soc) THEN
     428           0 :              nirr=8
     429           0 :              omega=EXP(CMPLX(0.0,-pi_const/4.0))
     430             :              char_table(5,1:4)=(/one, omega, -imi, &
     431           0 :                   &                   -CONJG(omega)/)
     432             :              char_table(6,1:4)=(/one, CONJG(omega), imi, &
     433           0 :                   &                   -omega/)
     434             :              char_table(7,1:4)=(/one, -omega, -imi, &
     435           0 :                   &                   CONJG(omega)/)
     436             :              char_table(8,1:4)=(/one, -CONJG(omega), imi, &
     437           0 :                   &                   omega/)
     438           0 :              irrname(5)='Gam5'
     439           0 :              irrname(6)='Gam6'
     440           0 :              irrname(7)='Gam7'
     441           0 :              irrname(8)='Gam8'                   
     442             :           ENDIF
     443           0 :        ELSE IF ((rot(2).EQ.1).AND.(rot(8).EQ.1)) THEN
     444           0 :           grpname='ZKUS'
     445             :        ENDIF
     446             :     CASE(5)                           ! D4, C4v, D2d, O and Td
     447           0 :        IF (rot(3).GT.0) THEN
     448           0 :           grpname='Td'
     449           0 :           char_table(1,1:5)=(/1.0,  1.0,  1.0,  1.0,  1.0/)
     450           0 :           char_table(2,1:5)=(/1.0, -1.0,  1.0, -1.0,  1.0/)
     451           0 :           char_table(3,1:5)=(/2.0,  0.0,  2.0,  0.0, -1.0/)
     452           0 :           char_table(4,1:5)=(/3.0,  1.0, -1.0, -1.0,  0.0/)
     453           0 :           char_table(5,1:5)=(/3.0, -1.0, -1.0,  1.0,  0.0/)
     454           0 :           irrname(1)='P1'
     455           0 :           irrname(2)='P2'
     456           0 :           irrname(3)='P3'
     457           0 :           irrname(4)='P5'
     458           0 :           irrname(5)='P4'
     459           0 :        ELSE IF (rot(10).GT.0) THEN
     460           0 :           grpname='D2d'
     461           0 :           char_table(1,1:5)=(/1.0,  1.0,  1.0,  1.0,  1.0/)
     462           0 :           char_table(2,1:5)=(/1.0,  1.0, -1.0,  1.0, -1.0/)
     463           0 :           char_table(3,1:5)=(/1.0,  1.0,  1.0, -1.0, -1.0/)
     464           0 :           char_table(4,1:5)=(/1.0,  1.0, -1.0, -1.0,  1.0/)
     465           0 :           char_table(5,1:5)=(/2.0, -2.0,  0.0,  0.0,  0.0/)
     466             :           !               standard order: E, 2, 2_x, -4, m
     467           0 :           irrname(1)='W1'
     468           0 :           irrname(2)='W2'
     469           0 :           irrname(3)='W1`'
     470           0 :           irrname(4)='W2`'
     471           0 :           irrname(5)='W3'
     472             :        ELSE
     473           0 :           grpname='C4v'
     474           0 :           char_table(1,1:5)=(/1.0,  1.0,  1.0,  1.0,  1.0/)
     475           0 :           char_table(2,1:5)=(/1.0,  1.0,  1.0, -1.0, -1.0/)
     476           0 :           char_table(3,1:5)=(/1.0, -1.0,  1.0,  1.0, -1.0/)
     477           0 :           char_table(4,1:5)=(/1.0, -1.0,  1.0, -1.0,  1.0/)
     478           0 :           char_table(5,1:5)=(/2.0,  0.0, -2.0,  0.0,  0.0/)
     479           0 :           irrname(1)='Del1'
     480           0 :           irrname(2)='Del1`'
     481           0 :           irrname(3)='Del2'
     482           0 :           irrname(4)='Del2`'
     483           0 :           irrname(5)='Del5'
     484             :        ENDIF
     485             :     CASE(6)                           ! C3i, D3d, C6, C3h, D6, C6v and D3h
     486           0 :        IF (rot(2).EQ.0) THEN
     487           0 :           IF (rot(7).EQ.0) THEN
     488           0 :              grpname='C3h'
     489           0 :              char_table(:,:) = 0.0
     490           0 :              WRITE(24,*) 'C3h: Character table missing in grp_k.F'
     491             :           ELSE
     492           0 :              grpname='C3i'
     493           0 :              omega=CMPLX(-0.5,SQRT(3./4.))
     494           0 :              char_table(1,1:6)=(/one, one, one, one, one, one/)
     495           0 :              char_table(2,1:6)=(/one, one, one,-one,-one,-one/)
     496             :              char_table(3,1:6)=(/one, omega, CONJG(omega),&
     497           0 :                   &                                one, omega, CONJG(omega)/)
     498             :              char_table(4,1:6)=(/one, omega, CONJG(omega),&
     499           0 :                   &                               -one,-omega,-CONJG(omega)/)
     500             :              char_table(5,1:6)=(/one, CONJG(omega), omega,&
     501           0 :                   &                                one, CONJG(omega), omega/)
     502             :              char_table(6,1:6)=(/one, CONJG(omega), omega,&
     503           0 :                   &                               -one,-CONJG(omega),-omega/)
     504           0 :              irrname(1)='Ag  '
     505           0 :              irrname(2)='Au  '
     506           0 :              irrname(3)='E1g '
     507           0 :              irrname(4)='E1u '
     508           0 :              irrname(5)='E2g '
     509           0 :              irrname(6)='E2u '
     510           0 :              IF (soc) THEN
     511           0 :                 char_table(7,1:6)=(/one,-one, one, one,-one, one/)
     512           0 :                 char_table(8,1:6)=(/one,-one, one,-one, one,-one/)
     513             :                 char_table( 9,1:6)=(/one,-omega, CONJG(omega),&
     514           0 :                      &                                one,-omega, CONJG(omega)/)
     515             :                 char_table(10,1:6)=(/one,-omega, CONJG(omega),&
     516           0 :                      &                               -one, omega,-CONJG(omega)/)
     517             :                 char_table(11,1:6)=(/one,-CONJG(omega), omega,&
     518           0 :                      &                                one,-CONJG(omega), omega/)
     519             :                 char_table(12,1:6)=(/one,-CONJG(omega), omega,&
     520           0 :                      &                               -one, CONJG(omega),-omega/)
     521           0 :                 irrname(7)="Ag' "
     522           0 :                 irrname(8)="Au' "
     523           0 :                 irrname(9)="E1g'"
     524           0 :                 irrname(10)="E1u'"
     525           0 :                 irrname(11)="E2g'"
     526           0 :                 irrname(12)="E2u'"
     527             :              ENDIF
     528             :           ENDIF
     529           0 :        ELSEIF (rot(2).GT.1) THEN
     530           0 :           grpname='D6'
     531           0 :           char_table(1,1:6)=(/1.0,  1.0,  1.0,  1.0,  1.0,  1.0/)
     532           0 :           char_table(2,1:6)=(/1.0,  1.0,  1.0,  1.0, -1.0, -1.0/)
     533           0 :           char_table(3,1:6)=(/1.0, -1.0,  1.0, -1.0,  1.0, -1.0/)
     534           0 :           char_table(4,1:6)=(/1.0, -1.0,  1.0, -1.0, -1.0,  1.0/)
     535           0 :           char_table(5,1:6)=(/2.0,  1.0, -1.0, -2.0,  0.0,  0.0/)
     536           0 :           char_table(6,1:6)=(/2.0, -1.0, -1.0,  2.0,  0.0,  0.0/)
     537           0 :           irrname(1)='Gam1'
     538           0 :           irrname(2)='Gam2'
     539           0 :           irrname(3)='Gam3'
     540           0 :           irrname(4)='Gam4'
     541           0 :           irrname(5)='Gam6'
     542           0 :           irrname(6)='Gam5'
     543             :        ELSE
     544           0 :           IF (rot(6).EQ.0) THEN
     545           0 :              grpname='D3d'
     546           0 :              char_table(1,1:6)=(/1.0,  1.0,  1.0,  1.0,  1.0,  1.0/)
     547           0 :              char_table(2,1:6)=(/1.0,  1.0, -1.0,  1.0,  1.0, -1.0/)
     548           0 :              char_table(3,1:6)=(/2.0, -1.0,  0.0,  2.0, -1.0,  0.0/)
     549           0 :              char_table(4,1:6)=(/1.0,  1.0,  1.0, -1.0, -1.0, -1.0/)
     550           0 :              char_table(5,1:6)=(/1.0,  1.0, -1.0, -1.0, -1.0,  1.0/)
     551           0 :              char_table(6,1:6)=(/2.0, -1.0,  0.0, -2.0,  1.0,  0.0/)
     552           0 :              irrname(1)='A1g'
     553           0 :              irrname(2)='A2g'
     554           0 :              irrname(3)='Eg'
     555           0 :              irrname(4)='A1u'
     556           0 :              irrname(5)='A2u'
     557           0 :              irrname(6)='Eu'
     558           0 :           ELSEIF (rot(6).GT.1) THEN
     559           0 :              grpname='C6' 
     560           0 :              char_table(:,:) = 0.0
     561           0 :              WRITE(24,*) 'C6: Character table missing in grp_k.F'
     562             :           ELSE
     563           0 :              IF (members(3).GT.1) grpname='D3h'    ! maybe this works
     564           0 :              IF (members(3).EQ.1) grpname='C6v'
     565           0 :              char_table(1,1:6)=(/1.0,  1.0,  1.0,  1.0,  1.0,  1.0/)
     566           0 :              char_table(2,1:6)=(/1.0,  1.0,  1.0,  1.0, -1.0, -1.0/)
     567           0 :              char_table(3,1:6)=(/1.0, -1.0,  1.0, -1.0,  1.0, -1.0/)
     568           0 :              char_table(4,1:6)=(/1.0, -1.0,  1.0, -1.0, -1.0,  1.0/)
     569           0 :              char_table(5,1:6)=(/2.0,  1.0, -1.0, -2.0,  0.0,  0.0/)
     570           0 :              char_table(6,1:6)=(/2.0, -1.0, -1.0,  2.0,  0.0,  0.0/)
     571           0 :              irrname(1)='Gam1'
     572           0 :              irrname(2)='Gam2'
     573           0 :              irrname(3)='Gam3'
     574           0 :              irrname(4)='Gam4'
     575           0 :              irrname(5)='Gam6'
     576           0 :              irrname(6)='Gam5'
     577             :           ENDIF
     578             :        ENDIF
     579             :     CASE(8)                           ! Th, C4h and D2h
     580           0 :        IF (rot(3).GT.0) THEN
     581           0 :           grpname='Th'
     582           0 :           char_table(:,:) = 0.0
     583           0 :           WRITE(24,*) 'Th: Character table missing in grp_k.F'
     584           0 :        ELSE IF (rot(2).EQ.3) THEN
     585           0 :           grpname='D2h'
     586           0 :           char_table(:,:) = 0.0
     587           0 :           WRITE(24,*) 'D2h: Character table missing in grp_k.F'
     588             :        ELSE
     589           0 :           grpname='C4h'
     590           0 :           char_table(:,:) = 0.0
     591           0 :           WRITE(24,*) 'C4h: Character table missing in grp_k.F'
     592             :        ENDIF
     593             :     CASE(10)                           ! D4h and Oh
     594           0 :        IF (rot(3).GT.0) THEN
     595           0 :           grpname='Oh'
     596             :           char_table(1,1:10)= (/1.0,  1.0,  1.0,  1.0,  1.0,&
     597           0 :                &                                1.0,  1.0,  1.0,  1.0,  1.0/)
     598             :           char_table(2,1:10)= (/1.0, -1.0,  1.0,  1.0, -1.0,&
     599           0 :                &                                1.0, -1.0,  1.0,  1.0, -1.0/)
     600             :           char_table(3,1:10)= (/2.0,  0.0, -1.0,  2.0,  0.0,&
     601           0 :                &                                2.0,  0.0, -1.0,  2.0,  0.0/)
     602             :           char_table(4,1:10)= (/3.0,  1.0,  0.0, -1.0, -1.0,&
     603           0 :                &                                3.0,  1.0,  0.0, -1.0, -1.0/)
     604             :           char_table(5,1:10)= (/3.0, -1.0,  0.0, -1.0,  1.0,&
     605           0 :                &                                3.0, -1.0,  0.0, -1.0,  1.0/)
     606             :           char_table(6,1:10)= (/1.0,  1.0,  1.0,  1.0,  1.0,&
     607           0 :                &                               -1.0, -1.0, -1.0, -1.0, -1.0/)
     608             :           char_table(7,1:10)= (/1.0, -1.0,  1.0,  1.0, -1.0,&
     609           0 :                &                               -1.0,  1.0, -1.0, -1.0,  1.0/)
     610             :           char_table(8,1:10)= (/2.0,  0.0, -1.0,  2.0,  0.0,&
     611           0 :                &                               -2.0,  0.0,  1.0, -2.0,  0.0/)
     612             :           char_table(9,1:10)= (/3.0,  1.0,  0.0, -1.0, -1.0,&
     613           0 :                &                               -3.0, -1.0,  0.0,  1.0,  1.0/)
     614             :           char_table(10,1:10)=(/3.0, -1.0,  0.0, -1.0,  1.0,&
     615           0 :                &                               -3.0,  1.0,  0.0,  1.0, -1.0/)
     616             : 
     617           0 :           irrname(1)='Gam1+'
     618           0 :           irrname(2)='Gam2+'
     619           0 :           irrname(3)='Gam3+'
     620           0 :           irrname(4)='Gam4+'
     621           0 :           irrname(5)='Gam5+'
     622           0 :           irrname(6)='Gam1-'
     623           0 :           irrname(7)='Gam2-'
     624           0 :           irrname(8)='Gam3-'
     625           0 :           irrname(9)='Gam4-'
     626           0 :           irrname(10)='Gam5-'
     627             :        ELSE
     628           0 :           grpname='D4h'
     629             :           char_table(1,1:10)= (/1.0,  1.0,  1.0,  1.0,  1.0,&
     630           0 :                &                                1.0,  1.0,  1.0,  1.0,  1.0/)
     631             :           char_table(2,1:10)= (/1.0,  1.0,  1.0, -1.0, -1.0,&
     632           0 :                &                                1.0,  1.0,  1.0, -1.0, -1.0/)
     633             :           char_table(3,1:10)= (/1.0, -1.0,  1.0,  1.0, -1.0,&
     634           0 :                &                                1.0, -1.0,  1.0,  1.0, -1.0/)
     635             :           char_table(4,1:10)= (/1.0, -1.0,  1.0, -1.0,  1.0,&
     636           0 :                &                                1.0, -1.0,  1.0, -1.0,  1.0/)
     637             :           char_table(5,1:10)= (/2.0,  0.0, -2.0,  0.0,  0.0,&
     638           0 :                &                                2.0,  0.0, -2.0,  0.0,  0.0/)
     639             :           char_table(6,1:10)= (/1.0,  1.0,  1.0,  1.0,  1.0,&
     640           0 :                &                               -1.0, -1.0, -1.0, -1.0, -1.0/)
     641             :           char_table(7,1:10)= (/1.0,  1.0,  1.0, -1.0, -1.0,&
     642           0 :                &                               -1.0, -1.0, -1.0,  1.0,  1.0/)
     643             :           char_table(8,1:10)= (/1.0, -1.0,  1.0,  1.0, -1.0,&
     644           0 :                &                               -1.0,  1.0, -1.0, -1.0,  1.0/)
     645             :           char_table(9,1:10)= (/1.0, -1.0,  1.0, -1.0,  1.0,&
     646           0 :                &                               -1.0,  1.0, -1.0,  1.0, -1.0/)
     647             :           char_table(10,1:10)=(/2.0,  0.0, -2.0,  0.0,  0.0,&
     648           0 :                &                               -2.0,  0.0,  2.0,  0.0,  0.0/)
     649             : 
     650             :           ! standard char-table assumes the order: E, 4, 2, 2_h, 2_h' where 4 and 2 
     651             :           ! rotate around the same axis and 2_h is perpendicular to this axis. Check:
     652             : 
     653           0 :           CALL cross( rax(1,2),rax(1,3),kt )
     654           0 :           IF (kt(1)**2+kt(2)**2+kt(3)**2 < eps) THEN
     655             :              !                  all ok
     656             :           ELSE 
     657           0 :              CALL cross( rax(1,2),rax(1,4),kt )
     658           0 :              IF (kt(1)**2+kt(2)**2+kt(3)**2 < eps) THEN      ! change 3 & 4
     659           0 :                 CALL change_column(char_table,10,10,3,4)
     660             :                 ! check, whether element 3 is perpendicular to element 2
     661           0 :                 IF (DOT_PRODUCT(rax(1:3,2),rax(1:3,3)) < eps) THEN
     662             :                    !                     all ok
     663             :                 ELSE             ! change 4 & 5
     664           0 :                    WRITE(*,*) DOT_PRODUCT(rax(1:3,2),rax(1:3,3))
     665           0 :                    CALL change_column(char_table,10,10,4,5)
     666             :                 ENDIF
     667             :              ELSE
     668           0 :                 CALL cross( rax(1,2),rax(1,5),kt )
     669           0 :                 IF (kt(1)**2+kt(2)**2+kt(3)**2 < eps) THEN    ! change 3 & 5
     670           0 :                    CALL change_column(char_table,10,10,3,5)
     671           0 :                    IF (DOT_PRODUCT(rax(1:3,2),rax(1:3,3)) < eps) THEN ! change 4 & 5
     672           0 :                       CALL change_column(char_table,10,10,4,5)
     673             :                    ELSE             
     674             :                       !                     all ok
     675             :                    ENDIF
     676             :                 ELSE
     677           0 :                    CALL juDFT_error("D4h",calledby="grp_k")
     678             :                 ENDIF
     679             :              ENDIF
     680             :           ENDIF
     681           0 :           irrname(1)='A1g'
     682           0 :           irrname(2)='A2g'
     683           0 :           irrname(3)='B1g'
     684           0 :           irrname(4)='B2g'
     685           0 :           irrname(5)='Eg'
     686           0 :           irrname(6)='A1u'
     687           0 :           irrname(7)='A2u'
     688           0 :           irrname(8)='B1u'
     689           0 :           irrname(9)='B2u'
     690           0 :           irrname(10)='Eu'
     691             :        ENDIF
     692             :     CASE(12)                           ! D6h and C6h
     693           0 :        IF (rot(2).EQ.3) THEN
     694           0 :           grpname='D6h'
     695           0 :           char_table(:,:) = 0.0
     696           0 :           WRITE(24,*) 'D6h: Character table missing in grp_k.F'
     697             :        ELSE
     698           0 :           grpname='C6h'
     699           0 :           char_table(:,:) = 0.0
     700           0 :           WRITE(24,*) 'C6h: Character table missing in grp_k.F'
     701             :        ENDIF
     702             :     CASE DEFAULT
     703           0 :        WRITE(24,*) 'Group of k not identified'
     704             :     END SELECT
     705             : 
     706             :     !>
     707             : 
     708           0 :   END SUBROUTINE grp_k
     709             :   !-------------------------------------------------------------------------------
     710             : 
     711             :   !<--SUBROUTINE rotaxis(alpha,beta,gamma,rax,theta)
     712           0 :   SUBROUTINE rotaxis(alpha,beta,gamma,rax,theta)
     713             : 
     714             :     ! Determines the rotation axis based on the Euler angles
     715             :     IMPLICIT NONE
     716             :     REAL, INTENT(IN) :: alpha,beta,gamma
     717             :     REAL, INTENT(OUT) :: rax(4),theta 
     718             : 
     719             :     REAL :: costhe2,the2
     720             :     INTEGER :: i
     721             : 
     722           0 :     costhe2=COS(beta/2.0)*COS((alpha+gamma)/2.0)
     723           0 :     the2=ACOS(costhe2)
     724           0 :     rax=0.0
     725           0 :     IF (the2.GT.0.00001) THEN
     726           0 :        rax(1)=-SIN(beta/2.0)*SIN((alpha-gamma)/2.0)/SIN(the2)
     727           0 :        rax(2)= SIN(beta/2.0)*COS((alpha-gamma)/2.0)/SIN(the2)
     728           0 :        rax(3)= COS(beta/2.0)*SIN((alpha+gamma)/2.0)/SIN(the2)
     729             :     ENDIF
     730           0 :     DO i=1,3
     731           0 :        IF (ABS(rax(i)).GT.0.0001) THEN
     732           0 :           rax(i)=rax(i)/ABS(rax(i))
     733             :        ENDIF
     734             :     ENDDO
     735           0 :     rax(4)=rax(1)**2+rax(2)**2+rax(3)**2
     736           0 :     theta=the2*2.0
     737           0 :   END SUBROUTINE rotaxis
     738             :   !>
     739             : 
     740             :   !<--Subroutine euler
     741           0 :   SUBROUTINE euler(n,sym,cell,alpha,beta,gamma)
     742             : 
     743             :     ! determines the Euler angles corresponding the proper rotation part of mrot      
     744             : 
     745             :     USE m_constants, ONLY : pi_const
     746             :     USE m_inv3
     747             :     USE m_types
     748             :     IMPLICIT NONE
     749             :     INTEGER,INTENT(IN)         :: n
     750             :     TYPE(t_sym),INTENT(IN)     :: sym
     751             :     TYPE(t_cell),INTENT(IN)    :: cell
     752             :     
     753             :     REAL, INTENT(OUT) :: alpha,beta,gamma
     754             : 
     755             :     INTEGER :: det
     756             :     REAL :: mprop(3,3)      
     757             :     REAL :: sina,sinb,sinc,cosa,cosb,cosc
     758             :     REAL :: amatinv(3,3),detr
     759             : 
     760           0 :     CALL inv3(cell%amat,amatinv,detr)
     761             :     det= sym%mrot(1,1,n)*sym%mrot(2,2,n)*sym%mrot(3,3,n) +&
     762             :          &        sym%mrot(1,2,n)*sym%mrot(2,3,n)*sym%mrot(3,1,n) +&
     763             :          &        sym%mrot(2,1,n)*sym%mrot(3,2,n)*sym%mrot(1,3,n) -&
     764             :          &        sym%mrot(1,3,n)*sym%mrot(2,2,n)*sym%mrot(3,1,n) -&
     765             :          &        sym%mrot(2,3,n)*sym%mrot(3,2,n)*sym%mrot(1,1,n) -&
     766           0 :          &        sym%mrot(2,1,n)*sym%mrot(1,2,n)*sym%mrot(3,3,n)
     767             : 
     768             :     ! Take the proper rotation         
     769           0 :     mprop=REAL(det)*MATMUL(cell%amat,MATMUL(REAL(sym%mrot(:,:,n)),amatinv))
     770             :     ! Euler angles         
     771           0 :     cosb = mprop(3,3)
     772           0 :     sinb = 1.00 - cosb*cosb
     773           0 :     sinb = MAX(sinb,0.00)
     774           0 :     sinb = SQRT(sinb)
     775             :     !
     776             :     ! if beta = 0 or pi , only alpha+gamma or -gamma have a meaning:
     777             :     !
     778           0 :     IF ( ABS(sinb).LT.1.0e-5 ) THEN 
     779           0 :        beta = 0.0
     780           0 :        IF ( cosb.LT.0.0 ) beta = pi_const
     781           0 :        gamma = 0.0
     782           0 :        cosa = mprop(1,1)/cosb
     783           0 :        sina = mprop(1,2)/cosb
     784           0 :        IF ( ABS(sina).LT.1.0e-5 ) THEN
     785           0 :           alpha=0.0
     786           0 :           IF ( cosa.LT.0.0 ) alpha=alpha+pi_const
     787             :        ELSE
     788           0 :           alpha = 0.5*pi_const - ATAN(cosa/sina)
     789           0 :           IF ( sina.LT.0.0 ) alpha=alpha+pi_const
     790             :        ENDIF
     791             :     ELSE
     792           0 :        beta = 0.5*pi_const - ATAN(cosb/sinb)
     793             :        !     
     794             :        ! determine alpha and gamma from d13 d23 d32 d31
     795             :        !
     796           0 :        cosa = mprop(3,1)/sinb
     797           0 :        sina = mprop(3,2)/sinb
     798           0 :        cosc =-mprop(1,3)/sinb
     799           0 :        sinc = mprop(2,3)/sinb
     800           0 :        IF ( ABS(sina).LT.1.0e-5 ) THEN
     801           0 :           alpha=0.0
     802           0 :           IF ( cosa.LT.0.0 ) alpha=alpha+pi_const
     803             :        ELSE
     804           0 :           alpha = 0.5*pi_const - ATAN(cosa/sina)
     805           0 :           IF ( sina.LT.0.0 ) alpha=alpha+pi_const
     806             :        ENDIF
     807           0 :        IF ( ABS(sinc).LT.1.0e-5 ) THEN
     808           0 :           gamma = 0.0
     809           0 :           IF ( cosc.LT.0.0 ) gamma=gamma+pi_const
     810             :        ELSE
     811           0 :           gamma = 0.5*pi_const - ATAN(cosc/sinc)
     812           0 :           IF ( sinc.LT.0.0 ) gamma=gamma+pi_const
     813             :        ENDIF
     814             : 
     815             :     ENDIF
     816             : 
     817           0 :   END SUBROUTINE euler
     818             :   !>
     819             :   !-----------------------------------------------------------
     820           0 :   SUBROUTINE change_column( char_table,nx,ny,r1,r2 )
     821             : 
     822             :     INTEGER, INTENT (IN)   :: nx,ny,r1,r2
     823             :     COMPLEX, INTENT(INOUT) :: char_table(:,:)
     824             : 
     825           0 :     COMPLEX tmpc(nx)
     826             : 
     827           0 :     tmpc(1:nx) = char_table(1:nx,r1)
     828           0 :     char_table(1:nx,r1) = char_table(1:nx,r2)
     829           0 :     char_table(1:nx,r2) = tmpc(1:nx)
     830           0 :     tmpc(1:nx) = char_table(1:nx,r1+nx/2)
     831           0 :     char_table(1:nx,r1+nx/2) = char_table(1:nx,r2+nx/2)
     832           0 :     char_table(1:nx,r2+nx/2) = tmpc(1:nx)
     833             : 
     834           0 :   END SUBROUTINE change_column
     835             : END MODULE m_grp_k

Generated by: LCOV version 1.13