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,):' 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,): ' read(*,'(a)')iresp if(iresp.eq.'y'.or.iresp.eq.'Y')irefsam = 1 write(*,'(a,$)')' Do you want to refine D/L (Y,): ' 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 (,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,)? ' 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,): ' 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,):' 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,):' 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 (/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/)? ' 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/)? ' 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,)?: ' 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,)? ' 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,)? ' 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