Ressonância entre um pente de frequências e um átomo de dois níveis - programa em Delphi

Download do executável.
Download do programa.
unit DoisNiveisWin;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus, DBCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    editPulsos: TEdit;
    editTaxa: TEdit;
    editOffSet: TEdit;
    editLargura: TEdit;
    editOmega: TEdit;
    Calcular: TButton;
    Limpar: TButton;
    CheckBoxTxt: TCheckBox;
    CheckBoxDat: TCheckBox;
    GroupBox1: TGroupBox;
    Label9: TLabel;
    Label10: TLabel;
    CheckBoxEscalaH: TCheckBox;
    ListBox1: TDBListBox;
    MainMenu1: TMainMenu;
    Arquivo1: TMenuItem;
    Ferramentas1: TMenuItem;
    Sair1: TMenuItem;
    Cordacurva1: TMenuItem;
    Espessuradacurva1: TMenuItem;
    Azul1: TMenuItem;
    Vermelha1: TMenuItem;
    Verde1: TMenuItem;
    N11: TMenuItem;
    N21: TMenuItem;
    N31: TMenuItem;
    EditY1: TEdit;
    EditY2: TEdit;
    EditX1: TEdit;
    EditX2: TEdit;
    Sobre1: TMenuItem;
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    StaticText3: TStaticText;
    StaticText4: TStaticText;
    procedure CalcularClick(Sender: TObject);
    procedure CondIniciais;
    procedure RungeKutta;
    procedure Decaimento;
    procedure AmbienteGrafico;
    procedure Dados;
    procedure AdicionaDados;
    procedure GerarArquivo;
    procedure Bloch;
    procedure LimparClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Azul1Click(Sender: TObject);
    procedure Vermelha1Click(Sender: TObject);
    procedure Verde1Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure N21Click(Sender: TObject);
    procedure N31Click(Sender: TObject);
    procedure Sobre1Click(Sender: TObject);
    procedure Sair1Click(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  q12, q2, gama, w, alpha, N, wL, w2: real;
  dd, Omega, h, t, Tr, fr, phi: real;
  Tp, a10, a20, x, y: real;
  Pulsos, i, j, k, m, PassoRKfento, g, cor, espessura: integer;
  a, b, c, k1, k2, k3, k4: array[1..5] of real;
  nb, nt: real;
  txt,dat: TextFile;

implementation

{$R *.dfm}

procedure Tform1.CondIniciais;
begin
   AssignFile(txt,'dados.txt');
   AssignFile(dat,'dados.dat');
   ReWrite(txt);
   ReWrite(dat);
   Canvas.MoveTo(210,400);
   Canvas.Brush.Color := $EEE9E9;
   Canvas.FillRect(Rect(200,200,600,410));

   gama:= 0.0025 * 1e9 * 0;
   PassoRKfento:= 10;
   q2:= (2*Pi) * 5e6;
   q12:= 0.5 * q2;
   fr:= StrToFloat(editTaxa.text) * 1e6;
   Tp:= StrToFloat(editLargura.Text) * 1e-15;
   Pulsos:= StrToInt(editPulsos.Text);
   Omega:= StrToFloat(editOmega.Text) * q12 / (fr * Tp);
   a10:= 1;
   a20:= 0;
   w2:= (2*Pi) * 384e12 + (2 * Pi) * 20e6 * 0;
   wL:= (2*Pi) * 384e12 + (2 * Pi) * 40e6 * 0;
   phi:= (2*Pi) * 0.4 * 0;
   nb:= 0;nt:= 0;
   b[1]:= 0;b[2]:= 0;
   a[1]:= a10;
   a[2]:= a20;
   a[3]:= 0;
   a[4]:= 0;
   t:= 0; N:= -1;
   dd:= StrToFloat(editOffSet.Text) * 1e6 * 2 * Pi;
   Tr:= 1 / fr;
end;

function func(a1, a2, a12, b12: real; j: integer): real;
begin
   if (j = 1) then func:= +2 * Omega * (b12 * Cos(alpha) - a12 * Sin(alpha)) + q2 * a2 - (a1 - a10) * gama;
   if (j = 2) then func:= -2 * Omega * (b12 * Cos(alpha) - a12 * Sin(alpha)) - q2 * a2 - a2 * gama;
   if (j = 3) then func:= -dd * b12 - Omega * (a2 - a1) * Sin(alpha) - 0.5 * q2 * a12 - a12 * gama;
   if (j = 4) then func:=  dd * a12 + Omega * (a2 - a1) * Cos(alpha) - 0.5 * q2 * b12 - b12 * gama;
end;

procedure Tform1.RungeKutta;
Begin
  N:= N + 1;
  g:= PassoRKfento;
  h:= Tp / g;

  alpha:= -N * wL * Tr + N * phi;

  for k:= 1 to g do
  begin
     t:= t + h;

     for j:= 1 to 4 do
        k1[j]:= func(a[1], a[2], a[3], a[4], j);

     for j:= 1 to 4 do
        k2[j]:= func(a[1] + k1[1] * h / 2, a[2] + k1[2] * h / 2, a[3] + k1[3] * h / 2,
                     a[4] + k1[4] * h / 2, j);

     for j:= 1 to 4 do
        k3[j]:= func(a[1] + k2[1] * h / 2, a[2] + k2[2] * h / 2, a[3] + k2[3] * h / 2,
                     a[4] + k2[4] * h / 2, j);

     for j:= 1 to 4 do
        k4[j]:= func(a[1] + k3[1] * h, a[2] + k3[2] * h, a[3] + k3[3] * h,
                     a[4] + k3[4] * h, j);

     for j:= 1 to 4 do
        b[j]:= a[j] + h * (k1[j] / 6 + k2[j] / 3 + k3[j] / 3 + k4[j] / 6);

     for m:= 1 to 4 do
        a[m]:= b[m];

   end;

end;

procedure Tform1.Decaimento;
begin
   nb:= b[2];
   nt:= t;
   t:= t + (Tr - Tp);
   x:= dd * (Tr - Tp);
   y:= (Tr - Tp) * q2;
   b[1]:= a[1] + a[2] * (1 - Exp(-y));
   b[2]:= a[2] * Exp(-y);
   b[3]:= (a[3] * Cos(x) - a[4] * Sin(x)) * Exp(-0.5 * y);
   b[4]:= (a[3] * Sin(x) + a[4] * Cos(x)) * Exp(-0.5 * y);

   for m:= 1 to 4 do
      a[m]:= b[m];

end;

procedure TForm1.AmbienteGrafico;
var ex,ey:real;
z1,z2,z3,z4:real;
begin
   Canvas.Pen.Color:=clred;
   Canvas.Pen.Width:=2;

   if (cor = 1) then
      Canvas.Pen.Color:=clred;
   if (cor = 2) then
      Canvas.Pen.Color:=clblue;
   if (cor = 3) then
      Canvas.Pen.Color:=clgreen;

   if (espessura = 1) then
      Canvas.Pen.Width:=1;
   if (espessura = 2) then
      Canvas.Pen.Width:=2;
   if (espessura = 3) then
      Canvas.Pen.Width:=3;

   ex:= 0.4e12 / StrToFloat(EditX2.Text);
   ey:= 2e2 / StrToFloat(EditY2.Text);

   z1:= ex * nt + 200;
   //z2:=ex * t + 200;
   z3:= 400 - ey * nb;
   //z4:=400 - ey * b[2];
   Canvas.LineTo(trunc(z1),trunc(z3));
end;

procedure TForm1.Dados;
begin
   //Apaga listBox
   listBox1.Items.Clear();
end;

procedure TForm1.AdicionaDados;
begin
   //Soma das populações
   w:= b[1] + b[2];

   //Adiciona populações no listBox
   listBox1.Items.Add(IntToStr(i) + '                      '
                      + FormatFloat('#,##0.0000000',b[1]) + '                   '
                      + FormatFloat('#,##0.0000000',b[2]));
end;

procedure TForm1.GerarArquivo;
begin

   if FileExists('dados.txt') then
      Append(txt) else
      ReWrite(txt);

   if FileExists('dados.dat') then
      Append(dat) else
      ReWrite(dat);

   if (CheckBoxTxt.Checked = true) then
      writeln(txt,t*1e9 - 0.99999,' ',b[1],' ',b[2]);

   if (CheckBoxDat.Checked = true) then
      writeln(dat,t*1e9 - 0.99999,' ',b[1],' ',b[2]);

   closeFile(txt);
   closeFile(dat);
end;

procedure TForm1.Bloch;
begin
   nb:= b[2];
   nt:= t;
   if (i mod 2 = 0) then
      RungeKutta();

   if (i mod 2 = 1) then
      Decaimento();
end;

procedure TForm1.CalcularClick(Sender: TObject);
begin

  //Preparação do listBox
  Dados;

  //Condições iniciais
  CondIniciais;

  //Início da Interação
  for i:= 1 to 2*Pulsos + 1 do
  begin
      //Resolve as equações de Bloch
      Bloch;

      //Adiciona dados no listBox
      AdicionaDados;

      //Gera arquivo .txt com os dados
      GerarArquivo();

      //Inicia ambiente gráfico e plota a curva
      AmbienteGrafico();
   end;

end;

procedure TForm1.LimparClick(Sender: TObject);
begin
   //Limpa o listBox
   listBox1.Items.Clear();

   //Limpa o ambiente gráfico
   Canvas.Brush.Color := $EEE9E9;
   Canvas.FillRect(Rect(200,200,600,410));

end;

procedure TForm1.Button1Click(Sender: TObject);
var r:integer;
begin
for r:=1 to 100 do
begin
Canvas.LineTo(r*r,10*r);
end;
end;

procedure TForm1.Azul1Click(Sender: TObject);
begin
  cor:=1;
end;

procedure TForm1.Vermelha1Click(Sender: TObject);
begin
  cor:=2;
end;

procedure TForm1.Verde1Click(Sender: TObject);
begin
  cor:=3;
end;

procedure TForm1.N11Click(Sender: TObject);
begin
  espessura:=1;
end;

procedure TForm1.N21Click(Sender: TObject);
begin
  espessura:=2;
end;

procedure TForm1.N31Click(Sender: TObject);
begin
  espessura:=3;
end;

procedure TForm1.Sobre1Click(Sender: TObject);
begin
  showMessage('Criado em 11/07/2011. marcopolo@df.ufpe.br');
end;

procedure TForm1.Sair1Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var m1,m2: real;
begin
   m1:= StrToFloat(editPulsos.Text);
   m2:= StrToFloat(editTaxa.Text);

   if (checkBoxEscalaH.Checked = true) then
      editX2.Text:= FloatToStr(1200*m1/m2);

   if (editY2.Text = '') then
      editY2.Text:= '1';

   if (StrToFloat(editY2.Text) > 1) then
      editY2.Text:= '1';

   if (StrToFloat(editY2.Text) <= 0) then
      editY2.Text:= '0.5';

   if (editX2.Text = '') then
      editX2.Text:= FloatToStr(1200 * m1 / m2);

   if (StrToFloat(editX2.Text) <= 0) then
      editY2.Text:= FloatToStr(1200 * m1 / m2);
end;

end.
Marco Polo Moreno

Páginas

Ressonância entre um pente de frequências e um átomo de dois níveis - programa em Delphi
