Solved

Convert Pascal code to Basic?

Posted on 1998-04-14
14
432 Views
Last Modified: 2010-04-16
I have pascal program that I need to change to a Visual Basic program.  The program I am converting is a mathmatical algorithum, it takes a text input file and outputs a text file.  I need to incorporate this algorithum into a visual basic program.  Does anyone know of any programs that will do this?  Or, would anyone be willing to do it for some points?  I can post the program if anyone is interested.  I am willing to give 500 points for someone to convert it.  
0
Comment
Question by:Tom_Hickerson
  • 5
  • 3
  • 2
  • +3
14 Comments
 
LVL 2

Expert Comment

by:omsec
ID: 1217481
I dont think there are any programs to convert a "normal" DOS-Source into any Visual Windows lang such as VB, Delphi or VCPP. Sorry, i've never messed with Basic or VB, Delphi only, if you dont find anyone here, try the VB part.
0
 
LVL 1

Author Comment

by:Tom_Hickerson
ID: 1217482
The program I am converting is a math routine.  I am not concerned with converting it into a visual program.  I just want the algoritim changed into VB.  
0
 
LVL 1

Author Comment

by:Tom_Hickerson
ID: 1217483
Edited text of question
0
 
LVL 5

Expert Comment

by:inter
ID: 1217484
Hi,

I may try if you send it:

inter@kosgeb.tekmer.gov.tr

Regards,
Igor
0
 
LVL 84

Expert Comment

by:ozo
ID: 1217485
Others may try if you post it.
0
 
LVL 1

Author Comment

by:Tom_Hickerson
ID: 1217486
Here it is, all I am concerned with is the algorithom part.  I do not need to input a file, or output one, just to have the input values in a array and then it give me the outputs in another array.
E-mail questions or Bids on converting it.


{$R-}    {Range checking off}
{$B+}    {Boolean complete evaluation on}
{$S+}    {Stack checking on}
{$I+}    {I/O checking on}
{$N+}    {numeric coprocessor}
{$M 65500,16384,655360} {Turbo 3 default stack and heap}

    program PSA;

Uses
  Crt;

label 1000,2000;
    type
      vector  = array[1..20] of real;
      ivector = array[1..20] of integer;
      imatrix = array[1..20,1..10] of integer;
      cvector = array[1..20] of char;
      matrix  = array[1..20,1..20] of real;
      cstr    = packed array[1..2] of char;
      ccstr   = string[10];
      cccstr  = string[50];
    var
      IL,JL,IT,JT,TYP,CODE,ICODE,ROW,BFLAG                : ivector;
      COL                                                 : imatrix;
      RL,XL,BL,SL,RT,XT,CT,ST,DA,DV,VSPEC                 : vector;
      V,DEL,PG,QG,QMAX,QMIN,PL,QL,PT,QT,DP,DQ             : vector;
      TY                                                  : cvector;
      G,B,BI,BPI,BQI,A,AI,BP,BQ                           : matrix;
      ANS,ELEM,STAR,AWS,AWR,DUMMYC                        : char;
      SRAT,DEG,ANGLE,MAXDA,MAXDV,VRi,VIi,VRj,VIj,RDATA    : real;
      ZM,ZA,R,X,C,GE,BE,BC,YM,YA,IRi,IIi,IRj,IIj,Si,Sj    : real;
      Pij,Pji,Qij,Qji,PGTOT,QGTOT,PLTOT,QLTOT,PLOSS,QLOSS : real;
      NL,NT,NB,I,J,K,IMAX,JC,ITER,NSLACK,JTER,IC          : integer;
      N1,N2,NB1,NB0,NA,NI,NJ,DFLAG,VFLAG,WFLAG,IFLAG      : integer;
      OK                                                  : boolean;
      SCASE,NUMB,OUTFILE                                  : cccstr;
      CTITLE,RTITLE                                       : cccstr;
      IOUT,IIN                                            : text;
      DUMMY                                               : string;
  {=================================================================}
    procedure INITIALIZE;     forward;
    procedure BCHECK;         forward;
    procedure DISLINE;        forward;
    procedure DISTRAN;        forward;
    procedure DISBUS;         forward;
    procedure LOAD;           forward;
    procedure HEADING;        forward;
    procedure RENUMBER;       forward;
    procedure YBUILD;         forward;
    procedure BPMAT;          forward;
    procedure BQMAT;          forward;
    procedure INVERSE;        forward;
    procedure PQTRANS;        forward;
    procedure PQFLOW;         forward;
    procedure TOTALS;         forward;
    procedure VARLIMIT;       forward;
    procedure DISMAT;         forward;
    procedure BUSDIAG;        forward;
    procedure LINEFLOW;       forward;
    procedure TRANFLOW;       forward;
    procedure HARDCOPY;       forward;
 {==================================================================}
    function CREAL(S: string; X: real): real;
      var
        I,J,K :            integer;
        begin
          K:=0;
          J:=length(S);
          if(S[1]='-')then begin
            K:=1;
            S[1]:='0';
            end;
          if(S[J]='.')then S:=concat(S,'0');
          if(S[1]='.')then S:=concat('0',S);
          if(J<>0)then val(S,X,I);
          CREAL:=X;
          if(K=1)then CREAL:=-X;
        end;
  {=================================================================}
    function CINTER(S: string; X: integer): integer;
      var
        II,J :            integer;
        begin
          J:=length(S);
          if(J<>0)then val(S,X,II);
          CINTER:=X;
        end;
  {=================================================================}
    function CCHAR(S: string; X: char): char;
      var
        I,J :            integer;
        begin
          J:=length(S);
          if(J<>0)then CCHAR:=upcase(S[1]);
          if(J=0)then  CCHAR:=upcase(X);
        end;
  {=================================================================}
    function MAG(R,X: real): real;
      var
        Z: real;
        begin
          Z:=SQRT(SQR(R)+SQR(X));
          MAG:=Z;
        end;
  {=================================================================}
    function ANG(R,X: real): real;
      var
        A: real;
      begin
        if(R=0.0)then begin
          if(X>0.0)then
            A:=PI/2.0
            ELSE
            A:=-PI/2.0;
          end;
        if(R>0.0)then begin
          A:=ARCTAN(X/R);
        end;
        if(R<0.0)then begin
          A:=PI+ARCTAN(X/R);
        end;
        if((R=0.0)AND(X=0.0))then begin
          A:=0.0
        end;
        ANG:=A;
        end;
  {==================================}
      procedure INITIALIZE;
      begin
      RTITLE:='  ';
      DFLAG:=0;
      NL:=0;
      NT:=0;
      NB:=0;
      WFLAG:=0;
      for I:=1 to 20 do begin
          TY[I]:='L';
          IL[I]:=0;
          JL[I]:=0;
          IT[I]:=0;
          JT[I]:=0;
          BFLAG[I]:=0;
          TYP[I]:=1;
          V[I]:=1.0;
          DEL[I]:=0.0;
          DV[I]:=0.0;
          DA[I]:=0.0;
          PT[I]:=0.0;
          QT[I]:=0.0;
          PG[I]:=0.0;
          QG[I]:=0.0;
          PL[I]:=0.0;
          QL[I]:=0.0;
          QMAX[I]:=0.0;
          QMIN[I]:=0.0;
          RL[I]:=0.0;
          XL[I]:=0.0;
          BL[I]:=0.0;
          SL[I]:=0.0;
          RT[I]:=0.0;
          XT[I]:=0.0;
          CT[I]:=1.0;
          ST[I]:=0.0;
        end;
      end;
    {------------------------------------------------------------------}
      procedure DISLINE;
      begin
      clrscr;
      writeln(IOUT);
      writeln(IOUT,'======================== LINE DATA =========================');
      writeln(IOUT,' Line#    Bus     Bus       R         X         B      Srat ');
      writeln(IOUT,'------------------------------------------------------------');
      I:=1;
      if(NL>0)then begin
        repeat
        writeln(IOUT,I:4,IL[I]:8,JL[I]:8,RL[I]:10:5,XL[I]:10:5,BL[I]:10:5,SL[I]:10:4);
        I:=I+1;
        until I>NL;
        end;
      writeln(IOUT,'============================================================');
      end;
     {------------------------------------------------------------------}
      procedure DISTRAN;
      begin
      clrscr;
      writeln(IOUT);
      writeln(IOUT,'===================== TRANSFORMER DATA ========================');
      writeln(IOUT,' Tran#   HV Bus  LV Bus        R         X         C      Srat ');
      writeln(IOUT,'---------------------------------------------------------------');
      I:=1;
      if(NT>0)then begin
      repeat
        writeln(IOUT,I:4,IT[I]:8,JT[I]:8,RT[I]:13:5,XT[I]:10:5,CT[I]:10:4,ST[I]:10:4);
        I:=I+1;
      until I>NT;
      end;
      writeln(IOUT,'===============================================================');
      end;
    {------------------------------------------------------------------}
      procedure DISBUS;
      begin
      clrscr;
      writeln(IOUT);
      writeln(IOUT,'========================= BUS DATA ==================================');
      writeln(IOUT,' Bus  Type    V    Delta    Pgen      Qmax    Qmin     Pload   Qload ');
      writeln(IOUT,'---------------------------------------------------------------------');
      for I:=1 to NB do begin;
        DEL[I]:=(180.0/PI)*DEL[I];
        writeln(IOUT,I:3,'     ',TY[I],V[I]:8:4,DEL[I]:7:1,PG[I]:9:4,
                     QMAX[I]:9:4,QMIN[I]:9:4,PL[I]:9:4,QL[I]:9:4);
        DEL[I]:=(PI/180.0)*DEL[I];
        end;
      writeln(IOUT,'=====================================================================');
      end;
    {------------------------------------------------------------------}
      procedure DISCBUS;
      begin
      clrscr;
      writeln(IOUT);
      writeln(IOUT,'====================== CONVERGED BUS DATA =========================');
      writeln(IOUT,'|Bus Type Code   V      Delta     Pgen      Qgen    Pload    Qload ');
      writeln(IOUT,'-------------------------------------------------------------------');
      for I:=1 to NB do begin;
        DEL[I]:=(180.0/PI)*DEL[I];
        STAR:=' ';
        if(V[I]>1.05)then STAR:='*';
        if(V[I]<0.95)then STAR:='*';
        writeln(IOUT,I:3,STAR:3,TY[I]:2,CODE[I]:4,V[I]:9:4,DEL[I]:7:1,
                     PG[I]:10:4,QG[I]:10:4,PL[I]:9:3,QL[I]:9:3);
        DEL[I]:=(PI/180.0)*DEL[I];
        end;
      writeln(IOUT,'===================================================================');
      writeln(IOUT,'       Code = 0/1 = Voltage Control off/on; (*) = Hi,Lo V.');
      writeln(IOUT);
      end;
    {------------------------------------------------------------------}
      procedure BCHECK;
      begin
      K:=1;
      for I:=1 to NL do begin;
        BFLAG[IL[I]]:=1;
        BFLAG[JL[I]]:=1;
        if(IL[I]>K)then K:=IL[I];
        if(JL[I]>K)then K:=JL[I];
        end;
      for I:=1 to NT do begin;
        BFLAG[IT[I]]:=1;
        BFLAG[JT[I]]:=1;
        if(IT[I]>K)then K:=IT[I];
        if(JT[I]>K)then K:=JT[I];
        end;
      if(K>NB)then begin;
        writeln('############################################');
        writeln('HIGHEST BUS NUMBER IN BUS DATA FILE:        ',NB:3);
        writeln('HIGHEST BUS NUMBER IN LINE/TRANS DATA FILE: ',K:3);
        writeln('CHECK SYSTEM DATA!');
        writeln('############################################');
        write('   Press <ENTER> to continue...');    readln;
        end;
      if(NB>K)then K:=NB;
      for I:=1 to K do begin;
        if(BFLAG[I]=0)then begin;
          writeln('############################################');
          writeln('BUS ',I:3,' HAS NO LINE/TRANSFORMER TERMINATIONS!');
          writeln('CHECK SYSTEM DATA!');
          writeln('############################################');
        write('   Press <ENTER> to continue...');    readln;
          end;
        end;
      for I:=1 to 20 do BFLAG[I]:=0;
      writeln;
      end;
    {------------------------------------------------------------------}
      procedure LOAD;
      begin
      writeln;
      assign(IIN,'o:\infiles.txt');
      {$I-} reset(IIN) {$I+};
      OK :=(IOresult=0);
      if not OK then begin;
         writeln('    File infiles.txt not in directory;  Major oops.');
         readln;
         end
      else begin;
      readln(IIN,SCASE);
      assign(IIN,SCASE);
      {$I-} reset(IIN) {$I+};
      OK:=(IOresult=0);
      writeln;
      if not OK then writeln('     File ',SCASE,'not found;  Sorry.');
      writeln;
      if OK then begin;
      readln(IIN,CTITLE);
      I:=1;
      repeat
        read(IIN,ELEM);
        if(ELEM<>'X')then readln(IIN,IL[I],JL[I],RL[I],XL[I],BL[I],SL[I]);
        I:=I+1;
      until ELEM='X';
      NL:=I-2;
      readln(IIN);
      I:=1;
      repeat
        read(IIN,ELEM);
        if(ELEM<>'X')then readln(IIN,IT[I],JT[I],RT[I],XT[I],CT[I],ST[I]);
        I:=I+1;
      until ELEM='X';
      NT:=I-2;
      readln(IIN);
      I:=1;
      repeat
        read(IIN,ELEM);
        if(ELEM<>'X')then begin
        CODE[I]:=0;
        readln(IIN,J,TYP[I],V[I],DEL[I],PG[I],QG[I],QMAX[I],QMIN[I],PL[I],QL[I]);
        if(TYP[I]=2)then TY[I]:='G';
        if(TYP[I]=2)then CODE[I]:=1;
        if(TYP[I]=3)then TY[I]:='S';
        if(TYP[I]=3)then NSLACK:=I;
        if(TYP[I]=3)then CODE[I]:=1;
        VSPEC[I]:=V[I];
        end;
        I:=I+1;
      until ELEM='X';
      NB:=I-2;
      readln(IIN);
      clrscr;
      writeln;
      writeln(IOUT,chr(12),CTITLE);
      HEADING;
      writeln;
      BCHECK;
      end;
      end;
      end;
  {------------------------------------------------------------------}
      procedure HEADING;
      begin
      writeln(IOUT,'============================================================');
      writeln(IOUT,'     Case Title: ',CTITLE);
      writeln(IOUT,'Run Description: ',RTITLE);
      writeln(IOUT,'System has ',NB:3,' Busses;',NL:3,' Lines; and ',NT:3,' Transformers.');
      writeln(IOUT);                                                          
      writeln(IOUT,'============================================================');
      end;
  {------------------------------------------------------------------}
      procedure RENUMBER;
      {Exchanges bus nos. N1 and N2}
      begin
      NB1:=NB+1;
      TYP[NB1]:=TYP[N1];
      TYP[N1]:=TYP[N2];
      TYP[N2]:=TYP[NB1];
      TY[NB1]:=TY[N1];
      TY[N1]:=TY[N2];
      TY[N2]:=TY[NB1];
      CODE[NB1]:=CODE[N1];
      CODE[N1]:=CODE[N2];
      CODE[N2]:=CODE[NB1];
      V[NB1]:=V[N1];
      V[N1]:=V[N2];
      V[N2]:=V[NB1];
      DEL[NB1]:=DEL[N1];
      DEL[N1]:=DEL[N2];
      DEL[N2]:=DEL[NB1];
      PG[NB1]:=PG[N1];
      PG[N1]:=PG[N2];
      PG[N2]:=PG[NB1];
      QMAX[NB1]:=QMAX[N1];
      QMAX[N1]:=QMAX[N2];
      QMAX[N2]:=QMAX[NB1];
      QMIN[NB1]:=QMIN[N1];
      QMIN[N1]:=QMIN[N2];
      QMIN[N2]:=QMIN[NB1];
      PL[NB1]:=PL[N1];
      PL[N1]:=PL[N2];
      PL[N2]:=PL[NB1];
      QL[NB1]:=QL[N1];
      QL[N1]:=QL[N2];
      QL[N2]:=QL[NB1];
      QG[NB1]:=QG[N1];
      QG[N1]:=QG[N2];
      QG[N2]:=QG[NB1];
      I:=1;
      repeat
        if(IL[I]=N1)then IL[I]:=NB1;
        if(JL[I]=N1)then JL[I]:=NB1;
        if(IL[I]=N2)then IL[I]:=N1;
        if(JL[I]=N2)then JL[I]:=N1;
        if(IL[I]=NB1)then IL[I]:=N2;
        if(JL[I]=NB1)then JL[I]:=N2;
        I:=I+1;
      until I>NL;
      I:=1;
      repeat
        if(IT[I]=N1)then IT[I]:=NB1;
        if(JT[I]=N1)then JT[I]:=NB1;
        if(IT[I]=N2)then IT[I]:=N1;
        if(JT[I]=N2)then JT[I]:=N1;
        if(IT[I]=NB1)then IT[I]:=N2;
        if(JT[I]=NB1)then JT[I]:=N2;
        I:=I+1;
      until I>NT;
      end;
{---------------------------------------------------------------------}
      procedure YBUILD;
      begin
      for I:=1 to 19 do begin
        ROW[I]:=0;
        for K:=1 to 10 do COL[I,K]:=0;
        for J:=1 to 19 do begin
          G[I,J]:=0.0;
          B[I,J]:=0.0;
        end;
      end;
      {===LINES===}
      if(NL>0)then begin
      for K:=1 to NL do begin
        I:=IL[K];
        J:=JL[K];
        ZM:=MAG(RL[K],XL[K]);
        ZA:=ANG(RL[K],XL[K]);
        YM:=1.0/ZM;
        GE:=YM*COS(ZA);
        BE:=-YM*SIN(ZA);
        G[I,I]:=G[I,I]+GE;
        B[I,I]:=B[I,I]+BE+BL[K]/2.0;
        G[I,J]:=G[I,J]-GE;
        B[I,J]:=B[I,J]-BE;
        G[J,I]:=G[I,J];
        B[J,I]:=B[I,J];
        G[J,J]:=G[J,J]+GE;
        B[J,J]:=B[J,J]+BE+BL[K]/2.0;
      end;
      end;
      {===TRANSFORMERS===}
      if(NT>0)then begin
      for K:=1 to NT do begin
        I:=IT[K];
        J:=JT[K];
        ZM:=MAG(RT[K],XT[K]);
        ZA:=ANG(RT[K],XT[K]);
        YM:=1.0/ZM;
        GE:=YM*COS(ZA);
        BE:=-YM*SIN(ZA);
        G[I,I]:=G[I,I]+GE;
        B[I,I]:=B[I,I]+BE;
        G[I,J]:=G[I,J]-CT[K]*GE;
        B[I,J]:=B[I,J]-CT[K]*BE;
        G[J,I]:=G[I,J];
        B[J,I]:=B[I,J];
        G[J,J]:=G[J,J]+GE*SQR(CT[K]);
        B[J,J]:=B[J,J]+BE*SQR(CT[K]);
      end;
      end;
      for I:=1 to NB do begin
        for J:=1 to NB do begin
          if(B[I,J]<>0.0)then begin
            ROW[I]:=ROW[I]+1;
            COL[I,ROW[I]]:=J;
            end;
        end;
      end;
      if(DFLAG=1)then begin
        write(IOUT,chr(12));
        writeln(IOUT);
        writeln(IOUT,'     ======= SYSTEM [Y] MATRIX =======');
        for I:=1 to NB do begin
          writeln(IOUT,'     ');
          writeln(IOUT,'     === ROW',I:3,' ===');
          K:=1;
          for J:=1 to NB do begin
            if(K=3)then begin
              writeln(IOUT,G[I,J]:9:3,' + j(',B[I,J]:9:3,')');
              K:=1;
              end
              else begin
              write(IOUT,G[I,J]:9:3,' + j(',B[I,J]:9:3,')   ');
              K:=K+1;
              end;
          end;
          writeln;
          write('  NONZEROS: NO.',ROW[I]:3,';  LOC: ');
          for K:=1 to 10 do write(COL[I,K]:3);
          writeln;
          readln;
      end;
    end;
    end;
  {------------------------------------------------------------------}
    procedure BPMAT;
    begin
      for I:=1 to NB do begin
        for J:= 1 to NB do BP[I,J]:=B[I,J];
      end;
      {===LINES===}
      if(NL>0)then begin
      for K:=1 to NL do begin
        I:=IL[K];
        J:=JL[K];
        ZM:=MAG(RL[K],XL[K]);
        ZA:=ANG(RL[K],XL[K]);
        YM:=1.0/ZM;
        BE:=-YM*SIN(ZA);
        BP[I,I]:=BP[I,I]-BL[K]/2.0;
        BP[J,J]:=BP[J,J]-BL[K]/2.0;
      end;
      end;
      {===TRANSFORMERS===}
      if(NT>0)then begin
      for K:=1 to NT do begin
        I:=IT[K];
        J:=JT[K];
        ZM:=MAG(RT[K],XT[K]);
        ZA:=ANG(RT[K],XT[K]);
        YM:=1.0/ZM;
        BE:=-YM*SIN(ZA);
        BP[I,J]:=BP[I,J]+CT[K]*BE-BE;
        BP[J,I]:=BP[I,J];
        BP[J,J]:=B[J,J]-BE*SQR(CT[K])+BE;
      end;
      end;
      write(IOUT,chr(12));
      writeln(IOUT);
    writeln;
    NA:=NB-1;
      for I:=1 to NA do begin
        for J:= 1 to NA do A[I,J]:=BP[I,J];
        end;
    if(DFLAG=1)then writeln('     ===== MATRIX BP  =======');
    INVERSE;
    for I:=1 to NA do begin
      for J:= 1 to NA do BPI[I,J]:=A[I,J];
      end;
    if(DFLAG=1)then begin;
      writeln('     ===== MATRIX BPI ======');
      DISMAT;
      end;
    end;
  {-----------------------------------------------------------------}
    procedure BQMAT;
    begin
    NI:=1;
    for I:=1 to NB0 do begin
      NJ:=1;
        for J:=1 to NB0 do begin
          if(CODE[I]=0)then begin
            if(CODE[J]=0)then begin
            A[NI,NJ]:=B[I,J];
            end;
          end;
        if(CODE[J]=0)then NJ:=NJ+1;
        end;
      if(CODE[I]=0)then NI:=NI+1;
      end;
      NA:=NI-1;
    if(DFLAG=1)then writeln('     ===== MATRIX BQ  =======');
    INVERSE;
    if(DFLAG=1)then writeln('     ===== MATRIX BQI ======');
    if(DFLAG=1)then DISMAT;
      NI:=1;
      for I:=1 to NB0 do begin
        if(CODE[I]=1)then for J:= 1 to NB0 do BQI[I,J]:=0.0;
        if(CODE[I]=0)then begin
          NJ:=1;
          for J:=1 to NB0 do begin
            if(CODE[J]=1)then BQI[I,J]:=0.0;
            if(CODE[J]=0)then begin
              BQI[I,J]:=AI[NI,NJ];
              NJ:=NJ+1;
            end;
          end;
        NI:=NI+1;
        end;
      end;
      NA:=NB0;
    if(DFLAG=1)then writeln('     ===== MATRIX AUG BQI ======');
    if(DFLAG=1)then DISMAT;
    end;
{------------------------------------------------------------------}
      procedure INVERSE;
      begin
      if(DFLAG=1)then DISMAT;
      for K:=1 to NA do begin
        I:=1;
        repeat
        J:=1;
          repeat
          if(I=K)then begin
          AI[I,J]:=-A[K,J]/A[K,K];
            if(J=K)then AI[I,J]:=1.0/A[K,K];
          end
          else begin
          AI[I,J]:=A[I,J]-A[I,K]*A[K,J]/A[K,K];
            if(J=K)then AI[I,J]:=A[I,K]/A[K,K];
          end;
          J:=J+1;
          until J>NA;
        I:=I+1;
        until I>NA;
        for I:=1 to NA do begin
          for J:= 1 to NA do A[I,J]:=AI[I,J];
        end;
      end;
      end;
{------------------------------------------------------------------}
      procedure DISMAT;
      begin
      writeln(IOUT);
      for I:=1 to NA do begin
        writeln(IOUT,'     ');
        writeln(IOUT,'     === ROW',I:3,' ===');
        K:=1;
        for J:=1 to NA do begin
          if(K=8)then begin
          writeln(IOUT,A[I,J]:9:3);
          K:=0;
          end
          else begin
          write(IOUT,A[I,J]:9:3);
          end;
          K:=K+1;
          end;
        end;
      writeln(IOUT);
      writeln(IOUT);
      readln;
      end;
   {---------------------------------------------------------------------}
      procedure PQTRANS;
      begin
      I:=1;
      for I:=1 to NB do begin
        if(TYP[I]=1)then QG[I]:=0.0;
        PT[I]:=0.0;
        QT[I]:=0.0;
        for K:=1 to ROW[I] do begin
          J:=COL[I,K];
          ANGLE:=DEL[I]-DEL[J];
          PT[I]:=PT[I]+V[J]*(G[I,J]*COS(ANGLE)+B[I,J]*SIN(ANGLE));
          QT[I]:=QT[I]+V[J]*(G[I,J]*SIN(ANGLE)-B[I,J]*COS(ANGLE));
          end;
        if(TYP[I]=3)then PG[I]:=PL[I]+V[I]*PT[I];
        if(CODE[I]=1)then QG[I]:=QL[I]+V[I]*QT[I];
        DP[I]:=PT[I]+(PL[I]-PG[I])/V[I];
        DQ[I]:=QT[I]+(QL[I]-QG[I])/V[I];
        end;
      end;
   {---------------------------------------------------------------------}
      procedure PQFLOW;
      begin
      NB0:=NB-1;
      N1:=NSLACK;
      N2:=NB;
      RENUMBER;
      YBUILD;
      BPMAT;
      writeln(IOUT,chr(12));
      BQMAT;
      writeln;
      writeln;
      JTER:=0;
      writeln(IOUT,'    ==========================================================');
      writeln(IOUT);
      writeln('     Please wait;  Iterative Solution in Progress.');
      IFLAG:=0;
      repeat
        JTER:=JTER+1;
        if(JTER>25)then IFLAG:=1;
        for I:=1 to NB do ICODE[I]:=CODE[I];
        VFLAG:=0;
        ITER:=0;
        repeat
          ITER:=ITER+1;
          if(ITER>25)then IFLAG:=1;
          MAXDA:=0.0;
          MAXDV:=0.0;
          PQTRANS;
          for I:=1 to NB0 do begin
            DA[I]:=0.0;
            for J:=1 to NB0 do DA[I]:=DA[I]+BPI[I,J]*DP[J];
            DEL[I]:=DEL[I]+DA[I];
            if(MAXDA<ABS(DA[I]))then MAXDA:=ABS(DA[I]);
            end;
          PQTRANS;
          for I:=1 to NB0 do begin
            DV[I]:=0.0;
            for J:=1 to NB0 do DV[I]:=DV[I]+BQI[I,J]*DQ[J];
            V[I]:=V[I]+DV[I];
            if(MAXDV<ABS(DV[I]))then MAXDV:=ABS(DV[I]);
            if(V[I]>50.0)then IFLAG:=1;
            end;
          if(DFLAG=1)then BUSDIAG;
        until ((MAXDA<0.001)and(MAXDV<0.0001)or(IFLAG=1));
        writeln(IOUT);
        writeln(IOUT,'     VAR Iteration No.',JTER:3,';     No. of Iterations =',ITER:3);
        VARLIMIT;
      until ((VFLAG<=0)or(IFLAG=1));
      writeln(IOUT);
      N1:=NSLACK;
      N2:=NB;
      RENUMBER;
      if((VFLAG=0)and(IFLAG=0))then begin
        writeln(IOUT,'       **** SOLUTION CONVERGED!');
        DISCBUS;
        LINEFLOW;
        TRANFLOW;
        TOTALS;
        end;
      if(IFLAG=1)then begin
        writeln(IOUT,'     **** SOLUTION DID NOT CONVERGE!');
        BUSDIAG;
        end;
      end;
  {------------------------------------------------------------------}
      procedure TOTALS;
      begin
      clrscr;
      PGTOT:=0.0;
      QGTOT:=0.0;
      PLTOT:=0.0;
      QLTOT:=0.0;
      for I:=1 to NB do begin
        PGTOT:=PGTOT+PG[I];
        QGTOT:=QGTOT+QG[I];
        PLTOT:=PLTOT+PL[I];
        QLTOT:=QLTOT+QL[I];
        end;
      PLOSS:=PGTOT-PLTOT;
      QLOSS:=QGTOT-QLTOT;
      WFLAG:=1;
      writeln(IOUT);
      writeln(IOUT);
      writeln(IOUT,'=================== SYSTEM TOTALS ========================');
      writeln(IOUT,'|  Pgen      Qgen     Pload     Qload     Ploss     Qloss ');
      writeln(IOUT,'----------------------------------------------------------');
      writeln(IOUT,PGTOT:8:4,QGTOT:10:4,PLTOT:10:4,QLTOT:10:4,PLOSS:10:4,QLOSS:10:4);
      writeln(IOUT,'==========================================================');
      writeln(IOUT);
      end;
  {------------------------------------------------------------------}
      procedure VARLIMIT;
      begin
      for I:=1 to NB do begin
        if(TYP[I]=2)then begin
          if(QG[I]>QMAX[I])then begin
            QG[I]:=QMAX[I];
            CODE[I]:=0;
            end;
          if(QG[I]<QMIN[I])then begin
            QG[I]:=QMIN[I];
            CODE[I]:=0;
            end;
          if((V[I]>VSPEC[I])and(QG[I]=QMAX[I]))then begin
            V[I]:=VSPEC[I];
            CODE[I]:=1;
            end;
          if((V[I]<VSPEC[I])and(QG[I]=QMIN[I]))then begin
            V[I]:=VSPEC[I];
            CODE[I]:=1;
            end;
          if(ICODE[I]<>CODE[I])then begin
            VFLAG:=1;
            BQMAT;
            end;
          if(CODE[I]=1)then V[I]:=VSPEC[I];
          end;
        end;
      end;
  {------------------------------------------------------------------}
      procedure BUSDIAG;
      begin
      writeln('***ITER =',ITER:4);
      writeln('**BUS TYPE CODE   V       DP       DQ       DA       DV');
      for I:=1 to NB do begin
        writeln(I:4,TYP[I]:4,CODE[I]:4,V[I]:9:3,DP[I]:9:3,DQ[I]:9:3,DA[I]:9:3,DV[I]:9:3);
      end;
      readln;
      end;
  {------------------------------------------------------------------}
      procedure LINEFLOW;
      begin
      IC:=0;
      for K:=1 to NL do begin
        YM:=1.0/MAG(RL[K],XL[K]);
        YA:=-ANG(RL[K],XL[K]);
        GE:=YM*COS(YA);
        BE:=YM*SIN(YA);
        VRi:=V[IL[K]]*COS(DEL[IL[K]]);
        VIi:=V[IL[K]]*SIN(DEL[IL[K]]);
        VRj:=V[JL[K]]*COS(DEL[JL[K]]);
        VIj:=V[JL[K]]*SIN(DEL[JL[K]]);
        IRi:=(VRi-VRj)*GE-(VIi-VIj)*BE-BL[K]*VIi/2.0;
        IIi:=(VIi-VIj)*GE+(VRi-VRj)*BE+BL[K]*VRi/2.0;
        IRj:=(VRj-VRi)*GE-(VIj-VIi)*BE-BL[K]*VIj/2.0;
        IIj:=(VIj-VIi)*GE+(VRj-VRi)*BE+BL[K]*VRj/2.0;
        Pij:=VRi*IRi+VIi*IIi;
        Qij:=-VRi*IIi+VIi*IRi;
        Pji:=VRj*IRj+VIj*IIj;
        Qji:=-VRj*IIj+VIj*IRj;
        Si:=MAG(Pij,Qij);
        Sj:=MAG(Pji,Qji);
        STAR:=' ';
        if((Si>SL[K])or(Sj>SL[K]))then STAR:='*';
        if(IC=0)then begin
          writeln(IOUT);
          writeln(IOUT,'================= LINE POWER FLOWS ================');
          writeln(IOUT,'|Bus to Bus      P        Q        S       Srating');
          writeln(IOUT,'---------------------------------------------------');
        end;
        writeln(IOUT,IL[K]:3,JL[K]:7,Pij:10:4,Qij:10:4,Si:10:4,SL[K]:10:4,STAR);
        writeln(IOUT,JL[K]:3,IL[K]:7,Pji:10:4,Qji:10:4,Sj:10:4,SL[K]:10:4,STAR);
        writeln(IOUT);
        IC:=IC+1;
      end;
      writeln(IOUT,'===================================================');
      writeln(IOUT,'     * indicates overloaded circuit.');
      end;
  {------------------------------------------------------------------}
      procedure TRANFLOW;
      begin
      writeln(IOUT);
      IC:=0;
      for K:=1 to NT do begin
        I:=IT[K];
        J:=JT[K];
        C:=CT[K];
        YM:=1.0/MAG(RT[K],XT[K]);
        YA:=-ANG(RT[K],XT[K]);
        GE:=YM*COS(YA);
        BE:=YM*SIN(YA);
        VRi:=V[I]*COS(DEL[I]);
        VIi:=V[I]*SIN(DEL[I]);
        VRj:=V[J]*COS(DEL[J]);
        VIj:=V[J]*SIN(DEL[J]);
        IRi:=(VRi-VRj)*C*GE-(VIi-VIj)*C*BE;
        IIi:=(VIi-VIj)*C*GE+(VRi-VRj)*C*BE;
        IRj:=(VRj-VRi)*C*GE-(VIj-VIi)*C*BE;
        IIj:=(VIj-VIi)*C*GE+(VRj-VRi)*C*BE;
        IRi:=IRi+(1.0-C)*(GE*VRi-BE*VIi);
        IIi:=IIi+(1.0-C)*(GE*VIi+BE*VRi);
        IRj:=IRj+(SQR(C)-C)*(GE*VRj-BE*VIj);
        IIj:=IIj+(SQR(C)-C)*(GE*VIj+BE*VRj);
        Pij:=VRi*IRi+VIi*IIi;
        Qij:=-VRi*IIi+VIi*IRi;
        Pji:=VRj*IRj+VIj*IIj;
        Qji:=-VRj*IIj+VIj*IRj;
        Si:=MAG(Pij,Qij);
        Sj:=MAG(Pji,Qji);
        STAR:=' ';
        if((Si>ST[K])or(Sj>ST[K]))then STAR:='*';
        if(IC=0)then begin
          writeln(IOUT);
          writeln(IOUT,'============== TRANSFORMER POWER FLOWS ============');
          writeln(IOUT,'|Bus to Bus      P        Q        S       Srating');
          writeln(IOUT,'---------------------------------------------------');
        end;
        IC:=IC+1;
        writeln(IOUT,IT[K]:3,JT[K]:7,Pij:10:4,Qij:10:4,Si:10:4,ST[K]:10:4,STAR);
        writeln(IOUT,JT[K]:3,IT[K]:7,Pji:10:4,Qji:10:4,Sj:10:4,ST[K]:10:4,STAR);
        writeln(IOUT);
      end;
      if nt <> 0 then begin
          writeln(IOUT,'==================================================');
          writeln(IOUT,'     * indicates overloaded circuit.');
      end;
      end;
    {---------------------------------------------------------------------}
      procedure HARDCOPY;
      begin
        assign(IIN,'o:\infiles.txt');
        {$I-} reset(IIN) {$I+};
        OK:=(IOresult=0);
        if not OK then begin;
           writeln('   File not found: infiles.txt -- Major oops.');
           readln;
           end  
        else begin;
        readln(IIN);
        readln(IIN,OUTFILE);
        assign(IIN,'');
        assign(IOUT,OUTFILE);
        rewrite(IOUT);
        HEADING;
        writeln(IOUT);
        writeln(IOUT, ' +++ Inputs +++');
        writeln(IOUT);
        DISLINE;
        DISTRAN;
        DISBUS;
        writeln(IOUT);
        writeln(IOUT, ' +++ Outputs +++');
        writeln(IOUT);
        DISCBUS;
        LINEFLOW;
        TRANFLOW;
        TOTALS;
        close(IOUT);
        assign(IOUT,'');
        end;
      end;
{-----------------------------------------------------------------------}
    {####################### MAIN PROGRAM #############################}
    begin
    assign(IOUT,'');
    rewrite(IOUT);
    INITIALIZE;
    1000:
    LOAD;
    writeln;
    if(NB>0)then begin;
      assign(IIN,'o:\infiles.txt');
      {$I-} reset(IIn) {$I+};
      OK:=(IOresult=0);
      if not OK then begin;
         writeln('   File infiles.txt is not available -- Major oops');
         readln;
         end
      else begin;
      readln(IIN);
      readln(IIN);
      readln(IIN,RTITLE);
      assign(IIN,'');
      HEADING;
      writeln;
      write('    One moment, please...');
      BCHECK;
      PQFLOW;
      end;
    end;
    if(NB=0)then write('    Please load an old (or make a new) case before running a power flow...');
    HARDCOPY;
    2000:
    end.











0
 
LVL 2

Expert Comment

by:omsec
ID: 1217487
uhm... well i see what it does, but it's quite bigger than expected
0
Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

 
LVL 1

Author Comment

by:Tom_Hickerson
ID: 1217488
I posted it all, but a lot of it is not needed.  I think the important stuff is in the PQflow.
0
 
LVL 1

Author Comment

by:Tom_Hickerson
ID: 1217489
If any of you are working on this plese post an note to the such on the page.  Otherwise I will seek assistance elsewhere.  Thanks
Tom
0
 
LVL 5

Expert Comment

by:inter
ID: 1217490
Working on it. Probably done on Monday,
Regards,
Igor
0
 
LVL 2

Expert Comment

by:Ready4Dis
ID: 1217491
I am working on it, probably by sunday or so
0
 
LVL 5

Expert Comment

by:inter
ID: 1217492
Hi,
I have almost completed the conversion but, I do not know if it works okay. It needs several files to process and I really do not want to dig in to the parsing stuff and try to produce the required files.
As far as I can understand, the program computes the 3phase Y or Delta connected transformer stuff on a high voltage bus.

Ready4Dis
---------------
So, I withdraw, if you want my partially converted file I can post you.
inter@kosgeb.tekmer.gov.tr

Regards,
Igor
0
 
LVL 2

Expert Comment

by:Ready4Dis
ID: 1217493
Um.. the only problem is that I am converting it to QB1.1 first, and then converting that to VB.  They are very close to the same thing, and only need minor changes, so if you want to, you can.  but I am re-writing it line by line, just using edit, and converting everything one at a time so there will be no mistakes.
0
 
LVL 3

Accepted Solution

by:
jlove1 earned 10 total points
ID: 1217494
Here is the VB code you requested. This is ONLY the PQFLOW procedure and it assumes that all the other code in your program has already been converted.
The statements at the very bottom are to be included within the main body of the code somewhere and they assume that the output file is "HELLO.TXT"

' procedure PQFLOW;
' THIS IS THE MAIN PROCEDURE CODE
       'begin
       NB0 = NB - 1
       N1 = NSLACK
       N2 = NB
       RENUMBER
       YBUILD
       BPMAT
       Print #1, Chr$(12)
       BQMAT;
       Print
       Print
       JTER = 0
       Print #1, "    =========================================================="
       Print #1, ""
       Print "     Please wait;  Iterative Solution in Progress."
       
       IFLAG = 0
       'repeat 1
       Do
         JTER = JTER + 1
         If (JTER > 25) Then IFLAG = 1
         For I = 1 To NB
         ICODE[I] = CODE[I]
         Next I
         
         VFLAG = 0
         ITER = 0
         'repeat 2
         Do
           ITER = ITER + 1
           If (ITER > 25) Then IFLAG = 1
           MAXDA = 0#
           MAXDV = 0#
           PQTRANS
           For I = 1 To NB0
            'do begin;
             DA [I] = 0#
             For j = 1 To NB0
             DA[I]=DA[I]+BPI[I,J]*DP[J]
             DEL[I]=DEL[I]+DA[I]
             if(MAXDA<ABS(DA[I]))then MAXDA =ABS(DA[I])
             
             'end;
             Next I
           PQTRANS
           For I = 1 To NB0
           'do begin
             DV [I] = 0#
             For j = 1 To NB0
             DV[I]=DV[I]+BQI[I,J]*DQ[J]
             Next j
             V[I] =V[I]+DV[I]
             if(MAXDV<ABS(DV[I]))then MAXDV=ABS(DV[I])
             if(V[I]>50.0)then IFLAG:=1
             netx I
           If (DFLAG = 1) Then BUSDIAG
         Loop Until ((MAXDA < 0.001) And (MAXDV < 0.0001) Or (IFLAG = 1))
         Print #1, ""
         Print #1, "     VAR Iteration No.',JTER:3,';     No. of Iterations =',ITER:3)"
         VARLIMIT
       Loop Until ((VFLAG <= 0) Or (IFLAG = 1))
       Print #1, ""
       N1 = NSLACK
       N2 = NB
       RENUMBER
       If ((VFLAG = 0) And (IFLAG = 0)) Then
       Print #1, "       **** SOLUTION CONVERGED!"
         DISCBUS
         LINEFLOW
         TRANFLOW
         TOTALS
         End If
       If (IFLAG = 1) Then
         Print #1, "     **** SOLUTION DID NOT CONVERGE!"
         BUSDIAG
         End If
' SOMEWHERE IN YOUR MAIN CODE YOU NEED THE FOLLOWING LINES
Open "hello.txt" For Output As #1

0

Featured Post

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

HOW TO: Install and Configure VMware vSphere Hypervisor 6.5 (ESXi 6.5), Step by Step Tutorial with screenshots. From Download, Checking Media, to Completed Installation.
Find out what Office 365 Transport Rules are, how they work and their limitations managing Office 365 signatures.
This video discusses moving either the default database or any database to a new volume.
You have products, that come in variants and want to set different prices for them? Watch this micro tutorial that describes how to configure prices for Magento super attributes. Assigning simple products to configurable: We assigned simple products…

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now