diff --git a/PP/average.f90 b/PP/average.f90 index 53a8b3a3d..e85d7893a 100644 --- a/PP/average.f90 +++ b/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 ) diff --git a/PP/chdens.f90 b/PP/chdens.f90 index a15214c74..fe583708c 100644 --- a/PP/chdens.f90 +++ b/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)) diff --git a/PP/plot_io.f90 b/PP/plot_io.f90 index 7f600145b..56811c9df 100644 --- a/PP/plot_io.f90 +++ b/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 diff --git a/PP/voronoy.f90 b/PP/voronoy.f90 index 84d4ecf8a..61009fcf2 100644 --- a/PP/voronoy.f90 +++ b/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))