Annotation of OpenXM_contrib2/asir2000/engine/cplx.c, Revision 1.2
1.2 ! noro 1: /*
! 2: * Copyright (c) 1994-2000 FUJITSU LABORATORIES LIMITED
! 3: * All rights reserved.
! 4: *
! 5: * FUJITSU LABORATORIES LIMITED ("FLL") hereby grants you a limited,
! 6: * non-exclusive and royalty-free license to use, copy, modify and
! 7: * redistribute, solely for non-commercial and non-profit purposes, the
! 8: * computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and
! 9: * conditions of this Agreement. For the avoidance of doubt, you acquire
! 10: * only a limited right to use the SOFTWARE hereunder, and FLL or any
! 11: * third party developer retains all rights, including but not limited to
! 12: * copyrights, in and to the SOFTWARE.
! 13: *
! 14: * (1) FLL does not grant you a license in any way for commercial
! 15: * purposes. You may use the SOFTWARE only for non-commercial and
! 16: * non-profit purposes only, such as academic, research and internal
! 17: * business use.
! 18: * (2) The SOFTWARE is protected by the Copyright Law of Japan and
! 19: * international copyright treaties. If you make copies of the SOFTWARE,
! 20: * with or without modification, as permitted hereunder, you shall affix
! 21: * to all such copies of the SOFTWARE the above copyright notice.
! 22: * (3) An explicit reference to this SOFTWARE and its copyright owner
! 23: * shall be made on your publication or presentation in any form of the
! 24: * results obtained by use of the SOFTWARE.
! 25: * (4) In the event that you modify the SOFTWARE, you shall notify FLL by
! 26: * e-mail at risa-admin@flab.fujitsu.co.jp of the detailed specification
! 27: * for such modification or the source code of the modified part of the
! 28: * SOFTWARE.
! 29: *
! 30: * THE SOFTWARE IS PROVIDED AS IS WITHOUT ANY WARRANTY OF ANY KIND. FLL
! 31: * MAKES ABSOLUTELY NO WARRANTIES, EXPRESSED, IMPLIED OR STATUTORY, AND
! 32: * EXPRESSLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS
! 33: * FOR A PARTICULAR PURPOSE OR NONINFRINGEMENT OF THIRD PARTIES'
! 34: * RIGHTS. NO FLL DEALER, AGENT, EMPLOYEES IS AUTHORIZED TO MAKE ANY
! 35: * MODIFICATIONS, EXTENSIONS, OR ADDITIONS TO THIS WARRANTY.
! 36: * UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, TORT, CONTRACT,
! 37: * OR OTHERWISE, SHALL FLL BE LIABLE TO YOU OR ANY OTHER PERSON FOR ANY
! 38: * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, PUNITIVE OR CONSEQUENTIAL
! 39: * DAMAGES OF ANY CHARACTER, INCLUDING, WITHOUT LIMITATION, DAMAGES
! 40: * ARISING OUT OF OR RELATING TO THE SOFTWARE OR THIS AGREEMENT, DAMAGES
! 41: * FOR LOSS OF GOODWILL, WORK STOPPAGE, OR LOSS OF DATA, OR FOR ANY
! 42: * DAMAGES, EVEN IF FLL SHALL HAVE BEEN INFORMED OF THE POSSIBILITY OF
! 43: * SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. EVEN IF A PART
! 44: * OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY
! 45: * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
! 46: * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
! 47: *
! 48: * $OpenXM: OpenXM_contrib2/asir2000/engine/cplx.c,v 1.1.1.1 1999/12/03 07:39:08 noro Exp $
! 49: */
1.1 noro 50: #include "ca.h"
51: #include "base.h"
52: #if PARI
53: #include "genpari.h"
54: void patori(GEN,Obj *);
55: void patori_i(GEN,N *);
56: void ritopa(Obj,GEN *);
57: void ritopa_i(N,int,GEN *);
58: #endif
59:
60: void toreim(a,rp,ip)
61: Num a;
62: Num *rp,*ip;
63: {
64: if ( !a )
65: *rp = *ip = 0;
66: else if ( NID(a) <= N_B ) {
67: *rp = a; *ip = 0;
68: } else {
69: *rp = ((C)a)->r; *ip = ((C)a)->i;
70: }
71: }
72:
73: void reimtocplx(r,i,cp)
74: Num r,i;
75: Num *cp;
76: {
77: C c;
78:
79: if ( !i )
80: *cp = r;
81: else {
82: NEWC(c); c->r = r; c->i = i; *cp = (Num)c;
83: }
84: }
85:
86: void addcplx(a,b,c)
87: Num a,b;
88: Num *c;
89: {
90: Num ar,ai,br,bi,cr,ci;
91:
92: if ( !a )
93: *c = b;
94: else if ( !b )
95: *c = a;
96: else if ( (NID(a) <= N_B) && (NID(b) <= N_B ) )
97: addnum(0,a,b,c);
98: else {
99: toreim(a,&ar,&ai); toreim(b,&br,&bi);
100: addnum(0,ar,br,&cr); addnum(0,ai,bi,&ci);
101: reimtocplx(cr,ci,c);
102: }
103: }
104:
105: void subcplx(a,b,c)
106: Num a,b;
107: Num *c;
108: {
109: Num ar,ai,br,bi,cr,ci;
110:
111: if ( !a )
112: chsgnnum(b,c);
113: else if ( !b )
114: *c = a;
115: else if ( (NID(a) <= N_B) && (NID(b) <= N_B ) )
116: subnum(0,a,b,c);
117: else {
118: toreim(a,&ar,&ai); toreim(b,&br,&bi);
119: subnum(0,ar,br,&cr); subnum(0,ai,bi,&ci);
120: reimtocplx(cr,ci,c);
121: }
122: }
123:
124: void mulcplx(a,b,c)
125: Num a,b;
126: Num *c;
127: {
128: Num ar,ai,br,bi,cr,ci,t,s;
129:
130: if ( !a || !b )
131: *c = 0;
132: else if ( (NID(a) <= N_B) && (NID(b) <= N_B ) )
133: mulnum(0,a,b,c);
134: else {
135: toreim(a,&ar,&ai); toreim(b,&br,&bi);
136: mulnum(0,ar,br,&t); mulnum(0,ai,bi,&s); subnum(0,t,s,&cr);
137: mulnum(0,ar,bi,&t); mulnum(0,ai,br,&s); addnum(0,t,s,&ci);
138: reimtocplx(cr,ci,c);
139: }
140: }
141:
142: void divcplx(a,b,c)
143: Num a,b;
144: Num *c;
145: {
146: Num ar,ai,br,bi,cr,ci,t,s,u,w;
147:
148: if ( !b )
149: error("divcplx : division by 0");
150: else if ( !a )
151: *c = 0;
152: else if ( (NID(a) <= N_B) && (NID(b) <= N_B ) )
153: divnum(0,a,b,c);
154: else {
155: toreim(a,&ar,&ai); toreim(b,&br,&bi);
156: mulnum(0,br,br,&t); mulnum(0,bi,bi,&s); addnum(0,t,s,&u);
157: mulnum(0,ar,br,&t); mulnum(0,ai,bi,&s);
158: addnum(0,t,s,&w); divnum(0,w,u,&cr);
159: mulnum(0,ar,bi,&t); mulnum(0,ai,br,&s);
160: subnum(0,s,t,&w); divnum(0,w,u,&ci);
161: reimtocplx(cr,ci,c);
162: }
163: }
164:
165: void pwrcplx(a,e,c)
166: Num a,e;
167: Num *c;
168: {
169: int ei;
170: Num t;
171: extern long prec;
172:
173: if ( !e )
174: *c = (Num)ONE;
175: else if ( !a )
176: *c = 0;
177: else if ( !INT(e) ) {
178: #if PARI
179: GEN pa,pe,z;
180: int ltop,lbot;
181:
182: ltop = avma; ritopa((Obj)a,&pa); ritopa((Obj)e,&pe); lbot = avma;
183: z = gerepile(ltop,lbot,gpui(pa,pe,prec));
184: patori(z,(Obj *)c); cgiv(z);
185: #else
186: error("pwrcplx : can't calculate a fractional power");
187: #endif
188: } else {
189: ei = SGN((Q)e)*QTOS((Q)e);
190: pwrcplx0(a,ei,&t);
191: if ( SGN((Q)e) < 0 )
192: divnum(0,(Num)ONE,t,c);
193: else
194: *c = t;
195: }
196: }
197:
198: void pwrcplx0(a,e,c)
199: Num a;
200: int e;
201: Num *c;
202: {
203: Num t,s;
204:
205: if ( e == 1 )
206: *c = a;
207: else {
208: pwrcplx0(a,e/2,&t);
209: if ( !(e%2) )
210: mulnum(0,t,t,c);
211: else {
212: mulnum(0,t,t,&s); mulnum(0,s,a,c);
213: }
214: }
215: }
216:
217: void chsgncplx(a,c)
218: Num a,*c;
219: {
220: Num r,i;
221:
222: if ( !a )
223: *c = 0;
224: else if ( NID(a) <= N_B )
225: chsgnnum(a,c);
226: else {
227: chsgnnum(((C)a)->r,&r); chsgnnum(((C)a)->i,&i);
228: reimtocplx(r,i,c);
229: }
230: }
231:
232: int cmpcplx(a,b)
233: Num a,b;
234: {
235: Num ar,ai,br,bi;
236: int s;
237:
238: if ( !a ) {
239: if ( !b || (NID(b)<=N_B) )
240: return compnum(0,a,b);
241: else
242: return -1;
243: } else if ( !b ) {
244: if ( !a || (NID(a)<=N_B) )
245: return compnum(0,a,b);
246: else
247: return 1;
248: } else {
249: toreim(a,&ar,&ai); toreim(b,&br,&bi);
250: s = compnum(0,ar,br);
251: if ( s )
252: return s;
253: else
254: return compnum(0,ai,bi);
255: }
256: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to cplx.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2000 / engine