1!==============================================================================================
2!
3! Utilities:
4!
5! (1) printchi           Originally By JRD               Last Modified 6/30/2008 (JRD)
6!
7!==============================================================================================
8
9#include "f_defs.h"
10
11program printchi
12
13  use global_m
14  implicit none
15
16  integer, allocatable :: irow(:), isrtx(:)
17  real(DP) :: tnp(200, 3)
18  real(DP), allocatable :: ekinx(:)
19  integer :: ii, jj, nmtx, ntranq, mtrx(200, 3, 3), kg0(200, 3), ttt
20
21  SCALAR, allocatable :: eps(:,:)
22
23  character :: ajname*6, adate*11
24  character :: aheadinput*6
25  integer :: ps, ps2, np, i, k, j, n, nband
26  integer :: freq_dep, nfreq, kgrid(3), nrk, ng, nFFTgridpts, FFTgrid(3), nq, indexq0
27  real(DP) :: initfreq, deltafreq, brdning, ecuts, bdot(3, 3)
28  integer, allocatable :: kgg(:, :), index_vec(:)
29  real(DP), allocatable :: qpt(:, :)
30
31
32
33  write(6,*) 'Welcome to Chi Printing'
34  call open_file(unit=10,file='chi0mat',form='unformatted',status='old')
35  ttt=1
36  !       call open_file(unit=10,file='chi0mat',form='unformatted',status='old')
37  !  ttt=nq-1! nq is number of q points in epsilon.inp
38  call open_file(unit=11,file='chi.gconv',status='replace')
39
40  !       call open_file(unit=6, file='temp.dat')
41
42  !       write(6, *) 1111
43
44  !--------------------------
45  ! Now read chi0mat
46
47  !       read(10)
48  !       read(10) ii
49  !       if (ii.ne.0) then
50  !         call die('Full frequency dependence not supported')
51  !       endif
52  !       read(10)
53  !       read(10)
54  !       read(10)
55  !       read(10)
56  !       read(10)
57  !       read(10)
58  !       read(10) nold
59  !       read(10)
60  !       read(10)
61  !       read(10) nge
62  !       rewind(10)
63  ! !      deallocate(oldx)
64  !       SAFE_ALLOCATE(oldx, (nold))
65  ! !      deallocate(oldy)
66  !       SAFE_ALLOCATE(oldy, (nold))
67  ! !      deallocate(oldz)
68  !       SAFE_ALLOCATE(oldz, (nold))
69  ! !      deallocate(ekold)
70  ! !      allocate(ekold(nge))
71  ! !      deallocate(isrtold)
72  !       SAFE_ALLOCATE(isrtold, (nge))
73  ! !      deallocate(isrtq)
74  ! !      allocate(isrtq(nge))
75  ! !      deallocate(isrtq)
76  !       SAFE_ALLOCATE(isrtq, (nge))
77
78  read(10) aheadinput,ajname,adate
79  write(11, *) 'line-1'
80  write(11, *) aheadinput,ajname,adate
81  read(10) freq_dep, nFreq, InitFreq, &
82       DeltaFreq,Brdning
83  write(11, *) 'line-2'
84  write(11, *) freq_dep, nFreq, InitFreq, &
85       DeltaFreq,Brdning
86  read(10) (kgrid(i),i=1,3)
87  write(11, *) 'line-3'
88  write(11, *) (kgrid(i),i=1,3)
89  read(10)
90  write(11, *) 'line-4'
91  write(11, *)
92  read(10)
93  write(11, *) 'line-5'
94  write(11, *)
95  read(10)
96  write(11, *) 'line-6'
97  write(11, *)
98  read(10) ecuts, nband
99  write(11, *) 'line-7'
100  write(11, *) ecuts, nband
101  read(10) nrk ! also invflag is here, but not needed
102  write(11, *) 'line-8'
103  write(11, *) nrk, 1 ! invflag
104  read(10) ng, nFFTgridpts
105  SAFE_ALLOCATE(kgg, (3, ng))
106  SAFE_ALLOCATE(index_vec, (nFFTgridpts))
107  backspace(10)
108  read(10) ng,nFFTgridpts,(FFTgrid(i),i=1,3), &
109       ((kgg(j,i),j=1,3),i=1,ng), &
110       ((bdot(i,j),j=1,3),i=1,3),(index_vec(i),i=1,nFFTgridpts)
111  write(11, *) 'line-9'
112  write(11, *) ng,nFFTgridpts,(FFTgrid(i),i=1,3), &
113       ((kgg(j,i),j=1,3),i=1,ng), &
114       ((bdot(i,j),j=1,3),i=1,3),(index_vec(i),i=1,nFFTgridpts)
115  read(10) nq
116  SAFE_ALLOCATE(qpt, (3, nq))
117  backspace(10)
118  read(10) nq,indexq0,((qpt(j,i),j=1,3),i=1,nq)
119  write(11, *) 'line-10'
120  write(11, *) nq,indexq0,((qpt(j,i),j=1,3),i=1,nq)
121  SAFE_DEALLOCATE(kgg)
122  SAFE_DEALLOCATE(index_vec)
123  SAFE_DEALLOCATE(qpt)
124
125  !       write(6, *) 'temp1'
126
127  ! Read q->0 dielectric matrix
128  do ps2=1, ttt
129     mtrx=0
130     tnp=0.0d0
131     kg0=0
132     read(10) ntranq
133     backspace(10)
134
135     read(10) ntranq, (((mtrx(n,i,j),i=1,3),j=1,3), &
136          (tnp(n,k), &
137          kg0(n,k),k=1,3),n=1,ntranq)
138     write(11, *) 'line-11', ps2
139     write(11, *) ntranq, (((mtrx(n,i,j),i=1,3),j=1,3), &
140          (tnp(n,k), &
141          kg0(n,k),k=1,3),n=1,ntranq)
142     read(10) nmtx
143     backspace(10)
144     SAFE_ALLOCATE(isrtx, (ng))
145     SAFE_ALLOCATE(ekinx, (ng))
146     SAFE_ALLOCATE(irow, (nmtx))
147     read(10) nmtx, np,(isrtx(i),ekinx(i),i=1 &
148          ,ng),(irow(i),i=1,nmtx)
149     write(11, *) 'line-12', ps2
150     write(11, *) nmtx, np,(isrtx(i),ekinx(i),i=1 &
151          ,ng),(irow(i),i=1,nmtx)
152     SAFE_ALLOCATE(eps, (nmtx,nmtx))
153     write(11, *) 'line-13', ps2
154     do jj = 1, nmtx
155        read(10) (eps(ii,jj),ii=1,nmtx)
156        do ps=1, nmtx
157           write(11,*) jj, eps(ps,jj)
158        end do
159     enddo
160     FLUSH(11)
161     SAFE_DEALLOCATE(eps)
162     SAFE_DEALLOCATE(isrtx)
163     SAFE_DEALLOCATE(ekinx)
164     SAFE_DEALLOCATE(irow)
165  end do
166  !      read(10) (totalreal,ii=1,nge)
167  call close_file(10)
168  call close_file(11)
169
170end program printchi
171