Line data    Source code

       1             :       module m_wann_write_mmnk2
       2             : #ifdef CPP_MPI 
       3             :       use mpi 
       4             : #endif
       5             :       contains
       6           0 :       subroutine wann_write_mmnk2(
       7             :      >               l_p0,fullnkpts,nntot_q,wann,
       8           0 :      >               nbnd,bpt_q,gb_q,isize,irank,
       9           0 :      >               fname,mmnk_q,l_unformatted)
      10             : c**********************************************************
      11             : 
      12             : c**********************************************************
      13             :       use m_types
      14             :       implicit none
      15             :       logical, intent(in)     :: l_p0,l_unformatted
      16             :       integer, intent(in)     :: fullnkpts
      17             :       integer, intent(in)     :: nntot_q
      18             :       type(t_wann),intent(in) :: wann
      19             : 
      20             :       integer, intent(in)     :: nbnd
      21             :       integer, intent(in)     :: bpt_q(:)
      22             :       integer, intent(in)     :: gb_q(:,:)
      23             : 
      24             :       integer, intent(in)     :: isize,irank
      25             :       
      26             :       CHARACTER(len=30), INTENT(IN) :: fname
      27             :       complex, intent(in)  :: mmnk_q(:,:,:,:)
      28             : 
      29             :       integer          :: ikpt,i,j
      30             :       integer          :: ikpt_b
      31             :       character(len=3) :: spin12(2)
      32             :       integer          :: cpu_index
      33             :       data   spin12/'WF1' , 'WF2'/
      34             : 
      35             : #ifdef CPP_MPI
      36             :       integer :: ierr(3)
      37             :       integer :: stt(MPI_STATUS_SIZE)
      38             : #endif
      39             : 
      40           0 :       call timestart("wann_write_mmnk2")
      41             : 
      42             : #ifdef CPP_MPI
      43             : c******************************************************
      44             : c     Collect contributions to the mmnk matrix from the
      45             : c     various processors.
      46             : c******************************************************
      47           0 :       if(isize.ne.1)then
      48           0 :       do ikpt=1,fullnkpts
      49           0 :        if(l_p0)then
      50           0 :         do cpu_index=1,isize-1
      51           0 :          if(mod(ikpt-1,isize).eq.cpu_index)then
      52           0 :           do ikpt_b=1,nntot_q !nearest neighbors
      53             :              call MPI_RECV(
      54             :      &               mmnk_q(1:nbnd,1:nbnd,ikpt_b,ikpt),nbnd*nbnd,
      55             :      &               MPI_DOUBLE_COMPLEX,cpu_index,5*fullnkpts,
      56           0 :      &               MPI_COMM_WORLD,stt,ierr(1))
      57             : 
      58             :           enddo !nearest neighbors
      59             :          endif !processors
      60             :         enddo !cpu_index
      61             :        else
      62           0 :         if(mod(ikpt-1,isize).eq.irank)then
      63           0 :          do ikpt_b=1,nntot_q !loop over nearest neighbors
      64             :             call MPI_SEND(
      65             :      &              mmnk_q(1:nbnd,1:nbnd,ikpt_b,ikpt),
      66             :      &              nbnd*nbnd,MPI_DOUBLE_COMPLEX,0,5*fullnkpts,
      67           0 :      &              MPI_COMM_WORLD,ierr(1))
      68             :          enddo !loop over nearest neighbors
      69             :         endif !processors
      70             :        endif ! l_p0
      71           0 :        call MPI_BARRIER(MPI_COMM_WORLD,ierr(1))
      72             :       enddo !ikpt
      73             :       endif !isize
      74             : #endif
      75             : 
      76             : 
      77             : c******************************************************
      78             : c     Write mmnk matrix to file.
      79             : c******************************************************
      80           0 :       if (l_p0) then
      81           0 :         if(.not.l_unformatted) then
      82           0 :          open(305,file=trim(fname))
      83           0 :          write(305,*)'Overlaps between parameter points'
      84           0 :          write(305,'(3i5)')nbnd,fullnkpts,nntot_q
      85           0 :          do ikpt=1,fullnkpts
      86           0 :             do ikpt_b=1,nntot_q
      87           0 :                write(305,'(2i5,3x,3i4)')ikpt,bpt_q(ikpt_b),
      88           0 :      >                                  gb_q(1:3,ikpt_b)
      89           0 :             do i=1,nbnd
      90           0 :                do j=1,nbnd
      91             :                   write(305,'(2f24.18)')
      92           0 :      >             real(mmnk_q(j,i,ikpt_b,ikpt)),
      93           0 :      >            -aimag(mmnk_q(j,i,ikpt_b,ikpt))
      94             :                enddo
      95             :             enddo
      96             :             enddo
      97             :          enddo
      98           0 :          close(305)
      99             :         else
     100           0 :          open(305,file=trim(fname),form='unformatted')
     101           0 :          write(305)nbnd,fullnkpts,nntot_q
     102           0 :          write(305)bpt_q,gb_q
     103           0 :          write(305)conjg(mmnk_q)     
     104           0 :          close(305)
     105             :         endif
     106             :       endif !l_p0
     107           0 :       call timestop("wann_write_mmnk2")
     108           0 :       end subroutine wann_write_mmnk2
     109             :       end module m_wann_write_mmnk2