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