wann_gwf_anglmom.f 2.04 KB
Newer Older
Daniel Wortmann's avatar
Daniel Wortmann committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82
c*************************c
c  routine to set up the  c
c  composite matrix anglmom c
c*************************c
      module m_wann_gwf_anglmom

      implicit none
      contains

      subroutine wann_gwf_anglmom(nkpts,nqpts,l_unformatted)
      use m_wann_gwf_tools

      implicit none
      
      ! input parameters
      logical,intent(in) :: l_unformatted
      integer,intent(in) :: nkpts,nqpts

      integer :: nwfs,nbnd,nkqpts
      integer :: d,i,j,k,q,kq,t1,t2,t3,t4
      real :: tempr,tempi 

      complex,allocatable :: anglmom(:,:,:,:)
      character(len=12) :: fending

      nkqpts = nkpts*nqpts

      ! get number of bands and wfs from proj
      open(405,file='proj',status='old')
      read(405,*)nwfs,nbnd
      close(405)
      write(*,*)'nbnd=',nbnd
      write(*,*)'nwfs=',nwfs

      allocate(anglmom(3,nbnd,nbnd,nkqpts))

      ! read in separate files
      do q=1,nqpts
       WRITE(fending,'("_",i4.4)')q
       open(405,file='WF1'//trim(fending)//'.anglmom')
       read(405,*) !header
       read(405,*) !nbnd and nkpts
       do k=1,nkpts
        kq=get_index_kq(k,q,nkpts)
        do i=1,nbnd
         do j=1,nbnd
          do d=1,3
           read(405,*)t1,t2,t3,t4,tempr,tempi
           anglmom(d,j,i,kq) = cmplx(tempr,tempi)
          enddo
         enddo
        enddo
       enddo
       close(405,status='delete')    
      enddo 

      ! write file either unformatted or formatted
      if(l_unformatted) then
       open(405,file='WF1_gwf.anglmom',form='unformatted')
       write(405)anglmom
       close(405)
      else
       open(405,file='WF1_gwf.anglmom')
       write(405,*)'Matrix elements of angular momentum'
       write(405,'(3i5)')nbnd,nbnd,nkqpts
       do kq=1,nkqpts
        do i=1,nbnd
         do j=1,nbnd
          do d=1,3
           write(405,'(4i5,3x,2f18.12)')d,j,i,kq,
     >                                  anglmom(d,j,i,kq)
          enddo
         enddo
        enddo
       enddo
       close(405)
      endif

      deallocate(anglmom)

      end subroutine wann_gwf_anglmom
      end module m_wann_gwf_anglmom