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_nabla
       8             :       contains
       9           0 :       subroutine wann_write_nabla(
      10             :      >               mpi_comm,l_p0,filename,title,
      11             :      >               nbnd,fullnkpts,nwfs,
      12             :      >               irank,isize,
      13           0 :      <               nablamat)
      14             : c*************************************************************
      15             : c     This subroutine is used to write several matrices to 
      16             : c     files: WF1.nabl, WF1.surfcurr, etc. The corresponding 
      17             : c     filename has to be provided as input. To be concrete
      18             : c     all explanations given in the following refer to
      19             : c     WF1.nabl/WF2.nabl.
      20             : c
      21             : c     MPI-Version: Collect the contributions to the matrix
      22             : c     grad^{k}_{mn} from the various processors.
      23             : c
      24             : c     Write the matrix grad^{k}_{mn} to file WF1.nabl/WF2.nabl
      25             : c
      26             : c     Frank Freimuth
      27             : c*************************************************************
      28             :       implicit none
      29             :       integer, intent(in)    :: mpi_comm
      30             :       logical, intent(in)    :: l_p0
      31             :       character, intent(in)  :: filename*(*)
      32             :       character, intent(in)  :: title*(*)
      33             : 
      34             :       integer, intent(in)    :: nbnd
      35             :       integer, intent(in)    :: fullnkpts
      36             :       integer, intent(in)    :: nwfs
      37             : 
      38             :       integer, intent(in)    :: irank,isize
      39             : 
      40             :       complex, intent(inout) :: nablamat(:,:,:,:)
      41             : 
      42             :       integer :: ikpt,i,j,k
      43             :       integer :: cpu_index
      44             : #ifdef CPP_MPI
      45             :       include 'mpif.h'
      46             :       integer :: ierr(3)
      47             :       integer :: stt(MPI_STATUS_SIZE)
      48             : #include "cpp_double.h"
      49             : #endif
      50             : 
      51             : #ifdef CPP_MPI
      52             : c**********************************************************
      53             : c     Collect contributions to the nablamat matrix from the
      54             : c     various processors.
      55             : c**********************************************************
      56           0 :       if(isize.ne.1)then
      57           0 :        do ikpt=1,fullnkpts
      58           0 :         if(l_p0)then
      59           0 :          do cpu_index=1,isize-1
      60           0 :           if(mod(ikpt-1,isize).eq.cpu_index)then
      61             :            call MPI_RECV(
      62             :      &             nablamat(1:3,1:nbnd,1:nbnd,ikpt),nbnd*nbnd*3,
      63             :      &             CPP_MPI_COMPLEX,cpu_index,
      64           0 :      &             ikpt,mpi_comm,stt,ierr)
      65             :           endif !processors
      66             :          enddo !cpu_index
      67             :         else
      68           0 :          if(mod(ikpt-1,isize).eq.irank)then
      69             :            call MPI_SEND(
      70             :      &             nablamat(1:3,1:nbnd,1:nbnd,ikpt),nbnd*nbnd*3,
      71             :      &             CPP_MPI_COMPLEX,0,
      72           0 :      &             ikpt,mpi_comm,ierr)
      73             :          endif !processors
      74             :         endif ! l_p0
      75           0 :         call MPI_BARRIER(mpi_comm,ierr)
      76             :        enddo !ikpt 
      77             :       endif !isize
      78             : #endif
      79             : 
      80           0 :       write(*,*)"wn: fullnkpts=",fullnkpts
      81           0 :       write(6,*)"wn: fullnkpts=",fullnkpts
      82             : 
      83           0 :       if(l_p0)then
      84           0 :        open (305,file=filename)
      85           0 :        write (305,*)title
      86           0 :        write (305,'(3i5)') nbnd,nbnd,fullnkpts
      87           0 :        do ikpt=1,fullnkpts
      88           0 :        do i = 1,nbnd
      89           0 :         do j = 1,nbnd
      90           0 :          do k = 1,3  
      91           0 :           write (305,'(3i5,3x,2f18.12)') i,j,ikpt,
      92           0 :      &              real(nablamat(k,j,i,ikpt)),
      93           0 :      &              aimag(nablamat(k,j,i,ikpt))
      94             :          enddo !k
      95             :         enddo !j
      96             :        enddo !i
      97             :        enddo !ikpt
      98           0 :        close(305)
      99             :       endif
     100             : 
     101           0 :       end subroutine wann_write_nabla
     102             :       end module m_wann_write_nabla