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