1!========================================================================= 2! 3! Utilities: 4! 5! (1) epsascbin() Originally by JLL Last Modified 5/5/2008 (JRD) 6! 7! This utility converts a ascii epsmat file to an binary epsmat file. 8! It uses the input file epsconv.inp 9! 10!========================================================================= 11 12#include "f_defs.h" 13 14program epsascbin 15 16 use global_m 17 implicit none 18 19! JRD adate should be 11 characters in v. 2 20 21 character :: ajname*6,adate*11,outfile*20 22 real(DP) :: ecuts1,ecuts2 23 real(DP), allocatable :: dFreqGrid(:) 24 Complex(DPC), allocatable :: dFreqBrd(:) 25 integer :: iunit,ig,im,iq,istart,j,jm, & 26 nfiles,ng1,ng2,ngq1,ngq2,nmtx1,nmtx2,nq,nqtot, & 27 ii,qgrid(3),freq_dep,nFreq,ijk 28 29 character*120, allocatable :: filename(:) 30 real(DP), allocatable :: ekin(:),q2(:,:) 31 SCALAR, allocatable :: eps(:) 32 SCALAR :: tmpc 33 integer, allocatable :: isort1(:),isort2(:),kx(:),ky(:),kz(:) 34 real(DP) :: tmp 35 integer :: itmp 36 37 logical :: file_exists 38 39 write(6,*) 'This routine should only be used on non-HDF5-based epsmat files.' 40 write(6,*) 'If you built with HDF5 support (which is ideal), or otherwise' 41 write(6,*) 'have HDF5-based epsmat files, you can use the h5dump command' 42 write(6,*) 'to see your data in ascii format.' 43 44 call open_file(55,file='epsconv.inp',form='formatted',status='old') 45 read(55,*) nqtot 46 SAFE_ALLOCATE(q2, (3,nqtot)) 47 read(55,'(a20)') outfile 48 write(6,*) 'Output -> ',outfile 49 write(6,*) 50 51!------------------------- 52! Find maximal values, and check consistency between 53! the input file and the epsmat files... 54 55 istart=1 56 ng1=0 57 ngq1=0 58 nmtx1=0 59 read(55,*) nfiles 60 SAFE_ALLOCATE(filename, (nfiles)) 61 do iunit=1,nfiles 62 read(55,'(a20)') filename(iunit) 63#ifdef HDF5 64 ! stop without error to allow the testsuite to run when compiled with -DHDF5 65 INQUIRE(FILE=filename(iunit), EXIST=file_exists) 66 if (.not. file_exists) then 67 write(0,'(a)') 'WARNING: File "' // trim(filename(iunit)) // '" does not exist. Stopping.' 68 stop 69 endif 70#endif 71 write(6,*) 'Checking file ',TRUNC(filename(iunit)) 72 call open_file(unit=11,file=filename(iunit),form='formatted',status='old') 73 74 read(11,'(1x,a6,1x,a11)') ajname,adate 75 if(ajname /= 'chiGG0') then 76 call die("Incorrect header '" // ajname // "' (must be 'chiGG0') in file '" // TRUNC(filename(iunit)) // "'") 77 endif 78 read(11,*) freq_dep,nFreq 79 if (freq_dep.ne.0) then 80 call die('epsascbin: freq_dep') 81 endif 82 read(11,*) (qgrid(ii),ii=1,3) 83 if (freq_dep.eq.2) then 84 SAFE_ALLOCATE(dFreqGrid,(nFreq)) 85 SAFE_ALLOCATE(dFreqBrd,(nFreq)) 86 read(11,*) (dFreqGrid(ijk),ijk=1,nFreq),(dFreqBrd(ijk),ijk=1,nFreq) 87 else 88 read(11,*) 89 endif 90 read(11,*) 91 read(11,*) 92 read(11,*) ecuts2 93 94 if(iunit == 1) then 95 ecuts1 = ecuts2 96 else 97 if(ecuts2.ne.ecuts1) then 98 write(0,*) 'The cut-off in previous file (',ecuts1,') does not match ', & 99 'the one in file ',TRUNC(filename(iunit)),' (',ecuts2,').' 100 call die('epsascbin cutoff mismatch') 101 endif 102 endif 103 104 read(11,*) nq,((q2(j,iq),j=1,3),iq=istart,istart+nq-1) 105 106 read(11,*) ng2, (tmp,ig=1,3*ng2) 107 if(ng1.eq.0) ng1=ng2 108 if(ng2.ne.ng1) then 109 call die('The number of G-vectors differs in epsmat files') 110 endif 111 112 do iq=istart,istart+nq-1 113 read(11,*) ngq2,nmtx2,(itmp, ig=1,2*ngq2) 114 if(ngq1.lt.ngq2) ngq1=ngq2 115 if(nmtx1.lt.nmtx2) nmtx1=nmtx2 116 read(11,*) (tmp,ig=1,ngq2) 117 read(11,*) (q2(j,iq),j=1,3) 118 do jm = 1, nmtx2 119 read(11,*) (tmpc,im=1,nmtx2) 120 enddo 121 enddo 122 123 istart=istart+nq 124 call close_file(11) 125 enddo 126 if(istart-1.ne.nqtot) then 127 write(0,*) 'found = ', istart - 1, ' expected ', nqtot 128 call die('Number of q-vectors found differs from number in input file.') 129 endif 130 131 SAFE_ALLOCATE(kx, (ng1)) 132 SAFE_ALLOCATE(ky, (ng1)) 133 SAFE_ALLOCATE(kz, (ng1)) 134 call open_file(unit=11,file=filename(1),form='formatted',status='old') 135 read(11,*) 136 read(11,*) freq_dep,nFreq 137 read(11,*) 138 read(11,*) 139 read(11,*) 140 read(11,*) 141 read(11,*) 142 read(11,*) itmp,(tmp,iq=1,3*itmp) 143 read(11,*) ng1,(kx(ig),ky(ig),kz(ig),ig=1,ng1) 144 call close_file(11) 145 SAFE_ALLOCATE(isort1, (ng1)) 146 SAFE_ALLOCATE(isort2, (ng1)) 147 SAFE_ALLOCATE(ekin, (ngq1)) 148 SAFE_ALLOCATE(eps, (nmtx1)) 149 150 call open_file(unit=12,file=outfile,form='unformatted',status='replace') 151 write(12) ajname,adate 152 write(12) freq_dep,nFreq 153 write(12) (qgrid(ii),ii=1,3) 154 if (freq_dep .eq. 2) then 155 write(12) (dFreqGrid(ijk),ijk=1,nFreq),(dFreqBrd(ijk),ijk=1,nFreq) 156 else 157 write(12) 158 endif 159 write(12) 160 write(12) 161 write(12) ecuts1 162 write(12) nqtot,((q2(j,iq),j=1,3),iq=1,nqtot) 163 write(12) ng1,(kx(ig),ky(ig),kz(ig),ig=1,ng1) 164 165 write(6,*) 166 istart=1 167 do iunit=1,nfiles 168 write(6,*) 'Dealing with file ',TRUNC(filename(iunit)) 169 call open_file(unit=11,file=filename(iunit),form='formatted',status='old') 170 171 read(11,*) 172 read(11,*) freq_dep,nFreq 173 read(11,*) 174 read(11,*) 175 read(11,*) 176 read(11,*) 177 read(11,*) 178 read(11,*) nq,(tmp,iq=1,3*nq) 179! write(6,*) 'Number of qs', nq 180 read(11,*) itmp,(tmp,iq=1,3*itmp) 181 do iq=istart,istart+nq-1 182 write(6,'(a,f9.6,3x,f9.6,3x,f9.6)') ' -> q=',(q2(j,iq),j=1,3) 183 read(11,*) ngq2,nmtx2,(isort1(ig),isort2(ig),ig=1,ngq2) 184 write(12) ngq2,nmtx2,(isort1(ig),isort2(ig),ig=1,ngq2) 185 read(11,*) (ekin(ig),ig=1,ngq2) 186 write(12) (ekin(ig),ig=1,ngq2) 187 read(11,*) 188 write(12) (q2(j,iq),j=1,3) 189 do jm =1, nmtx2 190 read(11,*) (eps(im),im=1,nmtx2) 191 write(12) (eps(im),im=1,nmtx2) 192 enddo 193 enddo 194 195 istart=istart+nq 196 call close_file(11) 197 enddo 198 call close_file(12) 199 200end program epsascbin 201