裝配圖復合形法減速器優(yōu)化設計
裝配圖復合形法減速器優(yōu)化設計,裝配,復合,減速器,優(yōu)化,設計
單級圓柱齒輪減速器復合形法fortran優(yōu)化源程序
C ==============
PROGRAM COMPLE
C ==============
DIMENSION X(25),GX(50),XCOM(1250)
COMMON /ONE/ ITE,IXE,ILI,NPE,NFX,NGR
READ(*,*) N,KG,K
WRITE(*,10001) N,KG,K
10001 FORMAT(25X,'========== PRIMARY DATA =========='//5X,
1 'N=',I4,5X,'KG=',I4,5X,'K=',I4)
CALL MAISUB(N,K,KG,X,GX,XCOM)
STOP
END
C ===================================
SUBROUTINE MAISUB(N,K,KG,X,GX,XCOM)
C ===================================
DIMENSION X(N),GX(KG),XCOM(N,K),FXK(50),XR(25)
DIMENSION XO(25),XH(25),XL(25),BL(25),BU(25)
COMMON /ONE/ ITE,IXE,ILI,NPE,NFX,NGR
COMMON /TWO/ ISE
READ(*,*) (X(I),I=1,N)
READ(*,*) EPS
READ(*,*) KWR,ISE
READ(*,*) (BL(I),I=1,N),(BU(I),I=1,N)
WRITE(*,1010) (BL(I),I=1,N)
WRITE(*,1015) (BU(I),I=1,N)
WRITE(*,1020) EPS
1010 FORMAT(' BL:'/(5X,5E15.6))
1015 FORMAT(' BU:'/(5X,5E15.6))
1020 FORMAT(5X,'EPS=',E10.2)
ITE=0
NFX=0
IXE=0
RM=2657863.0
1025 CALL PRICOM(N,K,KG,X,GX,XCOM,FXK,BL,BU,RM)
IF(KWR.LT.0) GOTO 1041
WRITE(*,1030)
1030 FORMAT(/25X,'========== PRIMARY COMPLEX =========='/)
WRITE(*,1080) K
DO 1031 L=1,K
WRITE(*,1085) L,(XCOM(I,L),I=1,N)
1031 CONTINUE
WRITE(*,1035) (FXK(I),I=1,K)
1035 FORMAT(4X,'FXK:'/(5X,5E15.6))
1041 WRITE(*,1042)
1042 FORMAT(/25X,'========== ITEATION COMPUTE =========='/)
1045 ITE=ITE+1
CALL FXSEGU(N,K,XCOM,FXK)
DO 1050 I=1,N
1050 XL(I)=XCOM(I,K)
FXL=FXK(K)
SDX=0.0
DO 1055 I=1,K-1
1055 SDX=SDX+(FXL-FXK(I))**2
=SQRT(SDX/FLOAT(K-1))
IF(SDX.LE.EPS) GOTO 1210
IF(KWR.GT.0) GOTO 1056
IF(ITE/10*10.NE.ITE) GOTO 1090
1056 WRITE(*,1060) ITE,FXL
IF(KWR.LT.0) GOTO 1090
WRITE(*,1065) (XL(I),I=1,N)
WRITE(*,1070) FXL
WRITE(*,1075) (GX(I),I=1,KG)
WRITE(*,1035) (FXK(I),I=1,K)
1060 FORMAT(/1X,'***** ITE=',I4,5X,'FXL=',E15.7)
1065 FORMAT(' X :'/(5X,5E15.6))
1070 FORMAT(' FX:'/(5X,5E15.6))
1075 FORMAT(' GX:'/(5X,5E15.6))
1080 FORMAT(' XCOM: (K=',I3,')')
1085 FORMAT(2X,I2/(5X,5E15.6))
1090 LH=1
1095 DO 1100 I=1,N
1100 XH(I)=XCOM(I,LH)
FXH=FXK(LH)
CALL XCENTE(N,K,K,LH,XO,XCOM)
CALL FFX(N,XO,FXO)
CALL GGX(N,KG,XO,GX)
DO 1105 J=1,KG
IF(GX(J).GE.0.0) GOTO 1170
1105 CONTINUE
1140 PHI=1.3
1145 DO 1150 I=1,N
1150 XR(I)=XO(I)+PHI*(XO(I)-XH(I))
CALL FFX(N,XR,FXR)
CALL GGX(N,KG,XR,GX)
DO 1151 J=1,KG
IF(GX(J).GE.0.0) GOTO 1152
1151 CONTINUE
GOTO 1155
1152 PHI=0.5*PHI
GOTO 1145
1155 IF(FXR.LT.FXH) GOTO 1160
IF(PHI.LE.1E-10) GOTO 1195
PHI=0.5*PHI
GOTO 1145
1160 DO 1165 I=1,N
1165 XCOM(I,LH)=XR(I)
FXK(LH)=FXR
GOTO 1045
1170 DO 1175 I=1,N
BL(I)=XL(I)
BU(I)=XO(I)
1175 CONTINUE
DO 1180 I=1,N
1180 X(I)=XL(I)
ISE=1
GOTO 1025
1195 LH=LH+1
WRITE(*,1200) LH
1200 FORMAT(1X,'****** LH=',I2,'*****')
IF(LH.LE.K/2) GOTO 1095
WRITE(*,1205)
1205 FORMAT(/25X,'********** ITERTION ABORTIVE **********'/)
GOTO 1220
1210 WRITE(*,1215)
1215 FORMAT(/25X,'========== OPTIMUM SOLUTION =========='/)
1220 WRITE(*,1225) ITE,NFX,IXE
1225 FORMAT(' ITE=',I5,' NFX=',I5' IXE=',I5)
WRITE(*,1065) (XL(I),I=1,N)
WRITE(*,1070) FXL
WRITE(*,1075) (GX(I),I=1,KG)
RETURN
END
C ================================================
SUBROUTINE PRICOM(N,K,KG,X,GX,XCOM,FXK,BL,BU,RM)
C ================================================
DIMENSION X(N),XO(25),BL(N),BU(N),GX(KG),XCOM(N,K),FXK(K)
COMMON /TWO/ ISE
2020 IF(ISE) 2025,2050,2075
2025 WRITE(*,2019)
2019 FORMAT(5X,'READ XCOM (FORMAT: * )')
READ(*,*) ((XCOM(I,J),I=1,N),J=1,K)
DO 2045 L=1,K
DO 2030 I=1,N
2030 X(I)=XCOM(I,L)
CALL FFX(N,X,FXK(L))
CALL GGX(N,KG,X,GX)
DO 2031 J=1,KG
IF(GX(J).GE.0.0) GOTO 2075
2031 CONTINUE
2045 CONTINUE
RETURN
2050 CALL FFX(N,X,FXK(1))
CALL GGX(N,KG,X,GX)
DO 2051 L=1,KG
IF(GX(L).GE.0.0) GOTO 2075
2051 CONTINUE
GOTO 2095
2075 DO 2080 I=1,N
CALL RANDOM(RM,Q)
2080 X(I)=BL(I)+Q*(BU(I)-BL(I))
CALL FFX(N,X,FXK(1))
CALL GGX(N,KG,X,GX)
DO 2081 L=1,KG
IF(GX(L).GE.0.0) GOTO 2075
2081 CONTINUE
2095 DO 2100 I=1,N
2100 XCOM(I,1)=X(I)
DO 2110 L=2,K
DO 2105 I=1,N
CALL RANDOM(RM,Q)
XCOM(I,L)=BL(I)+Q*(BU(I)-BL(I))
2105 CONTINUE
2110 CONTINUE
LH=0
DO 2155 LL=1,K-1
LL2=LL
CALL XCENTE(N,K,LL2,LH,XO,XCOM)
CALL FFX(N,XO,FXO)
CALL GGX(N,KG,X,GX)
DO 2111 L=1,KG
IF(GX(L).GE.0.0) GOTO 2075
2111 CONTINUE
2115 CONTINUE
LL1=LL+1
DO 2120 I=1,N
2120 X(I)=XCOM(I,LL1)
2125 CALL FFX(N,X,FXK(LL1))
CALL GGX(N,KG,X,GX)
DO 2126 L=1,KG
IF(GX(L).GE.0.0) GOTO 2145
2126 CONTINUE
DO 2140 I=1,N
2140 XCOM(I,LL1)=X(I)
GOTO 2155
2145 DO 2150 I=1,N
2150 X(I)=XO(I)+0.5*(X(I)-XO(I))
GOTO 2125
2155 CONTINUE
RETURN
END
C ===============================
SUBROUTINE FXSEGU(N,K,XCOM,FXK)
C ===============================
DIMENSION X(25),XCOM(N,K),FXK(K)
DO 3010 L=1,K-1
KL=K-L
DO 3005 LP=1,KL
LP1=LP+1
IF(FXK(LP).GT.FXK(LP1)) GOTO 3005
W=FXK(LP)
FXK(LP)=FXK(LP1)
FXK(LP1)=W
DO 3000 I=1,N
X(I)=XCOM(I,LP)
XCOM(I,LP)=XCOM(I,LP1)
3000 XCOM(I,LP1)=X(I)
3005 CONTINUE
3010 CONTINUE
RETURN
END
C ====================================
SUBROUTINE XCENTE(N,K,LL,LH,XO,XCOM)
C ====================================
DIMENSION XO(N),XCOM(N,K)
COMMON /ONE/ ITE,IXE,ILI,NPE,NFX,NGR
IXE=IXE+1
DO 4015 I=1,N
XS=0.0
DO 4000 L=1,LL
IF(L.EQ.LH) GOTO 4000
XS=XS+XCOM(I,L)
4000 CONTINUE
IF(LH) 4010,4010,4005
4005 XO(I)=XS/FLOAT(LL-1)
GOTO 4015
4010 XO(I)=XS/FLOAT(LL)
4015 CONTINUE
RETURN
END
SUBROUTINE RANDOM(RM,Q)
C =======================
C =======================
RM35=2.0**35
RM36=2.0*RM35
RM37=2.0*RM36
RM =5.0*RM
IF(RM.GE.RM37) RM=RM-RM37
IF(RM.GE.RM36) RM=RM-RM36
IF(RM.GE.RM35) RM=RM-RM35
Q=RM/RM35
RETURN
END
一、選題的依據(jù)及意義：
隨著社會的發(fā)展和人民生活水平的提高，人們對產(chǎn)品的需求是多樣化的，這就決定了未來的生產(chǎn)方式趨向多品種、小批量。在各行各業(yè)中十分廣泛地使用著齒輪減速器，它是一種不可缺少的機械傳動裝置. 它是機械設備的重要組成部分和核心部件。目前，國內(nèi)各類通用減速器的標準系列已達數(shù)百個，基本可滿足各行業(yè)對通用減速器的需求。國內(nèi)減速器行業(yè)重點骨干企業(yè)的產(chǎn)品品種、規(guī)格及參數(shù)覆蓋范圍近幾年都在不斷擴展，產(chǎn)品質(zhì)量已達到國外先進工業(yè)國家同類產(chǎn)品水平，承擔起為國民經(jīng)濟各行業(yè)提供傳動裝置配套的重任，部分產(chǎn)品還出口至歐美及東南亞地區(qū)，推動了中國裝配制造業(yè)發(fā)展。
圓柱齒輪減速器是一種使用非常廣泛的機械傳動裝置。減速器是用于原動機與工作機之間的獨立的傳動裝置，用來降低轉速和增大轉矩，以滿足工作需要。在現(xiàn)代機械中應用極為廣泛，具有品種多、批量小、更新?lián)Q代快的特點。目前生產(chǎn)的各種類型的減速器還存在著體積大、重量重、承載能力低、成本高和使用壽命短等問題，與國外先進產(chǎn)品相比還有較大的差距。對減速器進行優(yōu)化設計，選擇最佳參數(shù)是提高承載能力、減輕重量和降低成本等各項指標的一種重要途徑。
目的： 通過設計熟悉機器的具體操作，增強感性認識和社會適應能力，進一步鞏固、 深化已學過的理論知識，提高綜合運用所學知識發(fā)現(xiàn)問題、解決問題的能力。學習機械設計的一般方法，掌握通用機械零件、機械傳動裝置或簡單機械的設計原理和過程。對所學技能的訓練，例如：計算、繪圖、查閱設計資料和手冊，運用標準和規(guī)范等。學會利用多種手段(工具)解決問題，如：在本設計中可選擇CAD等制圖工具。了解減速器內(nèi)部齒輪間的傳動關系。
意義： 通過設計，培養(yǎng)學生理論聯(lián)系實際的工作作風，提高分析問題、解決問題的獨立工作能力；通過實習，加深學生對專業(yè)的理解和認識，為進一步開拓專業(yè)知識創(chuàng)造條件，鍛煉動手動腦能力，通過實踐運用鞏固了所學知識，加深了解其基本原理
二、國內(nèi)外研究概況及發(fā)展趨勢（含文獻綜述）：
1、國外減速器技術發(fā)展簡況
齒輪減速器在各行各業(yè)中十分廣泛地使用著，是一種不可缺少的機械傳動裝置。當前減速器普遍存在著體積大、重量大，或者傳動比大而機械效率過低的問題。
國外的減速器，以德國、丹麥和日本處于領先地位，特別在材料和制造工藝方面占據(jù)優(yōu)勢，減速器工作可靠性好，使用壽命長。但其傳動形式仍以定軸齒輪傳動為主，體積和重量問題，也未解決好。最近報導，日本住友重工研制的FA型高精度減速器，美國Alan-Newton公司研制的X-Y式減速器，在傳動原理和結構上與本項目類似或相近，都為目前先進的齒輪減速器。當今的減速器是向著大功率、大傳動比、小體積、高機械效率以及使用壽命長的方向發(fā)展。因此，除了不斷改進材料品質(zhì)、提高工藝水平外，還在傳動原理和傳動結構上深入探討和創(chuàng)新，平動齒輪傳動原理的出現(xiàn)就是一例。減速器與電動機的連體結構，也是大力開拓的形式，并已生產(chǎn)多種結構形式和多種功率型號的產(chǎn)品。
目前，超小型的減速器的研究成果尚不明顯。在醫(yī)療、生物工程、機器人等領域中，微型發(fā)動機已基本研制成功，美國和荷蘭近期研制的分子發(fā)動機的尺寸在納米級范圍，如能輔以納米級的減速器，則應用前景遠大。
2、國內(nèi)減速器技術發(fā)展簡況
國內(nèi)的減速器多以齒輪傳動、蝸桿傳動為主，但普遍存在著功率與重量比小，或者傳動比大而機械效率過低的問題。另外，材料品質(zhì)和工藝水平上還有許多弱點，特別是大型的減速器問題更突出，使用壽命不長。國內(nèi)使用的大型減速器(500kw以上)，多從國外(如丹麥、德國等)進口，花去不少的外匯。60年代開始生產(chǎn)的少齒差傳動、擺線針輪傳動、諧波傳動等減速器具有傳動比大，體積小、機械效率高等優(yōu)點?。但受其傳動的理論的限制，不能傳遞過大的功率，功率一般都要小于40kw。由于在傳動的理論上、工藝水平和材料品質(zhì)方面沒有突破，因此，沒能從根本上解決傳遞功率大、傳動比大、體積小、重量輕、機械效率高等這些基本要求。90年代初期，國內(nèi)出現(xiàn)的三環(huán)(齒輪)減速器，是一種外平動齒輪傳動的減速器，它可實現(xiàn)較大的傳動比，傳遞載荷的能力也大。它的體積和重量都比定軸齒輪減速器輕，結構簡單，效率亦高。由于該減速器的三軸平行結構，故使功率/體積(或重量)比值仍小。且其輸入軸與輸出軸不在同一軸線上，這在使用上有許多不便。北京理工大學研制成功的"內(nèi)平動齒輪減速器"不僅具有三環(huán)減速器的優(yōu)點外，還有著大的功率/重量(或體積)比值，以及輸入軸和輸出軸在同一軸線上的優(yōu)點，處于國內(nèi)領先地位。國內(nèi)有少數(shù)高等學校和廠礦企業(yè)對平動齒輪傳動中的某些原理做些研究工作，發(fā)表過一些研究論文，在利用擺線齒輪作平動減速器開展了一些工作。二、平動齒輪減速器工作原理簡介,平動齒輪減速器是指一對齒輪傳動中，一個齒輪在平動發(fā)生器的驅動下作平面平行運動，通過齒廓間的嚙合，驅動另一個齒輪作定軸減速轉動，實現(xiàn)減速傳動的作用。平動發(fā)生器可采用平行四邊形機構，或正弦機構或十字滑塊機構。本成果采用平行四邊形機構作為平動發(fā)生器。平動發(fā)生器可以是虛擬的采用平行四邊形機構，也可以是實體的采用平行四邊形機構。有實用價值的平動齒輪機構為內(nèi)嚙合齒輪機構，因此又可以分為內(nèi)齒輪作平動運動和外齒輪作平動運動兩種情況。外平動齒輪減速機構，其內(nèi)齒輪作平動運動，驅動外齒輪并作減速轉動輸出。該機構亦稱三環(huán)(齒輪)減速器。由于內(nèi)齒輪作平動，兩曲柄中心設置在內(nèi)齒輪的齒圈外部，故其尺寸不緊湊，不能解決體積較大的問題。?內(nèi)平動齒輪減速，其外齒輪作平動運動，驅動內(nèi)齒輪作減速轉動輸出。由于外齒輪作平動，兩曲柄中心能設置在外齒輪的齒圈內(nèi)部，大大減少了機構整體尺寸。由于內(nèi)平動齒輪機構傳動效率高、體積小、輸入輸出同軸線，故由廣泛的應用前景。? 三、本項目的技術特點與關鍵技術? 1.本項目的技術特點,本新型的"內(nèi)平動齒輪減速器"與國內(nèi)外已有的齒輪減速器相比較，有如下特點：(1)傳動比范圍大，自I=10起，最大可達幾千。若制作成大傳動比的減速器，則更顯示出本減速器的優(yōu)點。(2)傳遞功率范圍大：并可與電動機聯(lián)成一體制造。(3)結構簡單、體積小、重量輕。比現(xiàn)有的齒輪減速器減少1/3左右。(4)機械效率高。嚙合效率大于95%，整機效率在85%以上，且減速器的效率將不隨傳動比的增大而降低，這是別的許多減速器所不及的。 (5)本減速器的輸入軸和輸出軸是在同一軸線上
三、研究內(nèi)容及實驗方案：
研究內(nèi)容：
1.采用復合形法，以體積最小為目標進行減速器優(yōu)化設計；
2.與常規(guī)設計結果進行比較分析，
3.繪制減速器裝配圖及主要零件圖。
實驗方案：
1. 收集有關資料寫開題報告
2. 以減速器體積最小為目標函數(shù)建立優(yōu)化設計的數(shù)學模型
3．采用復合型法編寫優(yōu)化設計程序、計算
4. 計算減速器各項尺寸，并進行結果分析
5. 運用UG繪制減速器裝配圖及主要零件圖
6. 翻譯外文資料
7.撰寫畢業(yè)設計論文
四、目標、主要特色及工作進度
目標：本課題以減速器體積最小為目標函數(shù)，設計減速器的最優(yōu)參數(shù)，
繪制減速器裝配圖及主要零件圖。
主要特色：減速器體積小，重量輕，承載能力提高，降低成本
工作進度：
1. 收集資料、開題報告、外文翻譯 3，01-3.21
2. 建立優(yōu)化設計的數(shù)學模型 3.22-4.04
3．編寫優(yōu)化設計程序、計算 4.05-5.09
4. 減速器常規(guī)設計計算、結果分析 5.09-5.23
5. 繪制減速器裝配圖及主要零件圖 5.24-6.13
6. 撰寫畢業(yè)設計論文 6.14-6.27
7. 答辯準備及論文答辯 6.28-7.02
五、參考文獻
【1】璞良貴，紀名剛主編.機械設計.第八版.北京：高等教育出版社，2007
【2】孫靖民主編.機械優(yōu)化設計.第三版.北京：機械工業(yè)出版社，2005
【3】方世杰，綦耀光主編.機械優(yōu)化設計.北京：機械工業(yè)出版社，1997.2
【4】王昆等主編. 機械設計課程設計手冊.北京：機械工業(yè)出版社，2004
【5】劉瑞新，洪遠征等編著.Visual Basic 程序設計教程.第二版. 北京：機械工業(yè)出版社，2006
【6】楊黎明主編.機械零件設計手冊.北京：國防工業(yè)出版社，1996
【7】劉瑞新，洪遠征等編著.Visual Basic 程序設計教程上機指導及習題解答.第二版. 北京：機械工業(yè)出版社，2006
【8】鄭貞平，喻德主編.UG NX5中文版三維設計與NC加工實例精解. 北京：機械工業(yè)出版社，2008
【9】Carrol, R., and Johnson, G.,“Optimal design of compact spur gear sets”, ASME Journal of mechanisms, transmissions and automation in design. Vol.106, No.1, March 1984, pp.95-101
畢業(yè)設計（論文）任務書
I、畢業(yè)設計(論文)題目：
復合形法減速器優(yōu)化設計
II、畢 業(yè)設計(論文)使用的原始資料(數(shù)據(jù))及設計技術要求：
1、原始數(shù)據(jù)：
單級圓柱齒輪減速器，已知輸入功率P=22kW，輸入轉速n1=960r/min，傳動比i=4.5，
工作壽命10年，每年工作300天。
2、設計技術要求：
1）采用復合形法，以體積最小為目標進行減速器優(yōu)化設計；
2）與常規(guī)設計結果進行比較分析；
3）繪制減速器裝配圖及主要零件圖。
III、畢 業(yè)設計(論文)工作內(nèi)容及完成時間：
1. 收集資料、開題報告、外文翻譯（6000字符以上） 3.01-3.21（3周）
2. 建立優(yōu)化設計的數(shù)學模型 3.22-4.04 (2周)
3．編寫優(yōu)化設計程序、計算 4.05-5.09 (5周)
4. 減速器常規(guī)設計計算、結果分析 5.09-5.23 (2周)
5. 繪制減速器裝配圖及主要零件圖 5.24-6.13 (3周)
6. 撰寫畢業(yè)設計論文 6.14-6.27 (2周)
7．答辯準備及論文答辯 6.28-7.02（1周)
Ⅳ 、主 要參考資料：
[1] 璞良貴，紀名剛主編.機械設計.第八版.北京：高等教育出版社，2007
[2] 孫靖民主編.機械優(yōu)化設計.第三版.北京：機械工業(yè)出版社，2005
[3] 方世杰，綦耀光主編.機械優(yōu)化設計.北京：機械工業(yè)出版社，1997.2
[4] 王昆等主編. 機械設計課程設計手冊.北京：機械工業(yè)出版社，2004
[5] Carrol, R., and Johnson, G.,“Optimal design of compact spur gear sets”, ASME Journal of mechanisms, transmissions and automation in design. Vol.106, No.1, March 1984, pp.95-101
航空工程 系 機械設計制造及其自動化 專業(yè) 0781052 班
學生（簽名）：
日期：自 2010 年 3 月 1 日至 2010 年 7 月 2日
指導教師（簽名）：
助理指導教師(并指出所負責的部分)：
機械設計 系（室） 主任（簽名）： 賀紅林
附注:任務書應該附在已完成的畢業(yè)設計說明書首頁。
畢業(yè)設計（論文）
題目： 復合形法減速器的優(yōu)化設計
系 別 航空工程系
專業(yè)名稱 機械設計制造及其自動化
班級學號 078105206
學生姓名 戴曉思
指導教師 朱保利
二O一一年 六 月
單級圓柱齒輪減速器復合形法fortran優(yōu)化源程序
C ==============
PROGRAM COMPLE
C ==============
DIMENSION X(25),GX(50),XCOM(1250)
COMMON /ONE/ ITE,IXE,ILI,NPE,NFX,NGR
READ(*,*) N,KG,K
WRITE(*,10001) N,KG,K
10001 FORMAT(25X,'========== PRIMARY DATA =========='//5X,
1 'N=',I4,5X,'KG=',I4,5X,'K=',I4)
CALL MAISUB(N,K,KG,X,GX,XCOM)
STOP
END
C ===================================
SUBROUTINE MAISUB(N,K,KG,X,GX,XCOM)
C ===================================
DIMENSION X(N),GX(KG),XCOM(N,K),FXK(50),XR(25)
DIMENSION XO(25),XH(25),XL(25),BL(25),BU(25)
COMMON /ONE/ ITE,IXE,ILI,NPE,NFX,NGR
COMMON /TWO/ ISE
READ(*,*) (X(I),I=1,N)
READ(*,*) EPS
READ(*,*) KWR,ISE
READ(*,*) (BL(I),I=1,N),(BU(I),I=1,N)
WRITE(*,1010) (BL(I),I=1,N)
WRITE(*,1015) (BU(I),I=1,N)
WRITE(*,1020) EPS
1010 FORMAT(' BL:'/(5X,5E15.6))
1015 FORMAT(' BU:'/(5X,5E15.6))
1020 FORMAT(5X,'EPS=',E10.2)
ITE=0
NFX=0
IXE=0
RM=2657863.0
1025 CALL PRICOM(N,K,KG,X,GX,XCOM,FXK,BL,BU,RM)
IF(KWR.LT.0) GOTO 1041
WRITE(*,1030)
1030 FORMAT(/25X,'========== PRIMARY COMPLEX =========='/)
WRITE(*,1080) K
DO 1031 L=1,K
WRITE(*,1085) L,(XCOM(I,L),I=1,N)
1031 CONTINUE
WRITE(*,1035) (FXK(I),I=1,K)
1035 FORMAT(4X,'FXK:'/(5X,5E15.6))
1041 WRITE(*,1042)
1042 FORMAT(/25X,'========== ITEATION COMPUTE =========='/)
1045 ITE=ITE+1
CALL FXSEGU(N,K,XCOM,FXK)
DO 1050 I=1,N
1050 XL(I)=XCOM(I,K)
FXL=FXK(K)
SDX=0.0
DO 1055 I=1,K-1
1055 SDX=SDX+(FXL-FXK(I))**2
=SQRT(SDX/FLOAT(K-1))
IF(SDX.LE.EPS) GOTO 1210
IF(KWR.GT.0) GOTO 1056
IF(ITE/10*10.NE.ITE) GOTO 1090
1056 WRITE(*,1060) ITE,FXL
IF(KWR.LT.0) GOTO 1090
WRITE(*,1065) (XL(I),I=1,N)
WRITE(*,1070) FXL
WRITE(*,1075) (GX(I),I=1,KG)
WRITE(*,1035) (FXK(I),I=1,K)
1060 FORMAT(/1X,'***** ITE=',I4,5X,'FXL=',E15.7)
1065 FORMAT(' X :'/(5X,5E15.6))
1070 FORMAT(' FX:'/(5X,5E15.6))
1075 FORMAT(' GX:'/(5X,5E15.6))
1080 FORMAT(' XCOM: (K=',I3,')')
1085 FORMAT(2X,I2/(5X,5E15.6))
1090 LH=1
1095 DO 1100 I=1,N
1100 XH(I)=XCOM(I,LH)
FXH=FXK(LH)
CALL XCENTE(N,K,K,LH,XO,XCOM)
CALL FFX(N,XO,FXO)
CALL GGX(N,KG,XO,GX)
DO 1105 J=1,KG
IF(GX(J).GE.0.0) GOTO 1170
1105 CONTINUE
1140 PHI=1.3
1145 DO 1150 I=1,N
1150 XR(I)=XO(I)+PHI*(XO(I)-XH(I))
CALL FFX(N,XR,FXR)
CALL GGX(N,KG,XR,GX)
DO 1151 J=1,KG
IF(GX(J).GE.0.0) GOTO 1152
1151 CONTINUE
GOTO 1155
1152 PHI=0.5*PHI
GOTO 1145
1155 IF(FXR.LT.FXH) GOTO 1160
IF(PHI.LE.1E-10) GOTO 1195
PHI=0.5*PHI
GOTO 1145
1160 DO 1165 I=1,N
1165 XCOM(I,LH)=XR(I)
FXK(LH)=FXR
GOTO 1045
1170 DO 1175 I=1,N
BL(I)=XL(I)
BU(I)=XO(I)
1175 CONTINUE
DO 1180 I=1,N
1180 X(I)=XL(I)
ISE=1
GOTO 1025
1195 LH=LH+1
WRITE(*,1200) LH
1200 FORMAT(1X,'****** LH=',I2,'*****')
IF(LH.LE.K/2) GOTO 1095
WRITE(*,1205)
1205 FORMAT(/25X,'********** ITERTION ABORTIVE **********'/)
GOTO 1220
1210 WRITE(*,1215)
1215 FORMAT(/25X,'========== OPTIMUM SOLUTION =========='/)
1220 WRITE(*,1225) ITE,NFX,IXE
1225 FORMAT(' ITE=',I5,' NFX=',I5' IXE=',I5)
WRITE(*,1065) (XL(I),I=1,N)
WRITE(*,1070) FXL
WRITE(*,1075) (GX(I),I=1,KG)
RETURN
END
C ================================================
SUBROUTINE PRICOM(N,K,KG,X,GX,XCOM,FXK,BL,BU,RM)
C ================================================
DIMENSION X(N),XO(25),BL(N),BU(N),GX(KG),XCOM(N,K),FXK(K)
COMMON /TWO/ ISE
2020 IF(ISE) 2025,2050,2075
2025 WRITE(*,2019)
2019 FORMAT(5X,'READ XCOM (FORMAT: * )')
READ(*,*) ((XCOM(I,J),I=1,N),J=1,K)
DO 2045 L=1,K
DO 2030 I=1,N
2030 X(I)=XCOM(I,L)
CALL FFX(N,X,FXK(L))
CALL GGX(N,KG,X,GX)
DO 2031 J=1,KG
IF(GX(J).GE.0.0) GOTO 2075
2031 CONTINUE
2045 CONTINUE
RETURN
2050 CALL FFX(N,X,FXK(1))
CALL GGX(N,KG,X,GX)
DO 2051 L=1,KG
IF(GX(L).GE.0.0) GOTO 2075
2051 CONTINUE
GOTO 2095
2075 DO 2080 I=1,N
CALL RANDOM(RM,Q)
2080 X(I)=BL(I)+Q*(BU(I)-BL(I))
CALL FFX(N,X,FXK(1))
CALL GGX(N,KG,X,GX)
DO 2081 L=1,KG
IF(GX(L).GE.0.0) GOTO 2075
2081 CONTINUE
2095 DO 2100 I=1,N
2100 XCOM(I,1)=X(I)
DO 2110 L=2,K
DO 2105 I=1,N
CALL RANDOM(RM,Q)
XCOM(I,L)=BL(I)+Q*(BU(I)-BL(I))
2105 CONTINUE
2110 CONTINUE
LH=0
DO 2155 LL=1,K-1
LL2=LL
CALL XCENTE(N,K,LL2,LH,XO,XCOM)
CALL FFX(N,XO,FXO)
CALL GGX(N,KG,X,GX)
DO 2111 L=1,KG
IF(GX(L).GE.0.0) GOTO 2075
2111 CONTINUE
2115 CONTINUE
LL1=LL+1
DO 2120 I=1,N
2120 X(I)=XCOM(I,LL1)
2125 CALL FFX(N,X,FXK(LL1))
CALL GGX(N,KG,X,GX)
DO 2126 L=1,KG
IF(GX(L).GE.0.0) GOTO 2145
2126 CONTINUE
DO 2140 I=1,N
2140 XCOM(I,LL1)=X(I)
GOTO 2155
2145 DO 2150 I=1,N
2150 X(I)=XO(I)+0.5*(X(I)-XO(I))
GOTO 2125
2155 CONTINUE
RETURN
END
C ===============================
SUBROUTINE FXSEGU(N,K,XCOM,FXK)
C ===============================
DIMENSION X(25),XCOM(N,K),FXK(K)
DO 3010 L=1,K-1
KL=K-L
DO 3005 LP=1,KL
LP1=LP+1
IF(FXK(LP).GT.FXK(LP1)) GOTO 3005
W=FXK(LP)
FXK(LP)=FXK(LP1)
FXK(LP1)=W
DO 3000 I=1,N
X(I)=XCOM(I,LP)
XCOM(I,LP)=XCOM(I,LP1)
3000 XCOM(I,LP1)=X(I)
3005 CONTINUE
3010 CONTINUE
RETURN
END
C ====================================
SUBROUTINE XCENTE(N,K,LL,LH,XO,XCOM)
C ====================================
DIMENSION XO(N),XCOM(N,K)
COMMON /ONE/ ITE,IXE,ILI,NPE,NFX,NGR
IXE=IXE+1
DO 4015 I=1,N
XS=0.0
DO 4000 L=1,LL
IF(L.EQ.LH) GOTO 4000
XS=XS+XCOM(I,L)
4000 CONTINUE
IF(LH) 4010,4010,4005
4005 XO(I)=XS/FLOAT(LL-1)
GOTO 4015
4010 XO(I)=XS/FLOAT(LL)
4015 CONTINUE
RETURN
END
SUBROUTINE RANDOM(RM,Q)
C =======================
C =======================
RM35=2.0**35
RM36=2.0*RM35
RM37=2.0*RM36
RM =5.0*RM
IF(RM.GE.RM37) RM=RM-RM37
IF(RM.GE.RM36) RM=RM-RM36
IF(RM.GE.RM35) RM=RM-RM35
Q=RM/RM35
RETURN
END
收藏