Annotation of OpenXM_contrib/PHC/Ada/Continuation/process_io.adb, Revision 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