read_io_header split from plot_io in order to avoid fake allocations otherwise

needed when calling plot_io with iflag=0


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@527 c92efa57-630b-4861-b058-cf58834340f0

PP/average.f90

@@ -114,10 +114,8 @@ program average
 
 1100 call errore ('average', 'readin input', abs (ios) )
 
-  call plot_io (filename (1), title, nrx1, nrx2, nrx3, nr1, nr2, &
-       nr3, nat, ntyp, ibrav, celldm, at, gcutm, dual, ecutwfc, &
-       plot_num, atm, ityp, zv, tau, rhodum, 0)
-
+  call read_io_header(filename (1), title, nrx1, nrx2, nrx3, nr1, nr2, nr3, &
+                nat, ntyp, ibrav, celldm, at, gcutm, dual, ecutwfc, plot_num)
   nspin = 1
   if (ibrav.gt.0) call latgen (ibrav, celldm, at (1, 1), &
                                        at (1, 2), at (1, 3), omega )

PP/chdens.f90

@@ -172,26 +172,12 @@ program chdens
   ! Read the header and allocate objects
   !
 
-  !
-  ! ... workaround for not yet allocated arrays
-  !
-  
-  allocate(tau (3, nat))
-  allocate(ityp(nat))
-  allocate(rhor(nrx1*nrx2*nrx3))
-  
-  call plot_io (filepp (1), title, nrx1, nrx2, nrx3, nr1, nr2, nr3, &
-                nat, ntyp, ibrav, celldm, at, gcutm, dual, ecutwfc, &
-                plot_num, atm, ityp, zv, tau, rhodum, 0)
-  
+  call read_io_header(filepp (1), title, nrx1, nrx2, nrx3, nr1, nr2, nr3, &
+                nat, ntyp, ibrav, celldm, at, gcutm, dual, ecutwfc, plot_num )
   !
   ! ... see comment above
   !
   
-  deallocate( tau )
-  deallocate( ityp )
-  deallocate( rhor )
-  
   allocate(tau (3, nat))
   allocate(ityp(nat))
   allocate(rhor(nrx1*nrx2*nrx3))

PP/plot_io.f90

@@ -14,7 +14,6 @@ subroutine plot_io (filplot, title, nrx1, nrx2, nrx3, nr1, nr2, &
   !
   !     iflag >0 : write header and the quantity to be plotted ("plot")
   !                on file "filplot"
-  !     iflag= 0 : read only the header and not "plot"
   !     iflag< 0 : read everything (requires that all variables that are
   !                read are allocated with the correct dimensions!)
   !
@@ -34,16 +33,14 @@ subroutine plot_io (filplot, title, nrx1, nrx2, nrx3, nr1, nr2, &
   if (filplot == ' ') call errore ('plot_io', 'filename missing', 1)
   !
   iunplot = 4
+  if (iflag == 0 ) call errore('plot_io',&
+                        ' iflag==0 not allowed, use read_io_header ',1)
   if (iflag > 0) then
      WRITE( stdout, '(5x,"Writing data on file  ",a)') filplot
      open (unit = iunplot, file = filplot, form = 'formatted', &
           status = 'unknown', err = 100, iostat = ios)
   else
-     if (iflag < 0) then
-        WRITE( stdout, '(5x,"Reading data from file  ",a)') filplot
-     else
-        WRITE( stdout, '(5x,"Reading header from file  ",a)') filplot
-     endif
+     WRITE( stdout, '(5x,"Reading data from file  ",a)') filplot
      open (unit = iunplot, file = filplot, form = 'formatted', &
           status = 'old', err = 100, iostat = ios)
   endif
@@ -53,8 +50,7 @@ subroutine plot_io (filplot, title, nrx1, nrx2, nrx3, nr1, nr2, &
   rewind (iunplot)
   if (iflag > 0) then
      write (iunplot, '(a)') title
-     write (iunplot, '(8i8)') nrx1, nrx2, nrx3, nr1, nr2, nr3, nat, &
-          ntyp
+     write (iunplot, '(8i8)') nrx1, nrx2, nrx3, nr1, nr2, nr3, nat, ntyp
      write (iunplot, '(i6,6f12.8)') ibrav, celldm
      if (ibrav == 0) then
         do i = 1,3
@@ -78,15 +74,53 @@ subroutine plot_io (filplot, title, nrx1, nrx2, nrx3, nr1, nr2, &
         enddo
      endif
      read (iunplot, * ) gcutm, dual, ecut, plot_num
-     if (iflag < 0) then
-        read (iunplot, '(i4,3x,a2,3x,f5.2)') &
+     read (iunplot, '(i4,3x,a2,3x,f5.2)') &
              (ndum, atm(nt), zv(nt), nt=1, ntyp)
-        read (iunplot, *) (ndum,  (tau (ipol, na), ipol = 1, 3), &
+     read (iunplot, *) (ndum,  (tau (ipol, na), ipol = 1, 3), &
              ityp(na), na = 1, nat)
-        read (iunplot, * ) (plot (ir), ir = 1, nrx1 * nrx2 * nr3)
-     endif
+     read (iunplot, * ) (plot (ir), ir = 1, nrx1 * nrx2 * nr3)
   endif
 
   if (plot_num /= 9) close (unit = iunplot)
+
   return
 end subroutine plot_io
+!-----------------------------------------------------------------------
+subroutine read_io_header(filplot, title, nrx1, nrx2, nrx3, nr1, nr2, nr3, &
+                  nat, ntyp, ibrav, celldm, at, gcutm, dual, ecut, plot_num)
+     
+  !-----------------------------------------------------------------------
+  !
+  !     read header of file "filplot" 
+  !
+  USE io_global,  ONLY : stdout
+  USE kinds, only : DP
+  implicit none
+  character (len=*) :: filplot
+  character (len=75) :: title
+  integer :: nrx1, nrx2, nrx3, nr1, nr2, nr3, nat, ntyp, ibrav, plot_num, i
+  real(kind=DP) :: celldm (6), gcutm, dual, ecut, at(3,3)
+  !
+  integer :: iunplot, ios, ipol, na, nt, ir, ndum
+  !
+  if (filplot == ' ') call errore ('read_io_h', 'filename missing', 1)
+  !
+  iunplot = 4
+  WRITE( stdout, '(5x,"Reading header from file  ",a)') filplot
+  open (unit = iunplot, file = filplot, form = 'formatted', &
+          status = 'old', err = 100, iostat = ios)
+100 call errore ('plot_io', 'opening file '//filplot, abs (ios) )
+
+  rewind (iunplot)
+  read (iunplot, '(a)') title
+  read (iunplot, * ) nrx1, nrx2, nrx3, nr1, nr2, nr3, nat, ntyp
+  read (iunplot, * ) ibrav, celldm
+  if (ibrav == 0) then
+     do i = 1,3
+        read ( iunplot, * ) ( at(ipol,i),ipol=1,3 )
+     enddo
+  endif
+  read (iunplot, * ) gcutm, dual, ecut, plot_num
+
+  return
+end subroutine read_io_header

PP/voronoy.f90

@@ -51,9 +51,8 @@ program voronoy
   !
   ! read file header and allocate objects
   !
-  call plot_io (filename, title, nrx1, nrx2, nrx3, nr1, nr2, nr3, &
-       nat, ntyp, ibrav, celldm, at, gcutm, dual, ecutwfc, plot_num, &
-       atm, ityp, zv, tau, rhodum, 0)
+  call read_io_header (filename, title, nrx1, nrx2, nrx3, nr1, nr2, nr3, nat, &
+                       ntyp, ibrav, celldm, at, gcutm, dual, ecutwfc, plot_num)
   !
   allocate(tau(3, nat))
   allocate(ityp(nat))