chave算法代码Word下载.docx
- 文档编号:812384
- 上传时间:2023-04-29
- 格式:DOCX
- 页数:24
- 大小:22.32KB
chave算法代码Word下载.docx
《chave算法代码Word下载.docx》由会员分享,可在线阅读,更多相关《chave算法代码Word下载.docx(24页珍藏版)》请在冰点文库上搜索。
parameter(nsum=0)
externalfunct
nf=0
if(nl.gt.nu)then
besr=0.
besi=0.
ierr=1
return
endif
nw=max(new,1)
callbestrn(besr,besi,norder,nl,r,funct,.1*rerr,.1*aerr,
*npcs,xsum,nsum,nw,ierr)
if((ierr.ne.0).and.(nl.eq.7))then
ng=nl
else
oldr=besr
oldi=besi
do10n=nl+1,nu
callbestrn(besr,besi,norder,n,r,funct,.1*rerr,.1*aerr,
*npcs,xsum,nsum,2,ierr)
if((ierr.ne.0).and.(n.eq.7))then
besr=oldr
besi=oldi
ng=n
elseif((abs(besr-oldr).le.rerr*abs(besr)+aerr).and.
*(abs(besi-oldi).le.rerr*abs(besi)+aerr))then
10continue
ng=7
C********************************************************************
subroutinebestrn(besr,besi,norder,ng,r,funct,rerr,aerr,
*npcs,xsum,nsum,new,ierr)
parameter(nterm=50,nstop=100)
doubleprecisionkarg,kern,lastr,lasti
dimensionkarg(255,nterm),kern(510,nterm),sr(nstop),si(nstop),
*nk(nterm),xsum
(1)
common/besint/nk,np,nps,karg,kern
common/test/ngauss,nf,ni
if(new.eq.2)then
npo=nps
do5i=1,nterm
nk(i)=0
5continue
nps=0
npo=nterm
if((norder.ne.0).and.(r.eq.0.))then
ierr=0
ni=0
nw=new
np=1
npb=1
l=1
b=0.0
sumr=0.0
sumi=0.0
xsumr=0.0
xsumi=0.0
if(nsum.gt.0)then
lastr=0.0
lasti=0.0
do10n=1,nsum
if((nw.eq.2).and.(np.gt.npo))nw=1
if(np.gt.nterm)nw=0
a=b
b=xsum(n)
callbesqud(a,b,termr,termi,ng,nw,norder,r,funct)
xsumr=xsumr+termr
xsumi=xsumi+termi
if((abs(xsumr-lastr).le.rerr*abs(xsumr)+aerr).and.
*(abs(xsumi-lasti).le.rerr*abs(xsumi)+aerr))then
besr=xsumr
besi=xsumi
nps=max(np,nps)
np=np+1
lastr=xsumr
lasti=xsumi
15continue
if(zeroj(npb,norder).gt.xsum(nsum)*r)goto20
npb=npb+1
goto15
20continue
b=zeroj(npb,norder)/r
do30n=1,nstop
if(npcs.eq.1)then
termr=0.0
termi=0.0
xinc=(b-a)/npcs
aa=a
bb=a+xinc
do25i=1,npcs
callbesqud(aa,bb,tr,ti,ng,nw,norder,r,funct)
termr=termr+tr
termi=termi+ti
aa=bb
bb=bb+xinc
25continue
ni=ni+1
sr(l)=termr
si(l)=termi
callpadecf(sumr,sumi,sr,si,l)
if((abs(sumr-lastr).le.rerr*abs(sumr)+aerr).and.
*(abs(sumi-lasti).le.rerr*abs(sumi)+aerr))then
besr=xsumr+sumr
besi=xsumi+sumi
nps=max(np-1,nps)
lastr=sumr
lasti=sumi
l=l+1
30continue
subroutinebesqud(a,b,besr,besi,ng,new,norder,r,f)
parameter(nterm=50)
doubleprecisionkarg,kern,jbess
dimensionwt(254),wa(127),nwa(7),nwt(7),karg(255,nterm),
*kern(510,nterm),funct(254),fr1(64),fi1(64),
*fr2(64),fi2(64),bes1(64),bes2(64),nk(nterm)
common/test/ngauss,nf,ni
datanwt/1,3,7,15,31,63,127/,nwa/1,2,4,8,16,32,64/
data(wt(i),i=1,20)/
*0.55555555555555555556d+00,0.88888888888888888889d+00,
*0.26848808986833344073d+00,0.10465622602646726519d+00,
*0.40139741477596222291d+00,0.45091653865847414235d+00,
*0.13441525524378422036d+00,0.51603282997079739697d-01,
*0.20062852937698902103d+00,0.17001719629940260339d-01,
*0.92927195315124537686d-01,0.17151190913639138079d+00,
*0.21915685840158749640d+00,0.22551049979820668739d+00,
*0.67207754295990703540d-01,0.25807598095176653565d-01,
*0.10031427861179557877d+00,0.84345657393211062463d-02,
*0.46462893261757986541d-01,0.85755924049990351154d-01/
data(wt(i),i=21,40)/
*0.10957842105592463824d+00,0.25447807915618744154d-02,
*0.16446049854387810934d-01,0.35957103307129322097d-01,
*0.56979509494123357412d-01,0.76879620499003531043d-01,
*0.93627109981264473617d-01,0.10566989358023480974d+00,
*0.11195687302095345688d+00,0.11275525672076869161d+00,
*0.33603877148207730542d-01,0.12903800100351265626d-01,
*0.50157139305899537414d-01,0.42176304415588548391d-02,
*0.23231446639910269443d-01,0.42877960025007734493d-01,
*0.54789210527962865032d-01,0.12651565562300680114d-02,
*0.82230079572359296693d-02,0.17978551568128270333d-01/
data(wt(i),i=41,60)/
*0.28489754745833548613d-01,0.38439810249455532039d-01,
*0.46813554990628012403d-01,0.52834946790116519862d-01,
*0.55978436510476319408d-01,0.36322148184553065969d-03,
*0.25790497946856882724d-02,0.61155068221172463397d-02,
*0.10498246909621321898d-01,0.15406750466559497802d-01,
*0.20594233915912711149d-01,0.25869679327214746911d-01,
*0.31073551111687964880d-01,0.36064432780782572640d-01,
*0.40715510116944318934d-01,0.44914531653632197414d-01,
*0.48564330406673198716d-01,0.51583253952048458777d-01,
*0.53905499335266063927d-01,0.55481404356559363988d-01/
data(wt(i),i=61,80)/
*0.56277699831254301273d-01,0.56377628360384717388d-01,
*0.16801938574103865271d-01,0.64519000501757369228d-02,
*0.25078569652949768707d-01,0.21088152457266328793d-02,
*0.11615723319955134727d-01,0.21438980012503867246d-01,
*0.27394605263981432516d-01,0.63260731936263354422d-03,
*0.41115039786546930472d-02,0.89892757840641357233d-02,
*0.14244877372916774306d-01,0.19219905124727766019d-01,
*0.23406777495314006201d-01,0.26417473395058259931d-01,
*0.27989218255238159704d-01,0.18073956444538835782d-03,
*0.12895240826104173921d-02,0.30577534101755311361d-02/
data(wt(i),i=81,100)/
*0.52491234548088591251d-02,0.77033752332797418482d-02,
*0.10297116957956355524d-01,0.12934839663607373456d-01,
*0.15536775555843982440d-01,0.18032216390391286320d-01,
*0.20357755058472159467d-01,0.22457265826816098707d-01,
*0.24282165203336599358d-01,0.25791626976024229388d-01,
*0.26952749667633031963d-01,0.27740702178279681994d-01,
*0.28138849915627150636d-01,0.50536095207862517625d-04,
*0.37774664632698466027d-03,0.93836984854238150079d-03,
*0.16811428654214699063d-02,0.25687649437940203731d-02,
*0.35728927835172996494d-02,0.46710503721143217474d-02/
data(wt(i),i=101,120)/
*0.58434498758356395076d-02,0.70724899954335554680d-02,
*0.83428387539681577056d-02,0.96411777297025366953d-02,
*0.10955733387837901648d-01,0.12275830560082770087d-01,
*0.13591571009765546790d-01,0.14893641664815182035d-01,
*0.16173218729577719942d-01,0.17421930159464173747d-01,
*0.18631848256138790186d-01,0.19795495048097499488d-01,
*0.20905851445812023852d-01,0.21956366305317824939d-01,
*0.22940964229387748761d-01,0.23854052106038540080d-01,
*0.24690524744487676909d-01,0.25445769965464765813d-01,
*0.26115673376706097680d-01,0.26696622927450359906d-01/
data(wt(i),i=121,140)/
*0.27185513229624791819d-01,0.27579749566481873035d-01,
*0.27877251476613701609d-01,0.28076455793817246607d-01,
*0.28176319033016602131d-01,0.28188814180192358694d-01,
*0.84009692870519326354d-02,0.32259500250878684614d-02,
*0.12539284826474884353d-01,0.10544076228633167722d-02,
*0.58078616599775673635d-02,0.10719490006251933623d-01,
*0.13697302631990716258d-01,0.31630366082226447689d-03,
*0.20557519893273465236d-02,0.44946378920320678616d-02,
*0.71224386864583871532d-02,0.96099525623638830097d-02,
*0.11703388747657003101d-01,0.13208736697529129966d-01/
data(wt(i),i=141,160)/
*0.13994609127619079852d-01,0.90372734658751149261d-04,
*0.64476204130572477933d-03,0.15288767050877655684d-02,
*0.26245617274044295626d-02,0.38516876166398709241d-02,
*0.51485584789781777618d-02,0.64674198318036867274d-02,
*0.77683877779219912200d-02,0.90161081951956431600d-02,
*0.10178877529236079733d-01,0.11228632913408049354d-01,
*0.12141082601668299679d-01,0.12895813488012114694d-01,
*0.13476374833816515982d-01,0.13870351089139840997d-01,
*0.14069424957813575318d-01,0.25157870384280661489d-04,
*0.18887326450650491366d-03,0.46918492424785040975d-03/
data(wt(i),i=161,180)/
*0.84057143271072246365d-03,0.12843824718970101768d-02,
*0.17864463917586498247d-02,0.23355251860571608737d-02,
*0.29217249379178197538d-02,0.35362449977167777340d-02,
*0.41714193769840788528d-02,0.48205888648512683476d-02,
*0.54778666939189508240d-02,0.61379152800413850435d-02,
*0.67957855048827733948d-02,0.74468208324075910174d-02,
*0.80866093647888599710d-02,0.87109650797320868736d-02,
*0.93159241280693950932d-02,0.98977475240487497440d-02,
*0.10452925722906011926d-01,0.10978183152658912470d-01,
*0.11470482114693874380d-01,0.11927026053019270040d-01/
data(wt(i),i=181,200)/
*0.12345262372243838455d-01,0.12722884982732382906d-01,
*0.13057836688353048840d-01,0.13348311463725179953d-01,
*0.13592756614812395910d-01,0.13789874783240936517d-01,
*0.13938625738306850804d-01,0.14038227896908623303d-01,
*0.14088159516508301065d-01,0.69379364324108267170d-05,
*0.53275293669780613125d-04,0.13575491094922871973d-03,
*0.249212400482
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- chave 算法 代码