scipvmf77.c File Reference

#include <stdio.h>
#include "stack-c.h"
#include "machine.h"
#include "sci_pvm.h"

Include dependency graph for scipvmf77.c:

Go to the source code of this file.

Typedefs

typedef void(*) Fm (double *, int *)
typedef void(*) Fl (int *)

Functions

static void swap (double *, double *, int)
static void sci_to_f77 (double *, int *)
static void f77_to_sci (double *, int *)
static void sci_object_walk (int il, Fm fm, int stk_pos)
void C2F() scipvmf77tosci (int *k)
void C2F() scipvmscitof77 (int *k)


Typedef Documentation

typedef void(*) Fl(int *)

Definition at line 44 of file scipvmf77.c.

typedef void(*) Fm(double *, int *)

Definition at line 43 of file scipvmf77.c.


Function Documentation

static void f77_to_sci ( double *  ,
int  
) [static]

Definition at line 139 of file scipvmf77.c.

References nb, and swap.

Referenced by scipvmf77tosci().

00140 {
00141   int nb;
00142   
00143   if (*size == 1) {
00144     return;
00145   }
00146   nb = *size / 2;
00147   if (*size % 2) {              
00148     /* si le nbr est impaire on "coupe" un
00149      * complexe en deux et donc il faut
00150      * reparer ce crime... 
00151      */
00152     f77_to_sci(&tab[0], &nb);
00153     f77_to_sci(&tab[*size + 1], &nb);
00154     swap(&(tab[*size - 1]), &(tab[*size]), 1);
00155     swap(&tab[*size - nb - 1], &tab[*size], nb + 1); 
00156   }
00157   else {
00158     f77_to_sci(&tab[0], &nb);
00159     f77_to_sci(&tab[*size], &nb);
00160     swap(&tab[*size - nb], &tab[*size], nb); 
00161   }
00162 } 

Here is the caller graph for this function:

static void sci_object_walk ( int  il,
Fm  fm,
int  stk_pos 
) [static]

Definition at line 180 of file scipvmf77.c.

References i, iadr, id, ilp, istk, l, Lstk, m, n, ne, nel, sadr, sci_list, sci_matrix, sci_mlist, sci_poly, sci_sparse, sci_tlist, stk, and type.

Referenced by scipvmf77tosci(), and scipvmscitof77().

00181 {
00182   int ix1, ix2,type, m, n,id, mn, nel,ne,il,ilp,i,li,ill,l;
00183 
00184   if ( stk_pos == 1 ) 
00185     {
00186       /* object given by its stk position */ 
00187       il = iadr(*Lstk(ilk));
00188       if (*istk(il ) < 0) {
00189         il = iadr(*istk(il +1));
00190       }
00191     }
00192   else 
00193     {
00194       il = ilk;
00195     }
00196 
00197   type = *istk(il); 
00198 
00199   switch ( type ) {
00200   case sci_matrix : 
00201     if ( *istk(il + 3) == 1) {
00202       /* this is a complex scalar matrix */ 
00203       mn = *istk(il +1) * *istk(il + 2);
00204       ix1 = il + 4;
00205       fm(stk(sadr(ix1) ), &mn);
00206     } 
00207     break; 
00208   case sci_poly : 
00209     if ( *istk(il + 3) == 1) {
00210       /* this is a complex polynomial  matrix */ 
00211       id = il + 8;
00212       mn = *istk(il +1) * *istk(il+2);
00213       ix1 = il + 9 + mn;
00214       ix2 = *istk(id + mn ) - 1;
00215       fm(stk(sadr(ix1) ), &ix2);
00216     }
00217     break; 
00218   case sci_sparse : 
00219     if ( *istk(il + 3) == 1) {
00220       /* this is a complex sparse matrix */ 
00221       nel = *istk(il + 3 +1);
00222       m = *istk(il +1);
00223       n = *istk(il + 1 +1);
00224       ix1 = il + 5 + m + nel;
00225       fm(stk(sadr(ix1) ), &nel);
00226     }
00227     break; 
00228   case sci_list : 
00229   case sci_tlist : 
00230   case sci_mlist : 
00231     /* nb element of the list */
00232     ne = istk(il)[1];
00233     /* loop on objects */
00234     ilp = il + 2;
00235     l = sadr(ilp + ne + 1);
00236     for (i = 1; i <= ne; ++i) { 
00237       li  = istk(ilp)[i-1];
00238       ill = iadr(l + li -1);
00239       /* recursive call but now with an istk position 
00240        * i.e stk_pos == 0 
00241        */ 
00242       sci_object_walk(ill,fm,0);
00243     }
00244     break ; 
00245   default : 
00246     break;
00247   }
00248 }

Here is the caller graph for this function:

static void sci_to_f77 ( double *  ,
int  
) [static]

Definition at line 103 of file scipvmf77.c.

References nb, and swap.

Referenced by scipvmscitof77().

00104 {
00105   int nb;
00106   
00107   if (*size == 1) {
00108     return;
00109   }
00110   nb = *size / 2;
00111   if (*size % 2) {              
00112     /* si le nbr est impaire on "coupe" un
00113      *   complexe en deux et donc il faut
00114      * reparer ce crime... 
00115      */
00116     swap(&(tab[nb]), &(tab[*size + nb]), 1);
00117     swap(&tab[*size - nb - 1], &tab[*size], nb + 1); 
00118     sci_to_f77(&tab[0], &nb);
00119     sci_to_f77(&tab[*size + 1], &nb);
00120   }
00121   else {
00122     swap(&tab[*size - nb], &tab[*size], nb); 
00123     sci_to_f77(&tab[0], &nb);
00124     sci_to_f77(&tab[*size], &nb);
00125   }
00126 }

Here is the caller graph for this function:

void C2F() scipvmf77tosci ( int k  ) 

Definition at line 54 of file scipvmf77.c.

References f77_to_sci(), and sci_object_walk().

Referenced by intspvm_f772sci().

00055 {
00056   /* call sci_object_walk 
00057    * object is given by its lstk position 
00058    */
00059   sci_object_walk(*k,f77_to_sci,1);
00060 } 

Here is the call graph for this function:

Here is the caller graph for this function:

void C2F() scipvmscitof77 ( int k  ) 

Definition at line 69 of file scipvmf77.c.

References sci_object_walk(), and sci_to_f77().

Referenced by intspvm_sci2f77().

00070 {
00071   /* call sci_object_walk 
00072    * object is given by its lstk position 
00073    */
00074   sci_object_walk(*k,sci_to_f77,1);
00075 } 

Here is the call graph for this function:

Here is the caller graph for this function:

static void swap ( double *  ,
double *  ,
int   
) [static]

Definition at line 92 of file scipvmf77.c.

References i.

00093 {
00094   double tmp;
00095   int i;
00096   for (i = 0; i < size; ++i) {
00097     tmp = ptr1[i];
00098     ptr1[i] = ptr2[i];
00099     ptr2[i] = tmp;
00100   }
00101 }


Generated on Sun Mar 4 16:11:15 2007 for Scilab [trunk] by  doxygen 1.5.1