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