LCOV - code coverage report
Current view: top level - wannier - wann_write_matrix5.F (source / functions) Hit Total Coverage
Test: FLEUR test coverage Lines: 0 34 0.0 %
Date: 2024-03-28 04:22:06 Functions: 0 1 0.0 %

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

Generated by: LCOV version 1.14