LCOV - code coverage report
Current view: top level - wannier - wann_write_mmnk2.F (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 34 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 1 0.0 %

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

Generated by: LCOV version 1.13