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
|