LCOV - code coverage report
Current view: top level - dos - sympsi.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 112 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 1 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_sympsi
       8             : 
       9             :   ! Calculates the irreducible represetantions of the wave functions.
      10             :   ! if k-point is in Brillouin zone boundary results are correct only for
      11             :   ! non-symmorphic groups (factor groups would be needed for that...). 
      12             :   ! jsym contains the number of irreducible rep., corresponding character
      13             :   ! tables are given in the file syminfo.
      14             :   !
      15             :   ! Double groups work only with non-collinear calculations, for normal spin-orbit 
      16             :   ! calculations both spin up and down components would be needed...
      17             : 
      18             :   ! Jussi Enkovaara, Juelich 2004
      19             : 
      20             : CONTAINS
      21           0 :   SUBROUTINE sympsi(lapw,jspin,sym,DIMENSION,ne,cell,eig,noco, ksym,jsym,zMat)
      22             : 
      23             :     USE m_grp_k
      24             :     USE m_inv3
      25             :     USE m_types
      26             :     USE m_juDFT
      27             :     IMPLICIT NONE
      28             : 
      29             :     TYPE(t_lapw),INTENT(IN)        :: lapw
      30             :     TYPE(t_dimension),INTENT(IN)   :: DIMENSION
      31             :     TYPE(t_noco),INTENT(IN)        :: noco
      32             :     TYPE(t_sym),INTENT(IN)         :: sym
      33             :     TYPE(t_cell),INTENT(IN)        :: cell
      34             :     TYPE(t_mat),INTENT(IN)         :: zMat
      35             :     !
      36             :     !     .. Scalar Arguments ..
      37             :     INTEGER, INTENT (IN) :: ne,jspin
      38             :     !     ..
      39             :     !     .. Array Arguments ..
      40             :     REAL,    INTENT (IN) :: eig(DIMENSION%neigd)
      41             : 
      42             :     INTEGER, INTENT (OUT):: jsym(DIMENSION%neigd),ksym(DIMENSION%neigd)
      43             :     !     ..
      44             :     !     .. Local Scalars ..
      45             :     REAL degthre
      46             :     INTEGER i,k,n,c
      47             :     INTEGER nclass,nirr,n1,n2 ,ndeg
      48             :     LOGICAL soc, char_written
      49             :     !     ..
      50             :     !     .. Local Arrays ..
      51           0 :     INTEGER mrot_k(3,3,2*sym%nop)
      52             :     INTEGER :: mtmpinv(3,3),d
      53           0 :     INTEGER :: gmap(DIMENSION%nvd,sym%nop)
      54             :     REAL ::    kv(3),kvtest(3)
      55           0 :     INTEGER :: deg(ne)
      56             : 
      57           0 :     REAL :: norm(ne)
      58           0 :     LOGICAL :: symdone(ne)
      59             : 
      60           0 :     COMPLEX, ALLOCATABLE :: csum(:,:,:),chars(:,:)
      61             :     COMPLEX, SAVE, ALLOCATABLE :: char_table(:,:)
      62             :     CHARACTER(LEN=7) :: grpname
      63           0 :     CHARACTER(LEN=5) :: irrname(2*sym%nop)
      64           0 :     COMPLEX          :: c_table(2*sym%nop,2*sym%nop)
      65           0 :     COMPLEX, ALLOCATABLE :: su(:,:,:)
      66             :     !
      67             :     REAL,PARAMETER:: small=1.0e-4
      68             : 
      69           0 :     soc=noco%l_soc.AND.noco%l_noco
      70           0 :     jsym=0
      71           0 :     ksym=0
      72           0 :     IF (noco%l_soc.AND.(.NOT.noco%l_noco)) RETURN
      73             : 
      74           0 :     CALL timestart("sympsi")
      75             : 
      76           0 :     IF (soc) THEN
      77           0 :        ALLOCATE(su(2,2,2*sym%nop))
      78           0 :        CALL grp_k(sym,mrot_k,cell,lapw%bkpt,nclass,nirr,c_table, grpname,irrname,su)
      79             :     ELSE
      80           0 :        CALL grp_k(sym,mrot_k,cell,lapw%bkpt,nclass,nirr,c_table, grpname,irrname)
      81             :     ENDIF
      82           0 :     ALLOCATE(csum(ne,ne,nclass))
      83           0 :     ALLOCATE(chars(ne,nclass))
      84           0 :     chars=0.0
      85             :     !>
      86             : 
      87           0 :     IF (ALLOCATED(char_table)) THEN
      88           0 :        IF (SIZE(char_table,2).NE.nclass) THEN
      89           0 :           DEALLOCATE(char_table)
      90           0 :           ALLOCATE(char_table(nirr,nclass))
      91           0 :           char_written=.FALSE.
      92             :        ENDIF
      93             :     ELSE
      94           0 :        ALLOCATE(char_table(nirr,nclass))
      95           0 :        char_written=.FALSE.
      96             :     ENDIF
      97           0 :     char_table(:,:) = c_table(1:nirr,1:nclass)
      98             : 
      99             :     !<--map the (k+g)-vectors related by inv(rot)
     100           0 :     gmap=0
     101           0 :     DO c=1,nclass
     102           0 :        CALL inv3(mrot_k(:,:,c),mtmpinv,d)
     103           0 :        kloop: DO k=1,lapw%nv(jspin)
     104           0 :           kv(1)=lapw%k1(k,jspin)
     105           0 :           kv(2)=lapw%k2(k,jspin)
     106           0 :           kv(3)=lapw%k3(k,jspin)
     107           0 :           kv=kv+lapw%bkpt
     108           0 :           kvtest=MATMUL(kv,mtmpinv)
     109             :           !         kvtest=MATMUL(kv,mrot_k(:,:,c))
     110           0 :           DO i = 1,lapw%nv(jspin)
     111           0 :              kv(1)=lapw%k1(i,jspin)
     112           0 :              kv(2)=lapw%k2(i,jspin)
     113           0 :              kv(3)=lapw%k3(i,jspin)
     114           0 :              kv=kv+lapw%bkpt
     115             :              IF (ABS(kvtest(1)-kv(1)).LT.small.AND.&
     116           0 :                   ABS(kvtest(2)-kv(2)).LT.small.AND. ABS(kvtest(3)-kv(3)).LT.small) THEN
     117           0 :                 gmap(k,c)=i
     118             :                 CYCLE kloop
     119             :              ENDIF
     120             :           ENDDO
     121           0 :           WRITE(6,*) 'Problem in symcheck, cannot find rotated kv for', k,lapw%k1(k,jspin),lapw%k2(k,jspin),lapw%k3(k,jspin)
     122           0 :           CALL timestart("sympsi")
     123           0 :           RETURN
     124             :        ENDDO kloop
     125             :     ENDDO
     126             : 
     127             :     !norms
     128           0 :     DO i=1,ne
     129           0 :        norm(i)=0.0
     130           0 :        IF (soc) THEN
     131           0 :           DO k=1,lapw%nv(jspin)*2
     132           0 :              norm(i)=norm(i)+ABS(zMat%data_c(k,i))**2
     133             :           ENDDO
     134             :        ELSE
     135           0 :           IF (zmat%l_real) THEN
     136           0 :              DO k=1,lapw%nv(jspin)
     137           0 :                 norm(i)=norm(i)+ABS(zMat%data_r(k,i))**2
     138             :              ENDDO
     139             :           ELSE
     140           0 :              DO k=1,lapw%nv(jspin)
     141           0 :                 norm(i)=norm(i)+ABS(zMat%data_c(k,i))**2
     142             :              ENDDO
     143             :           ENDIF
     144             :        ENDIF
     145           0 :        norm(i)=SQRT(norm(i))
     146             :     ENDDO
     147             : 
     148             : 
     149             :     !<-- Calculate the characters
     150           0 :     symdone=.FALSE.
     151           0 :     stateloop: DO i=1,ne
     152           0 :        IF (symdone(i)) CYCLE stateloop
     153             :        ndeg=0
     154           0 :        deg=0
     155           0 :        degthre=0.0001
     156           0 :        DO n=1,ne
     157           0 :           IF (ABS(eig(i)-eig(n)).LT.degthre) THEN
     158           0 :              ndeg=ndeg+1
     159           0 :              deg(ndeg)=n
     160             :           ENDIF
     161             :        ENDDO
     162             : 
     163           0 :        csum=0.0
     164           0 :        DO c=1,nclass
     165           0 :           DO n1=1,ndeg
     166           0 :              DO n2=1,ndeg
     167           0 :                 IF (zmat%l_real) THEN
     168           0 :                    DO k=1,lapw%nv(jspin)
     169             :                       csum(n1,n2,c)=csum(n1,n2,c)+zMat%data_r(k,deg(n1))*&
     170           0 :                            zMat%data_r(gmap(k,c),deg(n2))/(norm(deg(n1))*norm(deg(n2)))
     171             :                    END DO
     172             :                 ELSE
     173           0 :                    IF (soc) THEN  
     174           0 :                       DO k=1,lapw%nv(jspin)
     175             : 
     176             :                          csum(n1,n2,c)=csum(n1,n2,c)+(CONJG(zMat%data_c(k,deg(n1)))*&
     177             :                               (su(1,1,c)*zMat%data_c(gmap(k,c),deg(n2))+ su(1,2,c)*zMat%data_c(gmap(k,c)+lapw%nv(jspin),deg(n2)))+&
     178             :                               CONJG(zMat%data_c(k+lapw%nv(jspin),deg(n1)))* (su(2,1,c)*zMat%data_c(gmap(k,c),deg(n2))+&
     179           0 :                               su(2,2,c)*zMat%data_c(gmap(k,c)+lapw%nv(jspin),deg(n2))))/ (norm(deg(n1))*norm(deg(n2)))
     180             :                       END DO
     181             :                    ELSE
     182           0 :                       DO k=1,lapw%nv(jspin)
     183             :                          csum(n1,n2,c)=csum(n1,n2,c)+CONJG(zMat%data_c(k,deg(n1)))*&
     184           0 :                               zMat%data_c(gmap(k,c),deg(n2))/(norm(deg(n1))*norm(deg(n2)))
     185             :                       END DO
     186             :                    ENDIF
     187             :                 ENDIF
     188             :              ENDDO
     189             :           ENDDO
     190             :        ENDDO
     191             :        ! We might have taken degenerate states which are not degenerate due to symmetry
     192             :        ! so look for irreducible reps
     193           0 :        DO n1=1,ndeg
     194           0 :           chars(deg(n1),:)=0.0
     195           0 :           DO n2=1,ndeg
     196           0 :              IF (ANY(ABS(csum(n1,n2,:)).GT.0.01)) THEN
     197           0 :                 chars(deg(n1),:)=chars(deg(n1),:)+csum(n2,n2,:)
     198             :              ENDIF
     199             :           ENDDO
     200           0 :           symdone(deg(n1))=.TRUE.
     201             :        ENDDO
     202             : 
     203             : 
     204             :        ! determine the irreducible presentation
     205           0 :        irrloop: DO n1=1,ndeg 
     206             :           !        write(*,'(2i3,6(2f6.3,2x))') n1,i,chars(deg(n1),1:nclass)
     207           0 :           DO c=1,nirr
     208           0 :              IF (ALL(ABS(chars(deg(n1),1:nclass)-&
     209           0 :                   &             char_table(c,1:nclass)).LT.0.001)) THEN
     210           0 :                 jsym(deg(n1))=c
     211           0 :                 CYCLE irrloop
     212           0 :              ELSE IF (ALL(ABS(char_table(c,1:nclass)).LT.0.001)) THEN
     213           0 :                 char_table(c,:)=chars(deg(n1),:)
     214           0 :                 jsym(deg(n1))=c
     215           0 :                 CYCLE irrloop
     216             :              ENDIF
     217             :           ENDDO
     218             :        ENDDO irrloop
     219             : 
     220             :     ENDDO stateloop
     221             :     !>
     222             : 
     223             :     IF (.NOT.char_written) THEN
     224           0 :        WRITE(444,124) lapw%bkpt
     225           0 :        WRITE(444,*) 'Group is ' ,grpname
     226           0 :        DO c=1,nirr
     227           0 :           IF (zmat%l_real)THEN
     228           0 :              IF (ANY(ABS(char_table).GT.0.001)) THEN
     229           0 :                 WRITE(444,123) c,irrname(c),(char_table(c,n),n=1,nclass)
     230             :              ELSE
     231           0 :                 WRITE(444,123) c,irrname(c),(REAL(char_table(c,n)),n=1,nclass)
     232             :              ENDIF
     233             :           ELSE
     234           0 :              IF (ANY(AIMAG(char_table).GT.0.001)) THEN
     235           0 :                 WRITE(444,123) c,irrname(c),(char_table(c,n),n=1,nclass)
     236             :              ELSE
     237           0 :                 WRITE(444,123) c,irrname(c),(REAL(char_table(c,n)),n=1,nclass)
     238             :              ENDIF
     239             :           ENDIF
     240             :        ENDDO
     241           0 :        char_written=.TRUE.
     242             :     ENDIF
     243             : 123 FORMAT(i3,1x,a5,1x,20f7.3)
     244             : 124 FORMAT('Character table for k: ',3f8.4)
     245             : 
     246           0 :     DEALLOCATE(csum)
     247           0 :     DEALLOCATE(chars)
     248             : 
     249           0 :     CALL timestop("sympsi")
     250             : 
     251           0 :   END SUBROUTINE sympsi
     252             : 
     253             : END  MODULE m_sympsi

Generated by: LCOV version 1.13