subroutine wrhist(icurr,hist,xmax,xmin,ncoord,bcoord,x0,NNT,
     1LPER,PPER)
      implicit none
      integer*4 icurr,hist(*),istart,iend,i,j,NNT,ncoord
      real*8 xmax,xmin,x,dx,e,bcoord(*),x0(*),PPER,d
      character*10 so
      logical LPER
c
      write(so,'(i10)')icurr
      do 21 istart=1,10
21    if(so(istart:istart).ne.' ')goto 22
22    do 23 iend=10,1,-1
23    if(so(iend:iend).ne.' ')goto 24
24    open(93,file=so(istart:iend)//'.prn')
      dx=(xmax-xmin)/dble(NNT)
      x=xmin-dx/2.0d0
      do 25 i=1,NNT
      x=x+dx
      e=0.0d0
      do 1 j=1,ncoord
      d=dabs(x-x0(j))
      if(LPER)d=d-anint(d/PPER)*PPER
1     e=e+d**2*bcoord(j)
25    write(93,930)x,hist(i),e
930   format(f10.3,i10,f12.4)
      close(93)
      write(6,*)'Histogram # ',icurr,' written'
      return
      end