wann_write_nabla.F 3.68 KB
Newer Older
1 2 3 4 5 6
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------

7 8 9
      module m_wann_write_nabla
      contains
      subroutine wann_write_nabla(
10
     >               fmpi_comm,l_p0,filename,title,
11
     >               nbnd,fullnkpts,nwfs,
Frank Freimuth's avatar
Frank Freimuth committed
12
     >               irank,isize,l_unformatted,
13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
     <               nablamat)
c*************************************************************
c     This subroutine is used to write several matrices to 
c     files: WF1.nabl, WF1.surfcurr, etc. The corresponding 
c     filename has to be provided as input. To be concrete
c     all explanations given in the following refer to
c     WF1.nabl/WF2.nabl.
c
c     MPI-Version: Collect the contributions to the matrix
c     grad^{k}_{mn} from the various processors.
c
c     Write the matrix grad^{k}_{mn} to file WF1.nabl/WF2.nabl
c
c     Frank Freimuth
c*************************************************************
28 29

      USE m_constants
30 31 32
#ifdef CPP_MPI
      USE mpi
#endif
33

34
      implicit none
35

36
      integer, intent(in)    :: fmpi_comm
37 38 39 40 41 42 43 44 45
      logical, intent(in)    :: l_p0
      character, intent(in)  :: filename*(*)
      character, intent(in)  :: title*(*)

      integer, intent(in)    :: nbnd
      integer, intent(in)    :: fullnkpts
      integer, intent(in)    :: nwfs

      integer, intent(in)    :: irank,isize
Frank Freimuth's avatar
Frank Freimuth committed
46
      logical, intent(in)    :: l_unformatted
47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70

      complex, intent(inout) :: nablamat(:,:,:,:)

      integer :: ikpt,i,j,k
      integer :: cpu_index
#ifdef CPP_MPI
      integer :: ierr(3)
      integer :: stt(MPI_STATUS_SIZE)
#include "cpp_double.h"
#endif

#ifdef CPP_MPI
c**********************************************************
c     Collect contributions to the nablamat matrix from the
c     various processors.
c**********************************************************
      if(isize.ne.1)then
       do ikpt=1,fullnkpts
        if(l_p0)then
         do cpu_index=1,isize-1
          if(mod(ikpt-1,isize).eq.cpu_index)then
           call MPI_RECV(
     &             nablamat(1:3,1:nbnd,1:nbnd,ikpt),nbnd*nbnd*3,
     &             CPP_MPI_COMPLEX,cpu_index,
71
     &             ikpt,fmpi_comm,stt,ierr(1))
72 73 74 75 76 77 78
          endif !processors
         enddo !cpu_index
        else
         if(mod(ikpt-1,isize).eq.irank)then
           call MPI_SEND(
     &             nablamat(1:3,1:nbnd,1:nbnd,ikpt),nbnd*nbnd*3,
     &             CPP_MPI_COMPLEX,0,
79
     &             ikpt,fmpi_comm,ierr(1))
80 81
         endif !processors
        endif ! l_p0
82
        call MPI_BARRIER(fmpi_comm,ierr(1))
83 84 85 86 87
       enddo !ikpt 
      endif !isize
#endif

      write(*,*)"wn: fullnkpts=",fullnkpts
88
      write(oUnit,*)"wn: fullnkpts=",fullnkpts
89 90

      if(l_p0)then
Frank Freimuth's avatar
Frank Freimuth committed
91 92 93 94 95
       if(l_unformatted)then
        open(305,file=trim(filename)//'_unf',form='unformatted')
        write(305)nbnd,nbnd,fullnkpts
        write(305)nablamat(1:3,1:nbnd,1:nbnd,1:fullnkpts)
       else !l_unformatted   
96 97 98 99 100 101 102 103 104 105 106 107 108 109
       open (305,file=filename)
       write (305,*)title
       write (305,'(3i5)') nbnd,nbnd,fullnkpts
       do ikpt=1,fullnkpts
       do i = 1,nbnd
        do j = 1,nbnd
         do k = 1,3  
          write (305,'(3i5,3x,2f18.12)') i,j,ikpt,
     &              real(nablamat(k,j,i,ikpt)),
     &              aimag(nablamat(k,j,i,ikpt))
         enddo !k
        enddo !j
       enddo !i
       enddo !ikpt
Frank Freimuth's avatar
Frank Freimuth committed
110
       endif !l_unformatted 
111 112 113 114 115
       close(305)
      endif

      end subroutine wann_write_nabla
      end module m_wann_write_nabla