PROGRAM PEDALL
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER*4 (I-N)
      parameter (nat0=3000,MX=3*nat0)
      real*8 b(MX,12),s(MX,MX),w(MX),u(MX)
      integer*4 ind(MX),lb(MX,12),nn(MX)
      WRITE(*,*)
      WRITE(*,*)' Approximate Potential Energy Distribution '
      WRITE(*,*)'    From B.MAT and F.INP'
      WRITE(*,*)
 
      open(9,file='B.MAT')
      read(9,*)nob0
      read(9,*)na
      if(max(nob0,na).gt.MX)call report('Fields too large')
      read(9,*)
      do 2  i=1,nob0
      read(9,*)
      read(9,*)nn(i)
      do 2 ii=1,nn(i)
      read(9,*)ia,ix,b(i,ii)
2     lb(i,ii)=ix+3*(ia-1)
      close(9)
      write(6,*)nob0, ' coordinates'

      OPEN(17,FILE='F.INP',STATUS='OLD')
      READ(17,*)NQ,NAC
      IF(NAC.NE.na)call report(' F.INP and B.MAT incompatible')
      NOAT=na/3
      DO 3 K=1,NOAT
3     READ(17,*)
      IMDMAX=0
      READ(17,*)
      DO 4 LL=1,NOAT
      DO 4 I=1,NQ
4     READ (17,*) IAT,IMD,(S(3*(IAT-1)+ix,I),ix=1,3)
      READ(17,*)
      READ(17,*)(W(I),I=1,NQ)
1717  FORMAT(3F15.7)
      WRITE(*,*)NQ,' modes'

      open(9,file='PED_RAW.LST')
      open(91,file='PED_SORT.LST')
      do 5 iq=1,NQ
      an=0.0d0
      do 7 ic=1,nob0
      ind(ic)=ic
      sum=0.0d0
      do 71 ii=1,nn(ic)
71    sum=sum+s(lb(ic,ii),iq)*b(ic,ii)
      u(ic)=sum**2
7     an=an+u(ic)
      do 72 ic=1,nob0
72    u(ic)=u(ic)/an
      write(91,609)iq,w(iq)
      write(9,609)iq,w(iq)
609   format(i6,f10.2,$)
      do 620 ic=1,nob0
620   write(9,6199)u(ic)*100.0d0
6199  format(f10.2,$)
      do 8 ic=1,nob0
      do 8 icp=ic,nob0
      if(u(icp).gt.u(ic))then
       t=u(icp)
       u(icp)=u(ic)
       u(ic)=t
       it=ind(ic)
       ind(ic)=ind(icp)
       ind(icp)=it
      endif
8     continue
      do 81 ic=1,nob0
81    write(91,619)ind(ic),100.0d0*u(ic)
619   format(i6,f10.2,$)
      write(9,*)
5     write(91,*)
      close(9)
      close(91)
      write(6,*)'PED_RAW.LST and PED_SORT.LST written'
      stop
      end
      
      subroutine report(s)
      character*(*) s
      write(6,*)s
      stop
      end