program specnorm
      implicit none
      integer*4 ns,is,nsf,npmax,iargc,ic,i
      real*8 wmin,wmax
      real*8,allocatable::x(:,:),y(:,:)
      integer*4,allocatable::np(:)
      character*80 list,s80,fn
      character*1 kk,ok
      character*80,allocatable::sn(:)
c      
      do 5 i=1,len(s80)
  5   s80(i:i)=' '
      write(6,6000)
6000  format(/,' Specnorm reads spectra listed in a list,',/,
     1         ' normalizes to the highest signal within wmin wmax,',/,
     1         ' shifts them from the first and writes into a file',/,
     1         ' so that they can be plotted by Sigmaplot etc.',/,/,
     1         '   Usage: specnorm <list> <file> <wmin> <wmax> <f>',/,/,
     1         '      <list> list of spectra',/,
     1         '      <file> output file name',/,
     1         '      <wmin> wmin for normalization',/,
     1         '      <wmax> wmax for normalization',/,
     1         '         <f> regular (r) or irregular (i) spacing',/,/)

      if(iargc().lt.2)stop
      call getarg(1,list)
      call getarg(2,fn)
      s80(1:11)='-10000000.0'
      if(iargc().gt.2)call getarg(3,s80)
      read(s80,*)wmin
      s80(1:11)='+10000000.0'
      if(iargc().gt.3)call getarg(4,s80)
      read(s80,*)wmax
      ok='r'
      if(iargc().gt.4)call getarg(5,ok)
      kk='n'
      if(iargc().gt.5)call getarg(6,kk)
c
      write(6,601)wmin,wmax
 601  format(' wmin, wmax:',2f20.2)
      if(ok.eq.'r')then
       write(6,602)'  Regular spacing'
 602   format(1x,a17)
      else
       write(6,602)'Irregular spacing'
      endif
      if(kk.eq.'y')write(6,*)' Sign inversion requested !!'

      ns=1
      do 2 ic=1,2
      if(ic.eq.2)allocate(sn(ns),np(ns))
      open(9,file=list)
      ns=0
1     read(9,9000,end=99,err=99)s80
9000  format(a80)
      if(s80(1:1).eq.'#')goto 1
      ns=ns+1
      if(ic.eq.2)sn(ns)=s80
      goto 1
99    close(9)
2     continue
c
      npmax=0
      do 3 is=1,ns
      np(is)=nsf(sn(is))
  3   if(np(is).gt.npmax)npmax=np(is)

      write(6,6003)ns,npmax
6003  format(i4,' spectra, maxinal number of points',i6)
      allocate(x(ns,npmax),y(ns,npmax))

      do 4 is=1,ns
      call ls(x,y,npmax,np,ns,is,sn(is))
      if(kk.eq.'y')then
       do 7 i=1,np(is)
 7     y(is,i)=-y(is,i)
      endif
4     call norm(wmin,wmax,x,y,npmax,np,ns,is,ok)

      call ws(x,y,npmax,np,ns,fn)
      end

      subroutine ws(x,y,npmax,np,ns,fn)
      implicit none
      integer*4 np(ns),ip,is,ns,npmax
      real*8 x(ns,npmax),y(ns,npmax)
      character*(*) fn
      logical xscale
      open(9,file=fn)
      do 1 ip=1,npmax
      do 2 is=1,ns
      if(is.gt.1)then
       xscale=np(is).ne.np(is-1)
      else
       xscale=.true.
      endif
      if(xscale)then
       if(np(is).ge.ip)then
        write(9,91)x(is,ip),y(is,ip) 
  91    format(2e12.4,$)
       else
        write(9,91)x(is,np(is)),y(is,np(is))
       endif
      else
       if(np(is).ge.ip)then
        write(9,92)y(is,ip) 
  92    format(e12.4,$)
       else
        write(9,92)y(is,np(is))
       endif
      endif
  2   continue
  1   write(9,*)
      close(9)
      end
c
      function nsf(nm)
      implicit none
      integer*4 np,nsf
      real*8 x
      character*(*) nm
      open(9,file=nm)
      np=0
 1    read(9,*,end=99,err=99)x,x
      np=np+1
      goto 1
 99   close(9)
      nsf=np
      return
      end

      subroutine norm(wmin,wmax,x,y,npmax,np,ns,is,ok)
      implicit none
      integer*4 npmax,np(*),i,is,ns
      real*8 x(ns,npmax),y(ns,npmax),wmin,wmax,smin,smax
      character*1 ok
      smin=0.0d0
      smax=0.0d0
      do 1 i=1,np(is)
      if(x(is,i).ge.wmin.and.x(is,i).le.wmax)then
       if(y(is,i).lt.smin)smin=y(is,i)
       if(y(is,i).gt.smax)smax=y(is,i)
      endif
 1    continue
      write(6,600)is,smin,smax
 600  format(i6,' Smin:',e12.4,' Smax:',E12.4)
      do 2 i=1,np(is)
 2    y(is,i)=y(is,i)/(smax-smin)
c     regular/irregular stacking:
      if(ok.eq.'r')then
       do 3 i=1,np(is)
 3     y(is,i)=y(is,i)+dble(is-1)
      else
       if(is.gt.1)then 
c       minimum of upper spectrum:
        smin=0.0d0
c       maximum of lower spectrum:
        smax=0.0d0
        do 4 i=1,np(is)
        if(x(is,i).ge.wmin.and.x(is,i).le.wmax)then
         if(y(is,i).lt.smin)smin=y(is,i)
        endif
        if(x(is-1,i).ge.wmin.and.x(is-1,i).le.wmax)then
         if(y(is-1,i).gt.smax)smax=y(is-1,i)
        endif
 4      continue
        do 5 i=1,np(is)
 5      y(is,i)=y(is,i)+smax-smin
       endif
      endif
      return
      end

      subroutine ls(x,y,npmax,np,ns,is,nm)
c     loads in the spectrum      
      implicit none
      integer*4 np(ns),i,is,ns,npmax
      real*8 x(ns,npmax),y(ns,npmax)
      character*(*) nm
      open(9,file=nm)
      do 1 i=1,np(is)
 1    read(9,*)x(is,i),y(is,i)
      close(9)
      return
      end