Annotation of OpenXM_contrib/PHC/Ada/Homotopy/homotopy_evaluator_packages.adb, Revision 1.1
1.1 ! maekawa 1: with text_io; use text_io;
! 2: with Standard_Evaluator_Packages; use Standard_Evaluator_Packages;
! 3:
! 4: package body Homotopy_Evaluator_Packages is
! 5:
! 6: procedure Create_Homotopy_Constants ( file : in file_type ) is
! 7:
! 8: -- DESCRIPTION :
! 9: -- Writes the code to initialize the homotopy constants.
! 10:
! 11: begin
! 12: put_line(file,
! 13: " procedure Homotopy_Constants ( a : in Complex_Number; "
! 14: & "k : in positive ) is");
! 15: put_line(file," begin");
! 16: put_line(file," aa := a;");
! 17: put_line(file," kk := k;");
! 18: put_line(file," end Homotopy_Constants;");
! 19: end Create_Homotopy_Constants;
! 20:
! 21: procedure Create_Inline_Homotopy_Evaluator ( file : in file_type ) is
! 22:
! 23: -- DESCRIPTION :
! 24: -- Writes the code to evaluate the homotopy.
! 25:
! 26: begin
! 27: put_line(file,
! 28: " function Eval_Homotopy ( x : Vector; t : Complex_Number ) "
! 29: & "return Vector is");
! 30: new_line(file);
! 31: put_line(file," y : Vector(x'range); ");
! 32: put_line(file," eval_target : Vector(x'range) := Eval_Target_Sys(x); ");
! 33: put_line(file," eval_astart : Vector(x'range) := aa*Eval_Start_Sys(x);");
! 34: put_line(file," tpk : constant Complex_Number := t**kk; ");
! 35: put_line(file," mtk : constant Complex_Number := (Create(1.0)-t)**kk; ");
! 36: new_line(file);
! 37: put_line(file," begin");
! 38: put_line(file," for i in y'range loop");
! 39: put_line(file," y(i) := mtk*eval_astart(i) + tpk*eval_target(i);");
! 40: put_line(file," end loop;");
! 41: put_line(file," return y;");
! 42: put_line(file," end Eval_Homotopy;");
! 43: end Create_Inline_Homotopy_Evaluator;
! 44:
! 45: procedure Create_Inline_Homotopy_Differentiator1 ( file : in file_type ) is
! 46:
! 47: -- DESCRIPTION :
! 48: -- Writes the code to differentiate the homotopy w.r.t. the variables.
! 49:
! 50: begin
! 51: put_line(file,
! 52: " function Diff_Homotopy ( x : Vector; t : Complex_Number ) "
! 53: & "return Matrix is");
! 54: new_line(file);
! 55: put_line(file," y : Matrix(x'range,x'range); ");
! 56: put_line(file," eval_target : Matrix(x'range,x'range)"
! 57: & " := Eval_Target_Jaco(x); ");
! 58: put_line(file," eval_astart : Matrix(x'range,x'range)"
! 59: & " := Eval_Start_Jaco(x);");
! 60: put_line(file," tpk : constant Complex_Number := t**kk; ");
! 61: put_line(file," mtk : constant Complex_Number"
! 62: & " := aa*(Create(1.0)-t)**kk; ");
! 63: new_line(file);
! 64: put_line(file," begin");
! 65: put_line(file," for i in y'range(1) loop");
! 66: put_line(file," for j in y'range(2) loop");
! 67: put_line(file," y(i,j) := mtk*eval_astart(i,j) "
! 68: & "+ tpk*eval_target(i,j);");
! 69: put_line(file," end loop;");
! 70: put_line(file," end loop;");
! 71: put_line(file," return y;");
! 72: put_line(file," end Diff_Homotopy;");
! 73: end Create_Inline_Homotopy_Differentiator1;
! 74:
! 75: procedure Create_Inline_Homotopy_Differentiator2 ( file : in file_type ) is
! 76:
! 77: -- DESCRIPTION :
! 78: -- Writes the code to differentiate the homotopy w.r.t. t.
! 79:
! 80: begin
! 81: put_line(file,
! 82: " function Diff_Homotopy ( x : Vector; t : Complex_Number ) "
! 83: & "return Vector is");
! 84: new_line(file);
! 85: put_line(file," y : Vector(x'range);");
! 86: new_line(file);
! 87: put_line(file," begin");
! 88: put_line(file," return y;");
! 89: put_line(file," end Diff_Homotopy;");
! 90: end Create_Inline_Homotopy_Differentiator2;
! 91:
! 92: procedure Create_Package_Specification
! 93: ( file : in file_type; packname : in String ) is
! 94:
! 95: -- DESCRIPTION :
! 96: -- Writes the specification of the homotopy evaluator package.
! 97:
! 98: begin
! 99: put_line(file,"with Standard_Complex_Numbers; "
! 100: & "use Standard_Complex_Numbers;");
! 101: put_line(file,"with Standard_Complex_Vectors; "
! 102: & "use Standard_Complex_Vectors;");
! 103: put_line(file,"with Standard_Complex_Matrices; "
! 104: & "use Standard_Complex_Matrices;");
! 105: new_line(file);
! 106: put_line(file,"package " & packname & " is");
! 107: new_line(file);
! 108: put_line(file,
! 109: " procedure Homotopy_Constants ( a : in Complex_Number; "
! 110: & "k : in positive );");
! 111: new_line(file);
! 112: put_line(file,
! 113: " function Eval_Homotopy ( x : Vector; t : Complex_Number ) "
! 114: & "return Vector;");
! 115: put_line(file,
! 116: " function Diff_Homotopy ( x : Vector; t : Complex_Number ) "
! 117: & "return Matrix;");
! 118: put_line(file,
! 119: " function Diff_Homotopy ( x : Vector; t : Complex_Number ) "
! 120: & "return Vector;");
! 121: new_line(file);
! 122: put_line(file,"end " & packname & ";");
! 123: end Create_Package_Specification;
! 124:
! 125: procedure Create_Package_Implementation
! 126: ( file : in file_type; packname : in String;
! 127: p,q : in Poly_Sys ) is
! 128:
! 129: -- DESCRIPTION :
! 130: -- Writes the implementation of the homotopy evaluator package.
! 131:
! 132: begin
! 133: put_line(file,"with Standard_Floating_Numbers; "
! 134: & "use Standard_Floating_Numbers;");
! 135: new_line(file);
! 136: put_line(file,"package body " & packname & " is");
! 137: new_line(file);
! 138: put_line(file," aa : Complex_Number;");
! 139: put_line(file," kk : positive;");
! 140: new_line(file);
! 141: Create_Inline_System_Evaluator(file,"Eval_Target_Sys",p);
! 142: new_line(file);
! 143: Create_Inline_System_Evaluator(file,"Eval_Start_Sys",q);
! 144: new_line(file);
! 145: Create_Inline_Jacobian_Evaluator(file,"Eval_Target_Jaco",p);
! 146: new_line(file);
! 147: Create_Inline_Jacobian_Evaluator(file,"Eval_Start_Jaco",q);
! 148: new_line(file);
! 149: Create_Homotopy_Constants(file);
! 150: new_line(file);
! 151: Create_Inline_Homotopy_Evaluator(file);
! 152: new_line(file);
! 153: Create_Inline_Homotopy_Differentiator1(file);
! 154: new_line(file);
! 155: Create_Inline_Homotopy_Differentiator2(file);
! 156: new_line(file);
! 157: put_line(file,"end " & packname & ";");
! 158: end Create_Package_Implementation;
! 159:
! 160: procedure Create ( packname : in String; p,q : in Poly_Sys ) is
! 161:
! 162: specfile,bodyfile : file_type;
! 163:
! 164: begin
! 165: Replace_Symbols;
! 166: Create(specfile,out_file,packname & ".ads");
! 167: Create_Package_Specification(specfile,packname);
! 168: Close(specfile);
! 169: Create(bodyfile,out_file,packname & ".adb");
! 170: Create_Package_Implementation(bodyfile,packname,p,q);
! 171: Close(bodyfile);
! 172: end Create;
! 173:
! 174: procedure Create ( p,q : in Poly_Sys ) is
! 175:
! 176: packname : String := Read_Package_Name;
! 177:
! 178: begin
! 179: Create(packname,p,q);
! 180: end Create;
! 181:
! 182: end Homotopy_Evaluator_Packages;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>