program diffkk c c generate f' and f'' near x-ray resonances for an atom, including c fine-structure due to solid-state effects (ie, xafs/dafs). c c algorithm summary: c 1 the brennan-cowan implementation of the cromer-libermann (cl) c calculation is used as a starting set of a causal f' and f''. c modifications were made to the bc code, mostly to make it easier c to use, more closely f77 conforming, and smaller. this data is c convolved with a lorenztian, typically with a width of a few ev. c c 2 an externally supplied file containing the xafs mu(e) is used to c improve f''. special support for xmu.dat files from feff is c provided, or the external file can contain *measured* mu(e) for c the system of interest. a simple matching procedure is done to c make the supplied mu(e) match the f'' from cl. c c 3 a differential kramers-kronig transform is used to convert the c changes in f'' (ie f''_supplied - f''_cl) into the changes in f' c (ie f' - f'_cl). the kk transform is done using a maclaurin c series method, as suggested in the literature. c c the result is a causal pair of f' and f'' that reflect the c presence of the atoms neighboring the central atom. c c -- Further notes on the algorithms used and instructions for -- c -- program use are given in the program documentation. -- c c copyright 1997 matt newville c c acknowledgements: julie cross, chuck bouldin, john rehr, and c bruce ravel contributed to the design of this code. c the best ideas were theirs. all mistakes are mine. c c include "dkcom.f" c#{dkcom.f: implicit none integer mpts,mdoc,mtitle,mvarys, npts,ndoc,ntitle integer iencol,imucol,iatz, npad, numvar parameter (mpts = 2**14, mdoc = 20, mtitle = 10, mvarys=20) double precision egrid, e0, elow, ehigh, ewidth double precision epad, xvarys(mvarys) double precision energy(mpts), f2ex(mpts), f2cl(mpts) character*100 doc(mdoc), title(mtitle), versn*6 character*100 inpfil, xmufil, outfil, label logical active, isfeff integer ne0, nelo, nehi, ne0ish, ne0dif, iprint common /dfkdat/ energy, f2ex, f2cl, xvarys, egrid, e0, elow, $ ehigh, ewidth, epad, npad, npts, ndoc, ntitle, iencol, $ imucol, ne0, nelo, nehi, ne0ish, ne0dif, iprint, $ iatz, numvar, active, isfeff common /dfkchr/ doc, title, label, inpfil, xmufil, outfil, $ versn save c#dkcom.f} integer i, ncol, mcol, ierr, istrln, ilen parameter (mcol = 6) double precision df1(mpts), df2(mpts), f1cl(mpts) double precision f1clr(mpts), f2clr(mpts) double precision outdat(mcol,mpts), gamma character*90 str external istrln versn = '1.10' ncol = mcol ndoc = mdoc npts = mpts c print version number write(str,'(3a)') ' -- diffkk version ', versn, '--' ilen = istrln(str) call messag(str(1:ilen)) c read diffk.inp call dkinp c read mu(e) data, convert to f''(e) on an even energy grid write(str,'(1a)') ' Reading xmu data:' ilen = istrln(str) call messag(str(1:ilen)) call readmu c generate initial tables of f' f'' on the same energy grid call messag(' ') call messag(' Looking up Cromer-Liberman f'' and f'''' ') call clcalc(iatz, npts, energy, f1clr, f2clr) c broaden f1cl and f2cl call messag(' Broadening Cromer-Liberman f'' and f'''' ') gamma = ewidth / egrid call convl2(npts, f1clr, f2clr, gamma, f1cl, f2cl) c align/shift/scale improved f'' to tabulated f'' (df2 = f2ex - f2cl) call messag(' Matching xmu data to Cromer-Liberman f'''' ') call dkfit call dkfcn(npts,numvar,xvarys,df2,ierr) c do kk transform of delta f'' -> delta f' call messag(' Doing difference Kramers-Kronig transform') call kkmclr(npts, energy, df2, df1) c add delta f' to initial f', delta f'' to initial f'' do 100 i = 1, npts outdat(1,i) = energy(i) outdat(2,i) = df1(i) + f1cl(i) outdat(3,i) = df2(i) + f2cl(i) outdat(4,i) = f1cl(i) outdat(5,i) = f2cl(i) 100 continue c play with docs (put user titles at top, c keep as many old doc lines as fit) ndoc = min(mdoc, ndoc+ntitle) do 200 i = ndoc, 1, -1 if (i.gt.ntitle) then doc(i) = doc(i-ntitle) else doc(i) = title(i) end if 200 continue c write results if (active) then call messag(' ') call messag(' Ready to write out data file:') call askstr('** output file name',outfil) end if ncol = 5 write(str,'(2a)') ' writing output data to ', $ outfil(1:istrln(outfil)) ilen = istrln(str) call messag(' ') call messag(str(1:ilen)) call outasc(outfil, label, doc, ndoc, outdat, $ mcol,mpts,ncol, npts) call messag(' writing summary to diffkk.log') call dklog call messag(' -- diffkk done -- ') end subroutine triml (string) c removes leading blanks. character*(*) string jlen = istrln(string) c c-- all blank and null strings are special cases. if (jlen .eq. 0) return c-- find first non-blank char do 10 i = 1, jlen if (string (i:i) .ne. ' ') goto 20 10 continue 20 continue c-- if i is greater than jlen, no non-blanks were found. if (i .gt. jlen) return c-- remove the leading blanks. string = string (i:) return c end subroutine triml end integer function nofx(x,array,npts) c c function nofx c c notes: x and array are real c c purpose c given a value x and an array of values, find the index c corresponding to the array element closest to x c usage c n = nofx(x,array,npts) c c parameters c x - a given value c array - array of values, assumed to be stored in order of c increasing value c npts - number of elements in array c c subroutines and function subprograms required c none c c written 8/11/81 by j.m. tranquada c implicit double precision(a-h,o-z) double precision array(npts), x imin = 1 imax = npts inc = ( imax - imin ) / 2 10 continue it = imin + inc xit = array(it) if ( x .lt. xit ) then imax = it else if ( x .gt. xit ) then imin = it else nofx = it return endif inc = ( imax - imin ) / 2 if ( inc .gt. 0 ) go to 10 xave = ( array(imin) + array(imin+1) ) / 2. if ( x .lt. xave ) then nofx = imin else nofx = imin + 1 endif return c end function nofx end function istrln (string) c c returns index of last non-blank character. c returns zero if string is null or all blank. character*(*) string c-- if null string or blank string, return length zero. istrln = 0 if (string(1:1).eq.char(0)) return if (string.eq.' ') return c c-- find rightmost non-blank character. ilen = len (string) do 20 i = ilen, 1, -1 if (string (i:i) .ne. ' ') goto 30 20 continue 30 istrln = i return c end function istrln end subroutine messag(messg) c write message to standard ouput with (1x,a) format character*(*) messg write(*,'(1x,a)') messg return c end subroutine messag end subroutine openfl(iunit, file, status, iexist, ierr) c c open a file, c if unit <= 0, the first unused unit number greater than 7 will c be assigned. c if status = 'old', the existence of the file is checked. c if the file does not exist iexist is set to -1 c if the file does exist, iexist = iunit. c if any errors are encountered, ierr is set to -1. c c note: iunit, iexist, and ierr may be overwritten by this routine character*(*) file, status, stat*10 integer iunit, iexist, ierr, iulow logical opend, exist data iulow, iumax /7, 50/ c c make sure there is a unit number ierr = -3 iexist = 0 if (iunit.le.0) then iunit = iulow 10 continue inquire(unit=iunit, opened = opend) if (opend) then if (iunit.gt.iumax) then iunit = min(iumax,iunit) return end if iunit = iunit + 1 go to 10 endif end if c c if status = 'old', check that the file name exists ierr = -2 stat = status call smcase(stat,'a') if (stat.eq.'old') then iexist = -1 inquire(file=file, exist = exist) if (.not.exist) return iexist = iunit end if c c open the file ierr = -1 open(unit=iunit, file=file, status=status, err=100) ierr = 0 100 continue return c end subroutine openfl end subroutine upper (str) c changes a-z to upper case. ascii specific c- for ascii: ichar(upper case 'a') = 65 c- ichar(lower case 'a') = 97 character*(*) str integer iupa, iloa, iloz, idif data iupa, iloa / 65, 97/ idif = iloa - iupa iloz = iloa + 25 jlen = max(1, istrln (str) ) do 10 i = 1, jlen ic = ichar (str(i:i)) if ((ic.ge.iloa).and.(ic.le.iloz)) str(i:i) = char(ic-idif) 10 continue return c end subroutine upper end subroutine lower (str) c changes a-z to lower case. ascii specific c- for ascii: ichar(upper case 'a') = 65 c- ichar(lower case 'a') = 97 character*(*) str integer iupa, iloa, iupz, idif data iupa, iloa / 65, 97/ idif = iloa - iupa iupz = iupa + 25 jlen = max(1, istrln (str) ) do 10 i = 1, jlen ic = ichar (str(i:i)) if ((ic.ge.iupa).and.(ic.le.iupz)) str(i:i) = char(ic+idif) 10 continue return c end subroutine lower end subroutine smcase (str, contrl) c convert case of string *str*to be the same case c as the first letter of string *contrl* c if contrl(1:1) is not a letter, *str* will be made lower case. character*(*) str, contrl, s1*1, t1*1 s1 = contrl(1:1) t1 = s1 call lower(t1) if (t1.eq.s1) call lower(str) if (t1.ne.s1) call upper(str) return c end subroutine smcase end subroutine bwords (s, nwords, words) c c breaks string into words. words are seperated by one or more c blanks, or a comma or equal sign and zero or more blanks. c c args i/o description c ---- --- ----------- c s i char*(*) string to be broken up c nwords i/o input: maximum number of words to get c output: number of words found c words(nwords) o char*(*) words(nwords) c contains words found. words(j), where j is c greater then nwords found, are undefined on c output. c c written by: steven zabinsky, september 1984 c c************************** deo soli gloria ************************** c-- no floating point numbers in this routine. implicit integer (a-z) character*(*) s, words(nwords) character blank, comma, equal parameter (blank = ' ', comma = ',', equal = '=') c-- betw .true. if between words c comfnd .true. if between words and a comma or equal has c already been found logical betw, comfnd c-- maximum number of words allowed wordsx = nwords c-- slen is last non-blank character in string slen = istrln (s) c-- all blank string is special case if (slen .eq. 0) then nwords = 0 return endif c-- begc is beginning character of a word begc = 1 nwords = 0 betw = .true. comfnd = .true. do 10 i = 1, slen if (s(i:i) .eq. blank) then if (.not. betw) then nwords = nwords + 1 words (nwords) = s (begc : i-1) betw = .true. comfnd = .false. endif elseif ((s(i:i).eq.comma).or.(s(i:i).eq.equal)) then if (.not. betw) then nwords = nwords + 1 words (nwords) = s(begc : i-1) betw = .true. elseif (comfnd) then nwords = nwords + 1 words (nwords) = blank endif comfnd = .true. else if (betw) then betw = .false. begc = i endif endif if (nwords .ge. wordsx) return 10 continue c if (.not. betw .and. nwords .lt. wordsx) then nwords = nwords + 1 words (nwords) = s (begc :slen) endif return c end subroutine bwords end subroutine untab (string) c replace tabs with blanks : tab is ascii dependent integer itab , i, ilen parameter (itab = 9) character*(*) string, tab*1 tab = char(itab) ilen = max(1, istrln(string)) 10 continue i = index(string(:ilen), tab ) if (i .ne. 0) then string(i:i) = ' ' go to 10 end if return c end subroutine untab end subroutine getfln(strin, s1, s2) c strip off the matched delimeters from string, as if getting c a filename from "filename", etc. integer idel, iend, istrln character*(*) strin, s1, s2, errmsg*80, ope*8, clo*8, cdel*1 data ope, clo / '"{(<''[', '"})>'']' / c errmsg = strin call triml(errmsg) ilen = istrln(errmsg) idel = index(ope,errmsg(1:1)) if (idel.ne.0) then cdel = clo(idel:idel) iend = index(errmsg(2:), cdel) if (iend.le.0) then call messag(' syntax error: cannot determine file '// $ 'name from line:') call messag(errmsg(1:ilen)) iend = ilen end if s1 = errmsg(2:iend) s2 = errmsg(iend+2:) else iend = index(errmsg,' ') - 1 if (iend.le.0) iend = istrln(errmsg) s1 = errmsg(1:iend) s2 = errmsg(iend+1:) end if return c end subroutine getfln end subroutine getcom(prompt, iuin, commnd, files, iunit, $ mfiles, nfiles) c c get next command line from unit iuin, or from a command file. c some rudimentary error checking is done here. c c prompt string to display when expecting input (in) c iuin default unit to read from (in) c files array of command files to use (in/out) c mfiles max number of command files to use (in/out) c commnd next command line to execute (out) c integer mwords, ii, ipro, mfiles, nfiles parameter (mwords = 3) character*(*) prompt, commnd, files(mfiles) character*80 line, words(mwords), errmsg, prom, stat*7 integer iunit(mfiles), istrln, nwords external istrln data stat /'old'/ c--------------------------------------------------------------------- call triml(prompt) prom = prompt ipro = istrln(prom) if (ipro.le.1) then prom = ' ' ipro = 1 end if iu0 = iuin if (iu0.le.0) iu0 = 5 30 format(1x,a, '>',$) 40 format(a) 100 continue c read command from prompt (standard input) c or from current input command lines from an external file line = ' ' commnd = ' ' if ((nfiles.lt.0).or.(nfiles.gt.mfiles)) nfiles = 0 if (nfiles.eq.0) then if ((iu0.eq.5).and.(ipro.gt.1)) then write(*, 30) prom(1:ipro) end if read ( iu0 ,40, err = 600, end = 600) line else read(iunit(nfiles),40, err =1000, end = 500) line end if c c check if command line is 'load filename'. c if so, open that file, and put it in the files stack call triml(line) call untab(line) nwords = mwords words(1) = ' ' words(2) = ' ' call bwords(line, nwords, words) if ((line.eq.' ').or.(nwords.le.0)) go to 100 call smcase(words(1),'a') if ( (words(1)(1:5).eq.'load ').or. $ (words(1)(1:8).eq.'include ').or. $ (words(1)(1:6).eq.'input ')) then if (words(2).eq.' ') then call messag( ' ##> no file name given. syntax is'// $ ' include filename ') go to 100 end if nfiles = nfiles + 1 if (nfiles.gt.mfiles) go to 2000 call getfln(words(2),files(nfiles), errmsg) do 400 i = 1, nfiles - 1 if (files(nfiles).eq.files(i)) go to 3000 400 continue iunit(nfiles) = 0 call openfl(iunit(nfiles), files(nfiles), stat, iexist, ierr) if (iexist.lt.0) go to 2600 if (ierr.lt.0) go to 2800 go to 100 elseif ((words(1)(1:1).eq.'*').or.(words(1)(1:1).eq.'#')) then commnd = ' ' go to 100 else commnd = line end if return c c end-of-file for command line file: drop nfiles by 1, c return to get another command line 500 continue close(iunit(nfiles)) nfiles = nfiles - 1 if (nfiles.lt.0) nfiles = 0 if (ipro.gt.1) go to 100 commnd = 'getcom_eof' return c 600 continue commnd = 'getcom_end' return c c warning and error messages 1000 continue call messag(' ##> error reading from "include"d file: ' ) errmsg = files(nfiles) ii = max(1, istrln(errmsg)) call messag(' ##> '//errmsg(1:ii) ) go to 5000 2000 continue call messag(' ##> error: too many nested "include"d files: ' ) write(errmsg, '(1x,a,i3)') ' ##>current limit is ', mfiles ii = max(1, istrln(errmsg)) call messag(' ##> '//errmsg(1:ii) ) go to 5000 2600 continue call messag(' ##> error: can not find "include"d file: ' ) errmsg = files(nfiles) ii = max(1, istrln(errmsg)) call messag(' ##> '//errmsg(1:ii) ) go to 5000 2800 continue call messag(' ##> error: can not open "include"d file: ' ) errmsg = files(nfiles) ii = max(1, istrln(errmsg)) call messag(' ##> '//errmsg(1:ii) ) go to 5000 3000 continue call messag(' ##> error: recursive "include" of file:') errmsg = files(nfiles) ii = max(1, istrln(errmsg)) call messag(' ##> '//errmsg(1:ii) ) go to 5000 c 5000 continue commnd = 'getcom_error' return c c end subroutine getcom end subroutine fixstr(string,str,ilen,words,wrdsor,mwords,nwords) c simple preparation of string for reading of keywords integer ilen, mwords, nwords, i, lenp1 integer iexcla, iperct, ihash, ieolc, istrln character*(*) string, str, words(mwords), wrdsor(mwords) c c fix-up string: untab, left-justify, make a lower-case version nwords = 0 call untab(string) str = string call triml(str) call smcase( str, 'case') c remove comments from str: c '!', '#', and '%' are end of line comments c '*' is a complete comment line if in col 1 lenp1 = len(str) + 1 iexcla = index(str,'!') if (iexcla.eq.0) iexcla = lenp1 iperct = index(str,'%') if (iperct.eq.0) iperct = lenp1 ihash = index(str,'#') if (ihash.eq.0) ihash = lenp1 ieolc = min(iperct,iexcla,ihash) - 1 if ((ieolc.lt.1).or.(str(1:1).eq.'*')) ieolc = 1 str = str(1:ieolc) ilen = max(1, istrln(str)) if (ilen.le.2) return c break string into words (up to mwords) c words is in lower case, wrdsor is in original case do 120 i = 1, mwords words(i) = ' ' wrdsor(i) = ' ' 120 continue nwords = mwords call bwords(str , nwords, words) call bwords(string, nwords, wrdsor) c end subroutine fixstr return end subroutine findee(nxmu, energy, xmu, ee) c c find ee of x-ray absorption data c (maximum deriv, with check that it is at least c the third positive deriv in a row) c inputs: c nxmu length of array energy, xmu, and xmuout c energy array of energy points c xmu array of raw absorption points c outputs: c ee energy origin of data implicit none integer nxmu, ninc, ntry, i, j parameter (ninc = 3) logical inc(ninc), incall double precision energy(nxmu), xmu(nxmu), ee, dxde, demx, deltae double precision zero, tiny, onepls parameter (zero = 0, tiny = 1.d-8, onepls = 1.001d0) c ee = zero if (nxmu.le.8) return do 100 i = 1, ninc inc(i) = .false. 100 continue dxde = zero demx = zero ntry = max(2, int(nxmu/2)) + 3 do 150 i = 2, ntry deltae = energy(i) - energy(i-1) if (deltae.gt.tiny) then dxde = (xmu(i) - xmu(i-1))/deltae inc(1) = dxde.gt.zero incall = inc(3).and.inc(2).and.inc(1) if (incall. and. (dxde.gt.demx) ) then ee = energy(i) demx = dxde * onepls end if do 130 j = ninc, 2, -1 inc(j) = inc(j - 1) 130 continue end if 150 continue return end subroutine str2dp(str,dpval,ierr) c return dp number "dpval" from character string "str" c if str cannot be a number, returns dpval = 0 and ierr.ne.0 character*(*) str, fmt*15 double precision dpval integer ierr , lenmax parameter ( lenmax = 40) logical isnum external isnum dpval = 0 ierr = -99 if (isnum(str)) then ierr = 0 write(fmt, 10) min(lenmax, len(str)) 10 format('(bn,f',i3,'.0)') read(str, fmt, err = 20, iostat=ierr) dpval end if return 20 continue ierr = -98 return c end subroutine str2dp end logical function isdat(string) c tests if string contains numerical data c returns true if the first (up to eight) words in string can c all be numbers. requires at least two words, and tests only c the first eight columns integer nwords, mwords, i parameter (mwords = 8) character*(30) string*(*), words(mwords), line*(256) logical isnum external isnum c isdat = .false. do 10 i = 1, mwords words(i) = 'no' 10 continue c nwords = mwords line = string call triml(line) call untab(line) call bwords(line, nwords, words) if (nwords.ge.2) then isdat = .true. do 50 i = 1, nwords if (.not. ( isnum( words(i) ) ) ) isdat = .false. 50 continue end if c return end logical function isnum (string) c tests whether a string can be a number. not foolproof! c to return true, string must contain: c - only characters in 'deDE.+-, 1234567890' (case is checked) c - no more than one 'd' or 'e' c - no more than one '.' character*(*) string, number*20 c note: layout and case of *number* is important: do not change! parameter (number = 'deDE.,+- 1234567890') integer iexp, idec, i, j, istrln external istrln iexp = 0 idec = 0 isnum = .false. do 100 i = 1, max(1, istrln(string)) j = index(number,string(i:i)) if (j.le.0) go to 200 if((j.ge.1).and.(j.le.4)) iexp = iexp + 1 if (j.eq.5) idec = idec + 1 100 continue c every character in "string" is also in "number". so, if there are c not more than one exponential and decimal markers, it's a number if ((iexp.le.1).and.(idec.le.1)) isnum = .true. 200 continue return c end logical function isnum end subroutine lintrp(x, y, npts, xin, ip, yout) c c linear interpolation for use in repeated loops where xin c is increasing or decreasing steadily through the values in x. c inputs: c x array of ordinate values c y array of abscissa values c npts length of arrays x and y c xin value of x at which to interpolate c ip guess of index in x array to use c outputs: c ip index in x array used in interpolation c y interpolated abscissa at xin c implicit none integer npts, ip double precision x(npts), y(npts), tiny, xin, yout parameter (tiny = 1.d-10) c find best starting value, and make sure ip is in range call hunt(x, npts, xin, ip) ip = min(npts-1, max(ip,1)) if ( ( x(ip+1) - x(ip) ) .le. tiny ) then yout = y(ip) else yout = y(ip) + (y(ip+1) - y(ip)) * ( xin - x(ip)) $ / (x(ip+1) - x(ip)) end if return c end subroutine lintrp end subroutine hunt(array, npts, x, jlo) c c given an array array(n), and a value x, this returns a value c jlo such that array(jlo) <= x <= array(jlo+1). array must be c monotonically increasing. c jlo = 0 or jlo = n indicates that x is out of range. c on input, jlo gives an initial guess for the output jlo c c similar to a routine from "numerical recipes" by press, c flannery, teukolsky, and vetterling c see pp89 - 92 of 1989 fortran version implicit none integer npts, jlo, jhi, jmid, jstep double precision array(npts) , x c jlo not useful - go straight to bisection if (jlo.le.0.or.jlo.gt.npts) then jlo=0 jhi=npts+1 go to 30 endif jstep = 1 c hunt up : if (x.ge.array(jlo)) then 10 continue jhi=jlo+jstep if(jhi.gt.npts)then jhi=npts+1 else if (x.ge.array(jhi)) then jlo=jhi jstep=jstep+jstep go to 10 endif else c hunt down : jhi=jlo 20 continue jlo=jhi-jstep if(jlo.lt.1)then jlo=0 else if (x.lt.array(jlo)) then jhi=jlo jstep=jstep+jstep go to 20 endif endif c done hunting, value bracketed: begin bisection 30 continue if (jhi-jlo.ne.1) then jmid=(jhi+jlo)/2 if (x.gt.array(jmid)) then jlo=jmid else jhi=jmid endif go to 30 end if c return return c end subroutine hunt end subroutine askstr(ask, str) c c prompt for and return a characer string. c see also the routines askint, and askval. c inputs: c ask character string for prompt c str default string to show in prompt c outputs: c str string read in c copyright 1993 university of washington matt newville character*(*) ask , str character*80 query , answer integer i , j, k, istrln external istrln query = ask call triml(query) call triml(str) i = max(1, istrln(query) ) j = max(1, istrln(str) ) k = max(1, min(80, len(str))) 30 format (2x,a,' [', a, '] >',$) write(*, 30 ) query(1:i), str(1:j) read (*, '(a)', err= 50) answer call triml(answer) if (istrln(answer).ge.1) str = answer(1:k) 50 continue return c end subroutine askstr end subroutine askdp(ask, val) c prompt for and return a double precision number c inputs: c ask character string for prompt c val default dp number to show in prompt c outputs: c val dp number read in c copyright 1993 university of washington matt newville character*(*) ask, answer*30 , query*80 integer i, istrln double precision val, tmp external istrln query = ask i = max(1, istrln(query) ) 30 format( 2x,a,' [', g16.8, '] >',$) write(*, 30) query(1:i), val read (*, '(a)', err = 50) answer if ( answer.ne.' ') then call str2dp(answer, tmp, ierr) if (ierr.eq. 0 ) val = tmp end if 50 continue return c end subroutine askdp end subroutine askint(ask, int) c prompt for and return an integer. c inputs: c ask character string for prompt c int default integer to show in prompt c outputs: c int integer read in c copyright 1993 university of washington matt newville character*(*) ask, answer*30, query*80 integer i, istrln, int, itmp external istrln query = ask call triml(query) i = max(1, istrln(query) ) 30 format( 2x,a,' [', i4, '] >',$) write(*, 30) query(1:i), int read (*, '(a)', err = 50) answer call triml(answer) if (istrln(answer).ge.1) then call str2in(answer, itmp, ierr) if (ierr.eq. 0 ) int = itmp end if 50 continue return c end subroutine askint end subroutine str2in(str,intgr,ierr) c return intger "intgr" from character string "str" c if str cannot be a number, returns val = 0 and ierr.ne.0 character*(*) str double precision dpval integer ierr, intgr call str2dp(str,dpval,ierr) intgr = dpval return c end subroutine str2in end subroutine strclp(str,str1,str2,strout) c c a rather complex way of clipping a string: c strout = the part of str that begins with str2. c str1 and str2 are subsrtings of str, (str1 coming before str2), c and even if they are similar, strout begins with str2 c for example: c 1. str = "title title my title" with str1 = str2 = "title" c gives strout = "title my title" c 2. str = "id 1 1st path label" with str1 = "1", str2 = "1st" c gives strout = "1st path label" c character*(*) str, str1, str2, strout integer i1, i2, ibeg, iend, istrln, ilen external istrln ilen = len(strout) i1 = max(1, istrln(str1)) i2 = max(1, istrln(str2)) i1e = index(str,str1(1:i1)) + i1 ibeg = index(str(i1e:),str2(1:i2) ) + i1e - 1 iend = min(ilen+ibeg, istrln(str) ) strout = str(ibeg:iend) return c end subroutine strclp end character*2 function atsym (iz) character*2 sym(103) common /atsyms/ sym save atsym = 'xx' if ((iz.le.103).and.(iz.gt.0)) atsym = sym(iz) call upper(atsym(1:1)) return end c integer function iatsym (symin) character*2 sym(103), symin common /atsyms/ sym save call smcase(symin,sym(1)) do 10 iatsym = 1, 103 if (symin.eq.sym(iatsym)) return 10 continue iatsym = 0 return end c block data prtabl character*2 sym(103) common /atsyms/ sym data sym / 'h' ,'he','li','be','b' ,'c' ,'n' ,'o' ,'f' ,'ne', $ 'na','mg','al','si','p' ,'s' ,'cl','ar','k' ,'ca','sc','ti', $ 'v' ,'cr','mn','fe','co','ni','cu','zn','ga','ge','as','se', $ 'br','kr','rb','sr','y' ,'zr','nb','mo','tc','ru','rh','pd', $ 'ag','cd','in','sn','sb','te','i' ,'xe','cs','ba','la','ce', $ 'pr','nd','pm','sm','eu','gd','tb','dy','ho','er','tm','yb', $ 'lu','hf','ta','w' ,'te','os','ir','pt','au','hg','tl','pb', $ 'bi','po','at','rn','fr','ra','ac','th','pa','u' ,'np','pu', $ 'am','cm','bk','cf','es','fm','md','no','lw'/ end subroutine str2lg(str,flag,ierr) c return logical "flag" from character string "str". c flag is .true. unless the str(1:1) is 'f' or 'n' (not case-sensitive) character*(*) str, test*4 parameter (test = 'fnFN') logical flag integer ierr ierr = 0 flag = .true. if (index(test,str(1:1)).ne.0) flag = .false. return c end subroutine str2lg end subroutine dkinp c read inputs for diffkk program from 'diffkk.inp' c c include "dkcom.f" c#{dkcom.f: implicit none integer mpts,mdoc,mtitle,mvarys, npts,ndoc,ntitle integer iencol,imucol,iatz, npad, numvar parameter (mpts = 2**14, mdoc = 20, mtitle = 10, mvarys=20) double precision egrid, e0, elow, ehigh, ewidth double precision epad, xvarys(mvarys) double precision energy(mpts), f2ex(mpts), f2cl(mpts) character*100 doc(mdoc), title(mtitle), versn*6 character*100 inpfil, xmufil, outfil, label logical active, isfeff integer ne0, nelo, nehi, ne0ish, ne0dif, iprint common /dfkdat/ energy, f2ex, f2cl, xvarys, egrid, e0, elow, $ ehigh, ewidth, epad, npad, npts, ndoc, ntitle, iencol, $ imucol, ne0, nelo, nehi, ne0ish, ne0dif, iprint, $ iatz, numvar, active, isfeff common /dfkchr/ doc, title, label, inpfil, xmufil, outfil, $ versn save c#dkcom.f} integer i, mfil, maxwrd,nwords, iwrds parameter(maxwrd = 30, mfil = 10) character*70 words(maxwrd), wrdsor(maxwrd), keywrd character*70 prompt*20,key*3,stat*10, string,str,comfil(mfil) integer istrln,icom(mfil), nfil, iinp, ier, iex, ilen, nline external istrln c initialization c initialize stuff in common active = .false. isfeff = .true. inpfil = 'diffkk.inp' xmufil = 'xmu.dat' outfil = 'dk.out' iatz = 0 iprint = 0 imucol = 2 iencol = 1 egrid = 1 elow = 200 ehigh = 500 ewidth = 1.5 c note: pre1/pre2 will be set in f2fit according c to whether data is from feff or not epad = 5 npad = 20 iatz = 0 ntitle = 0 label =' e fp fpp f1_cl f2_cl' do 10 i = 1, mtitle title(i) = ' ' 10 continue c initialize local stuff prompt = 'f' stat = 'old' nline = 0 nfil = 0 ier = 0 iex = 0 iinp = 1 do 20 i = 1, mfil icom(i) = 0 20 continue c input file: if file is found, open it for reading, cc#mac ccc use LS Fortran's '*' syntax and dialog boxes (thanks boyan!) c open(unit=iinp,file=*,status='old',iostat=ier) c if (ier.ne.0) then c call AlertBox('File selection was canceled!') c call finmsg(2001,string,' ',0) c end if c call f_setvolume(jvrefnum(iinp)) c call f_creator('ttxt') ccc this resets fname to the name of the opened file. ccc useful for computing output file names, etc. c inquire(unit=iinp,name= inpfil,iostat=ier) c if (ier.ne.0) inpfil='diffkk.inp' cc#mac call openfl(iinp, inpfil, stat, iex, ier) if (iex.lt.0) then ilen = istrln( inpfil) call messag( ' '// inpfil(:ilen)// ' not found'// $ ' -- running interactively') active = .true. return endif if ((iex.lt.0).or.(ier.ne.0)) go to 1990 c c read in next line 100 continue keywrd = ' ' key = ' ' call getcom(prompt, iinp, string, comfil, icom, mfil, nfil) nline = nline + 1 c call fixstr(string,str,ilen,words,wrdsor,maxwrd,nwords) if ((ilen.le.2).or.(str.eq.'getcom_eof')) go to 100 if ((words(1).eq.'end').or.(str.eq.'getcom_end')) go to 1000 if (str.eq.'getcom_error') go to 1990 c parse current set of keywords from line 150 continue keywrd = words(1) key = keywrd(1:3) iwrds = 2 c inpfil,outfil,imucol,egrid,iatz if (keywrd.eq.'title') then ntitle = ntitle + 1 call strclp(string,wrdsor(1),wrdsor(2),title(ntitle)) iwrds = maxwrd + 1 else if (key.eq.'out') then outfil = wrdsor(2) else if (key.eq.'xmu') then xmufil = wrdsor(2) else if (keywrd.eq.'isfeff') then call str2lg(words(2),isfeff,ier) else if (keywrd.eq.'iz') then call str2in(words(2),iatz,ier) else if (keywrd.eq.'mucol') then call str2in(words(2),imucol,ier) else if (keywrd.eq.'encol') then call str2in(words(2),iencol,ier) else if (keywrd.eq.'egrid') then call str2dp(words(2),egrid,ier) else if (keywrd.eq.'e0') then call str2dp(words(2),e0,ier) else if (keywrd.eq.'ewidth') then call str2dp(words(2),ewidth,ier) else if (keywrd.eq.'elow') then call str2dp(words(2),elow,ier) else if (keywrd.eq.'ehigh') then call str2dp(words(2),ehigh,ier) else if (keywrd.eq.'epad') then call str2dp(words(2),epad,ier) else if (keywrd.eq.'npad') then call str2in(words(2),npad,ier) else if (key.eq.'iz') then call str2at(words(2),iatz) else if (key.eq.'iprint') then call str2at(words(2),iprint) end if if (nwords.gt.iwrds) then do 450 i = 1, nwords words(i) = words(i+iwrds) wrdsor(i) = wrdsor(i+iwrds) 450 continue nwords = nwords - iwrds go to 150 end if go to 100 1000 continue return 1990 continue call messag(' weird, fatal error trying to open file.') stop end subroutine str2at(str,iz) c given a string str that contains either an atomic number or c an atomic symbol, return the atomic number to iz. c character*(*) str integer iz, ierr, iatsym logical isnum external isnum, iatsym if (isnum(str)) then call str2in(str,iz,ierr) if (ierr.ne.0) iz = 0 else iz = iatsym(str) end if return c end subroutine str2at end subroutine readmu c include "dkcom.f" c#{dkcom.f: implicit none integer mpts,mdoc,mtitle,mvarys, npts,ndoc,ntitle integer iencol,imucol,iatz, npad, numvar parameter (mpts = 2**14, mdoc = 20, mtitle = 10, mvarys=20) double precision egrid, e0, elow, ehigh, ewidth double precision epad, xvarys(mvarys) double precision energy(mpts), f2ex(mpts), f2cl(mpts) character*100 doc(mdoc), title(mtitle), versn*6 character*100 inpfil, xmufil, outfil, label logical active, isfeff integer ne0, nelo, nehi, ne0ish, ne0dif, iprint common /dfkdat/ energy, f2ex, f2cl, xvarys, egrid, e0, elow, $ ehigh, ewidth, epad, npad, npts, ndoc, ntitle, iencol, $ imucol, ne0, nelo, nehi, ne0ish, ne0dif, iprint, $ iatz, numvar, active, isfeff common /dfkchr/ doc, title, label, inpfil, xmufil, outfil, $ versn save c#dkcom.f} integer ntmp, i, ipos, nwords, ierr, iztmp, istrln character*10 words(10) double precision small, etmp(mpts), xmutmp(mpts) double precision e0tmp, e1, erange, e0inv, one parameter (small = 1.d-5,one=1.d0) logical isf external istrln c read file e0tmp = 0. if (active) call askstr('** name for input xmu data',xmufil) isf = isfeff cc print*, ' readmu calls in2col' call in2col(active, xmufil, mdoc, mpts, iencol, imucol, $ doc, ndoc, etmp, xmutmp, ntmp, isf) cc print*, ' readmu called in2col' if ((.not.active) .and. isf .and. (.not.isfeff)) then i = istrln(xmufil) call messag(' warning: read '//xmufil(1:i)// $ ' as a feff xmu.dat file') end if isfeff = isf c pre-pad feff arrays for mu with zero: c npad number of points to pre-pad with 0 c epad energy grid for pre-padding if (isfeff) then if (active) then call messag(' ') call messag(' Feff''s xmu.dat file may need '// $ '"padding" at low energies:') call askint('** number of points to pad with',npad) call askdp ('** Padding energy grid',epad) end if if ((npad+ntmp).gt.mpts) npad = mpts - ntmp if (epad.le.small) epad = etmp(2) - etmp(1) do 40 i = ntmp, 1, -1 xmutmp(i+npad) = xmutmp(i) etmp(i+npad) = etmp(i) 40 continue do 50 i = npad, 1, -1 etmp(i) = etmp(i+1) - epad xmutmp(i) = 0 50 continue ntmp = ntmp + npad end if c c now guess iatz, e0, elow and ehigh call izgues(etmp,xmutmp,ntmp,e0tmp,iztmp) if (iatz.le.0) then if (isfeff .and. (e0tmp.le.0)) then call findee(ntmp, etmp, xmutmp, e0tmp) call izgues(etmp,xmutmp,ntmp,e0tmp,iztmp) end if iatz = iztmp if (iatz.le.0) iatz = 29 if (active) call askint('** atomic number',iatz) end if if (e0.le.0) then if (active) call askdp('** E0 (in eV)',e0tmp) e0 = e0tmp end if if (active) then call messag(' ') call messag(' mu(E) needs to be put an even energy grid:') call askdp('** energy grid spacing (in eV)',egrid) call messag(' ') call messag(' For smoother results, mu(E) can be') call messag(' extrapolated past it''s input range:') call messag(' (elow = how far below the data'// $ ' range to extrapolate') call messag(' (ehigh= how far above the data'// $ ' range to extrapolate') call askdp('** elow (in eV)',elow) call askdp('** ehigh (in eV)',ehigh) call messag(' ') call messag(' Setting up broadening of '// $ 'Cromer-Liberman data') call askdp('** ewidth (in eV)',ewidth) end if erange = etmp(ntmp) + ehigh - (etmp(1) - elow) npts = min ( mpts, 1 + int(erange / egrid) ) c interpolate onto even grid c convert mu to f'', by multiplying by energy (it will be rescaled by c another constant multiplicitave factor in dkfcn, so as to match the c CL f'', so we don't need to worry about the scale here) e1 = etmp(1) - elow - egrid ipos = 1 e0inv = 1 / max(one, e0) do 100 i = 1, npts energy(i) = e1 + egrid * i call lintrp(etmp,xmutmp,ntmp,energy(i),ipos,f2ex(i)) f2ex(i) = f2ex(i) * energy(i) * e0inv 100 continue return end subroutine in2col(active,filnam,mdoc,mpts, $ ix1,ix2, doc,ndoc,x1,x2,npts,isfeff) c c open and reads two columns from a multi-column data file. c arguments: c filnam file name containing data (in) c mdoc max number of document lines to get (in) c mpts max number of data elements to get (in) c ix1 column to read array x1 from (in) c ix2 column to read array x2 from (in) c doc array of document lines (out) c ndoc number of doc lines returned (out) c x1 first array (out) c x2 second array (out) c npts number of data points (out) c implicit none integer ilen , istrln, j, i, maxwrd, ndoc, npts, iounit integer iexist, ierr, nwords, idoc, id, mdoc,mpts,ncol integer ix1, ix2, ixmax, ixmin parameter(maxwrd = 10) double precision x1(mpts),x2(mpts), zero parameter(zero = 0) logical isdat, ffhead, adddoc, comm, isfeff, active character*(*) filnam, doc(mdoc), commnt*4, ffstr*5,ffend*2 character*30 words(maxwrd), str*100, file*100 external istrln, isdat data commnt, iounit, adddoc /'#*%!', 0, .true./ data ffhead, ffstr, ffend /.false.,' feff','@#'/ ncol = 3 if (active) isfeff = .false. c ixmax = max(ix1,ix2) ixmin = min(ix1,ix2) if (.not.active.and. $ (ixmin.le.0).or.(ixmax.gt.maxwrd)) go to 880 10 format(a) file = filnam 20 continue ilen = istrln(file) if (ilen.le.0) go to 890 c open data file call openfl(iounit, file, 'old', iexist, ierr) if ((iexist.lt.0).or.(ierr.lt.0)) then if (.not.active) go to 900 call messag(' couldn''t find file '//file(:ilen)) call askstr(' type a new file name (or N to abort)', $ file) str = file call smcase(str,'n') if (str.eq.'n') go to 999 go to 20 end if c initialize buffers do 80 j = 1, mdoc doc(j) = ' ' 80 continue do 90 j = 1, mpts x1(j) = zero x2(j) = zero 90 continue do 100 i = 1, maxwrd words(i) = ' ' 100 continue idoc = 0 id = 0 c c get documents from header: up to ndoc 200 continue cc print*, ' line 200', comm, ffhead comm = .false. read(iounit, 10, end = 920, err = 930) str call triml (str) c remove leading comments (followed by optional blanks) from str if ( index(commnt, str(1:1)).ne.0 ) then comm = .true. str(1:1) = ' ' call triml(str) end if c if str is '----', stop adding lines to doc if (str(2:4) .eq. '---') adddoc = .false. c if the str is all numbers and we're not reading a c feff header or a commented out lins, then this is data! if ((.not.(comm.or.ffhead)).and.(isdat(str))) goto 410 c save str in doc if there's room ilen = istrln(str) if (adddoc .and. (idoc .lt. ndoc) .and. ilen.gt.0) then idoc = idoc + 1 doc(idoc) = str endif c test for whether reading feff headers (lines may not be commented out, c but will have ' feff ' in latter part of the first line, and the c magic '@#' characters just before numbers -- zany zabinsky!) if (idoc.eq.1) then call smcase(str,'a') ffhead = (index(str(55:),ffstr).ne.0) isfeff = ffhead ix2 = 2 if (ffhead) ix2 = 4 if (active) then str = 'n' if (ffhead) str = 'y' call askstr('** is this a feff xmu.dat file?',str) call smcase(str,'y') ffhead = (str.eq.'y') isfeff = ffhead call messag(' ') call messag(' What columns are energy and mu(E) in?:') if (ffhead) then ix2 = 4 call messag(' (Feff puts mu in column 4,'// $ ' mu0 in column 5)') end if 320 continue call askint('** column for energy ',ix1) call askint('** column for mu ',ix2) ixmax = max(ix1,ix2) ixmin = min(ix1,ix2) if ((ixmin.le.0).or.(ixmax.gt.maxwrd)) then call messag( ' something''s wrong with '// $ 'those values, try again ...') go to 320 end if end if end if c end first column check if feff xmu / getting of column numbers if (ffhead) ffhead = (str(ilen-1:).ne.ffend) cc print*, ' at goto 200', active goto 200 c c read numerical data cc print*, ' line 400' 400 continue read(iounit, 10, end = 500, err = 980) str 410 continue call triml (str) if (istrln(str).le.0) go to 400 if (id.ge.mpts) go to 500 id = id + 1 nwords = maxwrd call untab(str) call bwords(str,nwords,words) if (nwords.le.1) goto 940 if (nwords.lt.ixmax) goto 950 if (id.eq.1) ncol = nwords if (ncol.ne.nwords) goto 960 call str2dp(words(ix1), x1(id), ierr) if (ierr.ne.0) goto 990 call str2dp(words(ix2), x2(id), ierr) if (ierr.ne.0) goto 990 goto 400 500 continue npts = id if (idoc.le.0) then ndoc = 1 doc(1) = 'in2col: no document line found' else ndoc = idoc end if c close data file and return close(iounit) cc print*, 'in2col done' return c error handling 880 call messag( ' in2col: selected columns out of range') go to 999 890 call messag( ' in2col: no file name given') go to 999 900 call messag( ' in2col: could not find file') go to 990 920 call messag( ' in2col: error reading document lines') go to 990 930 call messag( ' in2col: unexpected end-of-file while '// $ 'reading titles') go to 990 940 call messag( ' in2col: too few columns of numbers !') go to 990 950 call messag( ' in2col: fewer columns found than requested') go to 990 960 call messag( ' in2col: number of columns changed !') go to 990 c error at reading numerical data 980 call messag( ' in2col: error reading numerical data.') 990 call messag( ' in2col: error with file '//file(1:ilen) ) close(iounit) 999 continue stop c end subroutine in2col end c double precision function e0atom(iz,shell) c integer iz, ishell c character*(*) shell, stmp*3 c double precision edge(92,4) c data edge /368*0/ c stmp = shell c call smcase(stmp,'a') c ishell = 0 c if (stmp.eq.'k') ishell = 1 c if (stmp.eq.'l1') ishell = 2 c if (stmp.eq.'l2') ishell = 3 c if (stmp.eq.'l3') ishell = 4 c e0atom = -1 c if (.not.((ishell.eq.0).or.(iz.gt.92).or.(iz.le.0))) c $ e0atom = edge(iz,ishell) c return c end c subroutine izgues(energy,absorb,npts,e0,iz) c given a spectra of mu(e), guess the atomic number c only k and l shells are considered, though it could be expanded. c data used is taken from mcmaster. implicit none integer npts, nedges, iz, nofx parameter (nedges= 315) double precision energy(npts), absorb(npts), e0,ex,edges(nedges) integer iedge(nedges), i external nofx data (edges(i),i = 1, 196) / 0.014,0.025,0.049,0.050,0.055,0.063, $ 0.072,0.073,0.087,0.099,0.100,0.112,0.118,0.135,0.136,0.153, $ 0.162,0.164,0.188,0.193,0.200,0.202,0.238,0.248,0.251,0.284, $ 0.287,0.295,0.297,0.341,0.346,0.350,0.399,0.400,0.402,0.404, $ 0.454,0.461,0.463,0.512,0.520,0.531,0.537,0.574,0.584,0.604, $ 0.639,0.650,0.682,0.686,0.707,0.720,0.754,0.778,0.793,0.842, $ 0.855,0.867,0.872,0.929,0.932,0.952,1.012,1.021,1.044,1.072, $ 1.100,1.115,1.142,1.196,1.218,1.249,1.302,1.305,1.325,1.360, $ 1.414,1.436,1.477,1.530,1.550,1.560,1.596,1.653,1.675,1.726, $ 1.782,1.805,1.839,1.863,1.920,1.940,2.007,2.065,2.080,2.149, $ 2.156,2.216,2.223,2.307,2.371,2.373,2.465,2.472,2.520,2.532, $ 2.625,2.677,2.698,2.793,2.822,2.838,2.866,2.967,3.003,3.043, $ 3.146,3.173,3.202,3.224,3.330,3.351,3.412,3.524,3.537,3.605, $ 3.607,3.727,3.730,3.806,3.929,3.938,4.018,4.038,4.132,4.156, $ 4.238,4.341,4.381,4.465,4.493,4.557,4.612,4.698,4.781,4.852, $ 4.939,4.965,5.012,5.100,5.188,5.247,5.359,5.452,5.465,5.483, $ 5.624,5.713,5.724,5.891,5.965,5.987,5.989,6.165,6.208,6.267, $ 6.441,6.460,6.540,6.549,6.717,6.722,6.835,6.977,7.013,7.112, $ 7.126,7.243,7.312,7.428,7.515,7.618,7.709,7.737,7.790,7.931, $ 8.052,8.071,8.252,8.333,8.358,8.376,8.581,8.648,8.708,8.919/ data (edges(i),i = 197,315) / 8.943,8.979,9.047,9.244,9.265, $ 9.395,9.561,9.618,9.659,9.752,9.881,9.978,10.116,10.204, $ 10.349,10.367,10.488,10.534,10.739,10.870,10.871,11.104, $ 11.136,11.215,11.272,11.542,11.564,11.680,11.868,11.918, $ 11.957,12.098,12.284,12.384,12.525,12.657,12.658,12.824, $ 12.964,13.035,13.273,13.418,13.424,13.474,13.733,13.892, $ 14.209,14.322,14.353,14.612,14.698,14.846,15.198,15.200, $ 15.344,15.708,15.860,16.105,16.300,16.385,17.080,17.167, $ 17.334,17.998,18.053,18.055,18.986,19.692,19.999,20.470, $ 20.947,21.045,21.756,22.117,22.263,23.095,23.220,24.350, $ 25.514,26.711,27.940,29.200,30.491,31.813,33.169,34.582, $ 35.985,37.441,38.925,40.444,41.991,43.569,45.184,46.835, $ 48.520,50.240,51.996,53.789,55.618,57.486,59.390,61.332, $ 63.314,65.351,67.414,69.524,71.676,73.872,76.112,78.395, $ 80.723,83.103,85.528,88.006,90.527,98.417,109.649,115.603, $ 121.760/ data (iedge(i), i=1,315) / 1,2,12,12,3,12,13,13,13,14,14,4,14, $ 15,15,15,16,16,5,16,17,17,17,18,18,6,18,19,19,19,20,20,21,20, $ 7,21,22,22,21,23,23,22,8,24,24,23,25,25,24,9,26,26,25,27,27, $ 26,28,10,28,27,29,29,28,30,30,11,29,31,31,30,32,32,31,12,33, $ 33,32,34,34,33,35,13,35,34,36,36,35,37,14,37,36,38,38,37,39, $ 15,39,38,40,40,41,39,41,16,42,40,42,43,41,43,17,44,42,44,45, $ 43,45,46,18,44,46,47,45,47,48,46,19,48,49,47,50,49,48,20,51, $ 50,49,52,51,50,21,53,52,51,54,53,52,22,55,54,53,56,55,54,23, $ 57,56,55,58,57,59,56,24,58,60,57,59,61,25,58,62,60,59,63,61, $ 26,60,64,62,61,65,63,27,62,66,64,63,67,65,28,68,64,66,69,65, $ 67,70,29,66,71,68,67,72,69,30,68,73,70,69,74,71,31,70,75,72, $ 71,76,32,73,77,72,74,78,73,33,79,75,74,80,76,75,81,34,77,76, $ 82,78,83,77,35,79,78,80,36,79,86,81,80,82,37,81,83,82,38,90, $ 83,39,92,86,40,94,86,41,90,42,90,92,43,92,44,94,94,45,46,47, $ 48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67, $ 68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,86,90,92,94/ c guess e0 from spectra call findee(npts,energy,absorb,e0) c find closest energy in table ex = e0/1000 iz = iedge(nofx(ex,edges,nedges)) return end subroutine clcalc(iz, npts, energy, fp, fpp) c cromer-libermann calculation of anomalous scattering factors c arguments: c iz atomic number of element [in] c npts number of elements in energy array [in] c energy array of energies at which to calculate f'/f'' [in] c fp real part of anomalous scattering (f') [out] c fpp imag part of anomalous scattering (f'') [out] c c notes: c 1 energy array is in eV c 2 this code is based on, and modified from the cowan-brennan c routines. data statements were simplified and rearranged, c code was cleaned up to be more in keeping with f77 standard c c matthew newville oct 1996 implicit none integer nparms(92,24), norb(92), iz, i, j, k, npts integer nparmz(24), norbz double precision binden(92,24), xnrg(92,24,11), xsc(92,24,11) double precision benaz(24), xnrgz(24,11), xscz(24,11) double precision relcor(92), kpcor(92), xnrdat(5), kev2ry double precision energy(*), fp(*), fpp(*), ener, f1, f2 parameter (kev2ry = 0.02721d0) c include "cldata.f" data (xnrdat(i),i=1,5)/80.d0,26.7d0,8.9d0,3.0d0,1.0d0/ c data (norb(i), i=1,92) /2*1, 2*2, 2*3, 6*4, 5, 6,8*7, 8, 14*9, $ 2*12,2*13,13*14,3*17,6*18,8*19,3*20,5*21,2*22,2*23,9*24/ c data binden( 1, 1), binden( 2, 1) / 14.d-3, 25.d-3/ data (binden( 3,i),i=1, 2) / 5.4750d-02, 5.3400d-03/ data (binden( 4,i),i=1, 2) / 0.1110d0,8.420d-03/ data (binden( 5,i),i=1, 3) / 0.1880d0,1.347d-02, 4.7d-03/ data (binden( 6,i),i=1, 3) / 0.2838d0,1.951d-02, 6.4d-03/ data (binden( 7,i),i=1, 4) / 0.4016d0,2.631d-02, 9.2d-03,9.2d-03/ data (binden( 8,i),i=1, 4) / 0.5320d0,2.370d-02, 7.1d-03,7.1d-03/ data (binden( 9,i),i=1, 4) / 0.6854d0, 3.1000d-02, 8.6000d-03, $ 8.6000d-03/ data (binden(10,i),i=1, 4) / 0.8669d0 , 4.5000d-02, 1.8300d-02, $ 1.8300d-02/ data (binden(11,i),i=1, 4) / 1.0721d0 , 6.3300d-02, 3.1100d-02, $ 3.1100d-02/ data (binden(12,i),i=1, 4) / 1.3050d0 , 8.9400d-02, 5.1400d-02, $ 5.1400d-02/ data (binden(13,i),i=1, 5) / 1.5596d0 , 0.11770d0 , 7.3100d-02, $ 7.3100d-02, 8.3757d-03/ data (binden(14,i),i=1, 6) / 1.8389d0 , 0.14870d0 , 9.9200d-02, $ 9.9200d-02, 1.1357d-02, 5.0831d-03/ data (binden(15,i),i=1, 7) / 2.1455d0, 0.18930d0, 0.13220d0, $ 0.13220d0, 1.44615d-02, 6.38493d-03, 6.33669d-03/ data (binden(16,i),i=1, 7) / 2.4720d0, 0.22920d0, 0.16480d0, $ 0.16480d0,1.76882d-02, 7.81363d-03, 7.73488d-03/ data (binden(17,i),i=1, 7) / 2.8224d0,0.2702d0,0.2016d0, $ 0.2000d0,1.75000d-02, 6.80000d-03, 6.80000d-03/ data (binden(18,i),i=1, 7) / 3.2029d0,0.3140d0,0.2473d0, $ 0.2452d0,2.53000d-02, 1.24000d-02, 1.24000d-02/ data (binden(19,i),i=1, 7) / 3.60740d0,0.37710d0,0.2963d0, $ 0.2936d0,3.39000d-02,1.78000d-02,1.78000d-02/ data (binden(20,i),i=1, 7) / 4.0381d0,0.43780d0,0.3500d0, $ 0.3464d0,4.37000d-02,2.54000d-02,2.54000d-02/ data (binden(21,i),i=1, 7) / 4.49280d0,0.50040d0,0.4067d0, $ 0.40220d0,5.38000d-02,3.23000d-02,3.23009d-02/ data (binden(22,i),i=1, 7) / 4.9664d0,0.5637d0,0.4615d0, $ 0.4555d0,6.03000d-02, 3.46000d-02, 3.46000d-02/ data (binden(23,i),i=1, 8)/ 5.4651d0,0.6282d0,0.5205d0, $ 0.5129d0,6.6500d-02,3.7800d-02,3.7800d-02,2.2000d-03/ data (binden(24,i),i=1, 9)/ 5.9892d0,0.6946d0,0.5837d0,0.5745d0, $ 7.410d-02, 4.250d-02, 4.250d-02, 2.300d-03, 2.300d-03/ data (binden(25,i),i=1, 9)/ 6.539d0,0.769d0,0.6514d0,0.64030d0, $ 8.3900d-02,4.8600d-02,4.8600d-02,7.2616d-03,7.1437d-03/ data (binden(26,i),i=1, 9)/ 7.112d0,0.8461d0,0.7211d0,0.7081d0, $ 9.290d-02,5.400d-02,5.400d-02,3.560d-03,3.560d-03/ data (binden(27,i),i=1, 9)/ 7.7089d0,0.9256d0,0.7936d0,0.7786d0, $ 0.10070d0,5.950d-02, 5.950d-02, 2.900d-03, 2.900d-03/ data (binden(28,i),i=1, 9)/ 8.3328d0,1.0081d0,0.8719d0,0.8547d0, $ 0.11180d0,6.81d-02,6.81d-02,3.60d-03,3.60d-03/ data (binden(29,i),i=1, 9)/ 8.9789d0,1.0961d0,0.951d0,0.9311d0, $ 0.1198d0,7.3600d-02,7.3600d-02,1.6000d-03,1.6000d-03/ data (binden(30,i),i=1, 9)/ 9.6589d0,1.1936d0,1.0428d0,1.0197d0, $ 0.1359d0,8.66d-02,8.66d-02,8.10d-03,8.10d-03/ data (binden(31,i),i=1, 9)/ 10.367d0,1.2977d0,1.1423d0,1.1154d0, $ 0.1581d0,0.1068d0,0.1029d0,1.74d-02,1.74d-02/ data (binden(32,i),i=1, 9)/ 11.1031d0,1.4143d0,1.2478d0, $ 1.2167d0,0.1800d0,0.1279d0,0.1208d0,2.870d-02,2.870d-02/ data (binden(33,i),i=1, 9)/ 11.8667,1.5265,1.3586,1.3231, $ 0.2035,0.1464,0.1405,4.12d-02,4.12d-02/ data (binden(34,i),i=1, 9)/ 12.6578,1.6539,1.4762, 1.4358, $ 0.2315,0.1682,0.1619,5.67d-02,5.67d-02/ data (binden(35,i),i=1, 9)/ 13.4737, 1.782, 1.596, 1.5499, $ 0.25650,0.1893,0.1815,7.01d-02,6.90d-02/ data (binden(36,i),i=1, 9)/ 14.3256,1.9210,1.7272,1.6749, $ 0.28833,0.2227,0.2138,8.890d-02,8.890d-02/ data (binden(37,i),i=1, 9)/ 15.200, 2.0651, 1.8639, 1.8044, $ 0.32210,0.24740,0.23850,0.11180,0.11030/ data (binden(38,i),i=1,12)/ 16.1046,2.2163,2.0068,1.9396, $ 0.3575, 0.2798,0.2691,0.135,0.1331, $ 3.77d-02, 1.99d-02,1.99d-02/ data (binden(39,i),i=1,12)/ 17.0384,2.3725,2.1555,2.080, $ 0.3936,0.3124,0.3003,0.1596,0.1574, $ 4.54d-02,2.56d-02,2.56d-02/ data (binden(40,i),i=1,13)/ 17.9976, 2.53160, 2.30671, 2.22230, $ 0.43030,0.34420,0.33050,0.18240,0.18000,5.130d-02, $ 2.870d-02,2.870d-02,4.0234d-03/ data (binden(41,i),i=1,13)/ 18.9856, 2.6977, 2.4647, 2.3705, $ 0.46840,0.37840,0.36300,0.2074,0.2046,5.810d-02, $ 3.390d-02,3.390d-02,3.20d-03/ data (binden(42,i),i=1,14)/ 19.9995, 2.8655, 2.6251, 2.5202, $ 0.50460,0.40970,0.39230,0.23030,0.2270,6.180d-02, $ 3.48d-02,3.48d-02,1.80d-03,1.80d-03/ data (binden(43,i),i=1,14)/ 21.0440, 3.0425, 2.7932, 2.6769, $ 0.54760,0.44490,0.42500,0.25640,0.25290,6.840d-02, $ 3.890d-02,3.890d-02,7.012d-03,6.729d-03/ data (binden(44,i),i=1,14)/ 22.1172, 3.2240, 2.9669, 2.8379, $ 0.5850,0.4828,0.4606,0.2836, 0.2794, $ 7.490d-02,4.301d-02,4.301d-02,2.000d-03,2.000d-03/ data (binden(45,i),i=1,14)/ 23.2199, 3.41190, 3.14610, 3.0038, $ 0.62710,0.52100,0.49620,0.31170,0.3070,8.10d-02,4.79d-02, $ 4.79d-02,2.50d-03,2.50d-03/ data (binden(46,i),i=1,14)/ 24.3503,3.6043,3.3303,3.1733,0.6699, $ 0.5591,0.5315,0.3400,0.3347,8.640d-02,5.110d-02, $ 5.110d-02,5.4466d-03,5.0184d-03/ data (binden(47,i),i=1,14)/ 25.514,3.8058,3.5237,3.3511,0.7175, $ 0.6024,0.5714,0.3728,0.3667,9.520d-02,6.260d-02, $ 5.590d-02,3.30d-03,3.30d-03/ data (binden(48,i),i=1,14)/ 26.7112,4.0180,3.7270,3.5375,0.7702, $ 0.6507,0.6165,0.4105,0.4037,0.1076,6.69d-02, $ 6.69d-02,9.30d-03,9.30d-03/ data (binden(49,i),i=1,14)/ 27.9399,4.2375,3.9380,3.7301,0.8256, $ 0.7022,0.6643,0.4508,0.4431,0.1219,7.74d-02,7.74d-02, $ 1.62d-02, 1.62d-02/ data (binden(50,i),i=1,14)/ 29.200,4.4647,4.1561,3.9288,0.8838, $ 0.7564,0.7144,0.4933,0.4848,0.1365,8.86d-02, $ 8.86d-02,2.39d-02,2.39d-02/ data (binden(51,i),i=1,14)/ 30.4912,4.6983,4.3804,4.1322, $ 0.9437,0.8119,0.7656,0.5369,0.5275,0.1520,9.840d-02, $ 9.840d-02,3.14d-02,3.14d-02/ data (binden(52,i),i=1,14)/ 31.8138,4.9392,4.6120,4.3414, $ 1.0060,0.8697,0.8187,0.5825,0.5721,0.1683,0.1102,0.1102, $ 3.980d-02, 3.980d-02/ data (binden(53,i),i=1,14)/ 33.1694,5.1881,4.8521,4.5571,1.0721, $ 0.9305,0.8746,0.6313,0.6194,0.1864,0.1227,0.1227, $ 4.96d-02,4.96d-02/ data (binden(54,i),i=1,14)/ 34.5614,5.4528,5.1037,4.7822,1.1446, $ 0.9990,0.9370,0.6854,0.6723,0.2081,0.1467,0.1467, $ 6.40d-02,6.40d-02/ data (binden(55,i),i=1,17)/ 35.9846,5.7143,5.3594,5.0119,1.2171, $ 1.0650,0.9976,0.7395,0.7255,0.2308,0.1723,0.1616,7.88d-02, $ 7.65d-02,2.27d-02,1.31d-02,1.14d-02/ data (binden(56,i),i=1,17)/ 37.4406,5.9888,5.6236,5.2470,1.2928, $ 1.1367,1.0621,0.7961,0.7807,0.2530,0.1918,0.1797, $ 9.250d-02,8.990d-02,3.901d-02,1.656d-02,1.460d-02/ data (binden(57,i),i=1,17)/ 38.9246,6.2663,5.8906,5.4827,1.3613, $ 1.2044,1.1234,0.8485,0.8317,0.2704,0.2058,0.1914,9.89d-02, $ 9.89d-02,3.23d-02,1.44d-02,1.44d-02/ data (binden(58,i),i=1,18)/ 40.443,6.5488,6.1642,5.7234,1.4346, $ 1.2728,1.1854,0.9013,0.8833,0.2896,0.2233,0.2072,0.101, $ 0.101,8.59d-02,3.78d-02, 1.98d-02, 1.98d-02/ data (binden(59,i),i=1,18)/ 41.991,6.8348,6.4404,5.9643,1.5110, $ 1.3374,1.2422,0.9511,0.9310,0.3045,0.2363,0.2176,0.1132, $ 0.1132,3.50d-03,3.74d-02,2.23d-02,2.23d-02/ data (binden(60,i),i=1,18)/ 43.5689,7.1260,6.7215,6.2079,1.5753, $ 1.4028,1.2974,0.9995,0.9777,0.3152,0.2433,0.2246,0.1175, $ 0.1175,3.00d-03,3.75d-02,2.11d-02,2.11d-02/ data (binden(61,i),i=1,18)/ 45.184,7.4279,7.0128,6.4593,1.6464, $ 1.4714,1.3569,1.0515,1.0269,0.3304,0.2544,0.2360,0.1204, $ 0.1204,4.00d-03,3.75d-02,2.11d-02,2.11d-02/ data (binden(62,i),i=1,18)/ 46.8342, 7.7368,7.3118,6.7162,1.7228, $ 1.5407,1.4198,1.1060,1.0802,0.3457,0.2656,0.2474,0.1290, $ 0.1290,5.50d-03,3.74d-02,2.13d-02,2.13d-02/ data (binden(63,i),i=1,18)/ 48.519,8.0520,7.6171,6.9769,1.8000, $ 1.6139,1.4806,1.1606,1.1309,0.3602,0.2839,0.2566,0.1332, $ 0.1332,2.9115d-03,3.18d-02,2.20d-02,2.20d-02/ data (binden(64,i),i=1,19)/ 50.2391,8.3765,7.9302,7.2428,1.8808, $ 1.6883,1.5440,1.2172,1.1852,0.3758,0.2885,0.2709,0.1405, $ 0.1405,9.2794d-03,8.5242d-03,3.61d-02,2.03d-02,2.03d-02/ data (binden(65,i),i=1,19)/ 51.9957,8.7080,8.2516,7.5140,1.9675, $ 1.7677,1.6113,1.2750,1.2412,0.3979,0.3102,0.2850,0.1470, $ 0.1470,9.40d-03,8.60d-03,3.90d-02,2.54d-02,2.54d-02/ data (binden(66,i),i=1,19)/ 53.7885,9.0458,8.5806,7.7901,2.0468, $ 1.8418,1.6756,1.3325,1.2949,0.4163,0.3318,0.2929,0.1542, $ 0.1542,4.20d-03,4.20d-03,6.29d-02,2.63d-02,2.63d-02/ data (binden(67,i),i=1,19)/ 55.6177,9.3942,8.9178,8.0711,2.1283, $ 1.9228,1.7412,1.3915,1.3514,0.4357,0.3435,0.3066,0.1610, $ 0.1610,3.70d-03,3.70d-03,5.12d-02,2.03d-02,2.03d-02/ data (binden(68,i),i=1,19)/ 57.4855,9.7513,9.2643,8.3579,2.2065, $ 2.0058,1.8118,1.4533,1.4093,0.4491,0.3662,0.3200,0.1767, $ 0.1676,4.30d-03,4.30d-03,5.98d-02,2.94d-02,2.94d-02/ data (binden(69,i),i=1,19)/ 59.3896,10.1157,9.6169,8.6480,2.3068, $ 2.0898,1.8845,1.5146,1.4677,0.4717,0.3859,0.3366,0.1796, $ 0.1796,5.30d-03,5.30d-03,5.32d-02,3.23d-02,3.23d-02/ data (binden(70,i),i=1,19)/ 61.3323,10.4864,9.9782,8.9436,2.3981, $ 2.1730,1.9498,1.5763,1.5278,0.4872,0.3967,0.3435, $ 0.1981,0.1849,6.30d-03,6.30d-03,5.41d-02,2.34d-02,2.34d-02/ data (binden(71,i),i=1,19)/ 63.3138,10.8704,10.3486,9.2441, $ 2.4912,2.2634,2.0236,1.6394,1.5885,0.5062,0.4101,0.3593, $ 0.2048,0.1950,6.90d-03,6.90d-03,5.68d-02,2.80d-02,2.80d-02/ data (binden(72,i),i=1,20)/ 65.3508,11.2707,10.7394,9.5607, $ 2.6009,2.3654,2.1076,1.7164,1.6617,0.5381,0.4370,0.3804, $ 0.2238,0.2137,1.71d-02,1.71d-02,6.49d-02,3.81d-02, $ 3.06d-02,5.00d-03/ data (binden(73,i),i=1, 20)/ 67.4164,11.6815,11.1361,9.8811, $ 2.7080,2.4687,2.1940,1.7932,1.7351,0.5655,0.4648,0.4045, $ 0.2413,0.2293,2.50d-02,2.50d-02,7.11d-02,4.49d-02, $ 3.64d-02,5.70d-03/ data (binden(74,i),i=1,20)/ 69.525,12.0998,11.5440,10.2068, $ 2.81960,2.57490,2.2810,1.8716,1.8092,0.5950,0.4916,0.4253, $ 0.2588,0.2454,3.65d-02,3.36d-02,7.71d-02,4.68d-02, $ 3.56d-02,6.10d-03/ data (binden(75,i),i=1,21)/ 71.6764,12.5267,11.9587,10.5353, $ 2.9317,2.6816,2.3673,1.9489,1.8829,0.6250,0.5179,0.4444, $ 0.2737,0.2602,4.06d-02,4.06d-02,8.28d-02,4.56d-02, $ 3.46d-02,6.063d-03,5.209d-03/ data (binden(76,i),i=1,21)/ 73.8708,12.9680,12.3850,10.8709, $ 3.0485,2.7922,2.4572,2.0308,1.9601,0.6543,0.5465,0.4682, $ 0.2894,0.2728,4.63d-02,4.63d-02,8.37d-02,5.80d-02, $ 4.54d-02,7.0526d-03,6.0279d-03/ data (binden(77,i),i=1,21)/ 76.1110,13.4185,12.8241,11.2152, $ 3.1737,2.9087,2.5507,2.1161,2.0404,0.6901,0.5771,0.4943, $ 0.3114,0.2949,6.34d-02,6.05d-02,9.52d-02,6.30d-02, $ 5.05d-02,8.0627d-03,6.8546d-03/ data (binden(78,i),i=1,21)/ 78.3948,13.8799,13.2726,11.5637, $ 3.2960,3.0265,2.6454,2.2019,2.1216,0.7220,0.6092,0.5190, $ 0.3308,0.3133,7.43d-02,7.11d-02,0.1017,6.53d-02, $ 5.17d-02,7.44d-03,6.125d-03/ data (binden(79,i),i=1,21)/ 80.7249,14.3528,13.7336,11.9187, $ 3.4249,3.1478,2.7430,2.2911,2.2057,0.7588,0.6437,0.5454, $ 0.3520,0.3339,8.64d-02,8.28d-02,0.1078,7.17d-02,5.37d-02, $ 8.308d-03,6.790d-03/ data (binden(80,i),i=1,22)/ 83.1023,14.8393,14.2087,12.2839, $ 3.5616,3.2785,2.8471,2.3849,2.2949,0.8003,0.6769,0.5710, $ 0.3783,0.3598,0.1022,9.85d-02,0.1203,8.05d-02,5.76d-02, $ 6.40d-03,6.40d-03,7.714d-03/ data (binden(81,i),i=1,22)/ 85.5304,15.3467,14.6979,12.6575, $ 3.7041,3.4157,2.9566,2.4851,2.3893,0.8455,0.7213,0.6090, $ 0.4066,0.3862,0.1228,0.1185,0.1363,9.96d-02,7.54d-02, $ 1.53d-02,1.31d-02,9.665d-03/ data (binden(82,i),i=1,23)/ 88.005,15.8608,15.2000,13.0352, $ 3.8507,3.5542,3.0664,2.5856,2.4840,0.8936,0.7639,0.6445, $ 0.4352,0.4129,0.1429,0.1381,0.1473,0.1048,8.60d-02, $ 2.18d-02,1.92d-02,1.17d-02,4.912d-03/ data (binden(83,i),i=1,23)/ 90.526,16.3875,15.7111,13.4186, $ 3.9991,3.6963,3.1769,2.6876,2.5796,0.9382,0.8053,0.6789, $ 0.4636,0.4340,0.1619,0.1574,0.1593,0.1168,9.28d-02, $ 2.65d-02,2.44d-02,1.423d-02,6.179d-03/ data (binden(84,i),i=1,24)/ 93.105,16.9393,16.2443,13.8138, $ 4.14940,3.8541,3.3019,2.7980,2.6830,0.9953,0.8510,0.7050, $ 0.5002,0.4735,0.1753,0.1694,0.1709,0.1257,9.83d-02, $ 3.14d-02,3.14d-02,1.678d-02,7.560d-03,5.395d-03/ data (binden(85,i),i=1,24)/ 95.7299,17.4930,16.7847,14.2135, $ 4.317,4.008,3.426,2.9087,2.7867,1.0420,0.8860,0.7400, $ 0.5332,0.4754,0.1971,0.1906,0.1856,0.1385,0.1084,4.16d-02, $ 3.766d-02,1.934d-02,9.031d-03,6.245d-03/ data (binden(86,i),i=1,24)/ 98.404,18.049,17.337,14.619,4.482, $ 4.1590,3.5380,3.0215,2.8924,1.0970,0.9290,0.7680,0.5666, $ 0.5370,0.2196,0.2126,0.2008,0.1518,0.1188,4.87d-02, $ 4.426d-02,2.194d-02,1.057d-02,7.126d-03/ data (binden(87,i),i=1,24)/ 101.137,18.6390,17.9065,15.0312, $ 4.6520,4.3270,3.6630,3.1362,2.9997,1.1530,0.9800,0.8100, $ 0.6033,0.5770,0.2465,0.2389,0.2200,0.1690,0.1329,5.954d-02, $ 5.455d-02,2.787d-02,1.516d-02,1.061d-02/ data (binden(88,i),i=1,24)/ 103.922,19.2367,18.4843,15.4444, $ 4.8220,4.4895,3.7918,3.2484,3.1049,1.2084,1.0576,0.8791, $ 0.6359,0.6027,0.2989,0.2989,0.2544,0.2004,0.1528, $ 6.72d-02,6.72d-02,4.35d-02,1.88d-02,1.88d-02/ data (binden(89,i),i=1,24)/ 106.755,19.8400,19.0832,15.8710, $ 5.0021,4.6560,3.9090,3.3703,3.2190,1.2690,1.0800,0.8900, $ 0.6750,0.6370,0.3039,0.2952,0.2614,0.2063,0.1632,8.32d-02, $ 7.70d-02,4.05d-02,2.52d-02,1.84d-02/ data (binden(90,i),i=1,24)/ 109.651,20.4721,19.6932,16.3003, $ 5.1823,4.8304,4.0461,3.4909,3.3320,1.3296,1.1682,0.9674, $ 0.7141,0.6764,0.3445,0.3352,0.2903,0.2295,0.1818,9.43d-02, $ 8.79d-02,5.95d-02,4.90d-02,4.30d-02/ data (binden(91,i),i=1,24)/ 112.601,21.1046,20.3137,16.7331, $ 5.3669,5.0009,4.1738,3.6112,3.4418,1.3871,1.2243,1.0067, $ 0.7434,0.7082,0.3712,0.3595,0.3096,0.2336,0.1831,9.66d-02, $ 8.92d-02,4.54d-02,2.85d-02,2.03d-02/ data (binden(92,i),i=1,24)/ 115.606,21.7574,20.9476,17.1663, $ 5.5480,5.1822,4.3034,3.7276,3.5517,1.4408,1.2726,1.0449, $ 0.7804,0.7377,0.3913,0.3809,0.3237,0.2593,0.1951,0.1050, $ 9.63d-02,7.07d-02,4.23d-02,3.23d-02/ c data (kpcor(i),i=3,92) / 1.d-3, 0.d-3, 1.d-3, 1.d-3, 2.d-3, $ 3.d-3, 4.d-3, 4.d-3, 6.d-3, 8.d-3, 8.d-3, 1.1d-2, $ 1.2d-2, 1.4d-2, 1.7d-2, 2.d-2, 2.2d-2, 2.5d-2, 2.8d-2, $ 3.1d-2, 3.5d-2, 3.9d-2, 4.2d-2, 4.8d-2, 5.2d-2, 5.7d-2, $ 6.1d-2, 6.7d-2, 7.3d-2, 7.9d-2, 8.5d-2, 9.2d-2, 9.9d-2, $ 1.06d-1, 1.14d-1, 1.22d-1, 1.3d-1, 1.38d-1, 1.47d-1, $ 1.56d-1, 1.66d-1, 1.75d-1, 1.86d-1, 1.96d-1, 2.07d-1, $ 2.19d-1, 2.3d-1, 2.42d-1, 2.55d-1, 2.67d-1, 2.81d-1, $ 2.94d-1, 3.08d-1, 3.23d-1, 3.38d-1, 3.54d-1, 3.69d-1, $ 3.86d-1, 4.02d-1, 4.19d-1, 4.37d-1, 4.55d-1, 4.74d-1, $ 4.93d-1, 5.12d-1, 5.32d-1, 5.53d-1, 5.74d-1, 5.96d-1, $ 6.17d-1, 6.40d-1, 6.63d-1, 6.87d-1, 7.11d-1, 7.36d-1, $ 7.62d-1, 7.88d-1, 8.14d-1, 8.42d-1, 8.70d-1, 8.99d-1, $ 9.28d-1, 9.57d-1, 9.88d-1, 1.018d0,1.050d0,1.083d0, $ 1.115d0,1.149d0,1.184d0/ c data (relcor(i),i=3,92) / 1.d-3, 1.d-3, 2.d-3, 3.d-3, 5.d-3, $ 7.d-3, 9.d-3, 1.1d-2, 1.4d-2, 1.8d-2, 2.1d-2, 2.6d-2, $ 3.0d-2, 3.5d-2, 4.1d-2, 4.7d-2, 5.3d-2, 6.0d-2, 6.8d-2, $ 7.5d-2, 8.4d-2, 9.3d-2, 0.102, 0.113, 0.123, 0.135, 0.146, $ 0.159, 0.172, 0.186, 0.200, 0.215, 0.231, 0.247, 0.264, $ 0.282, 0.300, 0.319, 0.338, 0.359, 0.380, 0.401, 0.424, $ 0.447, 0.471, 0.496, 0.521, 0.547, 0.575, 0.602, 0.631, $ 0.660, 0.690, 0.721, 0.753, 0.786, 0.819, 0.854, 0.8899, $ 0.9252, 0.9622, 1.000, 1.039, 1.079, 1.119, 1.161, 1.204, $ 1.248, 1.293, 1.338, 1.385, 1.433, 1.482, 1.532, 1.583, $ 1.636, 1.689, 1.743, 1.799, 1.856, 1.914, 1.973, 2.033, $ 2.095, 2.157, 2.221, 2.287, 2.353, 2.421, 2.490/ c data (nparms( 3, i), i=1, 2) /2*10/ data (nparms( 4, i), i=1, 2) /2*10/ data (nparms( 5, i), i=1, 3) /3*10/ data (nparms( 6, i), i=1, 3) /3*10/ data (nparms( 7, i), i=1, 4) /4*10/ data (nparms( 8, i), i=1, 4) /4*10/ data (nparms( 9, i), i=1, 4) /4*10/ data (nparms(10, i), i=1, 4) /4*10/ data (nparms(11, i), i=1, 4) /11, 3*10/ data (nparms(12, i), i=1, 4) /11, 3*10/ data (nparms(13, i), i=1, 5) /11, 4*10/ data (nparms(14, i), i=1, 6) /11, 5*10/ data (nparms(15, i), i=1, 7) /11, 6*10/ data (nparms(16, i), i=1, 7) /11, 6*10/ data (nparms(17, i), i=1, 7) /11, 6*10/ data (nparms(18, i), i=1, 7) /11, 6*10/ data (nparms(19, i), i=1, 7) /11, 6*10/ data (nparms(20, i), i=1, 7) /11, 6*10/ data (nparms(21, i), i=1, 7) /11, 6*10/ data (nparms(22, i), i=1, 7) /11, 6*10/ data (nparms(23, i), i=1, 8) /11, 7*10/ data (nparms(24, i), i=1, 9) /11, 8*10/ data (nparms(25, i), i=1, 9) /11, 8*10/ data (nparms(26, i), i=1, 9) /11, 8*10/ data (nparms(27, i), i=1, 9) /11, 8*10/ data (nparms(28, i), i=1, 9) /2*11, 7*10/ data (nparms(29, i), i=1, 9) /2*11, 7*10/ data (nparms(30, i), i=1, 9) /4*11, 5*10/ data (nparms(31, i), i=1, 9) /4*11, 5*10/ data (nparms(32, i), i=1, 9) /4*11, 5*10/ data (nparms(33, i), i=1, 9) /4*11, 5*10/ data (nparms(34, i), i=1, 9) /4*11, 5*10/ data (nparms(35, i), i=1, 9) /4*11, 5*10/ data (nparms(36, i), i=1, 9) /4*11, 5*10/ data (nparms(37, i), i=1, 9) /4*11, 5*10/ data (nparms(38, i), i=1,12) /4*11, 8*10/ data (nparms(39, i), i=1,12) /4*11, 8*10/ data (nparms(40, i), i=1,13) /4*11, 9*10/ data (nparms(41, i), i=1,13) /4*11, 9*10/ data (nparms(42, i), i=1,14) /4*11, 10*10/ data (nparms(43, i), i=1,14) /4*11, 10*10/ data (nparms(44, i), i=1,14) /4*11, 10*10/ data (nparms(45, i), i=1,14) /4*11, 10*10/ data (nparms(46, i), i=1,14) /4*11, 10*10/ data (nparms(47, i), i=1,14) /4*11, 10*10/ data (nparms(48, i), i=1,14) /4*11, 10*10/ data (nparms(49, i), i=1,14) /4*11, 10*10/ data (nparms(50, i), i=1,14) /4*11, 10*10/ data (nparms(51, i), i=1,14) /4*11, 10*10/ data (nparms(52, i), i=1,14) /5*11, 9*10/ data (nparms(53, i), i=1,14) /5*11, 9*10/ data (nparms(54, i), i=1,14) /5*11, 9*10/ data (nparms(55, i), i=1,17) /6*11, 11*10/ data (nparms(56, i), i=1,17) /7*11, 10*10/ data (nparms(57, i), i=1,17) /7*11, 10*10/ data (nparms(58, i), i=1,18) /8*11, 10*10/ data (nparms(59, i), i=1,18) /7*11, 11*10/ data (nparms(60, i), i=1,18) /7*11, 11*10/ data (nparms(61, i), i=1,18) /9*11, 9*10/ data (nparms(62, i), i=1,18) /9*11, 9*10/ data (nparms(63, i), i=1,18) /9*11, 9*10/ data (nparms(64, i), i=1,19) /9*11, 10*10/ data (nparms(65, i), i=1,19) /9*11, 10*10/ data (nparms(66, i), i=1,19) /9*11, 10*10/ data (nparms(67, i), i=1,19) /9*11, 10*10/ data (nparms(68, i), i=1,19) /9*11, 10*10/ data (nparms(69, i), i=1,19) /9*11, 10*10/ data (nparms(70, i), i=1,19) /9*11, 10*10/ data (nparms(71, i), i=1,19) /9*11, 10*10/ data (nparms(72, i), i=1,20) /9*11, 11*10/ data (nparms(73, i), i=1,20) /9*11, 11*10/ data (nparms(74, i), i=1,20) /9*11, 11*10/ data (nparms(75, i), i=1,21) /9*11, 12*10/ data (nparms(76, i), i=1,21) /9*11, 12*10/ data (nparms(77, i), i=1,21) /9*11, 12*10/ data (nparms(78, i), i=1,21) /9*11, 12*10/ data (nparms(79, i), i=1,21) /10, 8*11, 12*10/ data (nparms(80, i), i=1,22) /10, 8*11, 13*10/ data (nparms(81, i), i=1,22) /10, 8*11, 13*10/ data (nparms(82, i), i=1,23) /10, 8*11, 14*10/ data (nparms(83, i), i=1,23) /10, 8*11, 14*10/ data (nparms(84, i), i=1,24) /10, 8*11, 15*10/ data (nparms(85, i), i=1,24) /10, 9*11, 14*10/ data (nparms(86, i), i=1,24) /10, 9*11, 14*10/ data (nparms(87, i), i=1,24) /10, 9*11, 14*10/ data (nparms(88, i), i=1,24) /10, 10*11, 13*10/ data (nparms(89, i), i=1,24) /10, 10*11, 13*10/ data (nparms(90, i), i=1,24) /10, 10*11, 13*10/ data (nparms(91, i), i=1,24) /10, 11*11, 12*10/ data (nparms(92, i), i=1,24) /10, 11*11, 12*10/ c data (xsc( 3, 1,i),i=1,10)/1.301553100d-03,5.167718977d-02, $ 2.04572558, 73.6826706, 2367.26001, 6.531799585d-02, $ 2174.78979, 189729.859, 1618910.88, 3022227.00/ data (xsc( 3, 2,i),i=1,10)/2.456936636d-05,8.661831380d-04, $ 3.219022229d-02, 1.14365172, 35.4625931, 2.25543308, $ 17745.8359, 440576.219, 1333729.63, 1448481.13/ data (xsc( 4, 1,i),i=1,10)/5.501731299d-03,0.216350690, $ 8.28356647, 277.734161, 7976.12500,2.560380660d-02, $ 866.962646, 81105.0859, 771925.063, 2051785.63/ data (xsc( 4, 2,i),i=1,10)/2.081731509d-04,7.329026237d-03, $ 0.263835013, 8.65200520, 237.105286, 4.02921534, $ 31112.8418, 621490.375, 1648233.50, 1031229.06/ data (xsc( 5, 1,i),i=1,10)/1.651980355d-02,0.639404237, $ 23.6173916, 741.657715, 19577.5059,1.335961837d-02, $ 447.895050, 43871.5781, 435450.094, 1167093.38/ data (xsc( 5, 2,i),i=1,10)/8.280635811d-04,2.931262553d-02, $ 1.02559197, 31.2025394, 776.768555, 3.39596200, $ 26979.2715, 581240.375, 1365937.50, 870618.875/ data (xsc( 5, 3,i),i=1,10)/1.498534630d-07,1.311181040d-05, $ 1.204593806d-03,0.104659230, 7.67965651,0.400328189, $ 30321.8242, 1377606.13, 6894477.00, 14448549.0/ data (xsc( 6, 1,i),i=1,10)/4.022771120d-02, 1.52750432, $ 54.3804855, 1610.34399, 39562.0547,8.320189081d-03, $ 275.130463, 27737.3262, 281872.813, 765563.438/ data (xsc( 6, 2,i),i=1,10)/2.234945307d-03,7.857172936d-02, $ 2.65592504, 75.4173965, 1707.09705, 2.68837976, $ 21804.5703, 492388.406, 1077516.38, 678007.188/ data (xsc( 6, 3,i),i=1,10)/1.561928684d-06,1.310063381d-04, $ 1.182175893d-02,0.941143930, 63.7416344, 1.06329751, $ 76115.4297, 3070108.00, 11207961.0, 18938980.0/ data (xsc( 7, 1,i),i=1,10)/8.473966271d-02, 3.15485168, $ 108.397171, 3054.15259, 70342.9141,5.561249331d-03, $ 182.452774, 18816.3184, 196109.391, 545683.125/ data (xsc( 7, 2,i),i=1,10)/4.933742341d-03,0.170914933, $ 5.56366348, 148.861649, 3093.78003, 2.19790149, $ 17981.0859, 406345.625, 854337.875, 509074.750/ data (xsc( 7, 3,i),i=1,10)/5.528737347d-06,4.511051520d-04, $ 3.958846256d-02, 2.99486256, 182.204178,0.817081749, $ 60970.3750, 2508748.50, 7526410.50, 10705870.0/ data (xsc( 7, 4,i),i=1,10)/2.359686050d-06,2.124716120d-04, $ 1.939095370d-02, 1.48126984, 90.3186340,0.402362198, $ 30338.6758, 1251751.25, 3764252.50, 5362577.00/ data (xsc( 8, 1,i),i=1,10)/0.160504997, 5.85706615, $ 194.312134, 5221.68848, 111657.734,4.204052500d-03, $ 135.399689, 14075.4473, 147497.984, 417832.938/ data (xsc( 8, 2,i),i=1,10)/9.546677582d-03,0.325384855, $ 10.1911001, 256.266083, 4902.52197, 5.65027618, $ 33413.8359, 514644.063, 839019.875, 466361.438/ data (xsc( 8, 3,i),i=1,10)/1.560978126d-05,1.245745225d-03, $ 0.105102435, 7.58270359, 419.397400, 5.73374319, $ 230141.391, 3959252.50, 8621531.00, 10632627.0/ data (xsc( 8, 4,i),i=1,10)/1.317946135d-05,1.174610457d-03, $ 0.102651693, 7.48369217, 415.102356, 5.65493631, $ 228981.328, 3953836.50, 8638009.00, 10673776.0/ data (xsc( 9, 1,i),i=1,10)/0.280725479, 10.0407209, $ 322.387848, 8296.84570, 164967.891,3.362095449d-03, $ 102.271927, 10743.9775, 113532.219, 328530.594/ data (xsc( 9, 2,i),i=1,10)/1.684946194d-02,0.564888954, $ 17.0781956, 405.708954, 7241.59912, 4.16125727, $ 25509.5801, 409591.969, 663627.438, 342294.719/ data (xsc( 9, 3,i),i=1,10)/3.755814032d-05,2.953280695d-03, $ 0.240616351, 16.3673668, 847.311951, 6.02639341, $ 224444.438, 3326680.75, 6272801.50, 6917325.50/ data (xsc( 9, 4,i),i=1,10)/4.756415365d-05,4.174075089d-03, $ 0.351481318, 24.1645908, 1255.78772, 8.86773872, $ 334560.344, 4983429.00, 9439702.00, 10439668.0/ data (xsc(10, 1,i),i=1,10)/0.461048841, 16.1760311, $ 504.382843, 12496.9648, 235837.344,2.751233522d-03, $ 77.5974884, 8264.11914, 88570.9688, 262354.688/ data (xsc(10, 2,i),i=1,10)/2.783099376d-02,0.915888429, $ 26.7597961, 604.638611, 10104.3848, 2.09819627, $ 14937.3867, 281951.719, 503242.344, 240853.344/ data (xsc(10, 3,i),i=1,10)/8.132271614d-05,6.272922270d-03, $ 0.495196134, 31.8960037, 1569.13635,0.647712648, $ 45953.0586, 1562452.63, 3068620.50, 2868416.00/ data (xsc(10, 4,i),i=1,10)/1.363403426d-04,1.177385636d-02, $ 0.960985005, 62.6071243, 3095.17505, 1.25661778, $ 91011.9609, 3113751.25, 6153211.00, 5780000.50/ data (xsc(11, 1,i),i=1,11)/0.719678938, 24.7575035, $ 749.831604, 17837.6504,0.0000, 40.4996109, $ 5139.83252, 44760.4258, 137345.703, 242031.281, 194894.047/ data (xsc(11, 2,i),i=1,10)/4.549028352d-02, 1.47548819, $ 41.7576790, 896.968445, 13934.4736, 1.17296302, $ 9320.54199, 201357.344, 518224.594, 355563.563/ data (xsc(11, 3,i),i=1,10)/1.788535155d-04,1.378671546d-02, $ 1.06470704, 65.0138245, 2978.45313,0.172413975, $ 16576.0566, 938347.875, 2437551.50, 1397262.13/ data (xsc(11, 4,i),i=1,10)/3.001188161d-04,2.587055042d-02, $ 2.06276727, 127.485764, 5874.59863,0.329745412, $ 32774.9375, 1869307.13, 4888040.00, 2814550.00/ data (xsc(12, 1,i),i=1,11)/ 1.07748890, 36.3590317, $ 1071.03394, 24479.2656,0.0000, 31.9452724, $ 4077.84326, 35751.1758, 110366.938, 192795.563, 195278.125/ data (xsc(12, 2,i),i=1,10)/7.123360038d-02, 2.27467704, $ 62.3694611, 1277.60583, 18539.1563,0.615424693, $ 5559.92969, 139329.063, 436742.563, 487870.688/ data (xsc(12, 3,i),i=1,10)/3.576920135d-04,2.731011063d-02, $ 2.05052972, 119.007393, 5120.11670,4.636003450d-02, $ 5738.63086, 450838.188, 2111516.75, 1120995.88/ data (xsc(12, 4,i),i=1,10)/5.990033969d-04,5.106269196d-02, $ 3.96210837, 232.971024, 10091.8086,8.693627268d-02, $ 11313.0215, 896493.500, 4229249.00, 2257596.50/ data (xsc(13, 1,i),i=1,11)/ 1.55751050, 51.5725327, $ 1478.33850, 32428.1270,0.0000, 25.9100971, $ 3315.86548, 29194.6914, 90483.5703, 157688.125, 167248.469/ data (xsc(13, 2,i),i=1,10)/0.107318684, 3.36706495, $ 89.3895264, 1748.37085, 23709.1934,0.384381026, $ 3783.99194, 104031.250, 369606.750, 494166.094/ data (xsc(13, 3,i),i=1,10)/6.674015895d-04,5.023531988d-02, $ 3.65229011, 201.835403, 8114.76563,2.148255892d-02, $ 2929.53931, 269588.344, 1592395.75, 1433475.88/ data (xsc(13, 4,i),i=1,10)/1.112943166d-03,9.348440170d-02, $ 7.03663921, 394.388367, 15981.2051,3.948111460d-02, $ 5758.07031, 535215.063, 3186256.00, 2885157.25/ data (xsc(13, 5,i),i=1,10)/7.879838347d-03,0.224162638, $ 5.65236759, 109.529068, 1489.20581, 58.8560448, $ 45791.7344, 266193.563, 71344.7734, 347980.688/ data (xsc(14, 1,i),i=1,11)/ 2.18636870, 71.0673218, $ 1984.17834, 41781.9570,0.0000, 21.3957233, $ 2740.57544, 24228.9063, 75374.5000, 131083.328, 142535.563/ data (xsc(14, 2,i),i=1,10)/0.156227812, 4.81014633, $ 123.655083, 2312.42090, 29410.8008,0.263393164, $ 2770.06958, 81446.5391, 310726.656, 444896.500/ data (xsc(14, 3,i),i=1,10)/1.176461577d-03,8.714818954d-02, $ 6.12822819, 323.639862, 12196.4600,1.126069110d-02, $ 1652.95496, 172008.016, 1209017.13, 1656120.25/ data (xsc(14, 4,i),i=1,10)/1.959844725d-03,0.161601678, $ 11.7720785, 631.226135, 24000.7852,2.011139318d-02, $ 3237.92676, 340892.344, 2417061.00, 3331674.75/ data (xsc(14, 5,i),i=1,10)/1.411816571d-02,0.401187301, $ 9.87669754, 183.102570, 2358.03467, 44.4429398, $ 42208.6055, 313736.125, 162653.281, 80005.2031/ data (xsc(14, 6,i),i=1,10)/6.249973376d-05,3.996924497d-03, $ 0.261709213, 13.4452877, 475.203278, 32.8313789, $ 122243.977, 216556.953, 11214985.0, 32290612.0/ data (xsc(15, 1,i),i=1,11)/ 2.99109888, 95.5345459, $ 2601.35400, 52644.3086,0.0000, 17.7680607, $ 2290.75854, 20345.6113, 63556.0977, 110514.297, 121777.781/ data (xsc(15, 2,i),i=1,10)/0.220793724, 6.66793537, $ 166.183395, 2980.13110, 35851.7344,0.176890522, $ 1945.68689, 61948.0781, 254934.203, 385898.719/ data (xsc(15, 3,i),i=1,10)/1.978232060d-03,0.144055828, $ 9.80049324, 496.497589, 17670.9141,6.065215450d-03, $ 949.569885, 110775.891, 887976.250, 1629468.25/ data (xsc(15, 4,i),i=1,10)/3.278829157d-03,0.265864342, $ 18.7691917, 966.596558, 34750.7227,1.049841568d-02, $ 1852.47876, 219093.813, 1773571.75, 3276616.50/ data (xsc(15, 5,i),i=1,10)/2.243389189d-02,0.631072283, $ 15.1140366, 268.409637, 3296.84058, 34.8709259, $ 38114.8672, 321233.156, 227968.109, 4926.22803/ data (xsc(15, 6,i),i=1,10)/1.338380243d-04,8.599226363d-03, $ 0.548111379, 26.8109093, 882.155823, 30.0270767, $ 129890.227, 204304.078, 12901790.0, 30727232.0/ data (xsc(15, 7,i),i=1,10)/5.532951764d-05,3.981444519d-03, $ 0.261431783, 12.9882307, 431.338715, 14.9381475, $ 65373.6758, 102237.445, 6433917.50, 15425960.0/ data (xsc(16, 1,i),i=1,11)/ 4.00297880, 125.645302, $ 3336.60425, 64908.2656,0.0000, 15.0581884, $ 1949.67810, 17367.4648, 54399.3633, 94464.5781, 105087.281/ data (xsc(16, 2,i),i=1,10)/0.303693503, 8.99559212, $ 217.438217, 3737.79248, 42614.5664,0.130291492, $ 1515.55530, 50511.7813, 218041.891, 344550.156/ data (xsc(16, 3,i),i=1,10)/3.195327241d-03,0.228410363, $ 15.0264416, 729.671326, 24527.0723,4.100469407d-03, $ 656.268738, 81419.5938, 699896.000, 1532038.00/ data (xsc(16, 4,i),i=1,10)/5.274787080d-03,0.419763833, $ 28.6901493, 1417.97913, 48208.3945,6.840255111d-03, $ 1274.83459, 160726.359, 1396900.50, 3080348.75/ data (xsc(16, 5,i),i=1,10)/3.336768597d-02,0.925767303, $ 21.5492477, 366.828888, 4318.39111, 28.5174408, $ 34478.0508, 311271.250, 263840.156, 5097.19873/ data (xsc(16, 6,i),i=1,10)/2.531304199d-04,1.616474427d-02, $ 0.997793913, 46.4188728, 1431.60376, 26.2621441, $ 127479.820, 190660.828, 13336919.0, 26273610.0/ data (xsc(16, 7,i),i=1,10)/2.077342215d-04,1.485415734d-02, $ 0.948392630, 44.8675652, 1397.84741, 26.2266979, $ 128772.211, 192191.422, 13350413.0, 26480780.0/ data (xsc(17, 1,i),i=1,11)/ 5.25414228, 162.141266, $ 4201.44678, 78930.8828,0.0000, 12.9650497, $ 1677.90186, 14986.1406, 47054.5273, 81640.5781, 91375.2969/ data (xsc(17, 2,i),i=1,10)/0.408017427, 11.8550882, $ 278.075928, 4582.91162, 49648.3242,0.106112912, $ 1241.04224, 42662.8477, 190254.953, 310957.031/ data (xsc(17, 3,i),i=1,10)/4.981699865d-03,0.349480033, $ 22.2610455, 1037.18677, 33091.1836,2.997984877d-03, $ 469.981140, 61464.7539, 560663.125, 1384550.63/ data (xsc(17, 4,i),i=1,10)/8.185919374d-03,0.639391720, $ 42.3526001, 2009.42236, 64820.0625,4.982291255d-03, $ 933.104126, 123397.305, 1131530.13, 2813498.00/ data (xsc(17, 5,i),i=1,10)/4.733937234d-02, 1.29461861, $ 29.2959709, 478.582855, 5403.11523, 39.7703285, $ 42692.8984, 342222.719, 275203.469, 19442.5215/ data (xsc(17, 6,i),i=1,10)/4.393915879d-04,2.781425416d-02, $ 1.66258872, 73.4911575, 2122.91431, 66.6478119, $ 197430.234, 462803.625, 20593570.0, 28671536.0/ data (xsc(17, 7,i),i=1,10)/5.393139436d-04,3.811880946d-02, $ 2.36163688, 106.294724, 3105.21143, 96.3641510, $ 295091.563, 665788.375, 30513632.0, 43049564.0/ data (xsc(18, 1,i),i=1,11)/ 6.78045702, 205.872787, $ 5211.41455,0.0000,0.0000, 11.2206945, $ 1451.25696, 13007.5967, 40969.3633, 71071.4063, 79858.5313/ data (xsc(18, 2,i),i=1,10)/0.537745595, 15.3215637, $ 349.145355, 5530.56934, 57249.9609,8.058060706d-02, $ 990.483459, 35425.1172, 163749.750, 276381.094/ data (xsc(18, 3,i),i=1,10)/7.535587996d-03,0.518801868, $ 32.0660934, 1437.97949, 43965.0234,2.033560770d-03, $ 325.793732, 45366.8281, 443202.438, 1192494.38/ data (xsc(18, 4,i),i=1,10)/1.232103910d-02,0.945011258, $ 60.8128281, 2780.07568, 86040.3672,3.250034759d-03, $ 644.774658, 91015.1250, 894592.375, 2427436.25/ data (xsc(18, 5,i),i=1,10)/6.486418098d-02, 1.74860966, $ 38.5277634, 606.492554, 6609.77051, 19.1251431, $ 27166.3066, 268914.438, 284672.375, 42450.8164/ data (xsc(18, 6,i),i=1,10)/7.182126865d-04,4.501340538d-02, $ 2.61000037, 110.124474, 3000.17920, 13.2102203, $ 91612.4297, 198423.344, 10275668.0, 15258303.0/ data (xsc(18, 7,i),i=1,10)/1.170826145d-03,8.175848424d-02, $ 4.92371416, 211.844940, 5842.46826, 25.1585808, $ 181295.203, 407273.000, 20135490.0, 30561258.0/ data (xsc(19, 1,i),i=1,11)/ 8.61559391, 257.381226, $ 6361.01416,0.0000,0.0000, 9.75314999, $ 1266.26306, 11374.3389, 35897.2773, 62242.4883, 70476.5469/ data (xsc(19, 2,i),i=1,10)/0.695426166, 19.4439659, $ 430.745331, 6562.66797, 64891.7344,6.338828057d-02, $ 788.968140, 29275.7754, 139685.906, 254293.172/ data (xsc(19, 3,i),i=1,10)/1.109857671d-02,0.749247313, $ 44.9230194, 1933.97839, 56408.4883,1.546652056d-03, $ 238.654984, 34589.0430, 352950.938, 918931.813/ data (xsc(19, 4,i),i=1,10)/1.805134118d-02, 1.35872793, $ 84.9236145, 3731.17749, 110303.227,2.377696102d-03, $ 470.763550, 69328.6250, 712621.875, 1866130.50/ data (xsc(19, 5,i),i=1,10)/8.954766393d-02, 2.38756752, $ 51.3165588, 778.871826, 8213.99219, 11.3997135, $ 19505.7285, 222586.125, 398011.063, 198676.953/ data (xsc(19, 6,i),i=1,10)/1.234294148d-03,7.772114873d-02, $ 4.40419769, 177.011063, 4530.33447, 6.19070959, $ 62596.0508, 371854.625, 2104738.75, 26572800.0/ data (xsc(19, 7,i),i=1,10)/2.018780215d-03,0.141051933, $ 8.31027031, 341.028473, 8845.39355, 11.7073212, $ 123850.641, 762296.438, 4081948.00, 52652676.0/ data (xsc(20, 1,i),i=1,11)/ 10.8012180, 317.499695, $ 7660.65479,0.0000,0.0000, 8.58940220, $ 1112.51978, 10011.2959, 31645.1211, 54821.7813, 62620.7578/ data (xsc(20, 2,i),i=1,10)/0.886400521, 24.3066006, $ 523.445618, 7676.92627, 72531.1406,5.192638189d-02, $ 645.348877, 24651.0664, 120790.688, 221150.344/ data (xsc(20, 3,i),i=1,10)/1.598180458d-02, 1.05744219, $ 61.5380554, 2544.06226, 70789.5391,1.159604290d-03, $ 180.250580, 26956.6484, 284359.000, 774663.750/ data (xsc(20, 4,i),i=1,10)/2.587469853d-02, 1.90957880, $ 115.956467, 4897.30762, 138282.609,1.726604300d-03, $ 354.880554, 54049.7734, 574529.375, 1575394.13/ data (xsc(20, 5,i),i=1,10)/0.121023893, 3.18752408, $ 66.8213043, 979.660217, 10024.3721, 7.39177656, $ 14683.5410, 186835.031, 421672.531, 383247.125/ data (xsc(20, 6,i),i=1,10)/1.983818365d-03,0.123837739, $ 6.82274866, 261.554993, 6312.27588, 2.69190574, $ 38421.3984, 406731.313, 350113.156, 4626078.50/ data (xsc(20, 7,i),i=1,10)/3.220621264d-03,0.223583385, $ 12.8490229, 503.650238, 12333.3105, 5.03576231, $ 75807.5547, 827790.938, 700751.563, 9119556.00/ data (xsc(21, 1,i),i=1,11)/ 13.3754511, 387.105499, $ 9124.26074,0.0000,0.0000, 7.63245869, $ 985.740845, 8887.63965, 28145.1992, 48765.2773, 55765.8750/ data (xsc(21, 2,i),i=1,10)/ 1.11466527, 29.9885063, $ 628.362183, 8892.73633, 80391.9453,4.445857555d-02, $ 544.732727, 21299.0742, 106495.711, 198788.484/ data (xsc(21, 3,i),i=1,10)/2.259455808d-02, 1.46455920, $ 82.8303070, 3300.45557, 88189.5781,9.547692607d-04, $ 142.253525, 21883.9707, 237792.031, 660498.188/ data (xsc(21, 4,i),i=1,10)/3.633770719d-02, 2.63203478, $ 155.574493, 6340.27686, 172182.266,1.371221151d-03, $ 279.049683, 43849.1992, 480606.969, 1344320.00/ data (xsc(21, 5,i),i=1,10)/0.157317132, 4.07192469, $ 83.1233444, 1180.57031, 11781.1436, 5.22513533, $ 11549.5293, 158022.641, 381183.219, 393901.906/ data (xsc(21, 6,i),i=1,10)/2.940912731d-03,0.180802792, $ 9.67005634, 354.716370, 8119.83496, 1.61626744, $ 27698.6602, 365879.313, 277917.594, 1868140.75/ data (xsc(21, 7,i),i=1,10)/4.759747069d-03,0.325096637, $ 18.1512680, 681.726746, 15855.2959, 2.99188566, $ 54482.2539, 742810.500, 575778.188, 3671602.75/ data (xsc(22, 1,i),i=1,11)/ 16.3783951, 466.729553, $ 10741.3164,0.0000,0.0000, 6.81414413, $ 881.864502, 7959.78369, 25236.7109, 43721.8906, 50025.1211/ data (xsc(22, 2,i),i=1,10)/ 1.38360548, 36.5285339, $ 744.958191, 10184.4697, 88024.4688,3.695865348d-02, $ 473.029541, 18804.6387, 95396.0859, 180583.906/ data (xsc(22, 3,i),i=1,10)/3.134495765d-02, 1.98984599, $ 109.354668, 4199.17480, 107379.313,8.467737352d-04, $ 120.095116, 18723.7754, 206431.688, 581895.938/ data (xsc(22, 4,i),i=1,10)/5.011180788d-02, 3.55951881, $ 204.702057, 8047.52686, 209401.109,1.190659008d-03, $ 235.652359, 37602.7813, 418222.250, 1187201.38/ data (xsc(22, 5,i),i=1,10)/0.199400857, 5.07217216, $ 100.853806, 1388.92346, 13522.3828, 4.71482325, $ 10629.2871, 147303.156, 361211.375, 393500.281/ data (xsc(22, 6,i),i=1,10)/4.219437949d-03,0.254280508, $ 13.1719360, 462.252045, 10030.2881, 1.74592924, $ 28436.1680, 360342.531, 275575.281, 1358419.00/ data (xsc(22, 7,i),i=1,10)/6.784337573d-03,0.454848289, $ 24.6371078, 886.506653, 19570.9004, 3.21035886, $ 55870.5195, 732970.688, 575839.313, 2673432.25/ data (xsc(23, 1,i),i=1,11)/ 19.8593178, 557.293579, $ 12524.9434,0.0000,0.0000, 6.15256977, $ 793.150940, 7166.36816, 22744.7285, 39397.2227, 45205.3203/ data (xsc(23, 2,i),i=1,10)/ 1.69736111, 43.9810371, $ 873.232361, 11541.8584, 95371.6563,3.313467652d-02, $ 418.870239, 16851.0996, 86395.4922, 165305.313/ data (xsc(23, 3,i),i=1,10)/4.274908826d-02, 2.65845490, $ 142.064880, 5268.31689, 129182.891,7.210918702d-04, $ 102.273438, 16152.1201, 180568.219, 515993.250/ data (xsc(23, 4,i),i=1,10)/6.792763621d-02, 4.73335934, $ 265.038300, 10073.6582, 251756.672,9.996999288d-04, $ 200.471283, 32481.7402, 366493.250, 1054867.88/ data (xsc(23, 5,i),i=1,10)/0.248241663, 6.20659971, $ 120.277809, 1608.43457, 15290.3027, 4.38909674, $ 9963.03711, 138626.078, 342480.813, 385242.594/ data (xsc(23, 6,i),i=1,10)/5.895125680d-03,0.348192871, $ 17.4781113, 587.836182, 12128.6934, 1.71744359, $ 27477.3926, 344220.781, 266125.000, 1052709.13/ data (xsc(23, 7,i),i=1,10)/9.413871914d-03,0.619588792, $ 32.5734215, 1124.89624, 23648.6406, 3.13177872, $ 53901.5117, 701182.125, 560652.000, 2076638.38/ data (xsc(23, 8,i),i=1,10)/7.826552064d-06,1.302643330d-03, $ 0.193255246, 20.0691166, 1380.06238, 1381.32471, $ 5239243.00, 9182668.00, 10412750.0, 10710503.0/ data (xsc(24, 1,i),i=1,11)/ 23.8584499, 659.701660, $ 14486.9111,0.0000,0.0000, 5.58467245, $ 716.948975, 6486.02197, 20613.4258, 35712.5781, 40916.9805/ data (xsc(24, 2,i),i=1,10)/ 2.06217980, 52.4386368, $ 1014.19061, 12981.0391, 102526.242,3.025845997d-02, $ 375.973938, 15277.1689, 79048.1406, 151559.484/ data (xsc(24, 3,i),i=1,10)/5.744704604d-02, 3.50119233, $ 182.161697, 6545.91699, 154516.766,6.451446097d-04, $ 87.9408264, 14092.8447, 160078.109, 468845.625/ data (xsc(24, 4,i),i=1,10)/9.077656269d-02, 6.20592070, $ 338.715240, 12490.7891, 301108.000,8.811053121d-04, $ 171.919571, 28343.8750, 325225.781, 960945.375/ data (xsc(24, 5,i),i=1,10)/0.302706599, 7.43203974, $ 140.450073, 1828.28052, 17014.6992, 3.90112567, $ 9012.97559, 126689.531, 309776.031, 321821.813/ data (xsc(24, 6,i),i=1,10)/7.973670959d-03,0.460968494, $ 22.4341736, 725.293579, 14298.7051, 1.47912800, $ 24396.9609, 310075.875, 223923.734, 1302581.75/ data (xsc(24, 7,i),i=1,10)/1.263785642d-02,0.815583825, $ 41.6369019, 1384.22351, 27850.6758, 2.66806769, $ 47729.0195, 632149.500, 472555.719, 2572403.00/ data (xsc(24, 8,i),i=1,10)/1.598890958d-05,2.490416402d-03, $ 0.352081299, 35.3093948, 2332.49268, 1990.50281, $ 5731099.50, 11103850.0, 15900373.0, 17578990.0/ data (xsc(24, 9,i),i=1,10)/2.306908527d-06,4.717691918d-04, $ 7.798123360d-02, 8.36031055, 565.273315, 482.098938, $ 1422491.13, 2800122.25, 4079126.25, 4554578.50/ data (xsc(25, 1,i),i=1,11)/ 28.4208565, 774.182983, $ 16600.3594,0.0000,0.0000, 5.09475040, $ 650.499634, 5888.91309, 18730.2344, 32452.0781, 37298.2930/ data (xsc(25, 2,i),i=1,10)/ 2.47825813, 61.8827705, $ 1166.31567, 14459.9814, 109372.039,2.737544663d-02, $ 333.641083, 13715.8770, 71665.7734, 139514.672/ data (xsc(25, 3,i),i=1,10)/7.602304220d-02, 4.54017782, $ 229.838562, 7990.76465, 180338.203,5.802452797d-04, $ 75.9000168, 12276.8643, 140810.891, 412271.844/ data (xsc(25, 4,i),i=1,10)/0.119360931, 8.00909424, $ 425.921082, 15215.7480, 351552.875,7.861307240d-04, $ 148.008759, 24696.9512, 286419.781, 845586.250/ data (xsc(25, 5,i),i=1,10)/0.369769335, 8.92678928, $ 164.650696, 2087.09033, 18974.6934, 3.25346279, $ 7935.61279, 114448.820, 292233.063, 339664.719/ data (xsc(25, 6,i),i=1,10)/1.085056923d-02,0.614776731, $ 29.0170918, 900.749329, 16910.4805, 1.21343887, $ 20973.2129, 287629.000, 238536.297, 650341.813/ data (xsc(25, 7,i),i=1,10)/1.704382896d-02, 1.08166397, $ 53.6815720, 1716.14941, 32937.5547, 2.16276741, $ 40929.7813, 586108.750, 510700.938, 1289947.25/ data (xsc(25, 8,i),i=1,10)/2.829528239d-05,4.537343513d-03, $ 0.637378931, 61.7960281, 3924.17334, 42.0984802, $ 1352013.25, 6780917.00, 5107832.00, 3621647.25/ data (xsc(25, 9,i),i=1,10)/4.043392892d-06,8.592494996d-04, $ 0.141584083, 14.6815014, 954.535461, 10.6563883, $ 346167.406, 1705718.13, 1301684.50, 926458.625/ data (xsc(26, 1,i),i=1,11)/ 33.5967026, 901.826782, $ 18909.1035,0.0000,0.0000, 4.64799356, $ 593.258423, 5374.18408, 17106.8340, 29643.8125, 34122.8516/ data (xsc(26, 2,i),i=1,10)/ 2.95297790, 72.4341125, $ 1331.50403, 16011.6406, 115667.063,2.514671162d-02, $ 299.203613, 12430.0166, 65528.4492, 128504.328/ data (xsc(26, 3,i),i=1,10)/9.943902493d-02, 5.81886387, $ 286.807678, 9667.25781, 209151.594,5.338012706d-04, $ 66.8126221, 10892.3428, 126080.281, 372604.250/ data (xsc(26, 4,i),i=1,10)/0.155008718, 10.2135296, $ 529.719604, 18373.6797, 407788.563,7.196301012d-04, $ 129.786392, 21899.6582, 256620.547, 765136.438/ data (xsc(26, 5,i),i=1,10)/0.443230689, 10.5243616, $ 189.634857, 2344.99683, 20846.9414, 2.90282345, $ 7199.48584, 105066.070, 271252.344, 318037.219/ data (xsc(26, 6,i),i=1,10)/1.434014179d-02,0.796495140, $ 36.4943275, 1089.90161, 19528.9355, 1.07614696, $ 18903.8281, 265300.969, 225420.891, 544294.313/ data (xsc(26, 7,i),i=1,10)/2.241079509d-02, 1.39496934, $ 67.2663040, 2072.01074, 38024.9414, 1.89621890, $ 36795.9922, 540918.875, 485733.313, 1083631.13/ data (xsc(26, 8,i),i=1,10)/4.385668217d-05,6.915745325d-03, $ 0.943884850, 88.1911469, 5344.88770, 904.588257, $ 4360846.00, 6479449.50, 6033488.00, 5995079.50/ data (xsc(26, 9,i),i=1,10)/1.248026183d-05,2.616845304d-03, $ 0.418635994, 41.8461266, 2598.32959, 436.012756, $ 2171087.50, 3276084.50, 3056089.75, 3007959.75/ data (xsc(27, 1,i),i=1,11)/ 39.4313164, 1043.13147, $ 21369.3008,0.0000,0.0000, 4.28146601, $ 543.329163, 4923.98242, 15683.9902, 27184.9941, 31321.7324/ data (xsc(27, 2,i),i=1,10)/ 3.49209929, 84.1281891, $ 1508.71106, 17605.7676, 121267.266,2.347338758d-02, $ 270.816925, 11345.8652, 60245.4531, 118855.930/ data (xsc(27, 3,i),i=1,10)/0.128448009, 7.37002563, $ 353.904449, 11571.7295, 239973.906,4.955939366d-04, $ 59.5110245, 9754.95801, 113755.008, 338721.719/ data (xsc(27, 4,i),i=1,10)/0.199023858, 12.8761759, $ 651.491699, 21956.6172, 468721.469,6.732242764d-04, $ 115.055496, 19594.3516, 231614.719, 696498.438/ data (xsc(27, 5,i),i=1,10)/0.527080059, 12.2973413, $ 216.458298, 2613.66479, 22692.3418, 2.73499870, $ 6767.11426, 98785.1719, 255470.359, 301436.031/ data (xsc(27, 6,i),i=1,10)/1.868808270d-02, 1.01760614, $ 45.2823868, 1302.37842, 22269.2207,0.973131120, $ 17233.8945, 245676.391, 212413.641, 467092.094/ data (xsc(27, 7,i),i=1,10)/2.898808010d-02, 1.77265680, $ 83.1538925, 2470.61206, 43352.5391, 1.69353569, $ 33457.4688, 501269.844, 460572.344, 933397.188/ data (xsc(27, 8,i),i=1,10)/6.596191088d-05,1.024698000d-02, $ 1.36048698, 122.744514, 7140.04639, 2703.98633, $ 5272268.00, 5839494.00, 6107424.50, 6859508.00/ data (xsc(27, 9,i),i=1,10)/2.791640509d-05,5.796468351d-03, $ 0.903280079, 87.2194901, 5200.96289, 1960.57092, $ 3948209.75, 4443491.50, 4623939.50, 5131735.50/ data (xsc(28, 1,i),i=1,11)/ 45.9692841, 1198.94641, $ 23975.1094,0.0000,0.0000, 3.95673132, $ 499.031403, 4524.92383, 14424.6455, 25003.7090, 28779.6367/ data (xsc(28, 2,i),i=1,11)/ 4.09878159, 97.0018768, $ 1697.90784, 19234.1719,0.0000, 175.452911, $ 8759.09961, 41247.1641, 85691.0078, 115743.359, 125379.633/ data (xsc(28, 3,i),i=1,10)/0.164238393, 9.24035645, $ 432.607697, 13745.6699, 277654.313,4.599943059d-04, $ 52.9345589, 8730.52051, 102716.945, 308360.781/ data (xsc(28, 4,i),i=1,10)/0.252628744, 16.0622597, $ 793.752747, 26041.0527, 541307.000,6.338458625d-04, $ 101.764656, 17515.0469, 209193.891, 634732.625/ data (xsc(28, 5,i),i=1,10)/0.620443940, 14.2436867, $ 245.278503, 2896.93066, 24583.4199, 2.32250309, $ 6039.97852, 89677.1250, 235188.766, 278220.125/ data (xsc(28, 6,i),i=1,10)/2.409890480d-02, 1.28517413, $ 55.5597305, 1541.96960, 25191.3965,0.763312697, $ 14306.6006, 218936.094, 199737.891, 384962.188/ data (xsc(28, 7,i),i=1,10)/3.709980473d-02, 2.22665858, $ 101.645332, 2918.94946, 49043.4727, 1.30890584, $ 27669.1055, 446311.094, 435478.656, 771988.000/ data (xsc(28, 8,i),i=1,10)/9.720342496d-05,1.483889204d-02, $ 1.91603458, 167.094742, 9355.44727, 1645.66589, $ 4322541.00, 4872569.00, 4804619.50, 5332216.00/ data (xsc(28, 9,i),i=1,10)/5.445885472d-05,1.115813758d-02, $ 1.69257736, 158.038025, 9076.38281, 1582.09875, $ 4310802.50, 4948048.50, 4847296.50, 5294123.00/ data (xsc(29, 1,i),i=1,11)/ 53.2751999, 1370.01917, $ 0.0000,0.0000,0.0000, 3.67557979, $ 460.387970, 4176.02441, 13321.4180, 23094.5840, 26531.3652/ data (xsc(29, 2,i),i=1,11)/ 4.77699661, 111.155106, $ 1901.57800, 20946.1465,0.0000, 159.816452, $ 8044.51953, 38107.1836, 79578.3594, 107951.578, 98264.7188/ data (xsc(29, 3,i),i=1,10)/0.207876742, 11.4773922, $ 524.464844, 16219.5195, 335328.406,4.353651893d-04, $ 47.9885559, 7946.92432, 94237.9219, 285755.063/ data (xsc(29, 4,i),i=1,10)/0.317746878, 19.8555527, $ 959.083496, 30679.8008, 642349.813,6.144578801d-04, $ 91.8376389, 15937.9561, 192159.094, 590128.125/ data (xsc(29, 5,i),i=1,10)/0.722816169, 16.2981033, $ 274.493652, 3175.11328, 26342.4785, 2.21426272, $ 5730.03467, 84846.7969, 216483.391, 234566.063/ data (xsc(29, 6,i),i=1,10)/3.050390072d-02, 1.59164131, $ 66.8567581, 1792.96069, 27991.2402,0.722355902, $ 13405.5195, 202315.969, 164977.609, 484288.344/ data (xsc(29, 7,i),i=1,10)/4.648753628d-02, 2.73926282, $ 121.781357, 3385.16455, 54478.8164, 1.22389197, $ 25846.0547, 413024.906, 362458.844, 968524.375/ data (xsc(29, 8,i),i=1,10)/1.341273601d-04,1.955577545d-02, $ 2.42353272, 204.523788, 11062.6572, 31380.8027, $ 4706225.00, 6409198.00, 8098560.00, 9343090.00/ data (xsc(29, 9,i),i=1,10)/1.116064741d-04,2.188922837d-02, $ 3.18954372, 288.272064, 16006.7266, 45622.2109, $ 7098642.00, 9932945.00, 12575751.0, 14364417.0/ data (xsc(30, 1,i),i=1,11)/ 61.3851280, 1556.50842, $ 0.0000,0.0000,0.0000, 3.41738033, $ 424.861633, 3855.01636, 12305.6807, 21342.2305, 24597.9238/ data (xsc(30, 2,i),i=1,11)/ 5.53230429, 126.530487, $ 2115.26636, 22648.3418,0.0000, 144.203690, $ 7324.24951, 34937.3711, 73252.3047, 99417.7656, 107036.820/ data (xsc(30, 3,i),i=1,11)/0.260641187, 14.1196003, $ 629.830200, 18958.1777,0.0000, 27.0905952, $ 5521.70898, 53473.4570, 167394.891, 300247.656, 1333241.00/ data (xsc(30, 4,i),i=1,11)/0.395631582, 24.3039589, $ 1147.85352, 35802.5313,0.0000, 51.2061539, $ 11047.5537, 108699.633, 343778.188, 622572.875, 2775663.50/ data (xsc(30, 5,i),i=1,10)/0.843118131, 18.7137108, $ 308.696930, 3499.22192, 28351.6152, 1.81062496, $ 4876.25684, 74630.8828, 200414.328, 237135.188/ data (xsc(30, 6,i),i=1,10)/3.875831515d-02, 1.98363042, $ 81.0585175, 2100.58325, 31268.1074,0.500795305, $ 10337.0840, 176975.906, 176503.344, 277110.688/ data (xsc(30, 7,i),i=1,10)/5.864527449d-02, 3.39699197, $ 147.175522, 3960.25513, 60918.1406,0.831809580, $ 19836.1797, 360242.563, 388554.844, 559752.813/ data (xsc(30, 8,i),i=1,10)/1.970313460d-04,2.921710163d-02, $ 3.58537722, 293.221649, 15270.9492, 132.655106, $ 1802453.38, 3597675.00, 2548656.25, 2326434.25/ data (xsc(30, 9,i),i=1,10)/1.636254747d-04,3.274735808d-02, $ 4.72995329, 414.446899, 22173.4941, 185.929138, $ 2675326.50, 5466531.50, 3880210.50, 3443699.50/ data (xsc(31, 1,i),i=1,11)/ 70.3515015, 1759.00732, $ 0.0000,0.0000,0.0000, 3.18604612, $ 392.892303, 3565.45703, 11387.8984, 19762.4121, 22863.1387/ data (xsc(31, 2,i),i=1,11)/ 6.36879921, 143.186615, $ 2339.80249, 24352.5195,0.0000, 130.087662, $ 6664.97998, 32003.0059, 67459.7031, 93002.2422, 97879.8594/ data (xsc(31, 3,i),i=1,11)/0.323959708, 17.2229671, $ 750.230164, 21983.3828,0.0000, 23.8705845, $ 4887.52295, 47695.3945, 150168.469, 264292.719, 1161609.88/ data (xsc(31, 4,i),i=1,11)/0.488045543, 29.4898682, $ 1362.54773, 41448.9023,0.0000, 44.8492928, $ 9771.77344, 97009.0781, 308733.250, 547964.938, 2423530.50/ data (xsc(31, 5,i),i=1,10)/0.980047762, 21.4168129, $ 346.233002, 3849.91260, 30489.5234, 1.32787907, $ 3933.51074, 63336.6367, 180888.016, 223851.828/ data (xsc(31, 6,i),i=1,10)/4.889723286d-02, 2.45786095, $ 97.8323288, 2453.60913, 34869.2188,0.302032202, $ 7056.10400, 145255.656, 194211.641, 153909.406/ data (xsc(31, 7,i),i=1,10)/7.358220965d-02, 4.18986750, $ 176.936600, 4610.36816, 67755.8047,0.556340277, $ 14740.4688, 307470.469, 427068.250, 334535.438/ data (xsc(31, 8,i),i=1,10)/2.864034032d-04,4.266745225d-02, $ 5.15593910, 408.520752, 20417.7539, 8.49055195, $ 496642.375, 3697577.00, 1791704.50, 1466864.75/ data (xsc(31, 9,i),i=1,10)/2.360964572d-04,4.774709046d-02, $ 6.80612516, 578.010925, 29699.7559, 11.3159914, $ 733049.250, 5574049.00, 2732383.00, 2190759.75/ data (xsc(32, 1,i),i=1,11)/ 80.2246170, 1978.03235, $ 0.0000,0.0000,0.0000, 2.97958446, $ 364.208313, 3305.44434, 10563.2871, 18339.8008, 21252.4922/ data (xsc(32, 2,i),i=1,11)/ 7.28964853, 161.231857, $ 2578.17993, 26116.5684,0.0000, 116.147964, $ 6021.05811, 29166.0547, 61864.8750, 85900.4766, 91946.7969/ data (xsc(32, 3,i),i=1,11)/0.399251997, 20.8421402, $ 887.159058, 25318.9590,0.0000, 21.1208858, $ 4340.14258, 42661.2109, 135139.531, 236204.406, 1025463.19/ data (xsc(32, 4,i),i=1,11)/0.597486913, 35.5078125, $ 1605.66748, 47667.3398,0.0000, 39.4249001, $ 8668.75293, 86800.4922, 278110.656, 490046.188, 2151649.50/ data (xsc(32, 5,i),i=1,10)/ 1.13551497, 24.4313889, $ 387.218262, 4224.90674, 32690.6797, 1.06691349, $ 3305.13623, 55324.1563, 165297.047, 210959.625/ data (xsc(32, 6,i),i=1,10)/6.146106869d-02, 3.03055429, $ 117.449364, 2851.64014, 38660.9688,0.194859102, $ 5125.17773, 121457.352, 203937.344, 119521.008/ data (xsc(32, 7,i),i=1,10)/9.169522673d-02, 5.13813210, $ 211.667389, 5344.65771, 75049.6797,0.374449104, $ 11211.8652, 263858.656, 451811.719, 274452.563/ data (xsc(32, 8,i),i=1,10)/4.109158472d-04,6.092090160d-02, $ 7.22076845, 554.850220, 26606.1992, 1.40949738, $ 170372.672, 2955295.25, 1788004.63, 925162.063/ data (xsc(32, 9,i),i=1,10)/3.384672746d-04,6.817138195d-02, $ 9.52997208, 785.181580, 38735.9609, 1.78750610, $ 250344.313, 4433116.00, 2723435.00, 1394704.25/ data (xsc(33, 1,i),i=1,11)/ 91.0590286, 2214.20728, $ 0.0000,0.0000,0.0000, 2.77999401, $ 338.074158, 3071.30420, 9819.92090, 17059.8027, 19765.7715/ data (xsc(33, 2,i),i=1,11)/ 8.30234146, 180.560242, $ 2823.69092, 27807.3613,0.0000, 106.028755, $ 5528.84961, 26914.7109, 57309.3477, 79884.0313, 86638.7656/ data (xsc(33, 3,i),i=1,11)/0.488622487, 25.0425739, $ 1041.92041, 28968.4316,0.0000, 18.8089008, $ 3873.24927, 38317.7344, 122051.578, 212553.844, 910310.875/ data (xsc(33, 4,i),i=1,11)/0.725964069, 42.4437675, $ 1879.37708, 54474.1758,0.0000, 34.8414116, $ 7723.30566, 77956.7031, 251346.531, 441191.563, 1911485.38/ data (xsc(33, 5,i),i=1,10)/ 1.31026614, 27.7612228, $ 431.583313, 4623.30566, 34990.5742,0.875532150, $ 2808.80566, 48673.4727, 152043.938, 200912.766/ data (xsc(33, 6,i),i=1,10)/7.672012597d-02, 3.71009231, $ 139.956955, 3287.16162, 42463.3164,0.146437481, $ 4137.73193, 106420.070, 207359.031, 121932.625/ data (xsc(33, 7,i),i=1,10)/0.113692299, 6.26289845, $ 251.658844, 6162.21240, 82752.8125,0.268081605, $ 8669.26953, 226513.859, 457978.469, 282961.406/ data (xsc(33, 8,i),i=1,10)/5.811402225d-04,8.526003361d-02, $ 9.88842010, 737.480530, 33899.0352,0.408280015, $ 74780.4766, 2276189.50, 1982255.38, 636077.063/ data (xsc(33, 9,i),i=1,10)/4.769114603d-04,9.527547657d-02, $ 13.0436487, 1043.49854, 49382.5664,0.488065064, $ 109408.219, 3403490.75, 3013125.75, 961699.813/ data (xsc(34, 1,i),i=1,11)/ 102.904449, 2467.74854, $ 0.0000,0.0000,0.0000, 2.61308599, $ 314.814301, 2859.95776, 9148.33203, 15902.4307, 18405.3477/ data (xsc(34, 2,i),i=1,11)/ 9.41354561, 201.409302, $ 3084.02319, 29570.8711,0.0000, 95.5265350, $ 5028.90283, 24670.2402, 52813.6211, 73890.2188, 80790.6172/ data (xsc(34, 3,i),i=1,11)/0.593881845, 29.8914223, $ 1216.38818, 32970.6836,0.0000, 16.7941189, $ 3464.03857, 34490.4727, 110469.086, 192158.172, 806454.875/ data (xsc(34, 4,i),i=1,11)/0.875946045, 50.3962593, $ 2186.65649, 61936.3945,0.0000, 30.8629723, $ 6894.74365, 70160.8828, 227644.938, 399123.906, 1695917.13/ data (xsc(34, 5,i),i=1,10)/ 1.50731444, 31.4317169, $ 479.496704, 5048.24072, 37444.2422,0.671760857, $ 2349.33813, 42372.9219, 138259.844, 189295.625/ data (xsc(34, 6,i),i=1,10)/9.510219097d-02, 4.51131201, $ 165.746719, 3769.60205, 46480.4180,0.111424357, $ 3291.01318, 92255.5781, 204266.703, 134721.031/ data (xsc(34, 7,i),i=1,10)/0.139976755, 7.58119965, $ 297.261536, 7063.01318, 90829.4453,0.190035895, $ 6817.16602, 195496.141, 450909.063, 315883.531/ data (xsc(34, 8,i),i=1,10)/8.087955648d-04,0.117163680, $ 13.2909241, 963.809387, 42543.8438,0.137163624, $ 34927.3047, 1639086.38, 2139142.50, 459565.406/ data (xsc(34, 9,i),i=1,10)/6.616109749d-04,0.130725905, $ 17.5188789, 1363.39148, 62003.9180,0.154018119, $ 50843.1367, 2443793.00, 3244723.25, 694652.125/ data (xsc(35, 1,i),i=1,11)/ 115.801857, 2738.54492, $ 0.0000,0.0000,0.0000, 2.46435618, $ 293.933472, 2669.65356, 8542.25879, 14855.8311, 17168.5137/ data (xsc(35, 2,i),i=1,11)/ 10.6241693, 223.629333, $ 3352.69434, 31288.7969,0.0000, 87.0761642, $ 4614.44434, 22768.4023, 48947.3555, 68661.2578, 75400.8125/ data (xsc(35, 3,i),i=1,11)/0.717057228, 35.4425697, $ 1410.52295, 37236.1719,0.0000, 15.1906128, $ 3129.47437, 31291.8672, 100618.641, 174956.828, 717155.438/ data (xsc(35, 4,i),i=1,11)/ 1.04939413, 59.4305878, $ 2526.89600, 69876.7578,0.0000, 27.7121754, $ 6221.36328, 63677.0000, 207570.500, 364118.344, 1505880.75/ data (xsc(35, 5,i),i=1,10)/ 1.72405887, 35.4125748, $ 530.380676, 5485.78857, 39851.4297,0.576584041, $ 2067.87671, 38239.3828, 128469.820, 181360.719/ data (xsc(35, 6,i),i=1,10)/0.117057204, 5.44646025, $ 194.888123, 4290.66504, 50516.0938,9.125851095d-02, $ 2744.77466, 81830.6953, 199421.891, 151311.875/ data (xsc(35, 7,i),i=1,10)/0.171111077, 9.11055565, $ 348.548157, 8031.59326, 98924.9609,0.153152615, $ 5720.55713, 174393.688, 441951.531, 357866.969/ data (xsc(35, 8,i),i=1,10)/1.109156408d-03,0.158323511, $ 17.5431156, 1235.59436, 52167.1211,7.276616246d-02, $ 21845.5039, 1291753.50, 2164522.00, 369368.375/ data (xsc(35, 9,i),i=1,10)/9.028668865d-04,0.176223963, $ 23.0945625, 1745.56506, 75881.2969,8.406757563d-02, $ 33285.5859, 1971108.13, 3277090.25, 564616.125/ data (xsc(36, 1,i),i=1,11)/ 129.995651, 3029.05200, $ 0.0000,0.0000,0.0000, 2.32620788, $ 274.610352, 2494.08398, 7984.88086, 13894.3145, 16032.0732/ data (xsc(36, 2,i),i=1,11)/ 11.9420261, 247.392990, $ 3634.12915, 33032.5078,0.0000, 78.6450119, $ 4222.15674, 20975.0977, 45307.5313, 63711.9375, 70149.6953/ data (xsc(36, 3,i),i=1,11)/0.860745907, 41.8030548, $ 1629.10864, 41976.5313,0.0000, 13.6485691, $ 2812.35938, 28296.9355, 91485.9141, 159344.422, 637128.125/ data (xsc(36, 4,i),i=1,11)/ 1.25032532, 69.7208557, $ 2908.56104, 78711.8125,0.0000, 24.6885414, $ 5580.72559, 57580.0781, 188882.234, 332067.063, 1340001.13/ data (xsc(36, 5,i),i=1,10)/ 1.96369970, 39.7445793, $ 584.965515, 5951.28271, 42458.3047,0.475202024, $ 1761.07068, 33711.1406, 117089.836, 170235.375/ data (xsc(36, 6,i),i=1,10)/0.143166572, 6.53821802, $ 228.273178, 4881.62988, 55085.2852,6.140151992d-02, $ 2028.23376, 67512.3281, 185534.875, 159878.906/ data (xsc(36, 7,i),i=1,10)/0.208088011, 10.8912735, $ 407.198456, 9133.87207, 108257.883,9.887553006d-02, $ 4190.48828, 143476.719, 410401.406, 378941.063/ data (xsc(36, 8,i),i=1,10)/1.498913509d-03,0.210859850, $ 22.8473740, 1567.29126, 63664.1602,3.360760957d-02, $ 12333.9443, 935434.938, 2128649.75, 295130.188/ data (xsc(36, 9,i),i=1,10)/1.216916484d-03,0.234330356, $ 30.0603981, 2215.63501, 92852.1797,3.355485573d-02, $ 17778.7051, 1389055.50, 3219008.75, 444752.625/ data (xsc(37, 1,i),i=1,11)/ 145.150543, 3335.24902, $ 0.0000,0.0000,0.0000, 2.20369673, $ 257.035278, 2335.36548, 7478.15186, 13017.0439, 15004.7373/ data (xsc(37, 2,i),i=1,11)/ 13.3684654, 272.545593, $ 3922.27734, 34714.9336,0.0000, 71.6623535, $ 3874.45020, 19358.7090, 41990.6445, 59185.3477, 64918.2656/ data (xsc(37, 3,i),i=1,11)/ 1.02672589, 49.0009155, $ 1869.27454, 46924.0781,0.0000, 12.3343239, $ 2535.96387, 25624.2520, 83175.4922, 145147.594, 169550.125/ data (xsc(37, 4,i),i=1,11)/ 1.48078465, 81.2901382, $ 3325.66699, 87919.4688,0.0000, 22.1339550, $ 5025.31738, 52153.3359, 171869.922, 302482.156, 355350.250/ data (xsc(37, 5,i),i=1,10)/ 2.22920394, 44.4258423, $ 642.403442, 6425.02148, 45004.0195,0.379439354, $ 1512.92029, 29823.3379, 106568.219, 166562.719/ data (xsc(37, 6,i),i=1,10)/0.173848987, 7.78626299, $ 264.755524, 5475.88672, 59050.4336,5.199510977d-02, $ 1728.84705, 60143.6719, 179115.750, 170479.313/ data (xsc(37, 7,i),i=1,10)/0.250936806, 12.9117928, $ 471.177307, 10247.3936, 116533.945,8.001378179d-02, $ 3515.19214, 126855.000, 395169.250, 401144.719/ data (xsc(37, 8,i),i=1,10)/1.996008214d-03,0.276897550, $ 29.3404846, 1958.40479, 76366.8516,1.569856517d-02, $ 6946.48096, 651206.750, 2144910.75, 288034.063/ data (xsc(37, 9,i),i=1,10)/1.618464827d-03,0.307255805, $ 38.5445099, 2763.93921, 111082.711,1.564608514d-02, $ 10406.0605, 990321.813, 3254537.25, 431920.219/ data (xsc(38, 1,i),i=1,11)/ 161.513519, 3660.20239, $ 0.0000,0.0000,0.0000, 2.09155250, $ 241.108521, 2189.63208, 7012.84424, 12210.6865, 14059.6348/ data (xsc(38, 2,i),i=1,11)/ 14.9101200, 299.185394, $ 4219.23926, 36356.2305,0.0000, 65.4292450, $ 3560.53760, 17888.4688, 38957.1836, 55047.1719, 60405.5820/ data (xsc(38, 3,i),i=1,11)/ 1.21865380, 57.1402168, $ 2133.73535, 52165.9063,0.0000, 11.1423483, $ 2294.35181, 23263.1074, 75764.1719, 132247.688, 150195.922/ data (xsc(38, 4,i),i=1,11)/ 1.74423289, 94.2742844, $ 3783.10938, 97674.4453,0.0000, 19.8181324, $ 4538.41113, 47343.8086, 156657.875, 275882.625, 315142.156/ data (xsc(38, 5,i),i=1,10)/ 2.51823068, 49.4545937, $ 703.053589, 6912.58838, 47542.7813,0.320201725, $ 1313.70667, 26578.0039, 97467.1953, 153493.984/ data (xsc(38, 6,i),i=1,10)/0.209908247, 9.22296047, $ 305.693665, 6123.24658, 63259.9023,4.140869156d-02, $ 1399.07043, 51847.1016, 167731.375, 180220.813/ data (xsc(38, 7,i),i=1,10)/0.300864190, 15.2228489, $ 542.591614, 11452.9717, 125273.719,6.202661991d-02, $ 2845.76807, 109597.852, 370477.844, 422457.781/ data (xsc(38, 8,i),i=1,10)/2.632827265d-03,0.359631956, $ 37.2268562, 2414.14160, 90173.9453,8.880086243d-03, $ 4397.25391, 476697.594, 2032991.00, 424226.844/ data (xsc(38, 9,i),i=1,10)/2.128628781d-03,0.398270935, $ 48.8483047, 3404.98462, 131123.516,8.409592323d-03, $ 6564.34180, 725246.188, 3091865.00, 635316.875/ data (xsc(38,10,i),i=1,10)/0.378550559, 7.14977789, $ 99.8566971, 995.345764, 7467.83545, 21.4249725, $ 13344.4141, 124349.555, 205973.406, 104676.906/ data (xsc(38,11,i),i=1,10)/2.590393834d-02, 1.07259893, $ 34.1239853, 668.743408, 7179.04785, 32.5392952, $ 33407.7227, 113940.352, 2081546.50, 15789259.0/ data (xsc(38,12,i),i=1,10)/3.694827110d-02, 1.76024485, $ 60.2213287, 1243.12451, 14006.2578, 57.3781700, $ 68820.7734, 243546.422, 3774906.50, 30677134.0/ data (xsc(39, 1,i),i=1,11)/ 179.146790, 4003.60840, $ 0.0000,0.0000,0.0000, 1.98952651, $ 226.568222, 2056.57666, 6588.13281, 11473.4834, 13194.2031/ data (xsc(39, 2,i),i=1,11)/ 16.5722656, 327.370148, $ 4525.74902, 38015.5039,0.0000, 60.0163879, $ 3284.59888, 16586.6406, 36256.3047, 51340.8867, 56210.4727/ data (xsc(39, 3,i),i=1,11)/ 1.43939900, 66.3263550, $ 2426.01465, 57802.6680,0.0000, 10.1674337, $ 2085.79395, 21220.9609, 69344.5781, 121139.367, 138701.953/ data (xsc(39, 4,i),i=1,11)/ 2.04443002, 108.828255, $ 4286.77734, 108218.703,0.0000, 17.9094810, $ 4117.66357, 43179.9531, 143478.172, 252981.453, 291438.125/ data (xsc(39, 5,i),i=1,10)/ 2.83639383, 54.8693581, $ 767.066040, 7417.85059, 50142.5820,0.276592433, $ 1157.77515, 23958.1934, 89794.2656, 144308.313/ data (xsc(39, 6,i),i=1,10)/0.251975983, 10.8622761, $ 351.090485, 6813.45313, 67504.2188,3.296152130d-02, $ 1167.85828, 45512.6055, 156651.328, 183206.031/ data (xsc(39, 7,i),i=1,10)/0.358618289, 17.8460426, $ 621.632385, 12742.8994, 134270.031,5.000425503d-02, $ 2364.53101, 96150.6016, 346162.188, 429718.688/ data (xsc(39, 8,i),i=1,10)/3.440195462d-03,0.462344706, $ 46.7640839, 2949.67236, 105896.805,5.328153260d-03, $ 2960.22778, 360749.375, 1858937.13, 552808.563/ data (xsc(39, 9,i),i=1,10)/2.773017157d-03,0.510965705, $ 61.2910271, 4158.10840, 153977.609,4.748226609d-03, $ 4387.53125, 547963.625, 2829978.50, 828897.438/ data (xsc(39,10,i),i=1,10)/0.451179683, 8.43212128, $ 116.126633, 1141.38098, 8498.56152, 15.9779139, $ 11140.9570, 112213.250, 209913.750, 150483.000/ data (xsc(39,11,i),i=1,10)/3.378038853d-02, 1.38149095, $ 42.9767265, 816.078613, 8485.08398, 19.2197819, $ 27772.6797, 103374.656, 1032195.00, 6357127.50/ data (xsc(39,12,i),i=1,10)/4.790235683d-02, 2.26003051, $ 75.7655411, 1518.69629, 16618.9922, 33.3941879, $ 56679.7070, 234334.891, 1845420.75, 12221569.0/ data (xsc(40, 1,i),i=1,11)/ 198.084564, 4365.35010, $ 0.0000,0.0000,0.0000, 1.89752984, $ 213.369598, 1935.44495, 6200.74756, 10803.4980, 12404.0029/ data (xsc(40, 2,i),i=1,11)/ 18.3579235, 357.056580, $ 4839.54834, 39608.8945,0.0000, 55.0786514, $ 3045.32690, 15444.5264, 33866.7383, 48042.4766, 52498.1016/ data (xsc(40, 3,i),i=1,11)/ 1.69195735, 76.6252518, $ 2745.34692, 63772.3477,0.0000, 9.37018871, $ 1911.56104, 19491.3379, 63848.3672, 111592.367, 128467.000/ data (xsc(40, 4,i),i=1,11)/ 2.38461804, 125.030273, $ 4834.98193, 119323.406,0.0000, 16.3419838, $ 3766.07813, 39653.8359, 132203.844, 233354.406, 270296.406/ data (xsc(40, 5,i),i=1,10)/ 3.17947149, 60.6363792, $ 834.236755, 7938.17578, 52774.6797,0.243396163, $ 1033.27185, 21803.2090, 83217.4375, 135922.281/ data (xsc(40, 6,i),i=1,10)/0.301004767, 12.7231665, $ 400.982788, 7538.53076, 71666.0938,2.841274440d-02, $ 1006.94525, 40732.1367, 147045.813, 182756.844/ data (xsc(40, 7,i),i=1,10)/0.425387323, 20.8067722, $ 708.235107, 14099.4453, 143236.375,4.015129432d-02, $ 2032.82349, 86105.8047, 325500.844, 429292.906/ data (xsc(40, 8,i),i=1,10)/4.447322339d-03,0.588055849, $ 58.1128082, 3562.12866, 122820.500,3.797446843d-03, $ 2218.65479, 291803.063, 1696030.13, 631846.563/ data (xsc(40, 9,i),i=1,10)/3.569497028d-03,0.648275793, $ 76.0760880, 5019.27295, 178619.703,3.210201627d-03, $ 3261.68115, 442121.875, 2581909.75, 947468.688/ data (xsc(40,10,i),i=1,10)/0.529819191, 9.78068161, $ 132.754120, 1287.17285, 9516.60938, 13.6866503, $ 10142.7656, 105999.258, 209340.328, 171248.594/ data (xsc(40,11,i),i=1,10)/4.301036894d-02, 1.72926521, $ 52.4891701, 965.794861, 9737.61719, 16.6749153, $ 26720.4961, 106705.492, 768987.250, 4248017.00/ data (xsc(40,12,i),i=1,10)/6.057272106d-02, 2.81652451, $ 92.3253784, 1797.18713, 19125.3691, 28.6847382, $ 54410.7930, 245641.844, 1375094.00, 8130742.00/ data (xsc(40,13,i),i=1,10)/1.564582344d-04,1.751643978d-02, $ 1.57011914, 90.4214554, 2764.07764, 465.709259, $ 26196.8945, 11198567.0, 13479409.0, 12719175.0/ data (xsc(41, 1,i),i=1,11)/ 218.421249, 4747.14160, $ 0.0000,0.0000,0.0000, 1.81405532, $ 201.294617, 1824.36816, 5845.46338, 10199.0410, 11666.7500/ data (xsc(41, 2,i),i=1,11)/ 20.2745953, 388.375244, $ 5163.62695, 41282.5156,0.0000, 50.8884010, $ 2828.08960, 14406.3662, 31691.5313, 45017.3555, 49136.8516/ data (xsc(41, 3,i),i=1,11)/ 1.98029768, 88.1779251, $ 3097.12842, 70272.1328,0.0000, 8.61602688, $ 1756.81860, 17960.6035, 58998.5547, 103244.578, 118982.734/ data (xsc(41, 4,i),i=1,11)/ 2.76925254, 143.079041, $ 5436.61084, 131534.563,0.0000, 14.9521971, $ 3454.31055, 36536.3594, 122267.820, 216200.359, 250722.047/ data (xsc(41, 5,i),i=1,10)/ 3.55402899, 66.8008041, $ 904.766113, 8477.38574, 55445.9492,0.217097908, $ 928.643921, 19960.2207, 77480.8906, 127574.836/ data (xsc(41, 6,i),i=1,10)/0.357288361, 14.8225965, $ 455.976593, 8313.54980, 75939.4063,2.461441420d-02, $ 870.914978, 36546.6445, 137495.297, 179672.125/ data (xsc(41, 7,i),i=1,10)/0.501355648, 24.1268692, $ 803.454651, 15553.2676, 152661.203,3.376957402d-02, $ 1751.86255, 77276.9609, 305101.781, 423001.219/ data (xsc(41, 8,i),i=1,10)/5.694358610d-03,0.741096258, $ 71.6300507, 4274.30615, 142226.250,2.645154018d-03, $ 1681.38220, 238178.453, 1534821.38, 582568.063/ data (xsc(41, 9,i),i=1,10)/4.561474547d-03,0.815524220, $ 93.6537781, 6019.17334, 206829.016,2.152563073d-03, $ 2458.72705, 360692.031, 2338196.00, 869593.438/ data (xsc(41,10,i),i=1,10)/0.612750053, 11.1583605, $ 149.253799, 1429.06396, 10510.4922, 11.4717159, $ 9049.18164, 97834.2813, 196611.281, 157352.063/ data (xsc(41,11,i),i=1,10)/5.333347246d-02, 2.10468006, $ 62.3245010, 1112.88916, 10910.8672, 11.9794130, $ 23103.1055, 102423.703, 574271.688, 3695229.25/ data (xsc(41,12,i),i=1,10)/7.447589189d-02, 3.40727806, $ 109.204124, 2067.71436, 21464.4473, 20.2748394, $ 46713.0156, 237588.016, 1027884.94, 7088904.50/ data (xsc(41,13,i),i=1,10)/4.208431346d-04,4.603499547d-02, $ 4.00764608, 222.856277, 6501.55127, 2256.22852, $ 360910.219, 21367446.0, 27653664.0, 29049492.0/ data (xsc(42, 1,i),i=1,11)/ 240.097275, 5144.72656, $ 0.0000,0.0000,0.0000, 1.73783219, $ 190.097046, 1722.38550, 5518.71191, 9627.55371, 11005.0039/ data (xsc(42, 2,i),i=1,11)/ 22.3213329, 421.095978, $ 5490.91113, 42420.1602,0.0000, 47.3239059, $ 2639.03882, 13488.4756, 29747.5313, 42303.9961, 46096.3047/ data (xsc(42, 3,i),i=1,11)/ 2.30739427, 101.003838, $ 3476.32935, 77040.1797,0.0000, 8.02373505, $ 1624.74292, 16628.1777, 54710.8398, 95766.4297, 109727.063/ data (xsc(42, 4,i),i=1,11)/ 3.20123339, 162.969803, $ 6082.30273, 144061.484,0.0000, 13.7183266, $ 3188.79077, 33827.0742, 113491.219, 200842.766, 231035.063/ data (xsc(42, 5,i),i=1,10)/ 3.95829892, 73.3244247, $ 977.726746, 9017.90918, 57976.3359,0.199403420, $ 851.258484, 18528.1855, 72779.7734, 121042.602/ data (xsc(42, 6,i),i=1,10)/0.422186017, 17.1760159, $ 515.355103, 9102.08594, 79867.7734,2.242681757d-02, $ 782.378540, 33536.2383, 130016.234, 176863.469/ data (xsc(42, 7,i),i=1,10)/0.588181078, 27.8265152, $ 905.909912, 17032.8398, 161457.938,3.009606339d-02, $ 1572.45984, 71061.6875, 289479.813, 417790.563/ data (xsc(42, 8,i),i=1,10)/7.225201931d-03,0.925237000, $ 87.4035797, 5065.71143, 162128.094,2.092840848d-03, $ 1372.98071, 203375.188, 1406531.00, 614487.563/ data (xsc(42, 9,i),i=1,10)/5.769114941d-03, 1.01592946, $ 114.130440, 7128.85303, 235719.234,1.656617504d-03, $ 2001.51587, 308182.719, 2145403.00, 914660.375/ data (xsc(42,10,i),i=1,10)/0.703809321, 12.6618958, $ 167.027222, 1578.99634, 11535.5352, 11.1804590, $ 8929.43945, 96923.2109, 196239.875, 165727.781/ data (xsc(42,11,i),i=1,10)/6.567740440d-02, 2.54781103, $ 73.6351395, 1275.04834, 12151.4619, 13.2324371, $ 24509.7188, 107404.367, 547929.938, 3136452.50/ data (xsc(42,12,i),i=1,10)/9.101111442d-02, 4.10334730, $ 128.648575, 2367.61401, 23964.3633, 22.2596340, $ 49670.7539, 251517.375, 985744.375, 6027433.50/ data (xsc(42,13,i),i=1,10)/6.148125976d-04,6.714596599d-02, $ 5.73747110, 308.015320, 8571.79004, 14348.6230, $ 7814266.00, 25720028.0, 33348208.0, 36858940.0/ data (xsc(42,14,i),i=1,10)/8.017745859d-05,1.205120422d-02, $ 1.22094846, 70.6675644, 2032.77783, 3417.11523, $ 1867871.75, 6514205.00, 8738789.00, 9799364.00/ data (xsc(43, 1,i),i=1,11)/ 263.218353, 5561.27295, $ 0.0000,0.0000,0.0000, 1.66740632, $ 179.844498, 1627.83167, 5215.59229, 9100.87891, 10391.3418/ data (xsc(43, 2,i),i=1,11)/ 24.5051975, 455.363861, $ 5825.05176,0.0000,0.0000, 43.9736137, $ 2460.91431, 12623.2471, 27913.6055, 39755.9648, 43286.3984/ data (xsc(43, 3,i),i=1,11)/ 2.67746568, 115.233955, $ 3886.97217, 83721.3594,0.0000, 7.47870445, $ 1503.18005, 15398.0850, 50740.5664, 88811.2891, 101943.969/ data (xsc(43, 4,i),i=1,11)/ 3.68525243, 184.882828, $ 6779.14258, 157491.297,0.0000, 12.6491575, $ 2943.57031, 31316.1777, 105331.508, 186493.297, 215054.938/ data (xsc(43, 5,i),i=1,10)/ 4.39064074, 80.2249985, $ 1054.03064, 9577.97559, 60510.0625,0.167934537, $ 766.106262, 16960.5234, 67560.5156, 114272.773/ data (xsc(43, 6,i),i=1,10)/0.496396124, 19.8073235, $ 579.823730, 9923.71777, 83685.0391,2.020336129d-02, $ 694.726440, 30511.9727, 122119.953, 171240.531/ data (xsc(43, 7,i),i=1,10)/0.686615527, 31.9365902, $ 1016.76294, 18575.5742, 170208.906,2.655065246d-02, $ 1396.54407, 64829.9766, 272704.469, 405984.375/ data (xsc(43, 8,i),i=1,10)/9.092921391d-03, 1.14576757, $ 105.810783, 5955.49951, 183483.141,1.629359671d-03, $ 1102.35706, 171081.141, 1266380.25, 811327.688/ data (xsc(43, 9,i),i=1,10)/7.236727048d-03, 1.25537086, $ 138.003021, 8377.70313, 266886.938,1.248953165d-03, $ 1592.07019, 258446.125, 1929504.25, 1213104.13/ data (xsc(43,10,i),i=1,10)/0.807469964, 14.3330383, $ 186.406754, 1740.92493, 12638.6240, 9.87278652, $ 8206.63672, 91428.8672, 195055.016, 189214.219/ data (xsc(43,11,i),i=1,10)/8.067370206d-02, 3.07626271, $ 86.7981033, 1458.61951, 13531.8389, 11.2235250, $ 22794.4453, 109566.453, 395358.594, 1882568.00/ data (xsc(43,12,i),i=1,10)/0.111048825, 4.93399858, $ 151.375626, 2710.17578, 26790.3730, 18.6609764, $ 46080.8359, 257800.609, 728719.875, 3596759.75/ data (xsc(43,13,i),i=1,10)/9.261008236d-04,0.103053950, $ 8.74145603, 454.142639, 12115.5635, 370.902191, $ 161808.516, 18166836.0, 12834695.0, 8273540.00/ data (xsc(43,14,i),i=1,10)/1.214610529d-04,1.861779578d-02, $ 1.87551463, 105.118729, 2899.72070, 98.5036316, $ 38843.8516, 4626662.50, 3323490.25, 2198278.00/ data (xsc(44, 1,i),i=1,11)/ 287.872009, 6000.26904, $ 0.0000,0.0000,0.0000, 1.59923828, $ 170.411652, 1540.85437, 4937.02246, 8611.95215, 9830.63184/ data (xsc(44, 2,i),i=1,11)/ 26.8350067, 491.312775, $ 6168.32861,0.0000,0.0000, 41.0157661, $ 2302.53369, 11851.9229, 26274.7012, 37438.1367, 40693.1719/ data (xsc(44, 3,i),i=1,11)/ 3.09602880, 131.068787, $ 4337.21240, 97572.5078,0.0000, 6.99939537, $ 1396.53210, 14326.0068, 47300.6523, 82867.9531, 93226.5938/ data (xsc(44, 4,i),i=1,11)/ 4.22709703, 209.091370, $ 7540.30762, 170757.391,0.0000, 11.7136602, $ 2729.48413, 29138.4238, 98301.0000, 174310.500, 196049.469/ data (xsc(44, 5,i),i=1,10)/ 4.85759115, 87.5167999, $ 1132.91003, 10143.5400, 62980.7773,0.155831888, $ 712.178772, 15921.9951, 64010.1133, 108310.953/ data (xsc(44, 6,i),i=1,10)/0.581026495, 22.7495422, $ 650.461365, 10807.6689, 87569.0625,1.823580079d-02, $ 617.006958, 27822.9355, 114441.383, 165762.281/ data (xsc(44, 7,i),i=1,10)/0.797201991, 36.4975395, $ 1138.06311, 20246.6113, 179559.797,2.334276587d-02, $ 1236.63257, 59170.5859, 256474.516, 394525.250/ data (xsc(44, 8,i),i=1,10)/1.136720739d-02, 1.40930796, $ 127.387573, 6982.27832, 208328.328,1.303084427d-03, $ 903.103516, 146945.813, 1154545.50, 683887.500/ data (xsc(44, 9,i),i=1,10)/9.016356431d-03, 1.54062247, $ 165.916214, 9814.36816, 302962.688,9.781608824d-04, $ 1300.55066, 222252.859, 1762292.63, 1013434.63/ data (xsc(44,10,i),i=1,10)/0.910864234, 15.9583178, $ 204.765228, 1891.68176, 13675.8447, 8.82271194, $ 7577.24805, 85910.4922, 181337.719, 162904.641/ data (xsc(44,11,i),i=1,10)/9.656544775d-02, 3.61468291, $ 99.5735474, 1626.64807, 14724.5879, 9.53222752, $ 20959.3516, 105124.797, 355984.500, 1938333.38/ data (xsc(44,12,i),i=1,10)/0.131691754, 5.75846052, $ 172.905487, 3016.97754, 29205.1191, 15.6216393, $ 42190.2656, 248403.688, 657352.125, 3728875.00/ data (xsc(44,13,i),i=1,10)/1.168414718d-03,0.126144901, $ 10.3602219, 519.234192, 13235.6475, 16849.2520, $ 9683044.00, 18919170.0, 21132330.0, 22473160.0/ data (xsc(44,14,i),i=1,10)/4.559287336d-04,6.772233546d-02, $ 6.61125994, 357.740875, 9436.85938, 12039.8447, $ 6975326.00, 14523259.0, 16583439.0, 17588262.0/ data (xsc(45, 1,i),i=1,11)/ 314.038208, 6447.44287, $ 0.0000,0.0000,0.0000, 1.53989196, $ 161.669327, 1460.09253, 4677.97705, 8160.64990, 9308.90527/ data (xsc(45, 2,i),i=1,11)/ 29.3085480, 528.739258, $ 6515.34619,0.0000,0.0000, 38.0843735, $ 2156.85938, 11137.7354, 24749.6211, 35295.7461, 38326.3281/ data (xsc(45, 3,i),i=1,11)/ 3.56632352, 148.508102, $ 4819.84473,0.0000,0.0000, 6.57411432, $ 1300.56580, 13350.1484, 44139.0898, 77349.1563, 85781.7344/ data (xsc(45, 4,i),i=1,11)/ 4.82996225, 235.562592, $ 8353.98047,0.0000,0.0000, 10.8769188, $ 2535.83569, 27146.8809, 91811.0781, 162951.688, 181019.750/ data (xsc(45, 5,i),i=1,10)/ 5.35817719, 95.2024002, $ 1214.72339, 10722.4795, 65303.3828,0.143014431, $ 655.645508, 14831.9404, 60216.7891, 102613.008/ data (xsc(45, 6,i),i=1,10)/0.676429868, 26.0001163, $ 726.101990, 11706.2002, 91176.9219,1.582979597d-02, $ 554.688538, 25534.0957, 107596.227, 159663.047/ data (xsc(45, 7,i),i=1,10)/0.922076643, 41.5247650, $ 1267.58264, 21949.5234, 188445.813,2.098630182d-02, $ 1109.49890, 54388.3359, 241933.156, 381712.625/ data (xsc(45, 8,i),i=1,10)/1.410685759d-02, 1.72059906, $ 152.194992, 8114.72852, 234223.766,1.021503587d-03, $ 751.620422, 127058.289, 1049446.50, 715684.875/ data (xsc(45, 9,i),i=1,10)/1.114092674d-02, 1.87617385, $ 197.972824, 11399.3711, 340686.688,7.530418225d-04, $ 1075.53162, 191977.859, 1602119.00, 1057860.88/ data (xsc(45,10,i),i=1,10)/ 1.02415228, 17.7333393, $ 224.654068, 2052.98267, 14765.3525, 8.12298489, $ 7134.23730, 81918.4375, 174728.828, 160096.859/ data (xsc(45,11,i),i=1,10)/0.115625292, 4.24856138, $ 114.261101, 1814.72986, 16040.8086, 8.03506279, $ 19158.5625, 102679.789, 292163.031, 1562784.25/ data (xsc(45,12,i),i=1,10)/0.156398177, 6.73033333, $ 197.786179, 3364.05200, 31917.4922, 12.9800539, $ 38416.9727, 243174.047, 550757.750, 3011173.00/ data (xsc(45,13,i),i=1,10)/1.553658396d-03,0.166203409, $ 13.3680382, 647.823730, 15844.0928, 11416.7881, $ 6163891.50, 15592759.0, 15830255.0, 16222802.0/ data (xsc(45,14,i),i=1,10)/8.063389687d-04,0.118710421, $ 11.3625679, 594.924255, 15067.2021, 10823.0381, $ 5871011.50, 15941303.0, 16474088.0, 16681605.0/ data (xsc(46, 1,i),i=1,11)/ 341.820618, 6929.88525, $ 0.0000,0.0000,0.0000, 1.48557293, $ 153.623566, 1385.51062, 4438.48926, 7752.14160, 8818.31152/ data (xsc(46, 2,i),i=1,11)/ 31.9330921, 567.749390, $ 6867.76660,0.0000,0.0000, 35.6739388, $ 2025.88623, 10492.3643, 23366.0879, 33331.4141, 36074.6445/ data (xsc(46, 3,i),i=1,11)/ 4.09528351, 167.752396, $ 5341.66504,0.0000,0.0000, 6.16704893, $ 1215.63281, 12484.5205, 41325.7383, 72403.0078, 74949.1016/ data (xsc(46, 4,i),i=1,11)/ 5.50118160, 264.560547, $ 9230.24219,0.0000,0.0000, 10.1477365, $ 2365.25098, 25387.7773, 86059.5313, 152841.328, 156774.797/ data (xsc(46, 5,i),i=1,10)/ 5.89325142, 103.292404, $ 1299.56934, 11316.4756, 67682.6172,0.132441312, $ 607.180298, 13884.2705, 56833.6680, 97394.2891/ data (xsc(46, 6,i),i=1,10)/0.784810185, 29.6038456, $ 807.572998, 12640.6689, 94440.4453,1.461805869d-02, $ 505.420624, 23651.6230, 101696.453, 154143.234/ data (xsc(46, 7,i),i=1,10)/ 1.06200707, 47.0543175, $ 1406.76782, 23728.8730, 197113.906,1.815042086d-02, $ 1009.27832, 50481.5547, 229668.359, 370052.688/ data (xsc(46, 8,i),i=1,10)/1.737349667d-02, 2.08655882, $ 180.792755, 9387.08984, 262496.344,8.519665571d-04, $ 640.333557, 111922.383, 965541.938, 597959.000/ data (xsc(46, 9,i),i=1,10)/1.368676871d-02, 2.27084923, $ 234.873932, 13178.5693, 381904.469,6.217189366d-04, $ 911.242188, 169021.984, 1475317.50, 876121.938/ data (xsc(46,10,i),i=1,10)/ 1.14679289, 19.5808277, $ 244.713272, 2213.70801, 15841.3955, 7.48869276, $ 6840.04199, 78827.8672, 166242.125, 137745.578/ data (xsc(46,11,i),i=1,10)/0.136756092, 4.93306541, $ 129.562637, 2002.11621, 17290.6992, 7.61036730, $ 18528.8125, 100141.703, 282794.250, 1683916.13/ data (xsc(46,12,i),i=1,10)/0.183273137, 7.76306963, $ 223.361755, 3706.39746, 34494.4453, 12.1436052, $ 37082.0391, 238696.328, 533498.500, 3273070.25/ data (xsc(46,13,i),i=1,10)/1.931572333d-03,0.200469404, $ 15.6423988, 734.317932, 17329.5137, 1353.56152, $ 96767.9688, 11283164.0, 9874705.00, 7802603.50/ data (xsc(46,14,i),i=1,10)/1.495557954d-03,0.212519825, $ 19.7038517, 999.829834, 24445.3828, 2400.72192, $ 231654.063, 17024572.0, 16258404.0, 13481004.0/ data (xsc(47, 1,i),i=1,11)/ 371.173615, 7404.35596, $ 0.0000,0.0000,0.0000, 1.43481195, $ 146.067505, 1315.53430, 4213.75439, 7359.54688, 8367.52930/ data (xsc(47, 2,i),i=1,11)/ 34.7085419, 608.202698, $ 7222.55518,0.0000,0.0000, 33.4021225, $ 1901.80884, 9878.91504, 22047.4551, 31481.4609, 34134.9883/ data (xsc(47, 3,i),i=1,11)/ 4.68518305, 188.830048, $ 5899.13672,0.0000,0.0000, 5.80971479, $ 1135.11755, 11660.7373, 38641.9258, 67712.7969, 72616.8516/ data (xsc(47, 4,i),i=1,11)/ 6.24195051, 296.090698, $ 10163.7803,0.0000,0.0000, 9.39600563, $ 2202.82422, 23704.5723, 80536.8672, 143151.406, 152821.203/ data (xsc(47, 5,i),i=1,10)/ 6.46324205, 111.762505, $ 1386.70471, 11912.9297, 69822.0469,0.121659912, $ 557.751953, 12907.9512, 53366.1133, 92075.2422/ data (xsc(47, 6,i),i=1,10)/0.906831205, 33.5687065, $ 894.524719, 13595.2197, 97441.9141,1.328355819d-02, $ 453.930481, 21669.6406, 95233.3359, 146965.922/ data (xsc(47, 7,i),i=1,10)/ 1.21800828, 53.0988960, $ 1554.82153, 25551.3164, 205387.109,1.623871364d-02, $ 905.297241, 46351.3789, 215771.313, 354873.563/ data (xsc(47, 8,i),i=1,10)/2.127772756d-02, 2.51450348, $ 213.351471, 10782.4453, 292004.375,6.910418742d-04, $ 531.765259, 96376.8438, 867885.375, 780110.813/ data (xsc(47, 9,i),i=1,10)/1.668929122d-02, 2.72970104, $ 276.806854, 15126.2559, 424861.844,5.021790857d-04, $ 752.546265, 145539.859, 1326624.63, 1146642.13/ data (xsc(47,10,i),i=1,10)/ 1.27912045, 21.5915146, $ 266.562805, 2387.33960, 16980.1543, 6.52393007, $ 6185.69434, 73095.4531, 159421.859, 149676.469/ data (xsc(47,11,i),i=1,10)/0.161787838, 5.73900700, $ 147.378464, 2218.76978, 18746.2285, 4.71469355, $ 14223.8457, 92560.6094, 182653.781, 980771.875/ data (xsc(47,12,i),i=1,10)/0.215594113, 8.98779106, $ 253.145477, 4098.16504, 37397.2734, 10.5392103, $ 34347.0938, 236129.094, 444850.438, 2185658.00/ data (xsc(47,13,i),i=1,10)/2.605415648d-03,0.273270607, $ 21.0784111, 955.892883, 21619.0410, 7536.34375, $ 3400273.50, 11635234.0, 10617845.0, 10882367.0/ data (xsc(47,14,i),i=1,10)/2.015347360d-03,0.291224808, $ 26.7979927, 1314.85693, 30838.3770, 10630.3838, $ 4795128.50, 17853854.0, 16372035.0, 16260426.0/ data (xsc(48, 1,i),i=1,11)/ 402.193146,0.0000, $ 0.0000,0.0000,0.0000, 1.38744187, $ 139.001984, 1250.03833, 4003.46631, 6993.01221, 7938.74268/ data (xsc(48, 2,i),i=1,11)/ 37.6538239, 650.309753, $ 7583.02881,0.0000,0.0000, 31.2527809, $ 1783.91858, 9296.45605, 20793.3301, 29788.5117, 32232.9414/ data (xsc(48, 3,i),i=1,11)/ 5.34350967, 211.952164, $ 6498.77979,0.0000,0.0000, 5.47050619, $ 1059.40247, 10888.5313, 36130.9141, 63333.4414, 70256.5078/ data (xsc(48, 4,i),i=1,11)/ 7.06004715, 330.427429, $ 11165.3760,0.0000,0.0000, 8.73649120, $ 2050.06909, 22124.5645, 75358.7734, 134077.578, 148945.016/ data (xsc(48, 5,i),i=1,10)/ 7.07008743, 120.648285, $ 1476.84485, 12524.2734, 71821.1172,0.111077316, $ 508.901367, 11937.0459, 49828.3125, 87278.6406/ data (xsc(48, 6,i),i=1,10)/ 1.04392672, 37.9316368, $ 987.710999, 14587.1270, 100177.531,1.194320992d-02, $ 403.858978, 19719.7754, 88850.4609, 138626.625/ data (xsc(48, 7,i),i=1,10)/ 1.39177334, 59.7120972, $ 1713.33618, 27461.4473, 213595.250,1.433763001d-02, $ 801.577026, 42172.6875, 201692.719, 335675.688/ data (xsc(48, 8,i),i=1,10)/2.590886690d-02, 3.01359344, $ 250.567963, 12343.2217, 324396.969,5.484857247d-04, $ 432.801788, 81782.9531, 773230.188, 1046752.13/ data (xsc(48, 9,i),i=1,10)/2.025088482d-02, 3.26425838, $ 324.690765, 17305.2656, 472220.563,3.991335398d-04, $ 607.127319, 123268.711, 1181358.50, 1555562.88/ data (xsc(48,10,i),i=1,10)/ 1.42603564, 23.7744255, $ 289.901031, 2572.53320, 18192.9414, 5.35037184, $ 5335.19873, 65342.0234, 151706.297, 158377.469/ data (xsc(48,11,i),i=1,10)/0.190790504, 6.65182829, $ 166.873779, 2444.54761, 20169.2598, 4.45543766, $ 13676.0293, 92448.1406, 160554.719, 692735.563/ data (xsc(48,12,i),i=1,10)/0.252439588, 10.3763657, $ 286.513611, 4532.94678, 40641.7773, 6.85289192, $ 27041.0039, 218305.156, 345191.938, 1344777.13/ data (xsc(48,13,i),i=1,10)/3.445164068d-03,0.363392204, $ 27.6695786, 1215.86316, 26505.5605, 395.825348, $ 203484.531, 14914517.0, 6239630.00, 4870765.50/ data (xsc(48,14,i),i=1,10)/2.669762820d-03,0.388387829, $ 35.3342743, 1681.05505, 38035.3438, 537.642273, $ 312976.813, 22128590.0, 9579849.00, 7131414.00/ data (xsc(49, 1,i),i=1,11)/ 434.917938,0.0000, $ 0.0000,0.0000,0.0000, 1.34354222, $ 132.399948, 1188.87671, 3806.95923, 6656.97412, 7536.04053/ data (xsc(49, 2,i),i=1,11)/ 40.7497978, 693.810486, $ 7944.25537,0.0000,0.0000, 29.2774467, $ 1675.00842, 8755.65527, 19626.1855, 28158.8555, 30508.5703/ data (xsc(49, 3,i),i=1,11)/ 6.07568169, 237.183563, $ 7137.36230,0.0000,0.0000, 5.16041517, $ 989.900635, 10175.6943, 33801.3555, 59266.4219, 68483.8516/ data (xsc(49, 4,i),i=1,11)/ 7.96010685, 367.610535, $ 12227.7061,0.0000,0.0000, 8.13598537, $ 1910.12476, 20666.8047, 70551.6797, 125639.133, 145913.063/ data (xsc(49, 5,i),i=1,10)/ 7.71465921, 129.926773, $ 1569.21802, 13137.7842, 73556.2500,0.101870246, $ 464.898895, 11044.6797, 46562.8008, 82384.8047/ data (xsc(49, 6,i),i=1,10)/ 1.19739389, 42.7072029, $ 1086.68335, 15595.6992, 102573.328,1.075263787d-02, $ 359.387512, 17930.0918, 82653.3672, 131364.328/ data (xsc(49, 7,i),i=1,10)/ 1.58443534, 66.9061966, $ 1881.25659, 29413.6855, 221525.250,1.272562053d-02, $ 710.295349, 38356.5313, 188043.344, 317844.719/ data (xsc(49, 8,i),i=1,10)/3.134656325d-02, 3.59037566, $ 292.593079, 14046.4658, 358032.625,4.392093979d-04, $ 353.923401, 69448.6328, 684298.938, 1362901.38/ data (xsc(49, 9,i),i=1,10)/2.443429269d-02, 3.88134480, $ 378.674194, 19679.1719, 521345.250,3.238790378d-04, $ 492.438324, 104545.422, 1045670.75, 2049506.75/ data (xsc(49,10,i),i=1,10)/ 1.58318138, 26.0998497, $ 314.572235, 2766.40479, 19425.8887, 4.18845844, $ 4565.28613, 58088.5039, 144032.813, 158709.734/ data (xsc(49,11,i),i=1,10)/0.224245504, 7.68499517, $ 188.437393, 2689.43237, 21684.5605, 3.29573870, $ 11402.6494, 87467.1563, 132859.359, 445682.750/ data (xsc(49,12,i),i=1,10)/0.294052601, 11.9301281, $ 323.080231, 4995.24609, 43961.3984, 4.95171165, $ 22385.4727, 204827.625, 312471.688, 859850.188/ data (xsc(49,13,i),i=1,10)/4.493633285d-03,0.474454135, $ 35.5743599, 1514.22400, 31812.9629, 71.5568008, $ 237794.953, 6435903.50, 6812904.50, 3388422.75/ data (xsc(49,14,i),i=1,10)/3.482840722d-03,0.507674456, $ 45.5484734, 2100.52588, 45842.3477, 93.4430008, $ 355699.750, 9263124.00, 10435674.0, 5075456.00/ data (xsc(50, 1,i),i=1,11)/ 469.335571,0.0000, $ 0.0000,0.0000,0.0000, 1.30278218, $ 126.259201, 1131.63745, 3622.84937, 6329.84863, 7176.64746/ data (xsc(50, 2,i),i=1,11)/ 44.0108719, 738.826843, $ 8308.22559,0.0000,0.0000, 27.4632511, $ 1574.34033, 8254.03809, 18540.6504, 26645.5977, 28882.5742/ data (xsc(50, 3,i),i=1,11)/ 6.88818979, 264.686493, $ 7817.49707,0.0000,0.0000, 4.87964249, $ 926.749756, 9525.74512, 31670.9961, 55551.7070, 64946.3008/ data (xsc(50, 4,i),i=1,11)/ 8.94866943, 407.852692, $ 13358.3125,0.0000,0.0000, 7.59024191, $ 1782.53491, 19333.6797, 66145.1328, 117902.984, 138816.156/ data (xsc(50, 5,i),i=1,10)/ 8.39794064, 139.619003, $ 1664.24524, 13759.5059, 75257.2188,9.384955466d-02, $ 425.282135, 10229.7158, 43525.3945, 77673.8906/ data (xsc(50, 6,i),i=1,10)/ 1.36876702, 47.9281425, $ 1191.89270, 16629.6406, 104684.820,9.724338539d-03, $ 320.816071, 16334.0898, 76944.7344, 124711.328/ data (xsc(50, 7,i),i=1,10)/ 1.79763031, 74.7222824, $ 2059.40894, 31429.9531, 228986.734,1.139104739d-02, $ 631.474609, 34957.1680, 175520.609, 302964.813/ data (xsc(50, 8,i),i=1,10)/3.776062652d-02, 4.25705576, $ 340.030151, 15916.9688, 393437.000,3.568842076d-04, $ 292.079224, 59357.5664, 608254.313, 1563263.00/ data (xsc(50, 9,i),i=1,10)/2.930581942d-02, 4.59071922, $ 439.543304, 22287.4023, 573262.688,2.687954111d-04, $ 402.348206, 89147.5625, 928811.188, 2384795.75/ data (xsc(50,10,i),i=1,10)/ 1.75388730, 28.5942535, $ 340.728271, 2970.66602, 20701.3730, 3.48241735, $ 3979.11450, 52240.3828, 135489.859, 154490.063/ data (xsc(50,11,i),i=1,10)/0.262702942, 8.84935951, $ 212.117020, 2951.28784, 23259.3906, 2.44925475, $ 9630.53125, 82213.8906, 119546.063, 314798.563/ data (xsc(50,12,i),i=1,10)/0.342183888, 13.6839066, $ 363.285828, 5493.02246, 47471.6484, 3.59649491, $ 18782.8730, 191162.406, 299461.094, 616534.125/ data (xsc(50,13,i),i=1,10)/5.804231856d-03,0.608823895, $ 44.7936058, 1847.76965, 37422.2109, 21.2291412, $ 173031.516, 872345.125, 11045122.0, 2410028.00/ data (xsc(50,14,i),i=1,10)/4.492963664d-03,0.651289523, $ 57.4127159, 2567.69458, 54067.1875, 26.5790653, $ 256064.547, 1202452.63, 16681656.0, 3680548.50/ data (xsc(51, 1,i),i=1,11)/ 505.496216,0.0000, $ 0.0000,0.0000,0.0000, 1.26502931, $ 120.533768, 1078.21399, 3450.94507, 6030.91211, 6829.84473/ data (xsc(51, 2,i),i=1,11)/ 47.4398270, 785.260803, $ 8672.91797,0.0000,0.0000, 25.6544991, $ 1482.06189, 7791.75391, 17536.1699, 25232.7207, 27353.8516/ data (xsc(51, 3,i),i=1,11)/ 7.78759003, 294.564087, $ 8538.69238,0.0000,0.0000, 4.62826967, $ 869.748779, 8935.69824, 29728.7031, 52155.4648, 61254.6172/ data (xsc(51, 4,i),i=1,11)/ 10.0333748, 451.272095, $ 14553.6240,0.0000,0.0000, 7.10404396, $ 1667.56592, 18124.2422, 62121.6719, 110940.953, 131077.984/ data (xsc(51, 5,i),i=1,10)/ 9.12128925, 149.717255, $ 1761.59387, 14384.0293, 76311.1875,8.717016876d-02, $ 390.636078, 9503.69238, 40772.2461, 73333.0547/ data (xsc(51, 6,i),i=1,10)/ 1.55957532, 53.6119347, $ 1303.03162, 17677.0840, 106432.773,8.890544064d-03, $ 288.707092, 14956.6553, 71811.6797, 118304.641/ data (xsc(51, 7,i),i=1,10)/ 2.03267574, 83.1816788, $ 2247.32642, 33490.4336, 236239.328,1.033644192d-02, $ 565.778931, 32018.3027, 164208.984, 288257.781/ data (xsc(51, 8,i),i=1,10)/4.525857046d-02, 5.02239656, $ 393.184570, 17949.7637, 429912.750,2.794173197d-04, $ 244.952682, 51304.2305, 542743.000, 1568719.38/ data (xsc(51, 9,i),i=1,10)/3.499866277d-02, 5.40406275, $ 507.655334, 25119.6133, 626949.313,2.189208753d-04, $ 334.194427, 76887.9844, 828476.313, 2417228.50/ data (xsc(51,10,i),i=1,10)/ 1.94081104, 31.2639618, $ 368.240997, 3183.97900, 22000.8223, 2.83087897, $ 3493.35181, 47218.6758, 127794.977, 150779.203/ data (xsc(51,11,i),i=1,10)/0.306472033, 10.1463585, $ 237.725143, 3225.05713, 24828.2930, 2.04246855, $ 8548.25391, 78516.2891, 115483.641, 241015.188/ data (xsc(51,12,i),i=1,10)/0.397216707, 15.6378651, $ 406.766937, 6016.44824, 51029.2969, 2.94445682, $ 16596.7090, 181993.641, 300497.594, 492359.344/ data (xsc(51,13,i),i=1,10)/7.412088104d-03,0.769712508, $ 55.4780731, 2218.22095, 43305.5313, 9.27482128, $ 126239.773, 148987.328, 18163230.0, 1913123.50/ data (xsc(51,14,i),i=1,10)/5.726999138d-03,0.822774887, $ 71.1408691, 3086.07959, 62696.1250, 11.1955481, $ 185709.500, 206236.031, 26991814.0, 2937263.50/ data (xsc(52, 1,i),i=1,11)/ 543.457947,0.0000, $ 0.0000,0.0000,0.0000, 1.23006237, $ 115.191147, 1028.25171, 3290.14868, 5755.02539, 6500.19238/ data (xsc(52, 2,i),i=1,11)/ 51.0387535, 833.152344, $ 9037.26660,0.0000,0.0000, 24.1354580, $ 1396.82263, 7363.05762, 16601.8809, 23920.1660, 25938.9570/ data (xsc(52, 3,i),i=1,11)/ 8.78302097, 327.007843, $ 9303.80078,0.0000,0.0000, 4.37503052, $ 817.693420, 8395.02051, 27941.9473, 49081.9805, 57618.5156/ data (xsc(52, 4,i),i=1,11)/ 11.2163792, 498.023865, $ 15818.6797,0.0000,0.0000, 6.65949011, $ 1562.56665, 17016.8184, 58433.0078, 104470.789, 123283.906/ data (xsc(52, 5,i),i=1,11)/ 9.88542557, 160.228302, $ 1861.38550, 15013.1504,0.0000, 268.347015, $ 7620.71045, 29398.8750, 55816.5430, 72969.3047, 78514.3203/ data (xsc(52, 6,i),i=1,10)/ 1.77139270, 59.7895050, $ 1420.43896, 18742.4453, 107931.641,8.181498386d-03, $ 260.860443, 13730.5879, 67091.4219, 112186.773/ data (xsc(52, 7,i),i=1,10)/ 2.29133701, 92.3204727, $ 2445.53735, 35605.1328, 243246.750,9.464330040d-03, $ 509.012604, 29406.4902, 153818.844, 274294.938/ data (xsc(52, 8,i),i=1,10)/5.395657942d-02, 5.89682484, $ 452.654053, 20165.2617, 467900.031,2.316953905d-04, $ 207.141403, 44610.1406, 485886.938, 1451067.88/ data (xsc(52, 9,i),i=1,10)/4.160211980d-02, 6.33225298, $ 583.754639, 28203.6348, 682898.125,1.897431648d-04, $ 279.897980, 66722.4688, 741277.250, 2247015.25/ data (xsc(52,10,i),i=1,10)/ 2.13859034, 34.0773811, $ 397.046326, 3406.03345, 23322.0332, 2.39971447, $ 3090.32886, 42859.1563, 120638.492, 147175.891/ data (xsc(52,11,i),i=1,10)/0.356053442, 11.5856295, $ 265.413971, 3513.79102, 26433.5625, 1.61186409, $ 7437.31689, 73759.3594, 112976.242, 191477.125/ data (xsc(52,12,i),i=1,10)/0.458347231, 17.7873383, $ 453.762604, 6571.93799, 54741.0703, 2.26832080, $ 14359.0488, 170265.156, 300900.313, 417148.813/ data (xsc(52,13,i),i=1,10)/9.369441308d-03,0.960885108, $ 67.7794189, 2628.51807, 49492.0039, 4.53558826, $ 91436.6875, 153573.922, 16884066.0, 1665414.50/ data (xsc(52,14,i),i=1,10)/7.222595625d-03, 1.02602172, $ 86.9253845, 3659.91162, 71778.8203, 5.26037979, $ 133817.531, 240597.859, 24838258.0, 2550610.75/ data (xsc(53, 1,i),i=1,11)/ 583.245239,0.0000, $ 0.0000,0.0000,0.0000, 1.19740903, $ 110.184814, 981.340576, 3138.84619, 5488.67529, 6199.58057/ data (xsc(53, 2,i),i=1,11)/ 54.8252258, 882.531311, $ 9402.86230,0.0000,0.0000, 22.7374363, $ 1317.67639, 6963.47266, 15728.3428, 22737.3457, 24558.4648/ data (xsc(53, 3,i),i=1,11)/ 9.87876797, 362.167480, $ 10115.4580,0.0000,0.0000, 4.16131210, $ 769.584045, 7895.64453, 26293.9961, 46208.0469, 54148.6484/ data (xsc(53, 4,i),i=1,11)/ 12.5069389, 548.316711, $ 17158.7988,0.0000,0.0000, 6.21549034, $ 1465.90515, 15995.8418, 55028.0117, 98476.6797, 116015.422/ data (xsc(53, 5,i),i=1,11)/ 10.6919308, 171.167542, $ 1963.88062, 15650.5244,0.0000, 246.685699, $ 7083.80664, 27512.1523, 52495.8242, 68880.9609, 74222.1406/ data (xsc(53, 6,i),i=1,10)/ 2.00614882, 66.4919968, $ 1544.36499, 19827.3535, 108353.477,7.553438190d-03, $ 236.124390, 12618.8340, 62695.4531, 106305.945/ data (xsc(53, 7,i),i=1,10)/ 2.57510161, 102.176842, $ 2654.61157, 37784.0742, 250097.375,8.723785169d-03, $ 458.359650, 27024.2891, 144081.719, 260777.641/ data (xsc(53, 8,i),i=1,10)/6.408919394d-02, 6.89599848, $ 519.143921, 22592.1602, 509126.281,1.929337450d-04, $ 175.291458, 38821.3633, 435245.531, 1298463.13/ data (xsc(53, 9,i),i=1,10)/4.922960699d-02, 7.38825369, $ 668.624268, 31571.2012, 743100.750,1.664647862d-04, $ 235.063843, 58034.3086, 664276.000, 2012410.00/ data (xsc(53,10,i),i=1,10)/ 2.35337949, 37.0662956, $ 427.166504, 3637.14014, 24670.3906, 2.03494740, $ 2725.11133, 38797.4688, 113233.711, 142574.188/ data (xsc(53,11,i),i=1,10)/0.412523240, 13.1800241, $ 295.146637, 3815.27075, 28041.0430, 1.32522774, $ 6511.53564, 69118.1094, 111560.750, 161005.781/ data (xsc(53,12,i),i=1,10)/0.526673079, 20.1478863, $ 504.201324, 7155.66553, 58536.1875, 1.81927359, $ 12502.0205, 159002.281, 301011.219, 377583.531/ data (xsc(53,13,i),i=1,10)/1.171184145d-02, 1.18566418, $ 81.8601913, 3081.73657, 56009.5430, 2.33227348, $ 65372.1094, 245734.016, 7527104.50, 1628419.25/ data (xsc(53,14,i),i=1,10)/9.003613144d-03, 1.26440704, $ 104.971863, 4293.61768, 81361.2031, 2.58736515, $ 95179.1016, 385469.375, 10990779.0, 2475894.75/ data (xsc(54, 1,i),i=1,11)/ 624.902771,0.0000, $ 0.0000,0.0000,0.0000, 1.16669405, $ 105.467674, 937.121216, 2996.29761, 5237.44922, 5917.15186/ data (xsc(54, 2,i),i=1,11)/ 58.7911682, 933.676514, $ 9777.10059,0.0000,0.0000, 21.3622379, $ 1240.57385, 6577.08008, 14887.8174, 21553.1895, 23289.6211/ data (xsc(54, 3,i),i=1,11)/ 11.0863647, 400.323730, $ 10981.6182,0.0000,0.0000, 3.95615411, $ 724.057129, 7425.85840, 24750.0664, 43523.0820, 50915.9023/ data (xsc(54, 4,i),i=1,11)/ 13.9128065, 602.490906, $ 18586.5664,0.0000,0.0000, 5.82589436, $ 1374.63269, 15035.8057, 51837.3047, 92885.4141, 109281.883/ data (xsc(54, 5,i),i=1,11)/ 11.5422506, 182.560226, $ 2069.69287, 16305.2402,0.0000, 225.554062, $ 6558.44336, 25666.5449, 49240.8281, 64829.4492, 69698.6953/ data (xsc(54, 6,i),i=1,10)/ 2.26599121, 73.7758789, $ 1676.35754, 20961.6934, 125156.141,6.453159265d-03, $ 211.357910, 11509.1846, 58277.1328, 100207.680/ data (xsc(54, 7,i),i=1,10)/ 2.88628817, 112.821999, $ 2876.83911, 40080.6445, 254936.969,8.000156842d-03, $ 408.548584, 24666.2402, 134316.453, 246848.984/ data (xsc(54, 8,i),i=1,10)/7.581371069d-02, 8.03451633, $ 593.645935, 25286.0742, 554710.313,1.593173656d-04, $ 146.911163, 33567.6992, 388215.625, 1148923.00/ data (xsc(54, 9,i),i=1,10)/5.801723897d-02, 8.58840179, $ 763.666443, 35315.5352, 810876.438,1.457292674d-04, $ 194.779999, 50045.7188, 592061.188, 1774536.25/ data (xsc(54,10,i),i=1,10)/ 2.58266187, 40.2186584, $ 458.666656, 3879.22339, 26078.4570, 1.62305725, $ 2361.20264, 34653.8359, 104898.953, 136050.734/ data (xsc(54,11,i),i=1,10)/0.475486934, 14.9392967, $ 327.582428, 4144.67236, 29800.2109,0.845944464, $ 4936.92480, 59695.6836, 104645.664, 133242.016/ data (xsc(54,12,i),i=1,10)/0.603808820, 22.7610054, $ 559.287720, 7799.18701, 62819.4063, 1.11512387, $ 9363.07715, 135641.188, 282984.938, 336481.969/ data (xsc(54,13,i),i=1,10)/1.452930365d-02, 1.44994819, $ 97.9827118, 3587.86743, 63078.9258, 1.02980137, $ 41673.0234, 314019.625, 2160809.75, 2001500.50/ data (xsc(54,14,i),i=1,10)/1.111309417d-02, 1.54286444, $ 125.607826, 5001.27832, 91777.6953, 1.07193601, $ 60255.1250, 485718.219, 3088150.00, 2997721.00/ data (xsc(55, 1,i),i=1,11)/ 668.320923,0.0000, $ 0.0000,0.0000,0.0000, 1.13831234, $ 101.049385, 895.576660, 2862.36206, 5007.01465, 5643.01758/ data (xsc(55, 2,i),i=1,11)/ 62.9148407, 985.461731, $ 10133.5908,0.0000,0.0000, 20.2039261, $ 1173.67969, 6234.69531, 14131.9902, 20480.4668, 22111.2813/ data (xsc(55, 3,i),i=1,11)/ 12.4088593, 441.206024, $ 11877.7227,0.0000,0.0000, 3.77663493, $ 683.332703, 6998.48926, 23326.7520, 41032.0469, 48133.7227/ data (xsc(55, 4,i),i=1,11)/ 15.4399595, 660.235291, $ 20066.7324,0.0000,0.0000, 5.47628450, $ 1291.51416, 14149.7021, 48858.8516, 87793.4297, 103287.031/ data (xsc(55, 5,i),i=1,11)/ 12.4345665, 194.303421, $ 2176.17163, 16932.8340,0.0000, 207.813293, $ 6103.18750, 24027.2090, 46306.1641, 61175.3398, 66349.1484/ data (xsc(55, 6,i),i=1,11)/ 2.55166268, 81.5791855, $ 1811.97534, 22041.3555,0.0000, 132.541412, $ 8887.50684, 41439.9219, 78768.7188, 99256.2813, 116908.328/ data (xsc(55, 7,i),i=1,10)/ 3.22512913, 124.162460, $ 3105.34570, 42307.8672, 286714.625,7.030848414d-03, $ 369.943176, 22729.1934, 125855.672, 234657.953/ data (xsc(55, 8,i),i=1,10)/8.929523826d-02, 9.31651497, $ 674.936401, 28080.4043, 598648.063,1.352251275d-04, $ 125.515762, 29354.1777, 347528.063, 1013736.50/ data (xsc(55, 9,i),i=1,10)/6.807342172d-02, 9.93690300, $ 867.317322, 39209.3945, 875926.188,1.313709508d-04, $ 164.260330, 43590.1602, 529143.375, 1566129.13/ data (xsc(55,10,i),i=1,10)/ 2.82313156, 43.5039444, $ 491.150970, 4124.45654, 27439.4531, 1.35660052, $ 2063.27148, 31075.7227, 96953.8828, 136826.000/ data (xsc(55,11,i),i=1,10)/0.545892358, 16.8631973, $ 362.008423, 4482.41504, 31513.4902,0.584037483, $ 3832.93018, 51790.2969, 99812.5313, 119684.563/ data (xsc(55,12,i),i=1,10)/0.688148081, 25.5704937, $ 616.470398, 8429.50781, 66677.3281,0.917055428, $ 8224.60254, 126086.664, 282213.500, 341443.250/ data (xsc(55,13,i),i=1,10)/1.783043146d-02, 1.75544798, $ 116.101906, 4130.71094, 70102.7969,0.542041779, $ 28382.6523, 333746.094, 509263.906, 33172810.0/ data (xsc(55,14,i),i=1,10)/1.359604299d-02, 1.86466908, $ 148.681335, 5751.55957, 101874.367,0.606637239, $ 43811.2578, 516660.094, 794425.000, 40387076.0/ data (xsc(55,15,i),i=1,10)/0.472456068, 6.95320225, $ 76.9159241, 654.311829, 4590.27783, 56.5033722, $ 17553.1426, 113058.570, 88327.1797, 39314.4805/ data (xsc(55,16,i),i=1,10)/7.315488160d-02, 2.10896921, $ 43.6368027, 542.001160, 4002.73047, 117.951195, $ 22826.1758, 299502.938, 6245063.50, 34782560.0/ data (xsc(55,17,i),i=1,10)/8.944954723d-02, 3.08562970, $ 71.4837799, 977.464233, 8012.70508, 281.478271, $ 62977.6602, 667453.938, 14187204.0, 75207264.0/ data (xsc(56, 1,i),i=1,11)/ 713.582458,0.0000, $ 0.0000,0.0000,0.0000, 1.11179888, $ 96.9028397, 856.469177, 2735.89893, 4783.97607, 5391.82031/ data (xsc(56, 2,i),i=1,11)/ 67.2285004, 1038.76208, $ 10493.1992,0.0000,0.0000, 19.0881329, $ 1109.38501, 5906.62012, 13409.1484, 19454.8555, 20960.9531/ data (xsc(56, 3,i),i=1,11)/ 13.8606262, 485.220032, $ 12817.0371,0.0000,0.0000, 3.61123204, $ 645.642761, 6601.72070, 22001.8965, 38780.4063, 45369.6211/ data (xsc(56, 4,i),i=1,11)/ 17.0906467, 721.810120, $ 21613.8535,0.0000,0.0000, 5.15737438, $ 1215.44312, 13334.3994, 46105.3984, 82941.5078, 97501.9453/ data (xsc(56, 5,i),i=1,11)/ 13.3712473, 206.457520, $ 2284.67334, 17555.6973,0.0000, 191.704315, $ 5684.00342, 22503.7188, 43555.9180, 57755.9063, 62266.0430/ data (xsc(56, 6,i),i=1,11)/ 2.86609626, 89.9967422, $ 1954.58813, 23138.7617,0.0000, 120.214737, $ 8159.10010, 38513.3047, 74012.3203, 93928.9297, 108998.781/ data (xsc(56, 7,i),i=1,11)/ 3.59444380, 136.313110, $ 3344.86377, 44585.9531,0.0000, 227.145859, $ 17394.1035, 87520.2578, 177928.750, 235298.797, 271842.844/ data (xsc(56, 8,i),i=1,10)/0.104761206, 10.7616501, $ 764.411133, 31069.1133, 644373.125,1.156260405d-04, $ 107.815460, 25759.6895, 311501.281, 900985.125/ data (xsc(56, 9,i),i=1,10)/7.956307381d-02, 11.4523907, $ 981.137512, 43359.9141, 943255.750,1.209549810d-04, $ 139.529465, 38155.8359, 473915.219, 1389455.50/ data (xsc(56,10,i),i=1,10)/ 3.08263111, 46.9716301, $ 524.796814, 4374.58398, 28774.8438, 1.17016554, $ 1838.27747, 28246.3711, 90572.1094, 129712.180/ data (xsc(56,11,i),i=1,10)/0.625213265, 18.9666653, $ 398.201202, 4820.63867, 33107.3359,0.478750050, $ 3297.26660, 47314.3828, 97749.9844, 109830.711/ data (xsc(56,12,i),i=1,10)/0.781740725, 28.6364632, $ 677.618713, 9093.28320, 70677.2500,0.729823232, $ 7054.22217, 115113.430, 276223.219, 328282.125/ data (xsc(56,13,i),i=1,10)/2.173442580d-02, 2.10992384, $ 136.500305, 4715.90088, 77176.7109,0.333374560, $ 21233.9199, 328205.063, 191381.984, 5116668.00/ data (xsc(56,14,i),i=1,10)/1.655145921d-02, 2.23914099, $ 174.731979, 6567.91357, 112285.172,0.355158508, $ 32598.8613, 509330.250, 286083.969, 8133637.00/ data (xsc(56,15,i),i=1,10)/0.551031470, 8.08315945, $ 88.9186935, 753.340576, 5275.69482, 20.1813545, $ 8736.69629, 76697.9141, 119734.805, 46879.7344/ data (xsc(56,16,i),i=1,10)/9.369242191d-02, 2.68614078, $ 54.6888275, 664.928711, 4825.64844, 82.7137222, $ 21627.6367, 176767.813, 2802744.50, 14046967.0/ data (xsc(56,17,i),i=1,10)/0.115231708, 3.96815205, $ 90.7736359, 1219.17761, 9861.18945, 193.207626, $ 59549.1172, 412173.219, 5905087.50, 30859814.0/ data (xsc(57, 1,i),i=1,11)/ 760.622742,0.0000, $ 0.0000,0.0000,0.0000, 1.08746529, $ 93.0395203, 819.900757, 2617.47217, 4574.85010, 5157.28516/ data (xsc(57, 2,i),i=1,11)/ 71.7344208, 1093.24158, $ 10849.6484,0.0000,0.0000, 18.1027164, $ 1051.47766, 5608.29297, 12748.2500, 18545.5527, 19904.3516/ data (xsc(57, 3,i),i=1,11)/ 15.4446859, 532.367676, $ 13792.8945,0.0000,0.0000, 3.46828914, $ 612.457642, 6248.75586, 20814.9590, 36688.3828, 41857.4805/ data (xsc(57, 4,i),i=1,11)/ 18.8738060, 787.280396, $ 23222.7852,0.0000,0.0000, 4.88159323, $ 1148.77698, 12612.4453, 43647.6953, 78571.0156, 89963.6719/ data (xsc(57, 5,i),i=1,11)/ 14.3574810, 218.963730, $ 2393.10010, 18141.1133,0.0000, 180.240738, $ 5369.84570, 21318.6699, 41354.8047, 55034.1289, 58846.9102/ data (xsc(57, 6,i),i=1,11)/ 3.21070743, 99.0047684, $ 2101.86963, 24202.1484,0.0000, 111.235100, $ 7595.96582, 36149.2617, 70033.2422, 89405.4063, 104330.344/ data (xsc(57, 7,i),i=1,11)/ 3.99530911, 149.249466, $ 3592.67651, 46846.2500,0.0000, 208.944336, $ 16194.5527, 82332.9766, 168956.438, 224955.078, 259557.609/ data (xsc(57, 8,i),i=1,10)/0.122428671, 12.3795862, $ 861.627136, 34171.8516, 689897.938,1.033526787d-04, $ 95.9333115, 23207.3984, 284373.250, 819914.250/ data (xsc(57, 9,i),i=1,10)/9.262146056d-02, 13.1446447, $ 1104.64941, 47668.8398, 1009631.00,1.158792584d-04, $ 122.895706, 34300.3750, 432385.813, 1263590.63/ data (xsc(57,10,i),i=1,10)/ 3.35369444, 50.5715675, $ 559.346008, 4626.12598, 30044.0469, 1.07607150, $ 1714.85522, 26598.2578, 86576.2031, 125810.188/ data (xsc(57,11,i),i=1,10)/0.712526858, 21.2413349, $ 436.218292, 5161.81543, 34613.3047,0.422868967, $ 3052.04541, 45007.6914, 97081.1250, 109125.227/ data (xsc(57,12,i),i=1,10)/0.885864735, 31.9587975, $ 741.741638, 9764.77148, 74519.5469,0.670626879, $ 6612.56006, 110712.016, 276993.594, 337661.438/ data (xsc(57,13,i),i=1,10)/2.634496614d-02, 2.51742959, $ 159.058853, 5327.98145, 83920.8281,0.305604696, $ 19869.7539, 330691.094, 173071.016, 1769126.13/ data (xsc(57,14,i),i=1,10)/1.999914832d-02, 2.66824508, $ 203.687515, 7435.59229, 122600.813,0.280723274, $ 28343.6602, 502299.375, 256709.563, 2599748.00/ data (xsc(57,15,i),i=1,10)/0.634120166, 9.22574329, $ 100.573242, 845.609009, 5863.55518, 34.9373627, $ 13069.1367, 102413.617, 145775.375, 82583.2813/ data (xsc(57,16,i),i=1,10)/0.115328141, 3.26670742, $ 65.2264099, 776.051514, 5532.49072, 138.578018, $ 28625.2891, 268284.125, 3371859.00, 11701498.0/ data (xsc(57,17,i),i=1,10)/0.141208023, 4.82152081, $ 108.560730, 1432.34155, 11431.7119, 237.852753, $ 70301.5703, 473999.531, 5534420.00, 21534214.0/ data (xsc(58, 1,i),i=1,11)/ 809.808044,0.0000, $ 0.0000,0.0000,0.0000, 1.06494546, $ 89.4196777, 785.679443, 2507.05469, 4384.17139, 4934.34863/ data (xsc(58, 2,i),i=1,11)/ 76.4517670, 1149.86023, $ 11217.5518,0.0000,0.0000, 17.2115879, $ 999.253052, 5340.44824, 12156.1689, 17694.2715, 18956.2617/ data (xsc(58, 3,i),i=1,11)/ 17.1871319, 583.774780, $ 14862.6494,0.0000,0.0000, 3.34046555, $ 582.965149, 5939.49902, 19788.4238, 34880.5117, 39648.7305/ data (xsc(58, 4,i),i=1,11)/ 20.8196659, 858.343506, $ 24986.5137,0.0000,0.0000, 4.63358974, $ 1089.41125, 11981.6689, 41540.0820, 74921.2031, 87887.2813/ data (xsc(58, 5,i),i=1,11)/ 15.3994770, 232.209656, $ 2510.77319, 18812.0273,0.0000, 169.179718, $ 5079.00439, 20256.5059, 39389.9805, 52409.5625, 56607.7656/ data (xsc(58, 6,i),i=1,11)/ 3.59319282, 108.887032, $ 2263.31470, 25395.0762,0.0000, 103.819031, $ 7137.40576, 34230.3945, 66648.0156, 85321.3125, 100858.266/ data (xsc(58, 7,i),i=1,11)/ 4.43625975, 163.381516, $ 3865.47168, 49440.1797,0.0000, 193.663513, $ 15214.8311, 78193.3125, 161653.813, 216238.609, 250859.453/ data (xsc(58, 8,i),i=1,10)/0.142987847, 14.2490416, $ 974.597046, 37971.5156, 766256.375,9.374778892d-05, $ 86.6941147, 21336.9805, 266197.406, 783598.063/ data (xsc(58, 9,i),i=1,10)/0.107752517, 15.0949926, $ 1248.11316, 52964.6797, 1117025.88,1.129675657d-04, $ 109.798767, 31450.6113, 404560.438, 1208476.25/ data (xsc(58,10,i),i=1,10)/ 3.61078858, 53.8377266, $ 589.919250, 4852.89404, 31144.9297,0.976827741, $ 1578.11487, 24810.5371, 80955.2500, 117010.914/ data (xsc(58,11,i),i=1,10)/0.800607145, 23.4364147, $ 471.346466, 5469.02637, 35751.8672,0.367917597, $ 2727.51880, 41595.8828, 90040.4922, 99440.3594/ data (xsc(58,12,i),i=1,10)/0.984948337, 35.0290184, $ 799.215332, 10361.3623, 77732.5938,0.551236331, $ 5903.72998, 102664.188, 259700.688, 312581.281/ data (xsc(58,13,i),i=1,10)/3.089012951d-02, 2.90309620, $ 179.588837, 5875.51270, 89656.0000,0.224790260, $ 16450.4414, 302828.688, 155294.266, 2181362.25/ data (xsc(58,14,i),i=1,10)/2.329728007d-02, 3.06572342, $ 229.529587, 8191.41748, 131030.469,0.198385447, $ 23346.7324, 458748.375, 230269.875, 3252526.25/ data (xsc(58,15,i),i=1,10)/1.035557761d-05,3.610637737d-03, $ 0.808584511, 99.4774170, 7211.28125,5.046080914d-04, $ 1199.99670, 226161.875, 939981.813, 176164.344/ data (xsc(58,16,i),i=1,10)/0.651443303, 9.37103844, $ 101.202232, 846.455566, 5818.99902, 25.0341949, $ 10096.7607, 82769.1406, 119174.609, 54989.6055/ data (xsc(58,17,i),i=1,10)/0.121410131, 3.36805582, $ 65.7644196, 767.275940, 5356.12988, 63.9939270, $ 19259.2656, 134978.344, 2124584.25, 10484848.0/ data (xsc(58,18,i),i=1,10)/0.146372274, 4.90951490, $ 108.452263, 1408.65442, 11072.5674, 105.411148, $ 45629.6680, 262444.625, 3349819.25, 19155670.0/ data (xsc(59, 1,i),i=1,11)/ 860.712097,0.0000, $ 0.0000,0.0000,0.0000, 1.04404485, $ 86.0257263, 753.414917, 2402.43408, 4199.05176, 4728.57568/ data (xsc(59, 2,i),i=1,11)/ 81.3395538, 1207.10864, $ 11565.8018,0.0000,0.0000, 16.3109131, $ 951.270203, 5091.45117, 11600.6182, 16877.1348, 18157.6543/ data (xsc(59, 3,i),i=1,11)/ 19.0795765, 638.302734, $ 15951.4932,0.0000,0.0000, 3.22954988, $ 556.463745, 5655.64258, 18830.7266, 33142.2188, 37849.7344/ data (xsc(59, 4,i),i=1,11)/ 22.9036770, 933.039917, $ 26775.6172,0.0000,0.0000, 4.41599846, $ 1036.26831, 11404.3916, 39572.0508, 71370.6797, 83811.2344/ data (xsc(59, 5,i),i=1,11)/ 16.4826298, 245.755096, $ 2628.28271, 19448.8730,0.0000, 158.747223, $ 4798.38330, 19215.6523, 37455.7188, 49881.4883, 54007.9102/ data (xsc(59, 6,i),i=1,11)/ 4.00849056, 119.319763, $ 2425.90112, 26482.9023,0.0000, 98.3049698, $ 6764.58691, 32577.4707, 63681.0547, 81833.2656, 95781.7969/ data (xsc(59, 7,i),i=1,11)/ 4.91230440, 178.217194, $ 4139.19287, 51840.7891,0.0000, 182.810226, $ 14453.4980, 74755.5313, 155398.234, 208608.172, 243150.438/ data (xsc(59, 8,i),i=1,10)/0.166180491, 16.3103027, $ 1094.47742, 41736.0703, 853500.313,8.752152644d-05, $ 79.9549789, 19838.3828, 249923.359, 741483.375/ data (xsc(59, 9,i),i=1,10)/0.124732487, 17.2376976, $ 1399.79138, 58175.6797, 1234410.50,1.128136355d-04, $ 100.572495, 29242.8535, 380224.063, 1145307.25/ data (xsc(59,10,i),i=1,10)/ 3.88804603, 57.3575478, $ 622.517395, 5085.46436, 32177.2168,0.930876434, $ 1505.27185, 23761.2402, 77547.5938, 112279.977/ data (xsc(59,11,i),i=1,10)/0.899813354, 25.8756599, $ 509.420319, 5787.86377, 36860.5078,0.347547859, $ 2571.41772, 39730.1016, 86690.9844, 95286.7266/ data (xsc(59,12,i),i=1,10)/ 1.09892488, 38.4812775, $ 862.006897, 10987.7666, 80905.5938,0.521490991, $ 5636.45605, 99302.6797, 253925.141, 306984.688/ data (xsc(59,13,i),i=1,10)/3.637861088d-02, 3.36317515, $ 203.367188, 6471.13867, 95183.6875,0.234063476, $ 16634.0469, 300942.000, 155594.250, 1859522.25/ data (xsc(59,14,i),i=1,10)/2.732011490d-02, 3.54275942, $ 259.574341, 9017.19824, 139186.813,0.203849971, $ 23572.1543, 456056.719, 231231.016, 2776127.50/ data (xsc(59,15,i),i=1,10)/2.183549441d-05,7.402888034d-03, $ 1.58398998, 180.476883, 11228.9365, 2134.21289, $ 3177413.00, 1800969.50, 1281234.88, 1149309.13/ data (xsc(59,16,i),i=1,10)/0.698364556, 9.93235111, $ 106.226723, 882.846558, 6008.07275, 27.0433693, $ 10559.6523, 83490.3438, 114421.273, 52936.0195/ data (xsc(59,17,i),i=1,10)/0.134908944, 3.68196821, $ 70.4402924, 805.636169, 5511.17969, 50.8948174, $ 17093.0000, 110354.102, 1795618.25, 9865037.00/ data (xsc(59,18,i),i=1,10)/0.160756379, 5.32210493, $ 115.589355, 1477.56909, 11442.8271, 82.3358917, $ 40193.3594, 223769.688, 2781508.00, 17979608.0/ data (xsc(60, 1,i),i=1,11)/ 913.447388,0.0000, $ 0.0000,0.0000,0.0000, 1.02490735, $ 82.8395767, 723.043884, 2304.07080, 4028.49536, 4529.63818/ data (xsc(60, 2,i),i=1,11)/ 86.4296341, 1265.45947, $ 11914.8076,0.0000,0.0000, 15.5730972, $ 906.954590, 4859.86523, 11082.6943, 16151.4941, 17348.4160/ data (xsc(60, 3,i),i=1,11)/ 21.1415882, 696.520569, $ 17076.5527,0.0000,0.0000, 3.13180876, $ 532.388794, 5395.26465, 17946.8633, 31614.7520, 36935.4258/ data (xsc(60, 4,i),i=1,11)/ 25.1437130, 1012.18188, $ 28640.3652,0.0000,0.0000, 4.22006083, $ 987.990540, 10876.1992, 37762.1992, 68143.7031, 79710.7188/ data (xsc(60, 5,i),i=1,11)/ 17.6077061, 259.519012, $ 2743.41016, 20013.6563,0.0000, 152.314575, $ 4609.48486, 18466.1133, 35998.0273, 47935.9570, 51975.0820/ data (xsc(60, 6,i),i=1,11)/ 4.46138382, 130.456482, $ 2594.31519, 27548.5840,0.0000, 93.4612045, $ 6428.92871, 31062.5059, 60916.6875, 78521.5781, 91443.4609/ data (xsc(60, 7,i),i=1,11)/ 5.42337370, 193.898621, $ 4421.40381, 54216.1445,0.0000, 174.003799, $ 13811.7891, 71773.0547, 149865.641, 201881.109, 238359.641/ data (xsc(60, 8,i),i=1,10)/0.192459345, 18.6036015, $ 1224.46497, 45675.3984, 10258765.0,7.803834887d-05, $ 74.7325974, 18626.1699, 236190.359, 705053.500/ data (xsc(60, 9,i),i=1,10)/0.143891469, 19.6166897, $ 1564.23059, 63645.9609, 1330188.38,1.077217312d-04, $ 93.2128067, 27422.7539, 359431.469, 1089675.88/ data (xsc(60,10,i),i=1,10)/ 4.17606592, 60.9531631, $ 655.201355, 5311.15576, 33073.5000,0.876959801, $ 1476.41321, 23229.2422, 75376.2891, 109102.828/ data (xsc(60,11,i),i=1,10)/ 1.00769746, 28.4614315, $ 548.302368, 6095.67090, 37794.9883,0.357061416, $ 2562.55591, 39166.2227, 84976.8047, 93437.0938/ data (xsc(60,12,i),i=1,10)/ 1.22021139, 42.1038475, $ 926.316162, 11606.6885, 83823.6797,0.521504462, $ 5574.42334, 98074.5938, 251388.953, 305621.188/ data (xsc(60,13,i),i=1,10)/4.261606559d-02, 3.87616181, $ 229.196854, 7099.17236, 100678.688,0.234244794, $ 16402.4570, 296047.875, 154744.047, 1601790.63/ data (xsc(60,14,i),i=1,10)/3.191594034d-02, 4.07501125, $ 292.152466, 9887.37012, 147312.656,0.200786948, $ 23198.9570, 448626.906, 230925.766, 2393268.75/ data (xsc(60,15,i),i=1,10)/3.790792107d-05,1.291131414d-02, $ 2.73084378, 303.519989, 18331.5410, 6201.41406, $ 4246958.50, 1898921.63, 1260278.00, 900741.375/ data (xsc(60,16,i),i=1,10)/0.744405925, 10.4884844, $ 111.216232, 918.484375, 6185.98535, 28.2904549, $ 10784.8213, 82883.8125, 109374.461, 51805.9492/ data (xsc(60,17,i),i=1,10)/0.149897382, 4.01506662, $ 75.1642990, 842.401367, 5641.87305, 62.5228653, $ 18274.9824, 129760.617, 2142587.50, 11493880.0/ data (xsc(60,18,i),i=1,10)/0.176585436, 5.75601721, $ 122.752457, 1543.74365, 11766.4434, 101.254219, $ 43792.4063, 248609.359, 3320073.25, 21039738.0/ data (xsc(61, 1,i),i=1,11)/ 968.105164,0.0000, $ 0.0000,0.0000,0.0000, 1.00672913, $ 79.8226166, 694.223694, 2210.44873, 3862.62012, 4345.92725/ data (xsc(61, 2,i),i=1,11)/ 91.7074280, 1325.11218, $ 12263.9980,0.0000,0.0000, 14.8659601, $ 864.576538, 4639.04932, 10588.7500, 15432.6221, 16601.2402/ data (xsc(61, 3,i),i=1,11)/ 23.3821125, 758.867065, $ 18264.5020,0.0000,0.0000, 3.01800466, $ 509.440186, 5148.70850, 17113.2383, 30120.5820, 35252.3320/ data (xsc(61, 4,i),i=1,11)/ 27.5586643, 1096.41223, $ 30605.2305,0.0000,0.0000, 4.03355980, $ 942.017212, 10375.3223, 36054.0430, 65171.3828, 76039.9375/ data (xsc(61, 5,i),i=1,11)/ 18.7907276, 273.776337, $ 2861.63306, 20585.3867,0.0000, 145.209839, $ 4405.80762, 17676.3828, 34478.1602, 45973.0469, 49837.1992/ data (xsc(61, 6,i),i=1,11)/ 4.95716000, 142.364609, $ 2769.53345, 28606.2969,0.0000, 88.7883835, $ 6105.67725, 29603.0605, 58231.0273, 75172.6953, 87920.0313/ data (xsc(61, 7,i),i=1,11)/ 5.97502613, 210.568954, $ 4716.79346, 56664.7109,0.0000, 164.718735, $ 13151.1162, 68740.3672, 144250.172, 195117.422, 227489.813/ data (xsc(61, 8,i),i=1,11)/0.222328722, 21.1643238, $ 1367.03345, 49949.4805,0.0000, 42.2864380, $ 13450.1514, 140667.063, 436547.063, 768294.688, 9587678.00/ data (xsc(61, 9,i),i=1,11)/0.165465444, 22.2592735, $ 1743.82324, 69536.2188,0.0000, 51.1324348, $ 19737.7246, 213320.188, 671213.563, 1194337.88, 14725362.0/ data (xsc(61,10,i),i=1,10)/ 4.48026371, 64.6739578, $ 688.634399, 5541.96533, 33967.9531,0.835677087, $ 1411.66357, 22271.9531, 72218.1797, 104547.602/ data (xsc(61,11,i),i=1,10)/ 1.12526691, 31.2218380, $ 588.890503, 6411.08105, 38681.0781,0.348930359, $ 2468.01147, 37817.0000, 82121.3359, 90096.3047/ data (xsc(61,12,i),i=1,10)/ 1.35085428, 45.9449043, $ 993.455322, 12249.7432, 86818.5234,0.489623427, $ 5293.72363, 94433.5938, 244521.234, 298490.156/ data (xsc(61,13,i),i=1,10)/4.967614636d-02, 4.44507980, $ 257.014374, 7749.38623, 105896.570,0.246039420, $ 16661.4395, 293728.563, 154141.938, 1425006.00/ data (xsc(61,14,i),i=1,10)/3.703936562d-02, 4.66134930, $ 327.162567, 10787.4014, 155038.797,0.208176479, $ 23531.9668, 445345.063, 229929.859, 2132981.75/ data (xsc(61,15,i),i=1,10)/6.042137829d-05,2.064520679d-02, $ 4.31517363, 468.574341, 27527.2949, 3282.38892, $ 4659896.50, 2167964.00, 1106787.13, 625464.750/ data (xsc(61,16,i),i=1,10)/0.793453932, 11.0569677, $ 116.161903, 953.135803, 6350.88232, 29.7003460, $ 11026.4053, 82262.7031, 104472.398, 51364.2109/ data (xsc(61,17,i),i=1,10)/0.165404201, 4.35852671, $ 79.9592667, 878.540588, 5760.62988, 66.6086273, $ 18324.8105, 136198.859, 2281655.50, 12365242.0/ data (xsc(61,18,i),i=1,10)/0.192575037, 6.19663668, $ 129.966965, 1609.01404, 12074.4307, 107.336311, $ 44408.6367, 253856.297, 3515567.00, 22672972.0/ data (xsc(62, 1,i),i=1,11)/ 1024.60889,0.0000, $ 0.0000,0.0000,0.0000,0.989990175, $ 76.9716949, 666.947815, 2122.06958, 3709.04028, 4167.85449/ data (xsc(62, 2,i),i=1,11)/ 97.1800232, 1385.82727, $ 12577.5488,0.0000,0.0000, 14.2096920, $ 824.943970, 4431.94629, 10124.3301, 14750.3789, 15886.4209/ data (xsc(62, 3,i),i=1,11)/ 25.8145218, 825.375854, $ 19507.0449,0.0000,0.0000, 2.92831445, $ 488.056732, 4918.67969, 16334.6289, 28715.1699, 33631.8125/ data (xsc(62, 4,i),i=1,11)/ 30.1455135, 1185.63635, $ 32645.8516,0.0000,0.0000, 3.85827994, $ 899.062134, 9907.23438, 34452.4336, 62228.0156, 73187.8359/ data (xsc(62, 5,i),i=1,11)/ 20.0156765, 288.433502, $ 2982.33032, 21155.1348,0.0000, 137.929657, $ 4200.35010, 16887.6016, 32973.0820, 43966.6367, 47779.8008/ data (xsc(62, 6,i),i=1,11)/ 5.49368525, 155.004822, $ 2950.27979, 29631.3262,0.0000, 84.6665878, $ 5814.60059, 28265.7559, 55739.7070, 72101.6797, 84933.0078/ data (xsc(62, 7,i),i=1,11)/ 6.56906414, 228.257263, $ 5024.90869, 59169.4727,0.0000, 155.505859, $ 12499.7314, 65756.5703, 138696.875, 188337.016, 217892.078/ data (xsc(62, 8,i),i=1,11)/0.255926639, 24.0063839, $ 1522.65051, 54543.4414,0.0000, 39.2380524, $ 12562.8447, 132371.422, 413444.719, 727641.688, 8914730.00/ data (xsc(62, 9,i),i=1,11)/0.189811066, 25.1965961, $ 1940.54822, 75954.4844,0.0000, 46.8156319, $ 18364.1543, 200432.625, 635388.875, 1130759.25, 13595857.0/ data (xsc(62,10,i),i=1,10)/ 4.79181480, 68.4667816, $ 722.490662, 5771.56299, 34794.7070,0.798738182, $ 1352.46814, 21380.3438, 69235.1953, 100161.945/ data (xsc(62,11,i),i=1,10)/ 1.25433755, 34.1671867, $ 630.850708, 6726.20850, 39463.2578,0.342500240, $ 2380.81567, 36525.8398, 79284.4063, 86797.0078/ data (xsc(62,12,i),i=1,10)/ 1.49108446, 49.9956284, $ 1062.76575, 12899.3506, 89694.4844,0.462454557, $ 5043.36279, 91066.2344, 237872.828, 291451.938/ data (xsc(62,13,i),i=1,10)/5.766981095d-02, 5.07888269, $ 287.474701, 8456.42090, 111497.336,0.214876041, $ 15080.7578, 279950.500, 151400.031, 1231856.88/ data (xsc(62,14,i),i=1,10)/4.280338809d-02, 5.31219530, $ 365.430267, 11766.2344, 163378.766,0.176703438, $ 21222.5664, 423828.625, 228382.328, 1842798.25/ data (xsc(62,15,i),i=1,10)/9.115662397d-05,3.120273724d-02, $ 6.44168377, 684.032349, 39105.0742, 1407.56836, $ 4632811.00, 2616724.75, 1052927.88, 517781.719/ data (xsc(62,16,i),i=1,10)/0.841388226, 11.6187687, $ 121.064171, 986.825439, 6502.87549, 31.2840271, $ 11289.3701, 81614.6094, 99689.8125, 51566.5273/ data (xsc(62,17,i),i=1,10)/0.182548285, 4.72200823, $ 84.8162308, 913.745117, 5864.52930, 69.1399307, $ 18138.4902, 140176.719, 2382270.25, 13121841.0/ data (xsc(62,18,i),i=1,10)/0.210070804, 6.65772390, $ 137.215744, 1672.80249, 12359.4609, 110.741966, $ 44411.7617, 255105.328, 3646091.75, 24088756.0/ data (xsc(63, 1,i),i=1,11)/ 1082.95947,0.0000, $ 0.0000,0.0000,0.0000,0.974171460, $ 74.2786179, 641.095825, 2037.95776, 3560.11499, 4002.50830/ data (xsc(63, 2,i),i=1,11)/ 102.862061, 1447.51978, $ 12906.5879,0.0000,0.0000, 13.6051102, $ 788.036255, 4237.81445, 9688.19727, 14137.7637, 15188.7998/ data (xsc(63, 3,i),i=1,11)/ 28.4541492, 896.136658, $ 20760.3008,0.0000,0.0000, 2.84694123, $ 468.369171, 4705.22266, 15609.0039, 27462.1641, 32092.1113/ data (xsc(63, 4,i),i=1,11)/ 32.9148712, 1279.87524, $ 34769.1055,0.0000,0.0000, 3.67583942, $ 859.464600, 9473.74414, 32965.2734, 59528.4609, 70212.0781/ data (xsc(63, 5,i),i=1,11)/ 21.2896595, 303.460571, $ 3104.04297, 21702.4473,0.0000, 131.338531, $ 4011.77026, 16156.6387, 31568.1660, 42096.6328, 45800.4844/ data (xsc(63, 6,i),i=1,11)/ 6.07634449, 168.462387, $ 3137.86792, 30639.4648,0.0000, 80.5750580, $ 5529.34521, 26960.1426, 53302.7578, 69107.0547, 80889.2344/ data (xsc(63, 7,i),i=1,11)/ 7.20967674, 246.910980, $ 5340.70264, 61623.8750,0.0000, 148.134735, $ 11953.7559, 63179.2500, 133790.188, 182081.109, 211428.422/ data (xsc(63, 8,i),i=1,11)/0.293706030, 27.1489658, $ 1690.91504, 59372.9727,0.0000, 36.6632385, $ 11795.0303, 125044.891, 392674.344, 691058.563, 8393959.00/ data (xsc(63, 9,i),i=1,11)/0.216936782, 28.4228420, $ 2151.36255, 82561.6563,0.0000, 43.5729256, $ 17289.3379, 189921.781, 605157.125, 1076519.50, 12751725.0/ data (xsc(63,10,i),i=1,10)/ 5.11582518, 72.3587494, $ 756.797119, 5998.93994, 35548.1523,0.771124959, $ 1304.55896, 20625.2500, 66597.2422, 96260.0313/ data (xsc(63,11,i),i=1,10)/ 1.39358258, 37.3071594, $ 675.029053, 7056.30273, 40208.6094,0.312348515, $ 2182.68188, 34230.7852, 75077.6719, 81696.9531/ data (xsc(63,12,i),i=1,10)/ 1.64342415, 54.2822533, $ 1134.02893, 13547.2734, 92375.8125,0.452580839, $ 4910.60840, 88969.8750, 233275.406, 287084.031/ data (xsc(63,13,i),i=1,10)/6.667943299d-02, 5.77828264, $ 319.998474, 9173.61035, 116564.227,0.217281744, $ 14959.1025, 275113.344, 149905.344, 1111816.63/ data (xsc(63,14,i),i=1,10)/4.926908761d-02, 6.02834845, $ 406.214783, 12758.1240, 170930.344,0.176095545, $ 21010.7500, 416563.594, 226317.938, 1665856.63/ data (xsc(63,15,i),i=1,10)/1.146181894d-04,3.901197389d-02, $ 7.91907215, 820.722168, 45399.4453, 17581.6465, $ 5085654.50, 1741765.38, 1076830.88, 847386.250/ data (xsc(63,16,i),i=1,10)/0.893049419, 12.1990910, $ 125.938431, 1018.71301, 6625.91211, 46.2834549, $ 14583.2295, 92570.0938, 99155.5078, 59714.5078/ data (xsc(63,17,i),i=1,10)/0.200391889, 5.09999228, $ 89.8084869, 948.916504, 5960.54932, 67.7624512, $ 17511.6875, 136995.969, 2374781.50, 13462045.0/ data (xsc(63,18,i),i=1,10)/0.228655919, 7.13864422, $ 144.625183, 1736.83936, 12636.8389, 107.579514, $ 43169.0313, 246647.641, 3599109.50, 24708374.0/ data (xsc(64, 1,i),i=1,11)/ 1143.10596,0.0000, $ 0.0000,0.0000,0.0000,0.959365785, $ 71.7253799, 616.497253, 1957.80847, 3417.84131, 3844.55103/ data (xsc(64, 2,i),i=1,11)/ 108.705818, 1509.59424, $ 13262.7119,0.0000,0.0000, 13.0326872, $ 752.893372, 4052.26807, 9269.20313, 13526.1328, 14527.7451/ data (xsc(64, 3,i),i=1,11)/ 31.2971840, 970.748169, $ 22036.9688,0.0000,0.0000, 2.77000737, $ 449.687836, 4501.18213, 14910.6494, 26207.9980, 29811.4863/ data (xsc(64, 4,i),i=1,11)/ 35.8704872, 1378.49341, $ 36935.5586,0.0000,0.0000, 3.52496028, $ 821.969116, 9058.11621, 31526.7383, 57033.2656, 67089.6094/ data (xsc(64, 5,i),i=1,11)/ 22.6053371, 318.704803, $ 3224.01489, 22194.4258,0.0000, 124.233932, $ 3824.28784, 15422.8926, 30159.1445, 40230.4570, 43631.0859/ data (xsc(64, 6,i),i=1,11)/ 6.70396900, 182.570953, $ 3325.80371, 31544.6270,0.0000, 76.8523788, $ 5260.08838, 25697.5762, 50940.0703, 66192.6016, 77765.4844/ data (xsc(64, 7,i),i=1,11)/ 7.88950205, 266.344055, $ 5659.05615, 63945.3555,0.0000, 140.800232, $ 11401.4141, 60519.6875, 128700.688, 175722.438, 205292.328/ data (xsc(64, 8,i),i=1,11)/0.335776091, 30.5740318, $ 1868.08398, 64148.1680,0.0000, 34.2140961, $ 11034.2930, 117430.922, 370179.000, 640741.938, 7457943.00/ data (xsc(64, 9,i),i=1,11)/0.247009426, 31.9362679, $ 2374.01660, 89178.0625,0.0000, 40.2313499, $ 16143.1318, 178306.984, 570633.938, 998727.500, 11790371.0/ data (xsc(64,10,i),i=1,10)/ 5.46481276, 76.5115356, $ 792.899414, 6229.29053, 36272.9961,0.742980003, $ 1255.48206, 19839.9688, 64191.5430, 93504.5156/ data (xsc(64,11,i),i=1,10)/ 1.54827595, 40.7001610, $ 720.488281, 7362.80664, 40852.5234,0.332672507, $ 2226.52393, 34164.9609, 74950.7344, 83071.2188/ data (xsc(64,12,i),i=1,10)/ 1.81181812, 58.9971085, $ 1211.78772, 14245.8799, 95347.7031,0.417872757, $ 4602.69824, 84913.4297, 227768.609, 286891.344/ data (xsc(64,13,i),i=1,10)/7.735446095d-02, 6.59424448, $ 357.122192, 9967.38086, 122043.969,0.202335522, $ 14063.8340, 268268.563, 165319.609, 712462.688/ data (xsc(64,14,i),i=1,10)/5.692562088d-02, 6.86587000, $ 452.948425, 13862.2871, 179168.156,0.160692036, $ 19700.2520, 405765.781, 255306.219, 1038431.19/ data (xsc(64,15,i),i=1,10)/1.382994815d-04,5.050205067d-02, $ 10.4638147, 1061.43884, 56876.5391, 267.740540, $ 3218998.75, 2688464.25, 642599.563, 712302.250/ data (xsc(64,16,i),i=1,10)/2.152928209d-05,7.652925793d-03, $ 1.61883366, 167.511948, 9102.13379, 59.6805649, $ 582469.250, 432664.156, 113483.703, 131450.891/ data (xsc(64,17,i),i=1,10)/0.981478751, 13.3112621, $ 136.460098, 1096.66003, 7067.83691, 38.4084663, $ 12845.1797, 87106.9688, 106088.938, 71148.1016/ data (xsc(64,18,i),i=1,10)/0.233047232, 5.84594774, $ 100.983673, 1045.93884, 6441.26855, 92.7021561, $ 20351.8477, 175719.719, 2570084.75, 10158516.0/ data (xsc(64,19,i),i=1,10)/0.263996065, 8.17296124, $ 163.252853, 1930.42529, 13845.0762, 149.189301, $ 51857.5273, 306965.938, 3910144.00, 18497008.0/ data (xsc(65, 1,i),i=1,11)/ 1205.34631,0.0000, $ 0.0000,0.0000,0.0000,0.945949912, $ 69.3186493, 593.315186, 1882.57104, 3287.10913, 3693.98096/ data (xsc(65, 2,i),i=1,11)/ 114.814537, 1573.87476, $ 13375.7695,0.0000,0.0000, 12.5001888, $ 720.184631, 3880.36597, 8883.49219, 12978.4980, 13936.3750/ data (xsc(65, 3,i),i=1,11)/ 34.3973389, 1051.35217, $ 23490.6621,0.0000,0.0000, 2.69980812, $ 432.708130, 4317.91797, 14290.9492, 25129.9688, 29369.0313/ data (xsc(65, 4,i),i=1,11)/ 39.0477180, 1484.50305, $ 39273.8164,0.0000,0.0000, 3.38509846, $ 787.803040, 8687.35645, 30263.5215, 54709.1133, 64491.0703/ data (xsc(65, 5,i),i=1,11)/ 23.9997387, 334.799286, $ 3353.47583, 22755.9551,0.0000, 117.800514, $ 3644.35376, 14739.7920, 28850.6484, 38510.1875, 41981.3789/ data (xsc(65, 6,i),i=1,11)/ 7.39434862, 197.906570, $ 3531.16821, 32558.9160,0.0000, 73.1972122, $ 5008.93066, 24554.0254, 48755.4336, 63337.9180, 75171.7266/ data (xsc(65, 7,i),i=1,11)/ 8.62680721, 287.360413, $ 6009.16260, 66647.3047,0.0000, 133.595505, $ 10891.2568, 58180.1133, 124256.758, 170151.328, 197383.625/ data (xsc(65, 8,i),i=1,11)/0.383780777, 34.4529114, $ 2070.81250, 69956.3516,0.0000, 32.1261711, $ 10430.3506, 111923.531, 355110.250, 624042.125, 7105357.00/ data (xsc(65, 9,i),i=1,11)/0.281034321, 35.9007416, $ 2629.06689, 97290.8906,0.0000, 37.2868767, $ 15211.0215, 169810.875, 547588.938, 974825.438, 10944593.0/ data (xsc(65,10,i),i=1,10)/ 5.80675125, 80.4825516, $ 827.448120, 6460.78662, 36959.6289,0.686059952, $ 1169.97119, 18663.2559, 60345.0586, 87095.1875/ data (xsc(65,11,i),i=1,10)/ 1.70720196, 44.1261940, $ 766.399048, 7688.83008, 41268.0859,0.283821434, $ 2007.77905, 31646.2520, 69303.9453, 75000.9297/ data (xsc(65,12,i),i=1,10)/ 1.97987509, 63.5598145, $ 1285.20654, 14906.1006, 97783.3438,0.387636513, $ 4321.58154, 81055.0938, 217233.656, 268992.719/ data (xsc(65,13,i),i=1,10)/8.829211444d-02, 7.40487146, $ 392.962372, 10726.9199, 126635.656,0.185695708, $ 13399.7881, 256613.031, 146052.031, 902967.500/ data (xsc(65,14,i),i=1,10)/6.464228779d-02, 7.68600273, $ 497.457062, 14905.9932, 186049.250,0.144532889, $ 18709.5840, 388000.563, 222527.609, 1354789.88/ data (xsc(65,15,i),i=1,10)/1.721229200d-04,6.180451438d-02, $ 12.5331964, 1244.15955, 64718.2148, 299.456726, $ 3195598.25, 2391837.75, 624617.500, 773388.250/ data (xsc(65,16,i),i=1,10)/5.317702744d-05,1.868223213d-02, $ 3.86977792, 392.014709, 20689.9512, 135.322144, $ 1153528.25, 769299.875, 221514.781, 285723.438/ data (xsc(65,17,i),i=1,10)/ 1.03394198, 13.9011078, $ 141.431335, 1129.07935, 7199.43555, 33.8753967, $ 11612.2939, 80027.2891, 98025.5156, 66108.4219/ data (xsc(65,18,i),i=1,10)/0.254085600, 6.27169275, $ 106.286377, 1080.55054, 6513.52344, 56.7002983, $ 16049.0508, 111103.094, 1789577.25, 8258508.00/ data (xsc(65,19,i),i=1,10)/0.285247445, 8.70330620, $ 171.062729, 1995.06030, 14106.6416, 88.2457733, $ 39786.7695, 217099.766, 2625967.25, 14889155.0/ data (xsc(66, 1,i),i=1,11)/ 1269.03821,0.0000, $ 0.0000,0.0000,0.0000,0.933116853, $ 67.0328217, 571.199646, 1810.45398, 3159.20166, 3552.20166/ data (xsc(66, 2,i),i=1,11)/ 121.073395, 1638.18860, $ 0.0000,0.0000,0.0000, 12.0055704, $ 689.449402, 3717.61670, 8515.11621, 12436.9521, 13368.8477/ data (xsc(66, 3,i),i=1,11)/ 37.7270584, 1136.07471, $ 24637.5625,0.0000,0.0000, 2.63352537, $ 416.574951, 4142.22021, 13691.4355, 24044.9551, 28127.0898/ data (xsc(66, 4,i),i=1,11)/ 42.4298096, 1595.15820, $ 41594.8398,0.0000,0.0000, 3.25432801, $ 755.406189, 8330.66699, 29036.6445, 52571.1172, 61865.2969/ data (xsc(66, 5,i),i=1,11)/ 25.4214058, 350.885254, $ 3476.92969, 23219.5254,0.0000, 112.960999, $ 3499.95288, 14161.7920, 27715.0840, 36980.9453, 40356.6797/ data (xsc(66, 6,i),i=1,11)/ 8.13099670, 213.814957, $ 3732.61304, 33409.2852,0.0000, 70.5572205, $ 4805.42578, 23562.7539, 46824.7617, 60916.7031, 71674.3516/ data (xsc(66, 7,i),i=1,11)/ 9.41305542, 309.148773, $ 6356.02832, 69104.2813,0.0000, 127.893814, $ 10452.6660, 56052.5430, 120100.625, 164736.438, 191838.219/ data (xsc(66, 8,i),i=1,11)/0.436785549, 38.6510544, $ 2282.50684, 75612.8828,0.0000, 30.3219795, $ 9870.32422, 106393.242, 338903.469, 594702.563, 6478023.00/ data (xsc(66, 9,i),i=1,11)/0.318683326, 40.1826210, $ 2893.49243, 105063.195,0.0000, 34.9681435, $ 14408.7461, 161738.984, 523696.688, 931776.188, 10292234.0/ data (xsc(66,10,i),i=1,10)/ 6.16890669, 84.6834488, $ 863.450195, 6687.70117, 37538.8594,0.654098988, $ 1115.98035, 17845.0586, 57640.7539, 83085.8359/ data (xsc(66,11,i),i=1,10)/ 1.88586521, 47.8831367, $ 815.259094, 8020.14600, 41676.5938,0.256207049, $ 1830.93079, 29529.2188, 65308.7188, 70211.6172/ data (xsc(66,12,i),i=1,10)/ 2.16415858, 68.5139236, $ 1362.90686, 15563.0889, 100088.992,0.388950288, $ 4276.51904, 79927.7734, 214024.359, 265998.406/ data (xsc(66,13,i),i=1,10)/0.101031192, 8.34041023, $ 433.510498, 11552.5342, 131406.703,0.174231455, $ 12695.7656, 247717.438, 144066.406, 825162.250/ data (xsc(66,14,i),i=1,10)/7.362566143d-02, 8.63463211, $ 548.028015, 16047.1104, 193261.594,0.132819816, $ 17672.1348, 374285.719, 220294.266, 1239739.75/ data (xsc(66,15,i),i=1,10)/2.185936755d-04,7.233473659d-02, $ 13.9175034, 1352.66003, 68482.1563, 7500.48291, $ 4132833.50, 1385385.25, 828736.375, 883879.313/ data (xsc(66,16,i),i=1,10)/1.387346565d-04,4.390750453d-02, $ 8.51859379, 845.185059, 43485.8750, 4717.44727, $ 2783733.00, 1026051.56, 612730.688, 501245.656/ data (xsc(66,17,i),i=1,10)/ 1.05230796, 13.9913273, $ 141.300461, 1124.23755, 7125.84473, 12.0562201, $ 5477.91113, 47303.6328, 71032.5000, 36958.8359/ data (xsc(66,18,i),i=1,10)/0.263115197, 6.35300446, $ 105.325546, 1050.53577, 6179.10303, 51.8145599, $ 14367.9707, 105505.625, 1987611.88, 12897179.0/ data (xsc(66,19,i),i=1,10)/0.289452046, 8.66673756, $ 167.291809, 1923.84509, 13376.9600, 79.1424026, $ 35618.4531, 194356.781, 2880928.50, 23535914.0/ data (xsc(67, 1,i),i=1,11)/ 1334.60571,0.0000, $ 0.0000,0.0000,0.0000,0.921624780, $ 64.8667908, 550.195801, 1742.11914, 3040.18921, 3414.98804/ data (xsc(67, 2,i),i=1,11)/ 127.540550, 1703.47290, $ 0.0000,0.0000,0.0000, 11.5333118, $ 660.078430, 3562.11353, 8163.54395, 11921.4180, 12838.9736/ data (xsc(67, 3,i),i=1,11)/ 41.3182983, 1225.84668, $ 0.0000,0.0000,0.0000, 2.57155919, $ 401.451569, 3977.12207, 13127.6240, 23027.7676, 27011.9238/ data (xsc(67, 4,i),i=1,11)/ 46.0263824, 1711.56433, $ 44107.8242,0.0000,0.0000, 3.13175416, $ 725.036011, 7996.13916, 27882.2988, 50455.6523, 59582.1641/ data (xsc(67, 5,i),i=1,11)/ 26.8941078, 367.326843, $ 3601.06226, 23651.1621,0.0000, 108.356148, $ 3362.00195, 13608.3203, 26627.5039, 35508.2500, 38797.9258/ data (xsc(67, 6,i),i=1,11)/ 8.92685795, 230.693222, $ 3941.90771, 34243.8906,0.0000, 67.2341232, $ 4589.64648, 22539.3301, 44850.4766, 58392.7813, 69366.3203/ data (xsc(67, 7,i),i=1,11)/ 10.2482252, 331.990784, $ 6713.10693, 71558.0859,0.0000, 122.531265, $ 10040.0723, 54037.5586, 116145.539, 159645.594, 188161.109/ data (xsc(67, 8,i),i=1,11)/0.495855212, 43.2557602, $ 2510.42969, 81572.2656,0.0000, 28.6561489, $ 9351.12891, 101240.547, 323746.344, 568443.188, 6167648.50/ data (xsc(67, 9,i),i=1,11)/0.360295892, 44.8689651, $ 3179.04492, 113355.961,0.0000, 32.6780357, $ 13619.6924, 153859.719, 500477.813, 889989.313, 9361720.00/ data (xsc(67,10,i),i=1,10)/ 6.54965067, 89.0065689, $ 899.932190, 6912.58545, 38045.2539,0.623715460, $ 1062.71436, 17037.9434, 54990.2344, 79177.1328/ data (xsc(67,11,i),i=1,10)/ 2.07605410, 51.7956772, $ 864.182861, 8324.95703, 41912.6055,0.255674392, $ 1787.67529, 28664.5137, 63006.1758, 67616.2500/ data (xsc(67,12,i),i=1,10)/ 2.36101580, 73.7348785, $ 1444.09924, 16252.5742, 102489.891,0.350760937, $ 4059.06152, 76798.9766, 207234.531, 258288.594/ data (xsc(67,13,i),i=1,10)/0.115379266, 9.36775875, $ 476.764099, 12403.8252, 135893.094,0.166401088, $ 12151.7646, 239899.516, 141879.063, 761918.750/ data (xsc(67,14,i),i=1,10)/8.369409293d-02, 9.67334175, $ 601.871643, 17223.3164, 200078.641,0.124392033, $ 16865.3789, 362281.500, 217464.953, 1146450.50/ data (xsc(67,15,i),i=1,10)/2.674403368d-04,8.751519024d-02, $ 16.5284290, 1573.17749, 77197.3984, 13586.1748, $ 3802449.25, 1208605.63, 892395.938, 1131814.25/ data (xsc(67,16,i),i=1,10)/2.103789157d-04,6.618701667d-02, $ 12.6178923, 1226.53137, 61204.2852, 10686.0869, $ 3228999.00, 1132930.50, 786884.563, 737857.188/ data (xsc(67,17,i),i=1,10)/ 1.10694396, 14.5887871, $ 146.121933, 1151.68323, 7187.39893, 19.6703682, $ 7636.67969, 57470.4766, 72151.2578, 45606.9375/ data (xsc(67,18,i),i=1,10)/0.286340177, 6.80150270, $ 110.562202, 1080.74817, 6214.21094, 101.692322, $ 18338.1328, 212050.547, 3549127.75, 20366612.0/ data (xsc(67,19,i),i=1,10)/0.311033279, 9.19705486, $ 174.798630, 1979.67224, 13542.6328, 159.988159, $ 48520.7188, 316384.688, 5354897.50, 37786016.0/ data (xsc(68, 1,i),i=1,11)/ 1402.23413,0.0000, $ 0.0000,0.0000,0.0000,0.910493791, $ 62.8085632, 530.175903, 1676.71313, 2924.07813, 3286.56689/ data (xsc(68, 2,i),i=1,11)/ 134.224869, 1769.51392, $ 0.0000,0.0000,0.0000, 11.0918627, $ 632.328796, 3414.57690, 7830.02783, 11448.7598, 12303.9238/ data (xsc(68, 3,i),i=1,11)/ 45.1934395, 1320.92285, $ 0.0000,0.0000,0.0000, 2.51335192, $ 387.175659, 3820.93506, 12594.4482, 22104.3848, 25883.5938/ data (xsc(68, 4,i),i=1,11)/ 49.8604622, 1834.03943, $ 46768.0977,0.0000,0.0000, 3.01659632, $ 696.403503, 7680.22266, 26794.0332, 48556.0273, 57260.2188/ data (xsc(68, 5,i),i=1,11)/ 28.4245224, 384.056274, $ 3723.58569, 24031.4414,0.0000, 104.604179, $ 3244.11865, 13121.5859, 25649.2266, 34204.8359, 37387.1719/ data (xsc(68, 6,i),i=1,11)/ 9.78788471, 248.512024, $ 4155.96094, 35022.5781,0.0000, 64.4948883, $ 4388.03076, 21574.4277, 42972.6523, 55936.0938, 66895.3828/ data (xsc(68, 7,i),i=1,11)/ 11.1441288, 356.091522, $ 7084.56201, 74073.6016,0.0000, 116.850319, $ 9610.54688, 51969.5469, 112100.977, 154343.984, 183117.734/ data (xsc(68, 8,i),i=1,11)/0.561815262, 48.3105659, $ 2756.40894, 87908.3125,0.0000, 27.0312080, $ 8847.34668, 96264.0625, 309125.344, 542704.563, 5805503.00/ data (xsc(68, 9,i),i=1,11)/0.406345814, 49.9846649, $ 3485.59351, 122086.500,0.0000, 30.5725346, $ 12886.4717, 146502.688, 478717.344, 852600.375, 8976748.00/ data (xsc(68,10,i),i=1,10)/ 6.93704367, 93.3750305, $ 936.191528, 7123.01416, 38406.8633,0.617027283, $ 1041.06995, 16609.8438, 53253.5117, 76497.2344/ data (xsc(68,11,i),i=1,10)/ 2.28188133, 55.9661674, $ 915.904053, 8649.78418, 42045.2266,0.232938945, $ 1638.24182, 26802.6348, 59393.1172, 63320.1914/ data (xsc(68,12,i),i=1,10)/ 2.57315612, 79.2279968, $ 1527.52917, 16944.2441, 104755.180,0.332286477, $ 3873.14941, 74026.1875, 201022.984, 251265.359/ data (xsc(68,13,i),i=1,10)/0.131258249, 10.4975939, $ 524.155212, 13348.2412, 140832.594,0.129286721, $ 10204.1797, 221111.578, 141987.141, 671699.750/ data (xsc(68,14,i),i=1,10)/9.472762048d-02, 10.8004751, $ 659.165894, 18436.4121, 206537.156,0.117730275, $ 16194.6572, 351368.469, 214190.594, 1068542.88/ data (xsc(68,15,i),i=1,10)/3.274603223d-04,0.105456732, $ 19.5129871, 1820.59167, 86677.6875, 9084.09766, $ 3613573.25, 1161608.38, 818143.250, 1083411.63/ data (xsc(68,16,i),i=1,10)/3.070689563d-04,9.543409199d-02, $ 17.8338051, 1700.11145, 82362.3672, 8540.36621, $ 3669606.00, 1304625.50, 859613.500, 804831.188/ data (xsc(68,17,i),i=1,10)/ 1.16627645, 15.2216101, $ 151.309143, 1184.74243, 7322.17041, 14.6506004, $ 6117.94434, 48891.0039, 66023.3203, 41461.5586/ data (xsc(68,18,i),i=1,10)/0.312212288, 7.28530025, $ 116.161530, 1114.94849, 6270.96338, 43.9072113, $ 12625.0703, 90044.5938, 1784281.63, 12572056.0/ data (xsc(68,19,i),i=1,10)/0.334918499, 9.76585865, $ 182.850647, 2044.66467, 13802.0625, 65.2826080, $ 31433.3828, 168209.703, 2505131.25, 22829432.0/ data (xsc(69, 1,i),i=1,11)/ 1471.39294,0.0000, $ 0.0000,0.0000,0.0000,0.900793612, $ 60.8579330, 511.148865, 1614.70337, 2815.89136, 3162.20386/ data (xsc(69, 2,i),i=1,11)/ 141.087921, 1836.06555, $ 0.0000,0.0000,0.0000, 10.6769648, $ 606.147705, 3275.28369, 7513.65723, 10981.3125, 11814.0508/ data (xsc(69, 3,i),i=1,11)/ 49.3521461, 1421.06287, $ 0.0000,0.0000,0.0000, 2.46011782, $ 373.952698, 3675.54248, 12095.3730, 21194.6816, 24834.6289/ data (xsc(69, 4,i),i=1,11)/ 53.9229431, 1962.25940, $ 48693.1875,0.0000,0.0000, 2.91011405, $ 669.807983, 7385.81055, 25773.7207, 46685.1289, 55121.9570/ data (xsc(69, 5,i),i=1,11)/ 30.0097198, 401.448883, $ 3854.00562, 24460.3086,0.0000, 98.9670410, $ 3083.91357, 12506.6670, 24474.5977, 32640.4004, 35710.4648/ data (xsc(69, 6,i),i=1,11)/ 10.7098856, 267.221588, $ 4373.77295, 35729.5391,0.0000, 62.0311852, $ 4203.39844, 20678.1426, 41215.5820, 53704.4063, 63454.3359/ data (xsc(69, 7,i),i=1,11)/ 12.0933790, 381.320831, $ 7467.22461, 76588.0703,0.0000, 110.840065, $ 9201.04980, 49991.0078, 108227.203, 149431.625, 174449.719/ data (xsc(69, 8,i),i=1,11)/0.634685993, 53.8141022, $ 3018.67407, 94442.3594,0.0000, 25.6605186, $ 8411.94238, 91863.3594, 295954.406, 518979.188, 5293580.00/ data (xsc(69, 9,i),i=1,11)/0.457368761, 55.5603256, $ 3813.18188, 131185.469,0.0000, 28.7137737, $ 12225.6748, 139787.984, 458623.906, 816952.000, 8491173.00/ data (xsc(69,10,i),i=1,10)/ 7.33887577, 97.8807297, $ 973.763184, 7345.04736, 38792.1875,0.582199454, $ 982.922791, 15753.3369, 50548.5898, 72527.1875/ data (xsc(69,11,i),i=1,10)/ 2.50546837, 60.3660126, $ 968.579041, 8961.88574, 42031.0703,0.220133245, $ 1537.44055, 25404.2891, 56425.6523, 59866.5938/ data (xsc(69,12,i),i=1,10)/ 2.79648042, 84.9697342, $ 1614.07434, 17656.3770, 106991.719,0.306047380, $ 3628.43652, 70536.3750, 193484.969, 242422.828/ data (xsc(69,13,i),i=1,10)/0.148810402, 11.7134838, $ 572.790588, 14228.7041, 144489.688,0.137195289, $ 10440.6719, 219468.938, 138375.516, 642768.188/ data (xsc(69,14,i),i=1,10)/0.106935367, 12.0330038, $ 721.105347, 19745.8281, 213306.766,9.786464274d-02, $ 14379.4043, 330647.188, 213969.000, 969475.813/ data (xsc(69,15,i),i=1,10)/3.954572894d-04,0.125986248, $ 22.9034939, 2096.21631, 96838.7969, 4822.57129, $ 3442956.75, 1159065.38, 719061.125, 957708.813/ data (xsc(69,16,i),i=1,10)/4.371200339d-04,0.133366182, $ 24.3661098, 2279.20117, 107210.680, 5262.50977, $ 4053068.00, 1512070.63, 890228.000, 796651.313/ data (xsc(69,17,i),i=1,10)/ 1.22701144, 15.8550014, $ 156.277832, 1212.51257, 7389.15381, 19.6424370, $ 7400.30957, 53884.4375, 65175.7578, 49021.0898/ data (xsc(69,18,i),i=1,10)/0.338816017, 7.78060484, $ 121.763123, 1146.57324, 6304.62207, 36.6902924, $ 11354.2598, 76200.6406, 1554979.25, 11641636.0/ data (xsc(69,19,i),i=1,10)/0.359959543, 10.3489361, $ 190.831161, 2104.99976, 14006.3213, 53.4860840, $ 28089.1348, 148433.328, 2130197.75, 21017072.0/ data (xsc(70, 1,i),i=1,11)/ 1541.71777,0.0000, $ 0.0000,0.0000,0.0000,0.891275764, $ 59.0038948, 493.002045, 1555.27869, 2710.34204, 3045.11670/ data (xsc(70, 2,i),i=1,11)/ 148.159210, 1903.04565, $ 0.0000,0.0000,0.0000, 10.2957468, $ 581.685791, 3144.11011, 7215.60938, 10556.7441, 11334.2373/ data (xsc(70, 3,i),i=1,11)/ 53.8273430, 1526.73938, $ 0.0000,0.0000,0.0000, 2.41081572, $ 361.532532, 3538.25586, 11624.1348, 20375.9707, 23828.7031/ data (xsc(70, 4,i),i=1,11)/ 58.2434082, 2096.82056, $ 0.0000,0.0000,0.0000, 2.81023669, $ 644.727661, 7107.52979, 24810.9688, 44999.6055, 53052.9805/ data (xsc(70, 5,i),i=1,11)/ 31.6497993, 419.014099, $ 3980.23950, 24817.1445,0.0000, 94.8272552, $ 2958.55615, 12004.4395, 23485.4336, 31333.7148, 34275.3516/ data (xsc(70, 6,i),i=1,11)/ 11.6992607, 286.825867, $ 4593.76123, 36350.0625,0.0000, 59.9591522, $ 4040.46191, 19866.1914, 39596.6797, 51595.8047, 61729.0781/ data (xsc(70, 7,i),i=1,11)/ 13.0980949, 407.446991, $ 7849.08105, 78921.0469,0.0000, 107.206200, $ 8900.72363, 48445.7031, 105081.813, 145282.313, 172125.234/ data (xsc(70, 8,i),i=1,11)/0.715343714, 59.8061752, $ 3298.45850, 101215.008,0.0000, 24.4502983, $ 8020.99121, 87857.6094, 283850.594, 498111.625, 5105320.50/ data (xsc(70, 9,i),i=1,11)/0.513391793, 61.6185150, $ 4163.95898, 140750.281,0.0000, 26.9674721, $ 11601.7119, 133430.359, 439541.156, 782701.625, 7711613.50/ data (xsc(70,10,i),i=1,10)/ 7.75942469, 102.477119, $ 1010.94470, 7549.69922, 39027.3984,0.573737562, $ 957.574097, 15289.0342, 48781.6914, 69840.4219/ data (xsc(70,11,i),i=1,10)/ 2.74265718, 64.9363937, $ 1021.21985, 9246.31445, 41915.9375,0.224003002, $ 1520.10571, 24818.6543, 54561.5313, 57819.7070/ data (xsc(70,12,i),i=1,10)/ 3.03556943, 90.9325562, $ 1700.32141, 18316.3105, 108793.031,0.312239051, $ 3632.25000, 70013.7891, 191272.922, 240422.688/ data (xsc(70,13,i),i=1,10)/0.168596536, 13.0654650, $ 627.022766, 15258.4873, 148995.359,0.104630895, $ 8614.63477, 200358.922, 139436.656, 566868.563/ data (xsc(70,14,i),i=1,10)/0.120508559, 13.3664236, $ 785.539612, 21021.0391, 218893.000,9.704419225d-02, $ 14176.2070, 323827.875, 209291.875, 922033.500/ data (xsc(70,15,i),i=1,10)/4.783113254d-04,0.150039479, $ 26.7413387, 2401.42017, 107613.094, 2872.09058, $ 3231043.25, 1160468.25, 645744.625, 861925.125/ data (xsc(70,16,i),i=1,10)/6.005421747d-04,0.180947632, $ 32.4296608, 2977.81274, 135966.766, 3564.33423, $ 4325047.50, 1725410.88, 922834.375, 786038.563/ data (xsc(70,17,i),i=1,10)/ 1.28677082, 16.4926815, $ 161.412033, 1242.09070, 7478.63379, 19.6980019, $ 7301.84863, 52230.3672, 62098.7070, 51460.8164/ data (xsc(70,18,i),i=1,10)/0.368140638, 8.30016899, $ 127.264908, 1173.84985, 6308.03711, 84.3702698, $ 15436.2383, 179142.203, 3209781.50, 20650992.0/ data (xsc(70,19,i),i=1,10)/0.384861618, 10.9296017, $ 198.542496, 2156.73022, 14119.7676, 128.185013, $ 41605.4023, 259133.484, 4670217.50, 38034944.0/ data (xsc(71, 1,i),i=1,11)/ 1613.48828,0.0000, $ 0.0000,0.0000,0.0000,0.883233249, $ 57.2371292, 475.654175, 1498.60583, 2611.30737, 2930.99756/ data (xsc(71, 2,i),i=1,11)/ 155.393066, 1970.14307, $ 0.0000,0.0000,0.0000, 9.92060280, $ 557.767273, 3016.21631, 6924.03613, 10125.4639, 10887.1211/ data (xsc(71, 3,i),i=1,11)/ 58.6059151, 1637.07654, $ 0.0000,0.0000,0.0000, 2.36310601, $ 349.590149, 3405.74805, 11166.1563, 19539.6133, 22904.3906/ data (xsc(71, 4,i),i=1,11)/ 62.7940331, 2236.17310, $ 0.0000,0.0000,0.0000, 2.71535683, $ 620.746887, 6838.91699, 23871.2461, 43283.5977, 51212.6484/ data (xsc(71, 5,i),i=1,11)/ 33.3201714, 436.623932, $ 4102.14990, 25088.7871,0.0000, 90.3469238, $ 2837.81519, 11514.1992, 22520.4492, 30028.6621, 32739.8477/ data (xsc(71, 6,i),i=1,11)/ 12.7611723, 307.310638, $ 4814.39746, 36885.3945,0.0000, 57.6274033, $ 3863.48804, 19000.7676, 37902.2305, 49390.6875, 59108.7813/ data (xsc(71, 7,i),i=1,11)/ 14.1667366, 434.669891, $ 8237.31543, 81203.1641,0.0000, 102.608055, $ 8537.13574, 46617.7578, 101414.391, 140450.109, 166391.203/ data (xsc(71, 8,i),i=1,11)/0.804120004, 66.2429428, $ 3587.74219, 107704.898,0.0000, 23.3029346, $ 7631.86670, 83671.4688, 270691.625, 470973.875, 4747013.00/ data (xsc(71, 9,i),i=1,11)/0.574538291, 68.0975571, $ 4525.43750, 149873.734,0.0000, 25.3744278, $ 10999.2100, 126918.438, 419047.344, 740054.438, 7348300.50/ data (xsc(71,10,i),i=1,10)/ 8.19799042, 107.265495, $ 1049.34241, 7751.48779, 39244.7852,0.527745187, $ 922.143555, 14694.8594, 46854.3125, 67806.1094/ data (xsc(71,11,i),i=1,10)/ 3.00205064, 69.8310776, $ 1076.05896, 9526.97656, 41866.3672,0.224305376, $ 1484.56787, 24069.7949, 53115.8008, 57030.2344/ data (xsc(71,12,i),i=1,10)/ 3.29421878, 97.3660736, $ 1793.27148, 19027.4980, 110932.484,0.293062896, $ 3441.92285, 67151.6953, 186272.109, 238990.172/ data (xsc(71,13,i),i=1,10)/0.190909237, 14.5593395, $ 684.131104, 16224.4375, 152658.563,9.987676889d-02, $ 8416.99707, 196324.063, 150398.484, 419206.000/ data (xsc(71,14,i),i=1,10)/0.135900751, 14.8690519, $ 857.071838, 22396.6934, 225081.625,8.654536307d-02, $ 13099.7598, 310839.906, 230788.641, 645989.625/ data (xsc(71,15,i),i=1,10)/5.493086064d-04,0.180792093, $ 32.5430222, 2858.23975, 123095.383, 2413.55591, $ 3257706.00, 1017187.19, 744482.438, 1443660.50/ data (xsc(71,16,i),i=1,10)/6.554692518d-04,0.215257287, $ 39.6647453, 3566.21997, 156586.266, 3008.99121, $ 4377753.00, 1460495.00, 957145.563, 1859926.50/ data (xsc(71,17,i),i=1,10)/ 1.39114165, 17.7119598, $ 172.230255, 1314.03467, 7828.31934, 19.0485363, $ 7102.07129, 51647.7773, 66721.8984, 55492.9336/ data (xsc(71,18,i),i=1,10)/0.419142008, 9.31658077, $ 140.336517, 1269.64856, 6687.05322, 60.9940910, $ 13675.2520, 119009.672, 2060831.88, 9758692.00/ data (xsc(71,19,i),i=1,10)/0.437312812, 12.2985239, $ 220.535339, 2363.42725, 15287.5957, 90.7493744, $ 36299.0938, 200419.875, 2854342.50, 17617800.0/ data (xsc(72, 1,i),i=1,11)/ 1688.20093,0.0000, $ 0.0000,0.0000,0.0000,0.874796391, $ 55.5281868, 458.902313, 1443.75891, 2514.02637, 2823.03589/ data (xsc(72, 2,i),i=1,11)/ 162.862030, 2038.14709, $ 0.0000,0.0000,0.0000, 9.50245762, $ 534.485107, 2891.82593, 6642.30713, 9725.18066, 10436.9785/ data (xsc(72, 3,i),i=1,11)/ 63.7537384, 1754.60303, $ 0.0000,0.0000,0.0000, 2.31085491, $ 337.440704, 3274.01147, 10717.6094, 18738.5156, 21985.8203/ data (xsc(72, 4,i),i=1,11)/ 67.6438751, 2383.94409, $ 0.0000,0.0000,0.0000, 2.61657453, $ 596.337463, 6570.35596, 22947.1758, 41677.6367, 49231.2305/ data (xsc(72, 5,i),i=1,11)/ 35.0507317, 454.802521, $ 4229.03564, 25362.2930,0.0000, 85.5042877, $ 2697.13721, 10965.4121, 21466.5176, 28631.2539, 31063.2051/ data (xsc(72, 6,i),i=1,11)/ 13.8976984, 328.929138, $ 5043.80518, 37395.7422,0.0000, 54.8440781, $ 3668.76709, 18083.6582, 36142.5859, 47197.5508, 55615.4844/ data (xsc(72, 7,i),i=1,11)/ 15.2976475, 463.293823, $ 8645.29688, 83623.2344,0.0000, 97.0691605, $ 8123.25684, 44606.0742, 97459.6406, 135486.656, 157065.313/ data (xsc(72, 8,i),i=1,11)/0.902078450, 73.3129120, $ 3907.98950, 115234.406,0.0000, 21.6249485, $ 7123.05469, 78621.7813, 255715.156, 441644.375, 4246291.50/ data (xsc(72, 9,i),i=1,11)/0.642104566, 75.2015991, $ 4923.74219, 160371.875,0.0000, 23.2587910, $ 10237.4199, 119206.297, 395983.813, 693805.250, 6792580.00/ data (xsc(72,10,i),i=1,10)/ 8.65830803, 112.285439, $ 1090.12671, 7975.20752, 39552.8906,0.480294138, $ 849.728149, 13673.6367, 44007.0430, 64164.0156/ data (xsc(72,11,i),i=1,10)/ 3.28429103, 75.0950470, $ 1134.99402, 9836.72656, 41694.0547,0.205113158, $ 1359.13391, 22479.2051, 50541.5391, 54532.5078/ data (xsc(72,12,i),i=1,10)/ 3.57295585, 104.230095, $ 1892.04309, 19789.1621, 113293.516,0.264104277, $ 3174.73242, 63355.3164, 179580.281, 234113.688/ data (xsc(72,13,i),i=1,10)/0.216101766, 16.2323036, $ 748.213989, 17346.4609, 157133.984,7.853221148d-02, $ 7099.69336, 181097.531, 164954.906, 298310.938/ data (xsc(72,14,i),i=1,10)/0.153188035, 16.5431213, $ 936.576660, 23953.7383, 232304.688,6.261973083d-02, $ 10912.7920, 285928.219, 257060.188, 446283.844/ data (xsc(72,15,i),i=1,10)/6.675710320d-04,0.220822141, $ 39.3831596, 3398.25854, 141960.484, 71.2154617, $ 1770791.25, 1856734.88, 476388.219, 709763.125/ data (xsc(72,16,i),i=1,10)/7.900626515d-04,0.262668312, $ 48.0901070, 4250.57373, 181161.719, 87.1911545, $ 2318386.00, 2598049.25, 641885.063, 975640.875/ data (xsc(72,17,i),i=1,10)/ 1.51112092, 19.0874825, $ 184.359863, 1395.62964, 8246.86230, 15.4164753, $ 6106.85547, 47049.9883, 67087.8125, 55035.6289/ data (xsc(72,18,i),i=1,10)/0.477280259, 10.4594488, $ 154.855560, 1375.17896, 7105.65918, 31.8034935, $ 10495.0957, 64203.2539, 1095132.38, 5265648.50/ data (xsc(72,19,i),i=1,10)/0.495673567, 13.8010616, $ 244.304199, 2582.97314, 16523.7656, 80.3886871, $ 35074.4531, 189362.813, 2306188.00, 12463341.0/ data (xsc(72,20,i),i=1,10)/5.636430345d-03,0.354511261, $ 14.7646332, 333.031616, 3140.31787, 648.280334, $ 102469.688, 7361422.00, 11662020.0, 12384611.0/ data (xsc(73, 1,i),i=1,11)/ 1764.08289,0.0000, $ 0.0000,0.0000,0.0000,0.868327558, $ 53.9224358, 443.057892, 1391.93054, 2423.33130, 2718.72656/ data (xsc(73, 2,i),i=1,11)/ 170.510300, 2106.43604, $ 0.0000,0.0000,0.0000, 9.15231609, $ 511.630402, 2773.23804, 6372.74121, 9331.01563, 10000.7559/ data (xsc(73, 3,i),i=1,11)/ 69.2644882, 1877.56543, $ 0.0000,0.0000,0.0000, 2.26493645, $ 326.306915, 3151.53320, 10298.1045, 18016.4746, 20370.0176/ data (xsc(73, 4,i),i=1,11)/ 72.7586212, 2537.89771, $ 0.0000,0.0000,0.0000, 2.52462101, $ 573.537903, 6318.83740, 22075.7539, 40093.8438, 47404.6367/ data (xsc(73, 5,i),i=1,11)/ 36.8399849, 473.191589, $ 4352.81982, 25634.0977,0.0000, 81.4038849, $ 2574.11890, 10475.6426, 20512.1055, 27388.6699, 29541.9727/ data (xsc(73, 6,i),i=1,11)/ 15.1124964, 351.513580, $ 5274.74268, 37790.0078,0.0000, 52.0738792, $ 3491.09937, 17234.5039, 34495.3164, 45095.1875, 53710.6758/ data (xsc(73, 7,i),i=1,11)/ 16.5006599, 493.182770, $ 9062.79297, 86018.9922,0.0000, 91.9110031, $ 7732.41016, 42691.3672, 93661.6953, 130546.828, 151169.859/ data (xsc(73, 8,i),i=1,11)/ 1.00968874, 80.9500122, $ 4246.04883, 122891.891,0.0000, 20.2029152, $ 6680.40820, 74131.8359, 242187.578, 416389.344, 3998763.75/ data (xsc(73, 9,i),i=1,11)/0.715727150, 82.8500214, $ 5344.44971, 171114.109,0.0000, 21.4328136, $ 9566.49414, 112277.258, 374941.938, 652197.063, 6060169.00/ data (xsc(73,10,i),i=1,10)/ 9.13684845, 117.435211, $ 1131.14722, 8187.01270, 39774.8008,0.450498790, $ 800.082458, 12929.4141, 41821.4141, 61330.8359/ data (xsc(73,11,i),i=1,10)/ 3.59210086, 80.6877594, $ 1195.90381, 10142.7871, 41449.8906,0.189176232, $ 1248.69189, 21034.2090, 48140.8828, 52246.6875/ data (xsc(73,12,i),i=1,10)/ 3.87172508,111.500801 , $ 1995.66016,20583.1133,115724.797 ,0.234615475 , $ 2898.20264,59392.9688,172377.781,228286.563/ data (xsc(73,13,i),i=1,10)/0.244223863,18.0670052 , $ 816.785461,18500.4902,161459.875 ,6.520989537d-02, $ 6196.16357,169041.797,178054.969,224480.016/ data (xsc(73,14,i),i=1,10)/0.172409460,18.3736744 , $ 1021.24396,25537.3867,239193.469 ,5.150463432d-02, $ 9607.10059,268493.250,279922.344,331131.531/ data (xsc(73,15,i),i=1,10)/8.157273987d-04,0.268452168 , $ 47.1837082,3992.97632,161293.719,15.8366928 , $ 1023417.75,2180539.50,449506.844,567391.875/ data (xsc(73,16,i),i=1,10)/9.591804119d-04,0.318981498 , $ 57.6663742,5002.06787,206289.688,19.2783432 , $ 1330570.88,3008531.25,611872.125,797208.625/ data (xsc(73,17,i),i=1,10)/ 1.64040196,20.5572128 , $ 197.213211,1480.75830,8680.72852,13.6645327 , $ 5590.10547,44457.9922,67152.5859,56622.4805/ data (xsc(73,18,i),i=1,10)/0.541975379,11.7062254 , $ 170.306900,1483.91870,7528.13330,23.3908730 , $ 9218.46289,50637.6055,783713.750,3727575.25/ data (xsc(73,19,i),i=1,10)/0.561229527,15.4432154 , $ 269.733032,2815.31812,17838.4727,56.7247391 , $ 30256.5352,162221.516,1595024.88,8489136.00/ data (xsc(73,20,i),i=1,10)/1.150703989d-02,0.728107095 , $ 30.0322151,661.442322,6055.97852,944.121033 , $ 119037.039,11622477.0,14882909.0,12524732.0/ data (xsc(74, 1,i),i=1,11)/ 1839.59070 ,0.0000d0, $ 0.0000d0,0.0000d0,0.0000d0,0.861603260 , $ 52.3897018,427.891815,1342.07275,2334.80713,2620.14185/ data (xsc(74, 2,i),i=1,11)/ 178.335876,2174.81152 , $ 0.0000d0,0.0000d0,0.0000d0, 8.82645988 , $ 490.719055,2661.26294,6117.26758,8952.00098,9617.07813/ data (xsc(74, 3,i),i=1,11)/ 75.1551666,2006.74841 , $ 0.0000d0,0.0000d0,0.0000d0, 2.20830035 , $ 315.302155,3034.92700,9898.46484,17287.3848,19598.9844/ data (xsc(74, 4,i),i=1,11)/ 78.1690216,2698.55029 , $ 0.0000d0,0.0000d0,0.0000d0, 2.43909431 , $ 552.122559,6081.44873,21254.2305,38657.4180,45660.5977/ data (xsc(74, 5,i),i=1,11)/ 38.6690903,491.844788 , $ 4476.14502,25778.6523 ,0.0000d0, 77.4271851 , $ 2455.24756,10003.2510,19595.5137,26147.5293,28204.7148/ data (xsc(74, 6,i),i=1,11)/ 16.4158726,375.142456 , $ 5507.75635,38107.6367 ,0.0000d0, 49.7714119 , $ 3324.67725,16432.8613,32928.4063,43064.8789,51348.9023/ data (xsc(74, 7,i),i=1,11)/ 17.7657871,524.185852 , $ 9487.11426,88367.6172 ,0.0000d0, 87.2588196 , $ 7375.69922,40920.1836,90119.0391,125967.289,147796.500/ data (xsc(74, 8,i),i=1,11)/ 1.12825680,89.2119217 , $ 4604.43408,130792.680 ,0.0000d0, 18.8366451 , $ 6276.40381,69987.8516,229586.891,393425.563,3693187.00/ data (xsc(74, 9,i),i=1,11)/0.796105862,91.0866699 , $ 5788.82764,182139.047 ,0.0000d0, 19.8286781 , $ 8965.34570,105974.055,355593.156,616299.875,5715916.50/ data (xsc(74,10,i),i=1,10)/ 9.64179802,122.772850 , $ 1173.07715,8399.04297,39935.5742 ,0.421601743 , $ 751.282166,12201.3760,39692.8438,58542.0313/ data (xsc(74,11,i),i=1,10)/ 3.92075706,86.5611801 , $ 1258.35046,10439.9082,41147.5898 ,0.177314118 , $ 1160.63550,19814.1895,46024.0625,50295.0273/ data (xsc(74,12,i),i=1,10)/ 4.19067049,119.129013 , $ 2102.08813,21368.9277,118118.719 ,0.216527209 , $ 2712.24292,56548.5117,167150.609,224852.141/ data (xsc(74,13,i),i=1,10)/0.275548726,20.0754814 , $ 890.190186,19696.5840,165691.563 ,5.526931211d-02, $ 5477.47314,158389.719,189602.141,177491.109/ data (xsc(74,14,i),i=1,10)/0.193728566,20.3751984 , $ 1111.99805,27188.4883,246114.906 ,4.290794209d-02, $ 8504.03711,252341.953,300490.063,259114.969/ data (xsc(74,15,i),i=1,10)/9.907740168d-04,0.324058443 , $ 56.1426735,4666.74756,182839.422,3.27545214 , $ 496492.813,2512080.00,442645.656,433333.844/ data (xsc(74,16,i),i=1,10)/1.164219226d-03,0.385088027 , $ 68.5707245,5836.61279,232993.234,5.84086895 , $ 776562.438,3326166.50,600367.000,668055.625/ data (xsc(74,17,i),i=1,10)/ 1.77789497,22.1060219 , $ 210.645462,1568.55933,9127.75977,12.3787432 , $ 5189.83691,42301.6406,66690.7344,58239.9375/ data (xsc(74,18,i),i=1,10)/0.614715755,13.0612030 , $ 186.514069,1593.65063,7943.89209,23.3992462 , $ 9255.58008,50394.6445,732290.313,3191617.00/ data (xsc(74,19,i),i=1,10)/0.630771518,17.1803799 , $ 296.236694,3050.06738,19139.8848,66.5594025 , $ 33376.7227,178937.891,1679722.50,7773797.00/ data (xsc(74,20,i),i=1,10)/1.981321163d-02, 1.25190413 , $ 50.9601440,1095.75830,9751.22949,1327.13818 , $ 150278.109,16371733.0,17352948.0,12707123.0/ data (xsc(75, 1,i),i=1,11)/ 1915.94141 ,0.0000d0, $ 0.0000d0,0.0000d0,0.0000d0,0.856772244 , $ 50.9274673,413.388062,1294.55408,2251.55054,2524.54565/ data (xsc(75, 2,i),i=1,11)/ 186.362640,2243.05322 , $ 0.0000d0,0.0000d0,0.0000d0, 8.52171612 , $ 470.999451,2555.01782,5874.97314,8606.56836,9233.93164/ data (xsc(75, 3,i),i=1,11)/ 81.4502411,2141.64185 , $ 0.0000d0,0.0000d0,0.0000d0, 2.16742635 , $ 305.453949,2925.90161,9523.15723,16638.9668,18821.6328/ data (xsc(75, 4,i),i=1,11)/ 83.8583908,2865.32886 , $ 0.0000d0,0.0000d0,0.0000d0, 2.35974240 , $ 532.163940,5859.44531,20479.0078,37230.5430,42373.4063/ data (xsc(75, 5,i),i=1,11)/ 40.5475540,510.697052 , $ 4597.07520,25755.3281 ,0.0000d0, 73.8408203 , $ 2346.29224,9565.46484,18739.3359,25000.2461,26851.5547/ data (xsc(75, 6,i),i=1,11)/ 17.7996998,399.693878 , $ 5740.29785,38368.5313 ,0.0000d0, 47.7427826 , $ 3174.26465,15695.8252,31477.2227,41229.4531,48126.5547/ data (xsc(75, 7,i),i=1,11)/ 19.0995522,556.300598 , $ 9915.43457,90657.8906 ,0.0000d0, 83.2025681 , $ 7056.90430,39308.3945,86865.1719,121818.766,139126.891/ data (xsc(75, 8,i),i=1,11)/ 1.25757134,98.0825653 , $ 4979.79834,138712.344 ,0.0000d0, 17.7671642 , $ 5929.13525,66329.9375,218231.391,373204.563,3301167.25/ data (xsc(75, 9,i),i=1,11)/0.884033144,99.9366913 , $ 6255.14063,193281.297 ,0.0000d0, 18.3719311 , $ 8438.23535,100324.594,337942.750,584597.063,5269126.00/ data (xsc(75,10,i),i=1,10)/ 10.1583014,128.224472 , $ 1215.58923,8605.82031,40085.8594 ,0.396186143 , $ 707.321289,11537.1494,37729.2148,55959.2500/ data (xsc(75,11,i),i=1,10)/ 4.27405453,92.7415237 , $ 1322.24011,10726.3467,40762.2188 ,0.159107268 , $ 1087.44250,18750.2637,44108.4883,48576.1055/ data (xsc(75,12,i),i=1,10)/ 4.53424215,127.161201 , $ 2211.54761,22153.6484,120493.781 ,0.204284385 , $ 2572.76563,54298.7188,162975.359,222607.797/ data (xsc(75,13,i),i=1,10)/0.310283005,22.2605629 , $ 967.831177,20901.0840,169629.563 ,4.961069301d-02, $ 5023.96338,150751.188,199682.219,149001.297/ data (xsc(75,14,i),i=1,10)/0.217295468,22.5520267 , $ 1208.34241,28870.9023,252725.297 ,3.730181977d-02, $ 7712.63477,239449.125,318651.625,215458.031/ data (xsc(75,15,i),i=1,10)/1.201500068d-03,0.388672352 , $ 66.1321869,5375.47461,202675.484,2.35555959 , $ 417513.969,2530010.25,432043.594,420179.375/ data (xsc(75,16,i),i=1,10)/1.404164592d-03,0.461420894 , $ 80.8667755,6745.74121,260033.359,2.82714105 , $ 538840.125,3440587.50,593333.813,597202.438/ data (xsc(75,17,i),i=1,10)/ 1.92073214,23.7256927 , $ 224.696335,1659.15942,9583.94531,11.4298239 , $ 4883.94971,40571.7852,66197.8438,60112.1328/ data (xsc(75,18,i),i=1,10)/0.693705618,14.5190458 , $ 203.630386,1705.74011,8358.34766,27.6798763 , $ 10018.3906,56245.9688,783515.875,2965132.75/ data (xsc(75,19,i),i=1,10)/0.708791614,19.0751152 , $ 324.471436,3295.98877,20495.2559,79.1133957 , $ 37051.2227,198682.766,1777104.75,7157214.00/ data (xsc(75,20,i),i=1,10)/2.498664521d-02, 1.57436454 , $ 63.2084389,1326.85498,11485.3457,1627.00220 , $ 192282.688,17979350.0,15546440.0,10769062.0/ data (xsc(75,21,i),i=1,10)/2.776123583d-03,0.249567151 , $ 12.2760305,284.824127,2630.48193,502.536102 , $ 73569.9609,4687253.50,4525270.00,3534136.00/ data (xsc(76, 1,i),i=1,11)/ 1998.90881 ,0.0000d0, $ 0.0000d0,0.0000d0,0.0000d0,0.851439536 , $ 49.5324211,399.505341,1248.81079,2170.23877,2434.48438/ data (xsc(76, 2,i),i=1,11)/ 194.573410,2311.51489 , $ 0.0000d0,0.0000d0,0.0000d0, 8.22620964 , $ 451.903687,2452.52637,5641.01025,8263.15332,8874.19434/ data (xsc(76, 3,i),i=1,11)/ 88.1680374,2283.05469 , $ 0.0000d0,0.0000d0,0.0000d0, 2.12791586 , $ 296.024048,2821.88159,9165.03418,15993.6143,18093.2109/ data (xsc(76, 4,i),i=1,11)/ 89.8695908,3039.38940 , $ 0.0000d0,0.0000d0,0.0000d0, 2.28465271 , $ 513.147217,5647.55273,19742.5625,35937.0938,40865.7891/ data (xsc(76, 5,i),i=1,11)/ 42.4907570,529.875488 , $ 4717.12939 ,0.0000d0,0.0000d0, 70.3948135 , $ 2240.75293,9141.83301,17910.0566,23923.6348,25565.9590/ data (xsc(76, 6,i),i=1,11)/ 19.2818851,425.341064 , $ 5974.59668,38379.8125 ,0.0000d0, 45.8187141 , $ 3030.62378,14990.4873,30079.4863,39400.7031,45775.0156/ data (xsc(76, 7,i),i=1,11)/ 20.5141945,589.783813 , $ 10354.5322,92906.1797 ,0.0000d0, 78.8293304 , $ 6746.38770,37738.2813,83675.9063,117593.523,133297.078/ data (xsc(76, 8,i),i=1,11)/ 1.39927042,107.673134 , $ 5380.69873,147113.125 ,0.0000d0, 16.6950417 , $ 5585.86182,62750.9883,207209.391,354913.469,3120916.50/ data (xsc(76, 9,i),i=1,11)/0.979503036,109.458542 , $ 6751.12744,205034.984 ,0.0000d0, 17.0489063 , $ 7928.55518,94875.0156,320961.156,555184.313,4692289.50/ data (xsc(76,10,i),i=1,10)/ 10.6938610,133.808701 , $ 1258.50085,8806.44629,40180.1016 ,0.375633150 , $ 669.973206,10958.3008,35978.0820,53634.3945/ data (xsc(76,11,i),i=1,10)/ 4.65388107,99.2522964 , $ 1388.01270,11008.4053,40285.1289 ,0.149091095 , $ 1014.79846,17698.9414,42182.9766,46797.1055/ data (xsc(76,12,i),i=1,10)/ 4.89679003,135.598221 , $ 2326.23145,22975.7363,122932.898 ,0.187397838 , $ 2393.85498,51509.3242,157549.375,218334.688/ data (xsc(76,13,i),i=1,10)/0.348783582,24.6409035 , $ 1050.63794,22148.4180,173515.281 ,4.452895001d-02, $ 4606.27441,143338.641,208318.391,130930.875/ data (xsc(76,14,i),i=1,10)/0.243262097,24.9115200 , $ 1310.11157,30572.0625,259095.313 ,3.403215483d-02, $ 7209.48877,230274.516,334488.406,191418.828/ data (xsc(76,15,i),i=1,10)/1.447967952d-03,0.463260889 , $ 77.4304123,6157.79639,223774.094,1.48723567 , $ 326497.031,2556644.50,422422.719,388640.281/ data (xsc(76,16,i),i=1,10)/1.687170239d-03,0.549519956 , $ 94.6720352,7731.37061,287446.625,1.77697241 , $ 420702.313,3466842.00,580206.188,554103.000/ data (xsc(76,17,i),i=1,10)/ 2.07420516,25.4199944 , $ 239.049011,1749.07959,10019.4287,11.9897060 , $ 5035.51123,41312.3555,67346.7422,65126.1133/ data (xsc(76,18,i),i=1,10)/0.781921804,16.1034527 , $ 221.873444,1824.38684,8787.28320,16.6444149 , $ 7928.81055,40503.4844,488539.688,2061220.63/ data (xsc(76,19,i),i=1,10)/0.793199241,21.1034431 , $ 354.554565,3559.82104,21988.5039,42.5161095 , $ 27586.7891,154677.563,1046575.56,4693892.50/ data (xsc(76,20,i),i=1,10)/3.070637211d-02, 1.92730153 , $ 76.2970963,1563.94263,13180.4521,1332.16736 , $ 118385.555,17022298.0,13249806.0,8565134.00/ data (xsc(76,21,i),i=1,10)/6.823690142d-03,0.613249362 , $ 29.7935276,675.614624,6084.06689,842.825684 , $ 94287.0703,9001080.00,7622129.50,5465839.50/ data (xsc(77, 1,i),i=1,11)/ 2084.31763 ,0.0000d0, $ 0.0000d0,0.0000d0,0.0000d0,0.848372638 , $ 48.1983681,386.203674,1205.15100,2093.68530,2346.68823/ data (xsc(77, 2,i),i=1,11)/ 202.978378,2379.82813 , $ 0.0000d0,0.0000d0,0.0000d0, 7.94961882 , $ 433.875183,2355.21118,5418.98389,7944.38232,8525.54395/ data (xsc(77, 3,i),i=1,11)/ 95.3508377,2431.26270 , $ 0.0000d0,0.0000d0,0.0000d0, 2.08959174 , $ 286.991730,2722.27539,8823.24609,15401.6016,17388.1426/ data (xsc(77, 4,i),i=1,11)/ 96.2003555,3221.25073 , $ 0.0000d0,0.0000d0,0.0000d0, 2.21084285 , $ 494.703766,5443.54102,19033.6289,34653.4336,39425.0234/ data (xsc(77, 5,i),i=1,11)/ 44.4766579,549.367920 , $ 4837.60547 ,0.0000d0,0.0000d0, 66.8703003 , $ 2134.53540,8720.20117,17093.2480,22808.8457,24449.2773/ data (xsc(77, 6,i),i=1,11)/ 20.8563576,452.088379 , $ 6211.59619,38778.5977 ,0.0000d0, 43.8913994 , $ 2889.76660,14303.1133,28721.6406,37636.5820,44253.2461/ data (xsc(77, 7,i),i=1,11)/ 21.9989281,624.555847 , $ 10804.3447,95120.3594 ,0.0000d0, 74.9710388 , $ 6445.19922,36214.6797,80581.5391,113507.164,130227.563/ data (xsc(77, 8,i),i=1,11)/ 1.55473530,118.027016 , $ 5806.80859,155937.141 ,0.0000d0, 15.6755810 , $ 5258.79541,59341.3984,196701.406,337881.219,2871178.25/ data (xsc(77, 9,i),i=1,11)/ 1.08376312,119.709694 , $ 7277.57080,217373.359 ,0.0000d0, 15.8038664 , $ 7443.31494,89683.9844,304795.938,528760.125,4303920.00/ data (xsc(77,10,i),i=1,10)/ 11.2494116,139.565872 , $ 1302.66797,9012.43750,40174.4141 ,0.349638999 , $ 625.133118,10294.0283,34029.5703,51012.5156/ data (xsc(77,11,i),i=1,10)/ 5.06145191,106.100014 , $ 1455.52429,11283.7832,39719.5938 ,0.139374569 , $ 945.073547,16682.4863,40277.2813,44989.4844/ data (xsc(77,12,i),i=1,10)/ 5.28274965,144.459274 , $ 2445.39209,23822.7559,125401.656 ,0.170843989 , $ 2215.44385,48694.0586,151871.141,213374.094/ data (xsc(77,13,i),i=1,10)/0.391450971,27.2448635 , $ 1140.29614,23494.5469,177507.766 ,3.553931415d-02, $ 4019.15039,132922.703,214696.141,117752.625/ data (xsc(77,14,i),i=1,10)/0.271958530,27.4967785 , $ 1421.43127,32464.7871,266095.906 ,2.719595842d-02, $ 6175.17725,212257.125,346230.438,172286.266/ data (xsc(77,15,i),i=1,10)/1.736157807d-03,0.549801707 , $ 90.5000610,7081.02197,250507.734 ,0.377159357 , $ 152774.266,2498325.50,461861.563,300963.813/ data (xsc(77,16,i),i=1,10)/2.016902668d-03,0.651284337 , $ 110.502411,8871.02246,320563.281 ,0.563207269 , $ 223356.625,3402945.75,615073.625,444890.000/ data (xsc(77,17,i),i=1,10)/ 2.23526239,27.1868801 , $ 254.041412,1844.41895,10506.6924,9.46362782 , $ 4318.91797,37110.8359,63932.7344,62294.8242/ data (xsc(77,18,i),i=1,10)/0.877922356,17.7858124 , $ 240.620728,1940.79102,9193.33105,14.8904295 , $ 7501.68311,37936.2227,423219.875,1749258.50/ data (xsc(77,19,i),i=1,10)/0.883787930,23.2416325 , $ 385.564301,3824.12793,23457.9824,35.0851936 , $ 25319.3652,146989.172,863663.250,3837076.75/ data (xsc(77,20,i),i=1,10)/3.728385270d-02, 2.32002163 , $ 90.3582153,1808.81775,14857.0703,1107.31140 , $ 77534.5313,15999634.0,11557034.0,7199740.50/ data (xsc(77,21,i),i=1,10)/1.240959018d-02, 1.10907686 , $ 53.0882607,1176.70337,10343.2783,1072.80054 , $ 94213.7109,12927625.0,9863556.00,6704388.00/ data (xsc(78, 1,i),i=1,11)/ 2152.86523 ,0.0000d0, $ 0.0000d0,0.0000d0,0.0000d0,0.846432447 , $ 46.9265976,373.479858,1163.34302,2020.09045,2262.84082/ data (xsc(78, 2,i),i=1,11)/ 211.555557,2448.26978 , $ 0.0000d0,0.0000d0,0.0000d0, 7.68703556 , $ 416.657501,2262.49536,5206.62012,7630.89746,8209.95313/ data (xsc(78, 3,i),i=1,11)/ 103.003242,2586.15039 , $ 0.0000d0,0.0000d0,0.0000d0, 2.05388427 , $ 278.498779,2628.65894,8500.87891,14814.5088,16786.3652/ data (xsc(78, 4,i),i=1,11)/ 102.874779,3410.68140 , $ 0.0000d0,0.0000d0,0.0000d0, 2.13092494 , $ 476.970398,5252.69678,18371.7715,33486.5664,38127.0547/ data (xsc(78, 5,i),i=1,11)/ 46.5231895,569.037903 , $ 4954.47266 ,0.0000d0,0.0000d0, 63.4835701 , $ 2041.33167,8343.52637,16352.0498,21835.4512,23311.2852/ data (xsc(78, 6,i),i=1,11)/ 22.5318508,479.917175 , $ 6448.80908 ,0.0000d0,0.0000d0, 42.1726990 , $ 2761.56201,13670.0547,27461.3164,36029.4453,40899.0625/ data (xsc(78, 7,i),i=1,11)/ 23.5708256,660.746826 , $ 11264.8525,97432.0156 ,0.0000d0, 71.4618454 , $ 6167.74268,34803.2539,77696.2500,109723.523,123099.289/ data (xsc(78, 8,i),i=1,11)/ 1.72388852,129.156601 , $ 6258.42529,165190.234 ,0.0000d0, 14.7782784 , $ 4969.39600,56307.0273,187319.625,322146.500,2506648.50/ data (xsc(78, 9,i),i=1,11)/ 1.19665027,130.708649 , $ 7836.30566,230389.578 ,0.0000d0, 14.6959858 , $ 7008.56201,85020.4922,290270.938,504087.000,4003906.75/ data (xsc(78,10,i),i=1,10)/ 11.8233175,145.439590 , $ 1346.93054,9208.60059,40177.9961 ,0.332287967 , $ 592.279236,9783.34766,32463.5078,48631.1563/ data (xsc(78,11,i),i=1,10)/ 5.50269032,113.329018 , $ 1525.03955,11554.3320,38976.4805 ,0.130480543 , $ 880.564514,15729.3545,38386.2813,43067.9727/ data (xsc(78,12,i),i=1,10)/ 5.69251537,153.742264 , $ 2568.58374,24683.3379,127952.664 ,0.149947762 , $ 2075.37939,46410.0625,147089.547,209243.250/ data (xsc(78,13,i),i=1,10)/0.438516498,30.0672398 , $ 1235.32422,24872.5625,181224.297 ,3.104903921d-02, $ 3631.53516,125298.000,218161.641,112476.070/ data (xsc(78,14,i),i=1,10)/0.303463370,30.2908669 , $ 1539.00562,34389.4453,272764.500 ,2.241119184d-02, $ 5549.03320,200042.172,352990.563,165764.000/ data (xsc(78,15,i),i=1,10)/2.073757816d-03,0.648876309 , $ 105.026894,8065.94189,276766.594 ,0.201935664 , $ 105967.828,2356522.00,450271.250,288861.844/ data (xsc(78,16,i),i=1,10)/2.402246930d-03,0.767768264 , $ 128.175995,10105.0068,354410.719 ,0.297191739 , $ 154104.531,3225300.75,597038.500,432386.906/ data (xsc(78,17,i),i=1,10)/ 2.39787269,28.9441452 , $ 268.689026,1934.86853,10956.9707,8.76206303 , $ 4065.82104,35385.5000,60787.6797,60415.5820/ data (xsc(78,18,i),i=1,10)/0.977953315,19.4883652 , $ 258.886353,2048.14990,9545.51953,14.9105349 , $ 7464.91455,37688.8164,426000.906,1793904.38/ data (xsc(78,19,i),i=1,10)/0.973817170,25.3129902 , $ 414.666168,4062.57349,24760.0371,35.8129692 , $ 25837.0449,149480.656,885650.375,4116500.50/ data (xsc(78,20,i),i=1,10)/4.277142882d-02, 2.60824323 , $ 99.3904114,1943.15613,15571.6396,1458.41064 , $ 130757.008,15573292.0,10632751.0,7138561.00/ data (xsc(78,21,i),i=1,10)/2.346534841d-02, 2.04996371 , $ 95.8907242,2077.51929,17845.7520,2485.02710 , $ 306832.750,19785610.0,15738859.0,11531171.0/ data (xsc(79, 1,i),i=1,10)/0.0000d0,0.0000d0, $ 0.0000d0,0.0000d0,0.0000d0, 38.6293297 , $ 324.666565,902.221741,1572.68774,2059.21899/ data (xsc(79, 2,i),i=1,11)/ 220.632462,2516.19824 , $ 0.0000d0,0.0000d0,0.0000d0, 7.43844557 , $ 400.267578,2173.69653,5003.65381,7338.01123,7891.47705/ data (xsc(79, 3,i),i=1,11)/ 111.160133,2747.67578 , $ 0.0000d0,0.0000d0,0.0000d0, 2.01955223 , $ 270.382141,2538.76636,8191.92285,14277.0967,16157.1680/ data (xsc(79, 4,i),i=1,11)/ 109.872185,3607.06885 , $ 0.0000d0,0.0000d0,0.0000d0, 2.06537437 , $ 460.459686,5069.52979,17732.0488,32306.1172,36908.1055/ data (xsc(79, 5,i),i=1,11)/ 48.6085091,588.897339 , $ 5069.56836 ,0.0000d0,0.0000d0, 60.4823265 , $ 1949.15015,7972.59766,15626.1211,20858.4121,22135.5469/ data (xsc(79, 6,i),i=1,11)/ 24.3186417,508.801605 , $ 6683.98535 ,0.0000d0,0.0000d0, 40.5689774 , $ 2639.74976,13064.5391,26246.9785,34417.5859,38574.1055/ data (xsc(79, 7,i),i=1,11)/ 25.2148151,698.127991 , $ 11731.1084,99664.2188 ,0.0000d0, 68.0884933 , $ 5900.46240,33435.5117,74900.0781,106048.859,113809.922/ data (xsc(79, 8,i),i=1,11)/ 1.90877450,141.108276 , $ 6733.83203,174732.000 ,0.0000d0, 13.9222813 , $ 4690.47510,53360.8867,178147.047,308140.906,2278065.75/ data (xsc(79, 9,i),i=1,11)/ 1.31898510,142.470169 , $ 8423.35449,243802.313 ,0.0000d0, 13.6534481 , $ 6592.48730,80502.7813,276057.313,481926.281,3517298.75/ data (xsc(79,10,i),i=1,10)/ 12.4245834,151.485703 , $ 1391.80408,9401.99512,40092.7461 ,0.312762827 , $ 555.852295,9229.88086,30793.0605,46336.4688/ data (xsc(79,11,i),i=1,10)/ 5.97069407,120.866180 , $ 1595.74219,11811.1670,38153.6992 ,0.121744417 , $ 818.142944,14798.9648,36558.0859,41252.3125/ data (xsc(79,12,i),i=1,10)/ 6.13133955,163.471375 , $ 2695.16089,25549.3164,130381.320 ,0.137875795 , $ 1938.36426,44127.1914,142208.250,204849.344/ data (xsc(79,13,i),i=1,10)/0.490304232,33.1184692 , $ 1335.73010,26275.9258,184691.813 ,2.689767443d-02, $ 3259.02222,117527.594,221379.563,109208.750/ data (xsc(79,14,i),i=1,10)/0.337982684,33.3066254 , $ 1663.35889,36360.0391,279083.813 ,1.893635280d-02, $ 4930.04053,187187.797,359200.031,162359.984/ data (xsc(79,15,i),i=1,10)/2.464715159d-03,0.761895299 , $ 121.243187,9130.99805,303588.688 ,0.108959161 , $ 73797.3906,2183817.25,473625.219,254614.594/ data (xsc(79,16,i),i=1,10)/2.847113181d-03,0.900383472 , $ 147.877197,11437.7539,388956.375 ,0.162117675 , $ 107021.711,3008845.50,623508.438,379320.500/ data (xsc(79,17,i),i=1,10)/ 2.57219863,30.8129902 , $ 284.109406,2028.68372,11406.4199,8.25963116 , $ 3872.29126,34036.7461,59422.1289,61084.4102/ data (xsc(79,18,i),i=1,10)/ 1.09061289,21.3785706 , $ 278.904144,2164.76709,9921.41602,12.9298220 , $ 6920.77734,34738.8086,363105.688,1527340.13/ data (xsc(79,19,i),i=1,10)/ 1.07683420,27.6668377 , $ 447.594238,4332.26416,26230.8809,35.2958069 , $ 25916.6660,151241.641,843603.000,3729802.50/ data (xsc(79,20,i),i=1,10)/5.085494742d-02, 3.07416463 , $ 115.277191,2201.76416,17229.4004,1262.50232 , $ 93408.2422,14953335.0,9368696.00,6231522.00/ data (xsc(79,21,i),i=1,10)/3.338646144d-02, 2.90079951 , $ 133.737671,2833.18213,23805.2930,2647.12280 , $ 271471.438,22768304.0,16474063.0,11680687.0/ data (xsc(80, 1,i),i=1,10)/0.0000d0,0.0000d0, $ 0.0000d0,0.0000d0,0.0000d0, 37.6708527 , $ 314.210602,871.379089,1518.18823,1988.59009/ data (xsc(80, 2,i),i=1,11)/ 229.523453,2583.53491 , $ 0.0000d0,0.0000d0,0.0000d0, 7.19898653 , $ 384.036194,2088.10229,4807.28418,7049.54932,7582.37207/ data (xsc(80, 3,i),i=1,11)/ 119.987572,2916.03564 , $ 0.0000d0,0.0000d0,0.0000d0, 1.98558009 , $ 262.480316,2451.86548,7892.88232,13737.6699,15523.6602/ data (xsc(80, 4,i),i=1,11)/ 117.239082,3811.51001 , $ 0.0000d0,0.0000d0,0.0000d0, 2.00101280 , $ 444.345276,4891.01221,17112.7383,31212.5625,35622.8555/ data (xsc(80, 5,i),i=1,11)/ 50.7448845,608.994934 , $ 5182.54980 ,0.0000d0,0.0000d0, 57.4882240 , $ 1857.45996,7605.57227,14912.4912,19887.8281,21237.7188/ data (xsc(80, 6,i),i=1,11)/ 26.2121353,538.837524 , $ 6920.41309 ,0.0000d0,0.0000d0, 38.6270218 , $ 2514.95776,12453.9170,25036.1055,32819.9180,37971.5625/ data (xsc(80, 7,i),i=1,11)/ 26.9522266,736.975159 , $ 12208.2490,101485.320 ,0.0000d0, 64.6448517 , $ 5628.21045,32045.2227,72048.1563,102182.398,110843.000/ data (xsc(80, 8,i),i=1,11)/ 2.10924292,153.905960 , $ 7234.72949,184603.578 ,0.0000d0, 13.0759830 , $ 4416.37061,50452.8555,169043.188,294712.563,2243732.75/ data (xsc(80, 9,i),i=1,11)/ 1.45195472,155.072311 , $ 9043.05273,257820.844 ,0.0000d0, 12.6301603 , $ 6177.84326,75985.2266,261800.734,461422.781,3343575.00/ data (xsc(80,10,i),i=1,10)/ 13.0368004,157.633972 , $ 1437.08508,9591.41797,39842.2656 ,0.291843653 , $ 517.652100,8656.07617,29067.1582,44198.2227/ data (xsc(80,11,i),i=1,10)/ 6.46967506,128.708359 , $ 1666.59021,12044.7090,37353.2266 ,0.115271300 , $ 767.519165,13999.4492,34956.6250,39751.6523/ data (xsc(80,12,i),i=1,10)/ 6.59015846,173.532974 , $ 2823.66895,26396.5586,132724.922 ,0.128319412 , $ 1824.18433,42133.4844,137869.641,200981.234/ data (xsc(80,13,i),i=1,10)/0.547235131,36.4216881 , $ 1442.55212,27736.9629,187947.438 ,2.231793851d-02, $ 2837.85498,108309.156,223219.719,109609.313/ data (xsc(80,14,i),i=1,10)/0.375783116,36.5666656 , $ 1795.79980,38421.8203,285280.281 ,1.529175881d-02, $ 4230.52148,171749.438,362657.750,165932.516/ data (xsc(80,15,i),i=1,10)/2.916152822d-03,0.890594184 , $ 139.378189,10294.0381,331971.719 ,5.432848632d-02, $ 47886.6445,1922911.63,565484.563,208792.016/ data (xsc(80,16,i),i=1,10)/3.359529423d-03, 1.05118167 , $ 169.904404,12895.7520,425758.281 ,7.615496218d-02, $ 68313.9297,2655413.00,744125.375,302197.031/ data (xsc(80,17,i),i=1,10)/ 2.75942302,32.8090019 , $ 300.530212,2128.75781,11891.0273,6.72155762 , $ 3397.78882,30975.9766,57560.1719,60507.2617/ data (xsc(80,18,i),i=1,10)/ 1.21736455,23.4722557 , $ 300.726715,2289.89429,10319.0693,10.6393175 , $ 6229.20117,31394.5254,282175.094,1138393.13/ data (xsc(80,19,i),i=1,10)/ 1.19494247,30.3488846 , $ 484.944244,4637.80176,27901.2949,32.0235100 , $ 24897.1250,149795.922,723183.500,2809717.75/ data (xsc(80,20,i),i=1,10)/6.201901287d-02, 3.75049901 , $ 138.964645,2591.22046,19821.1680,2782.53613 , $ 354706.813,17363448.0,9453465.00,8431507.00/ data (xsc(80,21,i),i=1,10)/4.085951298d-02, 3.58066297 , $ 163.793716,3392.00171,27899.5762,3650.28955 , $ 417583.906,25729812.0,15345441.0,12314197.0/ data (xsc(80,22,i),i=1,10)/0.243561655,2.62276173 , $ 22.9374752,163.816376,958.838562,125.570839 , $ 11494.9297,45395.9727,1154198.00,5944232.50/ data (xsc(81, 1,i),i=1,10)/0.0000d0,0.0000d0, $ 0.0000d0,0.0000d0,0.0000d0, 36.7505112 , $ 304.159332,841.720154,1465.02539,1917.29431/ data (xsc(81, 2,i),i=1,11)/ 238.655640,2650.93481 , $ 0.0000d0,0.0000d0,0.0000d0, 6.96272993 , $ 368.510254,2004.36279,4616.48633,6773.05127,7278.79541/ data (xsc(81, 3,i),i=1,11)/ 129.225540,3091.14038 , $ 0.0000d0,0.0000d0,0.0000d0, 1.95263731 , $ 254.904739,2368.22070,7605.98242,13237.0400,14920.7422/ data (xsc(81, 4,i),i=1,11)/ 124.958359,4023.65405 , $ 0.0000d0,0.0000d0,0.0000d0, 1.93868458 , $ 428.747192,4718.60156,16512.6172,30123.8984,34298.8086/ data (xsc(81, 5,i),i=1,11)/ 52.9444160,629.299194 , $ 5292.59961 ,0.0000d0,0.0000d0, 54.6170578 , $ 1768.81311,7250.07129,14218.6465,19002.5254,20241.8477/ data (xsc(81, 6,i),i=1,11)/ 28.2292805,570.029846 , $ 7155.31543 ,0.0000d0,0.0000d0, 36.9420433 , $ 2393.39551,11859.7744,23856.9121,31273.2285,36988.2617/ data (xsc(81, 7,i),i=1,11)/ 28.7684555,777.151306 , $ 12694.6758,107799.883 ,0.0000d0, 61.2213783 , $ 5359.04590,30669.0098,69222.7969,98373.4688,113081.570/ data (xsc(81, 8,i),i=1,11)/ 2.32726169,167.645569 , $ 7766.12061,195036.063 ,0.0000d0, 12.1542692 , $ 4141.63770,47547.7813,159969.766,281337.531,2133384.75/ data (xsc(81, 9,i),i=1,11)/ 1.59528470,168.536713 , $ 9697.68848,272517.844 ,0.0000d0, 11.6307917 , $ 5770.26563,71525.0859,247680.750,440288.219,3370416.00/ data (xsc(81,10,i),i=1,10)/ 13.6683912,163.903152 , $ 1482.60254,9774.77051,39569.7383 ,0.271508664 , $ 480.142029,8090.28613,27381.3770,41939.8477/ data (xsc(81,11,i),i=1,10)/ 7.00394964,136.961182 , $ 1740.10291,12279.1162,36269.2188 ,0.104858741 , $ 698.989746,12999.3340,33023.7305,37786.5898/ data (xsc(81,12,i),i=1,10)/ 7.07736444,184.146790 , $ 2959.82471,27318.2383,135199.766 ,0.112245992 , $ 1642.63049,39087.8398,131048.930,192620.031/ data (xsc(81,13,i),i=1,10)/0.609680235,39.9801559 , $ 1555.03601,29221.6465,190981.688 ,1.847876050d-02, $ 2464.54248,99482.8906,224271.359,117338.148/ data (xsc(81,14,i),i=1,10)/0.417017430,40.0667915 , $ 1934.58154,40495.5039,291232.219 ,1.258266717d-02, $ 3661.52075,157913.375,365015.281,181976.344/ data (xsc(81,15,i),i=1,10)/3.436008003d-03, 1.03688824 , $ 159.680298,11575.1328,362794.156 ,2.389349788d-02, $ 28986.3750,1593842.88,749133.063,184318.234/ data (xsc(81,16,i),i=1,10)/3.947643563d-03, 1.22219718 , $ 194.503113,14495.2129,465411.188 ,3.316638619d-02, $ 41200.2734,2209708.25,983727.500,257940.484/ data (xsc(81,17,i),i=1,10)/ 2.95544767,34.8801651 , $ 317.410248,2230.55225,12376.1113,5.45351887 , $ 2901.15405,27592.9336,54876.1563,56690.0430/ data (xsc(81,18,i),i=1,10)/ 1.35342801,25.7043285 , $ 323.764130,2419.94360,10712.0381,6.59764719 , $ 4895.47607,25824.5352,174385.094,777126.375/ data (xsc(81,19,i),i=1,10)/ 1.32109165,33.2294579 , $ 525.348633,4973.02100,29784.1953,16.8682785 , $ 17707.2637,122690.359,433154.469,1640877.13/ data (xsc(81,20,i),i=1,10)/7.489055395d-02, 4.53407192 , $ 166.225403,3031.78906,22667.2891,343.807739 , $ 39589.9375,6899228.00,9519483.00,4303452.00/ data (xsc(81,21,i),i=1,10)/4.969504476d-02, 4.37703419 , $ 198.447693,4021.89771,32400.9922,667.043518 , $ 60946.2852,13976118.0,14531094.0,7702536.50/ data (xsc(81,22,i),i=1,10)/0.322027743,3.49257398 , $ 30.5639877,216.844971,1261.86975,112.208260 , $ 11709.5225,38995.6016,972106.063,5652065.00/ data (xsc(82, 1,i),i=1,10)/0.0000d0,0.0000d0, $ 0.0000d0,0.0000d0,0.0000d0, 35.8716545 , $ 294.524200,813.227112,1414.63635,1851.95520/ data (xsc(82, 2,i),i=1,11)/ 247.877075,2717.17554 , $ 0.0000d0,0.0000d0,0.0000d0, 6.74366903 , $ 353.930481,1925.35803,4434.95605,6505.57031,6997.19141/ data (xsc(82, 3,i),i=1,11)/ 139.015854,3272.97607 , $ 0.0000d0,0.0000d0,0.0000d0, 1.92084634 , $ 247.397278,2288.31763,7330.95020,12735.9219,14381.0098/ data (xsc(82, 4,i),i=1,11)/ 133.052155,4242.77148 , $ 0.0000d0,0.0000d0,0.0000d0, 1.88079166 , $ 414.137512,4556.13574,15947.2148,29116.4727,33094.9180/ data (xsc(82, 5,i),i=1,11)/ 55.1786766,649.716736 , $ 5399.47363 ,0.0000d0,0.0000d0, 51.9043045 , $ 1684.87061,6912.60889,13559.9385,18136.0488,19197.5273/ data (xsc(82, 6,i),i=1,11)/ 30.3572769,602.176270 , $ 7385.01611 ,0.0000d0,0.0000d0, 35.4397774 , $ 2282.71826,11311.4248,22763.2051,29838.4570,35104.1133/ data (xsc(82, 7,i),i=1,11)/ 30.6800423,818.620605 , $ 13184.6084 ,0.0000d0,0.0000d0, 58.1819344 , $ 5114.12451,29399.6211,66591.6953,94860.8672,109804.336/ data (xsc(82, 8,i),i=1,11)/ 2.56441355,182.313431 , $ 8320.59863,205728.031 ,0.0000d0, 11.4095411 , $ 3897.81689,44929.0664,151687.359,268430.313,2024232.25/ data (xsc(82, 9,i),i=1,11)/ 1.75049591,182.878403 , $ 10380.8555,287412.031 ,0.0000d0, 10.7044430 , $ 5407.70557,67492.0313,234746.563,419983.875,3163863.50/ data (xsc(82,10,i),i=1,10)/ 14.3185396,170.298172 , $ 1528.43176,9952.65332,39227.0586 ,0.252745450 , $ 444.717194,7553.37305,25753.1699,39676.5117/ data (xsc(82,11,i),i=1,10)/ 7.57276058,145.542236 , $ 1813.84351,12491.1357,35186.3164 ,9.720915556d-02, $ 644.845276,12162.3096,31334.0801,36176.0547/ data (xsc(82,12,i),i=1,10)/ 7.59156179,195.160721 , $ 3098.26685,28227.4707,137553.000 ,0.100781851 , $ 1504.72974,36656.7031,125312.609,186195.719/ data (xsc(82,13,i),i=1,10)/0.678053319,43.8103218 , $ 1673.45789,30730.8574,193726.781 ,1.556147821d-02, $ 2162.63745,91739.6797,223297.859,131120.797/ data (xsc(82,14,i),i=1,10)/0.461993575,43.8263206 , $ 2080.62988,42607.7734,296820.406 ,1.058416534d-02, $ 3199.59058,145721.188,364428.625,208738.016/ data (xsc(82,15,i),i=1,10)/4.032428842d-03, 1.20229006 , $ 182.168381,12949.8740,394023.594 ,1.262279321d-02, $ 19181.6973,1324029.13,962867.563,169274.266/ data (xsc(82,16,i),i=1,10)/4.620685242d-03, 1.41520584 , $ 221.727631,16211.8027,505706.313 ,1.737721264d-02, $ 27119.9004,1836849.50,1265559.00,233725.141/ data (xsc(82,17,i),i=1,10)/ 3.16178107,37.0364761 , $ 334.694977,2332.00024,12834.0713,4.73887587 , $ 2667.75488,25855.5645,53445.3672,55956.0820/ data (xsc(82,18,i),i=1,10)/ 1.50196934,28.0811501 , $ 347.392487,2546.10205,11081.9209,6.37304354 , $ 4764.15967,25354.5469,153902.828,663843.500/ data (xsc(82,19,i),i=1,10)/ 1.45888615,36.3288460 , $ 567.993652,5318.38916,31683.5840,12.5284662 , $ 15330.2109,114308.805,348896.344,1225272.00/ data (xsc(82,20,i),i=1,10)/8.954252303d-02, 5.39927149 , $ 195.322311,3483.39063,25483.1211,141.210983 , $ 48489.7266,2526930.00,13926979.0,3251424.25/ data (xsc(82,21,i),i=1,10)/5.954287946d-02, 5.24107456 , $ 234.869537,4658.67432,36794.3047,249.896179 , $ 77629.7344,4999401.00,19581046.0,5958861.00/ data (xsc(82,22,i),i=1,10)/0.393189073,4.27342463 , $ 37.3253899,262.932922,1523.90234,97.1954880 , $ 11322.2471,38387.7773,706199.000,4520768.00/ data (xsc(82,23,i),i=1,10)/9.778127819d-02, 1.60369289 , $ 18.6227684,137.449020,629.868591,216.538300 , $ 37120.3281,2332257.00,14477358.0,33478308.0/ data (xsc(83, 1,i),i=1,10)/0.0000d0,0.0000d0, $ 0.0000d0,0.0000d0,0.0000d0, 35.0313034 , $ 285.287354,785.885315,1365.58289,1786.26929/ data (xsc(83, 2,i),i=1,11)/ 257.295105,2782.74634 , $ 0.0000d0,0.0000d0,0.0000d0, 6.53682518 , $ 340.036987,1849.79492,4261.91357,6253.20752,6720.55078/ data (xsc(83, 3,i),i=1,11)/ 149.416214,3460.82422 , $ 0.0000d0,0.0000d0,0.0000d0, 1.89219773 , $ 240.637894,2213.10327,7071.67627,12280.5059,13831.9316/ data (xsc(83, 4,i),i=1,11)/ 141.511261,4469.10352 , $ 0.0000d0,0.0000d0,0.0000d0, 1.82588029 , $ 400.200531,4401.35645,15404.8818,28119.4688,32014.1934/ data (xsc(83, 5,i),i=1,11)/ 57.4725113,670.225647 , $ 5501.37598 ,0.0000d0,0.0000d0, 49.4341507 , $ 1606.95117,6596.78760,12940.4873,17344.4629,18283.0898/ data (xsc(83, 6,i),i=1,11)/ 32.6096420,635.363953 , $ 7610.20703 ,0.0000d0,0.0000d0, 34.0434570 , $ 2178.88477,10792.9971,21720.8320,28461.8203,34004.9414/ data (xsc(83, 7,i),i=1,11)/ 32.6707001,861.232056 , $ 13676.7070 ,0.0000d0,0.0000d0, 55.4122543 , $ 4888.97021,28219.4629,64132.8477,91479.2813,105628.164/ data (xsc(83, 8,i),i=1,11)/ 2.82040119,197.929398 , $ 8899.62695,216495.000 ,0.0000d0, 10.7359819 , $ 3675.45996,42511.4453,143958.656,255534.563,1912356.63/ data (xsc(83, 9,i),i=1,11)/ 1.91708291,198.100357 , $ 11092.5488,302747.500 ,0.0000d0, 9.93102837 , $ 5079.45801,63789.8672,222771.313,401488.000,2956409.00/ data (xsc(83,10,i),i=1,10)/ 14.9950428,176.798233 , $ 1573.41577,10112.4609,38650.5938 ,0.239857987 , $ 417.083588,7116.51025,24382.7129,37838.4063/ data (xsc(83,11,i),i=1,10)/ 8.18303871,154.478928 , $ 1887.62610,12679.8613,34116.4102 ,9.152862430d-02, $ 600.691833,11441.7998,29811.3867,34709.4336/ data (xsc(83,12,i),i=1,10)/ 8.13323975,206.586700 , $ 3239.14526,29127.9980,139812.109 ,9.195916355d-02, $ 1392.10449,34588.3672,120337.891,181400.359/ data (xsc(83,13,i),i=1,10)/0.752776563,47.9184341 , $ 1797.39246,32245.8066,196220.234 ,1.335039455d-02, $ 1920.67053,85025.8672,221361.969,148493.578/ data (xsc(83,14,i),i=1,10)/0.510924935,47.8553734 , $ 2233.79736,44745.0469,302076.063 ,9.048909880d-03, $ 2817.76147,134831.344,361423.063,242470.063/ data (xsc(83,15,i),i=1,10)/4.714301322d-03, 1.38842094 , $ 206.898804,14403.4854,424836.250 ,7.369683590d-03, $ 13740.0723,1117142.50,1183275.63,157517.953/ data (xsc(83,16,i),i=1,10)/5.388054997d-03, 1.63211393 , $ 251.696182,18037.5547,546186.188 ,9.792809375d-03, $ 19018.0117,1538130.63,1575194.88,216121.422/ data (xsc(83,17,i),i=1,10)/ 3.37275028,39.2505760 , $ 352.373291,2434.26758,13285.7627,4.22969723 , $ 2445.92578,24154.9160,52025.4648,55566.9219/ data (xsc(83,18,i),i=1,10)/ 1.66625845,30.6352291 , $ 372.132080,2675.41235,11441.5107,5.13349295 , $ 4271.24170,23504.8164,121862.406,547337.938/ data (xsc(83,19,i),i=1,10)/ 1.60768282,39.6253166 , $ 612.516968,5670.96289,33584.3477,11.0835199 , $ 14409.6475,111979.516,313722.000,1009973.50/ data (xsc(83,20,i),i=1,10)/0.106654033,6.36825800 , $ 226.640030,3950.73438,28295.7363,89.7414627 , $ 51561.1094,1270817.88,20336782.0,2788147.75/ data (xsc(83,21,i),i=1,10)/7.075495273d-02, 6.19856358 , $ 273.989136,5317.54688,41195.0039,136.017487 , $ 83653.1406,2191223.75,29711264.0,5008162.50/ data (xsc(83,22,i),i=1,10)/0.468857676,5.10219765 , $ 44.4555626,311.038757,1796.65747,80.6937408 , $ 10730.5605,40150.2227,452448.813,3054768.25/ data (xsc(83,23,i),i=1,10)/0.144043684,2.36591268 , $ 27.2262955,197.456253,895.054871,219.574280 , $ 28690.0664,2224832.25,15599741.0,32534522.0/ data (xsc(84, 1,i),i=1,10)/0.0000d0,0.0000d0, $ 0.0000d0,0.0000d0,0.0000d0, 34.2208443 , $ 276.376190,759.477966,1318.86035,1725.66687/ data (xsc(84, 2,i),i=1,11)/ 266.872803,2848.68750 , $ 0.0000d0,0.0000d0,0.0000d0, 6.32812405 , $ 326.251343,1775.42444,4091.75171,6004.19678,6452.10645/ data (xsc(84, 3,i),i=1,11)/ 160.466888,3657.99561 , $ 0.0000d0,0.0000d0,0.0000d0, 1.86150336 , $ 233.861206,2139.08374,6817.99902,11823.7256,13289.1875/ data (xsc(84, 4,i),i=1,11)/ 150.405594,4705.51270 , $ 0.0000d0,0.0000d0,0.0000d0, 1.77159297 , $ 386.573853,4250.64844,14882.2520,27186.2402,30899.5527/ data (xsc(84, 5,i),i=1,11)/ 59.7953682,690.732544 , $ 5598.08887 ,0.0000d0,0.0000d0, 47.1483383 , $ 1534.45020,6301.30176,12359.1094,16543.8066,17596.0977/ data (xsc(84, 6,i),i=1,11)/ 35.0146523,670.142517 , $ 7840.27539 ,0.0000d0,0.0000d0, 32.4779968 , $ 2068.58521,10257.8301,20659.0410,27085.3965,32381.3809/ data (xsc(84, 7,i),i=1,11)/ 34.7690544,905.965210 , $ 14199.0693 ,0.0000d0,0.0000d0, 51.9325256 , $ 4640.19531,26946.0840,61510.2773,87957.9922,102043.648/ data (xsc(84, 8,i),i=1,11)/ 3.09930158,214.751480 , $ 9521.85254,227992.469 ,0.0000d0, 10.0361357 , $ 3448.90625,40089.4727,136316.672,242563.859,1774240.50/ data (xsc(84, 9,i),i=1,11)/ 2.09772229,214.449371 , $ 11856.1709,319487.094 ,0.0000d0, 9.14648628 , $ 4746.33545,60081.2852,210904.781,381529.750,2765607.75/ data (xsc(84,10,i),i=1,10)/ 15.6847782,183.452728 , $ 1620.00366,10283.4570,40372.1289 ,0.207703725 , $ 383.014008,6601.27393,22815.6367,35706.0430/ data (xsc(84,11,i),i=1,10)/ 8.82795811,163.769943 , $ 1962.60010,12855.3604,32902.6055 ,8.550313860d-02, $ 556.334351,10723.8887,28273.1523,33159.0313/ data (xsc(84,12,i),i=1,10)/ 8.70744705,218.372986 , $ 3379.19727,29969.9551,142041.094 ,8.800361305d-02, $ 1331.04065,33340.2109,117201.172,178629.156/ data (xsc(84,13,i),i=1,10)/0.834614336,52.3687592 , $ 1930.88782,33889.8672,198118.484 ,1.086249482d-02, $ 1641.40857,77060.2422,216239.391,163054.609/ data (xsc(84,14,i),i=1,10)/0.564270496,52.2017975 , $ 2397.88818,47040.0234,306972.500 ,7.494420279d-03, $ 2406.56445,122601.320,353810.344,272668.813/ data (xsc(84,15,i),i=1,10)/5.490167998d-03, 1.59623230 , $ 233.664749,15881.7715,452387.063 ,5.607036874d-03, $ 11417.5176,1004739.50,1346146.38,148290.984/ data (xsc(84,16,i),i=1,10)/6.257853005d-03, 1.87339306 , $ 283.922241,19864.8320,580929.250 ,7.690316066d-03, $ 16142.7695,1399407.63,1789339.88,204764.938/ data (xsc(84,17,i),i=1,10)/ 3.59758449,41.5541191 , $ 370.383270,2536.76440,13722.8467,3.84612560 , $ 2268.73438,22722.3086,50754.1758,55935.4102/ data (xsc(84,18,i),i=1,10)/ 1.84124422,33.3191872 , $ 397.508850,2802.79980,11776.8926,4.65631342 , $ 4009.55371,22531.4258,105178.719,468122.031/ data (xsc(84,19,i),i=1,10)/ 1.77056026,43.1420021 , $ 658.957031,6033.04395,35510.2031,10.3189754 , $ 13909.4502,111363.953,296456.781,870142.250/ data (xsc(84,20,i),i=1,10)/0.125401482,7.42411327 , $ 260.130432,4433.51367,31102.9941,60.4447212 , $ 51791.1797,671768.875,21656248.0,2575326.00/ data (xsc(84,21,i),i=1,10)/8.318448067d-02, 7.24629307 , $ 315.867188,6001.97363,45624.3789,68.0741501 , $ 80080.9219,830642.250,31194066.0,4331104.50/ data (xsc(84,22,i),i=1,10)/0.542585373,5.90712309 , $ 51.3193245,356.646271,2053.41846,68.6135941 , $ 10094.2344,41401.5625,322850.406,2148358.25/ data (xsc(84,23,i),i=1,10)/0.191404030,3.12850118 , $ 35.5647087,253.442856,1136.24341,204.103409 , $ 22289.6895,1829071.25,15444491.0,30499764.0/ data (xsc(84,24,i),i=1,10)/7.235468179d-02, 1.55668128 , $ 22.3732834,205.542908,1246.63428,294.814789 , $ 26750.7090,1685096.00,14813727.0,35154412.0/ data (xsc(85, 1,i),i=1,10)/0.0000d0,0.0000d0, $ 0.0000d0,0.0000d0,0.0000d0, 33.4477615 , $ 267.846222,734.165283,1273.40491,1664.62390/ data (xsc(85, 2,i),i=1,11)/ 276.584686,2912.15015 , $ 0.0000d0,0.0000d0,0.0000d0, 6.14143181 , $ 313.561523,1706.15686,3932.88013,5771.06641,6200.07471/ data (xsc(85, 3,i),i=1,11)/ 172.179092,3860.64307 , $ 0.0000d0,0.0000d0,0.0000d0, 1.83471894 , $ 227.642502,2070.02710,6580.41406,11404.3096,12789.5000/ data (xsc(85, 4,i),i=1,11)/ 159.925751,4949.45166 , $ 0.0000d0,0.0000d0,0.0000d0, 1.72084296 , $ 373.738007,4108.19775,14386.8389,26292.6484,29845.1484/ data (xsc(85, 5,i),i=1,11)/ 62.1954842,711.726196 , $ 5696.37939 ,0.0000d0,0.0000d0, 44.6913452 , $ 1457.77856,5995.04395,11764.0693,15779.8418,16738.8672/ data (xsc(85, 6,i),i=1,11)/ 37.5388908,705.635925 , $ 8058.35693 ,0.0000d0,0.0000d0, 31.1980515 , $ 1973.77893,9784.15430,19706.2461,25816.8613,30766.2188/ data (xsc(85, 7,i),i=1,11)/ 36.9701653,951.975098 , $ 14722.2813 ,0.0000d0,0.0000d0, 49.1683540 , $ 4418.11230,25790.3516,59101.8438,84776.0000,97927.7500/ data (xsc(85, 8,i),i=1,11)/ 3.39954376,232.614685 , $ 10169.7500,245534.641 ,0.0000d0, 9.42238808 , $ 3247.65674,37907.1563,129371.938,231361.875,1661647.88/ data (xsc(85, 9,i),i=1,11)/ 2.29122949,231.771805 , $ 12651.3115,335991.906 ,0.0000d0, 8.46072960 , $ 4449.70996,56726.8945,200025.984,362108.594,2547308.75/ data (xsc(85,10,i),i=1,11)/ 16.3888626,190.113007 , $ 1664.51538,10423.3281 ,0.0000d0, 278.480927 , $ 5473.95068,17455.6113,29099.9414,35251.8594,36664.1602/ data (xsc(85,11,i),i=1,10)/ 9.50923252,173.291367 , $ 2035.13770,12990.9355,31972.6758 ,8.351007849d-02, $ 532.281250,10250.1025,27125.6035,32082.8555/ data (xsc(85,12,i),i=1,10)/ 9.30827808,230.684082 , $ 3526.37354,30878.0488,144276.859 ,8.129967004d-02, $ 1240.09729,31601.5723,112773.047,173837.141/ data (xsc(85,13,i),i=1,10)/0.923649311,57.1134109 , $ 2069.04883,35504.5117,199755.578 ,8.756686933d-03, $ 1450.80774,71079.7188,211478.125,175526.531/ data (xsc(85,14,i),i=1,10)/0.621270359,56.6601410 , $ 2550.72974,48721.6914,312525.250 ,8.164047264d-03, $ 2526.78271,124631.594,362389.063,312908.813/ data (xsc(85,15,i),i=1,10)/6.374954246d-03, 1.83107507 , $ 263.773804,17566.8594,485916.688 ,3.499210579d-03, $ 8310.03711,839269.250,1534910.00,132977.016/ data (xsc(85,16,i),i=1,10)/7.247803267d-03, 2.14576125 , $ 320.237701,21964.8242,624340.000 ,4.749699496d-03, $ 11686.6729,1168259.88,2054845.50,183562.797/ data (xsc(85,17,i),i=1,10)/ 3.83146310,43.9284134 , $ 388.764069,2640.73657,14159.3047,3.40237308 , $ 2059.03638,21035.6172,48738.1797,55508.8516/ data (xsc(85,18,i),i=1,10)/ 2.03308749,36.1748352 , $ 423.725555,2930.54126,12088.4502,3.97840047 , $ 3629.36279,21085.6875,88093.5234,389902.156/ data (xsc(85,19,i),i=1,10)/ 1.94541907,46.8733482 , $ 707.780518,6413.43506,37545.8477,8.31841469 , $ 12550.8926,105896.617,270469.938,729713.875/ data (xsc(85,20,i),i=1,10)/0.147015348,8.59739876 , $ 296.193359,4941.33105,33947.9648,27.7018490 , $ 44771.9414,226886.781,12036526.0,2545714.25/ data (xsc(85,21,i),i=1,10)/9.744767100d-02, 8.40332127 , $ 360.461853,6706.18555,50046.8281,41.8762245 , $ 74827.9375,402869.313,22061360.0,4196645.50/ data (xsc(85,22,i),i=1,10)/0.619182169,6.72205544 , $ 58.1308899,401.326813,2302.45313,59.5306664 , $ 9449.20703,41729.8555,253140.563,1605019.50/ data (xsc(85,23,i),i=1,10)/0.239918485,3.89793944 , $ 43.7474556,306.356781,1357.96216,184.359955 , $ 18016.6719,1456158.25,14650160.0,28570330.0/ data (xsc(85,24,i),i=1,10)/0.139622480,3.00979710 , $ 43.0439720,391.753876,2370.47290,433.118469 , $ 39754.7734,2284654.75,23007766.0,52331796.0/ data (xsc(86, 1,i),i=1,10)/0.0000d0,0.0000d0, $ 0.0000d0,0.0000d0,0.0000d0, 32.7082405 , $ 259.658112,709.805664,1230.23901,1608.56274/ data (xsc(86, 2,i),i=1,11)/ 286.324463,2972.90430 , $ 0.0000d0,0.0000d0,0.0000d0, 5.97114515 , $ 301.749786,1641.25891,3782.34375,5549.04736,5963.90527/ data (xsc(86, 3,i),i=1,11)/ 184.543777,4069.38232 , $ 0.0000d0,0.0000d0,0.0000d0, 1.80936372 , $ 221.735947,2004.33875,6352.86719,10987.8975,12345.5225/ data (xsc(86, 4,i),i=1,11)/ 169.612091,5201.73242 , $ 0.0000d0,0.0000d0,0.0000d0, 1.67247784 , $ 361.447510,3972.32251,13912.0547,25430.2305,28817.8984/ data (xsc(86, 5,i),i=1,11)/ 64.6178741,732.538330 , $ 5786.84521 ,0.0000d0,0.0000d0, 42.5356560 , $ 1389.38672,5717.67676,11219.5264,15059.6963,15867.3984/ data (xsc(86, 6,i),i=1,11)/ 40.2067871,741.913757 , $ 8263.90039 ,0.0000d0,0.0000d0, 30.1537457 , $ 1891.12329,9358.37988,18830.8457,24668.4512,29424.4844/ data (xsc(86, 7,i),i=1,11)/ 39.2416992,998.335022 , $ 15222.5459 ,0.0000d0,0.0000d0, 47.1776733 , $ 4247.63916,24860.7090,57111.8984,81949.1953,94896.7188/ data (xsc(86, 8,i),i=1,11)/ 3.72480917,251.646774 , $ 10847.8906 ,0.0000d0,0.0000d0, 8.86661434 , $ 3063.10254,35888.8672,122888.352,219814.375,1555675.25/ data (xsc(86, 9,i),i=1,11)/ 2.49988890,250.186829 , $ 13483.7422,359265.281 ,0.0000d0, 7.84287739 , $ 4177.10596,53618.7813,189895.703,344056.375,2367022.25/ data (xsc(86,10,i),i=1,11)/ 17.1224976,196.950211 , $ 1709.77856,10565.5049 ,0.0000d0, 259.228363 , $ 5127.47314,16426.4648,27496.5684,33383.9609,34959.8516/ data (xsc(86,11,i),i=1,10)/ 10.2345371,183.232803 , $ 2109.27319,13117.0352,30837.2793 ,7.991340756d-02, $ 501.215485,9699.64551,25842.3770,30759.2852/ data (xsc(86,12,i),i=1,10)/ 9.93726158,243.324570 , $ 3672.85864,31733.0859,146491.719 ,7.789496332d-02, $ 1185.83594,30462.9922,109736.867,170845.469/ data (xsc(86,13,i),i=1,10)/ 1.02049899,62.1883850 , $ 2213.63403,37139.5391,201148.625 ,7.511870470d-03, $ 1292.48083,65799.7656,206196.516,184906.563/ data (xsc(86,14,i),i=1,10)/0.684727073,61.7869377 , $ 2747.36743,51662.1875,315463.781 ,5.322730169d-03, $ 1855.35278,104139.547,337458.000,316493.656/ data (xsc(86,15,i),i=1,10)/7.387246937d-03, 2.09458923 , $ 296.885498,19372.9922,520578.719 ,2.185826190d-03, $ 6192.96729,704435.938,1681183.25,119902.750/ data (xsc(86,16,i),i=1,10)/8.376910351d-03, 2.45077538 , $ 360.115967,24213.7227,669276.000 ,2.965008840d-03, $ 8667.49023,979375.500,2265214.75,165190.688/ data (xsc(86,17,i),i=1,10)/ 4.07389593,46.3649178 , $ 407.378784,2744.46777,14580.5107,3.03716993 , $ 1877.47229,19520.6914,46664.3086,54876.0547/ data (xsc(86,18,i),i=1,10)/ 2.23659277,39.1639290 , $ 450.547058,3056.46533,12372.6953,3.31904221 , $ 3301.19556,19788.6934,75461.7031,327917.344/ data (xsc(86,19,i),i=1,10)/ 2.12870932,50.7740746 , $ 758.425842,6803.62549,39616.2148,6.97234297 , $ 11397.9805,100879.609,252484.063,626281.563/ data (xsc(86,20,i),i=1,10)/0.170608014,9.86708832 , $ 334.363861,5458.49316,36754.0469,18.7006512 , $ 40889.3008,129308.539,7570712.00,2955377.25/ data (xsc(86,21,i),i=1,10)/0.112919755,9.65379810 , $ 407.838867,7431.88428,54478.7461,27.1053352 , $ 68483.8750,222144.750,13698569.0,4497876.00/ data (xsc(86,22,i),i=1,10)/0.697724998,7.55132723 , $ 64.9880676,445.701447,2547.71094,52.4515724 , $ 8863.20605,41573.1172,212389.359,1263301.25/ data (xsc(86,23,i),i=1,10)/0.290859699,4.69220400 , $ 51.9614487,357.583649,1567.24304,165.204025 , $ 15162.6973,1169024.63,13539781.0,26944454.0/ data (xsc(86,24,i),i=1,10)/0.230380446,4.94895029 , $ 70.2489929,633.438477,3824.13770,551.077393 , $ 52582.9805,2657891.25,30586460.0,67924296.0/ data (xsc(87, 1,i),i=1,10)/0.0000d0,0.0000d0, $ 0.0000d0,0.0000d0,0.0000d0, 31.9943752 , $ 251.755920,686.283630,1188.50024,1554.37158/ data (xsc(87, 2,i),i=1,11)/ 296.320923,3034.51367 , $ 0.0000d0,0.0000d0,0.0000d0, 5.79519224 , $ 289.814911,1576.21301,3633.44873,5330.49902,5726.51416/ data (xsc(87, 3,i),i=1,11)/ 197.661118,4284.53076 , $ 0.0000d0,0.0000d0,0.0000d0, 1.78469050 , $ 216.020752,1940.70569,6133.70020,10599.9395,11879.2715/ data (xsc(87, 4,i),i=1,11)/ 179.735413,5460.53027 , $ 0.0000d0,0.0000d0,0.0000d0, 1.62679160 , $ 349.418213,3842.15430,13457.3525,24601.6191,27843.0977/ data (xsc(87, 5,i),i=1,11)/ 67.0797348,753.291138 , $ 5871.17725 ,0.0000d0,0.0000d0, 40.2350731 , $ 1324.10559,5452.16016,10698.1826,14343.7090,15202.3613/ data (xsc(87, 6,i),i=1,11)/ 43.0241318,779.583435 , $ 8468.98926 ,0.0000d0,0.0000d0, 28.9278431 , $ 1801.74500,8913.31836,17933.7539,23499.6621,24924.9941/ data (xsc(87, 7,i),i=1,11)/ 41.6333008,1046.61279 , $ 15742.6631 ,0.0000d0,0.0000d0, 44.9014091 , $ 4058.74146,23851.6895,54968.7344,79106.7031,91997.1406/ data (xsc(87, 8,i),i=1,11)/ 4.07376003,271.746887 , $ 11546.2959 ,0.0000d0,0.0000d0, 8.35686111 , $ 2892.12280,33985.2539,116673.094,208211.438,1432288.88/ data (xsc(87, 9,i),i=1,11)/ 2.72257781,269.586182 , $ 14340.2451 ,0.0000d0,0.0000d0, 7.28321743 , $ 3925.10522,50692.0859,180248.219,327725.219,2252029.25/ data (xsc(87,10,i),i=1,11)/ 17.8633900,203.805420 , $ 1753.93909,10689.7549 ,0.0000d0, 241.903488 , $ 4810.63721,15469.8379,25993.2148,31721.2422,33730.0469/ data (xsc(87,11,i),i=1,10)/ 11.0042925,193.559799 , $ 2184.04248,13225.3623,29552.2559 ,7.072333992d-02, $ 465.379456,9094.54102,24473.4766,29370.9590/ data (xsc(87,12,i),i=1,10)/ 10.6014233,256.580383 , $ 3827.44263,32666.8652,148676.000 ,7.096084207d-02, $ 1090.48291,28607.0156,104814.398,165223.531/ data (xsc(87,13,i),i=1,10)/ 1.12570786,67.6019821 , $ 2364.32104,38783.3672,202300.578 ,6.375303492d-03, $ 1142.47266,60534.2539,200025.719,191195.453/ data (xsc(87,14,i),i=1,10)/0.753192127,67.1091461 , $ 2937.00317,54118.6641,319030.969 ,4.454412032d-03, $ 1579.79993,94146.6641,324777.156,324697.000/ data (xsc(87,15,i),i=1,10)/8.524795994d-03, 2.38788056 , $ 333.179413,21303.7090,556148.375 ,1.353483414d-03, $ 4465.52393,575197.938,1800094.88,109305.172/ data (xsc(87,16,i),i=1,10)/9.641480632d-03, 2.78954172 , $ 403.793365,26616.8008,715483.375 ,1.830850029d-03, $ 6212.43799,797995.813,2448281.25,148537.156/ data (xsc(87,17,i),i=1,10)/ 4.31972933,48.8407059 , $ 426.179840,2847.59814,14988.2461,2.51213217 , $ 1672.80847,17778.0117,43958.2109,55705.2422/ data (xsc(87,18,i),i=1,10)/ 2.45826054,42.3176231 , $ 477.886230,3179.37451,12626.5820,2.73784781 , $ 2921.13599,18260.4551,62075.5117,251623.844/ data (xsc(87,19,i),i=1,10)/ 2.32740712,54.9004822 , $ 810.926147,7203.26953,41725.6406,5.50116587 , $ 9947.12988,93407.3750,232022.438,531928.188/ data (xsc(87,20,i),i=1,10)/0.197200686,11.2590389 , $ 374.991882,5991.90234,39557.9727,10.7602911 , $ 34290.2656,76739.4609,3658158.75,16185262.0/ data (xsc(87,21,i),i=1,10)/0.130038559,11.0167799 , $ 458.344269,8182.57959,58945.6406,14.4817677 , $ 57082.9531,127450.063,6339316.50,18006056.0/ data (xsc(87,22,i),i=1,10)/0.786665022,8.52335644 , $ 73.1453400,498.471558,2841.08960,37.4133263 , $ 7173.56934,38451.9102,127378.500,560245.438/ data (xsc(87,23,i),i=1,10)/0.361461133,5.83639669 , $ 64.0223694,433.053284,1879.62244,105.092667 , $ 9165.91406,527249.125,7122332.50,30174114.0/ data (xsc(87,24,i),i=1,10)/0.309049726,6.73805857 , $ 95.7926941,856.510742,5166.65625,348.738373 , $ 41605.0625,1091980.00,18438080.0,72377288.0/ data (xsc(88, 1,i),i=1,10)/0.0000d0,0.0000d0, $ 0.0000d0,0.0000d0,0.0000d0, 31.3100777 , $ 244.163834,663.638000,1147.81702,1499.77893/ data (xsc(88, 2,i),i=1,11)/ 306.343689,3094.58105 , $ 0.0000d0,0.0000d0,0.0000d0, 5.63081169 , $ 278.546875,1514.61377,3491.29004,5121.86621,5501.38721/ data (xsc(88, 3,i),i=1,11)/ 211.452972,4504.41064 , $ 0.0000d0,0.0000d0,0.0000d0, 1.76240766 , $ 210.690384,1880.81946,5925.33057,10221.9863,11428.7754/ data (xsc(88, 4,i),i=1,11)/ 190.220993,5724.52295 , $ 0.0000d0,0.0000d0,0.0000d0, 1.58466554 , $ 338.502838,3719.79443,13024.5957,23807.6230,26958.5313/ data (xsc(88, 5,i),i=1,11)/ 69.5919037,773.902649 , $ 5947.17578 ,0.0000d0,0.0000d0, 38.3973579 , $ 1264.32166,5205.85107,10210.7266,13711.1406,14467.4326/ data (xsc(88, 6,i),i=1,11)/ 45.9796181,817.757690 , $ 8657.50586 ,0.0000d0,0.0000d0, 27.9548969 , $ 1725.49060,8520.21973,17128.5000,22414.0684,23930.1797/ data (xsc(88, 7,i),i=1,11)/ 44.1171417,1096.23083 , $ 16268.6279 ,0.0000d0,0.0000d0, 42.7194214 , $ 3877.75952,22881.2480,52901.7656,76370.5938,82590.9453/ data (xsc(88, 8,i),i=1,11)/ 4.44829750,292.898895 , $ 12257.7246 ,0.0000d0,0.0000d0, 7.88969946 , $ 2745.00854,32304.4824,111103.805,198679.281,177188.359/ data (xsc(88, 9,i),i=1,11)/ 2.96144414,289.992767 , $ 15213.8330 ,0.0000d0,0.0000d0, 6.81387997 , $ 3706.67676,48087.6328,171447.391,311220.844,214832.594/ data (xsc(88,10,i),i=1,11)/ 18.6201916,210.705627 , $ 1796.98657,10796.8408 ,0.0000d0, 226.921906 , $ 4529.73535,14609.6328,24648.9258,30129.2930,32176.0742/ data (xsc(88,11,i),i=1,11)/ 11.8345547,204.558075 , $ 2264.33569,13339.8730 ,0.0000d0, 305.868378 , $ 7298.83887,19680.2715,26306.8438,27586.1445,29280.1055/ data (xsc(88,12,i),i=1,10)/ 11.3144207,270.821228 , $ 3999.07324,33804.1758,150625.859 ,5.938782915d-02, $ 935.522278,25656.2949,96879.2031,155201.500/ data (xsc(88,13,i),i=1,10)/ 1.24038506,73.3497391 , $ 2518.40259,40360.0078,203748.609 ,5.654674955d-03, $ 1039.39172,56579.8047,194990.953,198087.109/ data (xsc(88,14,i),i=1,10)/0.826027393,72.6433868 , $ 3123.74219,56255.6680,323509.313 ,4.171425942d-03, $ 1465.78882,89226.8438,319066.719,341851.063/ data (xsc(88,15,i),i=1,10)/9.832645766d-03, 2.72480321 , $ 376.080597,23819.7715,611912.938 ,5.584582686d-04, $ 2402.48877,393222.969,1755934.00,120076.273/ data (xsc(88,16,i),i=1,10)/1.109748799d-02, 3.18180394 , $ 456.724854,29953.3633,797488.875 ,6.517783040d-04, $ 2963.92896,509079.594,2362534.00,161796.984/ data (xsc(88,17,i),i=1,10)/ 4.58083582,51.4267845 , $ 445.765533,2958.88501,15452.5674,1.90909231 , $ 1359.26526,15092.7217,39369.9531,50218.1484/ data (xsc(88,18,i),i=1,10)/ 2.69415879,45.6471405 , $ 506.502319,3306.69385,12853.5693,1.91933167 , $ 2339.09937,15853.7207,47174.8281,179422.031/ data (xsc(88,19,i),i=1,10)/ 2.53644729,59.2411537 , $ 866.091980,7624.38721,43971.8086,3.86100101 , $ 8254.29102,83413.5703,208301.781,416361.406/ data (xsc(88,20,i),i=1,10)/0.226390973,12.7725086 , $ 418.153687,6537.43896,42370.2734,8.06064320 , $ 31118.6367,70931.5938,2077290.13,27086270.0/ data (xsc(88,21,i),i=1,10)/0.149072587,12.5121536 , $ 512.665894,8971.58398,63542.8398,7.59291506 , $ 45706.7578,114507.891,2777723.00,44059340.0/ data (xsc(88,22,i),i=1,10)/0.886055529,9.58439827 , $ 81.9342346,555.459351,3162.22949,17.5091190 , $ 4264.07861,28889.3945,65586.4219,260055.984/ data (xsc(88,23,i),i=1,10)/0.436373144,7.01217413 , $ 75.9711151,505.077942,2168.33765,82.3294144 , $ 7616.53564,335531.406,4094729.75,19157046.0/ data (xsc(88,24,i),i=1,10)/0.385011405,8.42786121 , $ 119.413391,1059.34106,6383.57666,130.730331 , $ 25809.3125,308458.000,4742936.50,31345792.0/ data (xsc(89, 1,i),i=1,10)/0.0000d0,0.0000d0, $ 0.0000d0,0.0000d0,0.0000d0, 30.6567307 , $ 236.888184,641.889221,1109.16467,1449.53955/ data (xsc(89, 2,i),i=1,11)/ 316.477295,3151.50293 , $ 0.0000d0,0.0000d0,0.0000d0, 5.48200941 , $ 267.833832,1456.66809,3357.55054,4923.81934,5289.55908/ data (xsc(89, 3,i),i=1,11)/ 226.114304,4733.34521 , $ 0.0000d0,0.0000d0,0.0000d0, 1.74003148 , $ 205.477539,1822.59863,5724.74121,9864.77539,11008.3662/ data (xsc(89, 4,i),i=1,11)/ 201.240692,6000.46094 , $ 0.0000d0,0.0000d0,0.0000d0, 1.54255128 , $ 327.727875,3600.14429,12607.2275,23046.5723,26069.3262/ data (xsc(89, 5,i),i=1,11)/ 72.1379547,794.610840 , $ 6019.70459 ,0.0000d0,0.0000d0, 36.5615044 , $ 1205.20618,4964.37451,9734.85059,13080.2842,13720.7324/ data (xsc(89, 6,i),i=1,11)/ 49.1042252,856.942261 , $ 8836.01172 ,0.0000d0,0.0000d0, 26.8872776 , $ 1653.85034,8148.21484,16358.6445,21413.0723,22850.3496/ data (xsc(89, 7,i),i=1,11)/ 46.6983032,1146.28943 , $ 16771.6113 ,0.0000d0,0.0000d0, 41.1373940 , $ 3736.69727,22090.2813,51169.0547,74077.4141,79779.8984/ data (xsc(89, 8,i),i=1,11)/ 4.85433435,315.624695 , $ 13025.1230 ,0.0000d0,0.0000d0, 7.43538141 , $ 2592.81348,30611.1035,105576.883,188526.906,195328.656/ data (xsc(89, 9,i),i=1,11)/ 3.21741652,311.810425 , $ 16155.4209 ,0.0000d0,0.0000d0, 6.32328796 , $ 3482.07495,45468.3867,162752.125,295087.625,338237.219/ data (xsc(89,10,i),i=1,11)/ 19.3954716,217.705322 , $ 1840.07129,10899.5684 ,0.0000d0, 211.895935 , $ 4251.27832,13759.5889,23288.9883,28643.2637,29793.3809/ data (xsc(89,11,i),i=1,11)/ 12.6863012,215.212051 , $ 2330.64307,13359.8379 ,0.0000d0, 305.483002 , $ 7156.78564,19147.0156,25651.1367,27066.9844,29640.3281/ data (xsc(89,12,i),i=1,10)/ 12.0329638,284.424713 , $ 4142.14111,34493.0586,152798.938 ,6.149294972d-02, $ 947.457397,25668.2832,96631.8672,155586.656/ data (xsc(89,13,i),i=1,10)/ 1.36413980,79.5076447 , $ 2682.74268,42052.0000,204243.516 ,4.857109394d-03, $ 925.638916,52211.9570,188149.891,202629.750/ data (xsc(89,14,i),i=1,10)/0.904943466,78.5924606 , $ 3324.62476,58619.4414,326985.094 ,3.750892123d-03, $ 1309.66064,82803.7422,309026.563,346923.031/ data (xsc(89,15,i),i=1,10)/1.126796473d-02, 3.07849669 , $ 416.329987,25565.6836,630210.063 ,5.881576217d-04, $ 2465.20459,390488.156,1801447.88,137987.719/ data (xsc(89,16,i),i=1,10)/1.267871819d-02, 3.58470702 , $ 503.618317,31913.9668,811952.313 ,7.991899038d-04, $ 3393.05811,539408.875,2470865.00,183959.109/ data (xsc(89,17,i),i=1,10)/ 4.84823561,54.0132103 , $ 464.316376,3051.76855,15752.6426,1.90675843 , $ 1345.01050,14846.0020,39057.2734,50900.0313/ data (xsc(89,18,i),i=1,10)/ 2.94850135,49.0861168 , $ 534.170288,3416.86621,13048.9395,1.87780750 , $ 2321.24805,15658.3936,45475.8203,160936.078/ data (xsc(89,19,i),i=1,10)/ 2.76166415,63.7891426 , $ 922.139343,8038.06787,46089.5313,3.45410872 , $ 7736.16016,80580.0547,203540.281,375716.531/ data (xsc(89,20,i),i=1,10)/0.259258419,14.4386101 , $ 464.838562,7122.88965,45260.4453,4.38500404 , $ 24185.0078,72250.2734,1012145.50,6806866.00/ data (xsc(89,21,i),i=1,10)/0.170383453,14.1434507 , $ 570.172852,9780.20020,68143.4922,5.16854811 , $ 39766.3242,124322.398,1605791.13,11435348.0/ data (xsc(89,22,i),i=1,10)/0.987139583,10.6504345 , $ 90.5672455,609.544067,3449.40454,22.4649811 , $ 5156.58691,33851.1367,80294.3672,275116.500/ data (xsc(89,23,i),i=1,10)/0.515477836,8.19324684 , $ 87.4149399,571.221741,2425.96313,52.8046532 , $ 5783.98682,182337.078,2409595.00,9638924.00/ data (xsc(89,24,i),i=1,10)/0.456029475,9.97208118 , $ 140.421387,1234.91040,7425.07813,161.046219 , $ 30990.6211,365109.531,4785396.00,23329580.0/ data (xsc(90, 1,i),i=1,10)/0.0000d0,0.0000d0, $ 0.0000d0,0.0000d0,0.0000d0, 30.0256462 , $ 229.867676,620.880432,1071.32349,1398.48145/ data (xsc(90, 2,i),i=1,11)/ 326.748230,3206.74072 , $ 0.0000d0,0.0000d0,0.0000d0, 5.32942200 , $ 257.386353,1399.47424,3225.70532,4730.33398,5081.20703/ data (xsc(90, 3,i),i=1,11)/ 241.548141,4967.70508 , $ 0.0000d0,0.0000d0,0.0000d0, 1.71924424 , $ 200.574661,1767.55457,5533.49854,9516.22852,10637.3252/ data (xsc(90, 4,i),i=1,11)/ 212.661148,6283.76123 , $ 0.0000d0,0.0000d0,0.0000d0, 1.50324297 , $ 317.605621,3487.47925,12211.0791,22325.4277,25228.9023/ data (xsc(90, 5,i),i=1,11)/ 74.7322159,815.165771 , $ 6084.66406 ,0.0000d0,0.0000d0, 34.9095573 , $ 1150.94543,4740.57813,9292.06641,12494.0732,13091.6123/ data (xsc(90, 6,i),i=1,11)/ 52.3884277,897.195007 , $ 9006.37988 ,0.0000d0,0.0000d0, 25.9803047 , $ 1583.89282,7787.53174,15613.9453,20437.0313,21649.1680/ data (xsc(90, 7,i),i=1,11)/ 49.4018021,1199.05383 , $ 17318.6953 ,0.0000d0,0.0000d0, 39.1069260 , $ 3568.88379,21193.1660,49261.0703,71324.6953,77848.9531/ data (xsc(90, 8,i),i=1,11)/ 5.28865862,339.583618 , $ 13815.9453 ,0.0000d0,0.0000d0, 7.04424381 , $ 2459.69165,29104.2305,100584.469,179252.141,217435.875/ data (xsc(90, 9,i),i=1,11)/ 3.49079299,334.796844 , $ 17127.3691 ,0.0000d0,0.0000d0, 5.86712837 , $ 3284.89453,43138.0977,154989.938,281640.000,284612.781/ data (xsc(90,10,i),i=1,11)/ 20.1967239,224.785431 , $ 1882.17468,10988.6104 ,0.0000d0, 198.749786 , $ 4002.68408,12988.8184,22050.8066,27266.7383,27966.6270/ data (xsc(90,11,i),i=1,11)/ 13.6110401,227.000778 , $ 2411.93018,13423.7900 ,0.0000d0, 267.613220 , $ 6459.70215,17602.8730,23771.4902,25100.8711,26530.9922/ data (xsc(90,12,i),i=1,10)/ 12.8120422,299.762665 , $ 4325.41553,35709.0195,154997.109 ,5.151344091d-02, $ 808.669556,22940.1172,89038.2969,145699.672/ data (xsc(90,13,i),i=1,10)/ 1.49804378,86.0589066 , $ 2854.00293,43763.1836,204403.484 ,4.222495947d-03, $ 831.180847,48406.6719,181424.375,203290.922/ data (xsc(90,14,i),i=1,10)/0.990160763,84.9544144 , $ 3537.86011,61136.7109,329522.906 ,3.322858829d-03, $ 1151.62366,76118.0234,296861.813,351032.781/ data (xsc(90,15,i),i=1,10)/1.291557774d-02, 3.48761749 , $ 465.507446,28162.8242,678548.563 ,3.316395741d-04, $ 1685.94482,305010.875,1679498.13,175044.375/ data (xsc(90,16,i),i=1,10)/1.449720468d-02, 4.05466318 , $ 562.677917,35155.6523,875816.438 ,4.542820679d-04, $ 2291.95605,418691.313,2306520.25,230358.953/ data (xsc(90,17,i),i=1,10)/ 5.12543678,56.6921768 , $ 483.870819,3157.56494,16144.9473,1.59335065 , $ 1164.63464,13204.5693,35900.0742,47829.9609/ data (xsc(90,18,i),i=1,10)/ 3.22147226,52.7174034 , $ 563.078918,3531.89648,13205.3047,1.54382432 , $ 2036.42456,14326.3066,39397.5703,133587.547/ data (xsc(90,19,i),i=1,10)/ 3.00122476,68.5812454 , $ 981.033936,8479.29980,48400.3281,2.72940397 , $ 6723.08105,73879.2813,190433.984,334627.750/ data (xsc(90,20,i),i=1,10)/0.295375645,16.2332058 , $ 513.687317,7711.88379,48096.0586,3.09335065 , $ 21043.4316,77838.1016,631898.438,3774984.25/ data (xsc(90,21,i),i=1,10)/0.193716198,15.9032726 , $ 630.955017,10614.9180,72772.0156,3.41730022 , $ 34181.8906,135000.875,965734.438,5904875.00/ data (xsc(90,22,i),i=1,10)/ 1.09475064,11.7419624 , $ 99.2631836,664.996521,3763.64331,11.4499903 , $ 3186.35620,24798.3672,56315.5508,174274.469/ data (xsc(90,23,i),i=1,10)/0.599823773,9.40906620 , $ 98.8109894,635.234314,2668.69360,14.2233953 , $ 2937.01074,40275.5586,688249.250,3604660.25/ data (xsc(90,24,i),i=1,10)/0.530631721,11.5330715 , $ 161.249908,1410.66431,8507.92773,25.3249302 , $ 11615.5664,91773.8047,862096.063,6226572.00/ data (xsc(91, 1,i),i=1,10)/0.0000d0,0.0000d0, $ 0.0000d0,0.0000d0,0.0000d0, 29.4217930 , $ 223.136414,600.697205,1035.42517,1351.72815/ data (xsc(91, 2,i),i=1,11)/ 337.117065,3259.90503 , $ 0.0000d0,0.0000d0,0.0000d0, 5.19536877 , $ 247.796692,1346.48499,3103.39087,4549.07129,4889.17822/ data (xsc(91, 3,i),i=1,11)/ 257.905670,5207.93652 , $ 0.0000d0,0.0000d0,0.0000d0, 1.70157337 , $ 195.931076,1716.45898,5356.15381,9198.30371,10276.5957/ data (xsc(91, 4,i),i=1,11)/ 224.646347,6579.08398 , $ 0.0000d0,0.0000d0,0.0000d0, 1.46701753 , $ 308.214417,3383.15088,11847.1455,21659.8418,24503.1035/ data (xsc(91, 5,i),i=1,11)/ 77.3622284,835.906982 , $ 6148.06592 ,0.0000d0,0.0000d0, 33.3525963 , $ 1100.01904,4531.10254,8875.43359,11910.4385,12559.3232/ data (xsc(91, 6,i),i=1,11)/ 55.8595657,938.530823 , $ 9165.85547 ,0.0000d0,0.0000d0, 25.2570820 , $ 1523.98364,7469.33203,14942.1523,19542.1445,20611.7461/ data (xsc(91, 7,i),i=1,11)/ 52.2285728,1253.22778 , $ 17866.4277 ,0.0000d0,0.0000d0, 37.5625000 , $ 3435.58594,20462.5117,47677.2148,69167.0703,75423.3516/ data (xsc(91, 8,i),i=1,11)/ 5.75961304,365.341827 , $ 14668.9941 ,0.0000d0,0.0000d0, 6.70611525 , $ 2344.94092,27821.2520,96390.9688,172092.281,199769.953/ data (xsc(91, 9,i),i=1,11)/ 3.78538799,359.353912 , $ 18164.5430 ,0.0000d0,0.0000d0, 5.52108574 , $ 3122.32910,41225.8398,148619.266,270616.875,243039.594/ data (xsc(91,10,i),i=1,11)/ 21.0021286,231.888794 , $ 1923.84741,11069.9834 ,0.0000d0, 187.909515 , $ 3793.61597,12330.0967,20968.8438,25971.4316,26566.6719/ data (xsc(91,11,i),i=1,11)/ 14.5760651,238.804214 , $ 2485.84570,13426.3496 ,0.0000d0, 251.954651 , $ 6102.91895,16669.2676,22509.7363,23724.2344,26403.6543/ data (xsc(91,12,i),i=1,11)/ 13.6208639,315.044312 , $ 4494.86768,36691.5938 ,0.0000d0, 555.756836 , $ 18990.5801,68248.2109,119065.188,148118.625,170989.891/ data (xsc(91,13,i),i=1,10)/ 1.64230478,92.9962540 , $ 3031.00464,45459.7344,204356.516 ,3.935094923d-03, $ 784.074402,46293.3555,177025.781,205539.109/ data (xsc(91,14,i),i=1,10)/ 1.08176517,91.7048569 , $ 3760.60034,63706.4531,331339.969 ,3.110173624d-03, $ 1058.86145,71959.8672,288208.750,349291.844/ data (xsc(91,15,i),i=1,10)/1.475244574d-02, 3.93603730 , $ 518.092651,30809.9121,723687.375 ,2.541629074d-04, $ 1390.44495,268268.000,1602622.00,154225.938/ data (xsc(91,16,i),i=1,10)/1.651385054d-02, 4.56706667 , $ 625.223999,38389.2852,933006.688 ,3.638048947d-04, $ 1922.26392,372285.031,2212278.25,202474.141/ data (xsc(91,17,i),i=1,10)/ 5.39867878,59.2882462 , $ 502.305939,3254.17920,16468.6211,1.38925898 , $ 1076.47644,12352.8877,33862.8359,45490.0625/ data (xsc(91,18,i),i=1,10)/ 3.50052953,56.2884750 , $ 589.689575,3624.10645,13284.4854,1.60460746 , $ 2043.36145,14154.6670,39618.5391,134922.734/ data (xsc(91,19,i),i=1,10)/ 3.23309350,73.0762100 , $ 1033.85815,8852.53125,50242.8086,2.88203740 , $ 6937.99805,75841.0234,194803.375,341959.656/ data (xsc(91,20,i),i=1,10)/0.330870241,17.9033680 , $ 556.262878,8182.76172,50086.0859,3.14749432 , $ 21223.2441,79335.6953,639017.000,3930551.75/ data (xsc(91,21,i),i=1,10)/0.215997905,17.4952431 , $ 682.322693,11258.5234,75960.1172,3.56514740 , $ 35011.4727,137911.125,1001618.38,6357603.00/ data (xsc(91,22,i),i=1,10)/ 1.13140631,12.0350523 , $ 100.865013,670.138062,3754.40869,20.0664749 , $ 4731.21875,31794.8516,81577.9766,277154.563/ data (xsc(91,23,i),i=1,10)/0.630836248,9.71265221 , $ 99.9530487,630.238342,2609.59546,47.1750145 , $ 5376.10059,160318.656,2133790.75,8486705.00/ data (xsc(91,24,i),i=1,10)/0.545299411,11.6766758 , $ 161.000015,1393.05579,8330.90820,148.432877 , $ 30669.6621,333496.375,4265278.50,21050740.0/ data (xsc(92, 1,i),i=1,10)/0.0000d0,0.0000d0, $ 0.0000d0,0.0000d0,0.0000d0, 28.8420296 , $ 216.662613,581.247925,1000.75500,1306.55957/ data (xsc(92, 2,i),i=1,11)/ 347.511749,3312.69507 , $ 0.0000d0,0.0000d0,0.0000d0, 5.04670286 , $ 238.440948,1294.83960,2983.78101,4374.05371,4702.30908/ data (xsc(92, 3,i),i=1,11)/ 275.066284,5450.26367 , $ 0.0000d0,0.0000d0,0.0000d0, 1.68461120 , $ 191.638474,1667.37158,5184.47363,8887.00000,9914.98242/ data (xsc(92, 4,i),i=1,11)/ 237.038956,6878.43262 , $ 0.0000d0,0.0000d0,0.0000d0, 1.43383610 , $ 299.443634,3284.61499,11500.2021,21017.8418,23796.3301/ data (xsc(92, 5,i),i=1,11)/ 80.0252914,856.124634 , $ 6198.50488 ,0.0000d0,0.0000d0, 31.9933510 , $ 1054.08093,4338.32813,8489.07422,11394.7461,11993.1641/ data (xsc(92, 6,i),i=1,11)/ 59.4962463,980.760010 , $ 9314.13086 ,0.0000d0,0.0000d0, 24.4866905 , $ 1463.05823,7151.39600,14279.6621,18608.2363,19801.8965/ data (xsc(92, 7,i),i=1,11)/ 55.1471939,1308.34705 , $ 18408.3984 ,0.0000d0,0.0000d0, 36.0961418 , $ 3308.43286,19758.1250,46138.4844,67105.4063,72027.0781/ data (xsc(92, 8,i),i=1,11)/ 6.25987339,392.130035 , $ 15519.8467 ,0.0000d0,0.0000d0, 6.42884302 , $ 2246.63086,26677.9121,92562.4453,165677.625,161128.875/ data (xsc(92, 9,i),i=1,11)/ 4.09870529,385.030487 , $ 19217.2520 ,0.0000d0,0.0000d0, 5.21098137 , $ 2972.62866,39420.1914,142481.063,259586.344,218465.656/ data (xsc(92,10,i),i=1,11)/ 21.8197193,238.938248 , $ 1962.87341,11122.5977 ,0.0000d0, 179.128845 , $ 3616.70117,11754.8545,20010.6035,24775.6016,25608.8555/ data (xsc(92,11,i),i=1,11)/ 15.5962124,250.807953 , $ 2555.26270,13389.1104 ,0.0000d0, 241.629105 , $ 5830.25635,15898.3486,21466.6270,22644.9102,25456.2285/ data (xsc(92,12,i),i=1,11)/ 14.4561348,330.642548 , $ 4663.99316,37632.7266 ,0.0000d0, 529.207092 , $ 18250.4551,66057.5000,115953.281,145725.063,141866.953/ data (xsc(92,13,i),i=1,10)/ 1.79938984,100.411514 , $ 3217.19214,47229.0898,203494.406 ,3.538780846d-03, $ 720.358765,43531.6289,171140.234,204807.703/ data (xsc(92,14,i),i=1,10)/ 1.18061268,98.8114548 , $ 3986.34106,66153.5703,333877.531 ,2.970987931d-03, $ 987.693970,68520.5469,280925.094,351001.250/ data (xsc(92,15,i),i=1,10)/1.679878868d-02, 4.42458105 , $ 573.094788,33343.6875,759708.875 ,2.203819167d-04, $ 1242.74731,246723.141,1552035.75,155875.063/ data (xsc(92,16,i),i=1,10)/1.875866763d-02, 5.12651873 , $ 691.397156,41594.4375,982996.938 ,3.104589123d-04, $ 1681.13770,338206.375,2135759.75,203558.438/ data (xsc(92,17,i),i=1,10)/ 5.68614292,61.9411621 , $ 520.420532,3343.23804,16722.4473,1.32321870 , $ 1028.75464,11836.4854,32616.0156,44416.0352/ data (xsc(92,18,i),i=1,10)/ 3.80143571,60.0876083 , $ 617.836304,3722.43945,13322.1113,1.32734489 , $ 1789.09875,12876.5469,34906.4883,119073.344/ data (xsc(92,19,i),i=1,10)/ 3.48343849,77.9058609 , $ 1090.78564,9263.05469,52299.1992,2.57604432 , $ 6471.06104,72662.7734,188445.047,325467.781/ data (xsc(92,20,i),i=1,10)/0.370925695,19.7877483 , $ 604.217896,8715.60840,52328.7227,2.62085009 , $ 19450.3066,81746.0547,509536.844,3205391.00/ data (xsc(92,21,i),i=1,10)/0.241213620,19.3023205 , $ 740.695251,11996.0439,79631.9766,2.94554043 , $ 32409.4219,142580.594,805837.188,5159188.50/ data (xsc(92,22,i),i=1,10)/ 1.19681120,12.6579933 , $ 105.484665,698.402161,3911.92090,8.77220631 , $ 2555.12280,20492.0859,50161.6914,174645.375/ data (xsc(92,23,i),i=1,10)/0.688192070,10.4296017 , $ 105.452431,653.458801,2669.10205,21.7011681 , $ 3465.78979,66133.5859,1070067.00,5223840.00/ data (xsc(92,24,i),i=1,10)/0.585494578,12.4282341 , $ 169.844070,1460.21033,8725.37793,54.2631149 , $ 17623.1504,145704.859,1739226.38,11441855.0/ c data (xnrg( 3, 1,i),i=6,10) / 24.8800831d0, 1.02811790d0, $ 0.218999997d0,9.252656251d-02,6.027210504d-02/ data (xnrg( 3, 2,i),i=6,10) / 2.42666030,0.100276709, $ 2.136000060d-02,9.024509229d-03,5.878594704d-03/ data (xnrg( 4, 1,i),i=6,10) / 50.4418144d0, 2.08440351d0, $ 0.444000006d0,0.187588111d0,0.122195505d0 / data (xnrg( 4, 2,i),i=6,10) / 3.82630682d0,0.158114210d0, $ 3.367999941d-02,1.422965620d-02,9.269244038d-03/ data (xnrg( 5, 1,i),i=6,10) / 85.4329758d0, 3.53034091d0, $ 0.751999974d0, 0.317716777d0,0.206961751d0 / data (xnrg( 5, 2,i),i=6,10) / 6.12118196d0,0.252945185d0, $ 5.387999862d-02, 2.276406996d-02,1.482858974d-02/ data (xnrg( 5, 3,i),i=6,10) / 2.13582444d0,8.825852722d-02, $ 1.879999973d-02, 7.942919619d-03,5.174043588d-03/ data (xnrg( 6, 1,i),i=6,10) / 128.967453d0, 5.32931280d0, $ 1.13520002d0, 0.479617149d0,0.312424183d0 / data (xnrg( 6, 2,i),i=6,10) / 8.86594391d0,0.366366804d0, $ 7.804000378d-02, 3.297156841d-02,2.147778682d-02/ data (xnrg( 6, 3,i),i=6,10) / 2.90835667d0,0.120181821d0, $ 2.559999935d-02, 1.081589051d-02,7.045506500d-03/ data (xnrg( 7, 1,i),i=6,10) / 182.499390d0, 7.54140949d0, $ 1.60640001d0, 0.678697169d0,0.442105532d0 / data (xnrg( 7, 2,i),i=6,10) / 11.9560728d0,0.494059980d0, $ 0.105240002d0, 4.446345195d-02,2.896363661d-02/ data (xnrg( 7, 3,i),i=6,10) / 4.18076277d0,0.172761381d0, $ 3.680000082d-02, 1.554784272d-02,1.012791600d-02/ data (xnrg( 7, 4,i),i=6,10) / 4.18076277d0,0.172761381d0, $ 3.680000082d-02, 1.554784272d-02,1.012791600d-02/ data (xnrg( 8, 1,i),i=6,10) / 241.757156d0, 9.99011421d0, $ 2.12800002d0, 0.899070919d0,0.585657716d0 / data (xnrg( 8, 2,i),i=6,10) / 10.7700090d0,0.445048332d0, $ 9.480000287d-02, 4.005259648d-02,2.609039098d-02/ data (xnrg( 8, 3,i),i=6,10) / 3.22645831d0,0.133326709d0, $ 2.840000018d-02, 1.199887879d-02,7.816108875d-03/ data (xnrg( 8, 4,i),i=6,10) / 3.22645831d0,0.133326709d0, $ 2.840000018d-02, 1.199887879d-02,7.816108875d-03/ data (xnrg( 9, 1,i),i=6,10) / 311.466827d0, 12.8707218d0, $ 2.74160004d0, 1.15831435d0,0.754529715d0 / data (xnrg( 9, 2,i),i=6,10) / 14.0873537d0,0.582130730d0, $ 0.124000005d0, 5.238947272d-02,3.412667289d-02/ data (xnrg( 9, 3,i),i=6,10) / 3.90810442d0,0.161494330d0, $ 3.440000117d-02, 1.453385316d-02,9.467399679d-03/ data (xnrg( 9, 4,i),i=6,10) / 3.90810442d0,0.161494330d0, $ 3.440000117d-02, 1.453385316d-02,9.467399679d-03/ data (xnrg(10, 1,i),i=6,10) / 393.946014d0, 16.2790031d0, $ 3.46759987d0, 1.46504617d0,0.954335868d0 / data (xnrg(10, 2,i),i=6,10) / 20.4493828d0,0.845028460d0, $ 0.180000007d0, 7.604923099d-02,4.953871667d-02/ data (xnrg(10, 3,i),i=6,10) / 8.31608295d0,0.343644917d0, $ 7.320000231d-02, 3.092668764d-02,2.014574595d-02/ data (xnrg(10, 4,i),i=6,10) / 8.31608295d0,0.343644917d0, $ 7.320000231d-02, 3.092668764d-02,2.014574595d-02/ data (xnrg(11, 1,i),i=6,11) / 22.8543644d0, 4.64584494d0, $ 2.14420009d0, 1.39372301d0, 1.12486768d0, 1.07317209d0/ data (xnrg(11, 2,i),i=6,10) / 28.7654667d0, 1.18867338d0, $ 0.253199995d0, 0.106975920d0,6.968446076d-02/ data (xnrg(11, 3,i),i=6,10) / 14.1327963d0,0.584008574d0, $ 0.124399997d0, 5.255847052d-02,3.423675895d-02/ data (xnrg(11, 4,i),i=6,10) / 14.1327963d0,0.584008574d0, $ 0.124399997d0, 5.255847052d-02,3.423675895d-02/ data (xnrg(12, 1,i),i=6,11) / 27.8191833d0, 5.65509510d0, $ 2.60999990d0, 1.69649148d0, 1.36923075d0, 1.30630505d0 / data (xnrg(12, 2,i),i=6,10) / 40.6261101d0, 1.67878985d0, $ 0.357600003d0, 0.151084468d0,9.841691703d-02/ data (xnrg(12, 3,i),i=6,10) / 23.3577404d0,0.965210319d0, $ 0.205600008d0, 8.686511964d-02,5.658422410d-02/ data (xnrg(12, 4,i),i=6,10) / 23.3577404d0,0.965210319d0, $ 0.205600008d0, 8.686511964d-02,5.658422410d-02/ data (xnrg(13, 1,i),i=6,11) / 33.2465858d0, 6.75838041d0, $ 3.11919999d0, 2.02746964d0, 1.63636184d0, 1.56115961d0 / data (xnrg(13, 2,i),i=6,10) / 53.4864998d0, 2.21021891d0, $ 0.470800012d0, 0.198910996d0,0.129571274d0 / data (xnrg(13, 3,i),i=6,10) / 33.2188873d0, 1.37270176d0, $ 0.292400002d0, 0.123537749d0,8.047289401d-02/ data (xnrg(13, 4,i),i=6,10) / 33.2188873d0, 1.37270176d0, $ 0.292400002d0, 0.123537749d0,8.047289401d-02/ data (xnrg(13, 5,i),i=6,10) / 3.80615973d0,0.157281682d0, $ 3.350266069d-02, 1.415473130d-02,9.220438078d-03/ data (xnrg(14, 1,i),i=6,11) / 39.2005310d0, 7.96870089d0, $ 3.67779994d0, 2.39055800d0, 1.92940867d0, 1.84073889d0/ data (xnrg(14, 2,i),i=6,10) / 67.5738525d0, 2.79234958d0, $ 0.594799995d0, 0.251300454d0,0.163697943d0 / data (xnrg(14, 3,i),i=6,10) / 45.0795288d0, 1.86281824d0, $ 0.396800011d0, 0.167646304d0,0.109205350d0 / data (xnrg(14, 4,i),i=6,10) / 45.0795288d0, 1.86281824d0, $ 0.396800011d0, 0.167646304d0,0.109205350d0 / data (xnrg(14, 5,i),i=6,10) / 5.16104650d0,0.213269562d0, $ 4.542867094d-02, 1.919342019d-02,1.250265632d-02/ data (xnrg(14, 6,i),i=6,10) / 2.30989599d0,9.545166790d-02, $ 2.033221535d-02, 8.590274490d-03,5.595732480d-03/ data (xnrg(15, 1,i),i=6,11) / 45.7364426d0, 9.29732323d0, $ 4.29099989d0, 2.78913593d0, 2.25109935d0, 2.14764547d0 / data (xnrg(15, 2,i),i=6,10) / 86.0237350d0, 3.55475307d0, $ 0.757200003d0, 0.319913775d0,0.208392873d0 / data (xnrg(15, 3,i),i=6,10) / 60.0757446d0, 2.48250580d0, $ 0.528800011d0, 0.223415747d0,0.145533741d0 / data (xnrg(15, 4,i),i=6,10) / 60.0757446d0, 2.48250580d0, $ 0.528800011d0, 0.223415747d0,0.145533741d0 / data (xnrg(15, 5,i),i=6,10) / 6.57174635d0,0.271563828d0, $ 5.784596503d-02, 2.443967387d-02,1.592008211d-02/ data (xnrg(15, 6,i),i=6,10) / 2.90150857d0,0.119898833d0, $ 2.553972043d-02, 1.079042256d-02,7.028916851d-03/ data (xnrg(15, 7,i),i=6,10) / 2.87958717d0,0.118992977d0, $ 2.534676343d-02, 1.070889924d-02,6.975811906d-03/ data (xnrg(16, 1,i),i=6,11) / 52.6965675d0, 10.7121801d0, $ 4.94400024d0, 3.21358371d0, 2.59366918d0, 2.47447205d0 / data (xnrg(16, 2,i),i=6,10) / 104.155533d0, 4.30401182d0, $ 0.916800022d0, 0.387344092d0,0.252317220d0 / data (xnrg(16, 3,i),i=6,10) / 74.8901901d0, 3.09468198d0, $ 0.659200013d0, 0.278509200d0,0.181421801d0 / data (xnrg(16, 4,i),i=6,10) / 74.8901901d0, 3.09468198d0, $ 0.659200013d0, 0.278509200d0,0.181421801d0 / data (xnrg(16, 5,i),i=6,10) / 8.03807640d0,0.332156867d0, $ 7.075292617d-02, 2.989280969d-02,1.947227307d-02/ data (xnrg(16, 6,i),i=6,10) / 3.55075431d0,0.146727577d0, $ 3.125452623d-02, 1.320490334d-02,8.601716720d-03/ data (xnrg(16, 7,i),i=6,10) / 3.51496625d0,0.145248711d0, $ 3.093951195d-02, 1.307181176d-02,8.515020832d-03/ data (xnrg(17, 1,i),i=6,11) / 60.1661758d0, 12.2306061d0, $ 5.64479971d0, 3.66910148d0, 2.96131539d0, 2.82522225d0 / data (xnrg(17, 2,i),i=6,10) / 122.787186d0, 5.07392645d0, $ 1.08080006d0, 0.456633389d0,0.297452480d0 / data (xnrg(17, 3,i),i=6,10) / 91.6132355d0, 3.78572750d0, $ 0.806400001d0, 0.340700567d0,0.221933454d0 / data (xnrg(17, 4,i),i=6,10) / 90.8861542d0, 3.75568223d0, $ 0.800000012d0, 0.337996602d0,0.220172077d0 / data (xnrg(17, 5,i),i=6,10) / 7.95253801d0,0.328622192d0, $ 7.000000030d-02, 2.957470156d-02,1.926505752d-02/ data (xnrg(17, 6,i),i=6,10) / 3.09012914d0,0.127693191d0, $ 2.720000036d-02, 1.149188355d-02,7.485850714d-03/ data (xnrg(17, 7,i),i=6,10) / 3.09012914d0,0.127693191d0, $ 2.720000036d-02, 1.149188355d-02,7.485850714d-03/ data (xnrg(18, 1,i),i=6,11) / 68.2774429d0, 13.8794670d0, $ 6.40580034d0, 4.16374922d0, 3.36054349d0, 3.20610285d0 / data (xnrg(18, 2,i),i=6,10) / 145.417831d0, 6.00909138d0, $ 1.27999997d0, 0.540794551d0,0.352275312d0 / data (xnrg(18, 3,i),i=6,10) / 112.380722d0, 4.64390087d0, $ 0.989199996d0, 0.417932779d0,0.272242785d0 / data (xnrg(18, 4,i),i=6,10) / 111.426414d0, 4.60446596d0, $ 0.980799973d0, 0.414383799d0,0.269930959d0 / data (xnrg(18, 5,i),i=6,10) / 11.4970980d0,0.475093782d0, $ 0.101199999d0, 4.275656864d-02,2.785176784d-02/ data (xnrg(18, 6,i),i=6,10) / 5.63494110d0,0.232852280d0, $ 4.960000142d-02, 2.095578797d-02,1.365066878d-02/ data (xnrg(18, 7,i),i=6,10) / 5.63494110d0,0.232852280d0, $ 4.960000142d-02, 2.095578797d-02,1.365066878d-02/ data (xnrg(19, 1,i),i=6,11) / 76.9003220d0, 15.6323299d0, $ 7.21479988d0, 4.68959618d0, 3.78495240d0, 3.61100745d0 / data (xnrg(19, 2,i),i=6,10) / 171.365829d0, 7.08133841d0, $ 1.50839996d0, 0.637292564d0,0.415134460d0 / data (xnrg(19, 3,i),i=6,10) / 134.647827d0, 5.56404305d0, $ 1.18519998d0, 0.500741959d0,0.326184928d0 / data (xnrg(19, 4,i),i=6,10) / 133.420868d0, 5.51334143d0, $ 1.17439997d0, 0.496178985d0,0.323212624d0 / data (xnrg(19, 5,i),i=6,10) / 15.4052029d0,0.636588097d0, $ 0.135600001d0, 5.729041994d-02,3.731916845d-02/ data (xnrg(19, 6,i),i=6,10) / 8.08886719d0,0.334255695d0, $ 7.119999826d-02, 3.008169681d-02,1.959531568d-02/ data (xnrg(19, 7,i),i=6,10) / 8.08886719d0,0.334255695d0, $ 7.119999826d-02, 3.008169681d-02,1.959531568d-02/ data (xnrg(20, 1,i),i=6,11) / 86.0817184d0, 17.4987278d0, $ 8.07619953d0, 5.24950361d0, 4.23685122d0, 4.04213810d0/ data (xnrg(20, 2,i),i=6,10) / 198.949783d0, 8.22118759d0, $ 1.75119996d0, 0.739874542d0,0.481956691 / data (xnrg(20, 3,i),i=6,10) / 159.050766d0, 6.57244349d0, $ 1.39999998d0, 0.591494024d0,0.385301143 / data (xnrg(20, 4,i),i=6,10) / 157.414810d0, 6.50484133d0, $ 1.38559997d0, 0.585410118d0,0.381338030 / data (xnrg(20, 5,i),i=6,10) / 19.8586235d0,0.820616543d0, $ 0.174799994d0, 7.385225594d-02,4.810759798d-02/ data (xnrg(20, 6,i),i=6,10) / 11.5425415d0,0.476971626d0, $ 0.101599999d0, 4.292556643d-02,2.796185389d-02/ data (xnrg(20, 7,i),i=6,10) / 11.5425415d0,0.476971626d0, $ 0.101599999d0, 4.292556643d-02,2.796185389d-02/ data (xnrg(21, 1,i),i=6,11) / 95.7747269d0, 19.4691277d0, $ 8.98559952d0, 5.84061050d0, 4.71393061d0, 4.49729300 / data (xnrg(21, 2,i),i=6,10) / 227.397141d0, 9.39671612d0, $ 2.00160003d0, 0.845667481d0,0.550870538 / data (xnrg(21, 3,i),i=6,10) / 184.816986d0, 7.63717937d0, $ 1.62679994d0, 0.687316060d0,0.447719902 / data (xnrg(21, 4,i),i=6,10) / 182.772049d0, 7.55267668d0, $ 1.60880005d0, 0.679711163d0,0.442766041 / data (xnrg(21, 5,i),i=6,10) / 24.4483738d0, 1.01027846d0, $ 0.215200007d0, 9.092108160d-02,5.922628939d-02/ data (xnrg(21, 6,i),i=6,10) / 14.6781130d0,0.606542647d0, $ 0.129199997d0, 5.458644778d-02,3.555779159d-02/ data (xnrg(21, 7,i),i=6,10) / 14.6781130d0,0.606542647d0, $ 0.129199997d0, 5.458644778d-02,3.555779159d-02/ data (xnrg(22, 1,i),i=6,11) / 105.870644d0, 21.5214291d0, $ 9.93280029d0, 6.45628738d0, 5.21084070d0, 4.97136641 / data (xnrg(22, 2,i),i=6,10) / 256.162628d0, 10.5853901d0, $ 2.25480008d0, 0.952643394d0,0.620554984 / data (xnrg(22, 3,i),i=6,10) / 209.719788d0, 8.66623592d0, $ 1.84599996d0, 0.779927135d0,0.508047044 / data (xnrg(22, 4,i),i=6,10) / 206.993210d0, 8.55356598d0, $ 1.82200003d0, 0.769787252d0,0.501441896 / data (xnrg(22, 5,i),i=6,10) / 27.4021740d0, 1.13233817d0, $ 0.241200000d0, 0.101905972d0,6.638187915d-02/ data (xnrg(22, 6,i),i=6,10) / 15.7233038d0,0.649733007d0, $ 0.138400003d0, 5.847340822d-02,3.808977082d-02/ data (xnrg(22, 7,i),i=6,10) / 15.7233038d0,0.649733007d0, $ 0.138400003d0, 5.847340822d-02,3.808977082d-02/ data (xnrg(23, 1,i),i=6,11) / 116.501617d0, 23.6824989d0, $ 10.9301996d0, 7.10459423d0, 5.73408651d0, 5.47056532 / data (xnrg(23, 2,i),i=6,10) / 285.473389d0, 11.7965975d0, $ 2.51279998d0, 1.06164730d0,0.691560507 / data (xnrg(23, 3,i),i=6,10) / 236.531204d0, 9.77416229d0, $ 2.08200002d0, 0.879636109d0,0.572997808 / data (xnrg(23, 4,i),i=6,10) / 233.077530d0, 9.63144684d0, $ 2.05159998d0, 0.866792262d0,0.564631283 / data (xnrg(23, 5,i),i=6,10) / 30.2196445d0, 1.24876428d0, $ 0.266000003d0, 0.112383865d0,7.320721447d-02/ data (xnrg(23, 6,i),i=6,10) / 17.1774826d0,0.709823906d0, $ 0.151199996d0, 6.388135254d-02,4.161252454d-02/ data (xnrg(23, 7,i),i=6,10) / 17.1774826d0,0.709823906d0, $ 0.151199996d0, 6.388135254d-02,4.161252454d-02/ data (xnrg(23, 8,i),i=6,10) / 0.999747634d0,4.131250456d-02, $ 8.799999952d-03, 3.717962420d-03,2.421892947d-03/ data (xnrg(24, 1,i),i=6,11) / 127.674065d0, 25.9536381d0, $ 11.9784002d0, 7.78592062d0, 6.28398228d0, 5.99518919 / data (xnrg(24, 2,i),i=6,10) / 315.647583d0, 13.0434837d0, $ 2.77839994d0, 1.17386210d0,0.764657617 / data (xnrg(24, 3,i),i=6,10) / 265.251221d0, 10.9609585d0, $ 2.33480000d0, 0.986443043d0,0.642572224 / data (xnrg(24, 4,i),i=6,10) / 261.070465d0, 10.7881966d0, $ 2.29800010d0, 0.970895171d0,0.632444322 / data (xnrg(24, 5,i),i=6,10) / 33.6733170d0, 1.39148021d0, $ 0.296400011d0, 0.125227734d0,8.157375455d-02/ data (xnrg(24, 6,i),i=6,10) / 19.3133068d0,0.798082411d0, $ 0.170000002d0, 7.182427496d-02,4.678656533d-02/ data (xnrg(24, 7,i),i=6,10) / 19.3133068d0,0.798082411d0, $ 0.170000002d0, 7.182427496d-02,4.678656533d-02/ data (xnrg(24, 8,i),i=6,10) / 1.04519069d0,4.319034144d-02, $ 9.200000204d-03, 3.886960680d-03,2.531978767d-03/ data (xnrg(24, 9,i),i=6,10) / 1.04519069d0,4.319034144d-02, $ 9.200000204d-03, 3.886960680d-03,2.531978767d-03/ data (xnrg(25, 1,i),i=6,11) / 139.394363d0, 28.3361435d0, $ 13.0780001d0, 8.50065708d0, 6.86084270d0, 6.54553890 / data (xnrg(25, 2,i),i=6,10) / 349.457245d0, 14.4405975d0, $ 3.07599998d0, 1.29959691d0,0.846561670 / data (xnrg(25, 3,i),i=6,10) / 296.016174d0, 12.2322559d0, $ 2.60559988d0, 1.10085487d0,0.717100441 / data (xnrg(25, 4,i),i=6,10) / 290.972015d0, 12.0238161d0, $ 2.56119990d0, 1.08209610d0,0.704880893 / data (xnrg(25, 5,i),i=6,10) / 38.1267395d0, 1.57550859d0, $ 0.335599989d0, 0.141789570d0,9.236218780d-02/ data (xnrg(25, 6,i),i=6,10) / 22.0853348d0,0.912630737d0, $ 0.194399998d0, 8.213317394d-02,5.350181460d-02/ data (xnrg(25, 7,i),i=6,10) / 22.0853348d0,0.912630737d0, $ 0.194399998d0, 8.213317394d-02,5.350181460d-02/ data (xnrg(25, 8,i),i=6,10) / 3.29989052d0,0.136361137d0, $ 2.904636599d-02, 1.227196585d-02,7.993998006d-03/ data (xnrg(25, 9,i),i=6,10) / 3.24635458d0,0.134148881d0, $ 2.857512981d-02, 1.207287051d-02,7.864307612d-03/ data (xnrg(26, 1,i),i=6,11) / 151.609222d0, 30.8191853d0, $ 14.2240000d0, 9.24555302d0, 7.46204519d0, 7.11911201 / data (xnrg(26, 2,i),i=6,10) / 384.493866d0, 15.8884125d0, $ 3.38439989d0, 1.42989457d0,0.931437969 / data (xnrg(26, 3,i),i=6,10) / 327.690002d0, 13.5411119d0, $ 2.88440013d0, 1.21864665d0,0.793830454 / data (xnrg(26, 4,i),i=6,10) / 321.782410d0, 13.2969923d0, $ 2.83240008d0, 1.19667697d0,0.779519260 / data (xnrg(26, 5,i),i=6,10) / 42.2166176d0, 1.74451435d0, $ 0.371600002d0, 0.156999409d0,0.102269933 / data (xnrg(26, 6,i),i=6,10) / 24.5392609d0, 1.01403415d0, $ 0.216000006d0, 9.125907719d-02,5.944646150d-02/ data (xnrg(26, 7,i),i=6,10) / 24.5392609d0, 1.01403415d0, $ 0.216000006d0, 9.125907719d-02,5.944646150d-02/ data (xnrg(26, 8,i),i=6,10) / 1.63595068d0,6.760227680d-02, $ 1.439999975d-02, 6.083938293d-03,3.963097464d-03/ data (xnrg(26, 9,i),i=6,10) / 1.63595068d0,6.760227680d-02, $ 1.439999975d-02, 6.083938293d-03,3.963097464d-03/ data (xnrg(27, 1,i),i=6,11) / 164.333557d0, 33.4057961d0, $ 15.4177999d0, 10.0215197d0, 8.08832359d0, 7.71660900 / data (xnrg(27, 2,i),i=6,10) / 420.621094d0, 17.3812962d0, $ 3.70239997d0, 1.56424820d0, 1.01895642 / data (xnrg(27, 3,i),i=6,10) / 360.636230d0, 14.9025459d0, $ 3.17440009d0, 1.34117043d0,0.873642802 / data (xnrg(27, 4,i),i=6,10) / 353.819794d0, 14.6208706d0, $ 3.11439991d0, 1.31582069d0,0.857129872 / data (xnrg(27, 5,i),i=6,10) / 45.7611771d0, 1.89098597d0, $ 0.402799994d0, 0.170181274d0,0.110856637 / data (xnrg(27, 6,i),i=6,10) / 27.0386295d0, 1.11731541d0, $ 0.238000005d0, 0.100553982d0,6.550119072d-02/ data (xnrg(27, 7,i),i=6,10) / 27.0386295d0, 1.11731541d0, $ 0.238000005d0, 0.100553982d0,6.550119072d-02/ data (xnrg(27, 8,i),i=6,10) / 1.31784916d0,5.445738882d-02, $ 1.159999985d-02, 4.900950473d-03,3.192495089d-03/ data (xnrg(27, 9,i),i=6,10) / 1.31784916d0,5.445738882d-02, $ 1.159999985d-02, 4.900950473d-03,3.192495089d-03/ data (xnrg(28, 1,i),i=6,11) / 177.633469d0, 36.1094093d0, $ 16.6655998d0, 10.8325853d0, 8.74293137d0, 8.34113312 / data (xnrg(28, 2,i),i=6,11) / 21.4900513d0, 4.36850691d0, $ 2.01620007d0, 1.31052339d0, 1.05771756d0, 1.00910807 / data (xnrg(28, 3,i),i=6,10) / 396.218170d0, 16.3728962d0, $ 3.48760009d0, 1.47349608d0,0.959840178 / data (xnrg(28, 4,i),i=6,10) / 388.401947d0, 16.0499077d0, $ 3.41880012d0, 1.44442844d0,0.940905392 / data (xnrg(28, 5,i),i=6,10) / 50.8053589d0, 2.09942627d0, $ 0.447200000d0, 0.188940093d0,0.123076193 / data (xnrg(28, 6,i),i=6,10) / 30.9467335d0, 1.27880979d0, $ 0.272399992d0, 0.115087837d0,7.496859133d-02/ data (xnrg(28, 7,i),i=6,10) / 30.9467335d0, 1.27880979d0, $ 0.272399992d0, 0.115087837d0,7.496859133d-02/ data (xnrg(28, 8,i),i=6,10) / 1.63595068d0,6.760227680d-02, $ 1.439999975d-02, 6.083938293d-03,3.963097464d-03/ data (xnrg(28, 9,i),i=6,10) / 1.63595068d0,6.760227680d-02, $ 1.439999975d-02, 6.083938293d-03,3.963097464d-03/ data (xnrg(29, 1,i),i=6,11) / 191.406631d0, 38.9092216d0, $ 17.9577999d0, 11.6725111d0, 9.42083168d0, 8.98787880 / data (xnrg(29, 2,i),i=6,11) / 23.3659821d0, 4.74984646d0, $ 2.19219995d0, 1.42492282d0, 1.15004885d0, 1.09719610 / data (xnrg(29, 3,i),i=6,10) / 432.163635d0, 17.8582687d0, $ 3.80399990d0, 1.60717380d0, 1.04691827 / data (xnrg(29, 4,i),i=6,10) / 423.120483d0, 17.4845772d0, $ 3.72440004d0, 1.57354307d0, 1.02501106 / data (xnrg(29, 5,i),i=6,10) / 54.4408035d0, 2.24965358d0, $ 0.479200006d0, 0.202459961d0,0.131883070 / data (xnrg(29, 6,i),i=6,10) / 33.4461021d0, 1.38209105d0, $ 0.294400007d0, 0.124382742d0,8.102332801d-02/ data (xnrg(29, 7,i),i=6,10) / 33.4461021d0, 1.38209105d0, $ 0.294400007d0, 0.124382742d0,8.102332801d-02/ data (xnrg(29, 8,i),i=6,10) / 0.727089226d0,3.004545718d-02, $ 6.400000304d-03, 2.703972859d-03,1.761376741d-03/ data (xnrg(29, 9,i),i=6,10) / 0.727089226d0,3.004545718d-02, $ 6.400000304d-03, 2.703972859d-03,1.761376741d-03/ data (xnrg(30, 1,i),i=6,11) / 205.896057d0, 41.8546371d0, $ 19.3171997d0, 12.5561171d0, 10.1339865d0, 9.66825867 / data (xnrg(30, 2,i),i=6,11) / 25.4444256d0, 5.17235374d0, $ 2.38720012d0, 1.55167222d0, 1.25234771d0, 1.19479358 / data (xnrg(30, 3,i),i=6,11) / 22.2297649d0, 4.51887608d0, $ 2.08559990d0, 1.35563314d0, 1.09412551d0, 1.04384279 / data (xnrg(30, 4,i),i=6,11) / 21.7373333d0, 4.41877460d0, $ 2.03940010d0, 1.32560337d0, 1.06988859d0, 1.02071965 / data (xnrg(30, 5,i),i=6,10) / 61.7571373d0, 2.55198598d0, $ 0.543600023d0, 0.229668677d0,0.149606928 / data (xnrg(30, 6,i),i=6,10) / 39.3537025d0, 1.62621033d0, $ 0.346399993d0, 0.146352515d0,9.533450752d-02/ data (xnrg(30, 7,i),i=6,10) / 39.3537025d0, 1.62621033d0, $ 0.346399993d0, 0.146352515d0,9.533450752d-02/ data (xnrg(30, 8,i),i=6,10) / 3.68088913d0,0.152105123d0, $ 3.240000084d-02, 1.368886139d-02,8.916969411d-03/ data (xnrg(30, 9,i),i=6,10) / 3.68088913d0,0.152105123d0, $ 3.240000084d-02, 1.368886139d-02,8.916969411d-03/ data (xnrg(31, 1,i),i=6,11) / 220.999420d0, 44.9248581d0, $ 20.7341995d0, 13.4771624d0, 10.8773575d0, 10.3774672 / data (xnrg(31, 2,i),i=6,11) / 27.6635666d0, 5.62346125d0, $ 2.59540009d0, 1.68700147d0, 1.36157143d0, 1.29899764 / data (xnrg(31, 3,i),i=6,11) / 24.3508453d0, 4.95004988d0, $ 2.28460002d0, 1.48498249d0, 1.19852281d0, 1.14344227 / data (xnrg(31, 4,i),i=6,11) / 23.7774067d0, 4.83348131d0, $ 2.23079991d0, 1.45001268d0, 1.17029881d0, 1.11651540 / data (xnrg(31, 5,i),i=6,10) / 71.8455048d0, 2.96886683d0, $ 0.632400036d0, 0.267186314d0,0.174046025 / data (xnrg(31, 6,i),i=6,10) / 48.5332031d0, 2.00553417d0, $ 0.427199990d0, 0.180490181d0,0.117571890 / data (xnrg(31, 7,i),i=6,10) / 46.7609253d0, 1.93229842d0, $ 0.411599994d0, 0.173899248d0,0.113278531 / data (xnrg(31, 8,i),i=6,10) / 7.90709448d0,0.326744318d0, $ 6.960000098d-02, 2.940570191d-02,1.915496960d-02/ data (xnrg(31, 9,i),i=6,10) / 7.90709448d0,0.326744318d0, $ 6.960000098d-02, 2.940570191d-02,1.915496960d-02/ data (xnrg(32, 1,i),i=6,11) / 236.689011d0, 48.1142426d0, $ 22.2061996d0, 14.4339571d0, 11.6495829d0, 11.1142035 / data (xnrg(32, 2,i),i=6,11) / 30.1491718d0, 6.12873650d0, $ 2.82859993d0, 1.83858073d0, 1.48391032d0, 1.41571426 / data (xnrg(32, 3,i),i=6,11) / 26.5998287d0, 5.40722418d0, $ 2.49559999d0, 1.62213182d0, 1.30921543d0, 1.24904776 / data (xnrg(32, 4,i),i=6,11) / 25.9368572d0, 5.27245522d0, $ 2.43339992d0, 1.58170199d0, 1.27658463d0, 1.21791673 / data (xnrg(32, 5,i),i=6,10) / 81.7975388d0, 3.38011384d0, $ 0.720000029d0, 0.304196924d0,0.198154882 / data (xnrg(32, 6,i),i=6,10) / 58.1216927d0, 2.40175867d0, $ 0.511600018d0, 0.216148809d0,0.140800044 / data (xnrg(32, 7,i),i=6,10) / 54.8952332d0, 2.26843190d0, $ 0.483200014d0, 0.204149932d0,0.132983938 / data (xnrg(32, 8,i),i=6,10) / 13.0421619d0,0.538940370d0, $ 0.114799999d0, 4.850250855d-02,3.159469366d-02/ data (xnrg(32, 9,i),i=6,10) / 13.0421619d0,0.538940370d0, $ 0.114799999d0, 4.850250855d-02,3.159469366d-02/ data (xnrg(33, 1,i),i=6,11) / 252.966965d0, 51.4232330d0, $ 23.7334003d0, 15.4266319d0, 12.4507666d0, 11.8785667 / data (xnrg(33, 2,i),i=6,11) / 32.5409851d0, 6.61494493d0, $ 3.05300021d0, 1.98444009d0, 1.60163271d0, 1.52802658 / data (xnrg(33, 3,i),i=6,11) / 28.9617939d0, 5.88736582d0, $ 2.71720004d0, 1.76617110d0, 1.42546880d0, 1.35995865 / data (xnrg(33, 4,i),i=6,11) / 28.2050266d0, 5.73353004d0, $ 2.64619994d0, 1.72002137d0, 1.38822162d0, 1.32442307 / data (xnrg(33, 5,i),i=6,10) / 92.4766541d0, 3.82140660d0, $ 0.814000010d0, 0.343911529d0,0.224025086 / data (xnrg(33, 6,i),i=6,10) / 66.5286636d0, 2.74915934d0, $ 0.585600019d0, 0.247413501d0,0.161165968 / data (xnrg(33, 7,i),i=6,10) / 63.8475227d0, 2.63836670d0, $ 0.562000036d0, 0.237442613d0,0.154670894 / data (xnrg(33, 8,i),i=6,10) / 18.7225475d0,0.773670495d0, $ 0.164800003d0, 6.962729990d-02,4.535545036d-02/ data (xnrg(33, 9,i),i=6,10) / 18.7225475d0,0.773670495d0, $ 0.164800003d0, 6.962729990d-02,4.535545036d-02/ data (xnrg(34, 1,i),i=6,11) / 269.831146d0, 54.8513908d0, $ 25.3155994d0, 16.4550571d0, 13.2808037d0, 12.6704578 / data (xnrg(34, 2,i),i=6,11) / 35.2568169d0, 7.16702080d0, $ 3.30780005d0, 2.15005922d0, 1.73530328d0, 1.65555394 / data (xnrg(34, 3,i),i=6,11) / 31.4687195d0, 6.39697456d0, $ 2.95239997d0, 1.91905034d0, 1.54885697d0, 1.47767615 / data (xnrg(34, 4,i),i=6,11) / 30.6074982d0, 6.22190523d0, $ 2.87160015d0, 1.86653066d0, 1.50646865d0, 1.43723583 / data (xnrg(34, 5,i),i=6,10) / 105.200722d0, 4.34720182d0, $ 0.925999999d0, 0.391231060d0,0.254849195 / data (xnrg(34, 6,i),i=6,10) / 76.4352493d0, 3.15852857d0, $ 0.672800004d0, 0.284255117d0,0.185164720 / data (xnrg(34, 7,i),i=6,10) / 73.5723343d0, 3.04022455d0, $ 0.647599995d0, 0.273608238d0,0.178229287 / data (xnrg(34, 8,i),i=6,10) / 25.7662239d0, 1.06473589d0, $ 0.226799995d0, 9.582202882d-02,6.241878495d-02/ data (xnrg(34, 9,i),i=6,10) / 25.7662239d0, 1.06473589d0, $ 0.226799995d0, 9.582202882d-02,6.241878495d-02/ data (xnrg(35, 1,i),i=6,11) / 287.223999d0, 58.3870163d0, $ 26.9473991d0, 17.5157223d0, 14.1368608d0, 13.4871740 / data (xnrg(35, 2,i),i=6,11) / 37.9875755d0, 7.72213030d0, $ 3.56400013d0, 2.31658840d0, 1.86970818d0, 1.78378201 / data (xnrg(35, 3,i),i=6,11) / 34.0225410d0, 6.91611624d0, $ 3.19199991d0, 2.07478952d0, 1.67455339d0, 1.59759593 / data (xnrg(35, 4,i),i=6,11) / 33.0398102d0, 6.71634674d0, $ 3.09980011d0, 2.01485991d0, 1.62618446d0, 1.55144989 / data (xnrg(35, 5,i),i=6,10) / 116.561485d0, 4.81666231d0, $ 1.02600002d0, 0.433480620d0,0.282370687 / data (xnrg(35, 6,i),i=6,10) / 86.0237350d0, 3.55475307d0, $ 0.757200003d0, 0.319913775d0,0.208392873 / data (xnrg(35, 7,i),i=6,10) / 82.4791794d0, 3.40828133d0, $ 0.726000011d0, 0.306731910d0,0.199806154 / data (xnrg(35, 8,i),i=6,10) / 31.8555946d0, 1.31636655d0, $ 0.280400008d0, 0.118467800d0,7.717031240d-02/ data (xnrg(35, 9,i),i=6,10) / 31.3557224d0, 1.29571033d0, $ 0.275999993d0, 0.116608821d0,7.595936954d-02/ data (xnrg(36, 1,i),i=6,11) / 305.384277d0, 62.0786438d0, $ 28.6511993d0, 18.6231861d0, 15.0306911d0, 14.3399258 / data (xnrg(36, 2,i),i=6,11) / 40.9506912d0, 8.32447338d0, $ 3.84200001d0, 2.49728751d0, 2.01554966d0, 1.92292106 / data (xnrg(36, 3,i),i=6,11) / 36.8193817d0, 7.48465967d0, $ 3.45440006d0, 2.24534869d0, 1.81221104d0, 1.72892725 / data (xnrg(36, 4,i),i=6,11) / 35.7044830d0, 7.25802231d0, $ 3.34979987d0, 2.17735887d0, 1.75733674d0, 1.67657483 / data (xnrg(36, 5,i),i=6,10) / 131.026016d0, 5.41437912d0, $ 1.15331995d0, 0.487272769d0,0.317411065 / data (xnrg(36, 6,i),i=6,10) / 101.201729d0, 4.18195200d0, $ 0.890799999d0, 0.376359195d0,0.245161608 / data (xnrg(36, 7,i),i=6,10) / 97.1572952d0, 4.01482391d0, $ 0.855199993d0, 0.361318350d0,0.235363945 / data (xnrg(36, 8,i),i=6,10) / 40.3988914d0, 1.66940069d0, $ 0.355599999d0, 0.150239483d0,9.786649048d-02/ data (xnrg(36, 9,i),i=6,10) / 40.3988914d0, 1.66940069d0, $ 0.355599999d0, 0.150239483d0,9.786649048d-02/ data (xnrg(37, 1,i),i=6,11) / 324.017792d0, 65.8664780d0, $ 30.3993988d0, 19.7595100d0, 15.9478130d0, 15.2148991 / data (xnrg(37, 2,i),i=6,11) / 44.0225258d0, 8.94891739d0, $ 4.13019991d0, 2.68461657d0, 2.16674209d0, 2.06716514 / data (xnrg(37, 3,i),i=6,11) / 39.7334671d0, 8.07703590d0, $ 3.72779989d0, 2.42305779d0, 1.95563912d0, 1.86576390 / data (xnrg(37, 4,i),i=6,11) / 38.4650841d0, 7.81919861d0, $ 3.60879993d0, 2.34570813d0, 1.89321065d0, 1.80620444 / data (xnrg(37, 5,i),i=6,10) / 146.372147d0, 6.04852581d0, $ 1.28840005d0, 0.544343531d0,0.354587138 / data (xnrg(37, 6,i),i=6,10) / 112.426170d0, 4.64577866d0, $ 0.989600003d0, 0.418101788d0,0.272352874 / data (xnrg(37, 7,i),i=6,10) / 108.381729d0, 4.47865057d0, $ 0.953999996d0, 0.403060913d0,0.262555212 / data (xnrg(37, 8,i),i=6,10) / 50.8053589d0, 2.09942627d0, $ 0.447200000d0, 0.188940093d0,0.123076193 / data (xnrg(37, 9,i),i=6,10) / 50.1237106d0, 2.07125854d0, $ 0.441199988d0, 0.186405122d0,0.121424899 / data (xnrg(38, 1,i),i=6,11) / 343.307892d0, 69.7877731d0, $ 32.2092018d0, 20.9358749d0, 16.8972511d0, 16.1207047 / data (xnrg(38, 2,i),i=6,11) / 47.2457123d0, 9.60412788d0, $ 4.43260002d0, 2.88117552d0, 2.32538390d0, 2.21851635 / data (xnrg(38, 3,i),i=6,11) / 42.7797203d0, 8.69628048d0, $ 4.01360035d0, 2.60882688d0, 2.10557270d0, 2.00880694 / data (xnrg(38, 4,i),i=6,11) / 41.3471947d0, 8.40507507d0, $ 3.87920022d0, 2.52146745d0, 2.03506517d0, 1.94153965 / data (xnrg(38, 5,i),i=6,10) / 162.458984d0, 6.71328163d0, $ 1.42999995d0, 0.604168892d0,0.393557578 / data (xnrg(38, 6,i),i=6,10) / 127.149719d0, 5.25419903d0, $ 1.11919999d0, 0.472857207d0,0.308020741 / data (xnrg(38, 7,i),i=6,10) / 122.287315d0, 5.05327034d0, $ 1.07640004d0, 0.454774410d0,0.296241522 / data (xnrg(38, 8,i),i=6,10) / 61.3481522d0, 2.53508544d0, $ 0.540000021d0, 0.228147700d0,0.148616150 / data (xnrg(38, 9,i),i=6,10) / 60.4847336d0, 2.49940634d0, $ 0.532400012d0, 0.224936724d0,0.146524519 / data (xnrg(38,10,i),i=6,10) / 17.1320381d0,0.707946062d0, $ 0.150800005d0, 6.371235847d-02,4.150243476d-02/ data (xnrg(38,11,i),i=6,10) / 9.04317188d0,0.373690367d0, $ 7.959999889d-02, 3.363065794d-02,2.190712094d-02/ data (xnrg(38,12,i),i=6,10) / 9.04317188d0,0.373690367d0, $ 7.959999889d-02, 3.363065794d-02,2.190712094d-02/ data (xnrg(39, 1,i),i=6,11) / 363.214050d0, 73.8343048d0, $ 34.0767975d0, 22.1498070d0, 17.8770123d0, 17.0554371 / data (xnrg(39, 2,i),i=6,11) / 50.5754852d0, 10.2810059d0, $ 4.74499989d0, 3.08423448d0, 2.48927188d0, 2.37487245 / data (xnrg(39, 3,i),i=6,11) / 45.9496155d0, 9.34065723d0, $ 4.31099987d0, 2.80213594d0, 2.26159143d0, 2.15765548 / data (xnrg(39, 4,i),i=6,11) / 44.3401527d0, 9.01348495d0, $ 4.15999985d0, 2.70398617d0, 2.18237543d0, 2.08207989 / data (xnrg(39, 5,i),i=6,10) / 178.863937d0, 7.39118242d0, $ 1.57440007d0, 0.665177286d0,0.433298647 / data (xnrg(39, 6,i),i=6,10) / 141.964172d0, 5.86637545d0, $ 1.24960005d0, 0.527950704d0,0.343908787 / data (xnrg(39, 7,i),i=6,10) / 136.465546d0, 5.63915634d0, $ 1.20120001d0, 0.507501841d0,0.330588371 / data (xnrg(39, 8,i),i=6,10) / 72.5271454d0, 2.99703431d0, $ 0.638400018d0, 0.269721270d0,0.175697312 / data (xnrg(39, 9,i),i=6,10) / 71.5273972d0, 2.95572186d0, $ 0.629599988d0, 0.266003311d0,0.173275426 / data (xnrg(39,10,i),i=6,10) / 20.6311550d0,0.852539837d0, $ 0.181600004d0, 7.672522217d-02,4.997906089d-02/ data (xnrg(39,11,i),i=6,10) / 11.6334267d0,0.480727285d0, $ 0.102399997d0, 4.326356202d-02,2.818202600d-02/ data (xnrg(39,12,i),i=6,10) / 11.6334267d0,0.480727285d0, $ 0.102399997d0, 4.326356202d-02,2.818202600d-02/ data (xnrg(40, 1,i),i=6,11) / 383.661713d0, 77.9909134d0, $ 35.9952011d0, 23.3967628d0, 18.8834229d0, 18.0155983 / data (xnrg(40, 2,i),i=6,11) / 53.9670830d0, 10.9704514d0, $ 5.06320000d0, 3.29106331d0, 2.65620255d0, 2.53413153 / data (xnrg(40, 3,i),i=6,11) / 49.1728020d0, 9.99586868d0, $ 4.61339998d0, 2.99869490d0, 2.42023325d0, 2.30900669 / data (xnrg(40, 4,i),i=6,11) / 47.3736153d0, 9.63012886d0, $ 4.44460011d0, 2.88897538d0, 2.33167934d0, 2.22452235 / data (xnrg(40, 5,i),i=6,10) / 195.541550d0, 8.08034992d0, $ 1.72119999d0, 0.727199614d0,0.473700225 / data (xnrg(40, 6,i),i=6,10) / 156.415070d0, 6.46352863d0, $ 1.37679994d0, 0.581692100d0,0.378916144 / data (xnrg(40, 7,i),i=6,10) / 150.189362d0, 6.20626450d0, $ 1.32200003d0, 0.558539391d0,0.363834351 / data (xnrg(40, 8,i),i=6,10) / 82.8881683d0, 3.42518210d0, $ 0.729600012d0, 0.308252901d0,0.200796947 / data (xnrg(40, 9,i),i=6,10) / 81.7975388d0, 3.38011384d0, $ 0.720000029d0, 0.304196924d0,0.198154882 / data (xnrg(40,10,i),i=6,10) / 23.3122978d0,0.963332415d0, $ 0.205200002d0, 8.669612557d-02,5.647413805d-02/ data (xnrg(40,11,i),i=6,10) / 13.0421619d0,0.538940370d0, $ 0.114799999d0, 4.850250855d-02,3.159469366d-02/ data (xnrg(40,12,i),i=6,10) / 13.0421619d0,0.538940370d0, $ 0.114799999d0, 4.850250855d-02,3.159469366d-02/ data (xnrg(40,13,i),i=6,10) / 1.82837915d0,7.555398345d-02, $ 1.609379798d-02, 6.799560972d-03,4.429256078d-03/ data (xnrg(41, 1,i),i=6,11) / 404.723267d0, 82.2723160d0, $ 37.9711990d0, 24.6811543d0, 19.9200497d0, 19.0045853 / data (xnrg(41, 2,i),i=6,11) / 57.5079002d0, 11.6902304d0, $ 5.39540005d0, 3.50699234d0, 2.83047795d0, 2.70039773 / data (xnrg(41, 3,i),i=6,11) / 52.5409508d0, 10.6805468d0, $ 4.92939997d0, 3.20409369d0, 2.58600998d0, 2.46716475 / data (xnrg(41, 4,i),i=6,11) / 50.5328522d0, 10.2723398d0, $ 4.74100018d0, 3.08163452d0, 2.48717356d0, 2.37287045 / data (xnrg(41, 5,i),i=6,10) / 212.855362d0, 8.79580784d0, $ 1.87360001d0, 0.791588008d0,0.515643001 / data (xnrg(41, 6,i),i=6,10) / 171.956589d0, 7.10575056d0, $ 1.51359999d0, 0.639489532d0,0.416565567 / data (xnrg(41, 7,i),i=6,10) / 164.958359d0, 6.81656265d0, $ 1.45200002d0, 0.613463819d0,0.399612308 / data (xnrg(41, 8,i),i=6,10) / 94.2489319d0, 3.89464211d0, $ 0.829599977d0, 0.350502461d0,0.228318438 / data (xnrg(41, 9,i),i=6,10) / 92.9765320d0, 3.84206271d0, $ 0.818399966d0, 0.345770508d0,0.225236028 / data (xnrg(41,10,i),i=6,10) / 26.4024258d0, 1.09102559d0, $ 0.232400000d0, 9.818800539d-02,6.395998597d-02/ data (xnrg(41,11,i),i=6,10) / 15.4052029d0,0.636588097d0, $ 0.135600001d0, 5.729041994d-02,3.731916845d-02/ data (xnrg(41,12,i),i=6,10) / 15.4052029d0,0.636588097d0, $ 0.135600001d0, 5.729041994d-02,3.731916845d-02/ data (xnrg(41,13,i),i=6,10) / 1.45417833d0,6.009091064d-02, $ 1.279999968d-02, 5.407945253d-03,3.522753250d-03/ data (xnrg(42, 1,i),i=6,11) / 426.336975d0, 86.6659546d0, $ 39.9990005d0, 25.9992180d0, 20.9838543d0, 20.0194988 / data (xnrg(42, 2,i),i=6,11) / 61.0849571d0, 12.4173756d0, $ 5.73099995d0, 3.72513127d0, 3.00653696d0, 2.86836553 / data (xnrg(42, 3,i),i=6,11) / 55.9602585d0, 11.3756247d0, $ 5.25020027d0, 3.41261292d0, 2.75430465d0, 2.62772512 / data (xnrg(42, 4,i),i=6,11) / 53.7240639d0, 10.9210510d0, $ 5.04040003d0, 3.27624345d0, 2.64424157d0, 2.52272010 / data (xnrg(42, 5,i),i=6,10) / 229.305756d0, 9.47558594d0, $ 2.01839995d0, 0.852765381d0,0.555494130 / data (xnrg(42, 6,i),i=6,10) / 186.180283d0, 7.69351435d0, $ 1.63880002d0, 0.692385972d0,0.451022506 / data (xnrg(42, 7,i),i=6,10) / 178.273178d0, 7.36677027d0, $ 1.56920004d0, 0.662980318d0,0.431867540 / data (xnrg(42, 8,i),i=6,10) / 104.655403d0, 4.32466793d0, $ 0.921200037d0, 0.389203072d0,0.253528148 / data (xnrg(42, 9,i),i=6,10) / 103.155777d0, 4.26269913d0, $ 0.907999992d0, 0.383626133d0,0.249895304 / data (xnrg(42,10,i),i=6,10) / 28.0838203d0, 1.16050577d0, $ 0.247199997d0, 0.104440942d0,6.803317368d-02/ data (xnrg(42,11,i),i=6,10) / 15.8141899d0,0.653488696d0, $ 0.139200002d0, 5.881140754d-02,3.830994293d-02/ data (xnrg(42,12,i),i=6,10) / 15.8141899d0,0.653488696d0, $ 0.139200002d0, 5.881140754d-02,3.830994293d-02/ data (xnrg(42,13,i),i=6,10) / 0.817975342d0,3.380113840d-02, $ 7.200000342d-03, 3.041969379d-03,1.981548732d-03/ data (xnrg(42,14,i),i=6,10) / 0.817975342d0,3.380113840d-02, $ 7.200000342d-03, 3.041969379d-03,1.981548732d-03/ data (xnrg(43, 1,i),i=6,11) / 448.602966d0, 91.1921997d0, $ 42.0879974d0, 27.3570614d0, 22.0797634d0, 21.0650425 / data (xnrg(43, 2,i),i=6,11) / 64.8581314d0, 13.1843891d0, $ 6.08500004d0, 3.95523000d0, 3.19224858d0, 3.04554248 / data (xnrg(43, 3,i),i=6,11) / 59.5437088d0, 12.1040707d0, $ 5.58640003d0, 3.63114166d0, 2.93067837d0, 2.79599309 / data (xnrg(43, 4,i),i=6,11) / 57.0644989d0, 11.6000948d0, $ 5.35379982d0, 3.47995234d0, 2.80865407d0, 2.67957687 / data (xnrg(43, 5,i),i=6,10) / 248.846268d0, 10.2830572d0, $ 2.19039989d0, 0.925434649d0,0.602831125 / data (xnrg(43, 6,i),i=6,10) / 202.176239d0, 8.35451412d0, $ 1.77960002d0, 0.751873374d0,0.489772767 / data (xnrg(43, 7,i),i=6,10) / 193.133072d0, 7.98082447d0, $ 1.70000005d0, 0.718242764d0,0.467865676 / data (xnrg(43, 8,i),i=6,10) / 116.516045d0, 4.81478453d0, $ 1.02559996d0, 0.433311641d0,0.282260597 / data (xnrg(43, 9,i),i=6,10) / 114.925537d0, 4.74906015d0, $ 1.01160002d0, 0.427396685d0,0.278407604 / data (xnrg(43,10,i),i=6,10) / 31.0830631d0, 1.28444326d0, $ 0.273600012d0, 0.115594834d0,7.529885322d-02/ data (xnrg(43,11,i),i=6,10) / 17.6773567d0,0.730480134d0, $ 0.155599996d0, 6.574033201d-02,4.282346740d-02/ data (xnrg(43,12,i),i=6,10) / 17.6773567d0,0.730480134d0, $ 0.155599996d0, 6.574033201d-02,4.282346740d-02/ data (xnrg(43,13,i),i=6,10) / 3.18627834d0,0.131666362d0, $ 2.804632671d-02, 1.184945367d-02,7.718772627d-03/ data (xnrg(43,14,i),i=6,10) / 3.05805564d0,0.126367822d0, $ 2.691768296d-02, 1.137260627d-02,7.408152800d-03/ data (xnrg(44, 1,i),i=6,11) / 471.480804d0, 95.8428116d0, $ 44.2344017d0, 28.7522144d0, 23.2057858d0, 22.1393166 / data (xnrg(44, 2,i),i=6,11) / 68.7272339d0, 13.9709015d0, $ 6.44799995d0, 4.19117880d0, 3.38268185d0, 3.22722387 / data (xnrg(44, 3,i),i=6,11) / 63.2465363d0, 12.8567829d0, $ 5.93379974d0, 3.85695052d0, 3.11292768d0, 2.96986675 / data (xnrg(44, 4,i),i=6,11) / 60.4965973d0, 12.2977743d0, $ 5.67580032d0, 3.68925142d0, 2.97757840d0, 2.84073806 / data (xnrg(44, 5,i),i=6,10) / 265.841980d0, 10.9853697d0, $ 2.33999991d0, 0.988640010d0,0.644003332 / data (xnrg(44, 6,i),i=6,10) / 219.399170d0, 9.06621647d0, $ 1.93120003d0, 0.815923750d0,0.531495392 / data (xnrg(44, 7,i),i=6,10) / 209.310806d0, 8.64933586d0, $ 1.84240007d0, 0.778406143d0,0.507056296 / data (xnrg(44, 8,i),i=6,10) / 128.876556d0, 5.32555723d0, $ 1.13440001d0, 0.479279160d0,0.312204003 / data (xnrg(44, 9,i),i=6,10) / 126.967949d0, 5.24668789d0, $ 1.11759996d0, 0.472181231d0,0.307580382 / data (xnrg(44,10,i),i=6,10) / 34.0368614d0, 1.40650296d0, $ 0.299600005d0, 0.126579717d0,8.245444298d-02/ data (xnrg(44,11,i),i=6,10) / 19.5859642d0,0.809349477d0, $ 0.172399998d0, 7.283826172d-02,4.744708166d-02/ data (xnrg(44,12,i),i=6,10) / 19.5859642d0,0.809349477d0, $ 0.172399998d0, 7.283826172d-02,4.744708166d-02/ data (xnrg(44,13,i),i=6,10) / 0.908861518d0,3.755681962d-02, $ 8.000000380d-03, 3.379965900d-03,2.201720839d-03/ data (xnrg(44,14,i),i=6,10) / 0.908861518d0,3.755681962d-02, $ 8.000000380d-03, 3.379965900d-03,2.201720839d-03/ data (xnrg(45, 1,i),i=6,11) / 494.987457d0, 100.621262d0, $ 46.4398003d0, 30.1857166d0, 24.3627586d0, 23.2431202 / data (xnrg(45, 2,i),i=6,11) / 72.7327728d0, 14.7851486d0, $ 6.82380009d0, 4.43544769d0, 3.57983017d0, 3.41531181 / data (xnrg(45, 3,i),i=6,11) / 67.0666122d0, 13.6333294d0, $ 6.29220009d0, 4.08990955d0, 3.30094767d0, 3.14924622 / data (xnrg(45, 4,i),i=6,11) / 64.0331497d0, 13.0166855d0, $ 6.00759983d0, 3.90492010d0, 3.15164375d0, 3.00680375 / data (xnrg(45, 5,i),i=6,10) / 284.973511d0, 11.7759409d0, $ 2.50839996d0, 1.05978823d0,0.690349519 / data (xnrg(45, 6,i),i=6,10) / 236.758423d0, 9.78355122d0, $ 2.08400011d0, 0.880481124d0,0.573548257 / data (xnrg(45, 7,i),i=6,10) / 225.488541d0, 9.31784725d0, $ 1.98479998d0, 0.838569522d0,0.546246946 / data (xnrg(45, 8,i),i=6,10) / 141.646072d0, 5.85323048d0, $ 1.24680007d0, 0.526767671d0,0.343138188 / data (xnrg(45, 9,i),i=6,10) / 139.510239d0, 5.76497173d0, $ 1.22799993d0, 0.518824756d0,0.337964118 / data (xnrg(45,10,i),i=6,10) / 36.8088913d0, 1.52105117d0, $ 0.324000001d0, 0.136888623d0,8.916968852d-02/ data (xnrg(45,11,i),i=6,10) / 21.7672329d0,0.899485826d0, $ 0.191599995d0, 8.095017821d-02,5.273121223d-02/ data (xnrg(45,12,i),i=6,10) / 21.7672329d0,0.899485826d0, $ 0.191599995d0, 8.095017821d-02,5.273121223d-02/ data (xnrg(45,13,i),i=6,10) / 1.13607681d0,4.694602638d-02, $ 9.999999776d-03, 4.224957433d-03,2.752150875d-03/ data (xnrg(45,14,i),i=6,10) / 1.13607681d0,4.694602638d-02, $ 9.999999776d-03, 4.224957433d-03,2.752150875d-03/ data (xnrg(46, 1,i),i=6,11) / 519.084656d0, 105.519745d0, $ 48.7005997d0, 31.6552315d0, 25.5487976d0, 24.3746510 / data (xnrg(46, 2,i),i=6,11) / 76.8342361d0, 15.6188955d0, $ 7.20860004d0, 4.68556643d0, 3.78169966d0, 3.60790420 / data (xnrg(46, 3,i),i=6,11) / 70.9932785d0, 14.4315434d0, $ 6.66060019d0, 4.32936811d0, 3.49421382d0, 3.33363032 / data (xnrg(46, 4,i),i=6,11) / 67.6464462d0, 13.7511978d0, $ 6.34660006d0, 4.12526894d0, 3.32948637d0, 3.17647314 / data (xnrg(46, 5,i),i=6,10) / 304.423157d0, 12.5796566d0, $ 2.67960000d0, 1.13211954d0,0.737466395 / data (xnrg(46, 6,i),i=6,10) / 254.072235d0, 10.4990091d0, $ 2.23639989d0, 0.944869459d0,0.615491033 / data (xnrg(46, 7,i),i=6,10) / 241.529938d0, 9.98072529d0, $ 2.12599993d0, 0.898225904d0,0.585107327 / data (xnrg(46, 8,i),i=6,10) / 154.506454d0, 6.38465929d0, $ 1.36000001d0, 0.574594200d0,0.374292523 / data (xnrg(46, 9,i),i=6,10) / 152.097977d0, 6.28513384d0, $ 1.33879995d0, 0.565637290d0,0.368457973 / data (xnrg(46,10,i),i=6,10) / 39.2628174d0, 1.62245464d0, $ 0.345600009d0, 0.146014526d0,9.511433542d-02/ data (xnrg(46,11,i),i=6,10) / 23.2214108d0,0.959576786d0, $ 0.204400003d0, 8.635812998d-02,5.625396594d-02/ data (xnrg(46,12,i),i=6,10) / 23.2214108d0,0.959576786d0, $ 0.204400003d0, 8.635812998d-02,5.625396594d-02/ data (xnrg(46,13,i),i=6,10) / 2.47511697d0,0.102279089d0, $ 2.178652771d-02, 9.204714559d-03,5.995981395d-03/ data (xnrg(46,14,i),i=6,10) / 2.28052115d0,9.423781186d-02, $ 2.007365227d-02, 8.481032215d-03,5.524571985d-03/ data (xnrg(47, 1,i),i=6,11) / 543.891663d0, 110.562531d0, $ 51.0279999d0, 33.1680336d0, 26.7697716d0, 25.5395145 / data (xnrg(47, 2,i),i=6,11) / 81.1296921d0, 16.4920769d0, $ 7.61159992d0, 4.94751501d0, 3.99311733d0, 3.80960584 / data (xnrg(47, 3,i),i=6,11) / 75.1160583d0, 15.2696238d0, $ 7.04740000d0, 4.58078671d0, 3.69713283d0, 3.52722383 / data (xnrg(47, 4,i),i=6,11) / 71.4366760d0, 14.5216780d0, $ 6.70219994d0, 4.35640812d0, 3.51603746d0, 3.35445118 / data (xnrg(47, 5,i),i=6,10) / 326.054047d0, 13.4735088d0, $ 2.86999989d0, 1.21256280d0,0.789867342 / data (xnrg(47, 6,i),i=6,10) / 273.749084d0, 11.3121147d0, $ 2.40960002d0, 1.01804566d0,0.663158298 / data (xnrg(47, 7,i),i=6,10) / 259.661743d0, 10.7299833d0, $ 2.28559995d0, 0.965656221d0,0.629031599 / data (xnrg(47, 8,i),i=6,10) / 169.411789d0, 7.00059128d0, $ 1.49119997d0, 0.630025625d0,0.410400748 / data (xnrg(47, 9,i),i=6,10) / 166.639755d0, 6.88604307d0, $ 1.46679997d0, 0.619716763d0,0.403685510 / data (xnrg(47,10,i),i=6,10) / 43.2618065d0, 1.78770459d0, $ 0.380800009d0, 0.160886377d0,0.104801908 / data (xnrg(47,11,i),i=6,10) / 28.4473648d0, 1.17552853d0, $ 0.250400007d0, 0.105792932d0,6.891386211d-02/ data (xnrg(47,12,i),i=6,10) / 25.4026775d0, 1.04971313d0, $ 0.223600000d0, 9.447004646d-02,6.153809652d-02/ data (xnrg(47,13,i),i=6,10) / 1.49962151d0,6.196875498d-02, $ 1.319999993d-02, 5.576943979d-03,3.632839303d-03/ data (xnrg(47,14,i),i=6,10) / 1.49962151d0,6.196875498d-02, $ 1.319999993d-02, 5.576943979d-03,3.632839303d-03/ data (xnrg(48, 1,i),i=6,11) / 569.412842d0, 115.750481d0, $ 53.4224014d0, 34.7243843d0, 28.0258961d0, 26.7379112 / data (xnrg(48, 2,i),i=6,11) / 85.6532364d0, 17.4116268d0, $ 8.03600025d0, 5.22337341d0, 4.21576166d0, 4.02201796 / data (xnrg(48, 3,i),i=6,11) / 79.4498825d0, 16.1506042d0, $ 7.45400000d0, 4.84507561d0, 3.91043901d0, 3.73072696 / data (xnrg(48, 4,i),i=6,11) / 75.4102325d0, 15.3294249d0, $ 7.07499981d0, 4.59872675d0, 3.71161199d0, 3.54103732 / data (xnrg(48, 5,i),i=6,10) / 350.002563d0, 14.4631319d0, $ 3.08080006d0, 1.30162489d0,0.847882688 / data (xnrg(48, 6,i),i=6,10) / 295.698090d0, 12.2191114d0, $ 2.60279989d0, 1.09967184d0,0.716329873 / data (xnrg(48, 7,i),i=6,10) / 280.156555d0, 11.5768900d0, $ 2.46600008d0, 1.04187453d0,0.678680420 / data (xnrg(48, 8,i),i=6,10) / 186.543823d0, 7.70853758d0, $ 1.64199996d0, 0.693737984d0,0.451903194 / data (xnrg(48, 9,i),i=6,10) / 183.453690d0, 7.58084393d0, $ 1.61479998d0, 0.682246089d0,0.444417328 / data (xnrg(48,10,i),i=6,10) / 48.8967476d0, 2.02055693d0, $ 0.430399984d0, 0.181842163d0,0.118452579 / data (xnrg(48,11,i),i=6,10) / 30.4014168d0, 1.25627565d0, $ 0.267600000d0, 0.113059856d0,7.364755869d-02/ data (xnrg(48,12,i),i=6,10) / 30.4014168d0, 1.25627565d0, $ 0.267600000d0, 0.113059856d0,7.364755869d-02/ data (xnrg(48,13,i),i=6,10) / 4.22620583d0,0.174639210d0, $ 3.720000014d-02, 1.571684144d-02,1.023800205d-02/ data (xnrg(48,14,i),i=6,10) / 4.22620583d0,0.174639210d0, $ 3.720000014d-02, 1.571684144d-02,1.023800205d-02/ data (xnrg(49, 1,i),i=6,11) / 595.605469d0, 121.074936d0, $ 55.8797989d0, 36.3216858d0, 29.3150711d0, 27.9678402 / data (xnrg(49, 2,i),i=6,11) / 90.3324051d0, 18.3628082d0, $ 8.47500038d0, 5.50872231d0, 4.44606543d0, 4.24173737 / data (xnrg(49, 3,i),i=6,11) / 83.9478455d0, 17.0649548d0, $ 7.87599993d0, 5.11937428d0, 4.13182449d0, 3.94193816 / data (xnrg(49, 4,i),i=6,11) / 79.5159683d0, 16.1640396d0, $ 7.46019983d0, 4.84910536d0, 3.91369152d0, 3.73383021 / data (xnrg(49, 5,i),i=6,10) / 375.178009d0, 15.5034552d0, $ 3.30239987d0, 1.39524984d0,0.908870339 / data (xnrg(49, 6,i),i=6,10) / 319.101257d0, 13.1862001d0, $ 2.80879998d0, 1.18670607d0,0.773024142 / data (xnrg(49, 7,i),i=6,10) / 301.878357d0, 12.4744978d0, $ 2.65720010d0, 1.12265563d0,0.731301546 / data (xnrg(49, 8,i),i=6,10) / 204.857376d0, 8.46530724d0, $ 1.80320001d0, 0.761844337d0,0.496267855 / data (xnrg(49, 9,i),i=6,10) / 201.358261d0, 8.32071304d0, $ 1.77240002d0, 0.748831451d0,0.487791240 / data (xnrg(49,10,i),i=6,10) / 55.3951073d0, 2.28908825d0, $ 0.487599999d0, 0.206008926d0,0.134194881 / data (xnrg(49,11,i),i=6,10) / 35.1729393d0, 1.45344889d0, $ 0.309599996d0, 0.130804673d0,8.520659059d-02/ data (xnrg(49,12,i),i=6,10) / 35.1729393d0, 1.45344889d0, $ 0.309599996d0, 0.130804673d0,8.520659059d-02/ data (xnrg(49,13,i),i=6,10) / 7.36177778d0,0.304210246d0, $ 6.480000168d-02, 2.737772278d-02,1.783393882d-02/ data (xnrg(49,14,i),i=6,10) / 7.36177778d0,0.304210246d0, $ 6.480000168d-02, 2.737772278d-02,1.783393882d-02/ data (xnrg(50, 1,i),i=6,11) / 622.469666d0, 126.535896d0, $ 58.4001999d0, 37.9599380d0, 30.6372986d0, 29.2293015 / data (xnrg(50, 2,i),i=6,11) / 95.1757126d0, 19.3473587d0, $ 8.92940044d0, 5.80408049d0, 4.68444777d0, 4.46916485 / data (xnrg(50, 3,i),i=6,11) / 88.5971680d0, 18.0100708d0, $ 8.31220055d0, 5.40290260d0, 4.36065912d0, 4.16025639 / data (xnrg(50, 4,i),i=6,11) / 83.7517242d0, 17.0250874d0, $ 7.85760021d0, 5.10741425d0, 4.12217140d0, 3.93272877 / data (xnrg(50, 5,i),i=6,10) / 401.625885d0, 16.5963593d0, $ 3.53520012d0, 1.49360693d0,0.972940385 / data (xnrg(50, 6,i),i=6,10) / 343.731415d0, 14.2039890d0, $ 3.02559996d0, 1.27830303d0,0.832690775 / data (xnrg(50, 7,i),i=6,10) / 324.645325d0, 13.4152966d0, $ 2.85759997d0, 1.20732379d0,0.786454678 / data (xnrg(50, 8,i),i=6,10) / 224.170685d0, 9.26338959d0, $ 1.97319996d0, 0.833668590d0,0.543054461 / data (xnrg(50, 9,i),i=6,10) / 220.308029d0, 9.10377312d0, $ 1.93920004d0, 0.819303751d0,0.533697128 / data (xnrg(50,10,i),i=6,10) / 62.0297966d0, 2.56325293d0, $ 0.546000004d0, 0.230682671d0,0.150267437 / data (xnrg(50,11,i),i=6,10) / 40.2625656d0, 1.66376710d0, $ 0.354400009d0, 0.149732485d0,9.753622860d-02/ data (xnrg(50,12,i),i=6,10) / 40.2625656d0, 1.66376710d0, $ 0.354400009d0, 0.149732485d0,9.753622860d-02/ data (xnrg(50,13,i),i=6,10) / 10.8608942d0,0.448803991d0, $ 9.559999406d-02, 4.039059207d-02,2.631056309d-02/ data (xnrg(50,14,i),i=6,10) / 10.8608942d0,0.448803991d0, $ 9.559999406d-02, 4.039059207d-02,2.631056309d-02/ data (xnrg(51, 1,i),i=6,11) / 649.992554d0, 132.130753d0, $ 60.9823990d0, 39.6383591d0, 31.9919453d0, 30.5216904 / data (xnrg(51, 2,i),i=6,11) / 100.155449d0, 20.3596420d0, $ 9.39659977d0, 6.10775900d0, 4.92954540d0, 4.70299816 / data (xnrg(51, 3,i),i=6,11) / 93.3786545d0, 18.9820538d0, $ 8.76080036d0, 5.69449139d0, 4.59599876d0, 4.38478041 / data (xnrg(51, 4,i),i=6,11) / 88.0876846d0, 17.9065018d0, $ 8.26440048d0, 5.37183285d0, 4.33558273d0, 4.13633204 / data (xnrg(51, 5,i),i=6,10) / 428.846283d0, 17.7211857d0, $ 3.77480006d0, 1.59483683d0, 1.03888190 / data (xnrg(51, 6,i),i=6,10) / 368.952332d0, 15.2461910d0, $ 3.24760008d0, 1.37209713d0,0.893788576 / data (xnrg(51, 7,i),i=6,10) / 347.912170d0, 14.3767509d0, $ 3.06239986d0, 1.29385090d0,0.842818737 / data (xnrg(51, 8,i),i=6,10) / 243.983871d0, 10.0821285d0, $ 2.14759994d0, 0.907351851d0,0.591051936 / data (xnrg(51, 9,i),i=6,10) / 239.712219d0, 9.90561104d0, $ 2.10999990d0, 0.891465962d0,0.580703855 / data (xnrg(51,10,i),i=6,10) / 69.0734787d0, 2.85431838d0, $ 0.608000040d0, 0.256877422d0,0.167330787 / data (xnrg(51,11,i),i=6,10) / 44.7159843d0, 1.84779561d0, $ 0.393600017d0, 0.166294321d0,0.108324662 / data (xnrg(51,12,i),i=6,10) / 44.7159843d0, 1.84779561d0, $ 0.393600017d0, 0.166294321d0,0.108324662 / data (xnrg(51,13,i),i=6,10) / 14.2691259d0,0.589642107d0, $ 0.125599995d0, 5.306546390d-02,3.456701711d-02/ data (xnrg(51,14,i),i=6,10) / 14.2691259d0,0.589642107d0, $ 0.125599995d0, 5.306546390d-02,3.456701711d-02/ data (xnrg(52, 1,i),i=6,11) / 678.186890d0, 137.862122d0, $ 63.6275978d0, 41.3577309d0, 33.3796425d0, 31.8456135 / data (xnrg(52, 2,i),i=6,11) / 105.290810d0, 21.4035606d0, $ 9.87839985d0, 6.42092752d0, 5.18230247d0, 4.94413948 / data (xnrg(52, 3,i),i=6,11) / 98.3157654d0, 19.9856701d0, $ 9.22399998d0, 5.99556971d0, 4.83899784d0, 4.61661196 / data (xnrg(52, 4,i),i=6,11) / 92.5472794d0, 18.8130493d0, $ 8.68280029d0, 5.64379168d0, 4.55507898d0, 4.34574127 / data (xnrg(52, 5,i),i=6,11) / 21.4452858d0, 4.35940695d0, $ 2.01200008d0, 1.30779338d0, 1.05551422d0, 1.00700605 / data (xnrg(52, 6,i),i=6,10) / 395.218414d0, 16.3315830d0, $ 3.47880006d0, 1.46977818d0,0.957418263 / data (xnrg(52, 7,i),i=6,10) / 372.042450d0, 15.3738842d0, $ 3.27480006d0, 1.38358903d0,0.901274383 / data (xnrg(52, 8,i),i=6,10) / 264.705902d0, 10.9384241d0, $ 2.32999992d0, 0.984415054d0,0.641251206 / data (xnrg(52, 9,i),i=6,10) / 259.979828d0, 10.7431288d0, $ 2.28839993d0, 0.966839254d0,0.629802227 / data (xnrg(52,10,i),i=6,10) / 76.4806976d0, 3.16040635d0, $ 0.673200011d0, 0.284424126d0,0.185274810 / data (xnrg(52,11,i),i=6,10) / 50.0782700d0, 2.06938076d0, $ 0.440800011d0, 0.186236113d0,0.121314816 / data (xnrg(52,12,i),i=6,10) / 50.0782700d0, 2.06938076d0, $ 0.440800011d0, 0.186236113d0,0.121314816 / data (xnrg(52,13,i),i=6,10) / 18.0863438d0,0.747380733d0, $ 0.159199998d0, 6.726132333d-02,4.381424561d-02/ data (xnrg(52,14,i),i=6,10) / 18.0863438d0,0.747380733d0, $ 0.159199998d0, 6.726132333d-02,4.381424561d-02/ data (xnrg(53, 1,i),i=6,11) / 707.084778d0, 143.736481d0, $ 66.3387985d0, 43.1200027d0, 34.8019638d0, 33.2025681 / data (xnrg(53, 2,i),i=6,11) / 110.596710d0, 22.4821453d0, $ 10.3761997d0, 6.74449587d0, 5.44345284d0, 5.19328833 / data (xnrg(53, 3,i),i=6,11) / 103.434067d0, 21.0261211d0, $ 9.70419979d0, 6.30769825d0, 5.09091520d0, 4.85695219 / data (xnrg(53, 4,i),i=6,11) / 97.1454391d0, 19.7477665d0, $ 9.11419964d0, 5.92420006d0, 4.78139591d0, 4.56165695 / data (xnrg(53, 5,i),i=6,11) / 22.8543644d0, 4.64584494d0, $ 2.14420009d0, 1.39372301d0, 1.12486768d0, 1.07317209 / data (xnrg(53, 6,i),i=6,10) / 422.847809d0, 17.4733105d0, $ 3.72200012d0, 1.57252908d0, 1.02435064 / data (xnrg(53, 7,i),i=6,10) / 397.445129d0, 16.4235973d0, $ 3.49839997d0, 1.47805905d0,0.962812483 / data (xnrg(53, 8,i),i=6,10) / 286.882141d0, 11.8548098d0, $ 2.52519989d0, 1.06688619d0,0.694973171 / data (xnrg(53, 9,i),i=6,10) / 281.474396d0, 11.6313477d0, $ 2.47760010d0, 1.04677546d0,0.681872904 / data (xnrg(53,10,i),i=6,10) / 84.7058945d0, 3.50029564d0, $ 0.745599985d0, 0.315012813d0,0.205200374 / data (xnrg(53,11,i),i=6,10) / 55.7586517d0, 2.30411100d0, $ 0.490799993d0, 0.207360908d0,0.135075569 / data (xnrg(53,12,i),i=6,10) / 55.7586517d0, 2.30411100d0, $ 0.490799993d0, 0.207360908d0,0.135075569 / data (xnrg(53,13,i),i=6,10) / 22.5397644d0,0.931409121d0, $ 0.198400006d0, 8.382315189d-02,5.460267514d-02/ data (xnrg(53,14,i),i=6,10) / 22.5397644d0,0.931409121d0, $ 0.198400006d0, 8.382315189d-02,5.460267514d-02/ data (xnrg(54, 1,i),i=6,11) / 736.758545d0, 149.768585d0, $ 69.1228027d0, 44.9295921d0, 36.2624741d0, 34.5959625 / data (xnrg(54, 2,i),i=6,11) / 116.239418d0, 23.6291981d0, $ 10.9055996d0, 7.08860397d0, 5.72118092d0, 5.45825291 / data (xnrg(54, 3,i),i=6,11) / 108.797523d0, 22.1164055d0, $ 10.2074003d0, 6.63477659d0, 5.35489893d0, 5.10880375 / data (xnrg(54, 4,i),i=6,11) / 101.943985d0, 20.7232151d0, $ 9.56439972d0, 6.21682882d0, 5.01757479d0, 4.78698206 / data (xnrg(54, 5,i),i=6,11) / 24.3998737d0, 4.96001673d0, $ 2.28920007d0, 1.48797250d0, 1.20093596d0, 1.14574456 / data (xnrg(54, 6,i),i=6,10) / 453.976318d0, 18.7596321d0, $ 3.99600005d0, 1.68829298d0, 1.09975958 / data (xnrg(54, 7,i),i=6,10) / 425.801605d0, 17.5953712d0, $ 3.74799991d0, 1.58351398d0, 1.03150618 / data (xnrg(54, 8,i),i=6,10) / 311.466827d0, 12.8707218d0, $ 2.74160004d0, 1.15831435d0,0.754529715 / data (xnrg(54, 9,i),i=6,10) / 305.513794d0, 12.6247253d0, $ 2.68919992d0, 1.13617551d0,0.740108430 / data (xnrg(54,10,i),i=6,10) / 94.5670395d0, 3.90778708d0, $ 0.832399964d0, 0.351685435d0,0.229089037 / data (xnrg(54,11,i),i=6,10) / 66.6649857d0, 2.75479269d0, $ 0.586799979d0, 0.247920483d0,0.161496207 / data (xnrg(54,12,i),i=6,10) / 66.6649857d0, 2.75479269d0, $ 0.586799979d0, 0.247920483d0,0.161496207 / data (xnrg(54,13,i),i=6,10) / 29.0835686d0, 1.20181823d0, $ 0.256000012d0, 0.108158909d0,7.045506686d-02/ data (xnrg(54,14,i),i=6,10) / 29.0835686d0, 1.20181823d0, $ 0.256000012d0, 0.108158909d0,7.045506686d-02/ data (xnrg(55, 1,i),i=6,11) / 767.097412d0, 155.935883d0, $ 71.9692001d0, 46.7797432d0, 37.7557220d0, 36.0205841 / data (xnrg(55, 2,i),i=6,11) / 121.813911d0, 24.7623844d0, $ 11.4286003d0, 7.42855263d0, 5.99555159d0, 5.72001410 / data (xnrg(55, 3,i),i=6,11) / 114.248375d0, 23.2244568d0, $ 10.7187996d0, 6.96718454d0, 5.62318373d0, 5.36475945 / data (xnrg(55, 4,i),i=6,11) / 106.840584d0, 21.7185993d0, $ 10.0237999d0, 6.51543713d0, 5.25858068d0, 5.01691198 / data (xnrg(55, 5,i),i=6,11) / 25.9453850d0, 5.27418900d0, $ 2.43420005d0, 1.58222198d0, 1.27700436d0, 1.21831715 / data (xnrg(55, 6,i),i=6,11) / 22.7030106d0, 4.61507750d0, $ 2.12999988d0, 1.38449299d0, 1.11741817d0, 1.06606495 / data (xnrg(55, 7,i),i=6,10) / 453.340118d0, 18.7333412d0, $ 3.99040008d0, 1.68592691d0, 1.09821832 / data (xnrg(55, 8,i),i=6,10) / 336.051544d0, 13.8866339d0, $ 2.95799994d0, 1.24974239d0,0.814086258 / data (xnrg(55, 9,i),i=6,10) / 329.689514d0, 13.6237364d0, $ 2.90199995d0, 1.22608256d0,0.798674226 / data (xnrg(55,10,i),i=6,10) / 104.882614d0, 4.33405685d0, $ 0.923200011d0, 0.390048057d0,0.254078567 / data (xnrg(55,11,i),i=6,10) / 78.2984161d0, 3.23551989d0, $ 0.689199984d0, 0.291184038d0,0.189678237 / data (xnrg(55,12,i),i=6,10) / 73.4360123d0, 3.03459120d0, $ 0.646400034d0, 0.273101240d0,0.177899033 / data (xnrg(55,13,i),i=6,10) / 35.8091431d0, 1.47973871d0, $ 0.315200001d0, 0.133170649d0,8.674779534d-02/ data (xnrg(55,14,i),i=6,10) / 34.7639503d0, 1.43654835d0, $ 0.305999994d0, 0.129283696d0,8.421581984d-02/ data (xnrg(55,15,i),i=6,10) / 10.3155775d0,0.426269919d0, $ 9.080000222d-02, 3.836261109d-02,2.498953044d-02/ data (xnrg(55,16,i),i=6,10) / 5.95304298d0,0.245997176d0, $ 5.240000039d-02, 2.213877626d-02,1.442127116d-02/ data (xnrg(55,17,i),i=6,10) / 5.18051052d0,0.214073882d0, $ 4.560000077d-02, 1.926580630d-02,1.254980825d-02/ data (xnrg(56, 1,i),i=6,11) / 798.135559d0, 162.245331d0, $ 74.8811951d0, 48.6725349d0, 39.2833862d0, 37.4780388 / data (xnrg(56, 2,i),i=6,11) / 127.665535d0, 25.9519043d0, $ 11.9776001d0, 7.78540087d0, 6.28356218d0, 5.99478865 / data (xnrg(56, 3,i),i=6,11) / 119.880424d0, 24.3693428d0, $ 11.2472000d0, 7.31064320d0, 5.90038776d0, 5.62922382 / data (xnrg(56, 4,i),i=6,11) / 111.852303d0, 22.7373829d0, $ 10.4940004d0, 6.82106543d0, 5.50525188d0, 5.25224686 / data (xnrg(56, 5,i),i=6,11) / 27.5591106d0, 5.60222769d0, $ 2.58559990d0, 1.68063152d0, 1.35643029d0, 1.29409277 / data (xnrg(56, 6,i),i=6,11) / 24.2314682d0, 4.92578316d0, $ 2.27340007d0, 1.47770250d0, 1.19264722d0, 1.13783669 / data (xnrg(56, 7,i),i=6,11) / 22.6433220d0, 4.60294437d0, $ 2.12439990d0, 1.38085306d0, 1.11448038d0, 1.06326222 / data (xnrg(56, 8,i),i=6,10) / 361.772308d0, 14.9494925d0, $ 3.18440008d0, 1.34539545d0,0.876394928 / data (xnrg(56, 9,i),i=6,10) / 354.774078d0, 14.6603050d0, $ 3.12279987d0, 1.31936967d0,0.859441698 / data (xnrg(56,10,i),i=6,10) / 114.970978d0, 4.75093746d0, $ 1.01199996d0, 0.427565664d0,0.278517663 / data (xnrg(56,11,i),i=6,10) / 87.1598129d0, 3.60169911d0, $ 0.767199993d0, 0.324138731d0,0.211145014 / data (xnrg(56,12,i),i=6,10) / 81.6612015d0, 3.37448025d0, $ 0.718800008d0, 0.303689927d0,0.197824612 / data (xnrg(56,13,i),i=6,10) / 42.0348434d0, 1.73700297d0, $ 0.370000005d0, 0.156323418d0,0.101829588 / data (xnrg(56,14,i),i=6,10) / 40.8533249d0, 1.68817914d0, $ 0.359600008d0, 0.151929468d0,9.896735102d-02/ data (xnrg(56,15,i),i=6,10) / 17.7682419d0,0.734235823d0, $ 0.156399995d0, 6.607833505d-02,4.304363951d-02/ data (xnrg(56,16,i),i=6,10) / 7.54355049d0,0.311721623d0, $ 6.639999896d-02, 2.805371769d-02,1.827428304d-02/ data (xnrg(56,17,i),i=6,10) / 6.63468933d0,0.274164796d0, $ 5.840000138d-02, 2.467375249d-02,1.607256196d-02/ data (xnrg(57, 1,i),i=6,11) / 829.770569d0, 168.676102d0, $ 77.8491974d0, 50.6017227d0, 40.8404274d0, 38.9635239 / data (xnrg(57, 2,i),i=6,11) / 133.581100d0, 27.1544247d0, $ 12.5326004d0, 8.14614868d0, 6.57472086d0, 6.27256632 / data (xnrg(57, 3,i),i=6,11) / 125.572166d0, 25.5263634d0, $ 11.7812004d0, 7.65774155d0, 6.18052912d0, 5.89649057 / data (xnrg(57, 4,i),i=6,11) / 116.876808d0, 23.7587662d0, $ 10.9653997d0, 7.12747383d0, 5.75255251d0, 5.48818254 / data (xnrg(57, 5,i),i=6,11) / 29.0193520d0, 5.89906597d0, $ 2.72259998d0, 1.76968110d0, 1.42830181d0, 1.36266136 / data (xnrg(57, 6,i),i=6,11) / 25.6746540d0, 5.21915436d0, $ 2.40880013d0, 1.56571209d0, 1.26367927d0, 1.20560443 / data (xnrg(57, 7,i),i=6,11) / 23.9479465d0, 4.86814880d0, $ 2.24679995d0, 1.46041262d0, 1.17869258d0, 1.12452340 / data (xnrg(57, 8,i),i=6,10) / 385.584503d0, 15.9334812d0, $ 3.39400005d0, 1.43395054d0,0.934080064 / data (xnrg(57, 9,i),i=6,10) / 377.950043d0, 15.6180038d0, $ 3.32679987d0, 1.40555882d0,0.915585577 / data (xnrg(57,10,i),i=6,10) / 122.878075d0, 5.07768202d0, $ 1.08159995d0, 0.456971377d0,0.297672659 / data (xnrg(57,11,i),i=6,10) / 93.5218506d0, 3.86459684d0, $ 0.823199987d0, 0.347798496d0,0.226557061 / data (xnrg(57,12,i),i=6,10) / 86.9780426d0, 3.59418774d0, $ 0.765600026d0, 0.323462725d0,0.210704684 / data (xnrg(57,13,i),i=6,10) / 44.9431992d0, 1.85718477d0, $ 0.395599991d0, 0.167139307d0,0.108875088 / data (xnrg(57,14,i),i=6,10) / 44.9431992d0, 1.85718477d0, $ 0.395599991d0, 0.167139307d0,0.108875088 / data (xnrg(57,15,i),i=6,10) / 14.6781130d0,0.606542647d0, $ 0.129199997d0, 5.458644778d-02,3.555779159d-02/ data (xnrg(57,16,i),i=6,10) / 6.54380274d0,0.270409107d0, $ 5.759999901d-02, 2.433575504d-02,1.585238986d-02/ data (xnrg(57,17,i),i=6,10) / 6.54380274d0,0.270409107d0, $ 5.759999901d-02, 2.433575504d-02,1.585238986d-02/ data (xnrg(58, 1,i),i=6,11) / 862.138855d0, 175.255951d0, $ 80.8860016d0, 52.5756340d0, 42.4335632d0, 40.4834442 / data (xnrg(58, 2,i),i=6,11) / 139.603271d0, 28.3786106d0, $ 13.0976000d0, 8.51339722d0, 6.87112522d0, 6.55534887 / data (xnrg(58, 3,i),i=6,11) / 131.404602d0, 26.7119827d0, $ 12.3283997d0, 8.01341915d0, 6.46759558d0, 6.17036438 / data (xnrg(58, 4,i),i=6,11) / 122.007904d0, 24.8018188d0, $ 11.4468002d0, 7.44038248d0, 6.00509977d0, 5.72912359 / data (xnrg(58, 5,i),i=6,11) / 30.5819168d0, 6.21670485d0, $ 2.86919999d0, 1.86497056d0, 1.50520957d0, 1.43603468 / data (xnrg(58, 6,i),i=6,11) / 27.1327629d0, 5.51555967d0, $ 2.54559994d0, 1.65463161d0, 1.33544588d0, 1.27407277 / data (xnrg(58, 7,i),i=6,11) / 25.2696247d0, 5.13681984d0, $ 2.37080002d0, 1.54101217d0, 1.24374413d0, 1.18658543 / data (xnrg(58, 8,i),i=6,10) / 409.578430d0, 16.9249802d0, $ 3.60520005d0, 1.52318156d0,0.992205441 / data (xnrg(58, 9,i),i=6,10) / 401.398682d0, 16.5869694d0, $ 3.53320003d0, 1.49276197d0,0.972389996 / data (xnrg(58,10,i),i=6,10) / 131.603149d0, 5.43822765d0, $ 1.15839994d0, 0.489419043d0,0.318809152 / data (xnrg(58,11,i),i=6,10) / 101.474380d0, 4.19321871d0, $ 0.893199980d0, 0.377373189d0,0.245822117 / data (xnrg(58,12,i),i=6,10) / 94.1580505d0, 3.89088655d0, $ 0.828800023d0, 0.350164473d0,0.228098273 / data (xnrg(58,13,i),i=6,10) / 49.9873810d0, 2.06562519d0, $ 0.439999998d0, 0.185898125d0,0.121094644 / data (xnrg(58,14,i),i=6,10) / 49.9873810d0, 2.06562519d0, $ 0.439999998d0, 0.185898125d0,0.121094644 / data (xnrg(58,15,i),i=6,10) / 39.0356026d0, 1.61306536d0, $ 0.343600005d0, 0.145169526d0,9.456390887d-02/ data (xnrg(58,16,i),i=6,10) / 17.1774826d0,0.709823906d0, $ 0.151199996d0, 6.388135254d-02,4.161252454d-02/ data (xnrg(58,17,i),i=6,10) / 8.99772835d0,0.371812522d0, $ 7.919999957d-02, 3.346166015d-02,2.179703489d-02/ data (xnrg(58,18,i),i=6,10) / 8.99772835d0,0.371812522d0, $ 7.919999957d-02, 3.346166015d-02,2.179703489d-02/ data (xnrg(59, 1,i),i=6,11) / 895.129639d0, 181.962326d0, $ 83.9812012d0, 54.5875053d0, 44.0573349d0, 42.0325928 / data (xnrg(59, 2,i),i=6,11) / 145.700043d0, 29.6179657d0, $ 13.6696005d0, 8.88519478d0, 7.17120171d0, 6.84163475 / data (xnrg(59, 3,i),i=6,11) / 137.292465d0, 27.9088688d0, $ 12.8808002d0, 8.37247753d0, 6.75738955d0, 6.44684029 / data (xnrg(59, 4,i),i=6,11) / 127.143257d0, 25.8457355d0, $ 11.9286003d0, 7.75355101d0, 6.25785637d0, 5.97026443 / data (xnrg(59, 5,i),i=6,11) / 32.2105637d0, 6.54777670d0, $ 3.02199984d0, 1.96429002d0, 1.58536983d0, 1.51251101 / data (xnrg(59, 6,i),i=6,11) / 28.5098667d0, 5.79549742d0, $ 2.67479992d0, 1.73861122d0, 1.40322542d0, 1.33873737 / data (xnrg(59, 7,i),i=6,11) / 26.4804516d0, 5.38295746d0, $ 2.48440003d0, 1.61485183d0, 1.30333972d0, 1.24344218 / data (xnrg(59, 8,i),i=6,10) / 432.209076d0, 17.8601456d0, $ 3.80439997d0, 1.60734272d0, 1.04702830 / data (xnrg(59, 9,i),i=6,10) / 423.075012d0, 17.4827003d0, $ 3.72399998d0, 1.57337415d0, 1.02490103 / data (xnrg(59,10,i),i=6,10) / 138.374161d0, 5.71802616d0, $ 1.21800005d0, 0.514599800d0,0.335211992 / data (xnrg(59,11,i),i=6,10) / 107.381989d0, 4.43733835d0, $ 0.945200026d0, 0.399342954d0,0.260133296 / data (xnrg(59,12,i),i=6,10) / 98.8841324d0, 4.08618212d0, $ 0.870400012d0, 0.367740303d0,0.239547223 / data (xnrg(59,13,i),i=6,10) / 51.4415588d0, 2.12571597d0, $ 0.452800006d0, 0.191306069d0,0.124617398 / data (xnrg(59,14,i),i=6,10) / 51.4415588d0, 2.12571597d0, $ 0.452800006d0, 0.191306069d0,0.124617398 / data (xnrg(59,15,i),i=6,10) / 1.59050763d0,6.572443992d-02, $ 1.400000043d-02, 5.914940499d-03,3.853011411d-03/ data (xnrg(59,16,i),i=6,10) / 16.9957104d0,0.702312529d0, $ 0.149599999d0, 6.320536137d-02,4.117217660d-02/ data (xnrg(59,17,i),i=6,10) / 10.1338062d0,0.418758541d0, $ 8.919999748d-02, 3.768661991d-02,2.454918623d-02/ data (xnrg(59,18,i),i=6,10) / 10.1338062d0,0.418758541d0, $ 8.919999748d-02, 3.768661991d-02,2.454918623d-02/ data (xnrg(60, 1,i),i=6,11) / 928.774841d0, 188.801743d0, $ 87.1378021d0, 56.6392822d0, 45.7133141d0, 43.6124687 / data (xnrg(60, 2,i),i=6,11) / 151.907654d0, 30.8798542d0, $ 14.2519999d0, 9.26375294d0, 7.47673416d0, 7.13312626 / data (xnrg(60, 3,i),i=6,11) / 143.284775d0, 29.1269913d0, $ 13.4429998d0, 8.73790550d0, 7.05232525d0, 6.72822142 / data (xnrg(60, 4,i),i=6,11) / 132.336166d0, 26.9013538d0, $ 12.4158001d0, 8.07022953d0, 6.51344633d0, 6.21410799 / data (xnrg(60, 5,i),i=6,11) / 33.5812721d0, 6.82641506d0, $ 3.15060019d0, 2.04787970d0, 1.65283465d0, 1.57687533 / data (xnrg(60, 6,i),i=6,11) / 29.9040222d0, 6.07890224d0, $ 2.80559993d0, 1.82363081d0, 1.47184432d0, 1.40420282 / data (xnrg(60, 7,i),i=6,11) / 27.6571712d0, 5.62216139d0, $ 2.59480000d0, 1.68661153d0, 1.36125672d0, 1.29869735 / data (xnrg(60, 8,i),i=6,10) / 454.203522d0, 18.7690201d0, $ 3.99799991d0, 1.68913794d0, 1.10030997 / data (xnrg(60, 9,i),i=6,10) / 444.296936d0, 18.3596516d0, $ 3.91079998d0, 1.65229630d0, 1.07631123 / data (xnrg(60,10,i),i=6,10) / 143.236572d0, 5.91895485d0, $ 1.26080000d0, 0.532682598d0,0.346991181 / data (xnrg(60,11,i),i=6,10) / 110.562996d0, 4.56878710d0, $ 0.973199964d0, 0.411172837d0,0.267839313 / data (xnrg(60,12,i),i=6,10) / 102.065147d0, 4.21763086d0, $ 0.898400009d0, 0.379570156d0,0.247253239 / data (xnrg(60,13,i),i=6,10) / 53.3956108d0, 2.20646310d0, $ 0.469999999d0, 0.198572993d0,0.129351094 / data (xnrg(60,14,i),i=6,10) / 53.3956108d0, 2.20646310d0, $ 0.469999999d0, 0.198572993d0,0.129351094 / data (xnrg(60,15,i),i=6,10) / 1.36329222d0,5.633522943d-02, $ 1.200000010d-02, 5.069948733d-03,3.302581143d-03/ data (xnrg(60,16,i),i=6,10) / 17.0411530d0,0.704190373d0, $ 0.149999991d0, 6.337435544d-02,4.128226265d-02/ data (xnrg(60,17,i),i=6,10) / 9.58848858d0,0.396224469d0, $ 8.440000564d-02, 3.565864265d-02,2.322815545d-02/ data (xnrg(60,18,i),i=6,10) / 9.58848858d0,0.396224469d0, $ 8.440000564d-02, 3.565864265d-02,2.322815545d-02/ data (xnrg(61, 1,i),i=6,11) / 963.204529d0, 195.800629d0, $ 90.3680038d0, 58.7389030d0, 47.4079094d0, 45.2291832 / data (xnrg(61, 2,i),i=6,11) / 158.343384d0, 32.1881104d0, $ 14.8557997d0, 9.65622139d0, 7.79349327d0, 7.43532801 / data (xnrg(61, 3,i),i=6,11) / 149.494537d0, 30.3893108d0, $ 14.0255995d0, 9.11659431d0, 7.35796261d0, 7.01981258 / data (xnrg(61, 4,i),i=6,11) / 137.695358d0, 27.9907703d0, $ 12.9186001d0, 8.39704800d0, 6.77721977d0, 6.46575928 / data (xnrg(61, 5,i),i=6,11) / 35.0990677d0, 7.13495350d0, $ 3.29299998d0, 2.14043927d0, 1.72753906d0, 1.64814651 / data (xnrg(61, 6,i),i=6,11) / 31.3663960d0, 6.37617397d0, $ 2.94280005d0, 1.91281044d0, 1.54382074d0, 1.47287142 / data (xnrg(61, 7,i),i=6,11) / 28.9255543d0, 5.87999916d0, $ 2.71379995d0, 1.76396108d0, 1.42368519d0, 1.35825694 / data (xnrg(61, 8,i),i=6,11) / 22.4152260d0, 4.55657673d0, $ 2.10299993d0, 1.36694312d0, 1.10325372d0, 1.05255151 / data (xnrg(61, 9,i),i=6,11) / 21.8908195d0, 4.44997501d0, $ 2.05380011d0, 1.33496320d0, 1.07744288d0, 1.02792692 / data (xnrg(61,10,i),i=6,10) / 150.143921d0, 6.20438671d0, $ 1.32159996d0, 0.558370352d0,0.363724262 / data (xnrg(61,11,i),i=6,10) / 115.607178d0, 4.77722740d0, $ 1.01760006d0, 0.429931641d0,0.280058891 / data (xnrg(61,12,i),i=6,10) / 107.245651d0, 4.43170452d0, $ 0.944000006d0, 0.398835957d0,0.259803057 / data (xnrg(61,13,i),i=6,10) / 54.7134628d0, 2.26092052d0, $ 0.481599987d0, 0.203473940d0,0.132543594 / data (xnrg(61,14,i),i=6,10) / 54.7134628d0, 2.26092052d0, $ 0.481599987d0, 0.203473940d0,0.132543594 / data (xnrg(61,15,i),i=6,10) / 1.81772292d0,7.511363924d-02, $ 1.599999890d-02, 6.759931799d-03,4.403441679d-03/ data (xnrg(61,16,i),i=6,10) / 17.0411530d0,0.704190373d0, $ 0.149999991d0, 6.337435544d-02,4.128226265d-02/ data (xnrg(61,17,i),i=6,10) / 9.58848858d0,0.396224469d0, $ 8.440000564d-02, 3.565864265d-02,2.322815545d-02/ data (xnrg(61,18,i),i=6,10) / 9.58848858d0,0.396224469d0, $ 8.440000564d-02, 3.565864265d-02,2.322815545d-02/ data (xnrg(62, 1,i),i=6,11) / 998.382507d0, 202.951614d0, $ 93.6684036d0, 60.8841515d0, 49.1393318d0, 46.8810349 / data (xnrg(62, 2,i),i=6,11) / 164.928314d0, 33.5266991d0, $ 15.4736004d0, 10.0577888d0, 8.11759758d0, 7.74453688 / data (xnrg(62, 3,i),i=6,11) / 155.868423d0, 31.6849995d0, $ 14.6236000d0, 9.50529194d0, 7.67167902d0, 7.31911182 / data (xnrg(62, 4,i),i=6,11) / 143.171799d0, 29.1040230d0, $ 13.4323997d0, 8.73101616d0, 7.04676437d0, 6.72291613 / data (xnrg(62, 5,i),i=6,11) / 36.7255821d0, 7.46559238d0, $ 3.44560003d0, 2.23962855d0, 1.80759430d0, 1.72452271 / data (xnrg(62, 6,i),i=6,11) / 32.8436890d0, 6.67647886d0, $ 3.08139992d0, 2.00289989d0, 1.61653161d0, 1.54224062 / data (xnrg(62, 7,i),i=6,11) / 30.2664165d0, 6.15257025d0, $ 2.83959985d0, 1.84573066d0, 1.48968101d0, 1.42121983 / data (xnrg(62, 8,i),i=6,11) / 23.5770245d0, 4.79274750d0, $ 2.21199989d0, 1.43779278d0, 1.16043615d0, 1.10710597 / data (xnrg(62, 9,i),i=6,11) / 23.0270348d0, 4.68094540d0, $ 2.16039991d0, 1.40425289d0, 1.13336635d0, 1.08128023 / data (xnrg(62,10,i),i=6,10) / 157.096710d0, 6.49169636d0, $ 1.38279998d0, 0.584227085d0,0.380567431 / data (xnrg(62,11,i),i=6,10) / 120.696808d0, 4.98754597d0, $ 1.06239998d0, 0.448859483d0,0.292388529 / data (xnrg(62,12,i),i=6,10) / 112.426170d0, 4.64577866d0, $ 0.989600003d0, 0.418101788d0,0.272352874 / data (xnrg(62,13,i),i=6,10) / 58.6215668d0, 2.42241502d0, $ 0.515999973d0, 0.218007803d0,0.142010987 / data (xnrg(62,14,i),i=6,10) / 58.6215668d0, 2.42241502d0, $ 0.515999973d0, 0.218007803d0,0.142010987 / data (xnrg(62,15,i),i=6,10) / 2.49936914d0,0.103281252d0, $ 2.199999988d-02, 9.294905700d-03,6.054732017d-03/ data (xnrg(62,16,i),i=6,10) / 16.9957104d0,0.702312529d0, $ 0.149599999d0, 6.320536137d-02,4.117217660d-02/ data (xnrg(62,17,i),i=6,10) / 9.67937469d0,0.399980128d0, $ 8.519999683d-02, 3.599663451d-02,2.344832569d-02/ data (xnrg(62,18,i),i=6,10) / 9.67937469d0,0.399980128d0, $ 8.519999683d-02, 3.599663451d-02,2.344832569d-02/ data (xnrg(63, 1,i),i=6,11) / 1034.29797d0, 210.252533d0, $ 97.0380020d0, 63.0743828d0, 50.9070549d0, 48.5675201 / data (xnrg(63, 2,i),i=6,11) / 171.647552d0, 34.8925858d0, $ 16.1040001d0, 10.4675474d0, 8.44831085d0, 8.06005192 / data (xnrg(63, 3,i),i=6,11) / 162.376633d0, 33.0079880d0, $ 15.2342005d0, 9.90217972d0, 7.99200583d0, 7.62471724 / data (xnrg(63, 4,i),i=6,11) / 148.729233d0, 30.2337418d0, $ 13.9538002d0, 9.06992435d0, 7.32029581d0, 6.98387671 / data (xnrg(63, 5,i),i=6,11) / 38.3712883d0, 7.80013180d0, $ 3.60000014d0, 2.33998823d0, 1.88859415d0, 1.80180001 / data (xnrg(63, 6,i),i=6,11) / 34.4041214d0, 6.99368429d0, $ 3.22779989d0, 2.09805942d0, 1.69333446d0, 1.61551392 / data (xnrg(63, 7,i),i=6,11) / 31.5625134d0, 6.41604137d0, $ 2.96120000d0, 1.92477024d0, 1.55347359d0, 1.48208058 / data (xnrg(63, 8,i),i=6,11) / 24.7409534d0, 5.02935123d0, $ 2.32119989d0, 1.50877237d0, 1.21772349d0, 1.16176057 / data (xnrg(63, 9,i),i=6,11) / 24.1078262d0, 4.90064907d0, $ 2.26180005d0, 1.47016263d0, 1.18656170d0, 1.13203084 / data (xnrg(63,10,i),i=6,10) / 163.685959d0, 6.76398325d0, $ 1.44079995d0, 0.608731866d0,0.396529913 / data (xnrg(63,11,i),i=6,10) / 129.012894d0, 5.33119059d0, $ 1.13559997d0, 0.479786158d0,0.312534273 / data (xnrg(63,12,i),i=6,10) / 116.606926d0, 4.81854010d0, $ 1.02639997d0, 0.433649600d0,0.282480776 / data (xnrg(63,13,i),i=6,10) / 60.5301743d0, 2.50128436d0, $ 0.532800019d0, 0.225105733d0,0.146634609 / data (xnrg(63,14,i),i=6,10) / 60.5301743d0, 2.50128436d0, $ 0.532800019d0, 0.225105733d0,0.146634609 / data (xnrg(63,15,i),i=6,10) / 1.32307839d0,5.467347428d-02, $ 1.164602861d-02, 4.920397419d-03,3.205162939d-03/ data (xnrg(63,16,i),i=6,10) / 14.4508972d0,0.597153425d0, $ 0.127199993d0, 5.374145508d-02,3.500736132d-02/ data (xnrg(63,17,i),i=6,10) / 9.99747658d0,0.413125038d0, $ 8.799999952d-02, 3.717962652d-02,2.421892807d-02/ data (xnrg(63,18,i),i=6,10) / 9.99747658d0,0.413125038d0, $ 8.799999952d-02, 3.717962652d-02,2.421892807d-02/ data (xnrg(64, 1,i),i=6,11) / 1070.96606d0, 217.706436d0, $ 100.478195d0, 65.3105011d0, 52.7118149d0, 50.2893372 / data (xnrg(64, 2,i),i=6,11) / 178.545853d0, 36.2948761d0, $ 16.7511997d0, 10.8882246d0, 8.78783798d0, 8.38397598 / data (xnrg(64, 3,i),i=6,11) / 169.053223d0, 34.3652115d0, $ 15.8606005d0, 10.3093376d0, 8.32062054d0, 7.93823051 / data (xnrg(64, 4,i),i=6,11) / 154.397522d0, 31.3859959d0, $ 14.4855995d0, 9.41559219d0, 7.59928274d0, 7.25004292 / data (xnrg(64, 5,i),i=6,11) / 40.0937309d0, 8.15027046d0, $ 3.76160002d0, 2.44502759d0, 1.97337091d0, 1.88268077 / data (xnrg(64, 6,i),i=6,11) / 35.9901352d0, 7.31609011d0, $ 3.37660003d0, 2.19477892d0, 1.77139640d0, 1.68998826 / data (xnrg(64, 7,i),i=6,11) / 32.9140358d0, 6.69077969d0, $ 3.08800006d0, 2.00718999d0, 1.61999404d0, 1.54554403 / data (xnrg(64, 8,i),i=6,11) / 25.9475174d0, 5.27462196d0, $ 2.43440008d0, 1.58235204d0, 1.27710927d0, 1.21841717 / data (xnrg(64, 9,i),i=6,11) / 25.2653599d0, 5.13595295d0, $ 2.37039995d0, 1.54075217d0, 1.24353433d0, 1.18638515 / data (xnrg(64,10,i),i=6,10) / 170.775070d0, 7.05692673d0, $ 1.50319993d0, 0.635095596d0,0.413703322 / data (xnrg(64,11,i),i=6,10) / 131.103271d0, 5.41757154d0, $ 1.15400004d0, 0.487560064d0,0.317598224 / data (xnrg(64,12,i),i=6,10) / 123.105293d0, 5.08707142d0, $ 1.08360004d0, 0.457816362d0,0.298223078 / data (xnrg(64,13,i),i=6,10) / 63.8475227d0, 2.63836670d0, $ 0.562000036d0, 0.237442613d0,0.154670894 / data (xnrg(64,14,i),i=6,10) / 63.8475227d0, 2.63836670d0, $ 0.562000036d0, 0.237442613d0,0.154670894 / data (xnrg(64,15,i),i=6,10) / 4.21684551d0,0.174252421d0, $ 3.711760789d-02, 1.568203233d-02,1.021532621d-02/ data (xnrg(64,16,i),i=6,10) / 3.87365603d0,0.160070822d0, $ 3.409677744d-02, 1.440574322d-02,9.383948520d-03/ data (xnrg(64,17,i),i=6,10) / 16.4049511d0,0.677900612d0, $ 0.144400001d0, 6.100838631d-02,3.974106163d-02/ data (xnrg(64,18,i),i=6,10) / 9.22494411d0,0.381201744d0, $ 8.120000362d-02, 3.430665284d-02,2.234746702d-02/ data (xnrg(64,19,i),i=6,10) / 9.22494411d0,0.381201744d0, $ 8.120000362d-02, 3.430665284d-02,2.234746702d-02/ data (xnrg(65, 1,i),i=6,11) / 1108.41211d0, 225.318497d0, $ 103.991402d0, 67.5940704d0, 54.5548744d0, 52.0476952 / data (xnrg(65, 2,i),i=6,11) / 185.631760d0, 37.7353020d0, $ 17.4160004d0, 11.3203430d0, 9.13659859d0, 8.71670818 / data (xnrg(65, 3,i),i=6,11) / 175.902496d0, 35.7575340d0, $ 16.5032005d0, 10.7270260d0, 8.65773487d0, 8.25985146 / data (xnrg(65, 4,i),i=6,11) / 160.178802d0, 32.5612144d0, $ 15.0279999d0, 9.76815033d0, 7.88383102d0, 7.52151394 / data (xnrg(65, 5,i),i=6,11) / 41.9419479d0, 8.52597713d0, $ 3.93499994d0, 2.55773711d0, 2.06433821d0, 1.96946752 / data (xnrg(65, 6,i),i=6,11) / 37.6827354d0, 7.66016245d0, $ 3.53539991d0, 2.29799843d0, 1.85470438d0, 1.76946771 / data (xnrg(65, 7,i),i=6,11) / 34.3486977d0, 6.98241758d0, $ 3.22259998d0, 2.09467959d0, 1.69060647d0, 1.61291134 / data (xnrg(65, 8,i),i=6,11) / 27.1796608d0, 5.52509308d0, $ 2.54999995d0, 1.65749156d0, 1.33775413d0, 1.27627504 / data (xnrg(65, 9,i),i=6,11) / 26.4591331d0, 5.37862396d0, $ 2.48239994d0, 1.61355186d0, 1.30229056d0, 1.24244118 / data (xnrg(65,10,i),i=6,10) / 180.817993d0, 7.47192955d0, $ 1.59160006d0, 0.672444224d0,0.438032359 / data (xnrg(65,11,i),i=6,10) / 140.964417d0, 5.82506275d0, $ 1.24080002d0, 0.524232686d0,0.341486901 / data (xnrg(65,12,i),i=6,10) / 129.512772d0, 5.35184717d0, $ 1.13999999d0, 0.481645137d0,0.313745201 / data (xnrg(65,13,i),i=6,10) / 66.8013229d0, 2.76042628d0, $ 0.588000000d0, 0.248427495d0,0.161826476 / data (xnrg(65,14,i),i=6,10) / 66.8013229d0, 2.76042628d0, $ 0.588000000d0, 0.248427495d0,0.161826476 / data (xnrg(65,15,i),i=6,10) / 4.27164888d0,0.176517054d0, $ 3.759999946d-02, 1.588583924d-02,1.034808718d-02/ data (xnrg(65,16,i),i=6,10) / 3.90810442d0,0.161494330d0, $ 3.440000117d-02, 1.453385316d-02,9.467399679d-03/ data (xnrg(65,17,i),i=6,10) / 17.7227993d0,0.732357979d0, $ 0.156000003d0, 6.590933353d-02,4.293355718d-02/ data (xnrg(65,18,i),i=6,10) / 11.5425415d0,0.476971626d0, $ 0.101599999d0, 4.292556643d-02,2.796185389d-02/ data (xnrg(65,19,i),i=6,10) / 11.5425415d0,0.476971626d0, $ 0.101599999d0, 4.292556643d-02,2.796185389d-02/ data (xnrg(66, 1,i),i=6,11) / 1146.63000d0, 233.087433d0, $ 107.577003d0, 69.9246979d0, 56.4359131d0, 53.8422890 / data (xnrg(66, 2,i),i=6,11) / 192.832764d0, 39.1991272d0, $ 18.0916004d0, 11.7594805d0, 9.49102497d0, 9.05484581 / data (xnrg(66, 3,i),i=6,11) / 182.915924d0, 37.1832275d0, $ 17.1611996d0, 11.1547232d0, 9.00292778d0, 8.58918095 / data (xnrg(66, 4,i),i=6,11) / 166.064529d0, 33.7576675d0, $ 15.5802002d0, 10.1270790d0, 8.17352009d0, 7.79789019 / data (xnrg(66, 5,i),i=6,11) / 43.6324158d0, 8.86961651d0, $ 4.09359980d0, 2.66082668d0, 2.14754128d0, 2.04884672 / data (xnrg(66, 6,i),i=6,11) / 39.2623520d0, 7.98126793d0, $ 3.68360019d0, 2.39432788d0, 1.93245149d0, 1.84364188 / data (xnrg(66, 7,i),i=6,11) / 35.7194023d0, 7.26105547d0, $ 3.35119987d0, 2.17826891d0, 1.75807130d0, 1.67727554 / data (xnrg(66, 8,i),i=6,11) / 28.4054108d0, 5.77426386d0, $ 2.66499996d0, 1.73224127d0, 1.39808428d0, 1.33383250 / data (xnrg(66, 9,i),i=6,11) / 27.6038780d0, 5.61132765d0, $ 2.58980012d0, 1.68336153d0, 1.35863364d0, 1.29619491 / data (xnrg(66,10,i),i=6,10) / 189.179520d0, 7.81745195d0, $ 1.66520000d0, 0.703539908d0,0.458288163 / data (xnrg(66,11,i),i=6,10) / 150.780121d0, 6.23067665d0, $ 1.32720006d0, 0.560736358d0,0.365265489 / data (xnrg(66,12,i),i=6,10) / 133.102768d0, 5.50019646d0, $ 1.17159998d0, 0.494996011d0,0.322442025 / data (xnrg(66,13,i),i=6,10) / 70.0732193d0, 2.89563084d0, $ 0.616800010d0, 0.260595351d0,0.169752672 / data (xnrg(66,14,i),i=6,10) / 70.0732193d0, 2.89563084d0, $ 0.616800010d0, 0.260595351d0,0.169752672 / data (xnrg(66,15,i),i=6,10) / 1.90860915d0,7.886932045d-02, $ 1.679999940d-02, 7.097928319d-03,4.623613786d-03/ data (xnrg(66,16,i),i=6,10) / 1.90860915d0,7.886932045d-02, $ 1.679999940d-02, 7.097928319d-03,4.623613786d-03/ data (xnrg(66,17,i),i=6,10) / 28.5836945d0, 1.18116200d0, $ 0.251599997d0, 0.106299929d0,6.924411654d-02/ data (xnrg(66,18,i),i=6,10) / 11.9515285d0,0.493872195d0, $ 0.105200000d0, 4.444655031d-02,2.895262837d-02/ data (xnrg(66,19,i),i=6,10) / 11.9515285d0,0.493872195d0, $ 0.105200000d0, 4.444655031d-02,2.895262837d-02/ data (xnrg(67, 1,i),i=6,11) / 1185.62378d0, 241.014099d0, $ 111.235397d0, 72.3026428d0, 58.3551445d0, 55.6733170 / data (xnrg(67, 2,i),i=6,11) / 200.259750d0, 40.7088852d0, $ 18.7884007d0, 12.2123985d0, 9.85657215d0, 9.40359402 / data (xnrg(67, 3,i),i=6,11) / 190.104141d0, 38.6444511d0, $ 17.8355999d0, 11.5930815d0, 9.35672474d0, 8.92671776 / data (xnrg(67, 4,i),i=6,11) / 172.054718d0, 34.9753571d0, $ 16.1422005d0, 10.4923773d0, 8.46835136d0, 8.07917118 / data (xnrg(67, 5,i),i=6,11) / 45.3697853d0, 9.22278881d0, $ 4.25659990d0, 2.76677608d0, 2.23305273d0, 2.13042831 / data (xnrg(67, 6,i),i=6,11) / 40.9890594d0, 8.33227348d0, $ 3.84559989d0, 2.49962735d0, 2.01743817d0, 1.92472279 / data (xnrg(67, 7,i),i=6,11) / 37.1178246d0, 7.54532671d0, $ 3.48239994d0, 2.26354861d0, 1.82690001d0, 1.74294114 / data (xnrg(67, 8,i),i=6,11) / 29.6631374d0, 6.02993488d0, $ 2.78299999d0, 1.80894089d0, 1.45998824d0, 1.39289153 / data (xnrg(67, 9,i),i=6,11) / 28.8083096d0, 5.85616541d0, $ 2.70280004d0, 1.75681114d0, 1.41791451d0, 1.35275137 / data (xnrg(67,10,i),i=6,10) / 197.995483d0, 8.18175316d0, $ 1.74280000d0, 0.736325562d0,0.479644865 / data (xnrg(67,11,i),i=6,10) / 156.096954d0, 6.45038366d0, $ 1.37399995d0, 0.580509126d0,0.378145546 / data (xnrg(67,12,i),i=6,10) / 139.328461d0, 5.75746059d0, $ 1.22640002d0, 0.518148780d0,0.337523788 / data (xnrg(67,13,i),i=6,10) / 73.1633530d0, 3.02332401d0, $ 0.643999994d0, 0.272087246d0,0.177238524 / data (xnrg(67,14,i),i=6,10) / 73.1633530d0, 3.02332401d0, $ 0.643999994d0, 0.272087246d0,0.177238524 / data (xnrg(67,15,i),i=6,10) / 1.68139374d0,6.948012114d-02, $ 1.480000000d-02, 6.252937019d-03,4.073183518d-03/ data (xnrg(67,16,i),i=6,10) / 1.68139374d0,6.948012114d-02, $ 1.480000000d-02, 6.252937019d-03,4.073183518d-03/ data (xnrg(67,17,i),i=6,10) / 23.2668552d0,0.961454630d0, $ 0.204799995d0, 8.652712405d-02,5.636405200d-02/ data (xnrg(67,18,i),i=6,10) / 9.22494411d0,0.381201744d0, $ 8.120000362d-02, 3.430665284d-02,2.234746702d-02/ data (xnrg(67,19,i),i=6,10) / 9.22494411d0,0.381201744d0, $ 8.120000362d-02, 3.430665284d-02,2.234746702d-02/ data (xnrg(68, 1,i),i=6,11) / 1225.44031d0, 249.108032d0, $ 114.971001d0, 74.7307739d0, 60.3148766d0, 57.5429840 / data (xnrg(68, 2,i),i=6,11) / 207.872177d0, 42.2563438d0, $ 19.5025997d0, 12.6766262d0, 10.2312489d0, 9.76105118 / data (xnrg(68, 3,i),i=6,11) / 197.490616d0, 40.1459770d0, $ 18.5286007d0, 12.0435295d0, 9.72027874d0, 9.27356434 / data (xnrg(68, 4,i),i=6,11) / 178.168549d0, 36.2181778d0, $ 16.7157993d0, 10.8652153d0, 8.76926708d0, 8.36625767 / data (xnrg(68, 5,i),i=6,11) / 47.0368042d0, 9.56166077d0, $ 4.41300011d0, 2.86843562d0, 2.31510162d0, 2.20870662 / data (xnrg(68, 6,i),i=6,11) / 42.7584038d0, 8.69194698d0, $ 4.01160002d0, 2.60752678d0, 2.10452342d0, 2.00780582 / data (xnrg(68, 7,i),i=6,11) / 38.6228333d0, 7.85126591d0, $ 3.62360001d0, 2.35532808d0, 1.90097499d0, 1.81361187 / data (xnrg(68, 8,i),i=6,11) / 30.9805508d0, 6.29773951d0, $ 2.90660000d0, 1.88928056d0, 1.52482998d0, 1.45475340 / data (xnrg(68, 9,i),i=6,11) / 30.0425854d0, 6.10706949d0, $ 2.81859994d0, 1.83208072d0, 1.47866428d0, 1.41070926 / data (xnrg(68,10,i),i=6,10) / 204.084839d0, 8.43338394d0, $ 1.79639995d0, 0.758971334d0,0.494396389 / data (xnrg(68,11,i),i=6,10) / 166.412537d0, 6.87665367d0, $ 1.46480000d0, 0.618871748d0,0.403135061 / data (xnrg(68,12,i),i=6,10) / 145.417831d0, 6.00909138d0, $ 1.27999997d0, 0.540794551d0,0.352275312 / data (xnrg(68,13,i),i=6,10) / 80.2979126d0, 3.31814504d0, $ 0.706799984d0, 0.298619986d0,0.194522023 / data (xnrg(68,14,i),i=6,10) / 76.1625900d0, 3.14726162d0, $ 0.670400023d0, 0.283241153d0,0.184504196 / data (xnrg(68,15,i),i=6,10) / 1.95405221d0,8.074716479d-02, $ 1.720000058d-02, 7.266926579d-03,4.733699840d-03/ data (xnrg(68,16,i),i=6,10) / 1.95405221d0,8.074716479d-02, $ 1.720000058d-02, 7.266926579d-03,4.733699840d-03/ data (xnrg(68,17,i),i=6,10) / 27.1749592d0, 1.12294888d0, $ 0.239199996d0, 0.101060979d0,6.583145261d-02/ data (xnrg(68,18,i),i=6,10) / 13.3602638d0,0.552085280d0, $ 0.117600001d0, 4.968549684d-02,3.236529604d-02/ data (xnrg(68,19,i),i=6,10) / 13.3602638d0,0.552085280d0, $ 0.117600001d0, 4.968549684d-02,3.236529604d-02/ data (xnrg(69, 1,i),i=6,11) / 1266.03076d0, 257.359253d0, $ 118.779198d0, 77.2060928d0, 62.3126945d0, 59.4489899 / data (xnrg(69, 2,i),i=6,11) / 215.640228d0, 43.8354378d0, $ 20.2313995d0, 13.1503439d0, 10.6135836d0, 10.1258154 / data (xnrg(69, 3,i),i=6,11) / 205.007126d0, 41.6739349d0, $ 19.2337990d0, 12.5019064d0, 10.0902338d0, 9.62651730 / data (xnrg(69, 4,i),i=6,11) / 184.352707d0, 37.4752960d0, $ 17.2959995d0, 11.2423429d0, 9.07364559d0, 8.65664768 / data (xnrg(69, 5,i),i=6,11) / 49.1749344d0, 9.99630165d0, $ 4.61359978d0, 2.99882483d0, 2.42033815d0, 2.30910683 / data (xnrg(69, 6,i),i=6,11) / 44.5490646d0, 9.05595303d0, $ 4.17960024d0, 2.71672630d0, 2.19265771d0, 2.09188986 / data (xnrg(69, 7,i),i=6,11) / 40.1726074d0, 8.16630459d0, $ 3.76900005d0, 2.44983768d0, 1.97725320d0, 1.88638449 / data (xnrg(69, 8,i),i=6,11) / 32.2873077d0, 6.56337738d0, $ 3.02920008d0, 1.96897018d0, 1.58914709d0, 1.51611471 / data (xnrg(69, 9,i),i=6,11) / 31.2875195d0, 6.36014032d0, $ 2.93540001d0, 1.90800035d0, 1.53993857d0, 1.46916771 / data (xnrg(69,10,i),i=6,10) / 214.354980d0, 8.85777569d0, $ 1.88679993d0, 0.797164917d0,0.519275844 / data (xnrg(69,11,i),i=6,10) / 175.364822d0, 7.24658871d0, $ 1.54359996d0, 0.652164400d0,0.424822032 / data (xnrg(69,12,i),i=6,10) / 152.961395d0, 6.32081270d0, $ 1.34640002d0, 0.568848252d0,0.370549619 / data (xnrg(69,13,i),i=6,10) / 81.6157608d0, 3.37260246d0, $ 0.718400002d0, 0.303520918d0,0.197714522 / data (xnrg(69,14,i),i=6,10) / 81.6157608d0, 3.37260246d0, $ 0.718400002d0, 0.303520918d0,0.197714522 / data (xnrg(69,15,i),i=6,10) / 2.40848303d0,9.952557087d-02, $ 2.119999938d-02, 8.956909180d-03,5.834559910d-03/ data (xnrg(69,16,i),i=6,10) / 2.40848303d0,9.952557087d-02, $ 2.119999938d-02, 8.956909180d-03,5.834559910d-03/ data (xnrg(69,17,i),i=6,10) / 24.1757164d0,0.999011397d0, $ 0.212799996d0, 8.990709484d-02,5.856577307d-02/ data (xnrg(69,18,i),i=6,10) / 14.6781130d0,0.606542647d0, $ 0.129199997d0, 5.458644778d-02,3.555779159d-02/ data (xnrg(69,19,i),i=6,10) / 14.6781130d0,0.606542647d0, $ 0.129199997d0, 5.458644778d-02,3.555779159d-02/ data (xnrg(70, 1,i),i=6,11) / 1307.44409d0, 265.777771d0, $ 122.664604d0, 79.7315903d0, 64.3510132d0, 61.3936348 / data (xnrg(70, 2,i),i=6,11) / 223.542587d0, 45.4418335d0, $ 20.9727993d0, 13.6322508d0, 11.0025291d0, 10.4968863 / data (xnrg(70, 3,i),i=6,11) / 212.709091d0, 43.2395935d0, $ 19.9563999d0, 12.9715948d0, 10.4693165d0, 9.98817825 / data (xnrg(70, 4,i),i=6,11) / 190.654129d0, 38.7562523d0, $ 17.8871994d0, 11.6266212d0, 9.38379478d0, 8.95254326 / data (xnrg(70, 5,i),i=6,11) / 51.1212120d0, 10.3919420d0, $ 4.79619980d0, 3.11751413d0, 2.51613188d0, 2.40049815 / data (xnrg(70, 6,i),i=6,11) / 46.3226700d0, 9.41649151d0, $ 4.34599972d0, 2.82488561d0, 2.27995276d0, 2.17517304 / data (xnrg(70, 7,i),i=6,11) / 41.5646286d0, 8.44927597d0, $ 3.89960003d0, 2.53472710d0, 2.04576707d0, 1.95174980 / data (xnrg(70, 8,i),i=6,11) / 33.6025887d0, 6.83074808d0, $ 3.15259981d0, 2.04917955d0, 1.65388381d0, 1.57787621 / data (xnrg(70, 9,i),i=6,11) / 32.5686951d0, 6.62057781d0, $ 3.05559993d0, 1.98612988d0, 1.60299659d0, 1.52932775 / data (xnrg(70,10,i),i=6,10) / 221.398666d0, 9.14884186d0, $ 1.94879997d0, 0.823359668d0,0.536339164 / data (xnrg(70,11,i),i=6,10) / 180.272675d0, 7.44939518d0, $ 1.58679998d0, 0.670416236d0,0.436711311 / data (xnrg(70,12,i),i=6,10) / 156.096954d0, 6.45038366d0, $ 1.37399995d0, 0.580509126d0,0.378145546 / data (xnrg(70,13,i),i=6,10) / 90.0227356d0, 3.72000313d0, $ 0.792400002d0, 0.334785610d0,0.218080446 / data (xnrg(70,14,i),i=6,10) / 84.0242462d0, 3.47212815d0, $ 0.739600003d0, 0.312477857d0,0.203549087 / data (xnrg(70,15,i),i=6,10) / 2.86291385d0,0.118303984d0, $ 2.520000003d-02, 1.064689271d-02,6.935420446d-03/ data (xnrg(70,16,i),i=6,10) / 2.86291385d0,0.118303984d0, $ 2.520000003d-02, 1.064689271d-02,6.935420446d-03/ data (xnrg(70,17,i),i=6,10) / 24.5847034d0, 1.01591194d0, $ 0.216399997d0, 9.142807871d-02,5.955654755d-02/ data (xnrg(70,18,i),i=6,10) / 10.6336794d0,0.439414799d0, $ 9.360000491d-02, 3.954559937d-02,2.576013282d-02/ data (xnrg(70,19,i),i=6,10) / 10.6336794d0,0.439414799d0, $ 9.360000491d-02, 3.954559937d-02,2.576013282d-02/ data (xnrg(71, 1,i),i=6,11) / 1349.68445d0, 274.364410d0, $ 126.627602d0, 82.3075256d0, 66.4300385d0, 63.3771133 / data (xnrg(71, 2,i),i=6,11) / 231.728455d0, 47.1058617d0, $ 21.7408009d0, 14.1314487d0, 11.4054298d0, 10.8812704 / data (xnrg(71, 3,i),i=6,11) / 220.605057d0, 44.8446884d0, $ 20.6972008d0, 13.4531116d0, 10.8579473d0, 10.3589487 / data (xnrg(71, 4,i),i=6,11) / 197.059998d0, 40.0584412d0, $ 18.4881992d0, 12.0172691d0, 9.69908524d0, 9.25334454 / data (xnrg(71, 5,i),i=6,11) / 53.1058617d0, 10.7953815d0, $ 4.98239994d0, 3.23854375d0, 2.61381435d0, 2.49369121 / data (xnrg(71, 6,i),i=6,11) / 48.2518921d0, 9.80866528d0, $ 4.52699995d0, 2.94253516d0, 2.37490702d0, 2.26576352 / data (xnrg(71, 7,i),i=6,11) / 43.1378517d0, 8.76908112d0, $ 4.04720020d0, 2.63066673d0, 2.12319946d0, 2.02562356 / data (xnrg(71, 8,i),i=6,11) / 34.9477158d0, 7.10418606d0, $ 3.27880001d0, 2.13120914d0, 1.72008955d0, 1.64103937 / data (xnrg(71, 9,i),i=6,11) / 33.8626595d0, 6.88361549d0, $ 3.17699981d0, 2.06503940d0, 1.66668427d0, 1.59008849 / data (xnrg(71,10,i),i=6,10) / 230.032837d0, 9.50563145d0, $ 2.02480006d0, 0.855469346d0,0.557255507 / data (xnrg(71,11,i),i=6,10) / 186.362045d0, 7.70102596d0, $ 1.64040005d0, 0.693062007d0,0.451462835 / data (xnrg(71,12,i),i=6,10) / 163.276962d0, 6.74708271d0, $ 1.43719995d0, 0.607210875d0,0.395539135 / data (xnrg(71,13,i),i=6,10) / 93.0674210d0, 3.84581852d0, $ 0.819200039d0, 0.346108496d0,0.225456208 / data (xnrg(71,14,i),i=6,10) / 88.6139984d0, 3.66178989d0, $ 0.780000031d0, 0.329546660d0,0.214667782 / data (xnrg(71,15,i),i=6,10) / 3.13557220d0,0.129571036d0, $ 2.759999968d-02, 1.166088227d-02,7.595936768d-03/ data (xnrg(71,16,i),i=6,10) / 3.13557220d0,0.129571036d0, $ 2.759999968d-02, 1.166088227d-02,7.595936768d-03/ data (xnrg(71,17,i),i=6,10) / 25.8116665d0, 1.06661367d0, $ 0.227200001d0, 9.599103034d-02,6.252887100d-02/ data (xnrg(71,18,i),i=6,10) / 12.7240610d0,0.525795460d0, $ 0.112000003d0, 4.731952026d-02,3.082409129d-02/ data (xnrg(71,19,i),i=6,10) / 12.7240610d0,0.525795460d0, $ 0.112000003d0, 4.731952026d-02,3.082409129d-02/ data (xnrg(72, 1,i),i=6,11) / 1393.10791d0, 283.191559d0, $ 130.701599d0, 84.9556122d0, 68.5672989d0, 65.4161530 / data (xnrg(72, 2,i),i=6,11) / 240.261810d0, 48.8405228d0, $ 22.5414009d0, 14.6518364d0, 11.8254318d0, 11.2819710 / data (xnrg(72, 3,i),i=6,11) / 228.935883d0, 46.5381851d0, $ 21.4787998d0, 13.9611492d0, 11.2679815d0, 10.7501392 / data (xnrg(72, 4,i),i=6,11) / 203.809082d0, 41.4303970d0, $ 19.1214008d0, 12.4288473d0, 10.0312672d0, 9.57026100 / data (xnrg(72, 5,i),i=6,11) / 55.4443779d0, 11.2707567d0, $ 5.20179987d0, 3.38115287d0, 2.72891355d0, 2.60350084 / data (xnrg(72, 6,i),i=6,11) / 50.4241333d0, 10.2502394d0, $ 4.73079967d0, 3.07500434d0, 2.48182249d0, 2.36776543 / data (xnrg(72, 7,i),i=6,11) / 44.9285126d0, 9.13308716d0, $ 4.21519995d0, 2.73986626d0, 2.21133375d0, 2.10970759 / data (xnrg(72, 8,i),i=6,11) / 36.5891533d0, 7.43785858d0, $ 3.43279982d0, 2.23130870d0, 1.80087936d0, 1.71811640 / data (xnrg(72, 9,i),i=6,11) / 35.4230919d0, 7.20082092d0, $ 3.32339978d0, 2.16019893d0, 1.74348700d0, 1.66336167 / data (xnrg(72,10,i),i=6,10) / 244.529190d0, 10.1046629d0, $ 2.15240002d0, 0.909379840d0,0.592372954 / data (xnrg(72,11,i),i=6,10) / 198.586227d0, 8.20616531d0, $ 1.74800003d0, 0.738522530d0,0.481075972 / data (xnrg(72,12,i),i=6,10) / 172.865463d0, 7.14330721d0, $ 1.52160001d0, 0.642869532d0,0.418767303 / data (xnrg(72,13,i),i=6,10) / 101.701599d0, 4.20260811d0, $ 0.895199955d0, 0.378218174d0,0.246372551 / data (xnrg(72,14,i),i=6,10) / 97.1118469d0, 4.01294613d0, $ 0.854799986d0, 0.361149341d0,0.235253856 / data (xnrg(72,15,i),i=6,10) / 7.77076530d0,0.321110815d0, $ 6.839999557d-02, 2.889870666d-02,1.882471144d-02/ data (xnrg(72,16,i),i=6,10) / 7.77076530d0,0.321110815d0, $ 6.839999557d-02, 2.889870666d-02,1.882471144d-02/ data (xnrg(72,17,i),i=6,10) / 29.4925556d0, 1.21871877d0, $ 0.259599984d0, 0.109679893d0,7.144583762d-02/ data (xnrg(72,18,i),i=6,10) / 17.3138123d0,0.715457439d0, $ 0.152400002d0, 6.438834965d-02,4.194278270d-02/ data (xnrg(72,19,i),i=6,10) / 13.9055805d0,0.574619353d0, $ 0.122400001d0, 5.171347782d-02,3.368632868d-02/ data (xnrg(72,20,i),i=6,10) / 2.27215385d0,9.389205277d-02, $ 1.999999955d-02, 8.449914865d-03,5.504302215d-03/ data (xnrg(73, 1,i),i=6,11) / 1437.14111d0, 292.142639d0, $ 134.832794d0, 87.6408768d0, 70.7345657d0, 67.4838181 / data (xnrg(73, 2,i),i=6,11) / 249.018982d0, 50.6206856d0, $ 23.3629990d0, 15.1858730d0, 12.2564507d0, 11.6931810 / data (xnrg(73, 3,i),i=6,11) / 237.392487d0, 48.2572441d0, $ 22.2721996d0, 14.4768572d0, 11.6842070d0, 11.1472359 / data (xnrg(73, 4,i),i=6,11) / 210.639175d0, 42.8188210d0, $ 19.7621994d0, 12.8453655d0, 10.3674374d0, 9.89098072 / data (xnrg(73, 5,i),i=6,11) / 57.7274666d0, 11.7348642d0, $ 5.41599989d0, 3.52038217d0, 2.84128499d0, 2.71070790 / data (xnrg(73, 6,i),i=6,11) / 52.6262169d0, 10.6978798d0, $ 4.93739986d0, 3.20929360d0, 2.59020662d0, 2.47116852 / data (xnrg(73, 7,i),i=6,11) / 46.7703362d0, 9.50749397d0, $ 4.38800001d0, 2.85218573d0, 2.30198646d0, 2.19619393 / data (xnrg(73, 8,i),i=6,11) / 38.2263298d0, 7.77066422d0, $ 3.58640003d0, 2.33114839d0, 1.88145947d0, 1.79499328 / data (xnrg(73, 9,i),i=6,11) / 36.9877892d0, 7.51889324d0, $ 3.47019982d0, 2.25561857d0, 1.82049978d0, 1.73683500 / data (xnrg(73,10,i),i=6,10) / 256.980591d0, 10.6191912d0, $ 2.26200008d0, 0.955685377d0,0.622536540 / data (xnrg(73,11,i),i=6,10) / 211.219406d0, 8.72820473d0, $ 1.85920000d0, 0.785504103d0,0.511679888 / data (xnrg(73,12,i),i=6,10) / 183.817245d0, 7.59586716d0, $ 1.61800003d0, 0.683598101d0,0.445298016 / data (xnrg(73,13,i),i=6,10) / 109.654144d0, 4.53123045d0, $ 0.965200007d0, 0.407792896d0,0.265637606 / data (xnrg(73,14,i),i=6,10) / 104.200966d0, 4.30588913d0, $ 0.917199969d0, 0.387513071d0,0.252427280 / data (xnrg(73,15,i),i=6,10) / 11.3607683d0,0.469460249d0, $ 0.100000001d0, 4.224957153d-02,2.752150968d-02/ data (xnrg(73,16,i),i=6,10) / 11.3607683d0,0.469460249d0, $ 0.100000001d0, 4.224957153d-02,2.752150968d-02/ data (xnrg(73,17,i),i=6,10) / 32.3100243d0, 1.33514500d0, $ 0.284399986d0, 0.120157786d0,7.827117294d-02/ data (xnrg(73,18,i),i=6,10) / 20.4039402d0,0.843150616d0, $ 0.179600000d0, 7.588023692d-02,4.942863062d-02/ data (xnrg(73,19,i),i=6,10) / 16.5412788d0,0.683534145d0, $ 0.145600006d0, 6.151537970d-02,4.007131979d-02/ data (xnrg(73,20,i),i=6,10) / 2.59025526d0,0.107036933d0, $ 2.280000038d-02, 9.632902220d-03,6.274904124d-03/ data (xnrg(74, 1,i),i=6,11) / 1482.09094d0, 301.280060d0, $ 139.050003d0, 90.3820419d0, 72.9469452d0, 69.5945282 / data (xnrg(74, 2,i),i=6,11) / 257.936066d0, 52.4333496d0, $ 24.1996002d0, 15.7296610d0, 12.6953392d0, 12.1119003 / data (xnrg(74, 3,i),i=6,11) / 246.087845d0, 50.0248413d0, $ 23.0879993d0, 15.0071239d0, 12.1121836d0, 11.5555439 / data (xnrg(74, 4,i),i=6,11) / 217.582245d0, 44.2302132d0, $ 20.4135990d0, 13.2687731d0, 10.7091675d0, 10.2170067 / data (xnrg(74, 5,i),i=6,11) / 60.1064911d0, 12.2184725d0, $ 5.63920021d0, 3.66546154d0, 2.95837784d0, 2.82241964 / data (xnrg(74, 6,i),i=6,11) / 54.8901253d0, 11.1580877d0, $ 5.14979982d0, 3.34735298d0, 2.70163393d0, 2.57747483 / data (xnrg(74, 7,i),i=6,11) / 48.6249466d0, 9.88449955d0, $ 4.56199980d0, 2.96528506d0, 2.39326835d0, 2.28328085 / data (xnrg(74, 8,i),i=6,11) / 39.8976097d0, 8.11040306d0, $ 3.74320006d0, 2.43306780d0, 1.96371818d0, 1.87347162 / data (xnrg(74, 9,i),i=6,11) / 38.5674057d0, 7.83999872d0, $ 3.61840010d0, 2.35194802d0, 1.89824688d0, 1.81100917 / data (xnrg(74,10,i),i=6,10) / 270.386292d0, 11.1731539d0, $ 2.37999988d0, 1.00553989d0,0.655011952 / data (xnrg(74,11,i),i=6,10) / 223.398148d0, 9.23146629d0, $ 1.96640003d0, 0.830795586d0,0.541182935 / data (xnrg(74,12,i),i=6,10) / 193.269394d0, 7.98645782d0, $ 1.70120001d0, 0.718749762d0,0.468195915 / data (xnrg(74,13,i),i=6,10) / 117.606674d0, 4.85985279d0, $ 1.03520000d0, 0.437367588d0,0.284902662 / data (xnrg(74,14,i),i=6,10) / 111.517303d0, 4.60822201d0, $ 0.981599987d0, 0.414721817d0,0.270151138 / data (xnrg(74,15,i),i=6,10) / 16.5867214d0,0.685411990d0, $ 0.145999998d0, 6.168437749d-02,4.018140584d-02/ data (xnrg(74,16,i),i=6,10) / 15.2688732d0,0.630954564d0, $ 0.134399995d0, 5.678342655d-02,3.698891029d-02/ data (xnrg(74,17,i),i=6,10) / 35.0366096d0, 1.44781542d0, $ 0.308400005d0, 0.130297676d0,8.487633616d-02/ data (xnrg(74,18,i),i=6,10) / 21.2673588d0,0.878829598d0, $ 0.187199995d0, 7.909119874d-02,5.152026564d-02/ data (xnrg(74,19,i),i=6,10) / 16.1777344d0,0.668511391d0, $ 0.142399997d0, 6.016339362d-02,3.919063136d-02/ data (xnrg(74,20,i),i=6,10) / 2.77202749d0,0.114548303d0, $ 2.439999953d-02, 1.030889619d-02,6.715248339d-03/ data (xnrg(75, 1,i),i=6,11) / 1527.95313d0, 310.602966d0, $ 143.352798d0, 93.1788483d0, 75.2042389d0, 71.7480774 / data (xnrg(75, 2,i),i=6,11) / 267.036438d0, 54.2832794d0, $ 25.0534000d0, 16.2846279d0, 13.1432505d0, 12.5392265 / data (xnrg(75, 3,i),i=6,11) / 254.928162d0, 51.8219070d0, $ 23.9174004d0, 15.5462313d0, 12.5472946d0, 11.9706583 / data (xnrg(75, 4,i),i=6,11) / 224.585007d0, 45.6537361d0, $ 21.0706005d0, 13.6958208d0, 11.0538359d0, 10.5458355 / data (xnrg(75, 5,i),i=6,11) / 62.4961662d0, 12.7042475d0, $ 5.86339998d0, 3.81119061d0, 3.07599521d0, 2.93463159 / data (xnrg(75, 6,i),i=6,11) / 57.1646881d0, 11.6204624d0, $ 5.36319971d0, 3.48606229d0, 2.81358552d0, 2.68428159 / data (xnrg(75, 7,i),i=6,11) / 50.4646378d0, 10.2584724d0, $ 4.73460007d0, 3.07747436d0, 2.48381591d0, 2.36966729 / data (xnrg(75, 8,i),i=6,11) / 41.5454445d0, 8.44537544d0, $ 3.89779997d0, 2.53355718d0, 2.04482269d0, 1.95084894 / data (xnrg(75, 9,i),i=6,11) / 40.1384964d0, 8.15937042d0, $ 3.76580000d0, 2.44775772d0, 1.97557437d0, 1.88478291 / data (xnrg(75,10,i),i=6,10) / 284.019226d0, 11.7365065d0, $ 2.50000000d0, 1.05623937d0,0.688037753 / data (xnrg(75,11,i),i=6,10) / 235.349686d0, 9.72533894d0, $ 2.07159996d0, 0.875242174d0,0.570135593 / data (xnrg(75,12,i),i=6,10) / 201.949020d0, 8.34512520d0, $ 1.77759993d0, 0.751028419d0,0.489222348 / data (xnrg(75,13,i),i=6,10) / 124.377693d0, 5.13965082d0, $ 1.09480000d0, 0.462548316d0,0.301305473 / data (xnrg(75,14,i),i=6,10) / 118.242882d0, 4.88614225d0, $ 1.04079998d0, 0.439733565d0,0.286443889 / data (xnrg(75,15,i),i=6,10) / 18.4498882d0,0.762403429d0, $ 0.162399992d0, 6.861330569d-02,4.469493032d-02/ data (xnrg(75,16,i),i=6,10) / 18.4498882d0,0.762403429d0, $ 0.162399992d0, 6.861330569d-02,4.469493032d-02/ data (xnrg(75,17,i),i=6,10) / 37.6268654d0, 1.55485237d0, $ 0.331200004d0, 0.139930591d0,9.115123749d-02/ data (xnrg(75,18,i),i=6,10) / 20.7220421d0,0.856295526d0, $ 0.182400003d0, 7.706321776d-02,5.019923300d-02/ data (xnrg(75,19,i),i=6,10) / 15.7233038d0,0.649733007d0, $ 0.138400003d0, 5.847340822d-02,3.808977082d-02/ data (xnrg(75,20,i),i=6,10) / 2.75506401d0,0.113847315d0, $ 2.425068244d-02, 1.024581026d-02,6.674154196d-03/ data (xnrg(75,21,i),i=6,10) / 2.36718655d0,9.781908989d-02, $ 2.083650045d-02, 8.803332224d-03,5.734519567d-03/ data (xnrg(76, 1,i),i=6,11) / 1574.73206d0, 320.112183d0, $ 147.741608d0, 96.0315552d0, 77.5066452d0, 73.9446716 / data (xnrg(76, 2,i),i=6,11) / 276.443817d0, 56.1956139d0, $ 25.9360008d0, 16.8583145d0, 13.6062717d0, 12.9809685 / data (xnrg(76, 3,i),i=6,11) / 264.015778d0, 53.6692390d0, $ 24.7700005d0, 16.1004181d0, 12.9945765d0, 12.3973846 / data (xnrg(76, 4,i),i=6,11) / 231.739120d0, 47.1080284d0, $ 21.7418003d0, 14.1320982d0, 11.4059544d0, 10.8817711 / data (xnrg(76, 5,i),i=6,11) / 64.9860382d0, 13.2103891d0, $ 6.09700012d0, 3.96302986d0, 3.19854403d0, 3.05154848 / data (xnrg(76, 6,i),i=6,11) / 59.5223923d0, 12.0997372d0, $ 5.58440018d0, 3.62984157d0, 2.92962909d0, 2.79499221 / data (xnrg(76, 7,i),i=6,11) / 52.3810692d0, 10.6480455d0, $ 4.91440010d0, 3.19434381d0, 2.57814074d0, 2.45965719 / data (xnrg(76, 8,i),i=6,11) / 43.2913399d0, 8.80028152d0, $ 4.06160021d0, 2.64002681d0, 2.13075399d0, 2.03283095 / data (xnrg(76, 9,i),i=6,11) / 41.7841988d0, 8.49390984d0, $ 3.92019987d0, 2.54811716d0, 2.05657411d0, 1.96206009 / data (xnrg(76,10,i),i=6,10) / 297.334045d0, 12.2867136d0, $ 2.61720014d0, 1.10575581d0,0.720292985 / data (xnrg(76,11,i),i=6,10) / 248.346405d0, 10.2624006d0, $ 2.18600011d0, 0.923575640d0,0.601620197 / data (xnrg(76,12,i),i=6,10) / 212.764481d0, 8.79205132d0, $ 1.87279999d0, 0.791249990d0,0.515422821 / data (xnrg(76,13,i),i=6,10) / 131.512253d0, 5.43447161d0, $ 1.15759993d0, 0.489081055d0,0.318589002 / data (xnrg(76,14,i),i=6,10) / 123.968712d0, 5.12275028d0, $ 1.09119999d0, 0.461027354d0,0.300314724 / data (xnrg(76,15,i),i=6,10) / 21.0401440d0,0.869440377d0, $ 0.185200006d0, 7.824621350d-02,5.096983537d-02/ data (xnrg(76,16,i),i=6,10) / 21.0401440d0,0.869440377d0, $ 0.185200006d0, 7.824621350d-02,5.096983537d-02/ data (xnrg(76,17,i),i=6,10) / 38.0358543d0, 1.57175291d0, $ 0.334800005d0, 0.141451567d0,9.214201570d-02/ data (xnrg(76,18,i),i=6,10) / 26.3569832d0, 1.08914781d0, $ 0.231999993d0, 9.801901132d-02,6.384990364d-02/ data (xnrg(76,19,i),i=6,10) / 20.6311550d0,0.852539837d0, $ 0.181600004d0, 7.672522217d-02,4.997906089d-02/ data (xnrg(76,20,i),i=6,10) / 3.20493889d0,0.132437468d0, $ 2.821058221d-02, 1.191885024d-02,7.763978094d-03/ data (xnrg(76,21,i),i=6,10) / 2.73928213d0,0.113195166d0, $ 2.411176823d-02, 1.018711925d-02,6.635922473d-03/ data (xnrg(77, 1,i),i=6,11) / 1622.48718d0, 329.819885d0, $ 152.222000d0, 98.9438019d0, 79.8571014d0, 76.1871109 / data (xnrg(77, 2,i),i=6,11) / 286.047272d0, 58.1478119d0, $ 26.8369999d0, 17.4439621d0, 14.0789442d0, 13.4319181 / data (xnrg(77, 3,i),i=6,11) / 273.376221d0, 55.5720367d0, $ 25.6481991d0, 16.6712456d0, 13.4552889d0, 12.8369246 / data (xnrg(77, 4,i),i=6,11) / 239.078690d0, 48.6000175d0, $ 22.4304008d0, 14.5796862d0, 11.7672005d0, 11.2264156 / data (xnrg(77, 5,i),i=6,11) / 67.6549683d0, 13.7529316d0, $ 6.34739971d0, 4.12578917d0, 3.32990599d0, 3.17687368 / data (xnrg(77, 6,i),i=6,11) / 62.0058670d0, 12.6045790d0, $ 5.81739998d0, 3.78129101d0, 3.05186319d0, 2.91160870 / data (xnrg(77, 7,i),i=6,11) / 54.3742447d0, 11.0532198d0, $ 5.10139990d0, 3.31589317d0, 2.67624283d0, 2.55325079 / data (xnrg(77, 8,i),i=6,11) / 45.1097107d0, 9.16992092d0, $ 4.23220015d0, 2.75091624d0, 2.22025228d0, 2.11821628 / data (xnrg(77, 9,i),i=6,11) / 43.4959831d0, 8.84188175d0, $ 4.08080006d0, 2.65250659d0, 2.14082623d0, 2.04244041 / data (xnrg(77,10,i),i=6,10) / 313.602661d0, 12.9589806d0, $ 2.76040006d0, 1.16625726d0,0.759703755 / data (xnrg(77,11,i),i=6,10) / 262.251984d0, 10.8370209d0, $ 2.30839992d0, 0.975289166d0,0.635306537 / data (xnrg(77,12,i),i=6,10) / 224.625122d0, 9.28216839d0, $ 1.97720003d0, 0.835358560d0,0.544155300 / data (xnrg(77,13,i),i=6,10) / 141.509735d0, 5.84759665d0, $ 1.24559999d0, 0.526260674d0,0.342807919 / data (xnrg(77,14,i),i=6,10) / 134.011627d0, 5.53775311d0, $ 1.17960000d0, 0.498375952d0,0.324643731 / data (xnrg(77,15,i),i=6,10) / 28.8109093d0, 1.19055116d0, $ 0.253600001d0, 0.107144915d0,6.979455054d-02/ data (xnrg(77,16,i),i=6,10) / 27.4930611d0, 1.13609385d0, $ 0.241999999d0, 0.102243967d0,6.660205126d-02/ data (xnrg(77,17,i),i=6,10) / 43.2618065d0, 1.78770459d0, $ 0.380800009d0, 0.160886377d0,0.104801908 / data (xnrg(77,18,i),i=6,10) / 28.6291370d0, 1.18303990d0, $ 0.252000004d0, 0.106468923d0,6.935420632d-02/ data (xnrg(77,19,i),i=6,10) / 22.9487514d0,0.948309720d0, $ 0.201999992d0, 8.534413576d-02,5.559344962d-02/ data (xnrg(77,20,i),i=6,10) / 3.66395903d0,0.151405513d0, $ 3.225097805d-02, 1.362590026d-02,8.875955828d-03/ data (xnrg(77,21,i),i=6,10) / 3.11492109d0,0.128717676d0, $ 2.741822600d-02, 1.158408355d-02,7.545909379d-03/ data (xnrg(78, 1,i),i=6,11) / 1671.17188d0, 339.716522d0, $ 156.789597d0, 101.912727d0, 82.2533112d0, 78.4731979 / data (xnrg(78, 2,i),i=6,11) / 295.883118d0, 60.1472473d0, $ 27.7598000d0, 18.0437794d0, 14.5630541d0, 13.8937798 / data (xnrg(78, 3,i),i=6,11) / 282.937073d0, 57.5155678d0, $ 26.5452003d0, 17.2542934d0, 13.9258633d0, 13.2858725 / data (xnrg(78, 4,i),i=6,11) / 246.507797d0, 50.1102104d0, $ 23.1273994d0, 15.0327339d0, 12.1328535d0, 11.5752640 / data (xnrg(78, 5,i),i=6,11) / 70.2620850d0, 14.2829065d0, $ 6.59200001d0, 4.28477812d0, 3.45822549d0, 3.29929590 / data (xnrg(78, 6,i),i=6,11) / 64.5170593d0, 13.1150541d0, $ 6.05299997d0, 3.93443012d0, 3.17546129d0, 3.02952647 / data (xnrg(78, 7,i),i=6,11) / 56.3929977d0, 11.4635925d0, $ 5.29080009d0, 3.43900251d0, 2.77560377d0, 2.64804530 / data (xnrg(78, 8,i),i=6,11) / 46.9387398d0, 9.54172707d0, $ 4.40380001d0, 2.86245537d0, 2.31027508d0, 2.20410180 / data (xnrg(78, 9,i),i=6,11) / 45.2269554d0, 9.19375515d0, $ 4.24320030d0, 2.75806618d0, 2.22602296d0, 2.12372160 / data (xnrg(78,10,i),i=6,10) / 328.098999d0, 13.5580120d0, $ 2.88800001d0, 1.22016764d0,0.794821203 / data (xnrg(78,11,i),i=6,10) / 276.839203d0, 11.4398079d0, $ 2.43680000d0, 1.02953756d0,0.670644164 / data (xnrg(78,12,i),i=6,10) / 235.849548d0, 9.74599457d0, $ 2.07599998d0, 0.877101123d0,0.571346521 / data (xnrg(78,13,i),i=6,10) / 150.325684d0, 6.21189785d0, $ 1.32319999d0, 0.559046328d0,0.364164621 / data (xnrg(78,14,i),i=6,10) / 142.373154d0, 5.88327599d0, $ 1.25320005d0, 0.529471636d0,0.344899565 / data (xnrg(78,15,i),i=6,10) / 33.7642059d0, 1.39523590d0, $ 0.297199994d0, 0.125565737d0,8.179392666d-02/ data (xnrg(78,16,i),i=6,10) / 32.3100243d0, 1.33514500d0, $ 0.284399986d0, 0.120157786d0,7.827117294d-02/ data (xnrg(78,17,i),i=6,10) / 46.2156067d0, 1.90976429d0, $ 0.406800002d0, 0.171871260d0,0.111957498 / data (xnrg(78,18,i),i=6,10) / 29.6743279d0, 1.22623014d0, $ 0.261200011d0, 0.110355884d0,7.188618183d-02/ data (xnrg(78,19,i),i=6,10) / 23.4940701d0,0.970843792d0, $ 0.206799999d0, 8.737211674d-02,5.691448227d-02/ data (xnrg(78,20,i),i=6,10) / 3.38092208d0,0.139709607d0, $ 2.975962311d-02, 1.257331390d-02,8.190297522d-03/ data (xnrg(78,21,i),i=6,10) / 2.78356099d0,0.115024894d0, $ 2.450151928d-02, 1.035178732d-02,6.743188016d-03/ data (xnrg(79, 1,i),i=6,10) / 372.712921d0, 168.043701d0, $ 114.162247d0, 92.0403137d0, 82.6876373 / data (xnrg(79, 2,i),i=6,11) / 305.964111d0, 62.1965141d0, $ 28.7056007d0, 18.6585464d0, 15.0592299d0, 14.3671532 / data (xnrg(79, 3,i),i=6,11) / 292.764404d0, 59.5132713d0, $ 27.4672012d0, 17.8535900d0, 14.4095535d0, 13.7473335 / data (xnrg(79, 4,i),i=6,11) / 254.075470d0, 51.6485710d0, $ 23.8374004d0, 15.4942312d0, 12.5053253d0, 11.9306183 / data (xnrg(79, 5,i),i=6,11) / 73.0099030d0, 14.8414831d0, $ 6.84980011d0, 4.45234728d0, 3.59346986d0, 3.42832494 / data (xnrg(79, 6,i),i=6,11) / 67.1028519d0, 13.6406965d0, $ 6.29559994d0, 4.09211922d0, 3.30273151d0, 3.15094781 / data (xnrg(79, 7,i),i=6,11) / 58.4735756d0, 11.8865337d0, $ 5.48600006d0, 3.56588197d0, 2.87800741d0, 2.74574304 / data (xnrg(79, 8,i),i=6,11) / 48.8402519d0, 9.92826748d0, $ 4.58220005d0, 2.97841501d0, 2.40386558d0, 2.29339123 / data (xnrg(79, 9,i),i=6,11) / 47.0197487d0, 9.55819416d0, $ 4.41139984d0, 2.86739564d0, 2.31426215d0, 2.20790577 / data (xnrg(79,10,i),i=6,10) / 344.822052d0, 14.2490578d0, $ 3.03519988d0, 1.28235900d0,0.835332870 / data (xnrg(79,11,i),i=6,10) / 292.517059d0, 12.0876627d0, $ 2.57480001d0, 1.08784199d0,0.708623827 / data (xnrg(79,12,i),i=6,10) / 247.846527d0, 10.2417450d0, $ 2.18160009d0, 0.921716690d0,0.600409269 / data (xnrg(79,13,i),i=6,10) / 159.959625d0, 6.61000013d0, $ 1.40799999d0, 0.594873965d0,0.387502849 / data (xnrg(79,14,i),i=6,10) / 151.734421d0, 6.27011108d0, $ 1.33560002d0, 0.564285278d0,0.367577285 / data (xnrg(79,15,i),i=6,10) / 39.2628174d0, 1.62245464d0, $ 0.345600009d0, 0.146014526d0,9.511433542d-02/ data (xnrg(79,16,i),i=6,10) / 37.6268654d0, 1.55485237d0, $ 0.331200004d0, 0.139930591d0,9.115123749d-02/ data (xnrg(79,17,i),i=6,10) / 48.9876328d0, 2.02431273d0, $ 0.431199998d0, 0.182180166d0,0.118672751 / data (xnrg(79,18,i),i=6,10) / 32.5826836d0, 1.34641194d0, $ 0.286799997d0, 0.121171772d0,7.893168926d-02/ data (xnrg(79,19,i),i=6,10) / 24.4029312d0, 1.00840068d0, $ 0.214800000d0, 9.075208008d-02,5.911620334d-02/ data (xnrg(79,20,i),i=6,10) / 3.77558589d0,0.156018272d0, $ 3.323354200d-02, 1.404102985d-02,9.146372788d-03/ data (xnrg(79,21,i),i=6,10) / 3.08572841d0,0.127511337d0, $ 2.716126479d-02, 1.147551835d-02,7.475190330d-03/ data (xnrg(80, 1,i),i=6,10) / 383.689545d0, 172.992691d0, $ 117.524399d0, 94.7509613d0, 85.1228409 / data (xnrg(80, 2,i),i=6,11) / 316.335022d0, 64.3047180d0, $ 29.6786003d0, 19.2909927d0, 15.5696745d0, 14.8541393 / data (xnrg(80, 3,i),i=6,11) / 302.892303d0, 61.5720711d0, $ 28.4174004d0, 18.4712181d0, 14.9080381d0, 14.2229090 / data (xnrg(80, 4,i),i=6,11) / 261.860565d0, 53.2311287d0, $ 24.5678005d0, 15.9689894d0, 12.8885002d0, 12.2961836 / data (xnrg(80, 5,i),i=6,11) / 75.9239883d0, 15.4338598d0, $ 7.12319994d0, 4.63005686d0, 3.73689818d0, 3.56516171 / data (xnrg(80, 6,i),i=6,11) / 69.8890381d0, 14.2070723d0, $ 6.55700016d0, 4.26202822d0, 3.43986440d0, 3.28177857 / data (xnrg(80, 7,i),i=6,11) / 60.6927147d0, 12.3376408d0, $ 5.69420004d0, 3.70121121d0, 2.98723125d0, 2.84994698 / data (xnrg(80, 8,i),i=6,11) / 50.8398209d0, 10.3347406d0, $ 4.76979971d0, 3.10035419d0, 2.50228214d0, 2.38728476 / data (xnrg(80, 9,i),i=6,11) / 48.9212570d0, 9.94473362d0, $ 4.58979988d0, 2.98335481d0, 2.40785241d0, 2.29719496 / data (xnrg(80,10,i),i=6,10) / 363.680939d0, 15.0283613d0, $ 3.20120001d0, 1.35249329d0,0.881018579 / data (xnrg(80,11,i),i=6,10) / 307.604156d0, 12.7111053d0, $ 2.70759988d0, 1.14394939d0,0.745172381 / data (xnrg(80,12,i),i=6,10) / 259.479950d0, 10.7224722d0, $ 2.28399992d0, 0.964980245d0,0.628591299 / data (xnrg(80,13,i),i=6,10) / 171.911148d0, 7.10387278d0, $ 1.51320004d0, 0.639320552d0,0.416455477 / data (xnrg(80,14,i),i=6,10) / 163.504181d0, 6.75647211d0, $ 1.43920004d0, 0.608055890d0,0.396089584 / data (xnrg(80,15,i),i=6,10) / 46.4428215d0, 1.91915357d0, $ 0.408800006d0, 0.172716260d0,0.112507932 / data (xnrg(80,16,i),i=6,10) / 44.7614288d0, 1.84967339d0, $ 0.393999994d0, 0.166463315d0,0.108434752 / data (xnrg(80,17,i),i=6,10) / 54.6680183d0, 2.25904274d0, $ 0.481200010d0, 0.203304946d0,0.132433504 / data (xnrg(80,18,i),i=6,10) / 36.5816765d0, 1.51166201d0, $ 0.321999997d0, 0.136043623d0,8.861926198d-02/ data (xnrg(80,19,i),i=6,10) / 26.1752110d0, 1.08163643d0, $ 0.230399996d0, 9.734302014d-02,6.340955943d-02/ data (xnrg(80,20,i),i=6,10) / 2.90835667d0,0.120181821d0, $ 2.559999935d-02, 1.081589051d-02,7.045506500d-03/ data (xnrg(80,21,i),i=6,10) / 2.90835667d0,0.120181821d0, $ 2.559999935d-02, 1.081589051d-02,7.045506500d-03/ data (xnrg(80,22,i),i=6,10) / 3.50529981d0,0.144849256d0, $ 3.085442446d-02, 1.303586271d-02,8.491603658d-03/ data (xnrg(81, 1,i),i=6,10) / 394.900269d0, 178.047226d0, $ 120.958252d0, 97.5194168d0, 87.6099777 / data (xnrg(81, 2,i),i=6,11) / 327.151459d0, 66.5034866d0, $ 30.6934013d0, 19.9506092d0, 16.1020489d0, 15.3620472 / data (xnrg(81, 3,i),i=6,11) / 313.320740d0, 63.6919708d0, $ 29.3957996d0, 19.1071720d0, 15.4213142d0, 14.7125969 / data (xnrg(81, 4,i),i=6,11) / 269.824768d0, 54.8500900d0, $ 25.3150005d0, 16.4546661d0, 13.2804890d0, 12.6701574 / data (xnrg(81, 5,i),i=6,11) / 78.9617157d0, 16.0513706d0, $ 7.40819979d0, 4.81530571d0, 3.88641191d0, 3.70780420 / data (xnrg(81, 6,i),i=6,11) / 72.8137817d0, 14.8016167d0, $ 6.83139992d0, 4.44038773d0, 3.58381724d0, 3.41911578 / data (xnrg(81, 7,i),i=6,11) / 63.0269699d0, 12.8121490d0, $ 5.91319990d0, 3.84356046d0, 3.10212064d0, 2.95955658 / data (xnrg(81, 8,i),i=6,11) / 52.9758263d0, 10.7689486d0, $ 4.97020006d0, 3.23061371d0, 2.60741401d0, 2.48758507 / data (xnrg(81, 9,i),i=6,11) / 50.9336205d0, 10.3538074d0, $ 4.77860022d0, 3.10607433d0, 2.50689888d0, 2.39168930 / data (xnrg(81,10,i),i=6,10) / 384.221191d0, 15.8771458d0, $ 3.38199997d0, 1.42888057d0,0.930777490 / data (xnrg(81,11,i),i=6,10) / 327.780884d0, 13.5448675d0, $ 2.88520002d0, 1.21898472d0,0.794050574 / data (xnrg(81,12,i),i=6,10) / 276.748322d0, 11.4360514d0, $ 2.43600011d0, 1.02919960d0,0.670423985 / data (xnrg(81,13,i),i=6,10) / 184.771545d0, 7.63530159d0, $ 1.62639999d0, 0.687147021d0,0.447609842 / data (xnrg(81,14,i),i=6,10) / 175.501160d0, 7.25222206d0, $ 1.54480004d0, 0.652671397d0,0.425152272 / data (xnrg(81,15,i),i=6,10) / 55.8040962d0, 2.30598879d0, $ 0.491200000d0, 0.207529902d0,0.135185659 / data (xnrg(81,16,i),i=6,10) / 53.8500443d0, 2.22524166d0, $ 0.474000007d0, 0.200262979d0,0.130451962 / data (xnrg(81,17,i),i=6,10) / 61.9389153d0, 2.55949736d0, $ 0.545200050d0, 0.230344683d0,0.150047272 / data (xnrg(81,18,i),i=6,10) / 45.2613029d0, 1.87032962d0, $ 0.398400009d0, 0.168322295d0,0.109645694 / data (xnrg(81,19,i),i=6,10) / 34.2640762d0, 1.41589212d0, $ 0.301600009d0, 0.127424717d0,8.300486952d-02/ data (xnrg(81,20,i),i=6,10) / 6.95279026d0,0.287309676d0, $ 6.120000035d-02, 2.585673891d-02,1.684316434d-02/ data (xnrg(81,21,i),i=6,10) / 5.95304298d0,0.245997176d0, $ 5.240000039d-02, 2.213877626d-02,1.442127116d-02/ data (xnrg(81,22,i),i=6,10) / 4.39199686d0,0.181490168d0, $ 3.865932673d-02, 1.633340120d-02,1.063963026d-02/ data (xnrg(82, 1,i),i=6,10) / 406.323364d0, 183.197510d0, $ 124.457153d0, 100.340317d0, 90.1442337 / data (xnrg(82, 2,i),i=6,11) / 338.110718d0, 68.7312927d0, $ 31.7215996d0, 20.6189365d0, 16.6414528d0, 15.8766613 / data (xnrg(82, 3,i),i=6,11) / 324.024200d0, 65.8677750d0, $ 30.4000015d0, 19.7599010d0, 15.9481287d0, 15.2152004 / data (xnrg(82, 4,i),i=6,11) / 277.876343d0, 56.4868164d0, $ 26.0704002d0, 16.9456749d0, 13.6767788d0, 13.0482349 / data (xnrg(82, 5,i),i=6,11) / 82.0868378d0, 16.6866474d0, $ 7.70139980d0, 5.00588465d0, 4.04022741d0, 3.85455060 / data (xnrg(82, 6,i),i=6,11) / 75.7662354d0, 15.4017925d0, $ 7.10839987d0, 4.62043667d0, 3.72913408d0, 3.55775428 / data (xnrg(82, 7,i),i=6,11) / 65.3676147d0, 13.2879572d0, $ 6.13280010d0, 3.98629975d0, 3.21732497d0, 3.06946635 / data (xnrg(82, 8,i),i=6,11) / 55.1182213d0, 11.2044554d0, $ 5.17119980d0, 3.36126304d0, 2.71286035d0, 2.58818555 / data (xnrg(82, 9,i),i=6,11) / 52.9523735d0, 10.7641811d0, $ 4.96799994d0, 3.22918367d0, 2.60625982d0, 2.48648405 / data (xnrg(82,10,i),i=6,10) / 406.079315d0, 16.7803879d0, $ 3.57439995d0, 1.51016879d0,0.983728826 / data (xnrg(82,11,i),i=6,10) / 347.139648d0, 14.3448277d0, $ 3.05559993d0, 1.29097795d0,0.840947270 / data (xnrg(82,12,i),i=6,10) / 292.880615d0, 12.1026850d0, $ 2.57800007d0, 1.08919406d0,0.709504545 / data (xnrg(82,13,i),i=6,10) / 197.768265d0, 8.17236423d0, $ 1.74080002d0, 0.735480547d0,0.479094446 / data (xnrg(82,14,i),i=6,10) / 187.634460d0, 7.75360537d0, $ 1.65160000d0, 0.697793961d0,0.454545259 / data (xnrg(82,15,i),i=6,10) / 64.9381561d0, 2.68343496d0, $ 0.571600020d0, 0.241498560d0,0.157312959 / data (xnrg(82,16,i),i=6,10) / 62.7568893d0, 2.59329844d0, $ 0.552399993d0, 0.233386651d0,0.152028829 / data (xnrg(82,17,i),i=6,10) / 66.9376450d0, 2.76605964d0, $ 0.589199960d0, 0.248934478d0,0.162156731 / data (xnrg(82,18,i),i=6,10) / 47.6243439d0, 1.96797740d0, $ 0.419200003d0, 0.177110210d0,0.115370169 / data (xnrg(82,19,i),i=6,10) / 39.0810432d0, 1.61494327d0, $ 0.344000012d0, 0.145338535d0,9.467399120d-02/ data (xnrg(82,20,i),i=6,10) / 9.90659046d0,0.409369349d0, $ 8.720000088d-02, 3.684162721d-02,2.399875596d-02/ data (xnrg(82,21,i),i=6,10) / 8.72507000d0,0.360545486d0, $ 7.680000365d-02, 3.244767338d-02,2.113652043d-02/ data (xnrg(82,22,i),i=6,10) / 5.31246948d0,0.219526812d0, $ 4.676153511d-02, 1.975654811d-02,1.286948007d-02/ data (xnrg(82,23,i),i=6,10) / 2.23201036d0,9.223321080d-02, $ 1.964665018d-02, 8.300625719d-03,5.407054443d-03/ data (xnrg(83, 1,i),i=6,10) / 417.964874d0, 188.446274d0, $ 128.022949d0, 103.215149d0, 92.7269363 / data (xnrg(83, 2,i),i=6,11) / 349.338593d0, 71.0136948d0, $ 32.7750015d0, 21.3036423d0, 17.1940765d0, 16.4038887 / data (xnrg(83, 3,i),i=6,11) / 334.919525d0, 68.0825806d0, $ 31.4222012d0, 20.4243279d0, 16.4843845d0, 15.7268114 / data (xnrg(83, 4,i),i=6,11) / 286.049408d0, 58.1482468d0, $ 26.8372002d0, 17.4440918d0, 14.0790491d0, 13.4320183 / data (xnrg(83, 5,i),i=6,11) / 85.2503357d0, 17.3297253d0, $ 7.99819994d0, 5.19880342d0, 4.19593143d0, 4.00309896 / data (xnrg(83, 6,i),i=6,11) / 78.7954330d0, 16.0175686d0, $ 7.39260006d0, 4.80516577d0, 3.87822795d0, 3.69999623 / data (xnrg(83, 7,i),i=6,11) / 67.7231903d0, 13.7667990d0, $ 6.35379982d0, 4.12994909d0, 3.33326364d0, 3.18007684 / data (xnrg(83, 8,i),i=6,11) / 57.2925911d0, 11.6464624d0, $ 5.37519979d0, 3.49386215d0, 2.81988072d0, 2.69028759 / data (xnrg(83, 9,i),i=6,11) / 54.9903145d0, 11.1784544d0, $ 5.15919971d0, 3.35346293d0, 2.70656514d0, 2.58217955 / data (xnrg(83,10,i),i=6,10) / 426.346924d0, 17.6179047d0, $ 3.75279999d0, 1.58554196d0, 1.03282726 / data (xnrg(83,11,i),i=6,10) / 365.953094d0, 15.1222534d0, $ 3.22119999d0, 1.36094320d0,0.886522889 / data (xnrg(83,12,i),i=6,10) / 308.513031d0, 12.7486629d0, $ 2.71560001d0, 1.14732945d0,0.747374117 / data (xnrg(83,13,i),i=6,10) / 210.674103d0, 8.70567131d0, $ 1.85440004d0, 0.783476114d0,0.510358870 / data (xnrg(83,14,i),i=6,10) / 199.949524d0, 8.26250076d0, $ 1.75999999d0, 0.743592501d0,0.484378576 / data (xnrg(83,15,i),i=6,10) / 73.5723343d0, 3.04022455d0, $ 0.647599995d0, 0.273608238d0,0.178229287 / data (xnrg(83,16,i),i=6,10) / 71.5273972d0, 2.95572186d0, $ 0.629599988d0, 0.266003311d0,0.173275426 / data (xnrg(83,17,i),i=6,10) / 72.3908234d0, 2.99140072d0, $ 0.637199998d0, 0.269214272d0,0.175367057 / data (xnrg(83,18,i),i=6,10) / 53.0775108d0, 2.19331837d0, $ 0.467200011d0, 0.197390005d0,0.128580496 / data (xnrg(83,19,i),i=6,10) / 42.1711731d0, 1.74263644d0, $ 0.371199995d0, 0.156830415d0,0.102159843 / data (xnrg(83,20,i),i=6,10) / 12.0424147d0,0.497627884d0, $ 0.105999999d0, 4.478454962d-02,2.917280048d-02/ data (xnrg(83,21,i),i=6,10) / 11.0881100d0,0.458193213d0, $ 9.759999812d-02, 4.123558104d-02,2.686099336d-02/ data (xnrg(83,22,i),i=6,10) / 6.46809006d0,0.267280430d0, $ 5.693355948d-02, 2.405418642d-02,1.566897519d-02/ data (xnrg(83,23,i),i=6,10) / 2.80379581d0,0.115861058d0, $ 2.467963099d-02, 1.042703912d-02,6.792207249d-03/ data (xnrg(84, 1,i),i=6,10) / 429.872772d0, 193.815140d0, $ 131.670349d0, 106.155762d0, 95.3687439 / data (xnrg(84, 2,i),i=6,11) / 361.101532d0, 73.4048691d0, $ 33.8786011d0, 22.0209789d0, 17.7730350d0, 16.9562397 / data (xnrg(84, 3,i),i=6,11) / 346.285950d0, 70.3931503d0, $ 32.4886017d0, 21.1174831d0, 17.0438271d0, 16.2605438 / data (xnrg(84, 4,i),i=6,11) / 294.474060d0, 59.8608093d0, $ 27.6276016d0, 17.9578495d0, 14.4937010d0, 13.8276148 / data (xnrg(84, 5,i),i=6,11) / 88.4543457d0, 17.9810371d0, $ 8.29880047d0, 5.39419270d0, 4.35362911d0, 4.15354967 / data (xnrg(84, 6,i),i=6,11) / 82.1593170d0, 16.7013817d0, $ 7.70819998d0, 5.01030445d0, 4.04379463d0, 3.85795403 / data (xnrg(84, 7,i),i=6,11) / 70.3878632d0, 14.3084745d0, $ 6.60379982d0, 4.29244804d0, 3.46441603d0, 3.30520177 / data (xnrg(84, 8,i),i=6,11) / 59.6460304d0, 12.1248703d0, $ 5.59599972d0, 3.63738155d0, 2.93571448d0, 2.80079794 / data (xnrg(84, 9,i),i=6,11) / 57.1945343d0, 11.6265287d0, $ 5.36600018d0, 3.48788238d0, 2.81505442d0, 2.68568301 / data (xnrg(84,10,i),i=6,10) / 452.294922d0, 18.6901512d0, $ 3.98119998d0, 1.68203998d0, 1.09568632 / data (xnrg(84,11,i),i=6,10) / 386.720581d0, 15.9804268d0, $ 3.40400004d0, 1.43817544d0,0.936832190 / data (xnrg(84,12,i),i=6,10) / 320.373688d0, 13.2387791d0, $ 2.81999993d0, 1.19143796d0,0.776106596 / data (xnrg(84,13,i),i=6,10) / 227.306259d0, 9.39296055d0, $ 2.00079989d0, 0.845329463d0,0.550650358 / data (xnrg(84,14,i),i=6,10) / 215.127518d0, 8.88969898d0, $ 1.89359999d0, 0.800037920d0,0.521147311 / data (xnrg(84,15,i),i=6,10) / 79.6816254d0, 3.29267836d0, $ 0.701375306d0, 0.296328098d0,0.193029076 / data (xnrg(84,16,i),i=6,10) / 76.9632339d0, 3.18034625d0, $ 0.677447379d0, 0.286218643d0,0.186443746 / data (xnrg(84,17,i),i=6,10) / 77.6650696d0, 3.20934820d0, $ 0.683625102d0, 0.288828701d0,0.188143954 / data (xnrg(84,18,i),i=6,10) / 57.1197777d0, 2.36035657d0, $ 0.502780914d0, 0.212422788d0,0.138372898 / data (xnrg(84,19,i),i=6,10) / 44.6769676d0, 1.84618330d0, $ 0.393256575d0, 0.166149214d0,0.108230144 / data (xnrg(84,20,i),i=6,10) / 14.2691259d0,0.589642107d0, $ 0.125599995d0, 5.306546390d-02,3.456701711d-02/ data (xnrg(84,21,i),i=6,10) / 14.2691259d0,0.589642107d0, $ 0.125599995d0, 5.306546390d-02,3.456701711d-02/ data (xnrg(84,22,i),i=6,10) / 7.62429142d0,0.315058053d0, $ 6.711070240d-02, 2.835398540d-02,1.846987754d-02/ data (xnrg(84,23,i),i=6,10) / 3.43538022d0,0.141959980d0, $ 3.023897670d-02, 1.277583838d-02,8.322223090d-03/ data (xnrg(84,24,i),i=6,10) / 2.45154977d0,0.101305217d0, $ 2.157908306d-02, 9.117070585d-03,5.938889459d-03/ data (xnrg(85, 1,i),i=6,10) / 441.992126d0, 199.279358d0, $ 135.382523d0, 109.148605d0, 98.0574646 / data (xnrg(85, 2,i),i=6,11) / 372.904938d0, 75.8042755d0, $ 34.9860001d0, 22.7407856d0, 18.3539867d0, 17.5104923 / data (xnrg(85, 3,i),i=6,11) / 357.805847d0, 72.7349243d0, $ 33.5694008d0, 21.8199997d0, 17.6108246d0, 16.8014851 / data (xnrg(85, 4,i),i=6,11) / 302.994598d0, 61.5928688d0, $ 28.4269981d0, 18.4774551d0, 14.9130726d0, 14.2277126 / data (xnrg(85, 5,i),i=6,11) / 92.0271378d0, 18.7073154d0, $ 8.63399982d0, 5.61207151d0, 4.52947807d0, 4.32131720 / data (xnrg(85, 6,i),i=6,11) / 85.4400635d0, 17.3682919d0, $ 8.01599979d0, 5.21037388d0, 4.20526934d0, 4.01200819 / data (xnrg(85, 7,i),i=6,11) / 73.0333481d0, 14.8462505d0, $ 6.85200024d0, 4.45377731d0, 3.59462404d0, 3.42942595 / data (xnrg(85, 8,i),i=6,11) / 62.0058670d0, 12.6045790d0, $ 5.81739998d0, 3.78129101d0, 3.05186319d0, 2.91160870 / data (xnrg(85, 9,i),i=6,11) / 59.4051476d0, 12.0759029d0, $ 5.57340002d0, 3.62269163d0, 2.92385840d0, 2.78948665 / data (xnrg(85,10,i),i=6,11) / 22.2127113d0, 4.51540947d0, $ 2.08400011d0, 1.35459316d0, 1.09328616d0, 1.04304194 / data (xnrg(85,11,i),i=6,10) / 402.625641d0, 16.6376705d0, $ 3.54399991d0, 1.49732482d0,0.975362301 / data (xnrg(85,12,i),i=6,10) / 336.278748d0, 13.8960238d0, $ 2.96000004d0, 1.25058734d0,0.814636707 / data (xnrg(85,13,i),i=6,10) / 242.302475d0, 10.0126486d0, $ 2.13280010d0, 0.901098907d0,0.586978734 / data (xnrg(85,14,i),i=6,10) / 216.029388d0, 8.92696762d0, $ 1.90153849d0, 0.803391874d0,0.523332119 / data (xnrg(85,15,i),i=6,10) / 89.5572205d0, 3.70076704d0, $ 0.788302481d0, 0.333054453d0,0.216952756 / data (xnrg(85,16,i),i=6,10) / 86.6041489d0, 3.57873726d0, $ 0.762308896d0, 0.322072238d0,0.209798917 / data (xnrg(85,17,i),i=6,10) / 84.3500137d0, 3.48558974d0, $ 0.742467463d0, 0.313689321d0,0.204338253 / data (xnrg(85,18,i),i=6,10) / 62.9383812d0, 2.60079837d0, $ 0.553997576d0, 0.234061599d0,0.152468488 / data (xnrg(85,19,i),i=6,10) / 49.2721024d0, 2.03606772d0, $ 0.433703929d0, 0.183238059d0,0.119361870 / data (xnrg(85,20,i),i=6,10) / 18.9016819d0,0.781072855d0, $ 0.166376784d0, 7.029347867d-02,4.578940198d-02/ data (xnrg(85,21,i),i=6,10) / 17.1146832d0,0.707228839d0, $ 0.150647223d0, 6.364781410d-02,4.146039113d-02/ data (xnrg(85,22,i),i=6,10) / 8.78822899d0,0.363155365d0, $ 7.735593617d-02, 3.268255293d-02,2.128952183d-02/ data (xnrg(85,23,i),i=6,10) / 4.10398197d0,0.169588551d0, $ 3.612415865d-02, 1.526230201d-02,9.941913188d-03/ data (xnrg(85,24,i),i=6,10) / 2.83769464d0,0.117261857d0, $ 2.497801557d-02, 1.055310573d-02,6.874327082d-03/ data (xnrg(86, 1,i),i=6,10) / 454.338654d0, 204.845993d0, $ 139.164276d0, 112.197540d0, 100.796585 / data (xnrg(86, 2,i),i=6,11) / 384.757416d0, 78.2136536d0, $ 36.0979996d0, 23.4635811d0, 18.9373531d0, 18.0670490 / data (xnrg(86, 3,i),i=6,11) / 369.581573d0, 75.1287003d0, $ 34.6741982d0, 22.5381165d0, 18.1904144d0, 17.3544369 / data (xnrg(86, 4,i),i=6,11) / 311.647308d0, 63.3517990d0, $ 29.2388000d0, 19.0051231d0, 15.3389511d0, 14.6340189 / data (xnrg(86, 5,i),i=6,11) / 95.5445023d0, 19.4223270d0, $ 8.96399975d0, 5.82657051d0, 4.70259953d0, 4.48648214 / data (xnrg(86, 6,i),i=6,11) / 88.6589890d0, 18.0226364d0, $ 8.31799984d0, 5.40667248d0, 4.36370134d0, 4.16315889 / data (xnrg(86, 7,i),i=6,11) / 75.4208908d0, 15.3315916d0, $ 7.07599974d0, 4.59937668d0, 3.71213651d0, 3.54153800 / data (xnrg(86, 8,i),i=6,11) / 64.4104691d0, 13.0933867d0, $ 6.04299974d0, 3.92793012d0, 3.17021489d0, 3.02452135 / data (xnrg(86, 9,i),i=6,11) / 61.6583939d0, 12.5339441d0, $ 5.78480005d0, 3.76010108d0, 3.03476095d0, 2.89529252 / data (xnrg(86,10,i),i=6,11) / 23.3851681d0, 4.75374651d0, $ 2.19400001d0, 1.42609274d0, 1.15099323d0, 1.09809697 / data (xnrg(86,11,i),i=6,10) / 422.166168d0, 17.4451427d0, $ 3.71600008d0, 1.56999409d0, 1.02269936 / data (xnrg(86,12,i),i=6,10) / 349.002808d0, 14.4218187d0, $ 3.07200003d0, 1.29790688d0,0.845460773 / data (xnrg(86,13,i),i=6,10) / 257.480469d0, 10.6398468d0, $ 2.26640010d0, 0.957544327d0,0.623747468 / data (xnrg(86,14,i),i=6,10) / 244.029312d0, 10.0840063d0, $ 2.14800000d0, 0.907520831d0,0.591162026 / data (xnrg(86,15,i),i=6,10) / 99.8069687d0, 4.12431622d0, $ 0.878523052d0, 0.371172220d0,0.241782799 / data (xnrg(86,16,i),i=6,10) / 96.6063461d0, 3.99205732d0, $ 0.850350440d0, 0.359269410d0,0.234029278 / data (xnrg(86,17,i),i=6,10) / 91.2637482d0, 3.77128530d0, $ 0.803323686d0, 0.339400828d0,0.221086800 / data (xnrg(86,18,i),i=6,10) / 68.9694824d0, 2.85002112d0, $ 0.607084632d0, 0.256490648d0,0.167078853 / data (xnrg(86,19,i),i=6,10) / 53.9939003d0, 2.23118615d0, $ 0.475266248d0, 0.200797960d0,0.130800441 / data (xnrg(86,20,i),i=6,10) / 22.1267567d0,0.914342403d0, $ 0.194764599d0, 8.228721470d-02,5.360215902d-02/ data (xnrg(86,21,i),i=6,10) / 20.1108532d0,0.831039429d0, $ 0.177020177d0, 7.479026914d-02,4.871862754d-02/ data (xnrg(86,22,i),i=6,10) / 9.97006226d0,0.411992192d0, $ 8.775869757d-02, 3.707767278d-02,2.415251732d-02/ data (xnrg(86,23,i),i=6,10) / 4.80451918d0,0.198536798d0, $ 4.229043797d-02, 1.786752976d-02,1.163896732d-02/ data (xnrg(86,24,i),i=6,10) / 3.23821735d0,0.133812636d0, $ 2.850350551d-02, 1.204260904d-02,7.844595239d-03/ data (xnrg(87, 1,i),i=6,10) / 466.957123d0, 210.535233d0, $ 143.029312d0, 115.313629d0, 103.596031 / data (xnrg(87, 2,i),i=6,11) / 397.334656d0, 80.7703629d0, $ 37.2779999d0, 24.2305775d0, 19.5563908d0, 18.6576385 / data (xnrg(87, 3,i),i=6,11) / 381.719696d0, 77.5961456d0, $ 35.8129997d0, 23.2783337d0, 18.7878399d0, 17.9244061 / data (xnrg(87, 4,i),i=6,11) / 320.425812d0, 65.1362915d0, $ 30.0623989d0, 19.5404606d0, 15.7710190d0, 15.0462303 / data (xnrg(87, 5,i),i=6,11) / 99.1684570d0, 20.1590061d0, $ 9.30399990d0, 6.04756927d0, 4.88096666d0, 4.65665197 / data (xnrg(87, 6,i),i=6,11) / 92.2403107d0, 18.7506485d0, $ 8.65400028d0, 5.62507153d0, 4.53997040d0, 4.33132696 / data (xnrg(87, 7,i),i=6,11) / 78.0855713d0, 15.8732672d0, $ 7.32600021d0, 4.76187611d0, 3.84328890d0, 3.66666293 / data (xnrg(87, 8,i),i=6,11) / 66.8555756d0, 13.5904293d0, $ 6.27239990d0, 4.07703924d0, 3.29056048d0, 3.13933635 / data (xnrg(87, 9,i),i=6,11) / 63.9457474d0, 12.9989185d0, $ 5.99940014d0, 3.89959025d0, 3.14734197d0, 3.00269961 / data (xnrg(87,10,i),i=6,11) / 24.5789413d0, 4.99641752d0, $ 2.30599999d0, 1.49889243d0, 1.20974946d0, 1.15415299 / data (xnrg(87,11,i),i=6,10) / 445.342133d0, 18.4028416d0, $ 3.92000008d0, 1.65618324d0, 1.07884324 / data (xnrg(87,12,i),i=6,10) / 368.088898d0, 15.2105122d0, $ 3.24000001d0, 1.36888611d0,0.891696930 / data (xnrg(87,13,i),i=6,10) / 274.158081d0, 11.3290148d0, $ 2.41319990d0, 1.01956666d0,0.664149106 / data (xnrg(87,14,i),i=6,10) / 262.206543d0, 10.8351431d0, $ 2.30800009d0, 0.975120127d0,0.635196447 / data (xnrg(87,15,i),i=6,10) / 112.011917d0, 4.62866068d0, $ 0.985953689d0, 0.416561216d0,0.271349341 / data (xnrg(87,16,i),i=6,10) / 108.546692d0, 4.48546743d0, $ 0.955451965d0, 0.403674394d0,0.262954801 / data (xnrg(87,17,i),i=6,10) / 99.9908829d0, 4.13191652d0, $ 0.880141914d0, 0.371856183d0,0.242228344 / data (xnrg(87,18,i),i=6,10) / 76.8030090d0, 3.17372537d0, $ 0.676037073d0, 0.285622776d0,0.186055616 / data (xnrg(87,19,i),i=6,10) / 60.4199524d0, 2.49672937d0, $ 0.531829774d0, 0.224695817d0,0.146367580 / data (xnrg(87,20,i),i=6,10) / 27.0558186d0, 1.11802578d0, $ 0.238151312d0, 0.100617915d0,6.554283947d-02/ data (xnrg(87,21,i),i=6,10) / 24.7905121d0, 1.02441657d0, $ 0.218211561d0, 9.219345450d-02,6.005511805d-02/ data (xnrg(87,22,i),i=6,10) / 12.6640158d0,0.523314238d0, $ 0.111471474d0, 4.709622264d-02,3.067863174d-02/ data (xnrg(87,23,i),i=6,10) / 6.89143038d0,0.284774095d0, $ 6.065989658d-02, 2.562854625d-02,1.669451967d-02/ data (xnrg(87,24,i),i=6,10) / 4.82253885d0,0.199281439d0, $ 4.244905338d-02, 1.793454401d-02,1.168262027d-02/ data (xnrg(88, 1,i),i=6,10) / 479.815216d0, 216.332504d0, $ 146.967758d0, 118.488899d0, 106.448647 / data (xnrg(88, 2,i),i=6,11) / 410.076080d0, 83.3604355d0, $ 38.4734001d0, 25.0075836d0, 20.1835098d0, 19.2559376 / data (xnrg(88, 3,i),i=6,11) / 394.036865d0, 80.0999832d0, $ 36.9686012d0, 24.0294685d0, 19.3940773d0, 18.5027847 / data (xnrg(88, 4,i),i=6,11) / 329.234161d0, 66.9268646d0, $ 30.8888016d0, 20.0776196d0, 16.2045574d0, 15.4598446 / data (xnrg(88, 5,i),i=6,11) / 102.792412d0, 20.8956852d0, $ 9.64400005d0, 6.26856852d0, 5.05933380d0, 4.82682180 / data (xnrg(88, 6,i),i=6,11) / 95.7043839d0, 19.4548283d0, $ 8.97900009d0, 5.83632040d0, 4.71046829d0, 4.49398947 / data (xnrg(88, 7,i),i=6,11) / 80.8312454d0, 16.4314098d0, $ 7.58360004d0, 4.92931509d0, 3.97842836d0, 3.79559183 / data (xnrg(88, 8,i),i=6,11) / 69.2473831d0, 14.0766373d0, $ 6.49679995d0, 4.22289848d0, 3.40828276d0, 3.25164843 / data (xnrg(88, 9,i),i=6,11) / 66.1883392d0, 13.4547930d0, $ 6.20980024d0, 4.03634977d0, 3.25771999d0, 3.10800505 / data (xnrg(88,10,i),i=6,11) / 25.7599239d0, 5.23648834d0, $ 2.41680002d0, 1.57091200d0, 1.26787615d0, 1.20960844 / data (xnrg(88,11,i),i=6,11) / 22.5452633d0, 4.58301067d0, $ 2.11520004d0, 1.37487304d0, 1.10965395d0, 1.05865765 / data (xnrg(88,12,i),i=6,10) / 399.490082d0, 16.5081005d0, $ 3.51640010d0, 1.48566401d0,0.967766345 / data (xnrg(88,13,i),i=6,10) / 288.972504d0, 11.9411907d0, $ 2.54360008d0, 1.07466018d0,0.700037122 / data (xnrg(88,14,i),i=6,10) / 273.885406d0, 11.3177481d0, $ 2.41079998d0, 1.01855266d0,0.663488567 / data (xnrg(88,15,i),i=6,10) / 135.829346d0, 5.61286688d0, $ 1.19560003d0, 0.505135894d0,0.329047173 / data (xnrg(88,16,i),i=6,10) / 135.829346d0, 5.61286688d0, $ 1.19560003d0, 0.505135894d0,0.329047173 / data (xnrg(88,17,i),i=6,10) / 115.607178d0, 4.77722740d0, $ 1.01760006d0, 0.429931641d0,0.280058891 / data (xnrg(88,18,i),i=6,10) / 91.0679245d0, 3.76319337d0, $ 0.801599979d0, 0.338672578d0,0.220612422 / data (xnrg(88,19,i),i=6,10) / 69.4370193d0, 2.86934090d0, $ 0.611199975d0, 0.258229375d0,0.168211460 / data (xnrg(88,20,i),i=6,10) / 30.5377464d0, 1.26190913d0, $ 0.268799990d0, 0.113566853d0,7.397782058d-02/ data (xnrg(88,21,i),i=6,10) / 30.5377464d0, 1.26190913d0, $ 0.268799990d0, 0.113566853d0,7.397782058d-02/ data (xnrg(88,22,i),i=6,10) / 19.7677383d0,0.816860855d0, $ 0.173999995d0, 7.351426035d-02,4.788742587d-02/ data (xnrg(88,23,i),i=6,10) / 8.54329777d0,0.353034109d0, $ 7.519999892d-02, 3.177167848d-02,2.069617435d-02/ data (xnrg(88,24,i),i=6,10) / 8.54329777d0,0.353034109d0, $ 7.519999892d-02, 3.177167848d-02,2.069617435d-02/ data (xnrg(89, 1,i),i=6,10) / 492.897217d0, 222.230743d0, $ 150.974792d0, 121.719460d0, 109.350937 / data (xnrg(89, 2,i),i=6,11) / 422.936829d0, 85.9747772d0, $ 39.6800003d0, 25.7918701d0, 20.8165035d0, 19.8598404 / data (xnrg(89, 3,i),i=6,11) / 406.803864d0, 82.6952591d0, $ 38.1664009d0, 24.8080349d0, 20.0224552d0, 19.1022835 / data (xnrg(89, 4,i),i=6,11) / 338.328156d0, 68.7754898d0, $ 31.7420006d0, 20.6321964d0, 16.6521549d0, 15.8868713 / data (xnrg(89, 5,i),i=6,11) / 106.629539d0, 21.6756973d0, $ 10.0039997d0, 6.50256729d0, 5.24819326d0, 5.00700188 / data (xnrg(89, 6,i),i=6,11) / 99.2537231d0, 20.1763401d0, $ 9.31200027d0, 6.05276918d0, 4.88516331d0, 4.66065598 / data (xnrg(89, 7,i),i=6,11) / 83.3296432d0, 16.9392853d0, $ 7.81799984d0, 5.08167410d0, 4.10139704d0, 3.91290903 / data (xnrg(89, 8,i),i=6,11) / 71.8438416d0, 14.6044455d0, $ 6.74039984d0, 4.38123798d0, 3.53607774d0, 3.37357020 / data (xnrg(89, 9,i),i=6,11) / 68.6206512d0, 13.9492350d0, $ 6.43800020d0, 4.18467903d0, 3.37743568d0, 3.22221899 / data (xnrg(89,10,i),i=6,11) / 27.0517559d0, 5.49909258d0, $ 2.53800011d0, 1.64969170d0, 1.33145881d0, 1.27026904 / data (xnrg(89,11,i),i=6,11) / 23.0227718d0, 4.68007898d0, $ 2.16000009d0, 1.40399289d0, 1.13315642d0, 1.08107996 / data (xnrg(89,12,i),i=6,10) / 404.443359d0, 16.7127857d0, $ 3.55999994d0, 1.50408483d0,0.979765713 / data (xnrg(89,13,i),i=6,10) / 306.695313d0, 12.6735487d0, $ 2.69959998d0, 1.14056945d0,0.742970705 / data (xnrg(89,14,i),i=6,10) / 289.472382d0, 11.9618473d0, $ 2.54800010d0, 1.07651913d0,0.701248050 / data (xnrg(89,15,i),i=6,10) / 138.121368d0, 5.70758009d0, $ 1.21577489d0, 0.513659716d0,0.334599614 / data (xnrg(89,16,i),i=6,10) / 134.087570d0, 5.54089117d0, $ 1.18026841d0, 0.498658359d0,0.324827671 / data (xnrg(89,17,i),i=6,10) / 118.722435d0, 4.90595865d0, $ 1.04502118d0, 0.441516966d0,0.287605584 / data (xnrg(89,18,i),i=6,10) / 93.6906281d0, 3.87157130d0, $ 0.824685633d0, 0.348426163d0,0.226965934 / data (xnrg(89,19,i),i=6,10) / 74.1787567d0, 3.06528354d0, $ 0.652937829d0, 0.275863439d0,0.179698348 / data (xnrg(89,20,i),i=6,10) / 37.7796021d0, 1.56116390d0, $ 0.332544416d0, 0.140498593d0,9.152124077d-02/ data (xnrg(89,21,i),i=6,10) / 34.9634132d0, 1.44479060d0, $ 0.307755679d0, 0.130025461d0,8.469901234d-02/ data (xnrg(89,22,i),i=6,10) / 18.3879013d0,0.759841919d0, $ 0.161854371d0, 6.838277727d-02,4.454476759d-02/ data (xnrg(89,23,i),i=6,10) / 11.4448824d0,0.472936064d0, $ 0.100740388d0, 4.256238416d-02,2.772527561d-02/ data (xnrg(89,24,i),i=6,10) / 8.36247349d0,0.345561922d0, $ 7.360834628d-02, 3.109921142d-02,2.025812678d-02/ data (xnrg(90, 1,i),i=6,10) / 506.266418d0, 228.258469d0, $ 155.069794d0, 125.020943d0, 112.316940 / data (xnrg(90, 2,i),i=6,11) / 436.411560d0, 88.7139282d0, $ 40.9441986d0, 26.6135941d0, 21.4797153d0, 20.4925709 / data (xnrg(90, 3,i),i=6,11) / 419.807465d0, 85.3386383d0, $ 39.3864021d0, 25.6010303d0, 20.6624794d0, 19.7128944 / data (xnrg(90, 4,i),i=6,11) / 347.479706d0, 70.6358185d0, $ 32.6006012d0, 21.1902828d0, 17.1025829d0, 16.3166008 / data (xnrg(90, 5,i),i=6,11) / 110.473068d0, 22.4570122d0, $ 10.3646002d0, 6.73695612d0, 5.43736744d0, 5.18748236 / data (xnrg(90, 6,i),i=6,11) / 102.971481d0, 20.9320869d0, $ 9.66079998d0, 6.27948856d0, 5.06814718d0, 4.83523035 / data (xnrg(90, 7,i),i=6,11) / 86.2522583d0, 17.5333958d0, $ 8.09220028d0, 5.25990343d0, 4.24524498d0, 4.05014610 / data (xnrg(90, 8,i),i=6,11) / 74.4147110d0, 15.1270542d0, $ 6.98159981d0, 4.53801727d0, 3.66261339d0, 3.49429083 / data (xnrg(90, 9,i),i=6,11) / 71.0295105d0, 14.4389095d0, $ 6.66400003d0, 4.33157825d0, 3.49599743d0, 3.33533192 / data (xnrg(90,10,i),i=6,11) / 28.3414593d0, 5.76126385d0, $ 2.65899992d0, 1.72834122d0, 1.39493656d0, 1.33082950 / data (xnrg(90,11,i),i=6,11) / 24.9029655d0, 5.06228542d0, $ 2.33640003d0, 1.51865232d0, 1.22569752d0, 1.16936815 / data (xnrg(90,12,i),i=6,10) / 439.570862d0, 18.1643562d0, $ 3.86919999d0, 1.63472044d0, 1.06486225 / data (xnrg(90,13,i),i=6,10) / 324.509003d0, 13.4096622d0, $ 2.85640001d0, 1.20681679d0,0.786124408 / data (xnrg(90,14,i),i=6,10) / 307.376953d0, 12.7017164d0, $ 2.70560002d0, 1.14310443d0,0.744621992 / data (xnrg(90,15,i),i=6,10) / 156.505951d0, 6.46728468d0, $ 1.37759995d0, 0.582030118d0,0.379136324 / data (xnrg(90,16,i),i=6,10) / 152.325180d0, 6.29452324d0, $ 1.34080005d0, 0.566482306d0,0.369008392 / data (xnrg(90,17,i),i=6,10) / 131.875809d0, 5.44949436d0, $ 1.16079998d0, 0.490433037d0,0.319469690 / data (xnrg(90,18,i),i=6,10) / 104.246414d0, 4.30776739d0, $ 0.917599976d0, 0.387682080d0,0.252537370 / data (xnrg(90,19,i),i=6,10) / 82.6155090d0, 3.41391516d0, $ 0.727200031d0, 0.307238907d0,0.200136423 / data (xnrg(90,20,i),i=6,10) / 42.8528175d0, 1.77080405d0, $ 0.377200007d0, 0.159365386d0,0.103811137 / data (xnrg(90,21,i),i=6,10) / 39.9444618d0, 1.65062225d0, $ 0.351599991d0, 0.148549497d0,9.676562995d-02/ data (xnrg(90,22,i),i=6,10) / 27.0386295d0, 1.11731541d0, $ 0.238000005d0, 0.100553982d0,6.550119072d-02/ data (xnrg(90,23,i),i=6,10) / 22.2671070d0,0.920142114d0, $ 0.195999995d0, 8.280916512d-02,5.394215882d-02/ data (xnrg(90,24,i),i=6,10) / 19.5405216d0,0.807471633d0, $ 0.172000006d0, 7.266926765d-02,4.733699560d-02/ data (xnrg(91, 1,i),i=6,10) / 519.889099d0, 234.400482d0, $ 159.242432d0, 128.385025d0, 115.339180 / data (xnrg(91, 2,i),i=6,11) / 449.894806d0, 91.4548035d0, $ 42.2091980d0, 27.4358406d0, 22.1433449d0, 21.1257038 / data (xnrg(91, 3,i),i=6,11) / 433.034882d0, 88.0275192d0, $ 40.6273994d0, 26.4076767d0, 21.3135185d0, 20.3340130 / data (xnrg(91, 4,i),i=6,11) / 356.705872d0, 72.5113220d0, $ 33.4662018d0, 21.7529202d0, 17.5566864d0, 16.7498341 / data (xnrg(91, 5,i),i=6,11) / 114.408257d0, 23.2569580d0, $ 10.7337999d0, 6.97693491d0, 5.63105297d0, 5.37226677 / data (xnrg(91, 6,i),i=6,11) / 106.606094d0, 21.6709328d0, $ 10.0018005d0, 6.50113726d0, 5.24703884d0, 5.00590086 / data (xnrg(91, 7,i),i=6,11) / 88.9744873d0, 18.0867710d0, $ 8.34759998d0, 5.42591286d0, 4.37923002d0, 4.17797375 / data (xnrg(91, 8,i),i=6,11) / 76.9813232d0, 15.6487970d0, $ 7.22239971d0, 4.69453621d0, 3.78893948d0, 3.61481118 / data (xnrg(91, 9,i),i=6,11) / 73.3701630d0, 14.9147177d0, $ 6.88359976d0, 4.47431755d0, 3.61120176d0, 3.44524169 / data (xnrg(91,10,i),i=6,11) / 29.5693417d0, 6.01086807d0, $ 2.77420020d0, 1.80322099d0, 1.45537162d0, 1.38848710 / data (xnrg(91,11,i),i=6,11) / 26.0988693d0, 5.30538940d0, $ 2.44860005d0, 1.59158194d0, 1.28455877d0, 1.22552431 / data (xnrg(91,12,i),i=6,11) / 21.4602070d0, 4.36244011d0, $ 2.01340008d0, 1.30870342d0, 1.05624866d0, 1.00770664 / data (xnrg(91,13,i),i=6,10) / 337.823822d0, 13.9598703d0, $ 2.97359991d0, 1.25633335d0,0.818379641 / data (xnrg(91,14,i),i=6,10) / 321.827850d0, 13.2988701d0, $ 2.83279991d0, 1.19684589d0,0.779629350 / data (xnrg(91,15,i),i=6,10) / 168.684692d0, 6.97054577d0, $ 1.48479998d0, 0.627321661d0,0.408639371 / data (xnrg(91,16,i),i=6,10) / 163.367859d0, 6.75083828d0, $ 1.43799996d0, 0.607548833d0,0.395759314 / data (xnrg(91,17,i),i=6,10) / 140.691757d0, 5.81379557d0, $ 1.23839998d0, 0.523218691d0,0.340826362 / data (xnrg(91,18,i),i=6,10) / 106.165833d0, 4.38708353d0, $ 0.934495151d0, 0.394820213d0,0.257187188 / data (xnrg(91,19,i),i=6,10) / 83.1835709d0, 3.43738890d0, $ 0.732200205d0, 0.309351444d0,0.201512545 / data (xnrg(91,20,i),i=6,10) / 43.9338608d0, 1.81547582d0, $ 0.386715561d0, 0.163385674d0,0.106429957 / data (xnrg(91,21,i),i=6,10) / 40.5537643d0, 1.67580032d0, $ 0.356963187d0, 0.150815427d0,9.824166447d-02/ data (xnrg(91,22,i),i=6,10) / 20.6577549d0,0.853638947d0, $ 0.181834131d0, 7.682414353d-02,5.004349723d-02/ data (xnrg(91,23,i),i=6,10) / 12.9717808d0,0.536032021d0, $ 0.114180483d0, 4.824076593d-02,3.142419457d-02/ data (xnrg(91,24,i),i=6,10) / 9.23429012d0,0.381587923d0, $ 8.128226548d-02, 3.434140980d-02,2.237010561d-02/ data (xnrg(92, 1,i),i=6,10) / 533.762024d0, 240.655319d0, $ 163.491714d0, 131.810898d0, 118.416931 / data (xnrg(92, 2,i),i=6,11) / 463.810791d0, 94.2836533d0, $ 43.5148010d0, 28.2844772d0, 22.8282757d0, 21.7791576 / data (xnrg(92, 3,i),i=6,11) / 446.547974d0, 90.7744598d0, $ 41.8951988d0, 27.2317429d0, 21.9786186d0, 20.9685478 / data (xnrg(92, 4,i),i=6,11) / 365.940582d0, 74.3885498d0, $ 34.3325996d0, 22.3160782d0, 18.0112076d0, 17.1834660 / data (xnrg(92, 5,i),i=6,11) / 118.268829d0, 24.0417385d0, $ 11.0959997d0, 7.21236372d0, 5.82106686d0, 5.55354786 / data (xnrg(92, 6,i),i=6,11) / 110.470932d0, 22.4565792d0, $ 10.3643999d0, 6.73682594d0, 5.43726254d0, 5.18738222 / data (xnrg(92, 7,i),i=6,11) / 91.7372208d0, 18.6483803d0, $ 8.60680008d0, 5.59439182d0, 4.51520872d0, 4.30770350 / data (xnrg(92, 8,i),i=6,11) / 79.4626694d0, 16.1532059d0, $ 7.45519972d0, 4.84585571d0, 3.91106844d0, 3.73132753 / data (xnrg(92, 9,i),i=6,11) / 75.7129440d0, 15.3909588d0, $ 7.10339975d0, 4.61718655d0, 3.72651100d0, 3.55525160 / data (xnrg(92,10,i),i=6,11) / 30.7140846d0, 6.24357176d0, $ 2.88160014d0, 1.87303054d0, 1.51171470d0, 1.44224083 / data (xnrg(92,11,i),i=6,11) / 27.1285000d0, 5.51469278d0, $ 2.54519987d0, 1.65437162d0, 1.33523607d0, 1.27387261 / data (xnrg(92,12,i),i=6,11) / 22.2745323d0, 4.52797604d0, $ 2.08979988d0, 1.35836315d0, 1.09632885d0, 1.04594493 / data (xnrg(92,13,i),i=6,10) / 354.637756d0, 14.6546717d0, $ 3.12159991d0, 1.31886268d0,0.859111428 / data (xnrg(92,14,i),i=6,10) / 335.233551d0, 13.8528328d0, $ 2.95079994d0, 1.24670041d0,0.812104702 / data (xnrg(92,15,i),i=6,10) / 177.818756d0, 7.34799194d0, $ 1.56519997d0, 0.661290348d0,0.430766672 / data (xnrg(92,16,i),i=6,10) / 173.092667d0, 7.15269661d0, $ 1.52359998d0, 0.643714488d0,0.419317722 / data (xnrg(92,17,i),i=6,10) / 147.099228d0, 6.07857132d0, $ 1.29480004d0, 0.547047496d0,0.356348515 / data (xnrg(92,18,i),i=6,10) / 117.833893d0, 4.86924171d0, $ 1.03719997d0, 0.438212574d0,0.285453111 / data (xnrg(92,19,i),i=6,10) / 88.6594391d0, 3.66366792d0, $ 0.780400038d0, 0.329715669d0,0.214777872 / data (xnrg(92,20,i),i=6,10) / 47.7152290d0, 1.97173309d0, $ 0.419999987d0, 0.177448213d0,0.115590341 / data (xnrg(92,21,i),i=6,10) / 43.7616806d0, 1.80836093d0, $ 0.385199994d0, 0.162745357d0,0.106012858 / data (xnrg(92,22,i),i=6,10) / 32.1282539d0, 1.32763362d0, $ 0.282799989d0, 0.119481795d0,7.783082873d-02/ data (xnrg(92,23,i),i=6,10) / 19.2224197d0,0.794326723d0, $ 0.169200003d0, 7.148627937d-02,4.656639323d-02/ data (xnrg(92,24,i),i=6,10) / 14.6781130d0,0.606542647d0, $ 0.129199997d0, 5.458644778d-02,3.555779159d-02/ c initialize the trivial parts of xnrg: c (non-trivial parts are given in the data statements above) norbz = norb(iz) do 50 k = 1, 5 do 30 j = 1, norbz xnrg(iz,j,k) = xnrdat(k) 30 continue 50 continue if (iz.gt.3) then c look-up coefficients for this element do 100 i = 1, 24 nparmz(i) = nparms(iz,i) benaz(i) = binden(iz,i)/ kev2ry do 80 j = 1, 11 xnrgz(i,j) = xnrg(iz,i,j) xscz(i,j) = xsc(iz,i,j) 80 continue 100 continue c calculate fp and fpp for each energy point do 200 i = 1, npts ener = energy(i) / 1000 call cromer(iz,ener,nparmz,norbz,benaz,xnrgz,xscz,f1,f2) fp(i) = f1 - relcor(iz) + kpcor(iz) fpp(i) = f2 200 continue end if return end subroutine cromer(iz,ener,nparms,norb,benaz,xnrg,xsc,f1,f2) c modified from cowan-brennan routines matt newville oct 1996 c this routine reads data for f' and f" according to an c algorithm by cromer and lieberman, given to fuoss. c converted to direct access file by brennan c converted to internal data 3-may-1993 smb implicit none integer iz, irb, ipr, icount,i0,inxs, norb, nparms(24) double precision benaz(24), xnrg(24,11), xsc(24,11) double precision ener, f1, f2, zero, fourpi double precision f1orb, f2orb, en_s(11), xs_s(11), aknint double precision xlnnrg(11),xln_xs(11),en_int(5), xs_int(5) double precision xsedga, f1corr, xlne, energa, bena, xsb double precision var, au, kev2ry, fscinv, tiny, tinlog double precision finepi, sigma0, sigma1, sigma2, sigma3, gauss parameter (zero=0, fourpi=12.56637061435917d0, tiny = 1.d-9) parameter (au = 2.80022d+7 ,kev2ry = 0.02721d0) c finepi = 1/(4*alpha*pi**2) parameter (finepi = 3.47116243d0, fscinv =137.036d0 ) common /gaus/ xsb,bena,xs_int, energa, xsedga,icount external sigma0,sigma1,sigma2,sigma3 save c executable code c ener is in kev xlne = log(ener) energa = ener / kev2ry f1 = zero f2 = zero tinlog = log(tiny) c main loop through the orbitals do 400 irb=1,norb icount= 6 f1orb = zero f1corr= zero f2orb = zero xsb = zero bena = benaz(irb) if (nparms(irb) .eq. 11) xsedga = xsc(irb,11)/ au c also copy subset into second array do 110 ipr=6,10 xs_int(ipr-5) = xsc(irb,ipr)/ au en_int(ipr-5) = xnrg(irb,ipr) 110 continue c the sorting routine messes up subsequent calls with same energy c so copy to second array before sorting. do 150 ipr=1,nparms(irb) xs_s(ipr) = xsc(irb,ipr) en_s(ipr) = xnrg(irb,ipr) 150 continue call sort(nparms(irb),en_s,xs_s) call sort(5,en_int,xs_int) c convert to log of energy,xsect do 190 ipr=1,nparms(irb) xlnnrg(ipr) = log(en_s(ipr)) xln_xs(ipr) = log(max(tiny,xs_s(ipr))) if (xln_xs(ipr).le.tinlog) xln_xs(ipr) = zero 190 continue c if (bena .le. energa) then do 250 i0 = 1, nparms(irb) if (abs(xln_xs(i0)) .ge. tiny ) go to 255 250 continue 255 continue inxs = nparms(irb) - i0 + 1 xsb = exp(aknint(xlne,inxs,xlnnrg(i0),xln_xs(i0)))/au f2orb= fscinv * energa * xsb / fourpi var = energa-bena if (abs(var). le. tiny) var = 1 f1corr = - finepi * xsb * energa * log((energa+bena)/var) end if c if((bena.gt.energa).and.(nparms(irb).eq.11)) then f1orb = gauss(sigma3) f1corr = finepi * xsedga * bena**2 * log((-bena+energa) $ /(-bena-energa)) / energa else if (nparms(irb).eq.11) then f1orb = gauss(sigma0) elseif ((nparms(irb).eq.10).and. $ (iz.ge.79).and.(irb.eq.1)) then f1orb = gauss(sigma1) else f1orb = gauss(sigma2) end if end if f1 = f1 + f1orb * 2 * finepi + f1corr f2 = f2 + f2orb 400 continue c this is the end of the loop over orbits c c note: the jensen correction to f' was subsequently shown to be incorrect c (see l. kissel and r.h. pratt, acta cryst. a46, 170 (1990)) c and that the relativistic correction that ludwig used is also c wrong. this section retained as comments for historical reasons. c c jensen_cor = -0.5*float(iz) c 1 *(energa/fscinv**2)**2 c c subtract relcor ala ludwig and change back to real*4 c c f1 = sumf1+jensen_cor-relcor(iz) c c kissel and pratt give better corrections. the relativistic correction c that ludwig used is (5/3)(e_tot/mc^2). kissel and pratt say that this c should be simply (e_tot/mc^2), but their correction (kpcor) apparently c takes this into account. so we can use the old relcor and simply add c the (energy independent) kpcor term: c return end double precision function sigma0( x) implicit none double precision x, xsb, bena, xs_int(5) double precision energa, d_prod, xsedga, tiny parameter(tiny=1.d-30) integer icount common /gaus/ xsb, bena, xs_int, energa, xsedga, icount save c executable code icount = icount-1 sigma0 = xs_int(icount)* bena/(x*x) d_prod = (energa*x)**2 - bena**2 if(abs( d_prod) .gt. tiny) $ sigma0 =bena * ( sigma0 * bena - xsb* energa**2)/ d_prod return end c*********************************************************************** double precision function sigma1( x) implicit none double precision x, xsb, bena, xs_int(5) double precision energa, xsedga, half parameter (half = 0.5d0) integer icount common /gaus/ xsb, bena, xs_int, $ energa, xsedga, icount save c executable code icount = icount-1 sigma1 = half* bena**3* xs_int( icount) $ /( sqrt(x)*( energa**2* x**2- bena**2* x)) return end c*********************************************************************** double precision function sigma2(x) implicit none double precision x, zero, tiny, p1, denom, eps double precision xsb, bena, xs_int(5), energa, xsedga integer icount common /gaus/ xsb, bena, xs_int, energa, xsedga,icount parameter (zero = 0, tiny = 1.d-18, eps = 1.d-5, p1 = 1.001d0) save icount=icount-1 c code modified by chris t. chantler, may 12-1992 c code modified by matt newville oct 1996 if ((abs(x).lt.tiny).or.(energa.lt.tiny)) then sigma2= zero elseif (abs(xs_int(icount)-xsb).lt.tiny) then sigma2=-2*xs_int(icount)*bena/x**3 else denom= x**3*energa**2-bena**2/ x if (abs(denom).lt.eps) then cc chantler: sigma2=-2*xs_int(icount)*bena/x**3 denom= x**3*(energa*p1)**2-bena**2/ x print*, ' weird point at e = ', energa * 27.21d0 end if sigma2= 2*(xs_int(icount)*(bena/x)**3/x- $ bena* xsb* energa**2)/ denom endif return end c*********************************************************************** double precision function sigma3( x) implicit none double precision x, xsb, bena, xs_int(5), energa, xsedga integer icount common /gaus/ xsb,bena,xs_int, energa, xsedga,icount save c executable code icount = icount-1 sigma3 = bena**3*( xs_int( icount) $ - xsedga* x**2)/( x**2*( x**2* energa**2- bena**2)) return end c*********************************************************************** subroutine lgndr (index,dbb,dcc) implicit none integer index, ip double precision dbb, dcc, const, d_x(2), d_a(3) double precision half,zero,one parameter(half = 0.5d0, zero = 0d0, one = 1d0) data d_x(1), d_x(2) /.04691007703067d0, .23076534494716d0/ data d_a(1), d_a(2) /.11846344252810d0, .23931433524968d0/ data d_a(3) /.28444444444444d0/ c executable code c warning! this routine has been stripped so it is only useful c with abs$cromer in this set of routines. dcc = half const=zero ip= index c ip limited to 1,2,3 if ( ip .gt. 3) then ip = 6 - ip const= -one end if dbb = d_a(ip) if( ip .eq. 3) return dcc= -const+ sign( d_x(ip), const) return end c*********************************************************************** double precision function gauss (sigma) implicit none integer i double precision b, c, sigma, zero parameter (zero = 0.d0) external sigma gauss = zero do 10 i=1,5 call lgndr( i, b, c) gauss = gauss + b * sigma(c) 10 continue return end c************************************************************* c*********************************************** c bubble sort. largest becomes last subroutine sort (n,a,b) implicit none integer i, n, j double precision a(*), b(*), x, y do 11 i=1,n-1 do 10 j=i+1,n if(a(j).lt.a(i)) then x=a(j) y=a(i) a(i)=x a(j)=y x=b(j) y=b(i) b(i)=x b(j)=y end if 10 continue 11 continue return end c aitken repeated interpolation c xlne = abscissa at which interpolation is desired c xlnnrg = vector of n values of abscissa c xln_xs = vector of n values of ordinate c t = temporary storage vector of 4*(m+1) locations) double precision function aknint( xlne, n, xlnnrg, xln_xs) implicit none integer n, i, ii, j double precision t(20), xlne, xlnnrg(n), xln_xs( n) c executable code if(n .le. 2) then write(*,'(a)') ' aknint: too few points, funct=y(1)' aknint = xln_xs(1) return end if if (xlnnrg(2) .gt. xlnnrg(1)) then do 10 i = 1, n if (xlnnrg(i) .ge. xlne) go to 30 10 continue else do 20 i = 1, n if (xlnnrg(i) .le. xlne) go to 30 20 continue end if 30 continue ii = min(n-2, max(1, i-1)) do 40 i= ii, ii+2 t(i-ii+1) = xln_xs(i) t(i-ii+4) = xlnnrg(i)- xlne 40 continue do 70 i=1,2 do 60 j=i+1,3 t(j) = ( t(i)*t(j+3)-t(j)*t(i+3)) $ /( xlnnrg( j + ii - 1)- xlnnrg( i + ii - 1)) 60 continue 70 continue aknint= t(3) return end subroutine convl2(npts, x, y, gamma, xout, yout) c broaden the two arrays x and y with a lorentzian c arrays are assumed to be on the same even grid c c note: gamma is the lorentzian width in units of grid points!! implicit none integer npts, i, j double precision x(npts), y(npts), xout(npts), yout(npts) double precision gamma, sum, factr, zero, one, small double precision tmpx, tmpy, gami2 parameter (zero = 0.d0, one = 1.d0, small = 1.d-20) gamma = max(small, gamma) gami2 = one /(gamma*gamma) do 100 i = 1, npts sum = zero tmpx = zero tmpy = zero do 50 j = 1, npts factr = 1 / ( 1 + gami2 * (j-i) * (j-i) ) sum = sum + factr tmpx = tmpx + x(j) * factr tmpy = tmpy + y(j) * factr 50 continue yout(i) = tmpy / max (small, sum) xout(i) = tmpx / max (small, sum) 100 continue return end subroutine dkfit c part of diffkk c match the externally supplied mu(E) to f'' from CL, allowing c a band-limited differential KK transform to be done. here, we c set up for, and call to lmdif1, for a non-linear least-squares c fit using subroutine dkfcn. c include "dkcom.f" c#{dkcom.f: implicit none integer mpts,mdoc,mtitle,mvarys, npts,ndoc,ntitle integer iencol,imucol,iatz, npad, numvar parameter (mpts = 2**14, mdoc = 20, mtitle = 10, mvarys=20) double precision egrid, e0, elow, ehigh, ewidth double precision epad, xvarys(mvarys) double precision energy(mpts), f2ex(mpts), f2cl(mpts) character*100 doc(mdoc), title(mtitle), versn*6 character*100 inpfil, xmufil, outfil, label logical active, isfeff integer ne0, nelo, nehi, ne0ish, ne0dif, iprint common /dfkdat/ energy, f2ex, f2cl, xvarys, egrid, e0, elow, $ ehigh, ewidth, epad, npad, npts, ndoc, ntitle, iencol, $ imucol, ne0, nelo, nehi, ne0ish, ne0dif, iprint, $ iatz, numvar, active, isfeff common /dfkchr/ doc, title, label, inpfil, xmufil, outfil, $ versn save c#dkcom.f} integer lenwrk, lenfvc, lminfo, nofx, i, iwork(mvarys) parameter(lenwrk = 2*mpts*(mvarys + 1) + 20*mvarys ) parameter(lenfvc = mpts) double precision work(lenwrk), fvect(lenfvc), toler, etmp parameter (toler = 1.d-5) external nofx, dkfcn c make sure e0 is set if (e0.le.0) call findee(npts, energy, f2ex, e0) c find useful indices in the energy array ne0 = min(npts, max(1, nofx( e0 , energy, npts)) ) etmp = e0 - elow etmp = energy(1) nelo = min(npts, max(1, nofx( etmp, energy, npts)) ) etmp = energy(npts) - ehigh etmp = energy(npts) nehi = min(npts, max(1, nofx( etmp, energy, npts)) ) ne0ish = ne0 - 5 ne0dif = 200 cc ne0 = min(npts, max(1, nofx(e0,energy,npts))) nelo = int ( elow / egrid) nehi = npts - int(ehigh/ egrid) cc print*, "dkfit: ne0, nelo, nehi, ne0ish, ne0dif, npts" cc print*, ne0, nelo, nehi, ne0ish, ne0dif, npts cc print*, e0, elow, ehigh, egrid c initialize variables do 10 i = 1, mvarys xvarys(i) = 1.d0 10 continue c xvarys(4) and xvarys(5) should be pretty small xvarys(4) = 1.d-4 xvarys(5) = 1.d-6 numvar = 5 lminfo = 0 c call lmdif1 call lmdif1 (dkfcn, npts, numvar, xvarys, fvect, $ toler, lminfo, iwork, work, lenwrk) c done! return end subroutine dkfcn(m,n,x,f,iflag) c fitting function to match feff's mu to CL f'' c used by lmdif1, called in routine dkfit c include "dkcom.f" c#{dkcom.f: implicit none integer mpts,mdoc,mtitle,mvarys, npts,ndoc,ntitle integer iencol,imucol,iatz, npad, numvar parameter (mpts = 2**14, mdoc = 20, mtitle = 10, mvarys=20) double precision egrid, e0, elow, ehigh, ewidth double precision epad, xvarys(mvarys) double precision energy(mpts), f2ex(mpts), f2cl(mpts) character*100 doc(mdoc), title(mtitle), versn*6 character*100 inpfil, xmufil, outfil, label logical active, isfeff integer ne0, nelo, nehi, ne0ish, ne0dif, iprint common /dfkdat/ energy, f2ex, f2cl, xvarys, egrid, e0, elow, $ ehigh, ewidth, epad, npad, npts, ndoc, ntitle, iencol, $ imucol, ne0, nelo, nehi, ne0ish, ne0dif, iprint, $ iatz, numvar, active, isfeff common /dfkchr/ doc, title, label, inpfil, xmufil, outfil, $ versn save c#dkcom.f} integer m,n,iflag, i, ipos double precision x(n),f(m), de, shifte, f2new c ipos = 1 do 100 i = 1, npts shifte = energy(i) + x(1) call lintrp(energy,f2ex,npts,shifte,ipos,f2new) de = shifte - e0 f(i) = 0 if ((i.gt.nelo).and.(i.lt.nehi)) then f(i) = -f2cl(i) + x(2) + x(3) * f2new $ + de * (x(4) + x(5) * de ) end if cc if (abs(i-ne0).lt.ne0dif) f(i) = f(i) * (i - ne0)/ne0dif if ((i.gt.nelo).and.(i.le.ne0ish)) $ f(i) = f(i) * (i - nelo) / ne0dif 100 continue return end subroutine lmdif1(fcn,m,n,x,fvec,tol,info,iwa,wa,lwa) integer m,n,info,lwa integer iwa(n) double precision tol double precision x(n),fvec(m),wa(lwa) external fcn c ********** c c subroutine lmdif1 c c the purpose of lmdif1 is to minimize the sum of the squares of c m nonlinear functions in n variables by a modification of the c levenberg-marquardt algorithm. this is done by using the more c general least-squares solver lmdif. the user must provide a c subroutine which calculates the functions. the jacobian is c then calculated by a forward-difference approximation. c c the subroutine statement is c c subroutine lmdif1(fcn,m,n,x,fvec,tol,info,iwa,wa,lwa) c c where c c fcn is the name of the user-supplied subroutine which c calculates the functions. fcn must be declared c in an external statement in the user calling c program, and should be written as follows. c c subroutine fcn(m,n,x,fvec,iflag) c integer m,n,iflag c double precision x(n),fvec(m) c ---------- c calculate the functions at x and c return this vector in fvec. c ---------- c return c end c c the value of iflag should not be changed by fcn unless c the user wants to terminate execution of lmdif1. c in this case set iflag to a negative integer. c c m is a positive integer input variable set to the number c of functions. c c n is a positive integer input variable set to the number c of variables. n must not exceed m. c c x is an array of length n. on input x must contain c an initial estimate of the solution vector. on output x c contains the final estimate of the solution vector. c c fvec is an output array of length m which contains c the functions evaluated at the output x. c c tol is a nonnegative input variable. termination occurs c when the algorithm estimates either that the relative c error in the sum of squares is at most tol or that c the relative error between x and the solution is at c most tol. c c info is an integer output variable. if the user has c terminated execution, info is set to the (negative) c value of iflag. see description of fcn. otherwise, c info is set as follows. c c info = 0 improper input parameters. c c info = 1 algorithm estimates that the relative error c in the sum of squares is at most tol. c c info = 2 algorithm estimates that the relative error c between x and the solution is at most tol. c c info = 3 conditions for info = 1 and info = 2 both hold. c c info = 4 fvec is orthogonal to the columns of the c jacobian to machine precision. c c info = 5 number of calls to fcn has reached or c exceeded 200*(n+1). c c info = 6 tol is too small. no further reduction in c the sum of squares is possible. c c info = 7 tol is too small. no further improvement in c the approximate solution x is possible. c c iwa is an integer work array of length n. c c wa is a work array of length lwa. c c lwa is a positive integer input variable not less than c m*n+5*n+m. c c subprograms called c c user-supplied ...... fcn c c minpack-supplied ... lmdif c c argonne national laboratory. minpack project. march 1980. c burton s. garbow, kenneth e. hillstrom, jorge j. more c c ********** integer maxfev,mode,mp5n,nfev,nprint double precision epsfcn,factor,ftol,gtol,xtol,zero data factor,zero /1.0d2,0.0d0/ info = 0 c c check the input parameters for errors. c if (n .le. 0 .or. m .lt. n .or. tol .lt. zero * .or. lwa .lt. m*n + 5*n + m) go to 10 c c call lmdif. c maxfev = 200*(n + 1) ftol = tol xtol = tol gtol = zero epsfcn = zero mode = 1 nprint = 0 mp5n = m + 5*n call lmdif(fcn,m,n,x,fvec,ftol,xtol,gtol,maxfev,epsfcn,wa(1), * mode,factor,nprint,info,nfev,wa(mp5n+1),m,iwa, * wa(n+1),wa(2*n+1),wa(3*n+1),wa(4*n+1),wa(5*n+1)) if (info .eq. 8) info = 4 10 continue return c c last card of subroutine lmdif1. c end double precision function dpmpar(i) integer i c ********** c c Function dpmpar c c This function provides double precision machine parameters c when the appropriate set of data statements is activated (by c removing the c from column 1) and all other data statements are c rendered inactive. Most of the parameter values were obtained c from the corresponding Bell Laboratories Port Library function. c c The function statement is c c double precision function dpmpar(i) c c where c c i is an integer input variable set to 1, 2, or 3 which c selects the desired machine parameter. If the machine has c t base b digits and its smallest and largest exponents are c emin and emax, respectively, then these parameters are c c dpmpar(1) = b**(1 - t), the machine precision, c c dpmpar(2) = b**(emin - 1), the smallest magnitude, c c dpmpar(3) = b**emax*(1 - b**(-t)), the largest magnitude. c c Argonne National Laboratory. MINPACK Project. November 1996. c Burton S. Garbow, Kenneth E. Hillstrom, Jorge J. More' c c ********** integer mcheps(4) integer minmag(4) integer maxmag(4) double precision dmach(3) equivalence (dmach(1),mcheps(1)) equivalence (dmach(2),minmag(1)) equivalence (dmach(3),maxmag(1)) c c Machine constants for the IBM 360/370 series, c the Amdahl 470/V6, the ICL 2900, the Itel AS/6, c the Xerox Sigma 5/7/9 and the Sel systems 85/86. c c data mcheps(1),mcheps(2) / z34100000, z00000000 / c data minmag(1),minmag(2) / z00100000, z00000000 / c data maxmag(1),maxmag(2) / z7fffffff, zffffffff / c c Machine constants for the Honeywell 600/6000 series. c c data mcheps(1),mcheps(2) / o606400000000, o000000000000 / c data minmag(1),minmag(2) / o402400000000, o000000000000 / c data maxmag(1),maxmag(2) / o376777777777, o777777777777 / c c Machine constants for the CDC 6000/7000 series. c c data mcheps(1) / 15614000000000000000b / c data mcheps(2) / 15010000000000000000b / c c data minmag(1) / 00604000000000000000b / c data minmag(2) / 00000000000000000000b / c c data maxmag(1) / 37767777777777777777b / c data maxmag(2) / 37167777777777777777b / c c Machine constants for the PDP-10 (KA processor). c c data mcheps(1),mcheps(2) / "114400000000, "000000000000 / c data minmag(1),minmag(2) / "033400000000, "000000000000 / c data maxmag(1),maxmag(2) / "377777777777, "344777777777 / c c Machine constants for the PDP-10 (KI processor). c c data mcheps(1),mcheps(2) / "104400000000, "000000000000 / c data minmag(1),minmag(2) / "000400000000, "000000000000 / c data maxmag(1),maxmag(2) / "377777777777, "377777777777 / c c Machine constants for the PDP-11. c c data mcheps(1),mcheps(2) / 9472, 0 / c data mcheps(3),mcheps(4) / 0, 0 / c c data minmag(1),minmag(2) / 128, 0 / c data minmag(3),minmag(4) / 0, 0 / c c data maxmag(1),maxmag(2) / 32767, -1 / c data maxmag(3),maxmag(4) / -1, -1 / c c Machine constants for the Burroughs 6700/7700 systems. c c data mcheps(1) / o1451000000000000 / c data mcheps(2) / o0000000000000000 / c c data minmag(1) / o1771000000000000 / c data minmag(2) / o7770000000000000 / c c data maxmag(1) / o0777777777777777 / c data maxmag(2) / o7777777777777777 / c c Machine constants for the Burroughs 5700 system. c c data mcheps(1) / o1451000000000000 / c data mcheps(2) / o0000000000000000 / c c data minmag(1) / o1771000000000000 / c data minmag(2) / o0000000000000000 / c c data maxmag(1) / o0777777777777777 / c data maxmag(2) / o0007777777777777 / c c Machine constants for the Burroughs 1700 system. c c data mcheps(1) / zcc6800000 / c data mcheps(2) / z000000000 / c c data minmag(1) / zc00800000 / c data minmag(2) / z000000000 / c c data maxmag(1) / zdffffffff / c data maxmag(2) / zfffffffff / c c Machine constants for the Univac 1100 series. c c data mcheps(1),mcheps(2) / o170640000000, o000000000000 / c data minmag(1),minmag(2) / o000040000000, o000000000000 / c data maxmag(1),maxmag(2) / o377777777777, o777777777777 / c c Machine constants for the Data General Eclipse S/200. c c Note - it may be appropriate to include the following card - c static dmach(3) c c data minmag/20k,3*0/,maxmag/77777k,3*177777k/ c data mcheps/32020k,3*0/ c c Machine constants for the Harris 220. c c data mcheps(1),mcheps(2) / '20000000, '00000334 / c data minmag(1),minmag(2) / '20000000, '00000201 / c data maxmag(1),maxmag(2) / '37777777, '37777577 / c c Machine constants for the Cray-1. c c data mcheps(1) / 0376424000000000000000b / c data mcheps(2) / 0000000000000000000000b / c c data minmag(1) / 0200034000000000000000b / c data minmag(2) / 0000000000000000000000b / c c data maxmag(1) / 0577777777777777777777b / c data maxmag(2) / 0000007777777777777776b / c c Machine constants for the Prime 400. c c data mcheps(1),mcheps(2) / :10000000000, :00000000123 / c data minmag(1),minmag(2) / :10000000000, :00000100000 / c data maxmag(1),maxmag(2) / :17777777777, :37777677776 / c c Machine constants for the VAX-11. c c data mcheps(1),mcheps(2) / 9472, 0 / c data minmag(1),minmag(2) / 128, 0 / c data maxmag(1),maxmag(2) / -32769, -1 / c c Machine constants for IEEE machines. c data dmach(1) /2.22044604926d-16/ data dmach(2) /2.22507385852d-308/ data dmach(3) /1.79769313485d+308/ c dpmpar = dmach(i) return c c Last card of function dpmpar. c end double precision function enorm(n,x) integer n double precision x(n) c ********** c c function enorm c c given an n-vector x, this function calculates the c euclidean norm of x. c c the euclidean norm is computed by accumulating the sum of c squares in three different sums. the sums of squares for the c small and large components are scaled so that no overflows c occur. non-destructive underflows are permitted. underflows c and overflows do not occur in the computation of the unscaled c sum of squares for the intermediate components. c the definitions of small, intermediate and large components c depend on two constants, rdwarf and rgiant. the main c restrictions on these constants are that rdwarf**2 not c underflow and rgiant**2 not overflow. the constants c given here are suitable for every known computer. c c the function statement is c c double precision function enorm(n,x) c c where c c n is a positive integer input variable. c c x is an input array of length n. c c subprograms called c c fortran-supplied ... dabs,dsqrt c c argonne national laboratory. minpack project. march 1980. c burton s. garbow, kenneth e. hillstrom, jorge j. more c c ********** integer i double precision agiant,floatn,one,rdwarf,rgiant,s1,s2,s3,xabs, * x1max,x3max,zero data one,zero,rdwarf,rgiant /1.0d0,0.0d0,3.834d-20,1.304d19/ s1 = zero s2 = zero s3 = zero x1max = zero x3max = zero floatn = n agiant = rgiant/floatn do 90 i = 1, n xabs = dabs(x(i)) if (xabs .gt. rdwarf .and. xabs .lt. agiant) go to 70 if (xabs .le. rdwarf) go to 30 c c sum for large components. c if (xabs .le. x1max) go to 10 s1 = one + s1*(x1max/xabs)**2 x1max = xabs go to 20 10 continue s1 = s1 + (xabs/x1max)**2 20 continue go to 60 30 continue c c sum for small components. c if (xabs .le. x3max) go to 40 s3 = one + s3*(x3max/xabs)**2 x3max = xabs go to 50 40 continue if (xabs .ne. zero) s3 = s3 + (xabs/x3max)**2 50 continue 60 continue go to 80 70 continue c c sum for intermediate components. c s2 = s2 + xabs**2 80 continue 90 continue c c calculation of norm. c if (s1 .eq. zero) go to 100 enorm = x1max*dsqrt(s1+(s2/x1max)/x1max) go to 130 100 continue if (s2 .eq. zero) go to 110 if (s2 .ge. x3max) * enorm = dsqrt(s2*(one+(x3max/s2)*(x3max*s3))) if (s2 .lt. x3max) * enorm = dsqrt(x3max*((s2/x3max)+(x3max*s3))) go to 120 110 continue enorm = x3max*dsqrt(s3) 120 continue 130 continue return c c last card of function enorm. c end subroutine fdjac2(fcn,m,n,x,fvec,fjac,ldfjac,iflag,epsfcn,wa) integer m,n,ldfjac,iflag double precision epsfcn double precision x(n),fvec(m),fjac(ldfjac,n),wa(m) c ********** c c subroutine fdjac2 c c this subroutine computes a forward-difference approximation c to the m by n jacobian matrix associated with a specified c problem of m functions in n variables. c c the subroutine statement is c c subroutine fdjac2(fcn,m,n,x,fvec,fjac,ldfjac,iflag,epsfcn,wa) c c where c c fcn is the name of the user-supplied subroutine which c calculates the functions. fcn must be declared c in an external statement in the user calling c program, and should be written as follows. c c subroutine fcn(m,n,x,fvec,iflag) c integer m,n,iflag c double precision x(n),fvec(m) c ---------- c calculate the functions at x and c return this vector in fvec. c ---------- c return c end c c the value of iflag should not be changed by fcn unless c the user wants to terminate execution of fdjac2. c in this case set iflag to a negative integer. c c m is a positive integer input variable set to the number c of functions. c c n is a positive integer input variable set to the number c of variables. n must not exceed m. c c x is an input array of length n. c c fvec is an input array of length m which must contain the c functions evaluated at x. c c fjac is an output m by n array which contains the c approximation to the jacobian matrix evaluated at x. c c ldfjac is a positive integer input variable not less than m c which specifies the leading dimension of the array fjac. c c iflag is an integer variable which can be used to terminate c the execution of fdjac2. see description of fcn. c c epsfcn is an input variable used in determining a suitable c step length for the forward-difference approximation. this c approximation assumes that the relative errors in the c functions are of the order of epsfcn. if epsfcn is less c than the machine precision, it is assumed that the relative c errors in the functions are of the order of the machine c precision. c c wa is a work array of length m. c c subprograms called c c user-supplied ...... fcn c c minpack-supplied ... dpmpar c c fortran-supplied ... dabs,dmax1,dsqrt c c argonne national laboratory. minpack project. march 1980. c burton s. garbow, kenneth e. hillstrom, jorge j. more c c ********** integer i,j double precision eps,epsmch,h,temp,zero double precision dpmpar data zero /0.0d0/ c c epsmch is the machine precision. c epsmch = dpmpar(1) c eps = dsqrt(dmax1(epsfcn,epsmch)) do 20 j = 1, n temp = x(j) h = eps*dabs(temp) if (h .eq. zero) h = eps x(j) = temp + h call fcn(m,n,x,wa,iflag) if (iflag .lt. 0) go to 30 x(j) = temp do 10 i = 1, m fjac(i,j) = (wa(i) - fvec(i))/h 10 continue 20 continue 30 continue return c c last card of subroutine fdjac2. c end subroutine lmdif(fcn,m,n,x,fvec,ftol,xtol,gtol,maxfev,epsfcn, * diag,mode,factor,nprint,info,nfev,fjac,ldfjac, * ipvt,qtf,wa1,wa2,wa3,wa4) integer m,n,maxfev,mode,nprint,info,nfev,ldfjac integer ipvt(n) double precision ftol,xtol,gtol,epsfcn,factor double precision x(n),fvec(m),diag(n),fjac(ldfjac,n),qtf(n), * wa1(n),wa2(n),wa3(n),wa4(m) external fcn c ********** c c subroutine lmdif c c the purpose of lmdif is to minimize the sum of the squares of c m nonlinear functions in n variables by a modification of c the levenberg-marquardt algorithm. the user must provide a c subroutine which calculates the functions. the jacobian is c then calculated by a forward-difference approximation. c c the subroutine statement is c c subroutine lmdif(fcn,m,n,x,fvec,ftol,xtol,gtol,maxfev,epsfcn, c diag,mode,factor,nprint,info,nfev,fjac, c ldfjac,ipvt,qtf,wa1,wa2,wa3,wa4) c c where c c fcn is the name of the user-supplied subroutine which c calculates the functions. fcn must be declared c in an external statement in the user calling c program, and should be written as follows. c c subroutine fcn(m,n,x,fvec,iflag) c integer m,n,iflag c double precision x(n),fvec(m) c ---------- c calculate the functions at x and c return this vector in fvec. c ---------- c return c end c c the value of iflag should not be changed by fcn unless c the user wants to terminate execution of lmdif. c in this case set iflag to a negative integer. c c m is a positive integer input variable set to the number c of functions. c c n is a positive integer input variable set to the number c of variables. n must not exceed m. c c x is an array of length n. on input x must contain c an initial estimate of the solution vector. on output x c contains the final estimate of the solution vector. c c fvec is an output array of length m which contains c the functions evaluated at the output x. c c ftol is a nonnegative input variable. termination c occurs when both the actual and predicted relative c reductions in the sum of squares are at most ftol. c therefore, ftol measures the relative error desired c in the sum of squares. c c xtol is a nonnegative input variable. termination c occurs when the relative error between two consecutive c iterates is at most xtol. therefore, xtol measures the c relative error desired in the approximate solution. c c gtol is a nonnegative input variable. termination c occurs when the cosine of the angle between fvec and c any column of the jacobian is at most gtol in absolute c value. therefore, gtol measures the orthogonality c desired between the function vector and the columns c of the jacobian. c c maxfev is a positive integer input variable. termination c occurs when the number of calls to fcn is at least c maxfev by the end of an iteration. c c epsfcn is an input variable used in determining a suitable c step length for the forward-difference approximation. this c approximation assumes that the relative errors in the c functions are of the order of epsfcn. if epsfcn is less c than the machine precision, it is assumed that the relative c errors in the functions are of the order of the machine c precision. c c diag is an array of length n. if mode = 1 (see c below), diag is internally set. if mode = 2, diag c must contain positive entries that serve as c multiplicative scale factors for the variables. c c mode is an integer input variable. if mode = 1, the c variables will be scaled internally. if mode = 2, c the scaling is specified by the input diag. other c values of mode are equivalent to mode = 1. c c factor is a positive input variable used in determining the c initial step bound. this bound is set to the product of c factor and the euclidean norm of diag*x if nonzero, or else c to factor itself. in most cases factor should lie in the c interval (.1,100.). 100. is a generally recommended value. c c nprint is an integer input variable that enables controlled c printing of iterates if it is positive. in this case, c fcn is called with iflag = 0 at the beginning of the first c iteration and every nprint iterations thereafter and c immediately prior to return, with x and fvec available c for printing. if nprint is not positive, no special calls c of fcn with iflag = 0 are made. c c info is an integer output variable. if the user has c terminated execution, info is set to the (negative) c value of iflag. see description of fcn. otherwise, c info is set as follows. c c info = 0 improper input parameters. c c info = 1 both actual and predicted relative reductions c in the sum of squares are at most ftol. c c info = 2 relative error between two consecutive iterates c is at most xtol. c c info = 3 conditions for info = 1 and info = 2 both hold. c c info = 4 the cosine of the angle between fvec and any c column of the jacobian is at most gtol in c absolute value. c c info = 5 number of calls to fcn has reached or c exceeded maxfev. c c info = 6 ftol is too small. no further reduction in c the sum of squares is possible. c c info = 7 xtol is too small. no further improvement in c the approximate solution x is possible. c c info = 8 gtol is too small. fvec is orthogonal to the c columns of the jacobian to machine precision. c c nfev is an integer output variable set to the number of c calls to fcn. c c fjac is an output m by n array. the upper n by n submatrix c of fjac contains an upper triangular matrix r with c diagonal elements of nonincreasing magnitude such that c c t t t c p *(jac *jac)*p = r *r, c c where p is a permutation matrix and jac is the final c calculated jacobian. column j of p is column ipvt(j) c (see below) of the identity matrix. the lower trapezoidal c part of fjac contains information generated during c the computation of r. c c ldfjac is a positive integer input variable not less than m c which specifies the leading dimension of the array fjac. c c ipvt is an integer output array of length n. ipvt c defines a permutation matrix p such that jac*p = q*r, c where jac is the final calculated jacobian, q is c orthogonal (not stored), and r is upper triangular c with diagonal elements of nonincreasing magnitude. c column j of p is column ipvt(j) of the identity matrix. c c qtf is an output array of length n which contains c the first n elements of the vector (q transpose)*fvec. c c wa1, wa2, and wa3 are work arrays of length n. c c wa4 is a work array of length m. c c subprograms called c c user-supplied ...... fcn c c minpack-supplied ... dpmpar,enorm,fdjac2,lmpar,qrfac c c fortran-supplied ... dabs,dmax1,dmin1,dsqrt,mod c c argonne national laboratory. minpack project. march 1980. c burton s. garbow, kenneth e. hillstrom, jorge j. more c c ********** integer i,iflag,iter,j,l double precision actred,delta,dirder,epsmch,fnorm,fnorm1,gnorm, * one,par,pnorm,prered,p1,p5,p25,p75,p0001,ratio, * sum,temp,temp1,temp2,xnorm,zero double precision dpmpar,enorm data one,p1,p5,p25,p75,p0001,zero * /1.0d0,1.0d-1,5.0d-1,2.5d-1,7.5d-1,1.0d-4,0.0d0/ c c epsmch is the machine precision. c epsmch = dpmpar(1) c info = 0 iflag = 0 nfev = 0 c c check the input parameters for errors. c if (n .le. 0 .or. m .lt. n .or. ldfjac .lt. m * .or. ftol .lt. zero .or. xtol .lt. zero .or. gtol .lt. zero * .or. maxfev .le. 0 .or. factor .le. zero) go to 300 if (mode .ne. 2) go to 20 do 10 j = 1, n if (diag(j) .le. zero) go to 300 10 continue 20 continue c c evaluate the function at the starting point c and calculate its norm. c iflag = 1 call fcn(m,n,x,fvec,iflag) nfev = 1 if (iflag .lt. 0) go to 300 fnorm = enorm(m,fvec) c c initialize levenberg-marquardt parameter and iteration counter. c par = zero iter = 1 c c beginning of the outer loop. c 30 continue c c calculate the jacobian matrix. c iflag = 2 call fdjac2(fcn,m,n,x,fvec,fjac,ldfjac,iflag,epsfcn,wa4) nfev = nfev + n if (iflag .lt. 0) go to 300 c c if requested, call fcn to enable printing of iterates. c if (nprint .le. 0) go to 40 iflag = 0 if (mod(iter-1,nprint) .eq. 0) call fcn(m,n,x,fvec,iflag) if (iflag .lt. 0) go to 300 40 continue c c compute the qr factorization of the jacobian. c call qrfac(m,n,fjac,ldfjac,.true.,ipvt,n,wa1,wa2,wa3) c c on the first iteration and if mode is 1, scale according c to the norms of the columns of the initial jacobian. c if (iter .ne. 1) go to 80 if (mode .eq. 2) go to 60 do 50 j = 1, n diag(j) = wa2(j) if (wa2(j) .eq. zero) diag(j) = one 50 continue 60 continue c c on the first iteration, calculate the norm of the scaled x c and initialize the step bound delta. c do 70 j = 1, n wa3(j) = diag(j)*x(j) 70 continue xnorm = enorm(n,wa3) delta = factor*xnorm if (delta .eq. zero) delta = factor 80 continue c c form (q transpose)*fvec and store the first n components in c qtf. c do 90 i = 1, m wa4(i) = fvec(i) 90 continue do 130 j = 1, n if (fjac(j,j) .eq. zero) go to 120 sum = zero do 100 i = j, m sum = sum + fjac(i,j)*wa4(i) 100 continue temp = -sum/fjac(j,j) do 110 i = j, m wa4(i) = wa4(i) + fjac(i,j)*temp 110 continue 120 continue fjac(j,j) = wa1(j) qtf(j) = wa4(j) 130 continue c c compute the norm of the scaled gradient. c gnorm = zero if (fnorm .eq. zero) go to 170 do 160 j = 1, n l = ipvt(j) if (wa2(l) .eq. zero) go to 150 sum = zero do 140 i = 1, j sum = sum + fjac(i,j)*(qtf(i)/fnorm) 140 continue gnorm = dmax1(gnorm,dabs(sum/wa2(l))) 150 continue 160 continue 170 continue c c test for convergence of the gradient norm. c if (gnorm .le. gtol) info = 4 if (info .ne. 0) go to 300 c c rescale if necessary. c if (mode .eq. 2) go to 190 do 180 j = 1, n diag(j) = dmax1(diag(j),wa2(j)) 180 continue 190 continue c c beginning of the inner loop. c 200 continue c c determine the levenberg-marquardt parameter. c call lmpar(n,fjac,ldfjac,ipvt,diag,qtf,delta,par,wa1,wa2, * wa3,wa4) c c store the direction p and x + p. calculate the norm of p. c do 210 j = 1, n wa1(j) = -wa1(j) wa2(j) = x(j) + wa1(j) wa3(j) = diag(j)*wa1(j) 210 continue pnorm = enorm(n,wa3) c c on the first iteration, adjust the initial step bound. c if (iter .eq. 1) delta = dmin1(delta,pnorm) c c evaluate the function at x + p and calculate its norm. c iflag = 1 call fcn(m,n,wa2,wa4,iflag) nfev = nfev + 1 if (iflag .lt. 0) go to 300 fnorm1 = enorm(m,wa4) c c compute the scaled actual reduction. c actred = -one if (p1*fnorm1 .lt. fnorm) actred = one - (fnorm1/fnorm)**2 c c compute the scaled predicted reduction and c the scaled directional derivative. c do 230 j = 1, n wa3(j) = zero l = ipvt(j) temp = wa1(l) do 220 i = 1, j wa3(i) = wa3(i) + fjac(i,j)*temp 220 continue 230 continue temp1 = enorm(n,wa3)/fnorm temp2 = (dsqrt(par)*pnorm)/fnorm prered = temp1**2 + temp2**2/p5 dirder = -(temp1**2 + temp2**2) c c compute the ratio of the actual to the predicted c reduction. c ratio = zero if (prered .ne. zero) ratio = actred/prered c c update the step bound. c if (ratio .gt. p25) go to 240 if (actred .ge. zero) temp = p5 if (actred .lt. zero) * temp = p5*dirder/(dirder + p5*actred) if (p1*fnorm1 .ge. fnorm .or. temp .lt. p1) temp = p1 delta = temp*dmin1(delta,pnorm/p1) par = par/temp go to 260 240 continue if (par .ne. zero .and. ratio .lt. p75) go to 250 delta = pnorm/p5 par = p5*par 250 continue 260 continue c c test for successful iteration. c if (ratio .lt. p0001) go to 290 c c successful iteration. update x, fvec, and their norms. c do 270 j = 1, n x(j) = wa2(j) wa2(j) = diag(j)*x(j) 270 continue do 280 i = 1, m fvec(i) = wa4(i) 280 continue xnorm = enorm(n,wa2) fnorm = fnorm1 iter = iter + 1 290 continue c c tests for convergence. c if (dabs(actred) .le. ftol .and. prered .le. ftol * .and. p5*ratio .le. one) info = 1 if (delta .le. xtol*xnorm) info = 2 if (dabs(actred) .le. ftol .and. prered .le. ftol * .and. p5*ratio .le. one .and. info .eq. 2) info = 3 if (info .ne. 0) go to 300 c c tests for termination and stringent tolerances. c if (nfev .ge. maxfev) info = 5 if (dabs(actred) .le. epsmch .and. prered .le. epsmch * .and. p5*ratio .le. one) info = 6 if (delta .le. epsmch*xnorm) info = 7 if (gnorm .le. epsmch) info = 8 if (info .ne. 0) go to 300 c c end of the inner loop. repeat if iteration unsuccessful. c if (ratio .lt. p0001) go to 200 c c end of the outer loop. c go to 30 300 continue c c termination, either normal or user imposed. c if (iflag .lt. 0) info = iflag iflag = 0 if (nprint .gt. 0) call fcn(m,n,x,fvec,iflag) return c c last card of subroutine lmdif. c end subroutine lmpar(n,r,ldr,ipvt,diag,qtb,delta,par,x,sdiag,wa1, * wa2) integer n,ldr integer ipvt(n) double precision delta,par double precision r(ldr,n),diag(n),qtb(n),x(n),sdiag(n),wa1(n), * wa2(n) c ********** c c subroutine lmpar c c given an m by n matrix a, an n by n nonsingular diagonal c matrix d, an m-vector b, and a positive number delta, c the problem is to determine a value for the parameter c par such that if x solves the system c c a*x = b , sqrt(par)*d*x = 0 , c c in the least squares sense, and dxnorm is the euclidean c norm of d*x, then either par is zero and c c (dxnorm-delta) .le. 0.1*delta , c c or par is positive and c c abs(dxnorm-delta) .le. 0.1*delta . c c this subroutine completes the solution of the problem c if it is provided with the necessary information from the c qr factorization, with column pivoting, of a. that is, if c a*p = q*r, where p is a permutation matrix, q has orthogonal c columns, and r is an upper triangular matrix with diagonal c elements of nonincreasing magnitude, then lmpar expects c the full upper triangle of r, the permutation matrix p, c and the first n components of (q transpose)*b. on output c lmpar also provides an upper triangular matrix s such that c c t t t c p *(a *a + par*d*d)*p = s *s . c c s is employed within lmpar and may be of separate interest. c c only a few iterations are generally needed for convergence c of the algorithm. if, however, the limit of 10 iterations c is reached, then the output par will contain the best c value obtained so far. c c the subroutine statement is c c subroutine lmpar(n,r,ldr,ipvt,diag,qtb,delta,par,x,sdiag, c wa1,wa2) c c where c c n is a positive integer input variable set to the order of r. c c r is an n by n array. on input the full upper triangle c must contain the full upper triangle of the matrix r. c on output the full upper triangle is unaltered, and the c strict lower triangle contains the strict upper triangle c (transposed) of the upper triangular matrix s. c c ldr is a positive integer input variable not less than n c which specifies the leading dimension of the array r. c c ipvt is an integer input array of length n which defines the c permutation matrix p such that a*p = q*r. column j of p c is column ipvt(j) of the identity matrix. c c diag is an input array of length n which must contain the c diagonal elements of the matrix d. c c qtb is an input array of length n which must contain the first c n elements of the vector (q transpose)*b. c c delta is a positive input variable which specifies an upper c bound on the euclidean norm of d*x. c c par is a nonnegative variable. on input par contains an c initial estimate of the levenberg-marquardt parameter. c on output par contains the final estimate. c c x is an output array of length n which contains the least c squares solution of the system a*x = b, sqrt(par)*d*x = 0, c for the output par. c c sdiag is an output array of length n which contains the c diagonal elements of the upper triangular matrix s. c c wa1 and wa2 are work arrays of length n. c c subprograms called c c minpack-supplied ... dpmpar,enorm,qrsolv c c fortran-supplied ... dabs,dmax1,dmin1,dsqrt c c argonne national laboratory. minpack project. march 1980. c burton s. garbow, kenneth e. hillstrom, jorge j. more c c ********** integer i,iter,j,jm1,jp1,k,l,nsing double precision dxnorm,dwarf,fp,gnorm,parc,parl,paru,p1,p001, * sum,temp,zero double precision dpmpar,enorm data p1,p001,zero /1.0d-1,1.0d-3,0.0d0/ c c dwarf is the smallest positive magnitude. c dwarf = dpmpar(2) c c compute and store in x the gauss-newton direction. if the c jacobian is rank-deficient, obtain a least squares solution. c nsing = n do 10 j = 1, n wa1(j) = qtb(j) if (r(j,j) .eq. zero .and. nsing .eq. n) nsing = j - 1 if (nsing .lt. n) wa1(j) = zero 10 continue if (nsing .lt. 1) go to 50 do 40 k = 1, nsing j = nsing - k + 1 wa1(j) = wa1(j)/r(j,j) temp = wa1(j) jm1 = j - 1 if (jm1 .lt. 1) go to 30 do 20 i = 1, jm1 wa1(i) = wa1(i) - r(i,j)*temp 20 continue 30 continue 40 continue 50 continue do 60 j = 1, n l = ipvt(j) x(l) = wa1(j) 60 continue c c initialize the iteration counter. c evaluate the function at the origin, and test c for acceptance of the gauss-newton direction. c iter = 0 do 70 j = 1, n wa2(j) = diag(j)*x(j) 70 continue dxnorm = enorm(n,wa2) fp = dxnorm - delta if (fp .le. p1*delta) go to 220 c c if the jacobian is not rank deficient, the newton c step provides a lower bound, parl, for the zero of c the function. otherwise set this bound to zero. c parl = zero if (nsing .lt. n) go to 120 do 80 j = 1, n l = ipvt(j) wa1(j) = diag(l)*(wa2(l)/dxnorm) 80 continue do 110 j = 1, n sum = zero jm1 = j - 1 if (jm1 .lt. 1) go to 100 do 90 i = 1, jm1 sum = sum + r(i,j)*wa1(i) 90 continue 100 continue wa1(j) = (wa1(j) - sum)/r(j,j) 110 continue temp = enorm(n,wa1) parl = ((fp/delta)/temp)/temp 120 continue c c calculate an upper bound, paru, for the zero of the function. c do 140 j = 1, n sum = zero do 130 i = 1, j sum = sum + r(i,j)*qtb(i) 130 continue l = ipvt(j) wa1(j) = sum/diag(l) 140 continue gnorm = enorm(n,wa1) paru = gnorm/delta if (paru .eq. zero) paru = dwarf/dmin1(delta,p1) c c if the input par lies outside of the interval (parl,paru), c set par to the closer endpoint. c par = dmax1(par,parl) par = dmin1(par,paru) if (par .eq. zero) par = gnorm/dxnorm c c beginning of an iteration. c 150 continue iter = iter + 1 c c evaluate the function at the current value of par. c if (par .eq. zero) par = dmax1(dwarf,p001*paru) temp = dsqrt(par) do 160 j = 1, n wa1(j) = temp*diag(j) 160 continue call qrsolv(n,r,ldr,ipvt,wa1,qtb,x,sdiag,wa2) do 170 j = 1, n wa2(j) = diag(j)*x(j) 170 continue dxnorm = enorm(n,wa2) temp = fp fp = dxnorm - delta c c if the function is small enough, accept the current value c of par. also test for the exceptional cases where parl c is zero or the number of iterations has reached 10. c if (dabs(fp) .le. p1*delta * .or. parl .eq. zero .and. fp .le. temp * .and. temp .lt. zero .or. iter .eq. 10) go to 220 c c compute the newton correction. c do 180 j = 1, n l = ipvt(j) wa1(j) = diag(l)*(wa2(l)/dxnorm) 180 continue do 210 j = 1, n wa1(j) = wa1(j)/sdiag(j) temp = wa1(j) jp1 = j + 1 if (n .lt. jp1) go to 200 do 190 i = jp1, n wa1(i) = wa1(i) - r(i,j)*temp 190 continue 200 continue 210 continue temp = enorm(n,wa1) parc = ((fp/delta)/temp)/temp c c depending on the sign of the function, update parl or paru. c if (fp .gt. zero) parl = dmax1(parl,par) if (fp .lt. zero) paru = dmin1(paru,par) c c compute an improved estimate for par. c par = dmax1(parl,par+parc) c c end of an iteration. c go to 150 220 continue c c termination. c if (iter .eq. 0) par = zero return c c last card of subroutine lmpar. c end subroutine qrfac(m,n,a,lda,pivot,ipvt,lipvt,rdiag,acnorm,wa) integer m,n,lda,lipvt integer ipvt(lipvt) logical pivot double precision a(lda,n),rdiag(n),acnorm(n),wa(n) c ********** c c subroutine qrfac c c this subroutine uses householder transformations with column c pivoting (optional) to compute a qr factorization of the c m by n matrix a. that is, qrfac determines an orthogonal c matrix q, a permutation matrix p, and an upper trapezoidal c matrix r with diagonal elements of nonincreasing magnitude, c such that a*p = q*r. the householder transformation for c column k, k = 1,2,...,min(m,n), is of the form c c t c i - (1/u(k))*u*u c c where u has zeros in the first k-1 positions. the form of c this transformation and the method of pivoting first c appeared in the corresponding linpack subroutine. c c the subroutine statement is c c subroutine qrfac(m,n,a,lda,pivot,ipvt,lipvt,rdiag,acnorm,wa) c c where c c m is a positive integer input variable set to the number c of rows of a. c c n is a positive integer input variable set to the number c of columns of a. c c a is an m by n array. on input a contains the matrix for c which the qr factorization is to be computed. on output c the strict upper trapezoidal part of a contains the strict c upper trapezoidal part of r, and the lower trapezoidal c part of a contains a factored form of q (the non-trivial c elements of the u vectors described above). c c lda is a positive integer input variable not less than m c which specifies the leading dimension of the array a. c c pivot is a logical input variable. if pivot is set true, c then column pivoting is enforced. if pivot is set false, c then no column pivoting is done. c c ipvt is an integer output array of length lipvt. ipvt c defines the permutation matrix p such that a*p = q*r. c column j of p is column ipvt(j) of the identity matrix. c if pivot is false, ipvt is not referenced. c c lipvt is a positive integer input variable. if pivot is false, c then lipvt may be as small as 1. if pivot is true, then c lipvt must be at least n. c c rdiag is an output array of length n which contains the c diagonal elements of r. c c acnorm is an output array of length n which contains the c norms of the corresponding columns of the input matrix a. c if this information is not needed, then acnorm can coincide c with rdiag. c c wa is a work array of length n. if pivot is false, then wa c can coincide with rdiag. c c subprograms called c c minpack-supplied ... dpmpar,enorm c c fortran-supplied ... dmax1,dsqrt,min0 c c argonne national laboratory. minpack project. march 1980. c burton s. garbow, kenneth e. hillstrom, jorge j. more c c ********** integer i,j,jp1,k,kmax,minmn double precision ajnorm,epsmch,one,p05,sum,temp,zero double precision dpmpar,enorm data one,p05,zero /1.0d0,5.0d-2,0.0d0/ c c epsmch is the machine precision. c epsmch = dpmpar(1) c c compute the initial column norms and initialize several arrays. c do 10 j = 1, n acnorm(j) = enorm(m,a(1,j)) rdiag(j) = acnorm(j) wa(j) = rdiag(j) if (pivot) ipvt(j) = j 10 continue c c reduce a to r with householder transformations. c minmn = min0(m,n) do 110 j = 1, minmn if (.not.pivot) go to 40 c c bring the column of largest norm into the pivot position. c kmax = j do 20 k = j, n if (rdiag(k) .gt. rdiag(kmax)) kmax = k 20 continue if (kmax .eq. j) go to 40 do 30 i = 1, m temp = a(i,j) a(i,j) = a(i,kmax) a(i,kmax) = temp 30 continue rdiag(kmax) = rdiag(j) wa(kmax) = wa(j) k = ipvt(j) ipvt(j) = ipvt(kmax) ipvt(kmax) = k 40 continue c c compute the householder transformation to reduce the c j-th column of a to a multiple of the j-th unit vector. c ajnorm = enorm(m-j+1,a(j,j)) if (ajnorm .eq. zero) go to 100 if (a(j,j) .lt. zero) ajnorm = -ajnorm do 50 i = j, m a(i,j) = a(i,j)/ajnorm 50 continue a(j,j) = a(j,j) + one c c apply the transformation to the remaining columns c and update the norms. c jp1 = j + 1 if (n .lt. jp1) go to 100 do 90 k = jp1, n sum = zero do 60 i = j, m sum = sum + a(i,j)*a(i,k) 60 continue temp = sum/a(j,j) do 70 i = j, m a(i,k) = a(i,k) - temp*a(i,j) 70 continue if (.not.pivot .or. rdiag(k) .eq. zero) go to 80 temp = a(j,k)/rdiag(k) rdiag(k) = rdiag(k)*dsqrt(dmax1(zero,one-temp**2)) if (p05*(rdiag(k)/wa(k))**2 .gt. epsmch) go to 80 rdiag(k) = enorm(m-j,a(jp1,k)) wa(k) = rdiag(k) 80 continue 90 continue 100 continue rdiag(j) = -ajnorm 110 continue return c c last card of subroutine qrfac. c end subroutine qrsolv(n,r,ldr,ipvt,diag,qtb,x,sdiag,wa) integer n,ldr integer ipvt(n) double precision r(ldr,n),diag(n),qtb(n),x(n),sdiag(n),wa(n) c ********** c c subroutine qrsolv c c given an m by n matrix a, an n by n diagonal matrix d, c and an m-vector b, the problem is to determine an x which c solves the system c c a*x = b , d*x = 0 , c c in the least squares sense. c c this subroutine completes the solution of the problem c if it is provided with the necessary information from the c qr factorization, with column pivoting, of a. that is, if c a*p = q*r, where p is a permutation matrix, q has orthogonal c columns, and r is an upper triangular matrix with diagonal c elements of nonincreasing magnitude, then qrsolv expects c the full upper triangle of r, the permutation matrix p, c and the first n components of (q transpose)*b. the system c a*x = b, d*x = 0, is then equivalent to c c t t c r*z = q *b , p *d*p*z = 0 , c c where x = p*z. if this system does not have full rank, c then a least squares solution is obtained. on output qrsolv c also provides an upper triangular matrix s such that c c t t t c p *(a *a + d*d)*p = s *s . c c s is computed within qrsolv and may be of separate interest. c c the subroutine statement is c c subroutine qrsolv(n,r,ldr,ipvt,diag,qtb,x,sdiag,wa) c c where c c n is a positive integer input variable set to the order of r. c c r is an n by n array. on input the full upper triangle c must contain the full upper triangle of the matrix r. c on output the full upper triangle is unaltered, and the c strict lower triangle contains the strict upper triangle c (transposed) of the upper triangular matrix s. c c ldr is a positive integer input variable not less than n c which specifies the leading dimension of the array r. c c ipvt is an integer input array of length n which defines the c permutation matrix p such that a*p = q*r. column j of p c is column ipvt(j) of the identity matrix. c c diag is an input array of length n which must contain the c diagonal elements of the matrix d. c c qtb is an input array of length n which must contain the first c n elements of the vector (q transpose)*b. c c x is an output array of length n which contains the least c squares solution of the system a*x = b, d*x = 0. c c sdiag is an output array of length n which contains the c diagonal elements of the upper triangular matrix s. c c wa is a work array of length n. c c subprograms called c c fortran-supplied ... dabs,dsqrt c c argonne national laboratory. minpack project. march 1980. c burton s. garbow, kenneth e. hillstrom, jorge j. more c c ********** integer i,j,jp1,k,kp1,l,nsing double precision cos,cotan,p5,p25,qtbpj,sin,sum,tan,temp,zero data p5,p25,zero /5.0d-1,2.5d-1,0.0d0/ c c copy r and (q transpose)*b to preserve input and initialize s. c in particular, save the diagonal elements of r in x. c do 20 j = 1, n do 10 i = j, n r(i,j) = r(j,i) 10 continue x(j) = r(j,j) wa(j) = qtb(j) 20 continue c c eliminate the diagonal matrix d using a givens rotation. c do 100 j = 1, n c c prepare the row of d to be eliminated, locating the c diagonal element using p from the qr factorization. c l = ipvt(j) if (diag(l) .eq. zero) go to 90 do 30 k = j, n sdiag(k) = zero 30 continue sdiag(j) = diag(l) c c the transformations to eliminate the row of d c modify only a single element of (q transpose)*b c beyond the first n, which is initially zero. c qtbpj = zero do 80 k = j, n c c determine a givens rotation which eliminates the c appropriate element in the current row of d. c if (sdiag(k) .eq. zero) go to 70 if (dabs(r(k,k)) .ge. dabs(sdiag(k))) go to 40 cotan = r(k,k)/sdiag(k) sin = p5/dsqrt(p25+p25*cotan**2) cos = sin*cotan go to 50 40 continue tan = sdiag(k)/r(k,k) cos = p5/dsqrt(p25+p25*tan**2) sin = cos*tan 50 continue c c compute the modified diagonal element of r and c the modified element of ((q transpose)*b,0). c r(k,k) = cos*r(k,k) + sin*sdiag(k) temp = cos*wa(k) + sin*qtbpj qtbpj = -sin*wa(k) + cos*qtbpj wa(k) = temp c c accumulate the tranformation in the row of s. c kp1 = k + 1 if (n .lt. kp1) go to 70 do 60 i = kp1, n temp = cos*r(i,k) + sin*sdiag(i) sdiag(i) = -sin*r(i,k) + cos*sdiag(i) r(i,k) = temp 60 continue 70 continue 80 continue 90 continue c c store the diagonal element of s and restore c the corresponding diagonal element of r. c sdiag(j) = r(j,j) r(j,j) = x(j) 100 continue c c solve the triangular system for z. if the system is c singular, then obtain a least squares solution. c nsing = n do 110 j = 1, n if (sdiag(j) .eq. zero .and. nsing .eq. n) nsing = j - 1 if (nsing .lt. n) wa(j) = zero 110 continue if (nsing .lt. 1) go to 150 do 140 k = 1, nsing j = nsing - k + 1 sum = zero jp1 = j + 1 if (nsing .lt. jp1) go to 130 do 120 i = jp1, nsing sum = sum + r(i,j)*wa(i) 120 continue 130 continue wa(j) = (wa(j) - sum)/sdiag(j) 140 continue 150 continue c c permute the components of z back to components of x. c do 160 j = 1, n l = ipvt(j) x(l) = wa(j) 160 continue return c c last card of subroutine qrsolv. c end subroutine kkmclr(npts, e, finp, fout) c reverse (f''->f') kk transform, using maclaurin series algorithm c arguments: c npts size of arrays to consider c e energy array *must be on an even grid* [npts] (in) c finp f'' array [npts] (in) c fout f' array [npts] (out) c m newville jan 1997 implicit none double precision e(*), finp(*), fout(*) double precision factor, ei2, de2, fopi, zero, tiny parameter(fopi = 1.273239544735163d0, zero = 0.d0, tiny=1.d-20) integer npts, i, j, k, ioff, nptsk if (npts.ge.2) then factor = - fopi * (e(npts) - e(1)) / (npts - 1) nptsk = npts / 2 do 100 i=1, npts fout(i) = zero ei2 = e(i) * e(i) ioff = mod(i,2) - 1 do 50 k = 1, nptsk j = k + k + ioff de2 = e(j)*e(j) - ei2 if (abs(de2).le.tiny) de2 = tiny fout(i) = fout(i) + e(j) * finp(j) / de2 50 continue fout(i) = factor * fout(i) 100 continue end if return c end subroutine kkmclr end subroutine outasc(filnam, title, doc, ndoc, $ xd, mcol, mdata, ncol, ndata) c c write column data to ascii file c inputs (no outputs): c filnam file name to write data to c title string to use as label for columns c doc array of document lines c mdoc dimension of doc c xd (mcol,mdata) matrix of data c mcol dimension of xd c mdata dimension of xd c ncol number of columns to actually write c ndata number of data points to actually write implicit none integer ilen, istrln, i, iounit, ierr, mcol, mdata integer ndoc, mxl, ncol, ndata, iexist, j, ic double precision xd(mcol,mdata) character*(*) filnam, title, lines*20 character*(*) doc(ndoc) character fmt*18, cmt*2, cmtd*2, contc*5 parameter(mxl = 78, cmtd = '# ', contc = ' + ') parameter(lines = '--------------------') external istrln c c decide comment character cmt = cmtd ic = istrln(cmt) c open data file c if file name is ' ' or '*', write to standard output (unit 6) iounit = 6 if ((filnam.ne.' ').and.(filnam.ne.'*')) then iounit = 0 call openfl(iounit, filnam, 'unknown', iexist, ierr) if ((ierr.lt.0).or.(iexist.lt.0)) go to 990 endif c write documents do 200 i = 1, ndoc call triml(doc(i)) ilen = istrln(doc(i)) if (ilen.gt.mxl) then write(iounit,820) cmt,doc(i)(1:mxl) write(iounit,820) cmt//contc,doc(i)(mxl+1:ilen) else if (ilen.ge.1) then write(iounit,820) cmt,doc(i)(1:ilen) end if 200 continue c write line of minus signs and column label write(iounit,820) cmt(1:ic), lines//lines ilen = max(1,istrln(title)) write(iounit,820) cmt,title(1:ilen) c determine format write(fmt,850) ncol c write out column data do 400 i = 1, ndata write(iounit,fmt) (xd(j,i), j= 1,ncol) 400 continue c close data file and return close(iounit) return 820 format(2a) 830 format(a,40('-')) 850 format('(',i2,'(g15.7))') 990 continue fmt = 'outasc: error opening file '//filnam ilen = istrln(fmt) call messag(fmt(:ilen)) stop c end subroutine outasc end subroutine dklog c c write log of diffkk. note that diffkk.log *can* be used as diffkk.inp c include "dkcom.f" c#{dkcom.f: implicit none integer mpts,mdoc,mtitle,mvarys, npts,ndoc,ntitle integer iencol,imucol,iatz, npad, numvar parameter (mpts = 2**14, mdoc = 20, mtitle = 10, mvarys=20) double precision egrid, e0, elow, ehigh, ewidth double precision epad, xvarys(mvarys) double precision energy(mpts), f2ex(mpts), f2cl(mpts) character*100 doc(mdoc), title(mtitle), versn*6 character*100 inpfil, xmufil, outfil, label logical active, isfeff integer ne0, nelo, nehi, ne0ish, ne0dif, iprint common /dfkdat/ energy, f2ex, f2cl, xvarys, egrid, e0, elow, $ ehigh, ewidth, epad, npad, npts, ndoc, ntitle, iencol, $ imucol, ne0, nelo, nehi, ne0ish, ne0dif, iprint, $ iatz, numvar, active, isfeff common /dfkchr/ doc, title, label, inpfil, xmufil, outfil, $ versn save c#dkcom.f} integer istrln, ilog, ier, iex, ilen, i character*70 stat*10, logfil, str, atsym*2 external istrln, atsym data stat /'unknown'/ c---------------------------------------------------------------------- c determine log file name (usually trivial) c but if not, find the *last* "." logfil = 'diffkk.log' c open log file ilog = 0 ier = 0 iex = 0 call openfl(ilog, logfil, stat, iex, ier) if (ier.lt.0) go to 5000 c c write version number write(str,10) versn 10 format(' -- diffkk version ',a, '--') ilen = istrln(str) write(ilog,900) str(1:ilen) write(ilog,900) ' program inputs or default values used:' if (ntitle.le.0) then write (ilog, 910) 'title', $ 'diffkk: no title lines specified' else do 100 i = 1, ntitle ilen = max(1, istrln(title(i))) write (ilog, 910) 'title', title(i)(1:ilen) 100 continue end if ilen = max(15, istrln(outfil)) write (ilog, 920) 'out', outfil(1:ilen), 'output file name' c ilen = max(15, istrln(xmufil)) write (ilog, 920) 'xmu', xmufil(1:ilen), $ 'file name for xmu data' c if (isfeff) then write (ilog, 981)'isfeff','file is a feff xmu.dat file' else write (ilog, 980)'isfeff','file is not a feff xmu.dat file' end if write (ilog, 930) 'encol',iencol,'column to read energy from' write (ilog, 930) 'mucol',imucol,'column to read mu(E) from' write (ilog, 930) 'iz', iatz, 'atomic number of core atom' write (ilog, 950) 'e0', e0 , 'edge energy (used as reference)' c write (ilog, 950) 'egrid', egrid,'energy grid for calculation' write (ilog, 950) 'ewidth', ewidth,'for broadening CL data' write (ilog, 950) 'elow', elow, $ 'how far below data range to calculate' write (ilog, 950) 'ehigh', ehigh, $ 'how far above data range to calculate' if (isfeff) then write(ilog,900) 'the following are for padding '// $ 'data from feff''s xmu.dat below e0' write (ilog, 950) 'epad', epad, 'energy grid for pre-padding' write (ilog, 930) 'npad', npad, $ 'number of points for pre-padding' end if c write(ilog,905) ' end % '// $ 'all remaining lines will be ignored on input' write(ilog,905) ' -- diffkk program summary --' write(ilog,905) ' ' write(ilog,905) ' f''''(E) was set to be' write(ilog,905) ' f''''(E) = f''''_CL(E) '// $ ' for E > e0+ehigh and E < e0-elow.' write(ilog,906) ' within the range E = [e0-elow, e0+ehigh],', $ ' f'''' was set to' write(ilog,905) ' f''''(E) = f''''_CL(E) + a0 '// $ '+ a1 * mu(E'') * ( E'' / e0)' write(ilog,905) ' + a2 * (E'' - e0) '// $ '+ a3 * (E'' - e0)**2 ' ilen = max(1,istrln(xmufil)) write(ilog,907) ' where mu(E) was read from ', $ xmufil(1:ilen),',' write(ilog,907) ' f''''_CL(E) was found for ', $ atsym(iatz), ', and E'' = E + e0_shift.' write(ilog,905) ' ' write(ilog,905) ' the values of e0_shift, a0, a1, a2, '// $ 'and a3 were determined to be:' write(ilog,955) 'e0_shift', xvarys(1) write(ilog,955) 'a0', xvarys(2) write(ilog,955) 'a1', xvarys(3) write(ilog,955) 'a2', xvarys(4) write(ilog,955) 'a3', xvarys(5) write(ilog,905) ' so as to best match f''''_CL(E)'// $ ' between E = [e0-elow, e0+ehigh]' write(ilog,905) ' ' write(ilog,905) ' -- end diffkk log file --' c close(ilog) return 900 format(1x,'# ',a) 905 format(1x, a) 906 format(1x, 2a) 907 format(1x, 3a) 910 format(1x, a8, ' = ', a) 920 format(1x, a8, ' = ', a , 1x,'% ',a) 930 format(1x, a8, ' = ', i4 , 12x,'% ',a) 950 format(1x, a8, ' = ', f11.4, 5x,'% ',a) 955 format(6x, a10, ' = ', g15.6) 980 format(1x, a8, ' = false', 11x,'% ',a) 981 format(1x, a8, ' = true', 12x,'% ',a) 5000 continue call messag(' weird, fatal error trying to open input file') stop end