	PROGRAM GPLSFT
	use msflib
	implicit none
C
C  Routine to fit peak profiles from NSLS powder patterns.
C
C	original version Oct. 14, 1985
C	updated Sept. 1991 by JAH
C	- option to read .profin files added 11/89 by jah
C	- bits added for better output file by jah
C	- all graphics calls now in subroutine DISPLY 9/91 jah
C	- this version uses PGPLOT graphics with hardcopy option
C       - asymmetry Correction added Sep 1992
C       - revised for Finger (1997) profile routine
C
C	multiple input options added June 93 by LWF
C
C	- user input of fwhm
C
C  The BNL routine GPLS is called to do the fitting.
C 
	include 'gplsc_com.for'
	include 'data_com.for'
	include 'options_com.for'
	include 'display_com.for'
	include 'a_com.for'
      character*1 IRESP,jresp
	REAL*4 XD(mxd),dspx(nparam),result,sam,det,tthi,tthf,dtth,tmin
	real*4 q,zsam,zdet
	integer low,nhigh,ihigh,ipnt1,ipnt2,nptf,i,j,k,n,ifirst,np1
	integer np2,ik,ioldnb
c
	rfine1 = '0011111111111111111111111111111111111111'
	rfine2 = '1111111111111111111111111111111111111111'
	lo = 1
	li = 1
	result = SETEXITQQ (QWIN$EXITNOPERSIST)

	CALL READTA
	irefdet = 0
      irefsam = 0
	iasymm=0
      write(*,'(a,$)')' Do you want an asymmetry correction (Y,<N>):'
	read(*,'(a1)')IRESP
	IF(IRESP.EQ.'Y'.OR.IRESP.EQ.'y') then
        iasymm=2
        write(*,'(a,$)')' Enter S/L and D/L (HALF Widths):'
        read(*,'(3f8.0)')sam,det
        write(*,'(a,$)')' Do you want to refine S/L (Y,<N>): '
	  read(*,'(a)')iresp
        if(iresp.eq.'y'.or.iresp.eq.'Y')irefsam = 1
        write(*,'(a,$)')' Do you want to refine D/L (Y,<N>): '
 	  read(*,'(a)')iresp
        if(iresp.eq.'y'.or.iresp.eq.'Y')irefdet = 1
      end if
   	if (pksinc) then
        OPEN(UNIT=9,FILE='GPLS.pks',STATUS='unknown',access='append')
	  if (.not. single) then
          write(9,'(5x,a)')ptitle
          write(9,'(/5x,a,f10.6)')'Input wavelength =',wave
   	    write(9,'(/5x,a,f10.6,a)')
     1	   '2-theta values corrected by subtracting  ',zero,' degrees'
          write(9,500)
500	    format(/,3x,'2-theta',4x,'sigma',7x,'d',9x,'q',12x,'I'
     1		,8x,'sigma(I)',5x,'fwhm')
          write(9,510)
510	    format(3x,'-------',4x,'-----',6x,'---',7x,'---',10x,'---'
     1		,7x,'--------',5x,'----')
	  endif
   	end if
C
C first call sets up plot
C
	call disply(angle,cps,1,ndata,ipnt1,ipnt2,99)
C
C DISPLAY ENTIRE SPECTRUM
C
	low = (anglow - angle(1)) / (angle(2) - angle(1)) - angle(1)
      if (low .le. 0)low = 1
	if (step)then
	    nhigh = 10.0 / (angle(2) - angle(1))
	else
	    nhigh = ndata
	endif
	if (nhigh .gt. 800)then
	  if (.not. step) then
	    write(*,*)'Too many points: Step mode on.'
	    pause
	  endif
	  nhigh = 800
	  step = .true.
	endif
90	ihigh = low + nhigh
	if(ihigh.gt.ndata)ihigh = ndata
	if (single) then
	  ipnt1 = 1
	  ipnt2 = ndata
	else
	  CALL DISPLY(angle,cps,low,ihigh,IPNT1,IPNT2,0)
	endif
	NPTF = IPNT2 - IPNT1 +1
C
C DISPLAY SELECTED REGION
C
95	call pgpage
 	call clear
	CALL DISPLY(angle,cps,IPNT1,IPNT2,I,J,1)
	if (nb.eq.0) go to 90
C
C COPY COUNT AND POSITION DATA TO ARRAYS Y AND XD
c
	J=0
	DO 100 I=IPNT1,IPNT2
	  J=J+1
	  YOBS(J)=CPS(I)
	  XD(J)=ANGLE(I)
   	  sigy(j)=sigf(i)
100	CONTINUE
	TTHI=XD(1)
	TTHF=XD(J)
	DTTH=XD(2)-XD(1)
C
C SET UP TRIAL PARAMETERS
C
	X(1)=YOBS(1)
	X(2)=YOBS(NPTF)
	if (pkwidth.eq.0.0) pkwidth = 0.04
      x(4)=pkwidth
	X(3)=0.80
	if (indwid) then
	  nc = 3
	  nper = 3
	else
	  NC=4
	  nper = 2
	endif
	n = nb * nper + nc
	DO J=1,NB
	  K= nc + nper * (J-1)
	  if (indwid)then
	    k = k + 1
	    x(k) = pkwidth
  	    X(K+1)=inten(j)*x(k)
	  endif
	  X(K+1)=inten(j)*x(4)
	  X(K+2)=pos(j)
	end do
	IFIRST = 0
115	N1 = n
	rfine1 = '00101111111111111111111111111111111111111'
	rfine2 = '11111111111111111111111111111111111111111'
	if (iasymm .ne. 0) then
	  N1 = N1 + 2
	  x(n1-1) = sam
        if(irefsam.ne.0)then
	    rfine1(n1-1:n1-1) = '1'
	    rfine2(n1-1:n1-1) = '1'
        else
	    rfine1(n1-1:n1-1) = '0'
	    rfine2(n1-1:n1-1) = '0'
	  endif
        x(n1) = det
        if(irefdet.ne.0)then
	    rfine1(n1:n1) = '1'
	    rfine2(n1:n1) = '1'
        else
	    rfine1(n1:n1) = '0'
	    rfine2(n1:n1) = '0'
	  endif
	else
	  rfine1(n+1:n+3) = '000'
	  rfine2(n+1:n+3) = '000'
      endif
   	if (esdinc) then 
   	       nsigma=1
   	else
	       nsigma=0
   	end if
C
C CLEAR SCREEN
C
	CALL CLEAR
C
C OPEN OUTPUT FILE AND WRITE DATA
C
      OPEN(UNIT=7,FILE='GPLS.out',STATUS='unknown')
120	continue
c set to skip asymmetry on first cycles - rough convergence first
	if(iasymm.ne.0.and.ifirst.ne.0)then
	  kasymm = 2
        n1 = n + 2
	else
	  kasymm = 0
	  n1 = n
	endif
	np = n1
	npts = nptf
	nline = nb
	icyc = nc
	astart = tthi
	astep = dtth
	aend = tthf
      ifirst=1
	call clear
	write(*,'(a)')' Least-Squares Calculation Running'
	CALL GPLS
	DO 122 I=1,N
	  if(abs(sigx(i)).gt.1.0e-6)DELX(I) = DELX(I)/SIGX(I)
122	CONTINUE
      if (indwid) then
	  write(7,9036)FAX,(X(I),SIGX(I),DELX(I),I=1,3),
     1   ((J,X(3*J+I),SIGX(3*J+I),DELX(3*J+I),I=1,3),J=1,NB)
	  write(*,9036)FAX,(X(I),SIGX(I),DELX(I),I=1,3),
     1   ((J,X(3*J+I),SIGX(3*J+I),DELX(3*J+I),I=1,3),J=1,NB)
9036	  FORMAT(5X,'LEAST-SQUARES RESULTS: GOF = ',F10.3
     1  /' PARAMETER',6X,'VALUE',7X,'SIGMA',5X,'DELTA/SIGMA'/
     2  /' LOW BG',T10,3F13.5/' HI BG',T10,3F13.5
     3  /' ETA',T10,3F13.5/(' FWHM ',i2,T10,3F13.5
     4  /' INT.',I2,T10,3F13.5/' POS.',I2,T10,3F13.5))
	else
	  write(7,9037)FAX,(X(I),SIGX(I),DELX(I),I=1,4),
     1   ((J,X(2*J+I+2),SIGX(2*J+I+2),DELX(2*J+I+2),I=1,2),J=1,NB)
	  write(*,9037)FAX,(X(I),SIGX(I),DELX(I),I=1,4),
     1   ((J,X(2*J+I+2),SIGX(2*J+I+2),DELX(2*J+I+2),I=1,2),J=1,NB)
9037	  FORMAT(5X,'LEAST-SQUARES RESULTS: GOF = ',F10.3
     1  /' PARAMETER',6X,'VALUE',7X,'SIGMA',5X,'DELTA/SIGMA'/
     2  /' LOW BG',T10,3F13.5/' HI BG',T10,3F13.5/
     3  ' ETA',T10,3F13.5/' FWHM',T10,3F13.5/(' INT.',I2,T10,3F13.5
     4  /' POS.',I2,T10,3F13.5))
	endif
	if(kasymm.ne.0)then
	  np1 = n1-1
	  np2 = n1
        if(irefsam.ne.0)then
	    write(7,99037)x(np1),sigx(np1),delx(np1)
	    write(*,99037)x(np1),sigx(np1),delx(np1)
99037	    format(' S/L',t10,3f13.5)
	    sam = x(np1)
	  else
	    np2=np2-1
	    write(7,99038)sam
	    write(*,99038)sam
99038	    format(' S/L',t10,f13.5)
     	  endif
        if(irefdet.ne.0)then
	    write(7,99039)x(n1),sigx(np2),delx(np2)
	    write(*,99039)x(n1),sigx(np2),delx(np2)
99039	    format(' D/L',t10,3f13.5)
	    det = x(n1)
	  else
	    write(7,'('' D/L'',t10,f13.5)')det
	    write(*,'('' D/L'',t10,f13.5)')det
     	  endif
	endif
   	if (pksinc) then
        do ik=1,nb
          dspx(ik)=wave/(2*(sin((x(nper*ik+nc)-zero)*3.1415926
     1           /360)))
        end do
   	end if
	write(*,'(/a,$)')' Do You wish more Least-Squares Cycles (<Y>,N)?'
	read(*,'(a1)')IRESP
	IF(IRESP.NE.'N'.AND.IRESP.NE.'n')then
	  rfine1 = rfine2
	  go to 120
	endif
C
C DISPLAY RESULTS OF FIT
C
	refit = .false.
	do i=1,nb
	  posn(i)=x(nper*i+nc)-zero
	end do
	ioldnb = nb
	CALL DISPLY(xd,yc,1,NPTF,I,J,2)
	if (ioldnb .ne. nb) then
c New line added
	  k = nc + (nb-1)*nper
	  if (indwid)then
	    k = k + 1
	    x(k) = pkwidth
	  endif
	  x(k+1) = (inten(nb)-x(1))/x(4)
	  x(k+2) = pos(nb)
	  rfine1(n:n+5) = '111111'
	  rfine2(n:n+5) = '111111'
	  n = nper*nb + nc
	  n1 = n
	  if (iasymm .ne. 0) then
	    n1 = n1 + 2
	    if(irefsam.ne.0)then
	        x(n1-1) = sam
	        rfine1(n1-1:n1-1) = '1'
	        rfine2(n1-1:n1-1) = '1'
          else
	        rfine1(n1-1:n1-1) = '0'
	        rfine2(n1-1:n1-1) = '0'
	    endif
	    if(irefdet.ne.0)then
	        x(n1) = det
	        rfine1(n1:n1) = '1'
	        rfine2(n1:n1) = '1'
          else
	        rfine1(n1:n1) = '0'
	        rfine2(n1:n1) = '0'
	    endif
	  endif
	  go to 115
	endif
	write(*,'(/a,$)')' Refit the same region (Y,<N>)?  '
	read(*,'(a1)')IRESP
	IF(IRESP.EQ.'Y'.OR.IRESP.EQ.'y') refit = .true.
	if (.not.refit) then
   	  if (pksinc) then
c print the lines in increasing 2theta
          do j=1,nb
	      tmin = 999.9
	      do i = 1,nb
	        if(x(nper*i+nc).lt.tmin)then
	          tmin = x(nper*i+nc)
	          k = i
	        endif
	      enddo
	      if (.not. single) then
c k now points to the minimum 2 theta
   	        q=1.0/(dspx(k)**2)
              if (indwid) then
		      write(9,'(3f10.5,2x,f10.8,2f12.4,3x,f8.6)')
     1	       X(3*k+3)-zero,SIGX(3*k+3),dspx(k),q,
     2	       X(3*k+2),SIGX(3*k+2),x(3*k+1)
              else
		      write(9,'(3f10.5,2x,f10.8,2f12.4,3x,f8.6)')
     1	       X(2*k+4)-zero,SIGX(2*k+4),dspx(k),q,
     2	       X(2*k+3),SIGX(2*k+3),x(4)
              endif
	      else
	        write(9,'(f10.5,3f8.3,f10.1)')x(2*k+4),x(2*k+3),x(3),x(4)
	1		,fax
	      endif
	      x(nper*k+nc) = 999.9
	    end do
   	  end if
	  if (single) then
		READ(2,'(a)')
C READ DATA FROM FILE
          do i = 1,35
	      READ(2,*)ANGLE(i),cps(i)
	    enddo
	  endif
   	  if (step)then
	     low=ipnt2
	  else
	     low=1
	  endif
	  call pgpage
	  go to 90
	endif
	if(kasymm.eq.0)ifirst = 0
	write(*,'(a,$)')' Continue with Same Parameters (Y,<N>):  '
	read(*,'(a)')jresp
	if(iasymm.eq.0.and.(jresp.eq.'y'.OR.jresp.eq.'Y'))go to 115
	if(jresp.ne.'y'.and.jresp.ne.'Y')then
        if(iasymm.ne.0)then
	    write(*,'(2a,$)')' Type New Values for S/L and D/L '
     1		,'(Half Sizes):'				  
          read(*,'(2f10.0)')zsam,zdet
	    if (zsam.gt.0.0)sam=zsam
	    if(zdet.gt.0.0)det=zdet
	  endif
	endif
	if (iasymm.ne.0)then
	  write(*,'(a,$)')' Do you want to refine S/L? (Y,<N>):'
	  read(*,'(a)')iresp
	  irefsam = 0
	  if(iresp.eq.'y'.or.iresp.eq.'Y')irefsam = 1
	  write(*,'(a,$)')' Do you want to refine D/L? (Y,<N>):'
	  read(*,'(a)')iresp
	  irefdet = 0
	  if(iresp.eq.'y'.or.iresp.eq.'Y')irefdet = 1
	endif
	if (jresp.eq.'y'.OR.jresp.eq.'Y')go to 115
	go to 95
	end
	SUBROUTINE READTA
C
C ROUTINE TO READ DATA
C
	implicit none
	include 'data_com.for'
	include 'options_com.for'
	include 'a_com.for'
	CHARACTER FLNAM*80,sttime*8,stdate*9
      character inputar*20,flesd*1
   	character pks
   	character ostep
	logical prof
      integer*4 icps(maxdta+2),j,ndat,nrec,i,jj,kk,ip,iraw,itype,ntoread
	real tthlo,stepsz,ang,refmon,angi,stpsz,angf,cntim,oscst,count
	real oscfi,oscsp,time,xmon,angmn,c0,c1,timedat,stdmon,ratemon,tth0
	equivalence (icps,cps)
C
	NDATA=0
      refmon = 0.0
	single = .false.
	write(*,9000)
9000	FORMAT('0Step-Scan Data Peak Fitting Program - 31-Mar-98'
     1/' Uses pseudo-Voigt function with gamma (fwhm), and eta'
     2/' Permitted values of eta between 0.0 - 1.3'
     3/' Asymmetry Version with Adjustable S_L and D_L'//)
   	prof = .false.
   	esdinc = .false.
   	pksinc = .false.
   	step = .false.
100	write(*,'(a)')' Types of Input Files Supported'
     1	  ,'01 - Profin format',' 2 - GSAS format',' 3 - X7A Raw data'
     2	  ,' 4 - PSD Binary Frame',' '
      write(*,'(a,$)')' Enter Type of File :  '
	read(*,'(i5)',err=100,end=10050)itype
	if (itype.le.0.or.itype.gt.4)go to 100
	go to (1000,2000,3000,4000),itype
c
c Read Profin Format Here
c
1000    prof = .true.
   	write(*,'(a,$)')' Does the file contain esds (<y>/n)?  '
   	read(*,'(A)')flesd
   	if ((flesd.ne.'n').and.(flesd.ne.'N')) esdinc = .true.
1005	write(*,'(/a,$)')' Type name of input file:  '
        read(*,'(a)')FLNAM
        if (flnam .eq. ' ')return
	filename=flnam
        OPEN(UNIT=2,FILE=FLNAM,STATUS='OLD',err=1300)
C
C read profin header
C
	read(2,'(a)')ptitle
   	read(2,'(3f8.2)',err=1030)angi,stpsz,angf
C
C	read data, calculate angle
C
1010	ndata = 0
   	ntoread = ((angf-angi)/stpsz+.5)/10+1 
   	do jj=1,ntoread
   	    read(2,'(10f8.0)',end = 1020)(cps(ndata + i),i=1,10)
   	    if(esdinc)read(2,'(10f8.0)',end=1020)(sigf(ndata+i),i=1,10)
   	    ndata = ndata+10
   	    if ((ndata+10).gt.maxdta) go to 1020
   	end do
1020	close(2)
   	do kk=1,ndata
   	    angle(kk)=angi+stpsz*(kk-1)
   	end do
   	IF((NDATA+10).GT.MAXDTA)
     1	  write(*,'(a)')' ***** Too Many Data for Arrays *** '
	go to 10000
1030	write(*,'(a)')' ***** Error Reading File *****'
	go to 1005
1300	write(*,*)' File NOT Found!!'
	go to 1005
c
c GSAS Format
c
2000	write(*,'(A,$)')' Type Name of Input File?   '
        read(*,'(a)')FLNAM
        if(flnam.eq.' ')return
	filename=flnam
        OPEN(UNIT=2,FILE=FLNAM,STATUS='OLD',err=2000)
	READ(2,'(a)')PTITLE
	read(2,'(a)')filename
        filename(1:4) = '    '
        call stripsp(filename)
        call copyto(filename,inputar)
        call stripsp(filename)
        call copyto(filename,inputar)
        READ(inputar,'(i10)')ndat
        call stripsp(filename)
        call copyto(filename,inputar)
        READ(inputar,'(i10)')nrec
	  i = index(filename,'CONST')
        do j = 1,i+5
          filename(j:j) = ' '
        enddo
        call stripsp(filename)
        call copyto(filename,inputar)
        read(inputar,'(f20.0)')tthlo
        call stripsp(filename)
        call copyto(filename,inputar)
        read(inputar,'(f20.0)')stepsz
	j = index(filename,'ESD')
C READ DATA FROM FILE
	if(ndat.gt.maxdta)ndat=maxdta
	if (j .ne. 0) then
c ESD's in file
	  read(2,'(10f8.0)')(cps(i),sigf(i),i=1,ndat)
	else
	  read(2,'(10(2x,f6.0))')(cps(i),i=1,ndat)
	  do i = 1,ndat
	    if (cps(i) .gt. 0.0) then
	      sigf(i) = sqrt(cps(i))
	    else
	      sigf(i) = 1.0
	    endif
	  enddo
	endif
	do i=1,ndat
	  ang=0.01*(tthlo+(i-1)*stepsz)
	  ndata=ndata+1
	  angle(ndata)=ang
	  cps(ndata) = cps(i) 
	  sigf(ndata) = sigf(i)
	enddo
	esdinc = .true.
	go to 10000
c
c X7A Raw Data
c
3000	write(*,'(/a,$)')' Type name of input file:  '
3002	read(*,'(a)')FLNAM
	if(FLNAM .eq.' ')go to 10000
	filename=flnam
        OPEN(UNIT=2,FILE=FLNAM,STATUS='OLD',err=3100)
	READ(2,'(a)')PTITLE
C SKIP NEXT FOUR LINES OF TITLE
	READ(2,'(a)')FLNAM,FLNAM,FLNAM,FLNAM
	READ(2,'(23x,f11.0)')ANGI,ANGF,STPSZ,CNTIM,OSCST,OSCFI,OSCSP
	READ(2,'(22x,a8,4x,a9///)')STTIME,STDATE
C READ DATA FROM FILE
3005	READ(2,'(2f10.3,2f15.0)',END=3020,err=3020)ANGLE(NDATA+1),TIME
     1   ,COUNT,XMON
	IF(TIME.LE.0.0)GO TO 3020
	NDATA=NDATA+1
	IF(NDATA.GT.MAXDTA)GO TO 3010
	IF(REFMON.EQ.0.0)THEN
	  REFMON=XMON
	END IF
	  CPS(NDATA)=COUNT*REFMON/XMON
	GO TO 3005
3010	write(*,'(a)')' ***** Too Many Data for Arrays *** '
	NDATA=NDATA-1
3020	CLOSE(UNIT=2)
	write(*,'(a,$)')' Type name of next file: '
	GO TO 3002
C
C SORT DATA IN ASCENDING ORDER
C
3030	DO I=1,NDATA-1
	  IP=I
	  ANGMN=ANGLE(I)
	  DO J=I+1,NDATA
	    IF(ANGLE(J).LT.ANGMN)THEN
	      IP=J
	      ANGMN=ANGLE(J)
	    END IF
	  enddo
	  IF(IP.NE.I)THEN
C SWAP ENTRIES
	    ANGLE(IP)=ANGLE(I)
	    ANGLE(I)=ANGMN
	    ANGMN=CPS(IP)
	    CPS(IP)=CPS(I)
	    CPS(I)=ANGMN
	  END IF
	enddo
	RETURN
3100	write(*,*)' File NOT Found!!'
	go to 3000
c
c PSD Binary Format
c
4000    open(unit=2,FILE='psdcalib.cal',STATUS='old',err=4005)
	iraw = 0
	read(2,*,err=4010)c0,c1
	close(unit=2)
	go to 4010
4005	write(*,'(a,$)')' Calibration File Not Found, Enter Ch0 and '
     1     //'Deg/Ch:'
	read(*,'(2f10.0)')c0,c1
	if(c0 .eq. 0)iraw = 1
4010	write(*,'(/a,$)')' Type name of input file:  '
4020    read(*,'(a)')FLNAM
	filename=flnam
        OPEN(UNIT=2,FILE=FLNAM,STATUS='OLD'
     1      ,form='unformatted',err=4100)
	read(2)ptitle
C read next stuff
	READ(2,err=4030)timedat,stdmon,ratemon,tth0
	go to 4040
4030	write(*,'(2A,$)')' Data file does not contain Detector'
     1   ,' 2Theta, Enter Value: '
	read(*,'(f10.0)')tth0
4040	READ(2,err=4110)ndata
C READ DATA FROM FILE
4050	READ(2,err=4110)(icps(i),i=1,ndata)
	DO I=1,ndata
	  cps(i)=icps(i)
c convert channel number to degrees 
	  if(iraw .eq. 0) then
	    angle(i)=tth0+(i-c0)*c1
	  else
	    angle(i) = i
	  endif
	enddo
	close(unit=2)
	return
4100	write(*,'(a)')' **** File NOT Found. ****'
	go to 4010
4110	write(*,'(a)')' **** Error Reading Data ****'
	go to 4010
c
c Get options here
c
10000 write(*,'(a,$)')' Do you want a .pks file (y/<n>)?  '
   	read(*,'(A)')pks
	pksinc = .false.
   	if ((pks.eq.'y').or.(pks.eq.'Y')) then
   	  pksinc = .true.
	  wave=0.0
	  do while (wave.eq.0.0)
	    write(*,'(A,$)')' What is the wavelength, and zero offset?  '
          read(*,'(f10.6)')wave,zero
	  enddo
      endif
      write(*,'(a,$)')' Do you want the stepping option (y/<n>)?  '
      read(*,'(a)')ostep
      step = .false.
      if ((ostep.eq.'y').or.(ostep.eq.'Y')) step = .true.
      if(step)then
	  write(*,'(a,$)')' Enter Starting Angle? '
	  read(*,'(f10.0)')anglow
      else
	  anglow = angle(1)
      endif
      write(*,'(a,$)')' Give the starting fwhm <0.04>:  '
      read(*,'(f10.6)')pkwidth
      write(*,'(a,$)')' Do you want individual peak widths (Y,<N>)?: '
      read(*,'(a)')ostep
      indwid = .false.                       
      if ((ostep.eq.'y').or.(ostep.eq.'Y')) indwid = .true.
      return
10050 stop
      end
      subroutine stripsp(inp)
	implicit none
      character*80 inp
	integer i,j

      i = 1
      do while (inp(i:i) .eq. ' ')
        i = i + 1
      enddo
      do j = i,80
        inp(j-i+1:j-i+1) = inp(j:j)
      enddo
      do j =  80-i+2,80
        inp(j:j) = ' '
      enddo
      return
      end
      subroutine copyto (inp,oup)
	implicit none
	integer i,j,jj
      character*(*) inp,oup
!
! N.B. This routine uses j and jj to overcome a Microsoft Fortran Powerstation 4.0
!       compiler bug.
!	
      i = 1
      jj = 1
	oup = ' '
      do while (inp(i:i) .ne. ' ')
	  j = jj
        oup(j:j) = inp(i:i)
        inp(i:i) = ' '
        jj = jj + 1
        i = i + 1
      enddo
	oup(jj:jj) = ','
      return
      end
	SUBROUTINE DISPLY(angd,cpsd,ILOW,IHIGH,IPNT1,IPNT2,IDSPLY)
	implicit none
	real angd(*),cpsd(*)
	include 'gplsc_com.for'
	include 'data_com.for'
	include 'display_com.for'
	include 'a_com.for'
	real xx(maxdta),yy(maxdta)
	logical hardf
	integer symbol,ilowi,ilow,ihighi,ihigh,idsply
	integer i,ii,j,jj,kk
	integer iresp,ipnt1,ipnt2
	real difmx,d,oldcpsmn,ytext,x1,x2,y1
	character*1 alph
	character*13 string2
	character*40 text(7)
	character*13 vtext(4,4)
	real*4 xtext(4),fjust(4)
	data fjust/0.0,1.0,1.0,1.0/
C
	ILOWI = ILOW
	IHIGHI = IHIGH
C 
C first call, initialize graphics
C
	if (idsply .eq. 99) then
	  call bgraf(icrt,lo,li)
 	  call pgask(.false.)
	  return
	end if
C
C find the data limits
C
	hardf = .false.
90	anglmx=0.0
	anglmn=1.0e6
	cpsmn=1.0E30
	cpsmx=0.0
	difmx=0.0
	do i=ilowi,ihighi
	  if(angd(i).gt.anglmx)anglmx=angd(i)
	  if(angd(i).lt.anglmn)anglmn=angd(i)
	  if(cpsd(i).gt.cpsmx)cpsmx=cpsd(i)
	  if(cpsd(i).lt.cpsmn)cpsmn=cpsd(i)
	  if(idsply.eq.2)then
	    d=abs(cpsd(i)-yobs(i))
	    if(d.gt.difmx)difmx=d
	  end if
	enddo
	if (idsply.eq.2) then
	  oldcpsmn=cpsmn
	  cpsmn = cpsmn - 3 * difmx
	end if
	if (idsply.eq.0) cpsmn = 0.0
C
C open output, set up origin, plot axes
C
	if (hardf) then
	  call egraf(icrt,lo,li)
	  call opnhd(lo,li)
 	  call pgask(.false.)
	end if
	call pgenv(anglmn,anglmx,cpsmn,1.1*cpsmx,0,0)
	if (hardf) then
	  call pglabel('2\gh, degrees','Intensity (cps) relative to
     1 100ma',ptitle)
	end if
C
C plot data
C
	ii=0
	do i=ilowi,ihighi
	  ii=ii+1
	  xx(ii)=angd(i)
	  yy(ii)=cpsd(i)
	end do
	npts = ihighi - ilowi + 1
	call pgline(npts,xx,yy)
C
C	if selected plot:
C
	if (idsply.eq.1) then	
	  write(*,5000)
5000	  format('          Give number of peaks: ',$)
	  read(*,5010)nb
5010	  format(i10)
	  if(nb.eq.0)then
          call clear
	    return
	  end if
	  do j=1,nb
	    write(*,'(a,i2)')'+         Move cursor to peak ',J
	    pos(j)=(anglmx+anglmn)/2
	    inten(j)=cpsmx
	    call pgcurse(pos(j),inten(j),alph)
	  enddo
	  call clear
	end if
C
C	if refined data:
C
	IF(IDSPLY.EQ.2)THEN
C
C 	PLOT OBSERVATIONS
C
	  ii=0
	  do i=ilowi,ihighi
	    ii=ii+1
	    xx(ii)=angd(i)
	    yy(ii)=yobs(i)
	  end do
	  npts = ihighi - ilowi + 1
	  symbol = ichar('+')
	  call pgsci(2)
	  call pgpoint(npts,xx,yy,symbol)
	  call pgsci(1)
C
C 	PLOT RESIDUALS
C
	  ii=0
	  do i=ilowi,ihighi
	    ii=ii+1
	    xx(ii)=angd(i)
	    yy(ii)=(yobs(i)-cpsd(i))+oldcpsmn-1.8*difmx
	  end do
	  npts = ihighi - ilowi + 1
	  call pgline(npts,xx,yy)
c
c Individual envelopes
c
	  do i = 1,nb
	  call pgsci(i+1)
	    do j = 1,npts
	      xx(j) = angd(ilowi+j-1)
	      yy(j) = bg(j) + pkval(i,j)
	    enddo
	    call pgline(npts,xx,yy)
	  enddo
	  call pgsci(1)
C
C	reflection markers
C
	  do i=1,nb
	    call pgmove (posn(i),oldcpsmn+0.015*(cpsmx-cpsmn))
	    call pgdraw (posn(i),oldcpsmn-0.035*(cpsmx-cpsmn))
	  end do
c
c	text on plot
c
      if (hardf) then
	  call pgsch (0.75)
	  write(string2,'(f8.3)')fax
	  text(1)='LEAST-SQUARES RESULTS:'
	  text(2)='GOF = '//string2
	  text(3)=' '
	  text(4)='PARAMETER        VALUE         SIGMA'
	  ytext=1.1*cpsmx-0.05*(cpsmx-cpsmn)
	  xtext(1)=anglmx-0.34*(anglmx-anglmn)
	  xtext(2)=anglmx-0.28*(anglmx-anglmn)
	  xtext(3)=anglmx-0.14*(anglmx-anglmn)
	  xtext(4)=anglmx-0.02*(anglmx-anglmn)
	  do ii=1,4
	    ytext=ytext-0.025*(1.1*cpsmx-cpsmn)
	    call pgtext(xtext(1),ytext,text(ii))
	  end do
c output ETA
	  vtext(1,1)='ETA '
	  vtext(1,2)=' '
	  write(vtext(1,3),'(f13.5)')x(3)
	  write(vtext(1,4),'(f13.5)')sigx(3)
	  ytext=ytext-0.025*(1.1*cpsmx-cpsmn)
	  do jj=1,4
	    call pgptext(xtext(jj),ytext,0.0,fjust(jj),vtext(1,jj))
	  enddo
c Output single FWHM
	  if (.not.indwid)then
	    vtext(1,1)='FWHM'
	    vtext(1,2)=' '
	    write(vtext(1,3),'(f13.5)')x(4)
	    write(vtext(1,4),'(f13.5)')sigx(4)
	    ytext=ytext-0.025*(1.1*cpsmx-cpsmn)
	    do jj=1,4
	      call pgptext(xtext(jj),ytext,0.0,fjust(jj),vtext(1,jj))
	    enddo
	  endif
c output individual line parameters
 	  do ii=1,nb
	    jj=1
	    if (indwid)then
	      vtext(1,1)='FWHM'
	      jj = 2
	    endif
	    vtext(jj,1)='INT.'
	    vtext(jj+1,1)='POS.'
	    do jj=1,nper
	        kk=nper*(ii-1)+nc+jj
	        write(vtext(jj,2),'(i2)')ii
	        write(vtext(jj,3),'(f13.5)')x(kk)
	        write(vtext(jj,4),'(f13.5)')sigx(kk)
	        ytext=ytext-0.025*(1.1*cpsmx-cpsmn)
	        do kk=1,4
	          call pgptext(xtext(kk),ytext,0.0,fjust(kk),vtext(jj,kk))
	        enddo
	    end do
	  end do
	  if (kasymm.ne.0) then
            vtext(1,1)='S/L'
	      vtext(2,1)='D/L'
            vtext(1,2)=' '
            vtext(2,2)=' '
	      vtext(1,3)=' '
	      vtext(2,3)=' '
	      vtext(1,4)=' '
	      vtext(2,4)=' '
	      n1 = nper * nb + nc + 1 
            write(vtext(1,3),'(f13.5)')x(n1)
            if (irefsam.ne.0) write(vtext(1,4),'(f13.5)')sigx(n1)
            write(vtext(2,3),'(f13.5)')x(n1+1)
            if (irefdet.ne.0) write(vtext(2,4),'(f13.5)')sigx(n1+1)
	      do jj=1,2
	        ytext=ytext-0.025*(1.1*cpsmx-cpsmn)
	        do kk=1,4
	          call pgptext(xtext(kk),ytext,0.0,fjust(kk),vtext(jj,kk))
	        enddo
	      enddo
	  endif
	endif
	call pgsch (1.0)
C
C	if hardcopy, close plot
C
	if (hardf) then
	    call pgiden
	    call pgsch(0.75)
	    call pgmtext('B',5.0,-0.05,0.0,filename)
	    call pgsch(1.0)
	    hardf = .false.
	    call clhd(lo,li)
	    call bgraf(icrt,lo,li)
	else
C
C	otherwise decide if hardcopy and/or refit
C
	    write(*,'(a,$)')'   Repeat this plot on hardcopy (Y,<N>)?  '
	    read(*,'(a1)')IRESP
	    IF(IRESP.EQ.'Y'.OR.IRESP.EQ.'y') hardf = .true.
	    if (hardf) then
		    call clhd(lo,li)
 	        call bgraf(icrt,lo,li)
	        go to 90
	    else
	        write(*,'(a,$)')'   Add another line (Y,<N>)?  '
		read(*,'(a1)')iresp
	        if(iresp.eq.'y'.or.iresp.eq.'Y') then
		    nb=nb+1
		    j = nb
	    	    pos(j)=(anglmx+anglmn)/2
	    	    inten(j)=cpsmx
	    	    call pgcurse(pos(j),inten(j),alph)
		endif
		    call clear		    
	    end if
	  end if
	end if
C
C	if full plot:
C
	if (idsply.ne.0) return
	write(*,'(a)')' Select the left edge of the region '
     1     //'(right button to exit)'
	call pgcurse(x1,y1,alph)
	if(alph.eq.'D'.or.alph.eq.'d')then		
	  stop
	end if
	write(*,'(/a)')' Select the right edge of the region' 
     1     //'(right button to expand)'
	call pgcurse(x2,y1,alph)
C
C CALCULATE POSITION IN POINT NUMBER
C
	IPNT1 = 0
	IPNT2 = 0
	DO 140 I=ILOWI,IHIGHI
	  IF(IPNT1.EQ.0.AND.angd(I).GE.X1)IPNT1=I
	  IF(IPNT2.EQ.0.AND.angd(I).GE.X2)IPNT2=I
140	CONTINUE
C SET UP TO EXPAND IF NECESSARY
	IF(ALPH.EQ.'D'.OR.ALPH.EQ.'d')THEN
	  ILOWI=IPNT1
	  IHIGHI=IPNT2
	  call clear
	  GO TO 90
	END IF
	call clear
	RETURN
	END
	SUBROUTINE GPLS
C 
C     GENERAL PURPOSE LEAST SQUARES PROGRAM 
C     MODIFIED VERSION OF MOWLS  D. E. COX OCTOBER 1981 
C     FORMAT FOLLOWS THAT OF HAMILTON IN STATISTICS IN PHYSICAL SCIENCES
C     DIMENSIONED FOR MXD OBSERVATIONS AND nparam PARAMETERS
C
C Original Version keeps entire observation matrix of
C    Ndata by Nparams in memory.  Converted to build normal
c    equations matrix one observation at a time.
C    Modifications 1-Oct-1992 by Larry W. Finger
C 
	implicit none
	integer neta
	PARAMETER (Neta=3)
	include 'gplsc_com.for'
	include 'a_com.for'
	real oldfax,sumwdel2,tth,wgt,del,getval
      real pnew(nparam)
	integer isel(nparam),ncyc,i,kcyc,ncount,j,jj,k,kk,idone
      real*8 amat(nparam,nparam),bmat(nparam),dsave(nparam)
      real*4 deriv(nparam),xfr,pold(nparam),newx(nparam)
C
C OPEN INPUT AND OUTPUT FILES
c
C     Iasymm is Non-zero for asymmetric peaks - Van Laar and Yelon (JAC
C	17,47,1984).  SAM is S/L, the effective illumination half width of sample 
C     scaled by sample to detector distance,
C	DET is D/L, the scaled half width of detector slit
C 
      NCYC=ICYC
	no = npts
	i  = 0
	oldfax = 1.0e10
C 
C     ESD TAKEN AS SQUARE ROOT OF OBSERVED VALUE IF NOT SET
C 
      do i=1,no
	  if(sigy(i).le.0.0)then
	    sigy(i)=sqrt(yobs(i))
	    if(sigy(i).le.0.0)sigy(i)=1.0
	  endif
      end do
    7 kcyc=0
c
c start cycle
c
C SET PARAMETER SELECTION FOR CYCLE
C 
   90 if(kcyc.eq.0)THEN
        READ(RFINE1,'(80i1)')(ISEL(I),I=1,nparam)
	else
        READ(RFINE2,'(80i1)')(ISEL(I),I=1,nparam)
	endif
c Count number of refined parameters and change refinement switches into pointers
      ncount=0
      do i=1,np
        if(isel(i).ne.0) then
          ncount=ncount+1 
          isel(i) = ncount
        endif
      enddo
      kcyc=kcyc+1
c Calculate fraction of shift to apply
	xfr = 0.2 * kcyc
      if(xfr.gt.0.9)xfr = 0.9
c Clear normal equations matrices
      do i = 1,nparam
	    bmat(i) = 0.0
	    do j = 1,nparam
	      amat(j,i) = 0.0
	    enddo
      enddo
      sumwdel2 = 0.0
	open(unit=87,file='test.dmp',status='unknown')
c Loop through observations
      do i = 1,no
	    tth = astart + (i-1)*astep	!Calculate 2theta for this observation
c evaluate the profile and derivatives
	    yc(i) = Getval(x,tth,deriv,bg(i),pkval(1,i))
	write(87,'(f8.3,10f8.2)')tth,(bg(i)+pkval(jj,i),jj=1,nb)
	    wgt = 1.0/sigy(i)**2
	    del = yobs(i) - yc(i)
	    sumwdel2 = sumwdel2 + wgt * del**2
	    do jj = 1,np
	      if(isel(jj).ne.0)then
	        j = isel(jj)
	        bmat(j) = bmat(j) + wgt * del * deriv(jj)
	        do kk = jj,np
	          if(isel(kk).ne.0)then
		        k = isel(kk)
	    	    amat(k,j) = amat(k,j) + wgt * deriv(jj)*deriv(kk)
	          endif
	        enddo
	      endif
	    enddo
c end of loop through observations
      enddo
	close(unit=87)
      fax = sumwdel2 / (no - ncount)
	write(*,'(a,f10.2)')' GOF:',fax
	open(unit=83,file='test.out',status='unknown',access='append')
	write(83,'(20f8.3)')fax,(x(i),i=1,ncount)
	close(unit=83)
	if (fax .le. 1.1*oldfax) then
	  oldfax = fax
c begin conversion of A to correlation matrix - improves accuracy
c of inversion
        do i = 1,ncount
    	    dsave(i) = 1.0/sqrt(amat(i,i))
        enddo
c Now do conversion and symmetrize
        do i = 1,ncount
	    do j = i,ncount
	      amat(j,i) = amat(j,i) * dsave(i) * dsave(j)
 	      amat(i,j) = amat(j,i)
	    enddo
        enddo
c invert correlation matrix
        call smi10(amat,ncount)
c correct inverse for conversion to correlation matrix
        do j = 1,ncount
	    do i = 1,ncount
	      amat(i,j) = amat(i,j) * dsave(i) * dsave(j)
	    enddo
        enddo
c Calculate shifts and new increment for next cycle
        do i = 1,ncount
	    newx(i) = 0.0
          do j = 1,ncount
	      newx(i) = newx(i) + amat(i,j) * bmat(j)
	    enddo
        enddo
        idone = 0
        do i=1,np
          if(isel(i).ne.0) then
            delx(i)=newx(isel(i))*xfr
            pnew(i)=delx(i)+x(i) 
C Keep parameters positive
		  if (pnew(i) .lt. 0.0) pnew(i) = 0.5 * x(i)
            sigx(i)=sqrt(fax*amat(isel(i),isel(i)))
            if(abs(delx(i)/sigx(i)).gt.0.1)idone=1
c Constrain Eta
            if(i.eq.neta.and.pnew(i).gt.1.3)pnew(i)=1.3
	      pold(i) = x(i)
            x(i)=pnew(i) 
	    else
	      delx(i) = 0.0
	      sigx(i) = 0.0
	    endif
        enddo
	else
c refinement diverging - reduce interval
	  do i = 1,np
	    if(isel(i).ne.0) then
	      x(i) = pold(i) + 0.01 * (pnew(i) - pold(i))
	    endif
	  enddo
	  idone = 1
	endif
      ICYC=ICYC-1
      IF(idone.ne.0.and.kcyc.lt.10) GO TO 90
      return
      end 
c Matrix Inversion
      SUBROUTINE SMI10(D,N)
	implicit none
	integer i,j,n,lr
	include 'gplsc_com.for'
      real*8 D(nparam,nparam),S(nparam),denom
c
      do j=1,n
        do i=1,j
	    d(i,j)=-d(i,j)
	    d(j,i)=d(i,j) 
	  enddo
	  d(j,j)=1.+d(j,j)
      enddo
      do lr=1,n 
	  denom=1.-d(lr,lr)
        if(abs(denom).lt.1.0e-15)then
	    write(*,*)'Matrix Singular'
	    denom=1.0e-15
	  end if
	  d(lr,lr)=1.0/denom
        do j=1,n 
          s(j)=d(lr,j) 
          if((j-lr).ne.0) then
	      d(j,lr)=d(j,lr)*d(lr,lr)
	      d(lr,j)=d(j,lr) 
          endif
	  enddo
	  do j=1,n 
	    if(j.ne.lr)then
	      do i=1,j
	        if(i.ne.lr) then
	          d(i,j)=d(i,j)+d(i,lr)*s(j)
	          d(j,i)=d(i,j) 
	        endif
	      enddo
	    endif
	  enddo
      enddo
      return
      end 
      real*4 function getval(piz,twoth,deriv,bg,pkval)
      implicit none
      real*4 piz(*),deriv(*)
      real*4 twoth
      real*4 gamma,eta,zz,bg,pkval(*)
	include 'a_com.for'
      real*4 profval,temp,dPrdT,dPrdG,dPrdE,dPrdS,dPrdD
      integer i,nl
c	 
C 
C     PIZ ARE PARAMETERS.
C     PIZ(1) AND  PIZ(2) ARE BACKGD ON LOW AND HIGH SIDES
C     PIZ(3) IS ETA
C     IF indwid is false,  PIZ(4) IS GAMMA
C     IF indwid is true, each peak has own width
C     LINEAR INTERPOLATION OF LOW AND HIGH BACKGROUND 
C 
C 
      ETA=PIZ(3)
c
C     modified for Van Laar and Yelon peak shapes - JAC 17,47(1984) 
C 
c---- det (piz(np)) and sam(piz(np-1)) are 1/2 detector slit and sample widths divided by
c       sample to detector distance, respectively
c
c Get background and derivatives for this point
c
      zz=piz(1)+(piz(2)-piz(1))*(twoth-astart)
	bg = zz
	nl = 0
      deriv(1) = 1.0 - twoth + astart
      deriv(2) = twoth - astart
c
c initialize derivatives wrt eta, gamma, and sam
c
      deriv(3) = 0.0
	if (.not.indwid) then
        GAMMA=PIZ(4)
        deriv(4) = 0.0
	endif
      if(kasymm.ne.0)then
c
        deriv(np) = 0.0
	  deriv(np-1) = 0.0
        getval = ZZ
        DO I=5,NP-2,nper
		  if (indwid) then
		    GAMMA = PIZ(i-1)
		  endif
	      temp = PROFVAL(ETA,GAMMA,piz(np-1),piz(np),TWOTH,PIZ(I+1)
     1		,dPrdT,dPrdG,dPrdE,dPrdS,dPrdD,.true.)
	      nl = nl + 1
	      pkval(nl) = PIZ(i)*temp
	      getval=getval + PIZ(I)*temp
	      deriv(i) = temp
	      deriv(i+1) = dPrdT*piz(i)
	      deriv(3) = deriv(3) + piz(i)*dPrdE
	      deriv(np-1) = deriv(np-1) + piz(i)*dPrdS
	      deriv(np) = deriv(np) + piz(i)*dPrdD
	      temp = piz(i)*dPrdG
		  if (indwid) then
	        deriv(i-1) = temp
		  else
	        deriv(4) = deriv(4) + temp
	      endif
	    enddo
      else
c
c Section with no asymmetry below
c
        getval=ZZ
        DO I=5,NP,nper
		  if (indwid) then
		    GAMMA = PIZ(i-1)
		  endif
	      temp = PROFVAL(ETA,GAMMA,0.0,0.0,TWOTH,PIZ(I+1),dPrdT
     1		,dPrdG,dPrdE,dPrdS,dPrdD,.false.)
	      nl = nl + 1
	      pkval(nl) = PIZ(i)*temp
	      getval = getval + PIZ(I)*temp
	      deriv(i) = temp
	      deriv(i+1) = piz(i)*dPrdT
		  deriv(3) = deriv(3)+piz(i)*dPrdE
	      temp = piz(i)*dPrdG
		  if (indwid) then
	        deriv(i-1) = temp
		  else
	        deriv(4) = deriv(4) + temp
	      endif
          enddo
      endif
      return
      end
      real*4 function Profval( Eta , Gamma , S_L , D_L , TwoTH , 
     1   TwoTH0 , dPRdT, dPRdG, dPRdE , dPRdS , dPRdD , Use_Asym )
c Returns value of Profile
c   Eta is the mixing coefficient between Gaussian and Lorentzian
c   Gamma is the FWHM
c   S_L is source width/detector distance
c   D_L is detector width/detector distance
c   TwoTH is point at which to evaluate the profile
c   TwoTH0 is two theta value for peak
c   dPRdT is derivative of profile wrt TwoTH0
c   dPRdG is derivative of profile wrt Gamma
c   dPRdE is derivative of profile wrt Eta
c   dPRdS is derivative of profile wrt S_L
c   dPRdD is derivative of profile wrt D_L
c   Use_Asym is true if asymmetry to be used
c
c Asymmetry due to axial divergence using the method of Finger, Cox and
c    Jephcoat, J. Appl. Cryst. 27, 892, 1992.

      implicit none
      real*4 Eta , Gamma , S_L , D_L , TwoTH 
      real*4 TwoTH0 , dPRdT, dPRdG, dPRdE , dPRdS , dPRdD
      logical Use_Asym
      integer*4 NTERMS(14)
      integer Fstterm(14)
      real*4 RAD

      integer*4 ArrayNum , K , NGT, ngt2 , it, i
      real*4 CsTH             	! cos(theta)
      real*4 TTH		! tan(theta)
      real*4 SnTwoTH		! sin(twoth)
      real*4 CsTwoTH 		! cos(twoth)
      real*4 ApB		! (S + H)/L 
      real*4 AmB		! (S - H)/L 
      real*4 ApB2 		! (ApB) **2
      real*4 Einfl              ! 2phi value for inflection point 
      real*4 Emin               ! 2phi value for minimum 
      real*4 dEmindA            ! derivative of Emin wrt A
      real*4 tmp , tmp1 , tmp2  ! intermediate values 
      real*4 WP(1883) , XP(1883)! Storage for Gauss-Legendre weights and intervals 
      real*4 Delta              ! Angle of integration for comvolution 
      real*4 dDELTAdA           ! derivative of DELTA wrt A (S/L)
      real*4 sinDELTA           ! sine of DELTA 
      real*4 cosDELTA           ! cosine of DELTA 
      real*4 tanDELTA           ! tangent of DELTA 
      real*4 RcosDELTA          ! 1/cos(DELTA) 
      real*4 F , dFdA
      real*4 G , dGdA , dGdB , PsVoigt
      real*4 sumWG , sumWRG , sumWdGdA , sumWRdGdA ,sumWdGdB , sumWRdGdB
      real*4 sumWGdRdG , sumWGdRdE , sumWGdRdA , sumWGdRdB , sumWGdRd2t 
      data RAD /57.2957795/  
      data NTERMS/6,10,20,40,60,80,100,150,200,300,400,
     1   600,800,1000/
      data Fstterm/0,3,8,18,38,68,108,158,233,333,483,
     1   683,983,1383/
!
! Values for the abscissas and weights of the Gauss-Legendre
!  N-point quadrature formula have been precomputed using routine
!  Gauleg from "Numerical Recipes" (Press, Flannery, Teukolsky
!  and Vetterling, 1986, Cambridge University Press,
!  ISBN 0 521 30811 9), and are stored in the DATA statements
!  for XP and WP below.
!
      data (xp(i),i=   1,  40)/
     1.2386192E+00,.6612094E+00,.9324695E+00,.1488743E+00,.4333954E+00,
     2.6794096E+00,.8650634E+00,.9739065E+00,.7652652E-01,.2277859E+00,
     3.3737061E+00,.5108670E+00,.6360537E+00,.7463319E+00,.8391170E+00,
     4.9122344E+00,.9639719E+00,.9931286E+00,.3877242E-01,.1160841E+00,
     5.1926976E+00,.2681522E+00,.3419941E+00,.4137792E+00,.4830758E+00,
     6.5494671E+00,.6125539E+00,.6719567E+00,.7273183E+00,.7783057E+00,
     7.8246122E+00,.8659595E+00,.9020988E+00,.9328128E+00,.9579168E+00,
     8.9772599E+00,.9907262E+00,.9982377E+00,.2595977E-01,.7780933E-01/
      data (xp(i),i=  41,  80)/
     1.1294491E+00,.1807400E+00,.2315436E+00,.2817229E+00,.3311428E+00,
     2.3796701E+00,.4271737E+00,.4735258E+00,.5186014E+00,.5622789E+00,
     3.6044406E+00,.6449728E+00,.6837663E+00,.7207165E+00,.7557238E+00,
     4.7886937E+00,.8195375E+00,.8481720E+00,.8745199E+00,.8985103E+00,
     5.9200785E+00,.9391663E+00,.9557223E+00,.9697018E+00,.9810672E+00,
     6.9897879E+00,.9958405E+00,.9992101E+00,.1951138E-01,.5850444E-01,
     7.9740840E-01,.1361640E+00,.1747123E+00,.2129945E+00,.2509524E+00,
     8.2885281E+00,.3256644E+00,.3623048E+00,.3983934E+00,.4338754E+00/
      data (xp(i),i=  81, 120)/
     1.4686966E+00,.5028041E+00,.5361459E+00,.5686713E+00,.6003306E+00,
     2.6310758E+00,.6608599E+00,.6896376E+00,.7173652E+00,.7440003E+00,
     3.7695024E+00,.7938327E+00,.8169541E+00,.8388315E+00,.8594314E+00,
     4.8787226E+00,.8966756E+00,.9132631E+00,.9284599E+00,.9422428E+00,
     5.9545908E+00,.9654851E+00,.9749091E+00,.9828486E+00,.9892913E+00,
     6.9942275E+00,.9976499E+00,.9995538E+00,.1562898E-01,.4687168E-01,
     7.7806858E-01,.1091892E+00,.1402031E+00,.1710801E+00,.2017899E+00,
     8.2323025E+00,.2625881E+00,.2926172E+00,.3223603E+00,.3517885E+00/
      data (xp(i),i= 121, 160)/
     1.3808730E+00,.4095853E+00,.4378974E+00,.4657816E+00,.4932108E+00,
     2.5201580E+00,.5465970E+00,.5725019E+00,.5978475E+00,.6226089E+00,
     3.6467619E+00,.6702830E+00,.6931492E+00,.7153381E+00,.7368281E+00,
     4.7575981E+00,.7776279E+00,.7968979E+00,.8153892E+00,.8330839E+00,
     5.8499645E+00,.8660147E+00,.8812187E+00,.8955616E+00,.9090296E+00,
     6.9216093E+00,.9332885E+00,.9440559E+00,.9539008E+00,.9628137E+00,
     7.9707858E+00,.9778094E+00,.9838775E+00,.9889844E+00,.9931249E+00,
     8.9962951E+00,.9984920E+00,.9997137E+00,.1043694E-01,.3130627E-01/
      data (xp(i),i= 161, 200)/
     1.5216195E-01,.7299491E-01,.9379607E-01,.1145563E+00,.1352667E+00,
     2.1559181E+00,.1765016E+00,.1970082E+00,.2174290E+00,.2377550E+00,
     3.2579774E+00,.2780874E+00,.2980762E+00,.3179352E+00,.3376556E+00,
     4.3572289E+00,.3766466E+00,.3959001E+00,.4149811E+00,.4338813E+00,
     5.4525925E+00,.4711065E+00,.4894151E+00,.5075106E+00,.5253849E+00,
     6.5430303E+00,.5604390E+00,.5776036E+00,.5945165E+00,.6111703E+00,
     7.6275579E+00,.6436720E+00,.6595056E+00,.6750519E+00,.6903041E+00,
     8.7052554E+00,.7198995E+00,.7342299E+00,.7482404E+00,.7619248E+00/
      data (xp(i),i= 201, 240)/
     1.7752773E+00,.7882919E+00,.8009631E+00,.8132853E+00,.8252531E+00,
     2.8368613E+00,.8481049E+00,.8589789E+00,.8694787E+00,.8795996E+00,
     3.8893372E+00,.8986874E+00,.9076460E+00,.9162090E+00,.9243729E+00,
     4.9321340E+00,.9394890E+00,.9464346E+00,.9529678E+00,.9590857E+00,
     5.9647858E+00,.9700655E+00,.9749225E+00,.9793548E+00,.9833603E+00,
     6.9869373E+00,.9900843E+00,.9927999E+00,.9950829E+00,.9969323E+00,
     7.9983473E+00,.9993274E+00,.9998723E+00,.7834291E-02,.2350095E-01,
     8.3916184E-01,.5481311E-01,.7045093E-01,.8607145E-01,.1016708E+00/
      data (xp(i),i= 241, 280)/
     1.1172453E+00,.1327909E+00,.1483040E+00,.1637806E+00,.1792170E+00,
     2.1946095E+00,.2099541E+00,.2252472E+00,.2404850E+00,.2556638E+00,
     3.2707798E+00,.2858293E+00,.3008086E+00,.3157141E+00,.3305421E+00,
     4.3452890E+00,.3599510E+00,.3745247E+00,.3890065E+00,.4033927E+00,
     5.4176799E+00,.4318646E+00,.4459432E+00,.4599124E+00,.4737686E+00,
     6.4875086E+00,.5011288E+00,.5146260E+00,.5279969E+00,.5412382E+00,
     7.5543465E+00,.5673188E+00,.5801518E+00,.5928424E+00,.6053874E+00,
     8.6177838E+00,.6300285E+00,.6421185E+00,.6540509E+00,.6658228E+00/
      data (xp(i),i= 281, 320)/
     1.6774311E+00,.6888732E+00,.7001461E+00,.7112472E+00,.7221736E+00,
     2.7329227E+00,.7434919E+00,.7538786E+00,.7640801E+00,.7740941E+00,
     3.7839181E+00,.7935496E+00,.8029862E+00,.8122257E+00,.8212659E+00,
     4.8301044E+00,.8387391E+00,.8471679E+00,.8553887E+00,.8633995E+00,
     5.8711983E+00,.8787832E+00,.8861524E+00,.8933041E+00,.9002364E+00,
     6.9069477E+00,.9134364E+00,.9197008E+00,.9257394E+00,.9315507E+00,
     7.9371333E+00,.9424859E+00,.9476071E+00,.9524956E+00,.9571503E+00,
     8.9615700E+00,.9657536E+00,.9697002E+00,.9734086E+00,.9768781E+00/
      data (xp(i),i= 321, 360)/
     1.9801078E+00,.9830968E+00,.9858445E+00,.9883502E+00,.9906132E+00,
     2.9926330E+00,.9944091E+00,.9959410E+00,.9972285E+00,.9982712E+00,
     3.9990687E+00,.9996210E+00,.9999281E+00,.5227245E-02,.1568116E-01,
     4.2613337E-01,.3658271E-01,.4702806E-01,.5746827E-01,.6790220E-01,
     5.7832871E-01,.8874665E-01,.9915490E-01,.1095523E+00,.1199377E+00,
     6.1303101E+00,.1406682E+00,.1510109E+00,.1613371E+00,.1716456E+00,
     7.1819354E+00,.1922054E+00,.2024543E+00,.2126811E+00,.2228846E+00,
     8.2330638E+00,.2432175E+00,.2533446E+00,.2634441E+00,.2735147E+00/
      data (xp(i),i= 361, 400)/
     1.2835555E+00,.2935652E+00,.3035429E+00,.3134874E+00,.3233976E+00,
     2.3332725E+00,.3431110E+00,.3529120E+00,.3626744E+00,.3723971E+00,
     3.3820792E+00,.3917194E+00,.4013169E+00,.4108705E+00,.4203792E+00,
     4.4298420E+00,.4392578E+00,.4486255E+00,.4579443E+00,.4672130E+00,
     5.4764306E+00,.4855961E+00,.4947086E+00,.5037670E+00,.5127704E+00,
     6.5217177E+00,.5306079E+00,.5394402E+00,.5482135E+00,.5569269E+00,
     7.5655795E+00,.5741702E+00,.5826982E+00,.5911624E+00,.5995621E+00,
     8.6078963E+00,.6161639E+00,.6243643E+00,.6324964E+00,.6405594E+00/
      data (xp(i),i= 401, 440)/
     1.6485524E+00,.6564744E+00,.6643248E+00,.6721025E+00,.6798068E+00,
     2.6874367E+00,.6949916E+00,.7024704E+00,.7098725E+00,.7171970E+00,
     3.7244432E+00,.7316101E+00,.7386971E+00,.7457033E+00,.7526281E+00,
     4.7594705E+00,.7662300E+00,.7729057E+00,.7794970E+00,.7860030E+00,
     5.7924232E+00,.7987567E+00,.8050030E+00,.8111612E+00,.8172308E+00,
     6.8232111E+00,.8291014E+00,.8349011E+00,.8406095E+00,.8462260E+00,
     7.8517501E+00,.8571811E+00,.8625184E+00,.8677614E+00,.8729095E+00,
     8.8779623E+00,.8829191E+00,.8877794E+00,.8925427E+00,.8972084E+00/
      data (xp(i),i= 441, 480)/
     1.9017761E+00,.9062452E+00,.9106152E+00,.9148857E+00,.9190563E+00,
     2.9231263E+00,.9270955E+00,.9309634E+00,.9347295E+00,.9383934E+00,
     3.9419548E+00,.9454132E+00,.9487683E+00,.9520197E+00,.9551671E+00,
     4.9582100E+00,.9611482E+00,.9639814E+00,.9667092E+00,.9693313E+00,
     5.9718476E+00,.9742575E+00,.9765610E+00,.9787578E+00,.9808476E+00,
     6.9828302E+00,.9847054E+00,.9864729E+00,.9881326E+00,.9896844E+00,
     7.9911279E+00,.9924632E+00,.9936899E+00,.9948081E+00,.9958175E+00,
     8.9967181E+00,.9975097E+00,.9981923E+00,.9987659E+00,.9992302E+00/
      data (xp(i),i= 481, 520)/
     1.9995854E+00,.9998313E+00,.9999680E+00,.3922075E-02,.1176598E-01,
     2.1960917E-01,.2745115E-01,.3529144E-01,.4312955E-01,.5096502E-01,
     3.5879735E-01,.6662606E-01,.7445067E-01,.8227070E-01,.9008566E-01,
     4.9789509E-01,.1056985E+00,.1134954E+00,.1212853E+00,.1290678E+00,
     5.1368423E+00,.1446083E+00,.1523655E+00,.1601134E+00,.1678513E+00,
     6.1755790E+00,.1832958E+00,.1910013E+00,.1986951E+00,.2063767E+00,
     7.2140456E+00,.2217013E+00,.2293434E+00,.2369713E+00,.2445847E+00,
     8.2521830E+00,.2597658E+00,.2673327E+00,.2748830E+00,.2824165E+00/
      data (xp(i),i= 521, 560)/
     1.2899326E+00,.2974308E+00,.3049108E+00,.3123719E+00,.3198139E+00,
     2.3272362E+00,.3346383E+00,.3420199E+00,.3493804E+00,.3567194E+00,
     3.3640365E+00,.3713311E+00,.3786029E+00,.3858515E+00,.3930762E+00,
     4.4002768E+00,.4074528E+00,.4146037E+00,.4217291E+00,.4288285E+00,
     5.4359016E+00,.4429478E+00,.4499667E+00,.4569580E+00,.4639212E+00,
     6.4708558E+00,.4777615E+00,.4846377E+00,.4914841E+00,.4983003E+00,
     7.5050859E+00,.5118403E+00,.5185633E+00,.5252543E+00,.5319131E+00,
     8.5385391E+00,.5451319E+00,.5516912E+00,.5582166E+00,.5647076E+00/
      data (xp(i),i= 561, 600)/
     1.5711639E+00,.5775851E+00,.5839707E+00,.5903203E+00,.5966337E+00,
     2.6029103E+00,.6091498E+00,.6153519E+00,.6215161E+00,.6276420E+00,
     3.6337293E+00,.6397777E+00,.6457866E+00,.6517559E+00,.6576850E+00,
     4.6635737E+00,.6694215E+00,.6752281E+00,.6809932E+00,.6867164E+00,
     5.6923974E+00,.6980357E+00,.7036311E+00,.7091832E+00,.7146916E+00,
     6.7201561E+00,.7255763E+00,.7309518E+00,.7362823E+00,.7415676E+00,
     7.7468072E+00,.7520008E+00,.7571482E+00,.7622490E+00,.7673029E+00,
     8.7723096E+00,.7772688E+00,.7821801E+00,.7870433E+00,.7918581E+00/
      data (xp(i),i= 601, 640)/
     1.7966241E+00,.8013412E+00,.8060089E+00,.8106271E+00,.8151953E+00,
     2.8197134E+00,.8241811E+00,.8285980E+00,.8329640E+00,.8372787E+00,
     3.8415419E+00,.8457533E+00,.8499127E+00,.8540198E+00,.8580743E+00,
     4.8620760E+00,.8660247E+00,.8699201E+00,.8737620E+00,.8775501E+00,
     5.8812842E+00,.8849641E+00,.8885896E+00,.8921603E+00,.8956762E+00,
     6.8991369E+00,.9025424E+00,.9058923E+00,.9091864E+00,.9124246E+00,
     7.9156067E+00,.9187324E+00,.9218016E+00,.9248141E+00,.9277697E+00,
     8.9306682E+00,.9335094E+00,.9362932E+00,.9390194E+00,.9416878E+00/
      data (xp(i),i= 641, 680)/
     1.9442982E+00,.9468506E+00,.9493447E+00,.9517803E+00,.9541574E+00,
     2.9564759E+00,.9587354E+00,.9609360E+00,.9630774E+00,.9651596E+00,
     3.9671823E+00,.9691456E+00,.9710493E+00,.9728932E+00,.9746772E+00,
     4.9764012E+00,.9780652E+00,.9796690E+00,.9812125E+00,.9826957E+00,
     5.9841183E+00,.9854805E+00,.9867820E+00,.9880227E+00,.9892027E+00,
     6.9903218E+00,.9913800E+00,.9923771E+00,.9933133E+00,.9941882E+00,
     7.9950021E+00,.9957547E+00,.9964460E+00,.9970760E+00,.9976447E+00,
     8.9981519E+00,.9985978E+00,.9989822E+00,.9993052E+00,.9995666E+00/
      data (xp(i),i= 681, 720)/
     1.9997666E+00,.9999050E+00,.9999820E+00,.2615810E-02,.7847359E-02,
     2.1307869E-01,.1830967E-01,.2354014E-01,.2876997E-01,.3399902E-01,
     3.3922713E-01,.4445417E-01,.4967999E-01,.5490445E-01,.6012741E-01,
     4.6534873E-01,.7056825E-01,.7578585E-01,.8100137E-01,.8621467E-01,
     5.9142561E-01,.9663405E-01,.1018398E+00,.1070429E+00,.1122429E+00,
     6.1174399E+00,.1226337E+00,.1278242E+00,.1330111E+00,.1381944E+00,
     7.1433739E+00,.1485495E+00,.1537210E+00,.1588884E+00,.1640513E+00,
     8.1692098E+00,.1743636E+00,.1795127E+00,.1846569E+00,.1897960E+00/
      data (xp(i),i= 721, 760)/
     1.1949299E+00,.2000585E+00,.2051816E+00,.2102991E+00,.2154108E+00,
     2.2205166E+00,.2256164E+00,.2307101E+00,.2357974E+00,.2408782E+00,
     3.2459525E+00,.2510200E+00,.2560807E+00,.2611343E+00,.2661808E+00,
     4.2712201E+00,.2762519E+00,.2812761E+00,.2862926E+00,.2913013E+00,
     5.2963021E+00,.3012947E+00,.3062790E+00,.3112550E+00,.3162225E+00,
     6.3211813E+00,.3261313E+00,.3310724E+00,.3360045E+00,.3409273E+00,
     7.3458408E+00,.3507449E+00,.3556393E+00,.3605240E+00,.3653989E+00,
     8.3702637E+00,.3751184E+00,.3799629E+00,.3847969E+00,.3896204E+00/
      data (xp(i),i= 761, 800)/
     1.3944333E+00,.3992353E+00,.4040264E+00,.4088065E+00,.4135754E+00,
     2.4183329E+00,.4230790E+00,.4278136E+00,.4325364E+00,.4372474E+00,
     3.4419464E+00,.4466333E+00,.4513080E+00,.4559703E+00,.4606202E+00,
     4.4652574E+00,.4698819E+00,.4744936E+00,.4790923E+00,.4836778E+00,
     5.4882502E+00,.4928091E+00,.4973546E+00,.5018864E+00,.5064046E+00,
     6.5109088E+00,.5153991E+00,.5198753E+00,.5243372E+00,.5287848E+00,
     7.5332179E+00,.5376364E+00,.5420402E+00,.5464292E+00,.5508032E+00,
     8.5551622E+00,.5595059E+00,.5638343E+00,.5681473E+00,.5724448E+00/
      data (xp(i),i= 801, 840)/
     1.5767266E+00,.5809926E+00,.5852427E+00,.5894768E+00,.5936947E+00,
     2.5978964E+00,.6020817E+00,.6062506E+00,.6104028E+00,.6145384E+00,
     3.6186571E+00,.6227589E+00,.6268437E+00,.6309113E+00,.6349616E+00,
     4.6389945E+00,.6430100E+00,.6470079E+00,.6509880E+00,.6549504E+00,
     5.6588948E+00,.6628211E+00,.6667294E+00,.6706194E+00,.6744910E+00,
     6.6783442E+00,.6821788E+00,.6859947E+00,.6897919E+00,.6935702E+00,
     7.6973295E+00,.7010697E+00,.7047907E+00,.7084924E+00,.7121748E+00,
     8.7158376E+00,.7194809E+00,.7231044E+00,.7267082E+00,.7302921E+00/
      data (xp(i),i= 841, 880)/
     1.7338560E+00,.7373998E+00,.7409234E+00,.7444268E+00,.7479097E+00,
     2.7513722E+00,.7548142E+00,.7582355E+00,.7616360E+00,.7650157E+00,
     3.7683744E+00,.7717121E+00,.7750287E+00,.7783241E+00,.7815982E+00,
     4.7848508E+00,.7880821E+00,.7912917E+00,.7944797E+00,.7976459E+00,
     5.8007903E+00,.8039128E+00,.8070132E+00,.8100916E+00,.8131479E+00,
     6.8161818E+00,.8191934E+00,.8221826E+00,.8251493E+00,.8280935E+00,
     7.8310149E+00,.8339136E+00,.8367895E+00,.8396425E+00,.8424725E+00,
     8.8452794E+00,.8480632E+00,.8508238E+00,.8535611E+00,.8562750E+00/
      data (xp(i),i= 881, 920)/
     1.8589656E+00,.8616325E+00,.8642760E+00,.8668957E+00,.8694918E+00,
     2.8720640E+00,.8746124E+00,.8771368E+00,.8796372E+00,.8821136E+00,
     3.8845658E+00,.8869937E+00,.8893975E+00,.8917768E+00,.8941318E+00,
     4.8964623E+00,.8987683E+00,.9010496E+00,.9033063E+00,.9055383E+00,
     5.9077455E+00,.9099278E+00,.9120852E+00,.9142177E+00,.9163252E+00,
     6.9184075E+00,.9204648E+00,.9224968E+00,.9245036E+00,.9264851E+00,
     7.9284412E+00,.9303720E+00,.9322772E+00,.9341570E+00,.9360111E+00,
     8.9378397E+00,.9396426E+00,.9414198E+00,.9431712E+00,.9448967E+00/
      data (xp(i),i= 921, 960)/
     1.9465965E+00,.9482703E+00,.9499181E+00,.9515400E+00,.9531358E+00,
     2.9547056E+00,.9562492E+00,.9577666E+00,.9592578E+00,.9607228E+00,
     3.9621615E+00,.9635738E+00,.9649597E+00,.9663193E+00,.9676524E+00,
     4.9689590E+00,.9702391E+00,.9714927E+00,.9727196E+00,.9739199E+00,
     5.9750936E+00,.9762406E+00,.9773609E+00,.9784544E+00,.9795211E+00,
     6.9805610E+00,.9815741E+00,.9825603E+00,.9835197E+00,.9844521E+00,
     7.9853575E+00,.9862360E+00,.9870876E+00,.9879120E+00,.9887095E+00,
     8.9894799E+00,.9902232E+00,.9909394E+00,.9916285E+00,.9922904E+00/
      data (xp(i),i= 961,1000)/
     1.9929252E+00,.9935328E+00,.9941132E+00,.9946664E+00,.9951924E+00,
     2.9956911E+00,.9961626E+00,.9966068E+00,.9970238E+00,.9974135E+00,
     3.9977758E+00,.9981109E+00,.9984186E+00,.9986990E+00,.9989521E+00,
     4.9991778E+00,.9993762E+00,.9995472E+00,.9996909E+00,.9998072E+00,
     5.9998962E+00,.9999577E+00,.9999920E+00,.1962267E-02,.5886772E-02,
     6.9811186E-02,.1373545E-01,.1765950E-01,.2158328E-01,.2550673E-01,
     7.2942978E-01,.3335238E-01,.3727447E-01,.4119598E-01,.4511686E-01,
     8.4903704E-01,.5295647E-01,.5687508E-01,.6079282E-01,.6470962E-01/
      data (xp(i),i=1001,1040)/
     1.6862542E-01,.7254017E-01,.7645380E-01,.8036625E-01,.8427746E-01,
     2.8818738E-01,.9209594E-01,.9600308E-01,.9990874E-01,.1038129E+00,
     3.1077154E+00,.1116162E+00,.1155154E+00,.1194128E+00,.1233083E+00,
     4.1272019E+00,.1310936E+00,.1349832E+00,.1388708E+00,.1427562E+00,
     5.1466395E+00,.1505204E+00,.1543991E+00,.1582754E+00,.1621492E+00,
     6.1660205E+00,.1698893E+00,.1737555E+00,.1776190E+00,.1814798E+00,
     7.1853377E+00,.1891928E+00,.1930450E+00,.1968942E+00,.2007404E+00,
     8.2045835E+00,.2084235E+00,.2122602E+00,.2160937E+00,.2199238E+00/
      data (xp(i),i=1041,1080)/
     1.2237505E+00,.2275738E+00,.2313936E+00,.2352099E+00,.2390225E+00,
     2.2428314E+00,.2466366E+00,.2504380E+00,.2542355E+00,.2580292E+00,
     3.2618188E+00,.2656044E+00,.2693859E+00,.2731633E+00,.2769365E+00,
     4.2807054E+00,.2844699E+00,.2882301E+00,.2919859E+00,.2957372E+00,
     5.2994839E+00,.3032259E+00,.3069634E+00,.3106961E+00,.3144240E+00,
     6.3181470E+00,.3218652E+00,.3255784E+00,.3292866E+00,.3329897E+00,
     7.3366877E+00,.3403805E+00,.3440681E+00,.3477503E+00,.3514272E+00,
     8.3550987E+00,.3587648E+00,.3624253E+00,.3660802E+00,.3697295E+00/
      data (xp(i),i=1081,1120)/
     1.3733731E+00,.3770109E+00,.3806429E+00,.3842691E+00,.3878893E+00,
     2.3915036E+00,.3951118E+00,.3987140E+00,.4023100E+00,.4058998E+00,
     3.4094834E+00,.4130607E+00,.4166316E+00,.4201960E+00,.4237541E+00,
     4.4273055E+00,.4308504E+00,.4343887E+00,.4379203E+00,.4414451E+00,
     5.4449632E+00,.4484743E+00,.4519786E+00,.4554759E+00,.4589662E+00,
     6.4624494E+00,.4659255E+00,.4693945E+00,.4728562E+00,.4763106E+00,
     7.4797577E+00,.4831973E+00,.4866296E+00,.4900543E+00,.4934715E+00,
     8.4968812E+00,.5002831E+00,.5036774E+00,.5070638E+00,.5104425E+00/
      data (xp(i),i=1121,1160)/
     1.5138133E+00,.5171762E+00,.5205312E+00,.5238781E+00,.5272169E+00,
     2.5305477E+00,.5338702E+00,.5371846E+00,.5404906E+00,.5437884E+00,
     3.5470777E+00,.5503587E+00,.5536311E+00,.5568951E+00,.5601504E+00,
     4.5633972E+00,.5666352E+00,.5698645E+00,.5730851E+00,.5762968E+00,
     5.5794996E+00,.5826936E+00,.5858785E+00,.5890544E+00,.5922213E+00,
     6.5953790E+00,.5985276E+00,.6016669E+00,.6047970E+00,.6079177E+00,
     7.6110291E+00,.6141311E+00,.6172236E+00,.6203066E+00,.6233801E+00,
     8.6264440E+00,.6294982E+00,.6325427E+00,.6355775E+00,.6386024E+00/
      data (xp(i),i=1161,1200)/
     1.6416176E+00,.6446229E+00,.6476182E+00,.6506036E+00,.6535789E+00,
     2.6565442E+00,.6594994E+00,.6624444E+00,.6653792E+00,.6683037E+00,
     3.6712180E+00,.6741219E+00,.6770155E+00,.6798986E+00,.6827712E+00,
     4.6856333E+00,.6884849E+00,.6913259E+00,.6941562E+00,.6969758E+00,
     5.6997847E+00,.7025828E+00,.7053701E+00,.7081465E+00,.7109120E+00,
     6.7136666E+00,.7164102E+00,.7191427E+00,.7218642E+00,.7245746E+00,
     7.7272737E+00,.7299617E+00,.7326385E+00,.7353039E+00,.7379581E+00,
     8.7406008E+00,.7432322E+00,.7458521E+00,.7484606E+00,.7510575E+00/
      data (xp(i),i=1201,1240)/
     1.7536428E+00,.7562165E+00,.7587786E+00,.7613290E+00,.7638676E+00,
     2.7663945E+00,.7689096E+00,.7714129E+00,.7739043E+00,.7763837E+00,
     3.7788512E+00,.7813067E+00,.7837502E+00,.7861816E+00,.7886009E+00,
     4.7910080E+00,.7934030E+00,.7957857E+00,.7981562E+00,.8005144E+00,
     5.8028602E+00,.8051937E+00,.8075148E+00,.8098234E+00,.8121196E+00,
     6.8144033E+00,.8166744E+00,.8189330E+00,.8211789E+00,.8234122E+00,
     7.8256328E+00,.8278407E+00,.8300358E+00,.8322182E+00,.8343877E+00,
     8.8365444E+00,.8386882E+00,.8408191E+00,.8429370E+00,.8450420E+00/
      data (xp(i),i=1241,1280)/
     1.8471339E+00,.8492128E+00,.8512786E+00,.8533313E+00,.8553709E+00,
     2.8573972E+00,.8594104E+00,.8614104E+00,.8633970E+00,.8653704E+00,
     3.8673304E+00,.8692771E+00,.8712104E+00,.8731303E+00,.8750367E+00,
     4.8769297E+00,.8788091E+00,.8806750E+00,.8825274E+00,.8843662E+00,
     5.8861913E+00,.8880028E+00,.8898006E+00,.8915847E+00,.8933550E+00,
     6.8951117E+00,.8968545E+00,.8985835E+00,.9002987E+00,.9020000E+00,
     7.9036874E+00,.9053609E+00,.9070204E+00,.9086660E+00,.9102976E+00,
     8.9119152E+00,.9135187E+00,.9151081E+00,.9166835E+00,.9182447E+00/
      data (xp(i),i=1281,1320)/
     1.9197918E+00,.9213247E+00,.9228435E+00,.9243480E+00,.9258383E+00,
     2.9273143E+00,.9287760E+00,.9302235E+00,.9316566E+00,.9330754E+00,
     3.9344797E+00,.9358697E+00,.9372453E+00,.9386065E+00,.9399532E+00,
     4.9412854E+00,.9426031E+00,.9439063E+00,.9451950E+00,.9464691E+00,
     5.9477286E+00,.9489735E+00,.9502038E+00,.9514195E+00,.9526205E+00,
     6.9538069E+00,.9549785E+00,.9561355E+00,.9572777E+00,.9584052E+00,
     7.9595179E+00,.9606159E+00,.9616990E+00,.9627673E+00,.9638208E+00,
     8.9648595E+00,.9658833E+00,.9668922E+00,.9678863E+00,.9688654E+00/
      data (xp(i),i=1321,1360)/
     1.9698296E+00,.9707788E+00,.9717132E+00,.9726325E+00,.9735369E+00,
     2.9744262E+00,.9753006E+00,.9761600E+00,.9770043E+00,.9778335E+00,
     3.9786477E+00,.9794468E+00,.9802309E+00,.9809998E+00,.9817537E+00,
     4.9824924E+00,.9832160E+00,.9839244E+00,.9846177E+00,.9852958E+00,
     5.9859587E+00,.9866065E+00,.9872390E+00,.9878564E+00,.9884585E+00,
     6.9890455E+00,.9896171E+00,.9901736E+00,.9907148E+00,.9912407E+00,
     7.9917514E+00,.9922468E+00,.9927269E+00,.9931917E+00,.9936412E+00,
     8.9940754E+00,.9944943E+00,.9948979E+00,.9952862E+00,.9956591E+00/
      data (xp(i),i=1361,1400)/
     1.9960167E+00,.9963590E+00,.9966859E+00,.9969974E+00,.9972936E+00,
     2.9975745E+00,.9978400E+00,.9980901E+00,.9983248E+00,.9985442E+00,
     3.9987482E+00,.9989368E+00,.9991100E+00,.9992678E+00,.9994103E+00,
     4.9995373E+00,.9996489E+00,.9997452E+00,.9998261E+00,.9998915E+00,
     5.9999416E+00,.9999762E+00,.9999955E+00,.1570010E-02,.4710016E-02,
     6.7849975E-02,.1098986E-01,.1412963E-01,.1726926E-01,.2040873E-01,
     7.2354799E-01,.2668702E-01,.2982579E-01,.3296426E-01,.3610241E-01,
     8.3924020E-01,.4237761E-01,.4551459E-01,.4865113E-01,.5178719E-01/
      data (xp(i),i=1401,1440)/
     1.5492274E-01,.5805775E-01,.6119218E-01,.6432601E-01,.6745921E-01,
     2.7059174E-01,.7372358E-01,.7685468E-01,.7998504E-01,.8311460E-01,
     3.8624334E-01,.8937123E-01,.9249824E-01,.9562434E-01,.9874950E-01,
     4.1018737E+00,.1049969E+00,.1081190E+00,.1112401E+00,.1143601E+00,
     5.1174789E+00,.1205966E+00,.1237131E+00,.1268284E+00,.1299424E+00,
     6.1330552E+00,.1361666E+00,.1392767E+00,.1423855E+00,.1454928E+00,
     7.1485987E+00,.1517031E+00,.1548060E+00,.1579074E+00,.1610073E+00,
     8.1641055E+00,.1672022E+00,.1702971E+00,.1733905E+00,.1764821E+00/
      data (xp(i),i=1441,1480)/
     1.1795719E+00,.1826600E+00,.1857463E+00,.1888308E+00,.1919134E+00,
     2.1949941E+00,.1980728E+00,.2011497E+00,.2042245E+00,.2072973E+00,
     3.2103681E+00,.2134368E+00,.2165035E+00,.2195679E+00,.2226302E+00,
     4.2256904E+00,.2287482E+00,.2318039E+00,.2348572E+00,.2379083E+00,
     5.2409569E+00,.2440033E+00,.2470472E+00,.2500886E+00,.2531276E+00,
     6.2561641E+00,.2591981E+00,.2622295E+00,.2652584E+00,.2682846E+00,
     7.2713082E+00,.2743291E+00,.2773473E+00,.2803628E+00,.2833755E+00,
     8.2863854E+00,.2893925E+00,.2923967E+00,.2953980E+00,.2983965E+00/
      data (xp(i),i=1481,1520)/
     1.3013920E+00,.3043845E+00,.3073740E+00,.3103605E+00,.3133439E+00,
     2.3163243E+00,.3193015E+00,.3222756E+00,.3252465E+00,.3282141E+00,
     3.3311786E+00,.3341398E+00,.3370977E+00,.3400522E+00,.3430035E+00,
     4.3459513E+00,.3488957E+00,.3518367E+00,.3547742E+00,.3577082E+00,
     5.3606387E+00,.3635657E+00,.3664890E+00,.3694087E+00,.3723248E+00,
     6.3752373E+00,.3781460E+00,.3810510E+00,.3839522E+00,.3868497E+00,
     7.3897433E+00,.3926331E+00,.3955190E+00,.3984010E+00,.4012791E+00,
     8.4041533E+00,.4070234E+00,.4098896E+00,.4127517E+00,.4156097E+00/
      data (xp(i),i=1521,1560)/
     1.4184636E+00,.4213134E+00,.4241591E+00,.4270006E+00,.4298378E+00,
     2.4326708E+00,.4354996E+00,.4383241E+00,.4411442E+00,.4439600E+00,
     3.4467714E+00,.4495784E+00,.4523810E+00,.4551791E+00,.4579727E+00,
     4.4607618E+00,.4635464E+00,.4663264E+00,.4691018E+00,.4718726E+00,
     5.4746387E+00,.4774001E+00,.4801569E+00,.4829089E+00,.4856561E+00,
     6.4883986E+00,.4911362E+00,.4938690E+00,.4965969E+00,.4993199E+00,
     7.5020381E+00,.5047512E+00,.5074594E+00,.5101626E+00,.5128607E+00,
     8.5155538E+00,.5182418E+00,.5209247E+00,.5236025E+00,.5262750E+00/
      data (xp(i),i=1561,1600)/
     1.5289425E+00,.5316046E+00,.5342616E+00,.5369133E+00,.5395597E+00,
     2.5422007E+00,.5448365E+00,.5474668E+00,.5500918E+00,.5527113E+00,
     3.5553254E+00,.5579340E+00,.5605371E+00,.5631347E+00,.5657267E+00,
     4.5683131E+00,.5708940E+00,.5734692E+00,.5760387E+00,.5786026E+00,
     5.5811608E+00,.5837132E+00,.5862599E+00,.5888008E+00,.5913360E+00,
     6.5938652E+00,.5963886E+00,.5989062E+00,.6014178E+00,.6039235E+00,
     7.6064233E+00,.6089170E+00,.6114048E+00,.6138865E+00,.6163622E+00,
     8.6188318E+00,.6212953E+00,.6237527E+00,.6262040E+00,.6286490E+00/
      data (xp(i),i=1601,1640)/
     1.6310879E+00,.6335205E+00,.6359469E+00,.6383670E+00,.6407808E+00,
     2.6431883E+00,.6455895E+00,.6479843E+00,.6503727E+00,.6527547E+00,
     3.6551303E+00,.6574994E+00,.6598620E+00,.6622181E+00,.6645677E+00,
     4.6669107E+00,.6692472E+00,.6715770E+00,.6739003E+00,.6762169E+00,
     5.6785268E+00,.6808300E+00,.6831266E+00,.6854163E+00,.6876994E+00,
     6.6899756E+00,.6922451E+00,.6945077E+00,.6967635E+00,.6990124E+00,
     7.7012544E+00,.7034895E+00,.7057176E+00,.7079388E+00,.7101530E+00,
     8.7123603E+00,.7145605E+00,.7167536E+00,.7189397E+00,.7211187E+00/
      data (xp(i),i=1641,1680)/
     1.7232906E+00,.7254553E+00,.7276129E+00,.7297634E+00,.7319066E+00,
     2.7340426E+00,.7361714E+00,.7382929E+00,.7404071E+00,.7425141E+00,
     3.7446137E+00,.7467060E+00,.7487909E+00,.7508684E+00,.7529385E+00,
     4.7550013E+00,.7570565E+00,.7591043E+00,.7611446E+00,.7631774E+00,
     5.7652027E+00,.7672204E+00,.7692306E+00,.7712332E+00,.7732282E+00,
     6.7752155E+00,.7771953E+00,.7791673E+00,.7811317E+00,.7830884E+00,
     7.7850373E+00,.7869785E+00,.7889120E+00,.7908376E+00,.7927555E+00,
     8.7946656E+00,.7965678E+00,.7984622E+00,.8003486E+00,.8022273E+00/
      data (xp(i),i=1681,1720)/
     1.8040979E+00,.8059607E+00,.8078155E+00,.8096624E+00,.8115013E+00,
     2.8133321E+00,.8151550E+00,.8169698E+00,.8187765E+00,.8205752E+00,
     3.8223658E+00,.8241483E+00,.8259227E+00,.8276889E+00,.8294470E+00,
     4.8311968E+00,.8329385E+00,.8346720E+00,.8363972E+00,.8381142E+00,
     5.8398229E+00,.8415234E+00,.8432156E+00,.8448994E+00,.8465749E+00,
     6.8482421E+00,.8499009E+00,.8515513E+00,.8531933E+00,.8548269E+00,
     7.8564521E+00,.8580688E+00,.8596771E+00,.8612769E+00,.8628682E+00,
     8.8644510E+00,.8660253E+00,.8675910E+00,.8691482E+00,.8706968E+00/
      data (xp(i),i=1721,1760)/
     1.8722369E+00,.8737683E+00,.8752911E+00,.8768053E+00,.8783108E+00,
     2.8798077E+00,.8812959E+00,.8827754E+00,.8842463E+00,.8857083E+00,
     3.8871617E+00,.8886063E+00,.8900422E+00,.8914692E+00,.8928875E+00,
     4.8942970E+00,.8956977E+00,.8970895E+00,.8984725E+00,.8998466E+00,
     5.9012119E+00,.9025683E+00,.9039157E+00,.9052543E+00,.9065839E+00,
     6.9079046E+00,.9092164E+00,.9105192E+00,.9118130E+00,.9130978E+00,
     7.9143736E+00,.9156404E+00,.9168982E+00,.9181469E+00,.9193866E+00,
     8.9206172E+00,.9218387E+00,.9230511E+00,.9242545E+00,.9254487E+00/
      data (xp(i),i=1761,1800)/
     1.9266338E+00,.9278098E+00,.9289766E+00,.9301343E+00,.9312828E+00,
     2.9324221E+00,.9335522E+00,.9346731E+00,.9357848E+00,.9368872E+00,
     3.9379805E+00,.9390645E+00,.9401392E+00,.9412046E+00,.9422608E+00,
     4.9433077E+00,.9443453E+00,.9453735E+00,.9463925E+00,.9474021E+00,
     5.9484024E+00,.9493933E+00,.9503749E+00,.9513471E+00,.9523099E+00,
     6.9532633E+00,.9542073E+00,.9551420E+00,.9560672E+00,.9569829E+00,
     7.9578893E+00,.9587862E+00,.9596736E+00,.9605516E+00,.9614201E+00,
     8.9622791E+00,.9631287E+00,.9639687E+00,.9647992E+00,.9656203E+00/
      data (xp(i),i=1801,1840)/
     1.9664318E+00,.9672338E+00,.9680262E+00,.9688091E+00,.9695824E+00,
     2.9703462E+00,.9711004E+00,.9718451E+00,.9725801E+00,.9733056E+00,
     3.9740215E+00,.9747278E+00,.9754244E+00,.9761115E+00,.9767889E+00,
     4.9774567E+00,.9781148E+00,.9787633E+00,.9794022E+00,.9800314E+00,
     5.9806509E+00,.9812608E+00,.9818610E+00,.9824515E+00,.9830323E+00,
     6.9836035E+00,.9841649E+00,.9847166E+00,.9852586E+00,.9857909E+00,
     7.9863135E+00,.9868264E+00,.9873295E+00,.9878229E+00,.9883066E+00,
     8.9887805E+00,.9892447E+00,.9896991E+00,.9901437E+00,.9905786E+00/
      data (xp(i),i=1841,1880)/
     1.9910037E+00,.9914191E+00,.9918247E+00,.9922205E+00,.9926065E+00,
     2.9929827E+00,.9933492E+00,.9937058E+00,.9940527E+00,.9943897E+00,
     3.9947169E+00,.9950344E+00,.9953420E+00,.9956398E+00,.9959278E+00,
     4.9962060E+00,.9964743E+00,.9967328E+00,.9969815E+00,.9972204E+00,
     5.9974494E+00,.9976686E+00,.9978780E+00,.9980775E+00,.9982672E+00,
     6.9984471E+00,.9986171E+00,.9987772E+00,.9989275E+00,.9990680E+00,
     7.9991986E+00,.9993193E+00,.9994302E+00,.9995313E+00,.9996225E+00,
     8.9997038E+00,.9997753E+00,.9998369E+00,.9998886E+00,.9999306E+00/
      data (xp(i),i=1881,1883)/
     1.9999626E+00,.9999848E+00,.9999971E+00/
      data (wp(i),i=   1,  40)/
     1.4679139E+00,.3607616E+00,.1713245E+00,.2955242E+00,.2692667E+00,
     2.2190864E+00,.1494513E+00,.6667134E-01,.1527534E+00,.1491730E+00,
     3.1420961E+00,.1316886E+00,.1181945E+00,.1019301E+00,.8327674E-01,
     4.6267205E-01,.4060143E-01,.1761401E-01,.7750595E-01,.7703982E-01,
     5.7611036E-01,.7472317E-01,.7288658E-01,.7061165E-01,.6791205E-01,
     6.6480401E-01,.6130624E-01,.5743977E-01,.5322785E-01,.4869581E-01,
     7.4387091E-01,.3878217E-01,.3346020E-01,.2793701E-01,.2224585E-01,
     8.1642106E-01,.1049828E-01,.4521277E-02,.5190788E-01,.5176794E-01/
      data (wp(i),i=  41,  80)/
     1.5148845E-01,.5107016E-01,.5051418E-01,.4982204E-01,.4899558E-01,
     2.4803703E-01,.4694899E-01,.4573438E-01,.4439648E-01,.4293889E-01,
     3.4136555E-01,.3968070E-01,.3788887E-01,.3599490E-01,.3400389E-01,
     4.3192122E-01,.2975249E-01,.2750356E-01,.2518048E-01,.2278952E-01,
     5.2033712E-01,.1782990E-01,.1527462E-01,.1267817E-01,.1004756E-01,
     6.7389931E-02,.4712730E-02,.2026812E-02,.3901781E-01,.3895840E-01,
     7.3883965E-01,.3866176E-01,.3842499E-01,.3812971E-01,.3777636E-01,
     8.3736549E-01,.3689771E-01,.3637375E-01,.3579439E-01,.3516053E-01/
      data (wp(i),i=  81, 120)/
     1.3447312E-01,.3373321E-01,.3294194E-01,.3210050E-01,.3121017E-01,
     2.3027232E-01,.2928837E-01,.2825982E-01,.2718823E-01,.2607524E-01,
     3.2492254E-01,.2373188E-01,.2250509E-01,.2124403E-01,.1995061E-01,
     4.1862681E-01,.1727465E-01,.1589618E-01,.1449351E-01,.1306876E-01,
     5.1162411E-01,.1016177E-01,.8683945E-02,.7192905E-02,.5690922E-02,
     6.4180313E-02,.2663534E-02,.1144950E-02,.3125542E-01,.3122488E-01,
     7.3116384E-01,.3107234E-01,.3095048E-01,.3079838E-01,.3061619E-01,
     8.3040408E-01,.3016227E-01,.2989098E-01,.2959049E-01,.2926108E-01/
      data (wp(i),i= 121, 160)/
     1.2890309E-01,.2851685E-01,.2810276E-01,.2766120E-01,.2719261E-01,
     2.2669746E-01,.2617622E-01,.2562940E-01,.2505754E-01,.2446120E-01,
     3.2384096E-01,.2319742E-01,.2253122E-01,.2184300E-01,.2113344E-01,
     4.2040323E-01,.1965309E-01,.1888374E-01,.1809594E-01,.1729046E-01,
     5.1646809E-01,.1562962E-01,.1477588E-01,.1390771E-01,.1302595E-01,
     6.1213146E-01,.1122511E-01,.1030780E-01,.9380420E-02,.8443871E-02,
     7.7499073E-02,.6546948E-02,.5588428E-02,.4624450E-02,.3655961E-02,
     8.2683925E-02,.1709393E-02,.7346345E-03,.2087312E-01,.2086402E-01/
      data (wp(i),i= 161, 200)/
     1.2084584E-01,.2081857E-01,.2078223E-01,.2073683E-01,.2068240E-01,
     2.2061896E-01,.2054653E-01,.2046515E-01,.2037486E-01,.2027568E-01,
     3.2016767E-01,.2005088E-01,.1992534E-01,.1979113E-01,.1964829E-01,
     4.1949689E-01,.1933700E-01,.1916867E-01,.1899200E-01,.1880705E-01,
     5.1861391E-01,.1841266E-01,.1820338E-01,.1798617E-01,.1776113E-01,
     6.1752835E-01,.1728792E-01,.1703997E-01,.1678459E-01,.1652190E-01,
     7.1625201E-01,.1597504E-01,.1569110E-01,.1540033E-01,.1510285E-01,
     8.1479879E-01,.1448828E-01,.1417146E-01,.1384846E-01,.1351943E-01/
      data (wp(i),i= 201, 240)/
     1.1318451E-01,.1284384E-01,.1249758E-01,.1214587E-01,.1178887E-01,
     2.1142673E-01,.1105962E-01,.1068768E-01,.1031109E-01,.9930004E-02,
     3.9544593E-02,.9155022E-02,.8761463E-02,.8364086E-02,.7963064E-02,
     4.7558573E-02,.7150788E-02,.6739888E-02,.6326051E-02,.5909457E-02,
     5.5490289E-02,.5068728E-02,.4644959E-02,.4219166E-02,.3791535E-02,
     6.3362252E-02,.2931504E-02,.2499479E-02,.2066366E-02,.1632357E-02,
     7.1197647E-02,.7624721E-03,.3276087E-03,.1566826E-01,.1566442E-01,
     8.1565672E-01,.1564519E-01,.1562981E-01,.1561059E-01,.1558755E-01/
      data (wp(i),i= 241, 280)/
     1.1556067E-01,.1552998E-01,.1549547E-01,.1545716E-01,.1541506E-01,
     2.1536917E-01,.1531950E-01,.1526608E-01,.1520891E-01,.1514800E-01,
     3.1508338E-01,.1501505E-01,.1494303E-01,.1486735E-01,.1478802E-01,
     4.1470505E-01,.1461848E-01,.1452832E-01,.1443459E-01,.1433731E-01,
     5.1423652E-01,.1413223E-01,.1402447E-01,.1391327E-01,.1379866E-01,
     6.1368065E-01,.1355929E-01,.1343460E-01,.1330661E-01,.1317535E-01,
     7.1304086E-01,.1290316E-01,.1276230E-01,.1261831E-01,.1247122E-01,
     8.1232106E-01,.1216788E-01,.1201172E-01,.1185260E-01,.1169058E-01/
      data (wp(i),i= 281, 320)/
     1.1152568E-01,.1135796E-01,.1118744E-01,.1101418E-01,.1083822E-01,
     2.1065959E-01,.1047835E-01,.1029454E-01,.1010820E-01,.9919373E-02,
     3.9728115E-02,.9534468E-02,.9338480E-02,.9140200E-02,.8939676E-02,
     4.8736957E-02,.8532093E-02,.8325134E-02,.8116132E-02,.7905137E-02,
     5.7692201E-02,.7477377E-02,.7260717E-02,.7042274E-02,.6822103E-02,
     6.6600256E-02,.6376790E-02,.6151757E-02,.5925215E-02,.5697218E-02,
     7.5467822E-02,.5237083E-02,.5005059E-02,.4771806E-02,.4537382E-02,
     8.4301844E-02,.4065249E-02,.3827657E-02,.3589125E-02,.3349711E-02/
      data (wp(i),i= 321, 360)/
     1.3109476E-02,.2868477E-02,.2626773E-02,.2384425E-02,.2141492E-02,
     2.1898033E-02,.1654108E-02,.1409777E-02,.1165101E-02,.9201405E-03,
     3.6749606E-03,.4296466E-03,.1845901E-03,.1045439E-01,.1045325E-01,
     4.1045097E-01,.1044754E-01,.1044297E-01,.1043726E-01,.1043041E-01,
     5.1042242E-01,.1041329E-01,.1040302E-01,.1039161E-01,.1037907E-01,
     6.1036539E-01,.1035058E-01,.1033464E-01,.1031758E-01,.1029938E-01,
     7.1028006E-01,.1025961E-01,.1023804E-01,.1021535E-01,.1019155E-01,
     8.1016663E-01,.1014060E-01,.1011347E-01,.1008523E-01,.1005588E-01/
      data (wp(i),i= 361, 400)/
     1.1002544E-01,.9993899E-02,.9961267E-02,.9927547E-02,.9892741E-02,
     2.9856855E-02,.9819891E-02,.9781854E-02,.9742747E-02,.9702576E-02,
     3.9661345E-02,.9619057E-02,.9575718E-02,.9531333E-02,.9485905E-02,
     4.9439441E-02,.9391946E-02,.9343424E-02,.9293880E-02,.9243321E-02,
     5.9191751E-02,.9139177E-02,.9085604E-02,.9031038E-02,.8975485E-02,
     6.8918951E-02,.8861442E-02,.8802965E-02,.8743525E-02,.8683130E-02,
     7.8621786E-02,.8559499E-02,.8496277E-02,.8432127E-02,.8367054E-02,
     8.8301068E-02,.8234174E-02,.8166380E-02,.8097693E-02,.8028121E-02/
      data (wp(i),i= 401, 440)/
     1.7957672E-02,.7886353E-02,.7814173E-02,.7741138E-02,.7667257E-02,
     2.7592538E-02,.7516989E-02,.7440619E-02,.7363435E-02,.7285447E-02,
     3.7206662E-02,.7127090E-02,.7046739E-02,.6965617E-02,.6883734E-02,
     4.6801099E-02,.6717721E-02,.6633608E-02,.6548770E-02,.6463217E-02,
     5.6376957E-02,.6290000E-02,.6202356E-02,.6114033E-02,.6025043E-02,
     6.5935394E-02,.5845096E-02,.5754159E-02,.5662594E-02,.5570409E-02,
     7.5477616E-02,.5384224E-02,.5290244E-02,.5195685E-02,.5100559E-02,
     8.5004875E-02,.4908644E-02,.4811876E-02,.4714583E-02,.4616774E-02/
      data (wp(i),i= 441, 480)/
     1.4518461E-02,.4419654E-02,.4320364E-02,.4220601E-02,.4120378E-02,
     2.4019704E-02,.3918590E-02,.3817049E-02,.3715090E-02,.3612725E-02,
     3.3509965E-02,.3406822E-02,.3303306E-02,.3199429E-02,.3095203E-02,
     4.2990638E-02,.2885746E-02,.2780539E-02,.2675029E-02,.2569225E-02,
     5.2463141E-02,.2356788E-02,.2250177E-02,.2143320E-02,.2036229E-02,
     6.1928915E-02,.1821391E-02,.1713667E-02,.1605756E-02,.1497670E-02,
     7.1389420E-02,.1281018E-02,.1172476E-02,.1063806E-02,.9550200E-03,
     8.8461294E-03,.7371464E-03,.6280830E-03,.5189512E-03,.4097636E-03/
      data (wp(i),i= 481, 520)/
     1.3005340E-03,.1912855E-03,.8217779E-04,.7844110E-02,.7843627E-02,
     2.7842662E-02,.7841214E-02,.7839284E-02,.7836871E-02,.7833976E-02,
     3.7830599E-02,.7826741E-02,.7822400E-02,.7817579E-02,.7812276E-02,
     4.7806493E-02,.7800229E-02,.7793485E-02,.7786262E-02,.7778560E-02,
     5.7770379E-02,.7761720E-02,.7752583E-02,.7742970E-02,.7732880E-02,
     6.7722314E-02,.7711273E-02,.7699757E-02,.7687768E-02,.7675306E-02,
     7.7662371E-02,.7648965E-02,.7635088E-02,.7620742E-02,.7605926E-02,
     8.7590643E-02,.7574892E-02,.7558676E-02,.7541994E-02,.7524848E-02/
      data (wp(i),i= 521, 560)/
     1.7507240E-02,.7489169E-02,.7470638E-02,.7451646E-02,.7432197E-02,
     2.7412290E-02,.7391927E-02,.7371109E-02,.7349838E-02,.7328114E-02,
     3.7305939E-02,.7283315E-02,.7260243E-02,.7236724E-02,.7212760E-02,
     4.7188352E-02,.7163501E-02,.7138210E-02,.7112480E-02,.7086312E-02,
     5.7059708E-02,.7032669E-02,.7005198E-02,.6977296E-02,.6948964E-02,
     6.6920205E-02,.6891020E-02,.6861412E-02,.6831380E-02,.6800929E-02,
     7.6770059E-02,.6738773E-02,.6707072E-02,.6674958E-02,.6642433E-02,
     8.6609500E-02,.6576160E-02,.6542416E-02,.6508269E-02,.6473721E-02/
      data (wp(i),i= 561, 600)/
     1.6438775E-02,.6403433E-02,.6367697E-02,.6331569E-02,.6295052E-02,
     2.6258147E-02,.6220857E-02,.6183184E-02,.6145131E-02,.6106700E-02,
     3.6067893E-02,.6028713E-02,.5989161E-02,.5949241E-02,.5908956E-02,
     4.5868306E-02,.5827296E-02,.5785926E-02,.5744201E-02,.5702123E-02,
     5.5659693E-02,.5616916E-02,.5573792E-02,.5530326E-02,.5486520E-02,
     6.5442376E-02,.5397897E-02,.5353085E-02,.5307945E-02,.5262478E-02,
     7.5216687E-02,.5170575E-02,.5124145E-02,.5077400E-02,.5030342E-02,
     8.4982975E-02,.4935301E-02,.4887323E-02,.4839045E-02,.4790469E-02/
      data (wp(i),i= 601, 640)/
     1.4741598E-02,.4692436E-02,.4642984E-02,.4593247E-02,.4543228E-02,
     2.4492929E-02,.4442353E-02,.4391504E-02,.4340385E-02,.4288999E-02,
     3.4237349E-02,.4185438E-02,.4133270E-02,.4080847E-02,.4028173E-02,
     4.3975251E-02,.3922085E-02,.3868678E-02,.3815032E-02,.3761152E-02,
     5.3707040E-02,.3652700E-02,.3598135E-02,.3543349E-02,.3488345E-02,
     6.3433126E-02,.3377697E-02,.3322059E-02,.3266217E-02,.3210173E-02,
     7.3153933E-02,.3097498E-02,.3040873E-02,.2984060E-02,.2927064E-02,
     8.2869888E-02,.2812535E-02,.2755009E-02,.2697314E-02,.2639453E-02/
      data (wp(i),i= 641, 680)/
     1.2581429E-02,.2523247E-02,.2464909E-02,.2406419E-02,.2347782E-02,
     2.2289000E-02,.2230077E-02,.2171017E-02,.2111823E-02,.2052500E-02,
     3.1993050E-02,.1933477E-02,.1873786E-02,.1813979E-02,.1754061E-02,
     4.1694034E-02,.1633904E-02,.1573673E-02,.1513345E-02,.1452924E-02,
     5.1392413E-02,.1331817E-02,.1271139E-02,.1210383E-02,.1149552E-02,
     6.1088651E-02,.1027682E-02,.9666507E-03,.9055595E-03,.8444126E-03,
     7.7832138E-03,.7219667E-03,.6606753E-03,.5993432E-03,.5379742E-03,
     8.4765722E-03,.4151409E-03,.3536841E-03,.2922057E-03,.2307099E-03/
      data (wp(i),i= 681, 720)/
     1.1692014E-03,.1076904E-03,.4626372E-04,.5231608E-02,.5231465E-02,
     2.5231179E-02,.5230749E-02,.5230177E-02,.5229461E-02,.5228602E-02,
     3.5227600E-02,.5226454E-02,.5225166E-02,.5223735E-02,.5222161E-02,
     4.5220444E-02,.5218584E-02,.5216581E-02,.5214435E-02,.5212147E-02,
     5.5209716E-02,.5207142E-02,.5204426E-02,.5201567E-02,.5198567E-02,
     6.5195423E-02,.5192138E-02,.5188710E-02,.5185141E-02,.5181429E-02,
     7.5177576E-02,.5173581E-02,.5169445E-02,.5165167E-02,.5160747E-02,
     8.5156186E-02,.5151485E-02,.5146642E-02,.5141658E-02,.5136534E-02/
      data (wp(i),i= 721, 760)/
     1.5131269E-02,.5125863E-02,.5120318E-02,.5114632E-02,.5108806E-02,
     2.5102840E-02,.5096735E-02,.5090490E-02,.5084106E-02,.5077583E-02,
     3.5070920E-02,.5064119E-02,.5057180E-02,.5050102E-02,.5042885E-02,
     4.5035531E-02,.5028039E-02,.5020409E-02,.5012642E-02,.5004738E-02,
     5.4996696E-02,.4988518E-02,.4980203E-02,.4971752E-02,.4963165E-02,
     6.4954443E-02,.4945584E-02,.4936590E-02,.4927461E-02,.4918197E-02,
     7.4908799E-02,.4899266E-02,.4889599E-02,.4879799E-02,.4869864E-02,
     8.4859797E-02,.4849596E-02,.4839263E-02,.4828797E-02,.4818199E-02/
      data (wp(i),i= 761, 800)/
     1.4807470E-02,.4796608E-02,.4785616E-02,.4774492E-02,.4763238E-02,
     2.4751853E-02,.4740338E-02,.4728694E-02,.4716920E-02,.4705017E-02,
     3.4692985E-02,.4680825E-02,.4668537E-02,.4656121E-02,.4643577E-02,
     4.4630907E-02,.4618109E-02,.4605185E-02,.4592136E-02,.4578960E-02,
     5.4565659E-02,.4552233E-02,.4538683E-02,.4525008E-02,.4511210E-02,
     6.4497288E-02,.4483243E-02,.4469075E-02,.4454785E-02,.4440373E-02,
     7.4425840E-02,.4411185E-02,.4396410E-02,.4381514E-02,.4366498E-02,
     8.4351363E-02,.4336109E-02,.4320736E-02,.4305245E-02,.4289636E-02/
      data (wp(i),i= 801, 840)/
     1.4273910E-02,.4258066E-02,.4242106E-02,.4226030E-02,.4209839E-02,
     2.4193532E-02,.4177110E-02,.4160574E-02,.4143924E-02,.4127161E-02,
     3.4110284E-02,.4093296E-02,.4076195E-02,.4058982E-02,.4041659E-02,
     4.4024225E-02,.4006681E-02,.3989027E-02,.3971264E-02,.3953392E-02,
     5.3935412E-02,.3917324E-02,.3899129E-02,.3880828E-02,.3862420E-02,
     6.3843906E-02,.3825288E-02,.3806564E-02,.3787737E-02,.3768805E-02,
     7.3749771E-02,.3730634E-02,.3711395E-02,.3692054E-02,.3672612E-02,
     8.3653070E-02,.3633427E-02,.3613685E-02,.3593845E-02,.3573906E-02/
      data (wp(i),i= 841, 880)/
     1.3553869E-02,.3533735E-02,.3513504E-02,.3493177E-02,.3472754E-02,
     2.3452237E-02,.3431624E-02,.3410918E-02,.3390119E-02,.3369227E-02,
     3.3348242E-02,.3327166E-02,.3305999E-02,.3284741E-02,.3263394E-02,
     4.3241957E-02,.3220431E-02,.3198818E-02,.3177116E-02,.3155328E-02,
     5.3133454E-02,.3111493E-02,.3089448E-02,.3067318E-02,.3045104E-02,
     6.3022806E-02,.3000426E-02,.2977964E-02,.2955420E-02,.2932796E-02,
     7.2910091E-02,.2887306E-02,.2864443E-02,.2841501E-02,.2818481E-02,
     8.2795384E-02,.2772211E-02,.2748961E-02,.2725637E-02,.2702238E-02/
      data (wp(i),i= 881, 920)/
     1.2678765E-02,.2655218E-02,.2631599E-02,.2607908E-02,.2584146E-02,
     2.2560312E-02,.2536409E-02,.2512437E-02,.2488395E-02,.2464286E-02,
     3.2440109E-02,.2415865E-02,.2391555E-02,.2367179E-02,.2342739E-02,
     4.2318235E-02,.2293667E-02,.2269037E-02,.2244344E-02,.2219590E-02,
     5.2194775E-02,.2169901E-02,.2144966E-02,.2119973E-02,.2094922E-02,
     6.2069814E-02,.2044649E-02,.2019428E-02,.1994152E-02,.1968821E-02,
     7.1943437E-02,.1917999E-02,.1892508E-02,.1866966E-02,.1841373E-02,
     8.1815729E-02,.1790036E-02,.1764294E-02,.1738503E-02,.1712665E-02/
      data (wp(i),i= 921, 960)/
     1.1686780E-02,.1660848E-02,.1634872E-02,.1608850E-02,.1582785E-02,
     2.1556676E-02,.1530525E-02,.1504331E-02,.1478097E-02,.1451822E-02,
     3.1425507E-02,.1399154E-02,.1372762E-02,.1346332E-02,.1319866E-02,
     4.1293363E-02,.1266825E-02,.1240253E-02,.1213646E-02,.1187006E-02,
     5.1160334E-02,.1133630E-02,.1106895E-02,.1080130E-02,.1053335E-02,
     6.1026511E-02,.9996593E-03,.9727801E-03,.9458743E-03,.9189426E-03,
     7.8919858E-03,.8650045E-03,.8379996E-03,.8109717E-03,.7839217E-03,
     8.7568502E-03,.7297579E-03,.7026457E-03,.6755143E-03,.6483644E-03/
      data (wp(i),i= 961,1000)/
     1.6211967E-03,.5940120E-03,.5668111E-03,.5395947E-03,.5123635E-03,
     2.4851182E-03,.4578597E-03,.4305887E-03,.4033058E-03,.3760120E-03,
     3.3487078E-03,.3213941E-03,.2940716E-03,.2667411E-03,.2394033E-03,
     4.2120589E-03,.1847087E-03,.1573535E-03,.1299941E-03,.1026314E-03,
     5.7526651E-04,.4790311E-04,.2057885E-04,.3924530E-02,.3924469E-02,
     6.3924348E-02,.3924167E-02,.3923925E-02,.3923623E-02,.3923260E-02,
     7.3922837E-02,.3922354E-02,.3921810E-02,.3921206E-02,.3920541E-02,
     8.3919816E-02,.3919030E-02,.3918185E-02,.3917278E-02,.3916312E-02/
      data (wp(i),i=1001,1040)/
     1.3915285E-02,.3914198E-02,.3913051E-02,.3911843E-02,.3910575E-02,
     2.3909247E-02,.3907858E-02,.3906410E-02,.3904901E-02,.3903332E-02,
     3.3901703E-02,.3900014E-02,.3898265E-02,.3896456E-02,.3894587E-02,
     4.3892658E-02,.3890668E-02,.3888619E-02,.3886510E-02,.3884342E-02,
     5.3882113E-02,.3879825E-02,.3877476E-02,.3875068E-02,.3872601E-02,
     6.3870074E-02,.3867487E-02,.3864840E-02,.3862134E-02,.3859369E-02,
     7.3856544E-02,.3853660E-02,.3850716E-02,.3847713E-02,.3844651E-02,
     8.3841530E-02,.3838349E-02,.3835109E-02,.3831811E-02,.3828453E-02/
      data (wp(i),i=1041,1080)/
     1.3825036E-02,.3821561E-02,.3818026E-02,.3814433E-02,.3810781E-02,
     2.3807070E-02,.3803300E-02,.3799473E-02,.3795586E-02,.3791641E-02,
     3.3787638E-02,.3783576E-02,.3779456E-02,.3775278E-02,.3771042E-02,
     4.3766747E-02,.3762395E-02,.3757984E-02,.3753516E-02,.3748990E-02,
     5.3744406E-02,.3739765E-02,.3735066E-02,.3730309E-02,.3725495E-02,
     6.3720624E-02,.3715695E-02,.3710709E-02,.3705666E-02,.3700566E-02,
     7.3695408E-02,.3690194E-02,.3684923E-02,.3679596E-02,.3674211E-02,
     8.3668770E-02,.3663273E-02,.3657719E-02,.3652109E-02,.3646442E-02/
      data (wp(i),i=1081,1120)/
     1.3640720E-02,.3634941E-02,.3629106E-02,.3623216E-02,.3617269E-02,
     2.3611267E-02,.3605209E-02,.3599096E-02,.3592927E-02,.3586703E-02,
     3.3580424E-02,.3574090E-02,.3567700E-02,.3561256E-02,.3554757E-02,
     4.3548203E-02,.3541594E-02,.3534931E-02,.3528213E-02,.3521441E-02,
     5.3514615E-02,.3507734E-02,.3500800E-02,.3493812E-02,.3486770E-02,
     6.3479674E-02,.3472524E-02,.3465321E-02,.3458065E-02,.3450756E-02,
     7.3443393E-02,.3435977E-02,.3428508E-02,.3420987E-02,.3413413E-02,
     8.3405786E-02,.3398107E-02,.3390375E-02,.3382592E-02,.3374756E-02/
      data (wp(i),i=1121,1160)/
     1.3366868E-02,.3358928E-02,.3350937E-02,.3342894E-02,.3334800E-02,
     2.3326654E-02,.3318457E-02,.3310208E-02,.3301909E-02,.3293559E-02,
     3.3285158E-02,.3276707E-02,.3268205E-02,.3259653E-02,.3251051E-02,
     4.3242398E-02,.3233696E-02,.3224944E-02,.3216142E-02,.3207290E-02,
     5.3198390E-02,.3189440E-02,.3180440E-02,.3171392E-02,.3162295E-02,
     6.3153149E-02,.3143955E-02,.3134712E-02,.3125421E-02,.3116082E-02,
     7.3106695E-02,.3097260E-02,.3087778E-02,.3078247E-02,.3068670E-02,
     8.3059045E-02,.3049373E-02,.3039654E-02,.3029888E-02,.3020075E-02/
      data (wp(i),i=1161,1200)/
     1.3010217E-02,.3000311E-02,.2990360E-02,.2980362E-02,.2970318E-02,
     2.2960229E-02,.2950094E-02,.2939914E-02,.2929688E-02,.2919418E-02,
     3.2909102E-02,.2898742E-02,.2888336E-02,.2877887E-02,.2867393E-02,
     4.2856855E-02,.2846273E-02,.2835647E-02,.2824977E-02,.2814264E-02,
     5.2803508E-02,.2792708E-02,.2781865E-02,.2770980E-02,.2760052E-02,
     6.2749081E-02,.2738068E-02,.2727013E-02,.2715915E-02,.2704776E-02,
     7.2693596E-02,.2682374E-02,.2671110E-02,.2659805E-02,.2648460E-02,
     8.2637073E-02,.2625646E-02,.2614179E-02,.2602671E-02,.2591123E-02/
      data (wp(i),i=1201,1240)/
     1.2579536E-02,.2567908E-02,.2556241E-02,.2544535E-02,.2532789E-02,
     2.2521005E-02,.2509181E-02,.2497319E-02,.2485419E-02,.2473480E-02,
     3.2461503E-02,.2449488E-02,.2437436E-02,.2425346E-02,.2413218E-02,
     4.2401054E-02,.2388852E-02,.2376614E-02,.2364339E-02,.2352028E-02,
     5.2339680E-02,.2327296E-02,.2314877E-02,.2302422E-02,.2289931E-02,
     6.2277405E-02,.2264844E-02,.2252249E-02,.2239618E-02,.2226953E-02,
     7.2214254E-02,.2201520E-02,.2188753E-02,.2175952E-02,.2163117E-02,
     8.2150249E-02,.2137349E-02,.2124415E-02,.2111448E-02,.2098449E-02/
      data (wp(i),i=1241,1280)/
     1.2085417E-02,.2072354E-02,.2059258E-02,.2046131E-02,.2032972E-02,
     2.2019782E-02,.2006561E-02,.1993309E-02,.1980026E-02,.1966713E-02,
     3.1953370E-02,.1939996E-02,.1926592E-02,.1913159E-02,.1899697E-02,
     4.1886205E-02,.1872684E-02,.1859134E-02,.1845555E-02,.1831949E-02,
     5.1818314E-02,.1804650E-02,.1790960E-02,.1777241E-02,.1763495E-02,
     6.1749722E-02,.1735922E-02,.1722096E-02,.1708242E-02,.1694363E-02,
     7.1680457E-02,.1666526E-02,.1652569E-02,.1638586E-02,.1624578E-02,
     8.1610545E-02,.1596488E-02,.1582405E-02,.1568299E-02,.1554168E-02/
      data (wp(i),i=1281,1320)/
     1.1540013E-02,.1525835E-02,.1511633E-02,.1497407E-02,.1483159E-02,
     2.1468888E-02,.1454594E-02,.1440278E-02,.1425940E-02,.1411579E-02,
     3.1397197E-02,.1382794E-02,.1368369E-02,.1353923E-02,.1339456E-02,
     4.1324969E-02,.1310461E-02,.1295933E-02,.1281385E-02,.1266817E-02,
     5.1252230E-02,.1237623E-02,.1222998E-02,.1208353E-02,.1193690E-02,
     6.1179009E-02,.1164309E-02,.1149592E-02,.1134857E-02,.1120104E-02,
     7.1105334E-02,.1090547E-02,.1075743E-02,.1060923E-02,.1046086E-02,
     8.1031234E-02,.1016365E-02,.1001481E-02,.9865808E-03,.9716658E-03/
      data (wp(i),i=1321,1360)/
     1.9567359E-03,.9417913E-03,.9268321E-03,.9118587E-03,.8968712E-03,
     2.8818700E-03,.8668551E-03,.8518269E-03,.8367855E-03,.8217313E-03,
     3.8066644E-03,.7915851E-03,.7764936E-03,.7613902E-03,.7462750E-03,
     4.7311483E-03,.7160104E-03,.7008614E-03,.6857017E-03,.6705313E-03,
     5.6553507E-03,.6401600E-03,.6249593E-03,.6097491E-03,.5945295E-03,
     6.5793007E-03,.5640630E-03,.5488166E-03,.5335618E-03,.5182987E-03,
     7.5030277E-03,.4877489E-03,.4724626E-03,.4571690E-03,.4418684E-03,
     8.4265610E-03,.4112470E-03,.3959267E-03,.3806003E-03,.3652680E-03/
      data (wp(i),i=1361,1400)/
     1.3499301E-03,.3345867E-03,.3192383E-03,.3038849E-03,.2885269E-03,
     2.2731644E-03,.2577977E-03,.2424270E-03,.2270526E-03,.2116747E-03,
     3.1962935E-03,.1809093E-03,.1655224E-03,.1501328E-03,.1347410E-03,
     4.1193471E-03,.1039514E-03,.8855408E-04,.7315545E-04,.5775582E-04,
     5.4235569E-04,.2695689E-04,.1158044E-04,.3140018E-02,.3139987E-02,
     6.3139926E-02,.3139833E-02,.3139709E-02,.3139554E-02,.3139368E-02,
     7.3139152E-02,.3138904E-02,.3138625E-02,.3138316E-02,.3137975E-02,
     8.3137604E-02,.3137201E-02,.3136768E-02,.3136304E-02,.3135809E-02/
      data (wp(i),i=1401,1440)/
     1.3135283E-02,.3134726E-02,.3134138E-02,.3133519E-02,.3132869E-02,
     2.3132189E-02,.3131477E-02,.3130735E-02,.3129962E-02,.3129158E-02,
     3.3128323E-02,.3127457E-02,.3126560E-02,.3125633E-02,.3124675E-02,
     4.3123686E-02,.3122666E-02,.3121615E-02,.3120534E-02,.3119422E-02,
     5.3118279E-02,.3117105E-02,.3115901E-02,.3114666E-02,.3113400E-02,
     6.3112103E-02,.3110776E-02,.3109418E-02,.3108029E-02,.3106610E-02,
     7.3105160E-02,.3103680E-02,.3102169E-02,.3100627E-02,.3099055E-02,
     8.3097452E-02,.3095819E-02,.3094155E-02,.3092461E-02,.3090736E-02/
      data (wp(i),i=1441,1480)/
     1.3088981E-02,.3087195E-02,.3085379E-02,.3083532E-02,.3081655E-02,
     2.3079748E-02,.3077810E-02,.3075842E-02,.3073843E-02,.3071815E-02,
     3.3069756E-02,.3067666E-02,.3065547E-02,.3063397E-02,.3061217E-02,
     4.3059007E-02,.3056766E-02,.3054496E-02,.3052195E-02,.3049865E-02,
     5.3047504E-02,.3045113E-02,.3042692E-02,.3040242E-02,.3037761E-02,
     6.3035250E-02,.3032709E-02,.3030139E-02,.3027538E-02,.3024908E-02,
     7.3022248E-02,.3019558E-02,.3016838E-02,.3014089E-02,.3011310E-02,
     8.3008501E-02,.3005662E-02,.3002794E-02,.2999896E-02,.2996969E-02/
      data (wp(i),i=1481,1520)/
     1.2994012E-02,.2991026E-02,.2988010E-02,.2984965E-02,.2981890E-02,
     2.2978786E-02,.2975652E-02,.2972489E-02,.2969297E-02,.2966075E-02,
     3.2962825E-02,.2959545E-02,.2956236E-02,.2952897E-02,.2949530E-02,
     4.2946134E-02,.2942708E-02,.2939254E-02,.2935770E-02,.2932258E-02,
     5.2928716E-02,.2925146E-02,.2921547E-02,.2917919E-02,.2914262E-02,
     6.2910577E-02,.2906863E-02,.2903120E-02,.2899349E-02,.2895549E-02,
     7.2891720E-02,.2887863E-02,.2883978E-02,.2880064E-02,.2876122E-02,
     8.2872151E-02,.2868152E-02,.2864125E-02,.2860069E-02,.2855985E-02/
      data (wp(i),i=1521,1560)/
     1.2851873E-02,.2847734E-02,.2843565E-02,.2839369E-02,.2835145E-02,
     2.2830893E-02,.2826613E-02,.2822305E-02,.2817970E-02,.2813606E-02,
     3.2809215E-02,.2804796E-02,.2800350E-02,.2795875E-02,.2791374E-02,
     4.2786844E-02,.2782288E-02,.2777704E-02,.2773092E-02,.2768453E-02,
     5.2763787E-02,.2759094E-02,.2754373E-02,.2749625E-02,.2744850E-02,
     6.2740048E-02,.2735219E-02,.2730363E-02,.2725480E-02,.2720571E-02,
     7.2715634E-02,.2710671E-02,.2705681E-02,.2700664E-02,.2695621E-02,
     8.2690551E-02,.2685454E-02,.2680331E-02,.2675182E-02,.2670006E-02/
      data (wp(i),i=1561,1600)/
     1.2664804E-02,.2659576E-02,.2654321E-02,.2649040E-02,.2643733E-02,
     2.2638400E-02,.2633041E-02,.2627657E-02,.2622246E-02,.2616809E-02,
     3.2611347E-02,.2605858E-02,.2600344E-02,.2594805E-02,.2589240E-02,
     4.2583649E-02,.2578033E-02,.2572391E-02,.2566724E-02,.2561032E-02,
     5.2555315E-02,.2549572E-02,.2543804E-02,.2538011E-02,.2532193E-02,
     6.2526350E-02,.2520483E-02,.2514590E-02,.2508672E-02,.2502730E-02,
     7.2496763E-02,.2490772E-02,.2484756E-02,.2478715E-02,.2472650E-02,
     8.2466561E-02,.2460447E-02,.2454309E-02,.2448147E-02,.2441961E-02/
      data (wp(i),i=1601,1640)/
     1.2435751E-02,.2429516E-02,.2423258E-02,.2416976E-02,.2410670E-02,
     2.2404340E-02,.2397986E-02,.2391609E-02,.2385209E-02,.2378784E-02,
     3.2372337E-02,.2365866E-02,.2359371E-02,.2352853E-02,.2346312E-02,
     4.2339748E-02,.2333161E-02,.2326551E-02,.2319918E-02,.2313262E-02,
     5.2306584E-02,.2299882E-02,.2293158E-02,.2286411E-02,.2279642E-02,
     6.2272850E-02,.2266036E-02,.2259200E-02,.2252341E-02,.2245460E-02,
     7.2238557E-02,.2231631E-02,.2224684E-02,.2217715E-02,.2210724E-02,
     8.2203711E-02,.2196677E-02,.2189620E-02,.2182543E-02,.2175443E-02/
      data (wp(i),i=1641,1680)/
     1.2168323E-02,.2161180E-02,.2154017E-02,.2146832E-02,.2139626E-02,
     2.2132400E-02,.2125152E-02,.2117883E-02,.2110593E-02,.2103282E-02,
     3.2095951E-02,.2088599E-02,.2081226E-02,.2073833E-02,.2066420E-02,
     4.2058986E-02,.2051531E-02,.2044057E-02,.2036562E-02,.2029047E-02,
     5.2021513E-02,.2013958E-02,.2006384E-02,.1998789E-02,.1991175E-02,
     6.1983542E-02,.1975888E-02,.1968216E-02,.1960524E-02,.1952812E-02,
     7.1945082E-02,.1937332E-02,.1929563E-02,.1921775E-02,.1913968E-02,
     8.1906142E-02,.1898298E-02,.1890434E-02,.1882552E-02,.1874652E-02/
      data (wp(i),i=1681,1720)/
     1.1866733E-02,.1858795E-02,.1850840E-02,.1842866E-02,.1834874E-02,
     2.1826863E-02,.1818835E-02,.1810789E-02,.1802725E-02,.1794643E-02,
     3.1786544E-02,.1778427E-02,.1770292E-02,.1762140E-02,.1753970E-02,
     4.1745784E-02,.1737580E-02,.1729359E-02,.1721120E-02,.1712865E-02,
     5.1704593E-02,.1696304E-02,.1687999E-02,.1679677E-02,.1671338E-02,
     6.1662983E-02,.1654611E-02,.1646223E-02,.1637819E-02,.1629399E-02,
     7.1620962E-02,.1612510E-02,.1604042E-02,.1595557E-02,.1587058E-02,
     8.1578542E-02,.1570011E-02,.1561465E-02,.1552903E-02,.1544325E-02/
      data (wp(i),i=1721,1760)/
     1.1535733E-02,.1527125E-02,.1518503E-02,.1509865E-02,.1501213E-02,
     2.1492545E-02,.1483863E-02,.1475167E-02,.1466456E-02,.1457730E-02,
     3.1448990E-02,.1440236E-02,.1431467E-02,.1422684E-02,.1413888E-02,
     4.1405077E-02,.1396253E-02,.1387414E-02,.1378563E-02,.1369697E-02,
     5.1360818E-02,.1351926E-02,.1343020E-02,.1334101E-02,.1325169E-02,
     6.1316224E-02,.1307265E-02,.1298294E-02,.1289310E-02,.1280314E-02,
     7.1271305E-02,.1262283E-02,.1253249E-02,.1244202E-02,.1235143E-02,
     8.1226072E-02,.1216989E-02,.1207894E-02,.1198787E-02,.1189668E-02/
      data (wp(i),i=1761,1800)/
     1.1180538E-02,.1171396E-02,.1162242E-02,.1153077E-02,.1143900E-02,
     2.1134712E-02,.1125513E-02,.1116303E-02,.1107082E-02,.1097850E-02,
     3.1088607E-02,.1079354E-02,.1070089E-02,.1060815E-02,.1051529E-02,
     4.1042234E-02,.1032928E-02,.1023612E-02,.1014286E-02,.1004950E-02,
     5.9956034E-03,.9862475E-03,.9768819E-03,.9675067E-03,.9581219E-03,
     6.9487276E-03,.9393240E-03,.9299112E-03,.9204892E-03,.9110581E-03,
     7.9016180E-03,.8921690E-03,.8827112E-03,.8732448E-03,.8637697E-03,
     8.8542861E-03,.8447941E-03,.8352937E-03,.8257851E-03,.8162684E-03/
      data (wp(i),i=1801,1840)/
     1.8067436E-03,.7972109E-03,.7876703E-03,.7781220E-03,.7685659E-03,
     2.7590023E-03,.7494312E-03,.7398528E-03,.7302670E-03,.7206740E-03,
     3.7110739E-03,.7014668E-03,.6918528E-03,.6822320E-03,.6726045E-03,
     4.6629703E-03,.6533295E-03,.6436824E-03,.6340289E-03,.6243691E-03,
     5.6147032E-03,.6050312E-03,.5953533E-03,.5856694E-03,.5759799E-03,
     6.5662846E-03,.5565837E-03,.5468774E-03,.5371657E-03,.5274486E-03,
     7.5177264E-03,.5079991E-03,.4982667E-03,.4885295E-03,.4787874E-03,
     8.4690406E-03,.4592892E-03,.4495332E-03,.4397729E-03,.4300082E-03/
      data (wp(i),i=1841,1880)/
     1.4202392E-03,.4104661E-03,.4006890E-03,.3909079E-03,.3811229E-03,
     2.3713342E-03,.3615418E-03,.3517459E-03,.3419465E-03,.3321437E-03,
     3.3223377E-03,.3125285E-03,.3027162E-03,.2929009E-03,.2830827E-03,
     4.2732617E-03,.2634380E-03,.2536118E-03,.2437830E-03,.2339519E-03,
     5.2241184E-03,.2142827E-03,.2044449E-03,.1946051E-03,.1847634E-03,
     6.1749198E-03,.1650745E-03,.1552276E-03,.1453792E-03,.1355293E-03,
     7.1256781E-03,.1158257E-03,.1059721E-03,.9611747E-04,.8626190E-04,
     8.7640548E-04,.6654832E-04,.5669051E-04,.4683217E-04,.3697344E-04/
	  data (wp(i),i=1881,1883)/
     1.2711461E-04,.1725677E-04,.7413338E-05/

      CsTH = cos(TwoTH0 * 0.5/RAD)
      if (abs(CsTH) .lt. 1.0e-15) CsTH = 1.0e-15
      TTH = sin(TwoTH0 * 0.5/RAD)/CsTH
      CsTwoTH = cos(TwoTH0/RAD)
      SnTwoTH = sin(TwoTH0/RAD)
      ApB = S_L + D_L
      AmB = S_L - D_L
      ApB2 = ApB**2
      if (((S_L .ne. 0.0) .or. (D_L .ne. 0.0)) .and. Use_Asym) then
        tmp = sqrt(1.0 + AmB**2)*CsTwoTH
        if (abs(tmp) .gt. 1.0)tmp = 1.0
        Einfl = acos(tmp)*RAD
        tmp2 = 1.0 + ApB2
        tmp = sqrt(tmp2 ) * CsTwoTH

c If S_L or D_L are zero, set Einfl = 2theta 
      
	  if ((S_L .eq. 0.0) .or. (D_L .eq. 0.0)) Einfl = TwoTH0
	  if (abs(tmp) .le. 1.0) then
          Emin = acos(tmp) * RAD
          tmp1 = tmp2 * (1.0 - tmp2 * CsTwoTH**2)
        else
          tmp1 = 0.0
          if (tmp .gt. 0.0) then
            Emin = 0.0
          else
            Emin = 180.0
          endif
        endif
        if ((tmp1 .gt. 0.0) .and. (abs(tmp) .le. 1.0)) then
          dEmindA = -ApB * CsTwoTH/sqrt(tmp1)
        else
          dEmindA = 0.0
        endif
        ArrayNum = 1
        K = 400.0 * (TwoTH0 - Emin)   ! Calculate number of terms needed 
	  K = max(K,80*int((TwoTH0-Emin)/gamma))
        do while ((ArrayNum .lt. 14) .and. (K .gt. NTERMS(ArrayNum)))
          ArrayNum = ArrayNum + 1
        enddo
        NGT = nterms(ArrayNum)              ! Save number of terms 
        ngt2 = ngt / 2
c Clear terms needed for summations 
        sumWG = 0.0
        sumWRG = 0.0
        sumWdGdA = 0.0
        sumWRdGdA = 0.0
        sumWdGdB = 0.0
        sumWRdGdB = 0.0
        sumWGdRd2t = 0.0
        sumWGdRdG = 0.0
        sumWGdRdE = 0.0
        sumWGdRdA = 0.0
        sumWGdRdB = 0.0
c Compute the convolution integral 
        it = fstterm(arraynum)-ngt2
        do K = ngt2 , NGT 
          delta = Emin + (TwoTH0 - Emin) * xp(k + it)
          dDeltadA = (1.0 - xp(k+it) ) * dEmindA
          sinDELTA = sin(Delta/RAD)
          cosDELTA = cos(Delta/RAD)
          if (abs(cosDELTA) .lt. 1.0e-15) cosDELTA = 1.0e-15
          RcosDELTA = 1.0 / cosDELTA
          tanDELTA = tan(Delta/RAD)
          tmp = cosDELTA**2 - CsTwoTH**2
          if (tmp .gt. 0.0) then
            tmp1 = sqrt(tmp)
            F = abs(CsTwoTH) / tmp1
            dFdA = cosDELTA * CsTwoTH * sinDELTA * dDELTAdA 
     1         / (tmp1 * tmp1 * tmp1)
          else
            F = 0.0
            dFdA = 0.0
          endif
c  calculate G(Delta,2theta) , FCJ eq. 7a and 7b 
          if ( abs(Delta - Emin) .gt. abs(Einfl - Emin)) then
            if (S_L .gt. D_L) then
c
c N.B. this is the only place where d()/dA <> d()/dB
c
              G = 2.0 * D_L * F * RcosDELTA
              dGdA = 2.0 * D_L * RcosDELTA * (dFdA + 
     1                F*tanDELTA*dDELTAdA)
              dGdB = dGdA + 2.0 * F * RcosDELTA
            else
              G = 2.0 * S_L * F * RcosDELTA
              dGdB = 2.0 * S_L * RcosDELTA
     1	            *(dFdA + F * tanDELTA * dDELTAdA)
              dGdA = dGdB + 2.0 * F * RcosDELTA
            endif
          else
            G = (-1.0 + ApB * F) * RcosDELTA
            dGdA = RcosDELTA * (F - tanDELTA * dDELTAdA + ApB * dFdA
     1               + ApB * F * tanDELTA * dDELTAdA)
            dGdB = dGdA
          endif
          tmp = PsVoigt(TwoTh-DELTA+TwoTH0,TwoTH0,eta,Gamma,dPRdT
     1          ,dPRdG,dPRdE)
          sumWG = sumWG + wp(k+it) * G
          sumWRG = sumWRG + wp(k+it) * G * tmp
          sumWdGdA = sumWdGdA + wp(k+it) * dGdA
          sumWdGdB = sumWdGdB + wp(k+it) * dGdB
          sumWRdGdA = sumWRdGdA + wp(k+it) * dGdA * tmp
          sumWRdGdB = sumWRdGdB + wp(k+it) * dGdB * tmp 
          sumWGdRd2t = sumWGdRd2t + wp(k+it) * G * dPRdT
          sumWGdRdG = sumWGdRdG + wp(k+it) * G * dPRdG
          sumWGdRdE = sumWGdRdE + wp(k+it) * G * dPRdE
          sumWGdRdA = sumWGdRdA + wp(k+it) * G * dPRdT * dDELTAdA * RAD
        enddo
        if (sumWG .eq. 0.0) sumWG = 1.0
        Profval = sumWRG / sumWG
        dPRdT = sumWGdRd2t/ sumWG
        dPRdG = sumWGdRdG / sumWG
        dPRdE = sumWGdRdE / sumWG
        dPRdS = (sumWRdGdA + sumWGdRdA) / sumWG - sumWRG * 
     1          sumWdGdA/sumWG**2
        dPRdD = (sumWRdGdB + sumWGdRdA) / sumWG - sumWRG * 
     1          sumWdGdB/sumWG**2
      else   ! here for no asymmetry 
        tmp = PsVoigt(TwoTH,TwoTH0,eta,Gamma,dPRdT,dPRdG,dPRdE)
        Profval = tmp
        dPRdS = 0.0
        dPRdD = 0.0
      endif
      return
      end
      real*4 function PsVoigt(TwoTH , TwoTH0 , Eta , Gamma,
     1         dPRdT , dPRdG , dPRdE ) 
c
c   Returns value of Pseudo Voigt
c   Eta is the mixing coefficient between Gaussian and Lorentzian
c   Gamma is the FWHM
c   TwoTH is point at which to evaluate the profile
c   TwoTH0 is two theta value for peak
c   dPRdT is derivative of profile wrt TwoTH0
c   dPRdG is derivative of profile wrt Gamma
c   dPRdE is derivative of profile wrt Eta

      implicit none
      real*4 TwoTH , TwoTH0 , Eta , Gamma
      real*4 dPRdT , dPRdG , dPRdE
      real*4  G,Gauss			! Gaussian part 
      real*4  L,Lorentz		! Lorentzian part 
      real*4 dGdT , dGdG , dLdT , dLdG, temp

      G = Gauss(TwoTH , TwoTH0 , Gamma , dGdT , dGdG )
      L = Lorentz(TwoTH , TwoTH0 , Gamma , dLdT , dLdG )
	temp = Eta * L + (1.0 - Eta) * G
      PsVoigt = temp/Gamma
      dPRdT = (Eta * dLdT + (1.0 - Eta) * dGdT)/Gamma
      dPRdG = (Gamma * (Eta * dLdG + (1.0 - Eta) * dGdG) - temp)
	1	/Gamma**2
      dPRdE = (L - G)/Gamma
      return
      end
      real*4 function Gauss(Pos , Pos0 , Gamma , dGdT , dGdG )

c  Return value of Gaussian at 'Pos' for peak at 'Pos0' and 'Gamma'.
c  dGdT is derivative of G wrt Pos0.
c  dGdG is derivative of G wrt Gamma.

      implicit none
      real*4 Pos , Pos0 , Gamma , dGdT , dGdG
      real*4   c
      real*4  cg 
      real*4  delp , temp 
      data c  / 1.6651092/
      data cg / 0.939437279/

      delp = Pos - Pos0
      if (abs(delp)/Gamma .gt. 6) then
        Gauss = 0.0
        dGdT = 0.0
        dGdG = 0.0
      else
        temp = cg * exp(-(delp * c /Gamma)**2)
        Gauss = temp
        dGdG = 2.0 * temp * (delp * c)**2 / Gamma**3
        dGdT = 2.0 * c**2 * delp * temp/Gamma**2
      endif
      return
      end
      real*4 function Lorentz(Pos , Pos0 , Gamma , dLdT , dLdG )

c  Return value of Lorentzian at 'Pos' for peak at 'Pos0' and 'Gamma'.
c  dLdT is derivative of L wrt Pos0.
c  dLdG is derivative of L wrt Gamma.

      implicit none      
      real*4 Pos , Pos0 , Gamma , dLdT , dLdG
      real*4 cl
      real*4  delp , denom
      data cl/ 0.636619772/

      delp = Pos - Pos0
      denom = 4.0 * delp**2 + Gamma**2
      Lorentz = cl * Gamma**2 / denom
      dLdT = 8.0 * cl * Gamma**2 * delp / denom**2
      dLdG = 2.0 * cl * Gamma * (denom - Gamma**2) / denom**2
      return
      end

