LCOV - code coverage report
Current view: top level - wannier - wann_write_mmnk.F (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 46 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_wann_write_mmnk
       8             :       contains
       9           0 :       subroutine wann_write_mmnk(
      10             :      >               mpi_comm,jspin2,l_p0,fullnkpts,nntot,wann,
      11           0 :      >               maptopair,pair_to_do,nbnd,bpt,gb,
      12             :      >               isize,irank,fending,
      13           0 :      <               mmnk,l_unformatted)
      14             : c**********************************************************
      15             : c     MPI-Version: Collect the contributions to the matrix
      16             : c     M^{k,b}_{mn} from the various processors.
      17             : c
      18             : c     Symmetry: Compose the M^{k,b}_{mn} matrix for the
      19             : c     full BZ from the pieces of the IBZ.
      20             : c
      21             : c     Write the matrix M^{k,b}_{mn} to file WF1.mmn/WF2.mmn
      22             : c     Frank Freimuth
      23             : c**********************************************************
      24             :       use m_types
      25             :       use m_juDFT
      26             :       implicit none
      27             :       integer, intent(in)     :: jspin2,mpi_comm
      28             :       logical, intent(in)     :: l_p0,l_unformatted
      29             :       integer, intent(in)     :: fullnkpts
      30             :       integer, intent(in)     :: nntot
      31             :       type(t_wann),intent(in) :: wann
      32             : 
      33             :       integer, intent(in)     :: maptopair(:,:,:) !maptopair(3,fullnkpts,nntot)
      34             :       integer, intent(in)     :: pair_to_do(:,:)  !pair_to_do(fullnkpts,nntot)
      35             :       integer, intent(in)     :: nbnd
      36             :       integer, intent(in)     :: bpt(:,:)
      37             :       integer, intent(in)     :: gb(:,:,:)
      38             : 
      39             :       integer, intent(in)     :: isize,irank
      40             :       
      41             :       CHARACTER(len=12), INTENT(IN) :: fending  !for file ending !QPOINTS
      42             : 
      43             :       complex, intent(inout)  :: mmnk(:,:,:,:) !mmnk(nbnd,nbnd,nntot,fullnkpts)
      44             : 
      45             :       integer          :: ikpt,i,j
      46             :       integer          :: ikpt_b
      47             :       character(len=3) :: spin12(2)
      48             :       integer          :: cpu_index
      49             :       data   spin12/'WF1' , 'WF2'/
      50             : 
      51             : #ifdef CPP_MPI
      52             :       include 'mpif.h'
      53             :       integer :: ierr(3)
      54             :       integer :: stt(MPI_STATUS_SIZE)
      55             : #include "cpp_double.h"
      56             : #endif
      57             : 
      58             : #ifdef CPP_MPI
      59             : c******************************************************
      60             : c     Collect contributions to the mmnk matrix from the
      61             : c     various processors.
      62             : c******************************************************
      63           0 :       if(isize.ne.1)then
      64           0 :       do ikpt=1,fullnkpts
      65           0 :        if(l_p0)then
      66           0 :         do cpu_index=1,isize-1
      67           0 :          if(mod(ikpt-1,isize).eq.cpu_index)then
      68           0 :           do ikpt_b=1,nntot !nearest neighbors
      69           0 :            if(pair_to_do(ikpt,ikpt_b).ne.0)then
      70             :              call MPI_RECV(
      71             :      &               mmnk(1:nbnd,1:nbnd,ikpt_b,ikpt),nbnd*nbnd,
      72             :      &               CPP_MPI_COMPLEX,cpu_index,5*fullnkpts+
      73           0 :      &               pair_to_do(ikpt,ikpt_b),mpi_comm,stt,ierr)
      74             : 
      75             :            endif !pairtodo
      76             :           enddo !nearest neighbors
      77             :          endif !processors
      78             :         enddo !cpu_index
      79             :        else
      80           0 :         if(mod(ikpt-1,isize).eq.irank)then
      81           0 :          do ikpt_b=1,nntot !loop over nearest neighbors
      82           0 :           if(pair_to_do(ikpt,ikpt_b).ne.0)then
      83             :             call MPI_SEND(
      84             :      &              mmnk(1:nbnd,1:nbnd,ikpt_b,ikpt),
      85             :      &              nbnd*nbnd,CPP_MPI_COMPLEX,0,5*fullnkpts+
      86           0 :      &              pair_to_do(ikpt,ikpt_b),mpi_comm,ierr)
      87             :           endif !pairtodo
      88             :          enddo !loop over nearest neighbors
      89             :         endif !processors
      90             :        endif ! l_p0
      91           0 :        call MPI_BARRIER(mpi_comm,ierr)
      92             :       enddo !ikpt
      93             :       endif !isize
      94             : #endif
      95             : 
      96             : c****************************************************
      97             : c     Symmetry: complete the mmnk matrix.
      98             : c****************************************************
      99           0 :       if(l_p0)then 
     100           0 :        do ikpt=1,fullnkpts
     101           0 :         do ikpt_b=1,nntot
     102           0 :          if(pair_to_do(ikpt,ikpt_b).eq.0)then
     103           0 :           if(maptopair(3,ikpt,ikpt_b).eq.1)then !conjugation selection
     104             :              mmnk(:,:,ikpt_b,ikpt)=conjg(transpose(mmnk(:,:,
     105           0 :      &          maptopair(2,ikpt,ikpt_b),maptopair(1,ikpt,ikpt_b))))
     106           0 :           elseif(maptopair(3,ikpt,ikpt_b).eq.2)then !rotation
     107             :              mmnk(:,:,ikpt_b,ikpt)=mmnk(:,:,maptopair
     108           0 :      &         (2,ikpt,ikpt_b),maptopair(1,ikpt,ikpt_b))
     109           0 :           elseif(maptopair(3,ikpt,ikpt_b).eq.3)then !rotation&reflection
     110             :              mmnk(:,:,ikpt_b,ikpt)=conjg( mmnk(:,:,maptopair
     111           0 :      &         (2,ikpt,ikpt_b),maptopair(1,ikpt,ikpt_b)) )
     112             :           else !something wrong
     113           0 :              call juDFT_error('maptopair')
     114             :           endif!maptopair
     115             :          endif!pairtodo
     116             :         enddo!ikpt_b
     117             :        enddo!ikpt
     118             :       endif
     119             : 
     120             : c******************************************************
     121             : c     Write mmnk matrix to file.
     122             : c******************************************************
     123           0 :       if (l_p0) then
     124           0 :        if(.not.l_unformatted) then
     125           0 :        open (305,file=spin12(jspin2)//trim(fending)//'.mmn')
     126           0 :        write (305,*) 'Overlaps of the wavefunct. the k- and b-points'
     127           0 :        write (305,'(3i5)') nbnd,fullnkpts,nntot
     128           0 :        do ikpt = 1,fullnkpts
     129           0 :         do ikpt_b = 1,nntot
     130           0 :          write (305,'(2i5,3x,3i4)') ikpt,bpt(ikpt_b,ikpt),
     131           0 :      &                                  gb(1:3,ikpt_b,ikpt)
     132           0 :          do i = 1,nbnd
     133           0 :           do j = 1,nbnd
     134             : c           write (305,'(2f18.12)')
     135             :            write (305,'(2f24.18)')
     136           0 :      &         real(mmnk(j,i,ikpt_b,ikpt)),-aimag(mmnk(j,i,ikpt_b,ikpt))
     137             :           enddo
     138             :          enddo
     139             :         enddo
     140             :        enddo !ikpt
     141           0 :        close (305)
     142             :        else
     143             :        open (305,file=spin12(jspin2)//trim(fending)//'.mmn',
     144           0 :      >       form='unformatted')
     145           0 :        write (305) nbnd,fullnkpts,nntot
     146           0 :        write (305) bpt,gb
     147           0 :        write (305) conjg(mmnk)
     148           0 :        close (305)
     149             :        endif
     150             :       endif !l_p0
     151             : 
     152           0 :       end subroutine wann_write_mmnk
     153             :       end module m_wann_write_mmnk

Generated by: LCOV version 1.13