| 查看: 819 | 回复: 2 | |||
[求助]
哪位专家帮我把原来的BASIC语言改成VB语言吗，我万分感谢！
|
|
这是通风网络解算中的部分程序： 以下为选余树 50 For I = 1 To NN KJ(I) = 0 Next I 60 MJ = 0 For K = 1 To NN JA = J1(K) JB = J2(K) If JA = JB Then Print "分支始末节点号相同" If JA < 0 Or JB < 0 Then Print "分支节点为负" If JA > 0 And JB > 0 Then KJ(JA) = KJ(JA) + 1 KJ(JB) = KJ(JB) + 1 If JA > MJ Then MJ = JA If JB > MJ Then MJ = JB End If Next K 70 NJ = 0 For J = 1 To MJ If KJ(J) = 0 Then GoTo 90 If KJ(J) > 0 Then NJ = NJ + 1 Else Print "分支走不通" End If 90 Next J 130 KF = NK + NF: IIS = KF + 1: IE = NN - 1: JE = IE For I = IIS To IE For J = IIS To JE If RR(J + 1) > RR(J) Then T = RR(J): RR(J) = RR(J + 1): RR(J + 1) = T B = BR(J): BR(J) = BR(J + 1): BR(J + 1) = B End If Next J JE = JE - 1 Next I 190 For I = 1 To NJ JC(I) = 0 Next I 200 L = 0: N = 0 210 For I = NN To KF + 1 Step -1 220 NT(I) = 0: K = BR(I): JA = J1(K): JB = J2(K) 230 If JC(JA) = JC(JB) Then GoTo 330 240 If JC(JA) > JC(JB) Then GoTo 290 250 If JC(JA) = 0 Then GoTo 280 260 GoSub 380 270 GoTo 360 280 JC(JA) = JC(JB): GoTo 360 290 If JC(JB) = 0 Then GoTo 320 300 GoSub 380 310 GoTo 360 320 JC(JB) = JC(JA): GoTo 360 330 If JC(JA) = 0 Then GoTo 350 340 NT(I) = 1: N = N + 1: GoTo 360 350 L = L + 1: JC(JA) = L: JC(JB) = L 360 Next I 370 GoTo 420 380 JJ = JC(JB) 390 For J = 1 To NJ: If JC(J) = JJ Then JC(J) = JC(JA) 400 Next J 410 Return 420 If N + NK + NF = NM Then GoTo 440 Else Print "N="; N; "KF="; KF; End If 440 If KF > 0 Then GoTo 460 450 GoTo 470 460 For I = 1 To KF NT(I) = 1 Next I 470 JK = 0: JE = 0: L = 0 '以下为选回路 480 For I = 1 To NN If NT(I) > 0 Then GoTo 500 490 GoTo 730 500 K = BR(I): L = L + 1: JK = JK + 1: NNA(JK) = K: JA = J1(K): JB = J2(K): N = I + 1 510 For J = N To NN If NT(J) = 0 Then GoTo 530 520 GoTo 600 530 K = BR(J): If JB = J1(K) Then GoTo 570 540 If JB = J2(K) Then GoTo 560 550 GoTo 600 560 JB = J1(K): JK = JK + 1: NNA(JK) = -K: GoTo 580 570 JB = J2(K): JK = JK + 1: NNA(JK) = K 580 If JA = JB Then GoTo 620 590 NT(J) = -1: GoTo 510 600 Next J 610 GoTo 660 620 For W = N To NN If NT(W) >= 0 Then GoTo 640 630 NT(W) = 0 640 Next W 650 MME(L) = JK: JE = JK: GoTo 730 660 K = Abs(NNA(JK)) 670 If NNA(JK) >= 0 Then GoTo 690 680 JB = J2(K): GoTo 700 690 JB = J1(K) 700 JK = JK - 1 710 If JK > JE Then GoTo 510 Else K = BR(I) Print "K="; K; End If 730 Next I 740 ML = MME(NM): Print 我还有一部分是用FORTRAN语言编的程序，和这一段是一样的内容，可以参考帮我把上面这一段改成VB语言，谢谢。 下面是用FORTRAN语言编的程序： !--------2.分支排序 DO 11 I=1,999 KJ(I)=0 11 CONTINUE MJ=0 DO 14 K=1,NB JA=J1(K) JB=J2(K) IF(JA.EQ.JB) GOTO 12 IF((JA.GT.0).AND.(JB.GT.0)) GOTO 13 12 WRITE(*,225) J1(K) 13 IF(JA.GT.0) KJ(JA)=KJ(JA)+1 IF(JA.GT.0) KJ(JB)=KJ(JB)+1 IF(JA.GT.MJ) MJ=JA IF(JB.GT.MJ) MJ=JB 14 CONTINUE NJ=0 DO 18 J=1,MJ IF(KJ(J).EQ.0) GOTO 18 IF(KJ(J).GT.0) GOTO 17 WRITE(*,226) J 16 STOP 16 17 NJ=NJ+1 18 CONTINUE NM=NB-NJ+1 19 DO 20 I=1,NB RR(I)=R(I) 20 CONTINUE DO 23 I=NFBPF+1,NB-1 DO 22 J=I+1,NB IF(RR(I)-RR(J)) 21,22,22 21 T=RR(J) RR(J)=RR(I) RR(I)=T M=BRANCH(J) BRANCH(J)=BRANCH(I) BRANCH(I)=M 22 CONTINUE 23 CONTINUE !--------3.选余树 24 DO 25 J=1,MJ JC(J)=0 25 CONTINUE I=NB+1 L=0 N=0 DO 36 IK=NFBPF+1,NB I=I-1 OUT(I)=0 K=BRANCH(I) JA=J1(K) JB=J2(K) IF(JC(JA)-JC(JB)) 31,33,26 26 IF(JC(JB)) 27,30,27 27 JJ=JC(JB) DO 29 J=1,MJ IF(JC(J)-JJ) 29,28,29 28 JC(J)=JC(JA) 29 CONTINUE GOTO 36 30 JC(JB)=JC(JA) GOTO 36 31 IF(JC(JA)) 27,32,27 32 JC(JA)=JC(JB) GOTO 36 33 IF(JC(JA)) 34,35,34 34 OUT(I)=1 N=N+1 GOTO 36 35 L=L+1 JC(JA)=L JC(JB)=L 36 CONTINUE M=N+NFBPF-NM IF(M) 37,38,37 37 WRITE(*,203) N STOP 37 38 IF(NFBPF) 41,41,39 39 DO 40 I=1,NFBPF OUT(I)=1 40 CONTINUE !--------4.选回路 41 JK=0 JE=0 L=0 DO 59 I=1,NB IF(OUT(I)) 59,59,42 42 K=BRANCH(I) L=L+1 JK=JK+1 NA(JK)=K JA=J1(K) JB=J2(K) N=I+1 43 DO 50 J=N,NB IF(OUT(J)) 50,44,50 44 K=BRANCH(J) IF(JB-J1(K)) 46,45,46 45 JB=J2(K) JK=JK+1 NA(JK)=K GOTO 48 46 IF(JB-J2(K)) 50,47,50 47 JB=J1(K) JK=JK+1 NA(JK)=-K 48 IF(JB-JA)49,56,49 49 OUT(J)=-1 GOTO 55 50 CONTINUE K=IABS(NA(JK)) IF(NA(JK))52,51,51 51 JB=J1(K) GOTO 53 52 JB=J2(K) 53 JK=JK-1 IF(JK-JE) 54,54,43 54 K=BRANCH(I) WRITE(*,217) K STOP 54 55 GOTO 43 56 DO 58 J=N,NB IF(OUT(J)) 57,58,58 57 OUT(J)=0 58 CONTINUE ME(L)=JK JE=JK 59 CONTINUE |
回复此楼» 猜你喜欢
A期刊撤稿
已经有5人回复
-
临港实验室与上科大联培博士招生1名
已经有8人回复
-
26申博自荐
已经有7人回复
-
想换工作。大多数高校都是 评职称时 认可5年内在原单位取得的成果吗？
已经有4人回复
-
带资进组求博导收留
已经有9人回复
-
求助大佬们，伤口沾上了乙腈
已经有6人回复
-
最近几年招的学生写论文不引自己组发的文章
已经有9人回复
2楼2016-01-22 05:54:52
3楼2016-03-05 11:43:10