Jump to content


Check out our Community Blogs

Register and join over 40,000 other developers!


Recent Status Updates

View All Updates

Photo
- - - - -

What programming language is this?

language programming

This topic has been archived. This means that you cannot reply to this topic.
4 replies to this topic

#1 aruwin

aruwin

    CC Resident

  • Advanced Member
  • PipPipPipPip
  • 60 posts

Posted 27 September 2014 - 09:32 PM

Hello. What is this programming language?

program charge (input, output);


{$APPTYPE CONSOLE}


uses
  SysUtils;






const
NMAX = 80;
APMAX = 100;
NONZERO = 0.00001;
NEGRI = 0.00001;
EPSILON = 8.8541851;


type
klmat = array[0..80] of real;
apmat = array[0..100] of real;
pmat = array[0..80, 0..80] of real;


var
kpvs, kpve, kpcs, kpce, kpp: integer;
ladvl, ladcl, ladvr, ladcr, ladp: integer;
app, apv, apc: integer;
nvar: integer;


s, t: integer;


volt, pot, vrz, e_r, e_z, field: real;
q, kr, kz, lr, lz: klmat;
ar, az: apmat;
p: pmat;
dtfile, rstfile: text;


procedure exprsn (ch: char; start, goal: integer);
var
i, j: integer;
adr, adz: real;
begin
j := 1;
for i := start to goal do
begin
case ch of
'k': 
begin
adr := kr[i];
adz := kz[i];
end;
'l': 
begin
adr := lr[i];
adz := lz[i];
end;
'a': 
begin
adr := ar[i];
adz := az[i];
end;
end;
writeln(rstfile, i : 3, '...', adr : 5 : 5, ' ', adz : 5 : 5);
end;
end;


function celf1 (k: real): real;
var
a0, a1, b0, b1: real;
begin
a0 := 1;
b0 := sqrt(1 - k * k);
repeat
a1 := (a0 + b0) / 2;
b1 := sqrt(a0 * b0);
a0 := a1;
b0 := b1;
until abs(a1 - b1) <= NONZERO;
celf1 := PI / (2 * a0);
end;


function celf2 (k: real): real;
var
ii, jj, z: integer;
a0, a1, b0, b1, c0, c1, cn: real;
begin
a0 := 1;
c0 := k * k;
b0 := sqrt(1 - c0);
cn := 0;
ii := 0;
repeat
a1 := (a0 + b0) / 2;
b1 := sqrt(a0 * b0);
c1 := (a0 - b0) / 2;
z := 1;
for jj := 1 to ii do
z := z * 2;
cn := cn + z * c1 * c1;
ii := ii + 1;
a0 := a1;
b0 := b1;
until abs(a1 - b1) <= NONZERO;
celf2 := (PI / 2) / a1 * (1 - (c0 / 2 + cn));
end;


function pline (pos: integer; adr, adz: real): real;
var
rb, rc, rf, rg, rh, ri, rj, rk, rl, rm, rn, rs, rq: real;
ts, tb, tt, ss, sb: real;


begin
rb := lz[pos];
rc := lr[pos];
if (pos < (ladvl + 1)) then
begin
rb := rb + vrz;
rc := rc + vrz;
end;
if (lr[pos] >= 0.0) then


if (adr <= NONZERO) then   {limited line}
begin
  {r=0;on the center axis}
pline := (abs(ln((rc - adz) / (rb - adz))) + ln((rb + adz) / (rc + adz))) / (rc - rb);
end
else  {r > 0}
begin
rf := (rc - adz) / adr;
rg := (rb - adz) / adr;
rh := (rb + adz) / adr;
ri := (rc + adz) / adr;
rk := abs(rf);
rl := abs(rg);
rm := rk + sqrt(1 + sqr(rk));
rn := rl + sqrt(1 + sqr(rl));
rs := rh + sqrt(1 + sqr(rh));
rq := ri + sqrt(1 + sqr(ri));
if (rf < 0.0) then
rm := 1.0 / rm;
if (rg < 0.0) then
rn := 1.0 / rn;
pline := ln((rm * rs) / (rn * rq)) / (rc - rb);
end
else if (adr > NONZERO) then  {lr < 0 , r <> 0}
begin
rf := (rb + adz) / adr;
rg := (rb - adz) / adr;
rh := abs(rg);
rk := rh + sqrt(1 + sqr(rh));
ri := rf + sqrt(1 + sqr(rf));
if (rg > 0.0) then
rk := 1 / rk;
pline := ln(ri * rk);
end
else {R < 0, r = 0}
begin
pline := ln((rb + adz) / (rb - adz));
end;
end;


function pring (pos: integer; adr, adz: real): real;
var
rd, rg, rh, re, rf, ri, rk, hik: real;
begin
rd := lz[pos];
if (pos < (ladp - ladcr + 1)) then
rd := rd + vrz;
if (lr[pos] >= NONZERO) then
begin    { r > 0 , not on the axis}
rg := sqr(lr[pos] + adr);
rh := sqr(lr[pos] - adr);
re := sqr(adz - rd);
rf := sqr(adz + rd);
ri := rg + re;
rk := rg + rf;
hik := lr[pos] * adr;
re := hik / ri;
rf := hik / rk;
re := 2.0 * sqrt(re);
rf := 2.0 * sqrt(rf);
pring := 2 * ((celf1(re) / sqrt(ri)) - (celf1(rf) / sqrt(rk))) / PI;
end
else { r = 0; on the axis}
begin
rg := sqr(adr);
re := sqr(adz - rd);
rf := sqr(adz + rd);
pring := (1 / sqrt(rg + re)) - (1 / sqrt(rg + rf));
end;
end;


procedure eline (pos: integer; adr, adz: real; var st_er, st_ez: real);
var
rb, rc, rg, rh, re, rf, ri, rj, rk, rl, rm: real;
begin
rb := lz[pos];
rc := lr[pos];
if (pos < (ladvl + 1)) then
begin
rb := rb + vrz;
rc := rc + vrz;
end;


if (lr[pos] >= 0) then
if (adr < NONZERO) then
begin {R > 0, limited line, r = 0}
st_er := 0;
st_ez := 1 / abs(rc - adz) - 1 / abs(rb - adz);
st_ez := st_ez + 1 / (rc + adz) - 1 / (rb + adz);
st_ez := st_ez / (rc - rb);
end
else {limitedline, r<> 0}
begin
rg := sqr(adr);
rh := rb - adz;
re := sqr(rh);
ri := rb + adz;
rf := sqr(ri);
rj := (rc - adz);
rl := sqr(rj);
rk := rc + adz;
rm := sqr(rk);
re := 1 / sqrt(rg + re);
rf := 1 / sqrt(rg + rf);
rl := 1 / sqrt(rg + rl);
rm := 1 / sqrt(rg + rm);
st_er := (rj * rl - rh * re + ri * rf - rk * rm) / ((rc - rb) * adr);
st_ez := (rl + rm - re - rf) / (rc - rb);
end
else  { half-infinit line}
if (adr > NONZERO) then  {half-infinit line, r <> 0 }
begin
rg := sqr(adr);
rh := rb - adz;
re := sqr(rh);
ri := rb + adz;
rf := sqr(ri);
re := 1 / sqrt(rg + re);
rf := 1 / sqrt(rg + rf);
st_er := (ri * rf - rh * re) / adr;
st_ez := 0 - re - rf;
end
else  {r = 0}
begin
st_er := 0;
st_ez := 0 - 1 / (rb - adz) - 1 / (rb + adz);
end;
end;


procedure ering (pos: integer; adr, adz: real; var st_er, st_ez: real);
var
rc, rd, re, ree, rff, rf, rg, rh, rii, ri, rj, rjj, rk, rkk, hik, sqi, sqk: real;
begin
rd := lz[pos];
if (pos < (ladp - ladcr + 1)) then
rd := rd + vrz;
if (lr[pos] > NONZERO) then  {ring charge}
if (adr < NONZERO) then  {ring charge r = 0}
begin
rc := sqr(lr[pos]);
re := adz - rd;
rf := adz + rd;
rg := rc + sqr(re);
rg := rg * sqrt(rg);
rh := rc + sqr(rf);
rh := rh * sqrt(rh);
st_er := 0;
st_ez := re / rg - rf / rh;
end
else  {ring charge r  > 0 }
begin
rc := lr[pos];
rg := sqr(rc + adr);
rh := sqr(rc - adr);
ree := adz - rd;
re := sqr(ree);
rff := adz + rd;
rf := sqr(rff);
rj := sqr(rc) - sqr(adr);
rjj := rj + re;
rj := rj + rf;
ri := rg + re;
rii := rh + re;
rk := rg + rf;
rkk := rh + rf;
hik := rc * adr;
re := hik / ri;
rf := hik / rk;
re := 2 * sqrt(re);
rf := 2 * sqrt(rf);
sqi := rii * sqrt(ri);
sqk := rkk * sqrt(rk);
st_er := ((celf1(re) * rii - celf2(re) * rjj) / sqi - (celf1(rf) * rkk - celf2(rf) * rj) / sqk) / (adr * PI);
st_ez := (celf2(re) * ree / sqi - celf2(rf) * rff / sqk) / PI * 2;
end
else  {spot charge}
begin
rg := sqr(adr);
rh := adz - rd;
re := sqr(rh);
re := re + rg;
ri := adz + rd;
rf := sqr(ri);
rf := rf + rg;
re := 1 / (re * sqrt(re));
rf := 1 / (rf * sqrt(rf));
st_er := adr * (re - rf);
st_ez := rh * re - ri * rf;
end;
end;


procedure pandel (k1, k2: integer; adr, adz: real);
var
i: integer;
stack_er, stack_ez: real;
begin
for i := k1 to k2 do
begin
stack_er := 0;
stack_ez := 0;
pot := pot + q[i] * pline(i, adr, adz);
eline(i, adr, adz, stack_er, stack_ez);
e_r := e_r + stack_er * q[i];
e_z := e_z + stack_ez * q[i];
end;
end;


procedure pander (k3, k4: integer; adr, adz: real);
var
i: integer;
stack_er, stack_ez: real;
begin
for i := k3 to k4 do
begin
stack_er := 0;
stack_ez := 0;
pot := pot + q[i] * pring(i, adr, adz);
ering(i, adr, adz, stack_er, stack_ez);
e_r := e_r + stack_er * q[i];
e_z := e_z + stack_ez * q[i];
end;
end;


procedure pivot (pos: integer);
var
max, tmp: real;
k, count: integer;
begin
count := pos;
max := abs(p[pos, pos]);
for k := pos + 1 to ladp do
if max < abs(p[k, pos]) then
begin
max := abs(p[k, pos]);
count := k;
end;
if count > pos then
begin
for k := pos to ladp do
begin
tmp := p[pos, k];
p[pos, k] := p[count, k];
p[count, k] := tmp;
end;
tmp := q[pos];
q[pos] := q[count];
q[count] := tmp;
end;
end;


procedure lusolution;
var
i, j, k: integer;
base, tmp: real;
begin
for i := 1 to kpp do
begin
pivot(i);
for k := i + 1 to ladp do
begin
base := p[k, i] / p[i, i];
for j := i to ladp do
p[k, j] := p[k, j] - p[i, j] * base;
q[k] := q[k] - q[i] * base;
end;
end;
for i := ladp downto 1 do
begin {U-matrix anli}
tmp := 0;
for j := i + 1 to ladp do
tmp := tmp + p[i, j] * q[j];
q[i] := (q[i] - tmp) / p[i, i];
end;
end;


var
i, j, i0, num, max, tmpnum: integer;
rz, qstand, pstack, tmp, qb: real;


begin { main  }
assign(rstfile, 'resultfile');
        rewrite(rstfile);
reset(dtfile, 'datafile.txt');
{ part1 -input data- }
writeln('warning kpvs + kpve+ kpcs+ kpce < ', NMAX);
writeln('warning sum of lad point < ', NMAX);


writeln('input kpvs, kpve, kpcs, kpce:');
readln(dtfile, kpvs, kpve, kpcs, kpce);
writeln('input ladvl, ladcl, ladvr, ladcr:');
readln(dtfile, ladvl, ladcl, ladvr, ladcr);
writeln('input apv, apc:');
readln(dtfile, apv, apc);
writeln('input number of repeat :');
readln(dtfile, nvar);


kpp := kpvs + kpve + kpcs + kpce;
ladp := ladvl + ladcl + ladvr + ladcr;
app := apv + apc;


writeln('input value of KP''s R & Z :');
for i := 1 to kpp do
begin
read(dtfile, kr[i], kz[i]);
end;
writeln('input value of LAD''s R & Z :');
for i := 1 to ladp do
begin
read(dtfile, lr[i], lz[i]);
end;
writeln('input value of AP''s R & Z :');
for i := 1 to app do
begin
read(dtfile, ar[i], az[i]);
end;


{ part2 -list_up data- }
if (kpvs > 0) then
begin
writeln(rstfile);
writeln(rstfile, kpvs, 'KP on stressed electrodes with variable height');
exprsn('k', 1, kpvs);
end;
if (kpve > 0) then
begin
writeln(rstfile);
writeln(rstfile, kpve, 'KP on earthed electrodes with variable height');
exprsn('k', kpvs + 1, kpvs + kpve);
end;
if (kpcs > 0) then
begin
writeln(rstfile);
writeln(rstfile, kpcs, 'KP on stressed electrodes with constant height');
exprsn('k', kpvs + kpve + 1, kpvs + kpve + kpcs);
end;
if (kpce > 0) then
begin
writeln(rstfile);
writeln(rstfile, kpce, 'KP on earthed electrodes with constant height');
exprsn('k', kpvs + kpve + kpcs + 1, kpp);
end;


if (ladvl > 0) then
begin
writeln(rstfile);
writeln(rstfile, ladvl, 'LAD(line-charge) with variable height');
exprsn('l', 1, ladvl);
end;
if (ladcl > 0) then
begin
writeln(rstfile);
writeln(rstfile, ladcl, 'LAD(line-charge) with constant height');
exprsn('l', ladvl + 1, ladvl + ladcl);
end;
if (ladvr > 0) then
begin
writeln(rstfile);
writeln(rstfile, ladvr, 'LAD(ring-charge) with variable height');
exprsn('l', ladvl + ladcl + 1, ladvl + ladcl + ladvr);
end;
if (ladcr > 0) then
begin
writeln(rstfile);
writeln(rstfile, ladcr, 'LAD(ring-charge) with constant height');
exprsn('l', ladvl + ladcl + ladvr + 1, ladp);
end;


if (apv > 0) then
begin
writeln(rstfile);
writeln(rstfile, apv, 'AP with variable height');
exprsn('a', 1, apv);
end;
if (apc > 0) then
begin
writeln(rstfile);
writeln(rstfile, apc, 'AP with constant height');
exprsn('a', apv + 1, app);
end;


readln(dtfile, volt, vrz);
writeln(volt, vrz);


{ caluculation part }
for num := 1 to nvar do
begin
{part3}
for i := 1 to kpp do
begin
rz := kz[i];
if (i < kpvs + kpve + 1) then
rz := rz + vrz;
j := 1;
while (j < ladvl + ladcl + 1) do
begin
p[i, j] := pline(j, kr[i], rz);
j := j + 1;
end;
while (j < ladp + 1) do
begin
p[i, j] := pring(j, kr[i], rz);
j := j + 1;
end;
end; { for(i = 1, i < kpp + 1) }


{ initialize voltage matrix but use vmat instead of qmat }
i := 1;
while (i < kpvs + 1) do  {kpvs}
begin
q[i] := 1.0;
i := i + 1;
end;
while (i < kpvs + kpve + 1) do {kpve}
begin
q[i] := 0.0;
i := i + 1;
end;
while (i < kpvs + kpve + kpcs + 1) do {kpcs}
begin
q[i] := 1.0;
i := i + 1;
end;
while (i < kpp + 1) do {kpce}
begin
q[i] := 0.0;
i := i + 1;
end;


{ part4, caluculation for charges by potentio }
lusolution;


qstand := 40 * PI * EPSILON * volt;
writeln(rstfile, num, '-th result for variable height = ', vrz : 5:5, '[cm]');
writeln(rstfile, 'volt = ', volt : 5, ' [kV]');


if (ladvl + ladcl > 0) then
begin
writeln(rstfile, 'line- charge');
for i := 1 to ladvl + ladcl do
begin
qb := q[i] * qstand;
write(rstfile, i, '   ', qb : 5 : 5);
if (lr[i] < 0) then
writeln(rstfile, '[pC / cm]') { half-infinite }
else
writeln(rstfile, '[pC]'); { limited line }
end;
end;
if (ladvr + ladcr > 0) then
begin
writeln(rstfile, 'ring- charge');
for i := ladvl + ladcl + 1 to ladp do
begin
qb := q[i] * qstand;
writeln(rstfile, i, ' ', qb : 5 : 5, '[pC]');
end;
end;


{part5}
if (app > 1) then
begin
writeln(rstfile, 'caluculation of potentials and field strange in ', app, 'AP');
for i := 1 to app do
begin
rz := az[i];
if (i < apv + 1) then
rz := rz + vrz;
pot := 0;
e_r := 0;
e_z := 0;
if (ladvl + ladcl > 0) then
pandel(1, ladvl + ladcl, ar[i], rz);
if (ladvr + ladcr > 0) then
pander(ladvl + ladcl + 1, ladp, ar[i], rz);
e_r := e_r * volt;
e_z := e_z * volt;
field := sqrt(sqr(e_r) + sqr(e_z));
writeln(rstfile, i, ' ', ar[i] : 5 : 5, ' ', rz : 5 : 5, ' ', pot : 5 : 5, ' ', e_r : 5 : 5, ' ', e_z : 5 : 5, ' ', field : 5 : 5);
end;
end;
end; { for(num = 1, nvar, i++) }


close(dtfile);
close(rstfile);
writeln(IOResult);
end.

Edited by WingedPanther, 29 September 2014 - 05:01 AM.
code tags


#2 BlackRabbit

BlackRabbit

    CodeCall Legend

  • Expert Member
  • PipPipPipPipPipPipPipPip
  • 3871 posts

Posted 28 September 2014 - 12:35 AM

Pascal / Delphi . Don't get confused, Delphi isn't a language to program the selfies :P 

 

It's not a very popular language market-wise, but you'll find it in educative institutions as a formative subject for programing related careers.



#3 aruwin

aruwin

    CC Resident

  • Advanced Member
  • PipPipPipPip
  • 60 posts

Posted 28 September 2014 - 01:17 AM

Pascal / Delphi . Don't get confused, Delphi isn't a language to program the selfies :P

 

It's not a very popular language market-wise, but you'll find it in educative institutions as a formative subject for programing related careers.

 

Then what's that for? How do I get it to work?



#4 BlackRabbit

BlackRabbit

    CodeCall Legend

  • Expert Member
  • PipPipPipPipPipPipPipPip
  • 3871 posts

Posted 29 September 2014 - 02:15 AM

 Elementary Watson, like in every other programing language, you must download the compiler (Click here for FreePascal) ,maybe and IDE, compile the program, and study it.

 

As about what it does, reading the labels it seems to be potentials calculation for a charge.



#5 WingedPanther73

WingedPanther73

    A spammer's worst nightmare

  • Moderator
  • 17757 posts

Posted 29 September 2014 - 05:02 AM

I'll disagree a little with BR. Delphi is the main language the company I work for uses, and is also fairly popular in Japan. Many of the features you see in VB and VB.NET were pioneered in Delphi. If you're trying to do coding yourself, you can also use Lazarus, which is very similar.

 

As for your code, the FreePascal compiler may be able to compile it.


Programming is a branch of mathematics.
My CodeCall Blog | My Personal Blog

My MineCraft server site: http://banishedwings.enjin.com/