Simulación del movimiento de los electrones en un campo electrico

Espectacular simulación realizada con OpenGL del movimiento de los electrones cuando atraviesan un campo eléctrico.

Como muestra la imagen se ven los electrones saliendo en tiempo real de la placa de color gris hacia la placa de color rojo acelerándose cuando atraviesan el campo eléctrico.

El escenario se puede girar o rotar en todas direcciones para apreciar mejor el movimiento.

Autor:

Email: systemhalt@nm.ru

www.systemhalt.nm.ru

Codigo fuente

Obtener parametros de los paneles solares

Partiendo de los siguientes datos: (se obtienen de la hoja de características del fabricante de los módulos fotovoltaicos)

Intensidad de cortocircuito (Isc).
Tensión de circuito abierto (Voc).
Tensión PMP (Vm).
Intensidad PMP (Im).
Porcentaje de eficiencia.
Temperatura operación nominal (TONC) en grados Kelvin.

El software calcularía los siguientes:

Factor de forma (FF).
Temperatura de célula (Tc) en grados kelvin.
Área (Ac) en metros cuadrados.
Máxima potencia (Pm).
Resistencia para PMP (Rm).

Pulsando el botón "Calcular datos irradiancia G" la aplicación obtendrá los siguientes datos en condiciones de irradiancia G:

Temperatura célula (Tc2).
Tensión (Voc2).
Intensidad cortocircuito (Isc2).
Máxima potencia (Pm2).
Eficiencia con G.

Codigo fuente


Autor: ajpdsoft

Fuente:  http://www.ajpdsoft.com/modules.php?name=News&file=article&sid=439



Ejemplo:

Cálculo para un sistema básico fotovoltaico

Corrección: E4=E1xE2xE3, E3 es la cantidad de horas de uso.

Cálculo de la corriente requerida

A1 Carga total diaria (sumar la columna E4)                                      273
watts-hora/día

A2 Tensión CD del sistema (generalmente 12 ó 24 V)                       12 voltios

A3 Carga diaria corriente (A1/A2)                                                     
22.8 amperios-hora

A4 Multiplicar con el factor de seguridad 20% (para
compensar

las pérdidas en las baterías y otros componentes)                           1.2

A5 Carga diaria corriente corregida (A4*A3)                                     27.3
amperios-hora

A6 Promedio de horas de sol por día.                                               
4 horas

A7 Amperaje que el sistema tendrá que producir (A5/A6)                 6.8 amperios

Cálculo del número de paneles

B1 Amperaje máximo del modulo solar seleccionado

(según especificaciones del fabricante)                                            
3.9 amperios

B2 Divida la línea A7 entre la B1 para obtener el número

de módulos que se necesita                                                             
1.75

B3 Redondee al número completo inmediato superior                       2

Cálculo del número de baterías

C1 Carga total diaria (A5)                                                                  
27.3 amperios-hora

C2 Días de reserva (este es el tiempo que el

sistema tiene que estar funcionando sin sol)                                     3

C3 Capacidad nominal del banco de baterías (C1*C2)                       81.9 amperios-hora

C4 Factor de profundidad de descarga (generalmente 80%,

significa que siempre se deja un 20% de reserva en las
baterías)    0.8

C5 Capacidad corregida del banco de baterías (C3/C4)                    102.4 amperios-hora

C6 Capacidad nominal de batería

(según especificaciones del fabricante)                                             
120 amperios-hora

C7 Número de baterías       
(C5/C6)                                                   0.9

C8 Número de baterías (redondear C7)                                              1

Simulador de circuitos lógicos

Simulador de circuitos con código fuente que permite diseñar circuitos basándose en puertas lógicas: Y, AND, OR, etc.

Una vez que se termina el diseño se puede activar virtualmente para ver su resultado.
Utilizando o no una tabla es posible realizar funciones básicas: sumador, comparador, etc y simular cualquier expresión booleana de una forma fácil.
El autor incluye varios ejemplos:
-Un display de 7 segmentos
-Un multiplicador binario.

Descargar codigo

Autor: Montero-Ribas

Web: ADMR.CAD.Free.fr

Redondear numeros reales

Aquí tienen varias formas de redondear correctamente números reales:

Opcion1:

======



function RoundStr(Zn: Real; kol_zn: Integer): Real;

var

snl, s, s0, s1, s2: string;

n, n1: Real;

nn, i: Integer;

begin

s := FloatToStr(Zn);

if (Pos(',', s) > 0) and (Zn > 0) and

(Length(Copy(s, Pos(',', s) + 1, length(s))) > kol_zn) then

begin

s0 := Copy(s, 1, Pos(',', s) + kol_zn - 1);

s1 := Copy(s, 1, Pos(',', s) + kol_zn + 2);

s2 := Copy(s1, Pos(',', s1) + kol_zn, Length(s1));

n := StrToInt(s2) / 100;

nn := Round(n);

if nn >= 10 then

begin

snl := '0,';

for i := 1 to kol_zn - 1 do

snl := snl + '0';

snl := snl + '1';

n1 := StrToFloat(Copy(s, 1, Pos(',', s) + kol_zn)) + StrToFloat(snl);

s := FloatToStr(n1);

if Pos(',', s) > 0 then

s1 := Copy(s, 1, Pos(',', s) + kol_zn);

end

else

s1 := s0 + IntToStr(nn);

if s1[Length(s1)] = ',' then

s1 := s1 + '0';

Result := StrToFloat(s1);

end

else

Result := Zn;

end;



Opcion 2:



function RoundEx(X: Double; Precision: Integer ): Double;



// Precision : 1, 10,100 ...



var

ScaledFractPart, Temp: Double;

begin

ScaledFractPart := Frac(X) * Precision;

Temp := Frac(ScaledFractPart);

ScaledFractPart := Int(ScaledFractPart);

if Temp >= 0.5 then

ScaledFractPart := ScaledFractPart + 1;

if Temp <= -0.5 then

ScaledFractPart := ScaledFractPart - 1;

Result := Int(X) + ScaledFractPart / Precision;

end;



Opcion 3:



function FormatData(s: String; i: Integer): String;

begin

Result:=FloatToStr(Round(StrToFloat(s)*exp(i*ln(10)))/(exp(i*ln(10))));

end;



Opcion 4:



function RoundFloat(R: Extended; Decimals: Integer): Extended;

var

Factor: Extended;

begin

Factor := Int(Exp(Decimals * Ln(10)));

Result := Round(Factor * R) / Factor;

end;



La llamada sería de la siguiente forma:



showmessage(FloatToStr(RoundStr(2.3456789,3)));

showmessage(FloatToStr(RoundEx(2.3456789,1000)));

showmessage(formatdata('2,3456789',3));

showmessage(FloatToStr(RoundFloat(2.3456789,3)));

Al trabajar con imágenes en 3D he tenido que utilizar alguna de estas funciones y lo que he hecho para acelerar su cálculo es aumentar la prioridad de mi aplicación con la siguiente función:

procedure TForm1.AumentaPrioridad;

var

ProcessID : DWORD;

ProcessHandle : THandle;

ThreadHandle : THandle;

begin

ProcessID := GetCurrentProcessID;

ProcessHandle := OpenProcess(PROCESS_SET_INFORMATION,

false, ProcessID);

SetPriorityClass(ProcessHandle, REALTIME_PRIORITY_CLASS);

ThreadHandle := GetCurrentThread;

SetThreadPriority(ThreadHandle, THREAD_PRIORITY_TIME_CRITICAL);

end;

Movimiento de un octoedro

Movimiento de un octaedro en pantalla. (No utiliza OpenGL, GlScene)





Codigo fuente

LIBROS:

Autocad 3D, DIBUJO Y MODELADO

3D con Photoshop

Aprender Maya, nivel avanzado, ejemplos y ejercicios

Aprender 3DS Max 2017 con 100 ejercicios prácticos

Programación en 3D con Java

Aprende Blender, diseño y creatividad

Rotación de poliedros en el espacio

Simula el movimiento de un objeto sobre los 3 ejes X,Y,Z

Codigo fuente





 

Gravedad pixelada

Simulación del movimiento de miles de píxeles bajo la influencia de las reglas de la gravedad.

Autor: Gerben Wijnja

Descargar codigo fuente

Operaciones con matrices

Aquí tienen una unidad con un montón de funciones para trabajar con matrices :

Unit
Matrix;

interface

type

 
MatrixPtr = ^MatrixRec;

 
MatrixRec = record

   
MatrixRow   : byte;

   
MatrixCol   : byte;

   
MatrixArray : pointer;

 
end;

 
MatrixElement = real;

function IntPower(X,n : integer) : integer;

function CreateSquareMatrix(Size : byte) : MatrixPtr;

function CreateMatrix(Row,Col : byte) : MatrixPtr;

function CloneMatrix(MPtr : MatrixPtr) : MatrixPtr;

function DeleteMatrix(var MPtr : MatrixPtr) :
boolean;

function FillMatrix(MPtr : MatrixPtr;Value : MatrixElement) :
boolean;

function AssignMatrix(var MPtr1 : MatrixPtr;MPtr2 : MatrixPtr)
: MatrixPtr;

function DisplayMatrix(MPtr : MatrixPtr;_Int,_Frac : byte) :
boolean;

function IsSingleMatrix(MPtr : MatrixPtr) : boolean;

function IsSquareMatrix(MPtr : MatrixPtr) : boolean;

function GetMatrixRow(MPtr : MatrixPtr) : byte;

function GetMatrixCol(MPtr : MatrixPtr) : byte;

procedure SetMatrixElement(MPtr : MatrixPtr;Row,Col : byte;Value :
MatrixElement);

function GetMatrixElement(MPtr : MatrixPtr;Row,Col : byte) :
MatrixElement;

function ExcludeVectorFromMatrix(MPtr : MatrixPtr;Row,Col : byte) :
MatrixPtr;

function SetVectorIntoMatrix(MPtr,VPtr : MatrixPtr;_Pos : byte) :
MatrixPtr;

function DetMatrix(MPtr : MatrixPtr) : MatrixElement;

function DetTriangularMatrix(MPtr : MatrixPtr) :
MatrixElement;

function AppendixElement(MPtr : MatrixPtr;Row,Col : byte) :
MatrixElement;

function CreateAppendixMatrix(MPtr : MatrixPtr) :
MatrixPtr;

function TransponeMatrix(MPtr : MatrixPtr) : MatrixPtr;

function ReverseMatrix(MPtr : MatrixPtr) : MatrixPtr;

function MultipleMatrixOnNumber(MPtr : MatrixPtr;Number :
MatrixElement) : MatrixPtr;

function MultipleMatrixOnMatrix(MPtr1,MPtr2 : MatrixPtr) :
MatrixPtr;

function AddMatrixOnMatrix(MPtr1,MPtr2 : MatrixPtr) :
MatrixPtr;

function SubMatrixOnMatrix(MPtr1,MPtr2 : MatrixPtr) :
MatrixPtr;

(* El sistema resuelve el método de Gauss y devuelve la matriz LU-*)

(Función * Resultado - soluciones vector columna *)

function GausseMethodMatrix(MPtr,VPtr : MatrixPtr;var LPtr,UPtr,BPtr : MatrixPtr) :
MatrixPtr;

implementation

function IntPower(X,n : integer) : integer;

var

Res,i :
integer;

begin

if n
< 1 then IntPower:= 0

else
begin

   Res:=
X;

  
for
i:=1 to n-1 do
Res:= Res*X;

  
IntPower:= Res;

end;

end;

function CreateSquareMatrix(Size : byte) : MatrixPtr;

var

TempPtr
: MatrixPtr;

begin

TempPtr:= nil;

GetMem(TempPtr,SizeOf(MatrixRec));

if
TempPtr = nil
then
begin

  
CreateSquareMatrix:= nil;

  
Exit;

end;

with
TempPtr^ do
begin

  
MatrixRow:= Size;

  
MatrixCol:= Size;

  
MatrixArray:= nil;

  
GetMem(MatrixArray,Size*Size*SizeOf(MatrixElement));

  
if
MatrixArray = nil
then
begin

    
FreeMem(TempPtr,SizeOf(MatrixRec));

    
CreateSquareMatrix:= nil;

    
Exit;

  
end;

end;

FillMatrix(TempPtr,0);

CreateSquareMatrix:= TempPtr;

end;

function CreateMatrix(Row,Col : byte) : MatrixPtr;

var

TempPtr
: MatrixPtr;

begin

TempPtr:= nil;

GetMem(TempPtr,SizeOf(MatrixRec));

if
TempPtr = nil
then
begin

  
CreateMatrix:= nil;

  
Exit;

end;

with
TempPtr^ do
begin

  
MatrixRow:= Row;

  
MatrixCol:= Col;

  
MatrixArray:= nil;

  
GetMem(MatrixArray,Row*Col*SizeOf(MatrixElement));

  
if
MatrixArray = nil
then
begin

    
FreeMem(TempPtr,SizeOf(MatrixRec));

    
CreateMatrix:= nil;

    
Exit;

  
end;

end;

FillMatrix(TempPtr,0);

CreateMatrix:= TempPtr;

end;

function DeleteMatrix(var MPtr : MatrixPtr) :
boolean;

begin

if
MPtr = nil
then
DeleteMatrix:= FALSE

else
with
MPtr^ do
begin

  
if
MatrixArray <> nil
then

    
FreeMem(MatrixArray,MatrixRow*MatrixCol*SizeOf(MatrixElement));

  
FreeMem(MPtr,SizeOf(MatrixRec));

  
MPtr:= nil;

  
DeleteMatrix:= TRUE;

end;

end;

function CloneMatrix(MPtr : MatrixPtr) : MatrixPtr;

var

TempPtr
: MatrixPtr;

i,j    
: byte;

begin

if
MPtr = nil
then
CloneMatrix:= nil

else
with
MPtr^ do
begin

  
TempPtr:= CreateMatrix(MPtr^.MatrixRow,MPtr^.MatrixCol);

  
if
TempPtr <> nil
then
begin

    
for
i:= 1 to MatrixRow do

      
for
j:= 1 to MatrixCol do

        
SetMatrixElement(TempPtr,i,j,GetMatrixElement(MPtr,i,j));

    
CloneMatrix:= TempPtr;

  
end
else
CloneMatrix:= nil;

end;

end;

function FillMatrix(MPtr : MatrixPtr;Value : MatrixElement) :
boolean;

var

i,j :
byte;

begin

if
MPtr = nil
then
FillMatrix:= FALSE

else
with
MPtr^ do
begin

  
for
i:= 1 to MatrixRow do

    
for
j:= 1 to MatrixCol do

      
SetMatrixElement(MPtr,i,j,Value);

  
FillMatrix:= TRUE;

end;

end;

function AssignMatrix(var MPtr1 : MatrixPtr;MPtr2 : MatrixPtr)
: MatrixPtr;

begin

DeleteMatrix(MPtr1);

MPtr1:=
MPtr2;

AssignMatrix:= MPtr1;

end;

function DisplayMatrix(MPtr : MatrixPtr;_Int,_Frac : byte) :
boolean;

var

i,j :
byte;

begin

if
MPtr = nil
then
DisplayMatrix:= FALSE

else
with
MPtr^ do
begin

  
for
i:= 1 to MatrixRow do begin

    
for
j:= 1 to MatrixCol do

      
write(GetMatrixElement(MPtr,i,j) : _Int : _Frac);

    
writeln;

  
end;

  
DisplayMatrix:= TRUE;

end;

end;

function IsSingleMatrix(MPtr : MatrixPtr) : boolean;

begin

if
MPtr <> nil
then
with
MPtr^ do
begin

  
if
(MatrixRow = 1)
and
(MatrixCol = 1)
then

    
IsSingleMatrix:= TRUE

  
else
IsSingleMatrix:= FALSE;

end
else
IsSingleMatrix:= FALSE;

end;

function IsSquareMatrix(MPtr : MatrixPtr) : boolean;

begin

if
MPtr <> nil
then
with
MPtr^ do
begin

  
if
MatrixRow = MatrixCol then

    
IsSquareMatrix:= TRUE

  
else
IsSquareMatrix:= FALSE;

end
else
IsSquareMatrix:= FALSE;

end;

function GetMatrixRow(MPtr : MatrixPtr) : byte;

begin

if
MPtr <> nil
then
GetMatrixRow:= MPtr^.MatrixRow

else
GetMatrixRow:= 0;

end;

function GetMatrixCol(MPtr : MatrixPtr) : byte;

begin

if
MPtr <> nil
then
GetMatrixCol:= MPtr^.MatrixCol

else
GetMatrixCol:= 0;

end;

procedure SetMatrixElement(MPtr : MatrixPtr;Row,Col : byte;Value :
MatrixElement);

var

TempPtr
: ^MatrixElement;

begin

if
MPtr <> nil
then

  
if
(Row <> 0)
or
(Col <> 0)
then
with
MPtr^ do
begin

    
pointer(TempPtr):= pointer(MatrixArray);

    
Inc(TempPtr,MatrixRow*(Col-1)+Row-1);

    
TempPtr^:= Value;

  
end;

end;

function GetMatrixElement(MPtr : MatrixPtr;Row,Col : byte) :
MatrixElement;

var

TempPtr
: ^MatrixElement;

begin

if
MPtr <> nil
then
begin

  
if
(Row <> 0)
and
(Col <> 0)
then
with
MPtr^ do
begin

    
pointer(TempPtr):= pointer(MatrixArray);

    
Inc(TempPtr,MatrixRow*(Col-1)+Row-1);

    
GetMatrixElement:= TempPtr^;

  
end
else
GetMatrixElement:= 0;

end
else
GetMatrixElement:= 0;

end;

function ExcludeVectorFromMatrix(MPtr : MatrixPtr;Row,Col : byte) :
MatrixPtr;

var

NewPtr           : MatrixPtr;

NewRow,
NewCol   : byte;

i,j              : byte;

DiffRow,
DiffCol : byte;

begin

if
MPtr <> nil
then
with
MPtr^ do
begin

  
if
Row = 0 then NewRow:= MatrixRow

  
else
NewRow:= MatrixRow-1;

  
if
Col = 0 then NewCol:= MatrixCol

  
else
NewCol:= MatrixCol-1;

  
NewPtr:= CreateMatrix(NewRow, NewCol);

  
if
(NewPtr = nil)
or
(NewPtr^.MatrixArray = nil)
then
begin

    
ExcludeVectorFromMatrix:= nil;

    
Exit;

  
end;

  
DiffRow:= 0;

  
DiffCol:= 0;

  
for
i:= 1 to MatrixRow do begin

    
if i
= Row then
DiffRow:= 1

    
else
for
j:= 1 to MatrixCol do if j = Col then DiffCol:= 1

      
else
SetMatrixElement(NewPtr,i-DiffRow,j-DiffCol,

        
GetMatrixElement(MPtr,i,j));

    
DiffCol:= 0;

  
end;

  
ExcludeVectorFromMatrix:= NewPtr;

end
else
ExcludeVectorFromMatrix:= nil;

end;

function SetVectorIntoMatrix(MPtr,VPtr : MatrixPtr;_Pos : byte) :
MatrixPtr;

var

TempPtr
: MatrixPtr;

i      
: byte;

begin

if
(MPtr <> nil)
and
(VPtr <> nil)
then
begin

  
TempPtr:= CloneMatrix(MPtr);

  
if
TempPtr = nil
then
begin

    
SetVectorIntoMatrix:= nil;

    
Exit;

  
end;

  
if
VPtr^.MatrixRow = 1
then
begin

    
for
i:= 1 to TempPtr^.MatrixCol do

      
SetMatrixElement(TempPtr,_Pos,i,GetMatrixElement(VPtr,1,i));

  
end
else
begin

    
for
i:= 1 to TempPtr^.MatrixRow do

      
SetMatrixElement(TempPtr,i,_Pos,GetMatrixElement(VPtr,i,1));

  
end;

  
SetVectorIntoMatrix:= TempPtr;

end
else
SetVectorIntoMatrix:= nil;

end;

function DetMatrix(MPtr : MatrixPtr) : MatrixElement;

var

TempPtr
: MatrixPtr;

i,j    
: byte;

Sum    
: MatrixElement;

begin

if
IsSquareMatrix(MPtr) then
begin

  
if
not
IsSingleMatrix(MPtr) then
begin

    
TempPtr:= nil;

    
Sum:= 0;

    
for
j:= 1 to GetMatrixCol(MPtr) do begin

      
AssignMatrix(TempPtr,ExcludeVectorFromMatrix(MPtr,1,j));

      
Sum:= Sum+IntPower(-1,j+1)*GetMatrixElement(MPtr,1,j)*DetMatrix(TempPtr);

    
end;

    
DeleteMatrix(TempPtr);

    
DetMatrix:= Sum;

  
end
else
DetMatrix:= GetMatrixElement(MPtr,1,1);

end
else
DetMatrix:= 0;

end;

function DetTriangularMatrix(MPtr : MatrixPtr) :
MatrixElement;

var

i      
: byte;

Sum    
: MatrixElement;

begin

if
IsSquareMatrix(MPtr) then
begin

   Sum:=
1;

  
for
i:= 1 to MPtr^.MatrixRow do

    
Sum:= Sum*GetMatrixElement(MPtr,i,i);

  
DetTriangularMatrix:= Sum;

end
else
DetTriangularMatrix:= 0;

end;

function AppendixElement(MPtr : MatrixPtr;Row,Col : byte) :
MatrixElement;

var

TempPtr
: MatrixPtr;

begin

if
IsSquareMatrix(MPtr) then
begin

  
TempPtr:= ExcludeVectorFromMatrix(MPtr,Row,Col);

  
if
TempPtr = nil
then
begin

    
AppendixElement:= 0;

    
Exit;

  
end;

  
AppendixElement:= IntPower(-1,Row+Col)*DetMatrix(TempPtr);

  
DeleteMatrix(TempPtr);

end
else
AppendixElement:= 0;

end;

function CreateAppendixMatrix(MPtr : MatrixPtr) :
MatrixPtr;

var

TempPtr
: MatrixPtr;

i,j    
: byte;

begin

if
(MPtr <> nil)
or
(MPtr^.MatrixArray <> nil) or

   
(not
IsSquareMatrix(MPtr)) then
with
MPtr^ do
begin

  
TempPtr:= CreateMatrix(MatrixCol,MatrixRow);

  
for
i:= 1 to MatrixRow do

    
for
j:= 1 to MatrixCol do

      
SetMatrixElement(TempPtr,i,j,AppendixElement(MPtr,i,j));

  
CreateAppendixMatrix:= TempPtr;

end
else
CreateAppendixMatrix:= nil;

end;

function TransponeMatrix(MPtr : MatrixPtr) : MatrixPtr;

var

TempPtr
: MatrixPtr;

i,j    
: byte;

begin

if
(MPtr <> nil)
or
(MPtr^.MatrixArray <> nil) then with MPtr^ do begin

  
TempPtr:= CreateMatrix(MatrixCol,MatrixRow);

  
for
i:= 1 to MatrixRow do

    
for
j:= 1 to MatrixCol do

      
SetMatrixElement(TempPtr,j,i,GetMatrixElement(MPtr,i,j));

  
TransponeMatrix:= TempPtr;

end
else
TransponeMatrix:= nil;

end;

function ReverseMatrix(MPtr : MatrixPtr) : MatrixPtr;

var

TempPtr     : MatrixPtr;

Determinant : MatrixElement;

begin

if
MPtr <> nil
then
begin

  
TempPtr:= nil;

  
AssignMatrix(TempPtr,CreateAppendixMatrix(MPtr));

  
AssignMatrix(TempPtr,TransponeMatrix(TempPtr));

  
Determinant:= DetMatrix(MPtr);

  
if
(TempPtr = nil)
or
(Determinant = 0)
then
begin

    
DeleteMatrix(TempPtr);

    
ReverseMatrix:= nil;

    
Exit;

  
end;

  
AssignMatrix(TempPtr,MultipleMatrixOnNumber(TempPtr,1/Determinant));

  
ReverseMatrix:= TempPtr;

end
else
ReverseMatrix:= nil;

end;

function MultipleMatrixOnNumber(MPtr : MatrixPtr;Number :
MatrixElement) : MatrixPtr;

var

TempPtr
: MatrixPtr;

i,j    
: byte;

begin

if
MPtr <> nil
then
with
MPtr^ do
begin

  
TempPtr:= CreateMatrix(MatrixRow,MatrixCol);

  
if
TempPtr = nil
then
begin

    
MultipleMatrixOnNumber:= nil;

    
Exit;

  
end;

  
for
i:= 1 to MatrixRow do

    
for
j:= 1 to MatrixCol do

      
SetMatrixElement(TempPtr,i,j,GetMatrixElement(MPtr,i,j)*Number);

  
MultipleMatrixOnNumber:= TempPtr;

end
else
MultipleMatrixOnNumber:= nil;

end;

function MultipleMatrixOnMatrix(MPtr1,MPtr2 : MatrixPtr) :
MatrixPtr;

var

TempPtr
: MatrixPtr;

i,j,k  
: byte;

begin

if
(MPtr1 <>  nil)
and
(MPtr2 <> nil)
then
begin

  
TempPtr:= CreateMatrix(MPtr1^.MatrixRow,MPtr2^.MatrixCol);

  
if
TempPtr = nil
then
begin

    
MultipleMatrixOnMatrix:= nil;

    
Exit;

  
end;

  
for
i:= 1 to TempPtr^.MatrixRow do

    
for
j:= 1 to TempPtr^.MatrixCol do

      
for
k:= 1 to MPtr1^.MatrixCol do

        
SetMatrixElement(TempPtr,i,j,GetMatrixElement(TempPtr,i,j)+

          
GetMatrixElement(MPtr1,i,k)*GetMatrixElement(MPtr2,k,j));

  
MultipleMatrixOnMatrix:= TempPtr;

end
else
MultipleMatrixOnMatrix:= nil;

end;

function AddMatrixOnMatrix(MPtr1,MPtr2 : MatrixPtr) :
MatrixPtr;

var

TempPtr
: MatrixPtr;

i,j,k  
: byte;

begin

if
(MPtr1 <>  nil)
and
(MPtr2 <> nil)
then
begin

  
TempPtr:= CreateMatrix(MPtr1^.MatrixRow,MPtr2^.MatrixCol);

  
if
TempPtr = nil
then
begin

    
AddMatrixOnMatrix:= nil;

    
Exit;

  
end;

  
for
i:= 1 to TempPtr^.MatrixRow do

    
for
j:= 1 to TempPtr^.MatrixCol do

      
SetMatrixElement(TempPtr,i,j,GetMatrixElement(Mptr1,i,j)+

        
GetMatrixElement(MPtr2,i,j));

  
AddMatrixOnMatrix:= TempPtr;

end
else
AddMatrixOnMatrix:= nil;

end;

function SubMatrixOnMatrix(MPtr1,MPtr2 : MatrixPtr) :
MatrixPtr;

var

TempPtr
: MatrixPtr;

i,j,k  
: byte;

begin

if
(MPtr1 <>  nil)
and
(MPtr2 <> nil)
then
begin

  
TempPtr:= CreateMatrix(MPtr1^.MatrixRow,MPtr2^.MatrixCol);

  
if
TempPtr = nil
then
begin

    
SubMatrixOnMatrix:= nil;

    
Exit;

  
end;

  
for
i:= 1 to TempPtr^.MatrixRow do

    
for
j:= 1 to TempPtr^.MatrixCol do

      
SetMatrixElement(TempPtr,i,j,GetMatrixElement(MPtr1,i,j)-

        
GetMatrixElement(MPtr2,i,j));

  
SubMatrixOnMatrix:= TempPtr;

end
else
SubMatrixOnMatrix:= nil;

end;

function GausseMethodMatrix(MPtr,VPtr : MatrixPtr;var LPtr,UPtr,BPtr : MatrixPtr) :
MatrixPtr;

var

TempPtr 
: MatrixPtr;

TempVPtr
: MatrixPtr;

TempLPtr
: MatrixPtr;

TempUPtr
: MatrixPtr;

XSum    
: MatrixElement;

i,j,k   
: byte;

begin

if
(MPtr <> nil)
and
(VPtr <> nil)
then
begin

  
TempUPtr:= CloneMatrix(MPtr);

  
if
TempUPtr = nil
then
begin

    
GausseMethodMatrix:= nil;

    
Exit;

  
end;

  
TempLPtr:= CreateMatrix(MPtr^.MatrixRow,MPtr^.MatrixCol);

  
if
TempLPtr = nil
then
begin

    
DeleteMatrix(TempUPtr);

    
GausseMethodMatrix:= nil;

    
Exit;

  
end;

  
TempVPtr:= CloneMatrix(VPtr);

  
if
TempVPtr = nil
then
begin

    
DeleteMatrix(TempLPtr);

    
DeleteMatrix(TempUPtr);

    
GausseMethodMatrix:= nil;

    
Exit;

  
end;

  
TempPtr:= CreateMatrix(MPtr^.MatrixRow,1);

  
if
TempPtr = nil
then
begin

    
DeleteMatrix(TempVPtr);

    
DeleteMatrix(TempLPtr);

    
DeleteMatrix(TempUPtr);

    
GausseMethodMatrix:= nil;

    
Exit;

  
end;

  
for
j:= 1 to MPtr^.MatrixCol-1 do
begin

    
SetMatrixElement(TempLPtr,j,j,1);

    
for
i:= j+1 to MPtr^.MatrixRow do begin

      
SetMatrixElement(TempLPtr,i,j,GetMatrixElement(TempUPtr,i,j)/

        
GetMatrixElement(TempUPtr,j,j));

      
for
k:= j to
MPtr^.MatrixCol do
begin

        
SetMatrixElement(TempUPtr,i,k,GetMatrixElement(TempUPtr,i,k)-

          
GetMatrixElement(TempLPtr,i,j)*GetMatrixElement(TempUPtr,j,k));

      
end;

      
SetMatrixElement(TempVPtr,i,1,GetMatrixElement(TempVPtr,i,1)-

        
GetMatrixElement(TempLPtr,i,j)*GetMatrixElement(TempVPtr,j,1));

    
end;

  
end;

  
SetMatrixElement(TempLPtr,TempLPtr^.MatrixRow,TempLPtr^.MatrixCol,1);

  
SetMatrixElement(TempPtr,TempPtr^.MatrixRow,1,

    
GetMatrixElement(TempVPtr,TempVPtr^.MatrixRow,1)/

    
GetMatrixElement(TempUPtr,TempUPtr^.MatrixRow,TempUPtr^.MatrixCol));

  
for
j:= MPtr^.MatrixCol-1
downto 1
do
begin

    
XSum:= 0;

    
for
k:= j+1 to MPtr^.MatrixCol do

      
XSum:= XSum+GetMatrixElement(TempUPtr,j,k)*

        
GetMatrixElement(TempPtr,k,1);

    
SetMatrixElement(TempPtr,j,1,(GetMatrixElement(TempVPtr,j,1)-XSum)/

      
GetMatrixElement(TempUPtr,j,j));

  
end;

  
LPtr:= TempLPtr;

  
UPtr:= TempUPtr;

  
BPtr:= TempVPtr;

  
GausseMethodMatrix:= TempPtr;

end
else
GausseMethodMatrix:= nil;

end;

end.







LIBROS:



Matemáticas, el fascinante mundo de los números



Matrix computations (Matematical Science)



Geometría analítica del plano y del espacio



Mecánica de fluidos



Geometría Afín y Euclidea