C-----------------------------------------------------------------------
	program FindResponse
C-----------------------------------------------------------------------
C OCCAM 2.0: Steven Constable IGPP/SIO La Jolla CA 92093-0225
c Program Revision 2.00, 11 June 1992
c 
c Finds the response of a standard OCCAM 2.0 model given a current
c iteration file.  
c
	include 'occamdim.inc'
	include 'occam.inc'
	character*80 itform,descr,modfil,datfil,iterfl
	real dwk1(ndd)
	logical ifdat

c calls
c   itrin, inputd, inputm, formod, outres
c
C-----------------------------------------------------------------------
c read the iteration file
	write(*,*) 'Enter iteration or startup file name'
	read (*,'(a)') iterfl
	open(12,file=iterfl)
c	open(12,file='startup')
      call itrin (itform,descr,modfil,datfil,maxitr,tolreq,iruf,
     *    nit,pmu,rlast,tobt,ifftol,12)
c input the data
      inquire (FILE=datfil, EXIST=ifdat)
	if (ifdat) then
	  call inputd(datfil)
	else
	  call setdat(err)
	end if
c input the fixed model characteristics
	call inputm(modfil)
c output a plotting model
      open(12, file='MODEL')
	call outmod(12)
	close (12)
c compute the forward response
	call formod(np,nd,pm,dp,dm)
c output the response
      if (.not. ifdat) then
	  call outdat(datfil, nd, dp, dm,err)
	end if
  	open(12, file='RESPS')
	call outres(12)
      DO 40 I = 1,ND
40      DWK1(I) = (D(I) - DM(I))/SD(I)
      TOFMU = SQRT(ANORM(ND,DWK1)/ND)
      WRITE(12,*) ' Misfit =', TOFMU
	close(12)
c
	stop
c
198	call filerr (' Iteration file ended prematurely', iof2)
199	call filerr (' Error reading iteration file', iof2)
c	
	end
C-----------------------------------------------------------------------
      REAL FUNCTION ANORM(N,D)
C-----------------------------------------------------------------------
C RETURNS THE SQUARE OF THE EUCLIDEAN NORM OF A VECTOR
      INCLUDE 'imp.inc'
C
      INTEGER I, N
      REAL D(N)
C
      ANORM = 0.0
      DO 10 I = 1,N
        ANORM = ANORM + D(I)*D(I)
10    CONTINUE
      RETURN
      END
C
C	
C-----------------------------------------------------------------------
      subroutine itrin (itform,descr,modfil,datfil,maxitr,tolreq,
     *    iruf,nit,pmu,rlast,tobt,ifftol,iof2)      
C-----------------------------------------------------------------------
c
C OCCAM 2.0: Steven Constable IGPP/SIO La Jolla CA 92093-0225
c Subroutine Revision 2.01, 13 Jan 1993
C
c reads a STARTUP or ITER file for OCCAM
c
c includes:
      include 'imp.inc'
      include 'occamdim.inc'
c   uses npp
      include 'occam.inc'
c   uses np, pm(), idebug
c arguments:
      integer maxitr, iruf, nit, ifftol,iof2
      real tolreq, pmu, rlast, tobt
      character*80 modfil, datfil, itform, descr
c local variables
      integer i, idcode
c   i = loop index
c   idcode = function to perform the equivalent of a free-format internal
c            read for an integer
      real rdcode
c   rdcode = function to perform the equivalent of a free-format internal
c            read for a real
      character*80 string
C
C-----------------------------------------------------------------------
      read(unit=iof2,fmt='(18x,a)', end=198, err=199) itform
      read(unit=iof2,fmt='(18x,a)', end=198, err=199) descr
      read(unit=iof2,fmt='(18x,a)', end=198, err=199) modfil
      read(unit=iof2,fmt='(18x,a)', end=198, err=199) datfil
      read(unit=iof2,fmt='(18x,a)', end=198, err=199) string
c
      read(unit=iof2,fmt='(18x,a)', end=198, err=199) string
      maxitr = idcode(string,iof2)
      read(unit=iof2,fmt='(18x,a)', end=198, err=199) string
      tolreq = rdcode(string,iof2)
      read(unit=iof2,fmt='(18x,a)', end=198, err=199) string
      iruf = idcode(string,iof2)
      read(unit=iof2,fmt='(18x,a)', end=198, err=199) string
      idebug = idcode(string,iof2)
      read(unit=iof2,fmt='(18x,a)', end=198, err=199) string
      nit = idcode(string,iof2)
      read(unit=iof2,fmt='(18x,a)', end=198, err=199) string
      pmu = rdcode(string,iof2)
      read(unit=iof2,fmt='(18x,a)', end=198, err=199) string
      rlast = rdcode(string,iof2)
      read(unit=iof2,fmt='(18x,a)', end=198, err=199) string
      tobt = rdcode(string,iof2)
      read(unit=iof2,fmt='(18x,a)', end=198, err=199) string
      ifftol = idcode(string,iof2)
      read(unit=iof2,fmt='(18x,a)', end=198, err=199) string
      np = idcode(string,iof2)
      if (np .gt. npp) call filerr (' Too many parameters', iof2)
      read (unit=iof2,fmt= *, end=198, err=199) (pm(i), i=1,np)
c
      return
c
198      call filerr (' Startup file ended prematurely', iof2)
199      call filerr (' Error reading startup file', iof2)
      end
c
C
C-----------------------------------------------------------------------
      real function rdcode(string, iof2)
C-----------------------------------------------------------------------
C
C OCCAM 2.0: Steven Constable IGPP/SIO La Jolla CA 92093-0225
c Subroutine Revision 2.00, 13 Jan 1993
C
c rdcode provides a patch to get around the lack of an internal
c free-format (list-directed) read on some compilers, notably the
c cray.  This version for reals.  Butchered from decode by Bob Parker.
c 
c on input:
c    string = character string containing number to be read
c    iof2 = unit number of open file, to be closed on error 
c on output:
c    rdcode contains a real number from string
c calls:
c    filerr
c
c includes:
      include 'imp.inc'
c input arguments:
      character*(*) string
	integer iof2
c local variables
      character*40 local
	integer k, k1, kn, l
c
c  Terminate line at % sign
      kn=index(string//'%', '%') - 1
      k1=1
      do 1100 k=k1, kn
        if (string(k:k) .ne. ' ') goto 1200
 1100 continue
      call filerr (' No number found by rdcode', iof2)
 1200 do 1300 l=k, kn
        if (string(l:l).eq. ',' .or. string(l:l) .eq. ' ') goto 1500
 1300 continue
 1500 local=string(k:l-1)
      read (local, '(f40.0)', err=1900) rdcode
	return
 1900 call filerr (' Error reading string in rdcode', iof2)
      end
C-----------------------------------------------------------------------
      integer function idcode(string, iof2)
C-----------------------------------------------------------------------
C
C OCCAM 2.0: Steven Constable IGPP/SIO La Jolla CA 92093-0225
c Subroutine Revision 2.00, 13 Jan 1993
C
c idcode provides a patch to get around the lack of an internal
c free-format (list-directed) read on some compilers, notably the
c cray.  This version for integers.  Butchered from decode by Bob Parker.
c 
c on input:
c    string = character string containing number to be read
c    iof2 = unit number of open file, to be closed on error 
c on output:
c    idcode contains an integer number from string
c calls:
c    filerr
c
c includes:
      include 'imp.inc'
c input arguments:
      character*(*) string
	integer iof2
c local variables
      character*40 local
	integer k, k1, kn, l
	real realno
c
c  Terminate line at % sign
      kn=index(string//'%', '%') - 1
      k1=1
      do 1100 k=k1, kn
        if (string(k:k) .ne. ' ') goto 1200
 1100 continue
      call filerr (' No number found by idcode', iof2)
 1200 do 1300 l=k, kn
        if (string(l:l).eq. ',' .or. string(l:l) .eq. ' ') goto 1500
 1300 continue
 1500 local=string(k:l-1)
      read (local, '(f40.0)', err=1900) realno
	idcode = int(realno)
	return
 1900 call filerr (' Error reading string in idcode', iof2)
      end
C-----------------------------------------------------------------------
      subroutine filerr(mssg, io1)
C-----------------------------------------------------------------------
C
C OCCAM 2.0: Steven Constable IGPP/SIO La Jolla CA 92093-0225
c Subroutine Revision 2.00, 13 May 1992
C
c filerr prints an error message, closes file io1, and stops
c
c on input:
c    mssg = character string containing error message
c    i01 = unit number of file to close (0 = no file open)
c on output:
c    outputs nothing
c calls:
c    no other routines
c
c
c includes:
      include 'imp.inc'
c input arguments:
      character*(*) mssg
      integer io1
c
C-----------------------------------------------------------------------
      write(*,*) mssg
      if (io1 .gt. 0) close (io1)
      stop
      end
