Annotation of OpenXM_contrib/PHC/Ada/Continuation/process_io.adb, Revision 1.1.1.1
1.1 maekawa 1: with integer_io; use integer_io;
2: with Standard_Floating_Numbers_io; use Standard_Floating_Numbers_io;
3: with Standard_Complex_Numbers_io; use Standard_Complex_Numbers_io;
4: with Standard_Complex_Solutions_io; use Standard_Complex_Solutions_io;
5:
6: package body Process_io is
7:
8: out_code : output_code;
9:
10: procedure Write_path ( ft : in file_type; n : in positive ) is
11: begin
12: if out_code /= nil
13: then put(ft,"***** path");
14: put(ft,n);
15: put(ft," *****");
16: new_line(ft);
17: end if;
18: end Write_path;
19:
20: procedure Write_path ( n : in positive ) is
21: begin
22: Write_path(Standard_Output,n);
23: end Write_path;
24:
25: procedure Write_block ( ft : in file_type; n : in positive ) is
26: begin
27: --if out_code /= nil
28: -- then
29: put(ft,"##### block");
30: put(ft,n);
31: put_line(ft," #####");
32: --end if;
33: end Write_block;
34:
35: procedure Write_block ( n : in positive ) is
36: begin
37: Write_Block(Standard_Output,n);
38: end Write_block;
39:
40: procedure Set_Output_Code ( u : in output_code ) is
41: begin
42: out_code := u;
43: end Set_output_code;
44:
45: procedure sWrite ( ft : in file_type; sol : in Solution ) is
46: begin
47: if (out_code = s) or (out_code = sp) or (out_code = sc) or (out_code = spc)
48: then put(ft,sol);
49: new_line(ft);
50: end if;
51: end sWrite;
52:
53: procedure sWrite ( sol : in Solution ) is
54: begin
55: sWrite(Standard_Output,sol);
56: end sWrite;
57:
58: procedure pWrite ( ft : in file_type;
59: step : in double_float; t : in Complex_Number ) is
60: begin
61: if (out_code = p) or (out_code = sp) or (out_code = pc) or (out_code = spc)
62: then put(ft,"step :"); put(ft,step); put(ft," ");
63: put(ft,"t :"); put(ft,t); new_line(ft);
64: end if;
65: end pWrite;
66:
67: procedure pWrite ( ft : in file_type; step : in double_float;
68: t : in Complex_Number; sol : in Solution ) is
69: begin
70: if (out_code = p) or (out_code = sp) or (out_code = pc) or (out_code = spc)
71: then put(ft,"step :"); put(ft,step); put(ft," ");
72: put(ft,"t :"); put(ft,t); new_line(ft);
73: if (out_code = sp) or (out_code = spc)
74: then put_line(ft,"the predicted solution for t :");
75: put_vector(ft,sol);
76: end if;
77: end if;
78: end pWrite;
79:
80: procedure pWrite ( step : in double_float; t : in Complex_Number ) is
81: begin
82: pWrite(Standard_Output,step,t);
83: end pWrite;
84:
85: procedure pWrite ( step : in double_float; t : in Complex_Number;
86: sol : in Solution ) is
87: begin
88: pWrite(Standard_Output,step,t,sol);
89: end pWrite;
90:
91: procedure cWrite ( ft : in file_type;
92: normax,normrx,normaf,normrf : in double_float ) is
93: begin
94: if (out_code = c) or (out_code = pc) or (out_code = sc) or (out_code = spc)
95: then put(ft,"correction (a&r):");
96: put(ft,normax,3,3,3); put(ft,normrx,3,3,3); put(ft," ");
97: put(ft,"residual (a&r):");
98: put(ft,normaf,3,3,3); put(ft,normaf,3,3,3); new_line(ft);
99: end if;
100: end cWrite;
101:
102: procedure cWrite ( normax,normrx,normaf,normrf : in double_float ) is
103: begin
104: cWrite(Standard_Output,normax,normrx,normaf,normrf);
105: end cWrite;
106:
107: procedure cWrite ( ft : in file_type;
108: rcond : in double_float; m : in natural ) is
109: begin
110: if (out_code = c) or (out_code = sc) or (out_code = pc) or (out_code = spc)
111: then put(ft,"rcond :"); put(ft,rcond); put(ft," ");
112: put(ft,"multiplicity : "); put(ft,m,1); new_line(ft);
113: end if;
114: end cWrite;
115:
116: procedure cWrite ( rcond : in double_float; m : in natural ) is
117: begin
118: cWrite(Standard_Output,rcond,m);
119: end cWrite;
120:
121: procedure Write_convergence_factor ( factor : in double_float ) is
122: begin
123: if (out_code = c) or (out_code = sc) or (out_code = pc) or (out_code = spc)
124: then put("convergence ratio :"); put(factor); new_line;
125: end if;
126: end Write_convergence_factor;
127:
128: procedure Write_convergence_factor
129: ( ft : in file_type; factor : in double_float ) is
130: begin
131: if (out_code = c) or (out_code = sc) or (out_code = pc) or (out_code = spc)
132: then put(ft,"convergence ratio :"); put(ft,factor); new_line(ft);
133: end if;
134: end Write_convergence_factor;
135:
136: procedure Write_Statistics ( nstep,nfail,niter,nsyst : in natural ) is
137: begin
138: Write_Statistics(Standard_Output,nstep,nfail,niter,nsyst);
139: end Write_Statistics;
140:
141: procedure Write_Statistics ( ft : in file_type;
142: nstep,nfail,niter,nsyst : in natural ) is
143: begin
144: --if out_code /= nil
145: -- then
146: put_line(ft,"######################################################");
147: put(ft,"number of steps :"); put(ft,nstep); new_line(ft);
148: put(ft,"number of failures :"); put(ft,nfail); new_line(ft);
149: put(ft,"number of iterations :"); put(ft,niter); new_line(ft);
150: put(ft,"number of systems :"); put(ft,nsyst); new_line(ft);
151: --end if;
152: end Write_Statistics;
153:
154: procedure Write_Total_Statistics
155: ( tnstep,tnfail,tniter,tnsyst : in natural ) is
156: begin
157: Write_Total_Statistics(Standard_Output,tnstep,tnfail,tniter,tnsyst);
158: end Write_Total_Statistics;
159:
160: procedure Write_Total_Statistics
161: ( ft : in file_type;
162: tnstep,tnfail,tniter,tnsyst : in natural ) is
163: begin
164: put(ft,"total number of steps :"); put(ft,tnstep); new_line(ft);
165: put(ft,"total number of failures :"); put(ft,tnfail); new_line(ft);
166: put(ft,"total number of iterations :"); put(ft,tniter); new_line(ft);
167: put(ft,"total number of systems :"); put(ft,tnsyst); new_line(ft);
168: end Write_Total_Statistics;
169:
170: procedure sWrite_Solutions ( sols : in Solution_List ) is
171: begin
172: sWrite_Solutions(Standard_Output,sols);
173: end sWrite_Solutions;
174:
175: procedure sWrite_Solutions ( ft : in file_type; sols : in Solution_List ) is
176: begin
177: if out_code /= nil
178: then put(ft,sols);
179: end if;
180: end sWrite_Solutions;
181:
182: end Process_io;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to process_io.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Continuation