@@ -242,130 +242,6 @@ typedef struct Namelist Namelist;
242242/* procedure parameter types for -A and -C++ */
243243
244244#define F2C_proc_par_types 1
245- #ifdef __cplusplus
246- typedef logical (* L_fp )(...);
247- #else
248- typedef logical (* L_fp )();
249- #endif
250- #if 0
251- static float spow_ui (float x , integer n ) {
252- float pow = 1.0 ; unsigned long int u ;
253- if (n != 0 ) {
254- if (n < 0 ) n = - n , x = 1 /x ;
255- for (u = n ; ; ) {
256- if (u & 01 ) pow *= x ;
257- if (u >>= 1 ) x *= x ;
258- else break ;
259- }
260- }
261- return pow ;
262- }
263- static double dpow_ui (double x , integer n ) {
264- double pow = 1.0 ; unsigned long int u ;
265- if (n != 0 ) {
266- if (n < 0 ) n = - n , x = 1 /x ;
267- for (u = n ; ; ) {
268- if (u & 01 ) pow *= x ;
269- if (u >>= 1 ) x *= x ;
270- else break ;
271- }
272- }
273- return pow ;
274- }
275- #ifdef _MSC_VER
276- static _Fcomplex cpow_ui (complex x , integer n ) {
277- complex pow = {1.0 ,0.0 }; unsigned long int u ;
278- if (n != 0 ) {
279- if (n < 0 ) n = - n , x .r = 1 /x .r , x .i = 1 /x .i ;
280- for (u = n ; ; ) {
281- if (u & 01 ) pow .r *= x .r , pow .i *= x .i ;
282- if (u >>= 1 ) x .r *= x .r , x .i *= x .i ;
283- else break ;
284- }
285- }
286- _Fcomplex p = {pow .r , pow .i };
287- return p ;
288- }
289- #else
290- static _Complex float cpow_ui (_Complex float x , integer n ) {
291- _Complex float pow = 1.0 ; unsigned long int u ;
292- if (n != 0 ) {
293- if (n < 0 ) n = - n , x = 1 /x ;
294- for (u = n ; ; ) {
295- if (u & 01 ) pow *= x ;
296- if (u >>= 1 ) x *= x ;
297- else break ;
298- }
299- }
300- return pow ;
301- }
302- #endif
303- #ifdef _MSC_VER
304- static _Dcomplex zpow_ui (_Dcomplex x , integer n ) {
305- _Dcomplex pow = {1.0 ,0.0 }; unsigned long int u ;
306- if (n != 0 ) {
307- if (n < 0 ) n = - n , x ._Val [0 ] = 1 /x ._Val [0 ], x ._Val [1 ] = 1 /x ._Val [1 ];
308- for (u = n ; ; ) {
309- if (u & 01 ) pow ._Val [0 ] *= x ._Val [0 ], pow ._Val [1 ] *= x ._Val [1 ];
310- if (u >>= 1 ) x ._Val [0 ] *= x ._Val [0 ], x ._Val [1 ] *= x ._Val [1 ];
311- else break ;
312- }
313- }
314- _Dcomplex p = {pow ._Val [0 ], pow ._Val [1 ]};
315- return p ;
316- }
317- #else
318- static _Complex double zpow_ui (_Complex double x , integer n ) {
319- _Complex double pow = 1.0 ; unsigned long int u ;
320- if (n != 0 ) {
321- if (n < 0 ) n = - n , x = 1 /x ;
322- for (u = n ; ; ) {
323- if (u & 01 ) pow *= x ;
324- if (u >>= 1 ) x *= x ;
325- else break ;
326- }
327- }
328- return pow ;
329- }
330- #endif
331- static integer pow_ii (integer x , integer n ) {
332- integer pow ; unsigned long int u ;
333- if (n <= 0 ) {
334- if (n == 0 || x == 1 ) pow = 1 ;
335- else if (x != -1 ) pow = x == 0 ? 1 /x : 0 ;
336- else n = - n ;
337- }
338- if ((n > 0 ) || !(n == 0 || x == 1 || x != -1 )) {
339- u = n ;
340- for (pow = 1 ; ; ) {
341- if (u & 01 ) pow *= x ;
342- if (u >>= 1 ) x *= x ;
343- else break ;
344- }
345- }
346- return pow ;
347- }
348- static integer dmaxloc_ (double * w , integer s , integer e , integer * n )
349- {
350- double m ; integer i , mi ;
351- for (m = w [s - 1 ], mi = s , i = s + 1 ; i <=e ; i ++ )
352- if (w [i - 1 ]> m ) mi = i ,m = w [i - 1 ];
353- return mi - s + 1 ;
354- }
355- static integer smaxloc_ (float * w , integer s , integer e , integer * n )
356- {
357- float m ; integer i , mi ;
358- for (m = w [s - 1 ], mi = s , i = s + 1 ; i <=e ; i ++ )
359- if (w [i - 1 ]> m ) mi = i ,m = w [i - 1 ];
360- return mi - s + 1 ;
361- }
362- #endif
363- /* -- translated by f2c (version 20000121).
364- You must link the resulting object file with the libraries:
365- -lf2c -lm (in that order)
366- */
367-
368-
369245
370246
371247/* Common Block Declarations */
0 commit comments