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_matrix4
8 : use m_juDFT
9 : contains
10 0 : subroutine wann_write_matrix4(
11 : > fmpi_comm,l_p0,filename,title,
12 : > num_bands1,num_bands2,
13 : > num_dims,fullnkpts,
14 : > irank,isize,
15 0 : < matrix4)
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 :
27 : USE m_constants
28 : #ifdef CPP_MPI
29 : USE mpi
30 : #endif
31 :
32 : implicit none
33 :
34 : integer, intent(in) :: fmpi_comm
35 : logical, intent(in) :: l_p0
36 : character, intent(in) :: filename*(*)
37 : character, intent(in) :: title*(*)
38 :
39 : integer, intent(in) :: num_bands1
40 : integer, intent(in) :: num_bands2
41 :
42 : integer, intent(in) :: num_dims
43 : integer, intent(in) :: fullnkpts
44 :
45 : integer, intent(in) :: irank,isize
46 :
47 : complex, intent(inout) :: matrix4(:,:,:,:)
48 :
49 : integer :: ikpt,i,j,ii,jj
50 : integer :: cpu_index,dir
51 : #ifdef CPP_MPI
52 : integer :: ierr(3)
53 : integer :: stt(MPI_STATUS_SIZE)
54 :
55 : #endif
56 :
57 : #ifdef CPP_MPI
58 : c**********************************************************
59 : c Collect contributions to the matrix4 matrix from the
60 : c various processors.
61 : c**********************************************************
62 0 : call timestart("wann_write_matrix4")
63 0 : print*,"dim1=",size(matrix4,1)
64 0 : print*,"dim2=",size(matrix4,2)
65 0 : print*,"dim3=",size(matrix4,3)
66 0 : print*,"dim4=",size(matrix4,4)
67 0 : if(isize.ne.1)then
68 0 : do ikpt=1,fullnkpts
69 0 : if(l_p0)then
70 0 : do cpu_index=1,isize-1
71 0 : if(mod(ikpt-1,isize).eq.cpu_index)then
72 : call MPI_RECV(
73 : & matrix4(1:num_dims,1:num_bands1,
74 : & 1:num_bands2,ikpt),
75 : & num_bands1*num_bands2*num_dims,
76 : & MPI_DOUBLE_COMPLEX,cpu_index,
77 0 : & ikpt,fmpi_comm,stt,ierr(1))
78 : endif !processors
79 : enddo !cpu_index
80 : else
81 0 : if(mod(ikpt-1,isize).eq.irank)then
82 : call MPI_SEND(
83 : & matrix4(1:num_dims,1:num_bands1,
84 : & 1:num_bands2,ikpt),
85 : & num_bands1*num_bands2*num_dims,
86 : & MPI_DOUBLE_COMPLEX,0,
87 0 : & ikpt,fmpi_comm,ierr(1))
88 : endif !processors
89 : endif ! l_p0
90 0 : call MPI_BARRIER(fmpi_comm,ierr(1))
91 : enddo !ikpt
92 : endif !isize
93 : #endif
94 :
95 0 : write(oUnit,*)"wann_write_matrix4"
96 :
97 0 : if(l_p0)then
98 0 : open (305,file=filename)
99 0 : write (305,*)title
100 0 : write (305,'(3i5)') num_bands1,num_bands1,fullnkpts
101 0 : do ikpt=1,fullnkpts
102 0 : do i = 1,num_bands2
103 0 : do j = 1,num_bands1
104 0 : do dir=1,num_dims
105 0 : write (305,'(4i5,3x,2f18.12)') dir,j,i,ikpt,
106 0 : & real(matrix4(dir,j,i,ikpt)),
107 0 : & aimag(matrix4(dir,j,i,ikpt))
108 : enddo !dir
109 : enddo !j
110 : enddo !i
111 : enddo !ikpt
112 0 : close(305)
113 : endif
114 0 : call timestop("wann_write_matrix4")
115 0 : end subroutine wann_write_matrix4
116 : end module m_wann_write_matrix4
|