*______________________________________________________________________________
        PROGRAM n0Tdep_fit
*______________________________________________________________________________
c
c R.T. AZUAH -- Nov 1999
c    fitting function to parameters for T-dep of n0(T).
c
c______________________________________________________________________________
        implicit none
        external n0T
c Variables and common blocks
	character xlab*5,ylab*5,xcap*60,ycap*60,subtitle(3)*60,title*80,nam(50)*20
	character*60 filein,fileres,text*80,dec*1,filefsf
	integer*4 text_len,lpt,strim,nrd,nid
	logical okay,resfile,moms,comp,firstime
	integer*4 nptot,nd,i,j,in_len,res_len,mn,fsf_len
	real*8 p(50),pmin(50),pmax(50),x(1000),y(1000),ysig(1000)
c
c
        data nam(1) /'Bkgd Constant'/,
     >       nam(2) /'Bkgd Slope'/,
     >       nam(3) /'n\d0\u(T=0)'/,
     >       nam(4) /'T\d\(2137)\u'/,
     >       nam(5) /'\(2129)'/

        nptot = 5
        data xlab, ylab /'X', 'Y'/

        data subtitle(1) /'FUNCTION TYPE : xxxxx'/
        data subtitle(2) /'Instrument: xxxxxxxx          User: xxxxxxxxxxxxxxxxxxxx'/
        data subtitle(3) /'Q value is: xxxxx     DATE OF EXPT: xxxxxxxxxxxxxxxxxxxx'/

 10     write (*,'(T5,A,$)') ' Enter data filename ::'
        read (*,'(A)') filein
        INQUIRE (file=filein,exist=okay)
        IF (okay) THEN
           open (unit=18,file=filein,status='old')
           in_len =  strim(filein)
           DO i = 1,1000
              read (18,*,end=15) x(i),y(i),ysig(i)
           END DO
 15        nd = i - 1   
           close (18)
        ELSE
           write (*,*) '    ** ERROR - Data file does not exist '
           GOTO 10
        END IF
c
c Set up labels and captions
c
        title = ' Data file = '//filein(1:in_len)
        xcap = ' T (K) '
        ycap = ' n\d0\u(T)  (%)'
c
c Welcome Message
        write (*,*) '#'
        write (*,*) '# ******** n0(T) Fitting Program ****** '
        write (*,*) '#'
        write (*,*) '# Type HELP for a list of available commands'
        write (*,*) '#'
        write (*,*) '# Details of fits are stored in /tmp/n0Tdep_fit.lpt '
        write (*,*) '#'
        write (*,*) '#'
c        call norm (x,y,ysig,nd,Sq) 	! normalise exp't data to S(Q)
        p(1) = 0.0			! estimate initial fitting parameters
        p(2) = 0.0
        p(3) = 7.0
        p(4) = 2.17
        p(5) = 4.50
c pass control to FRILLS
        open (unit=8,file='/tmp/n0Tdep_fit.lpt',status='unknown')
c
c        CALL FRILLS (n0T)

	firstime = .true.                ! for benefit of fofs when used
        CALL FRILLS (n0T,
	1    nd,x,y,ysig,
	2    nptot,p,pmin,pmax,nam,
	3    xlab,ylab,xcap,ycap,subtitle,title)


        close (8)			! close fitting log file
        STOP
        END
c___________________________________________________________________________
*____________________________________________________________________________
c        SUBROUTINE npstar(ycal,nv,inv,p)
        SUBROUTINE n0T(ycal,nv,inv,nptot,p,x,npk,ypk)
*_____________________________________________________________________________
c
c Determines parameters for J(Q,Y) calculation and also checks the results for
c consistentcy between input parameters and calculated output.
c
        implicit none
c Frills Variables 
	real*8 x(*),ypk(5000,20),ycal(*),p(*),bc,bs
	integer*4 inv(*),npk,nv,nptot

c General Variables
        real*8 n00,t_lambda,gamma
        integer*4 i,j
c
c Assign fitting parameters from Frills
c
        bc = p(1)
        bs = p(2)
        n00 = p(3)
        t_lambda = p(4)
        gamma = p(5)
c
c Calculate Function plus sloping background
c __ Calculation is made only at points where data is present
c
        DO i = 1,nv
           j = inv(i)
           ypk(j,1) = bc + bs*x(j)      ! Sloping background
           if (x(j) .LE. t_lambda) then
              ypk(j,2) = n00*(1 - ((x(j)/t_lambda)**gamma))
           else
              ypk(j,2) = 0.0
           end if
           ycal(j) = ypk(j,1) + ypk(j,2)
        END DO
        npk = 2
        RETURN
        END
