@@ -247,7 +247,6 @@ typedef struct Namelist Namelist;
247247#define s_copy (A ,B ,C ,D ) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; }
248248#define sig_die (s , kill ) { exit(1); }
249249#define s_stop (s , n ) {exit(0);}
250- static char junk [] = "\n@(#)LIBF77 VERSION 19990503\n" ;
251250#define z_abs (z ) (cabs(Cd(z)))
252251#define z_exp (R , Z ) {pCd(R) = cexp(Cd(Z));}
253252#define z_sqrt (R , Z ) {pCd(R) = csqrt(Cd(Z));}
@@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n";
261260/* procedure parameter types for -A and -C++ */
262261
263262#define F2C_proc_par_types 1
264- #ifdef __cplusplus
265- typedef logical (* L_fp )(...);
266- #else
267- typedef logical (* L_fp )();
268- #endif
269-
270- static float spow_ui (float x , integer n ) {
271- float pow = 1.0 ; unsigned long int u ;
272- if (n != 0 ) {
273- if (n < 0 ) n = - n , x = 1 /x ;
274- for (u = n ; ; ) {
275- if (u & 01 ) pow *= x ;
276- if (u >>= 1 ) x *= x ;
277- else break ;
278- }
279- }
280- return pow ;
281- }
282- static double dpow_ui (double x , integer n ) {
283- double pow = 1.0 ; unsigned long int u ;
284- if (n != 0 ) {
285- if (n < 0 ) n = - n , x = 1 /x ;
286- for (u = n ; ; ) {
287- if (u & 01 ) pow *= x ;
288- if (u >>= 1 ) x *= x ;
289- else break ;
290- }
291- }
292- return pow ;
293- }
294- #ifdef _MSC_VER
295- static _Fcomplex cpow_ui (complex x , integer n ) {
296- complex pow = {1.0 ,0.0 }; unsigned long int u ;
297- if (n != 0 ) {
298- if (n < 0 ) n = - n , x .r = 1 /x .r , x .i = 1 /x .i ;
299- for (u = n ; ; ) {
300- if (u & 01 ) pow .r *= x .r , pow .i *= x .i ;
301- if (u >>= 1 ) x .r *= x .r , x .i *= x .i ;
302- else break ;
303- }
304- }
305- _Fcomplex p = {pow .r , pow .i };
306- return p ;
307- }
308- #else
309- static _Complex float cpow_ui (_Complex float x , integer n ) {
310- _Complex float pow = 1.0 ; unsigned long int u ;
311- if (n != 0 ) {
312- if (n < 0 ) n = - n , x = 1 /x ;
313- for (u = n ; ; ) {
314- if (u & 01 ) pow *= x ;
315- if (u >>= 1 ) x *= x ;
316- else break ;
317- }
318- }
319- return pow ;
320- }
321- #endif
322- #ifdef _MSC_VER
323- static _Dcomplex zpow_ui (_Dcomplex x , integer n ) {
324- _Dcomplex pow = {1.0 ,0.0 }; unsigned long int u ;
325- if (n != 0 ) {
326- if (n < 0 ) n = - n , x ._Val [0 ] = 1 /x ._Val [0 ], x ._Val [1 ] = 1 /x ._Val [1 ];
327- for (u = n ; ; ) {
328- if (u & 01 ) pow ._Val [0 ] *= x ._Val [0 ], pow ._Val [1 ] *= x ._Val [1 ];
329- if (u >>= 1 ) x ._Val [0 ] *= x ._Val [0 ], x ._Val [1 ] *= x ._Val [1 ];
330- else break ;
331- }
332- }
333- _Dcomplex p = {pow ._Val [0 ], pow ._Val [1 ]};
334- return p ;
335- }
336- #else
337- static _Complex double zpow_ui (_Complex double x , integer n ) {
338- _Complex double pow = 1.0 ; unsigned long int u ;
339- if (n != 0 ) {
340- if (n < 0 ) n = - n , x = 1 /x ;
341- for (u = n ; ; ) {
342- if (u & 01 ) pow *= x ;
343- if (u >>= 1 ) x *= x ;
344- else break ;
345- }
346- }
347- return pow ;
348- }
349- #endif
350- static integer pow_ii (integer x , integer n ) {
351- integer pow ; unsigned long int u ;
352- if (n <= 0 ) {
353- if (n == 0 || x == 1 ) pow = 1 ;
354- else if (x != -1 ) pow = x == 0 ? 1 /x : 0 ;
355- else n = - n ;
356- }
357- if ((n > 0 ) || !(n == 0 || x == 1 || x != -1 )) {
358- u = n ;
359- for (pow = 1 ; ; ) {
360- if (u & 01 ) pow *= x ;
361- if (u >>= 1 ) x *= x ;
362- else break ;
363- }
364- }
365- return pow ;
366- }
367- static integer dmaxloc_ (double * w , integer s , integer e , integer * n )
368- {
369- double m ; integer i , mi ;
370- for (m = w [s - 1 ], mi = s , i = s + 1 ; i <=e ; i ++ )
371- if (w [i - 1 ]> m ) mi = i ,m = w [i - 1 ];
372- return mi - s + 1 ;
373- }
374- static integer smaxloc_ (float * w , integer s , integer e , integer * n )
375- {
376- float m ; integer i , mi ;
377- for (m = w [s - 1 ], mi = s , i = s + 1 ; i <=e ; i ++ )
378- if (w [i - 1 ]> m ) mi = i ,m = w [i - 1 ];
379- return mi - s + 1 ;
380- }
381- static inline void cdotc_ (complex * z , integer * n_ , complex * x , integer * incx_ , complex * y , integer * incy_ ) {
382- integer n = * n_ , incx = * incx_ , incy = * incy_ , i ;
383- #ifdef _MSC_VER
384- _Fcomplex zdotc = {0.0 , 0.0 };
385- if (incx == 1 && incy == 1 ) {
386- for (i = 0 ;i < n ;i ++ ) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
387- zdotc ._Val [0 ] += conjf (Cf (& x [i ]))._Val [0 ] * Cf (& y [i ])._Val [0 ];
388- zdotc ._Val [1 ] += conjf (Cf (& x [i ]))._Val [1 ] * Cf (& y [i ])._Val [1 ];
389- }
390- } else {
391- for (i = 0 ;i < n ;i ++ ) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
392- zdotc ._Val [0 ] += conjf (Cf (& x [i * incx ]))._Val [0 ] * Cf (& y [i * incy ])._Val [0 ];
393- zdotc ._Val [1 ] += conjf (Cf (& x [i * incx ]))._Val [1 ] * Cf (& y [i * incy ])._Val [1 ];
394- }
395- }
396- pCf (z ) = zdotc ;
397- }
398- #else
399- _Complex float zdotc = 0.0 ;
400- if (incx == 1 && incy == 1 ) {
401- for (i = 0 ;i < n ;i ++ ) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
402- zdotc += conjf (Cf (& x [i ])) * Cf (& y [i ]);
403- }
404- } else {
405- for (i = 0 ;i < n ;i ++ ) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
406- zdotc += conjf (Cf (& x [i * incx ])) * Cf (& y [i * incy ]);
407- }
408- }
409- pCf (z ) = zdotc ;
410- }
411- #endif
412- static inline void zdotc_ (doublecomplex * z , integer * n_ , doublecomplex * x , integer * incx_ , doublecomplex * y , integer * incy_ ) {
413- integer n = * n_ , incx = * incx_ , incy = * incy_ , i ;
414- #ifdef _MSC_VER
415- _Dcomplex zdotc = {0.0 , 0.0 };
416- if (incx == 1 && incy == 1 ) {
417- for (i = 0 ;i < n ;i ++ ) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
418- zdotc ._Val [0 ] += conj (Cd (& x [i ]))._Val [0 ] * Cd (& y [i ])._Val [0 ];
419- zdotc ._Val [1 ] += conj (Cd (& x [i ]))._Val [1 ] * Cd (& y [i ])._Val [1 ];
420- }
421- } else {
422- for (i = 0 ;i < n ;i ++ ) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
423- zdotc ._Val [0 ] += conj (Cd (& x [i * incx ]))._Val [0 ] * Cd (& y [i * incy ])._Val [0 ];
424- zdotc ._Val [1 ] += conj (Cd (& x [i * incx ]))._Val [1 ] * Cd (& y [i * incy ])._Val [1 ];
425- }
426- }
427- pCd (z ) = zdotc ;
428- }
429- #else
430- _Complex double zdotc = 0.0 ;
431- if (incx == 1 && incy == 1 ) {
432- for (i = 0 ;i < n ;i ++ ) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
433- zdotc += conj (Cd (& x [i ])) * Cd (& y [i ]);
434- }
435- } else {
436- for (i = 0 ;i < n ;i ++ ) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
437- zdotc += conj (Cd (& x [i * incx ])) * Cd (& y [i * incy ]);
438- }
439- }
440- pCd (z ) = zdotc ;
441- }
442- #endif
443- static inline void cdotu_ (complex * z , integer * n_ , complex * x , integer * incx_ , complex * y , integer * incy_ ) {
444- integer n = * n_ , incx = * incx_ , incy = * incy_ , i ;
445- #ifdef _MSC_VER
446- _Fcomplex zdotc = {0.0 , 0.0 };
447- if (incx == 1 && incy == 1 ) {
448- for (i = 0 ;i < n ;i ++ ) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
449- zdotc ._Val [0 ] += Cf (& x [i ])._Val [0 ] * Cf (& y [i ])._Val [0 ];
450- zdotc ._Val [1 ] += Cf (& x [i ])._Val [1 ] * Cf (& y [i ])._Val [1 ];
451- }
452- } else {
453- for (i = 0 ;i < n ;i ++ ) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
454- zdotc ._Val [0 ] += Cf (& x [i * incx ])._Val [0 ] * Cf (& y [i * incy ])._Val [0 ];
455- zdotc ._Val [1 ] += Cf (& x [i * incx ])._Val [1 ] * Cf (& y [i * incy ])._Val [1 ];
456- }
457- }
458- pCf (z ) = zdotc ;
459- }
460- #else
461- _Complex float zdotc = 0.0 ;
462- if (incx == 1 && incy == 1 ) {
463- for (i = 0 ;i < n ;i ++ ) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
464- zdotc += Cf (& x [i ]) * Cf (& y [i ]);
465- }
466- } else {
467- for (i = 0 ;i < n ;i ++ ) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
468- zdotc += Cf (& x [i * incx ]) * Cf (& y [i * incy ]);
469- }
470- }
471- pCf (z ) = zdotc ;
472- }
473- #endif
474- static inline void zdotu_ (doublecomplex * z , integer * n_ , doublecomplex * x , integer * incx_ , doublecomplex * y , integer * incy_ ) {
475- integer n = * n_ , incx = * incx_ , incy = * incy_ , i ;
476- #ifdef _MSC_VER
477- _Dcomplex zdotc = {0.0 , 0.0 };
478- if (incx == 1 && incy == 1 ) {
479- for (i = 0 ;i < n ;i ++ ) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
480- zdotc ._Val [0 ] += Cd (& x [i ])._Val [0 ] * Cd (& y [i ])._Val [0 ];
481- zdotc ._Val [1 ] += Cd (& x [i ])._Val [1 ] * Cd (& y [i ])._Val [1 ];
482- }
483- } else {
484- for (i = 0 ;i < n ;i ++ ) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
485- zdotc ._Val [0 ] += Cd (& x [i * incx ])._Val [0 ] * Cd (& y [i * incy ])._Val [0 ];
486- zdotc ._Val [1 ] += Cd (& x [i * incx ])._Val [1 ] * Cd (& y [i * incy ])._Val [1 ];
487- }
488- }
489- pCd (z ) = zdotc ;
490- }
491- #else
492- _Complex double zdotc = 0.0 ;
493- if (incx == 1 && incy == 1 ) {
494- for (i = 0 ;i < n ;i ++ ) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
495- zdotc += Cd (& x [i ]) * Cd (& y [i ]);
496- }
497- } else {
498- for (i = 0 ;i < n ;i ++ ) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
499- zdotc += Cd (& x [i * incx ]) * Cd (& y [i * incy ]);
500- }
501- }
502- pCd (z ) = zdotc ;
503- }
504- #endif
505- /* -- translated by f2c (version 20000121).
506- You must link the resulting object file with the libraries:
507- -lf2c -lm (in that order)
508- */
509-
510-
511263
512264
513265/* Table of constant values */
0 commit comments