Line data Source code
1 : c**************************c
2 : c write out uHu matrix c
3 : c**************************c
4 : module m_wann_write_uHu
5 : contains
6 0 : subroutine wann_write_uHu(
7 : > jspin2,l_p0,fullnkpts,nntot,nntot2,wann,
8 : > nbnd,bpt,gb,isize,irank,fending,ftype,
9 0 : < uHu_in,nkpt_loc,counts,displs,nnodes,
10 : > l_unformatted,l_symcc,l_check)
11 : use m_types
12 : use m_wann_uHu_symcheck
13 : #ifdef CPP_MPI
14 : use mpi
15 : #endif
16 :
17 : implicit none
18 : integer, intent(in) :: jspin2
19 : logical, intent(in) :: l_p0,l_unformatted,l_symcc,l_check
20 : integer, intent(in) :: fullnkpts,nkpt_loc
21 : integer, intent(in) :: nntot,nntot2,nnodes
22 : type(t_wann),intent(in) :: wann
23 :
24 : integer, intent(in) :: nbnd
25 : integer, intent(in) :: bpt(nntot,fullnkpts)
26 : integer, intent(in) :: gb(3,nntot,fullnkpts)
27 : integer, intent(in) :: counts(0:nnodes-1),displs(0:nnodes-1)
28 :
29 : integer, intent(in) :: isize,irank
30 :
31 : CHARACTER(len=12), INTENT(IN) :: fending !for file ending
32 : CHARACTER(len=*), INTENT(IN) :: ftype
33 : complex, intent(inout) :: uHu_in(nbnd,nbnd,nntot2,nntot,nkpt_loc)
34 :
35 0 : complex, allocatable :: uHu(:,:,:,:,:)
36 : integer :: ikpt,i,j,length
37 : integer :: ikpt_b,ikpt_b2
38 : character(len=3) :: spin12(2)
39 : integer :: cpu_index
40 : character(len=60) :: header
41 : data spin12/'WF1' , 'WF2'/
42 :
43 : #ifdef CPP_MPI
44 : integer :: ierr
45 : integer :: stt(MPI_STATUS_SIZE)
46 : #endif
47 :
48 0 : if(isize.gt.1) then
49 0 : if(l_p0) allocate(uHu(nbnd,nbnd,nntot2,nntot,fullnkpts))
50 : #ifdef CPP_MPI
51 : c******************************************************
52 : c Collect contributions to the mmnk matrix from the
53 : c various processors.
54 : c******************************************************
55 0 : length = nbnd*nbnd*nntot2*nntot
56 0 : CALL MPI_BARRIER(MPI_COMM_WORLD,ierr)
57 : CALL MPI_GATHERV(
58 : > uHu_in,length*nkpt_loc,MPI_DOUBLE_COMPLEX,
59 : > uHu,length*counts,length*displs,MPI_DOUBLE_COMPLEX,
60 0 : > 0,MPI_COMM_WORLD,ierr)
61 : #else
62 : c uHu = uHu_in
63 : #endif
64 : endif
65 :
66 0 : header='Elements uHu at k+b1 and k+b2'
67 :
68 : c******************************************************
69 : c Write mmnk matrix to file.
70 : c******************************************************
71 0 : if (l_p0) then
72 0 : write(*,*)'symmetry-complete uHu: ',l_symcc
73 :
74 0 : if(l_symcc.and.(nntot.ne.nntot2)) stop 'wann_write_uHu'
75 :
76 : if(.false. .and. l_symcc) then
77 : ! exploit symmetry to complete matrix
78 : do ikpt = 1,fullnkpts
79 : do ikpt_b = 1,nntot
80 : do ikpt_b2 = 1,ikpt_b-1
81 : do i=1,nbnd
82 : do j=1,nbnd
83 : if(isize.gt.1) then
84 : uHu(j,i,ikpt_b,ikpt_b2,ikpt)
85 : > = conjg(uHu(i,j,ikpt_b2,ikpt_b,ikpt))
86 : else
87 : uHu_in(j,i,ikpt_b,ikpt_b2,ikpt)
88 : > = conjg(uHu_in(i,j,ikpt_b2,ikpt_b,ikpt))
89 : endif
90 : enddo
91 : enddo
92 : enddo
93 : enddo
94 : enddo
95 : endif
96 :
97 0 : if(.not.l_unformatted) then
98 : open (305,file=spin12(jspin2)//trim(fending)//'.uHu'
99 0 : > //trim(ftype))
100 0 : write (305,*) 'Elements uHu at k+b1 and k+b2'
101 0 : write (305,'(4i5)') nbnd,fullnkpts,nntot,nntot2
102 0 : write (305,*)" "
103 0 : write (305,*)" "
104 0 : do ikpt = 1,fullnkpts
105 0 : do ikpt_b = 1,nntot
106 0 : do ikpt_b2 = 1,nntot2
107 : ! write(305,'(i6,i6,i6)')ikpt,ikpt_b,ikpt_b2
108 0 : do i = 1,nbnd
109 0 : do j = 1,nbnd
110 0 : if(isize.gt.1) then
111 : write (305,'(2f24.18)')
112 0 : & real(uHu(j,i,ikpt_b2,ikpt_b,ikpt)),
113 : ! & -aimag(uHu(j,i,ikpt_b2,ikpt_b,ikpt))
114 0 : & aimag(uHu(j,i,ikpt_b2,ikpt_b,ikpt))
115 : else
116 : write (305,'(2f24.18)')
117 0 : & real(uHu_in(j,i,ikpt_b2,ikpt_b,ikpt)),
118 : ! & -aimag(uHu_in(j,i,ikpt_b2,ikpt_b,ikpt))
119 0 : & aimag(uHu_in(j,i,ikpt_b2,ikpt_b,ikpt))
120 : endif
121 : enddo
122 : enddo
123 : enddo
124 : enddo
125 : enddo !ikpt
126 0 : close (305)
127 : else
128 : open (305,file=spin12(jspin2)//trim(fending)//'.uHu'
129 0 : > //trim(ftype),form='unformatted')
130 0 : write (305) header
131 0 : write (305) nbnd,fullnkpts,nntot !,nntot2
132 : ! write (305) bpt,gb
133 0 : do ikpt = 1,fullnkpts
134 0 : do ikpt_b = 1,nntot
135 0 : do ikpt_b2 = 1,nntot2
136 0 : if(isize.gt.1) then
137 : ! write (305) conjg(uHu)
138 0 : write (305) uHu(:,:,ikpt_b2,ikpt_b,ikpt)
139 : else
140 : ! write (305) conjg(uHu_in)
141 0 : write (305) uHu_in(:,:,ikpt_b2,ikpt_b,ikpt)
142 : endif
143 :
144 : enddo
145 : enddo
146 : enddo
147 :
148 0 : close(305)
149 : endif
150 :
151 :
152 0 : if((trim(ftype).ne.'_kq').and.l_check) then
153 0 : write(*,*)'perform symcheck...'
154 0 : if(isize.gt.1) then
155 0 : CALL wann_uHu_symcheck(uHu,nbnd,nntot,nntot2,fullnkpts)
156 : else
157 0 : CALL wann_uHu_symcheck(uHu_in,nbnd,nntot,nntot2,fullnkpts)
158 : endif
159 : endif
160 :
161 : endif !l_p0
162 :
163 0 : if(allocated(uHu)) deallocate( uHu )
164 :
165 : #ifdef CPP_MPI
166 0 : CALL MPI_BARRIER(MPI_COMM_WORLD,ierr)
167 : #endif
168 :
169 0 : end subroutine wann_write_uHu
170 : end module m_wann_write_uHu
|
