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