工程电磁 场.docx
- 文档编号:30745233
- 上传时间:2023-08-20
- 格式:DOCX
- 页数:24
- 大小:47.20KB
工程电磁 场.docx
《工程电磁 场.docx》由会员分享,可在线阅读,更多相关《工程电磁 场.docx(24页珍藏版)》请在冰豆网上搜索。
工程电磁场
工程电磁场报告
学生姓名杜建民
学号2013299
班级电气11班
1需要调试的程序
!
!
PROGRAMOFFEMFORLINEARFIELDS
PROGRAMMAIN
IMPLICITNONE
INTEGERL0,E0,NK,L01,E01,NU,XING,S,XST,
&YST,IST,JST,MST,EKST,HST,GST,LUOST,UOST,
&EQST,QST,NST,PST,KOST,KST,A(300000)
REALB(300000)
OPEN(UNIT=10,FILE='data.dat')
OPEN(UNIT=11,FILE='outputdata.dat')
OPEN(UNIT=12,FILE='OUTMATRIX.DAT')
CALLREAD1(L0,E0,NK,L01,E01,NU,XING)
XST=1
YST=XST+L0
HST=YST+L0
GST=HST+NK
UOST=GST+NK
QST=UOST+L01
PST=QST+E01
KOST=PST+L0
KST=KOST+L0
IST=1
JST=IST+E0
MST=JST+E0
EKST=MST+E0
LUOST=EKST+NK
EQST=LUOST+L01
NST=EQST+E01
CALLREAD2(L0,E0,NK,L01,E01,B(XST),B(YST),
&A(IST),A(JST),A(MST),A(EKST),B(HST),B(GST),
&A(LUOST),B(UOST),A(EQST),B(QST))
CALLNVECTO(L0,E0,S,A(IST),A(JST),A(MST),A(NST))
CALLKP(L0,E0,NK,E01,XING,S,B(XST),B(YST),
&A(IST),A(JST),A(MST),A(EKST),B(HST),B(GST),
&A(EQST),B(QST),A(NST),B(PST),B(KST))
CALLMODIFY(L0,L01,S,A(LUOST),B(UOST),A(NST),B(PST),B(KST))
CALLGAUSE(L0,S,A(NST),B(KOST),B(PST),B(KST))
CALLBXBY(L0,E0,NK,XING,B(XST),B(YST),
&A(IST),A(JST),A(MST),A(EKST),B(HST),B(GST),B(PST))
CALLISOPO(L0,E0,NU,B(XST),B(YST),A(IST),A(JST),A(MST),B(PST))
CLOSE(UNIT=10)
CLOSE(UNIT=11)
CLOSE(UNIT=12)
ENDPROGRAMMAIN
!
n
SUBROUTINEREAD1(L0,E0,NK,L01,E01,NU,XING)
INTEGERL0,E0,NK,L01,E01,NU,XING
READ(10,*)L0,E0,NK,L01,E01,NU,XING
WRITE(11,1001)L0,E0,NK,L01,E01,NU,XING
1001FORMAT(/////,2X,'L0=',I5,3X,'E0=',I5,3X,'NK=',I3,3X,
&'L01=',I4,3X,'E01=',I4,3X,'NU=',I4,/,2X,'XING=',I2,3X)
END
!
!
SUBROUTINETOREADDATA2
!
SUBROUTINEREAD2(L0,E0,NK,L01,E01,X,Y,I,J,
&M,EK,H,G,LU0,U0,EQ,Q)
INTEGERL0,E0,NK,L01,E01,I(E0),J(E0),M(E0),
&EK(NK),LU0(L01),EQ(E01)
REALX(L0),Y(L0),H(NK),G(NK),U0(L01),Q(E01)
WRITE(11,1001)
READ(10,*)(X(L),Y(L),L=1,L0)
WRITE(11,1002)(X(L),Y(L),L=1,L0)
WRITE(11,1003)
READ(10,*)(I(L),J(L),M(L),L=1,E0)
WRITE(11,1004)(I(L),J(L),M(L),L=1,E0)
WRITE(11,1005)
READ(10,*)(EK(L),H(L),G(L),L=1,NK)
WRITE(11,1006)(EK(L),H(L),G(L),L=1,NK)
WRITE(11,1007)
READ(10,*)(LU0(L),U0(L),L=1,L01)
WRITE(11,1008)(LU0(L),U0(L),L=1,L01)
WRITE(11,1009)
READ(10,*)(EQ(L),Q(L),L=1,E01)
WRITE(11,1010)(EQ(L),Q(L),L=1,E01)
1001FORMAT(//,7X,'X',13X,'Y')
1002FORMAT(2F14.6)
1003FORMAT(//,8X,'I',8X,'J',8X,'M')
1004FORMAT(3I9)
1005FORMAT(//,7X,'EK',5X,'H',13X,'G')
1006FORMAT(I9,2E14.6)
1007FORMAT(//,6X,'LU0',4X,'U0')
1008FORMAT(I9,E14.6)
1009FORMAT(//,7X,'EQ',5X,'Q')
1010FORMAT(I9,E14.6)
END
!
!
SUBROUTINEYIELDTHEVECTORN
!
SUBROUTINENVECTO(L0,E0,S,I,J,M,N)
INTEGERL0,E0,S,I(E0),J(E0),M(E0),N(L0)
N
(1)=1
DO2L=2,L0
LA=0
DO1LE=1,E0
IE=I(LE)
JE=J(LE)
ME=M(LE)
IF(.NOT.(L.EQ.IE.OR.L.EQ.JE.OR.L.EQ.ME))GOTO1
LI=L-IE
LJ=L-JE
LM=L-ME
LC=MAX0(LI,LJ,LM)
IF(LC.GT.LA)LA=LC
1CONTINUE
N(L)=N(L-1)+LA+1
2CONTINUE
S=N(L0)
WRITE(11,1001)S
1001FORMAT(//,5X,'S=',I7)
END
!
!
SUBROUTINETOYIELDTHEVECTORKANDP
!
SUBROUTINEKP(L0,E0,NK,E01,XING,S,X,Y,I,J,M,EK,H,G,EQ,Q,N,P,K)
INTEGERL0,E0,NK,E01,XING,S,I(E0),J(E0),M(E0),EK(NK),EQ(E01),N(L0)
REALX(L0),Y(L0),H(NK),G(NK),Q(E01),P(L0),K(S)
DO1LA=1,S
K(LA)=0.0
1CONTINUE
DO2L=1,L0
P(L)=0.0
2CONTINUE
DO4LE=1,E0
CALLDEL(L0,E0,NK,X,Y,I,J,M,EK,H,G,LE,IE,JE,ME,BI,BJ,
&BM,CI,CJ,CM,DELTA,YJ,YM,Y0,Y1,B,C)
D=B/4.0/DELTA
IF(XING.EQ.2)D=D*Y0
IF(XING.EQ.4)D=D*Y1
LA=N(IE)
K(LA)=K(LA)+D*(BI*BI+CI*CI)
LA=N(JE)
K(LA)=K(LA)+D*(BJ*BJ+CJ*CJ)
LA=N(ME)
K(LA)=K(LA)+D*(BM*BM+CM*CM)
LA=N(JE)-(JE-IE)
IF(IE.GT.JE)LA=N(IE)-(IE-JE)
K(LA)=K(LA)+D*(BI*BJ+CI*CJ)
LA=N(ME)-(ME-JE)
IF(JE.GT.ME)LA=N(JE)-(JE-ME)
K(LA)=K(LA)+D*(BJ*BM+CJ*CM)
LA=N(IE)-(IE-ME)
IF(ME.GT.IE)LA=N(ME)-(ME-IE)
K(LA)=K(LA)+D*(BM*BI+CM*CI)
A=C*DELTA/3.0
P(IE)=P(IE)+A
P(JE)=P(JE)+A
P(ME)=P(ME)+A
DO3LA=1,E01
IF(LE.NE.EQ(LA))GOTO3
IF(XING.NE.2)YJ=1.0
IF(XING.NE.2)YM=1.0
SI=SQRT(BI*BI+CI*CI)
P(JE)=P(JE)+Q(LA)*SI/3.0*(YJ+YM/2.0)
P(ME)=P(ME)+Q(LA)*SI/3.0*(YM+YJ/2.0)
3CONTINUE
4CONTINUE
END
!
!
SUBROUTINETOCALCULATEATRIANGLE
!
SUBROUTINEDEL(L0,E0,NK,X,Y,I,
&J,M,EK,H,G,LE,IE,JE,ME,BI,BJ,BM,CI,CJ,CM,
&DELTA,YJ,YM,Y0,Y1,B,C)
INTEGERL0,E0,NK,I(E0),J(E0),M(E0),EK(NK)
REALX(L0),Y(L0),H(NK),G(NK)
IE=I(LE)
JE=J(LE)
ME=M(LE)
XI=X(IE)
XJ=X(JE)
XM=X(ME)
YI=Y(IE)
YJ=Y(JE)
YM=Y(ME)
BI=YJ-YM
BJ=YM-YI
BM=YI-YJ
CI=XM-XJ
CJ=XI-XM
CM=XJ-XI
DELTA=(BI*CJ-BJ*CI)/2.0
Y0=(YI+YJ+YM)/3.0
Y1=1.0/Y0
IF(.NOT.((YI+YJ).EQ.0.0.OR.(YJ+YM).EQ.0.0.OR.(YM+YI).EQ.0.0))
&Y1=2.0/3.0*(1.0/(YI+YJ)+1.0/(YJ+YM)+1.0/(YM+YI))
DO1LA=1,NK
B=H(LA)
C=G(LA)
IF(LE.LE.EK(LA))GOTO2
1CONTINUE
2CONTINUE
END
!
SUBROUTINETOMODIFYTHEEQUATION
!
!
SUBROUTINEMODIFY(L0,L01,S,LU0,U0,N,P,K)
!
INTEGERL0,L01,S,LU0(L01),N(L0)
!
REALP(L0),K(S),U0(L01)
!
DO3LA=1,L01
!
L=LU0(LA)
!
NL=N(L)
!
K(NL)=1.0
!
P(L)=U0(LA)
!
L1=L-(N(L)-N(L-1)-1)
!
L2=L-1
!
DO1LB=L1,L2
!
NLB=N(L)-(L-LB)
!
P(LB)=P(LB)-U0(LA)*K(NLB)
!
K(NLB)=0.0
!
1CONTINUE
!
L1=L+1
!
DO2LB=L1,L0
!
IF((LB-L).GT.(N(LB)-N(LB-1)-1))GOTO2
!
NLB=N(LB)-(LB-L)
!
P(LB)=P(LB)-U0(LA)*K(NLB)
!
K(NLB)=0.0
!
2CONTINUE
!
3CONTINUE
!
END
!
SUBROUTINETOMODIFYTHEEQUATION在运行的过程中,
!
当LA=1时,则L=1,此时L-1=0,但N(L-1)=N(0),而N(0)却没有定义
!
运行时会出现数组越界,所以将上述子程序修改成以下的子程序:
!
形成方阵,强加边界条件
SUBROUTINEMODIFY(L0,L01,S,LU0,U0,N,P,K)
INTEGERL0,L01,S,LU0(L01),N(L0)
REALP(L0),K(S),U0(L01)
integerii,jj,ll,zz,xx,cc,vv,bb,mm,aa,ss,tt
realfazhen(9,9)
doii=1,9,1
dojj=1,9,1
if(jj==ii)then
ll=N(ii)
fazhen(ii,ii)=k(ll)
elseif((ii ll=N(jj) fazhen(ii,jj)=k(ll-(jj-ii)) elseif((ii fazhen(ii,jj)=0.0 elseif(ii>jj.AND.((ii-jj)<(N(ii)-N(ii-1))))then ll=N(ii) fazhen(ii,jj)=k(ll-(ii-jj)) elseif(ii>jj.AND.((ii-jj)>=(N(ii)-N(ii-1))))then fazhen(ii,jj)=0.0 endif enddo enddo dozz=1,3,1 p(zz)=5005.0 doxx=1,9,1 if(xx/=zz)then p(xx)=p(xx)-fazhen(xx,zz)*5005.0 endif enddo docc=1,9,1 if(cc==zz)then fazhen(zz,cc)=1.0 else fazhen(zz,cc)=0.0 fazhen(cc,zz)=0.0 endif enddo enddo dovv=7,9,1 dobb=1,9,1 if(vv==bb)then fazhen(vv,bb)=1.0 else fazhen(vv,bb)=0.0 endif enddo p(vv)=0.0 enddo doii=1,9,1 dojj=1,9,1 if(jj==ii)then ll=N(ii) k(ll)=fazhen(ii,ii) elseif((ii ll=N(jj) k(ll-(jj-ii))=fazhen(ii,jj) elseif(ii>jj.AND.((ii-jj)<(N(ii)-N(ii-1))))then ll=N(ii) k(ll-(ii-jj))=fazhen(ii,jj) endif enddo enddo END ! ! SUBOUTINETOSOLVETHEEQUATIONS ! SUBROUTINEGAUSE(L0,S,N,K0,P,K) INTEGERL0,S,N(L0) REALK0(L0),P(L0),K(S) WRITE(12,1003)(K(L),L=1,S) 1003FORMAT(5E14.6) DO1L=1,L0 K0(L)=0.0 1CONTINUE WRITE(12,1004) WRITE(12,1005)(P(L),L=1,L0) 1004FORMAT(//) 1005FORMAT(E14.6) DO4L=1,L0 NL=N(L) P(L)=P(L)/K(NL) L1=L+1 DO3LB=L1,L0 IF((LB-L).GT.(N(LB)-N(LB-1)-1))GOTO3 LC=N(LB)-(LB-L) K0(LB)=K(LC)/K(NL) L1=LC+1 L2=N(LB) DO2LA=L1,L2 LAC=L+LA-LC K(LA)=K(LA)-K(LC)*K0(LAC) 2CONTINUE P(LB)=P(LB)-K(LC)*P(L) K(LC)=K0(LB) 3CONTINUE K(NL)=1.0 4CONTINUE L2=L0-1 DO6LL=1,L2 L=L0-LL L1=L+1 DO5LB=L1,L0 IF((LB-L).GT.(N(LB)-N(LB-1)-1))GOTO5 NLB=N(LB)-(LB-L) P(L)=P(L)-K(NLB)*P(LB) 5CONTINUE 6CONTINUE WRITE(11,1001) WRITE(11,1002)(P(L),L=1,L0) 1001FORMAT(//,39X,'U') 1002FORMAT(5E14.6) END ! ! SUBROUTINETOCALCULATEFLUXDENSITIES ! SUBROUTINEBXBY(L0,E0,NK,XING,X,Y,I,J,M,EK,H,G,P) INTEGERL0,E0,NK,XING,I(E0),J(E0),M(E0),EK(NK) REALX(L0),Y(L0),H(NK),G(NK),P(L0) WRITE(11,1001) DO1LE=1,E0 CALLDEL(L0,E0,NK,X,Y,I,J, &M,EK,H,G,LE,IE,JE,ME,BI,BJ,BM,CI,CJ,CM, &DELTA,YJ,YM,Y0,Y1,B,C) UX=(BI*P(IE)+BJ*P(JE)+BM*P(ME))/2.0/DELTA UY=(CI*P(IE)+CJ*P(JE)+CM*P(ME))/2.0/DELTA IF(XING.EQ.1.OR.XING.EQ.2)BX=-B*UX IF(XING.EQ.1.OR.XING.EQ.2)BY=-B*UY IF(XING.EQ.3)BX=UY IF(XING.EQ.3)BY=-UX IF(XING.EQ.4)BX=UY*Y1 IF(XING.EQ.4)BY=-UX*Y1 BB=SQRT(BX*BX+BY*BY) WRITE(11,1002)LE,BX,BY,BB 1CONTINUE 1001FORMAT(//,8X,'E',4X,'BX',12X,'BY',13X,'B') 1002FORMAT(I9,3E14.6) END ! ! SUBROUTINETOCALCULATEFORISOPOTENTIALLINE ! SUBROUTINEISOPO(L0,E0,NU,X,Y,I,J,M,P) INTEGERL0,E0,NU,I(E0),J(E0),M(E0) REALX(L0),Y(L0),P(L0) A=P (1) B=P (1) DO1L=1,L0 C=P(L) IF(C.GT.A)A=C IF(C.LT.B)B=C 1CONTINUE DU=(A-B)/(NU+1) B=B+DU 2WRITE(11,1001)B DO5LE=1,E0 IE=I(LE) JE=J(LE) ME=M(LE) IF((P(IE)-B)*(P(JE)-B).GT.0.0)GOTO3 CALLUU(L0,X,Y,P,B,IE,JE,X0,Y0) WRITE(11,1002)LE,X0,Y0 3IF((P(JE)-B)*(P(ME)-B).GT.0.0)GOTO4 CALLUU(L0,X,Y,P,B,JE,ME,X0,Y0) WRITE(11,1002)LE,X0,Y0 4IF((P(ME)-B)*(P(IE)-B).GT.0.0)GOTO5 CALLUU(L0,X,Y,P,B,ME,IE,X0,Y0) WRITE(11,1002)LE,X0,Y0 5CONTINUE B=B+DU IF(B.LT.A)GOTO2 1001FORMAT(//,11X,'U=',E14.6,/,8X,'E',7X,'X',13X,'Y') 1002FORMAT(I9,2F14.6) END ! ! SUBROUTINETOYIELDCOORDINATESOFTHELINES ! SUBROUTINEUU(L0,X,Y,P,B,I0,J0,X0,Y0) INTEGERL0,I0,J0 REALX(L0),Y(L0),P(L0),B,X0,Y0 IF(P(I0).EQ.B)D=0.0 IF(P(I0).NE.B)D=(P(I0)-B)/(P(I0)-P(J0)) X0=(1.0-D)*X(I0)+D*X(J0) Y0=(1.0-D)*Y(I0)+D*Y(J0) END 2关于运行程序的结果如下: Outputdata L0=9E0=8NK=2L01=6E01=4NU=10 XING=1 XY 0.0000000.020000 0.0100000.020000 0.0200000.020000 0.0000000.010000 0.0100000.010000 0.0200000.010000 0.0000000.000000 0.0100000.000000 0.0200000.000000 IJM 214 452 325 563 547 785 658 896 EKHG 40.125000E-050.000000E+00 80.125000E-020.000000E+00 LU0
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- 工程电磁 工程 电磁