Cleanup some old codes 11/12511/2
Sylvestre Ledru [Thu, 12 Sep 2013 09:20:16 +0000 (11:20 +0200)]
Change-Id: Ib63f9f5c93ea19ea9129af9d7c536fd4330298d3

15 files changed:
scilab/modules/mpi/src/c/#s_mpi_send.c# [deleted file]
scilab/modules/mpi/src/c/dboard.c [deleted file]
scilab/modules/mpi/src/c/mpi_pi_reduce.c [deleted file]
scilab/modules/mpi/src/c/mpi_pi_send.c [deleted file]
scilab/modules/mpi/src/c/pre_send_recv_metadata.c [deleted file]
scilab/modules/mpi/src/fortran/intmpi.f [deleted file]
scilab/modules/mpi/src/fortran/intsmpi_comm_rank.f [deleted file]
scilab/modules/mpi/src/fortran/intsmpi_comm_size.f [deleted file]
scilab/modules/mpi/src/fortran/intsmpi_finalize.f [deleted file]
scilab/modules/mpi/src/fortran/intsmpi_init.f [deleted file]
scilab/modules/mpi/src/fortran/intsmpi_irecv.f [deleted file]
scilab/modules/mpi/src/fortran/intsmpi_isend.f [deleted file]
scilab/modules/mpi/src/fortran/intsmpi_recv.f [deleted file]
scilab/modules/mpi/src/fortran/intsmpi_send.f [deleted file]
scilab/modules/mpi/src/fortran/mpi_init.f [deleted file]

diff --git a/scilab/modules/mpi/src/c/#s_mpi_send.c# b/scilab/modules/mpi/src/c/#s_mpi_send.c#
deleted file mode 100644 (file)
index 3db5c97..0000000
+++ /dev/null
@@ -1,113 +0,0 @@
-/**
- * @author INRIA Lorraine - 1999
- * @author Sylvestre LEDRU <sylvestre.ledru@inria.fr> INRIA Rocquencourt - 2007
- */
-#include "sci_mpi.h"
-#include "s_mpi_send.h"
-#include "build_buff_type.h"
-
-void C2F(s_mpi_send)(int *pack, int *n, double *buff, int *dest, int *tag, int *comm, int *res){
-  int errcode, errclass;       /* Error mgmt */
-  char error_msg[MPI_MAX_ERROR_STRING];
-  int error_msg_length;
-  int l;                       /* size of the buff to send in bytes */
-  
-  MPI_Datatype buff_type;
-
-  MPI_Errhandler_set(MPI_COMM_WORLD, MPI_ERRORS_RETURN);
-#ifdef DEBUG
-  if (debuglevel >= 5) {    
-    int *ptr_int = (int *)buff;
-    (void) fprintf(stderr, "MPI_SEND: %d:%d:%d:%d|%d:%d|%d:%d:%d:%d|%f:%f\n", 
-                  *n, *dest, *tag, *comm, 
-                  pack[0], pack[1], 
-                  ptr_int[0],ptr_int[1],
-                  ptr_int[2],ptr_int[3],
-                  buff[2],buff[3]);
-    (void) fflush (stderr);    
-  }
-#endif /* DEBUG */
-
-#ifdef DEBUG
-  if (debuglevel >= 10) {
-    int i;
-    (void) fprintf(stderr, "MPI_SEND: %d|", *n);       
-    for (i = 0; i < *n; ++i) {
-      (void) fprintf(stderr, "%d:", 
-                    pack[i]);
-    }
-    (void) fprintf(stderr, "\n");
-    (void) fflush(stderr);     
-  }    
-#endif /* DEBUG */
-  
-  errcode = build_buff_type(*n, pack, &buff_type, &l);
-  if (errcode != MPI_SUCCESS){
-    MPI_Error_string(errcode, error_msg, &error_msg_length);
-    MPI_Error_class(errcode, &errclass);
-    (void) fprintf(stderr, "Error mpi_send -build_buff_type-: %d:%s\n", 
-                  errclass, error_msg);
-    (void) fflush(stderr);
-    *res = errcode;
-    return;
-  }
-  errcode = MPI_Type_commit(&buff_type);
-  if (errcode != MPI_SUCCESS){
-    MPI_Error_string(errcode, error_msg, &error_msg_length);
-    MPI_Error_class(errcode, &errclass);
-    (void) fprintf(stderr, "Error mpi_send -MPI_Type_commit-: %d:%s\n", 
-                  errclass, error_msg);
-    (void) fflush(stderr);
-    *res = errcode;
-    return;
-  }
-    
-                               /* Send the packing vector. The recv
-                                  part must make a call to probe
-                                  firts to have its size. */
-  errcode = MPI_Send(pack, *n, MPI_INT, *dest, *tag, MPI_COMM_WORLD);  
-  if (errcode != MPI_SUCCESS){
-    MPI_Error_string(errcode, error_msg, &error_msg_length);
-    MPI_Error_class(errcode, &errclass);
-    (void) fprintf(stderr, "Error mpi_send -MPI_Send-: %d:%s\n", 
-                  errclass, error_msg);
-    (void) fflush(stderr);
-    *res = errcode;
-    return;
-  }
-                               /* Send the data... */
-  errcode = MPI_Send(buff, 1, buff_type, *dest, *tag, MPI_COMM_WORLD);  
-  if (errcode != MPI_SUCCESS){
-    MPI_Error_string(errcode, error_msg, &error_msg_length);
-    MPI_Error_class(errcode, &errclass);
-    (void) fprintf(stderr, "Error mpi_send -MPI_Send-: %d:%s\n", 
-                  errclass, error_msg);
-    (void) fflush(stderr);
-    *res = errcode;
-    return;
-  }
-  
-#ifdef DEBUG
-  if (debuglevel >= 10) {
-    int i;
-    char *ptr = (char*) buff;
-    (void) fprintf(stderr, "SEND:");   
-    for (i = 0; i < l; ++i) {
-      (void) fprintf(stderr, "%d:",ptr[i]);
-    }
-    (void) fprintf(stderr, "\n");      
-    (void) fflush (stderr);    
-  }    
-#endif /* DEBUG */
-  errcode = MPI_Type_free(&buff_type);
-  if (errcode != MPI_SUCCESS){
-    MPI_Error_string(errcode, error_msg, &error_msg_length);
-    MPI_Error_class(errcode, &errclass);
-    (void) fprintf(stderr, "Error mpi_send -MPI_Type_free-: %d:%s\n", 
-                  errclass, error_msg);
-    (void) fflush(stderr);
-    *res = errcode;
-    return;
-  }
-  *res = MPI_SUCCESS;
-} 
diff --git a/scilab/modules/mpi/src/c/dboard.c b/scilab/modules/mpi/src/c/dboard.c
deleted file mode 100644 (file)
index 0c21fbe..0000000
+++ /dev/null
@@ -1,39 +0,0 @@
-/* dboard.c
-   see pi_send.c and pi_reduce.c    */
-
-#include <stdlib.h>
-#define sqr(x) ((x)*(x))
-long random(void);
-
-double dboard(int darts)
-     {
-     double x_coord,       /* x coordinate, between -1 and 1  */
-            y_coord,       /* y coordinate, between -1 and 1  */
-            pi,            /* pi  */
-            r;             /* random number between 0 and 1  */
-     int score,            /* number of darts that hit circle */
-         n;
-     unsigned long cconst; /* used to convert integer random number */
-                           /* between 0 and 2^31 to double random number */
-                           /* between 0 and 1  */
-
-     cconst = 2 << (31 - 1);
-     score = 0;
-
-     /* "throw darts at board" */
-     for (n = 1; n <= darts; n++)  {
-          /* generate random numbers for x and y coordinates */
-          r = (double)random()/cconst;
-          x_coord = (2.0 * r) - 1.0;
-          r = (double)random()/cconst;
-          y_coord = (2.0 * r) - 1.0;
-
-          /* if dart lands in circle, increment score */
-          if ((sqr(x_coord) + sqr(y_coord)) <= 1.0)
-               score++;
-          }
-
-     /* calculate pi */
-     pi = 4.0 * (double)score/(double)darts;
-     return(pi);
-     } 
diff --git a/scilab/modules/mpi/src/c/mpi_pi_reduce.c b/scilab/modules/mpi/src/c/mpi_pi_reduce.c
deleted file mode 100644 (file)
index d6ab1d4..0000000
+++ /dev/null
@@ -1,89 +0,0 @@
-/* ---------------------------------------------------------------
- * MPI pi Calculation Example - C Version 
- * Collective Communication example
- * FILE: mpi_pi_reduce.c
- * OTHER FILES: dboard.c
- * DESCRIPTION:  MPI pi calculation example program.  C Version.
- *   This program calculates pi using a "dartboard" algorithm.  See
- *   Fox et al.(1988) Solving Problems on Concurrent Processors, vol.1
- *   page 207.  All processes contribute to the calculation, with the
- *   master averaging the values for pi.
- *
- *   SPMD version:  Conditional statements check if the process 
- *   is the master or a worker. 
- *
- *   This version uses mpc_reduce to collect results
- *
- * AUTHOR: Roslyn Leibensperger. Converted to MPI: George L. Gusciora 
- *   (1/25/95)
- * LAST REVISED: 06/07/96 Blaise Barney
- * --------------------------------------------------------------- */
-#include "mpi.h"
-#include <stdlib.h>
-#include <stdio.h>
-void srandom (unsigned seed);
-double dboard (int darts);
-#define DARTS 50000     /* number of throws at dartboard */
-#define ROUNDS 100      /* number of times "darts" is iterated */
-#define MASTER 0        /* task ID of master task */
-
-int main(argc,argv)
-int argc;
-char *argv[];
-{
-double homepi,         /* value of pi calculated by current task */
-       pisum,          /* sum of tasks' pi values */
-       pi,             /* average of pi after "darts" is thrown */
-       avepi;          /* average pi value for all iterations */
-int    taskid,         /* task ID - also used as seed number */
-       numtasks,       /* number of tasks */
-       rc,             /* return code */
-       i;
-MPI_Status status;
-
-   /* Obtain number of tasks and task ID */
-   rc = MPI_Init(&argc,&argv);
-   rc|= MPI_Comm_size(MPI_COMM_WORLD,&numtasks);
-   rc|= MPI_Comm_rank(MPI_COMM_WORLD,&taskid);
-   if (rc != MPI_SUCCESS)
-      printf ("error initializing MPI and obtaining task ID information\n");
-   else
-      printf ("task ID = %d\n", taskid);
-
-   /* Set seed for random number generator equal to task ID */
-   srandom (taskid);
-
-   avepi = 0;
-   for (i = 0; i < ROUNDS; i++)
-   {
-      /* All tasks calculate pi using dartboard algorithm */
-      homepi = dboard(DARTS);
-      /* Use MPI_Reduce to sum values of homepi across all tasks 
-       * Master will store the accumulated value in pisum 
-       * - homepi is the send buffer
-       * - pisum is the receive buffer (used by the receiving task only)
-       * - the size of the message is sizeof(double)
-       * - MASTER is the task that will receive the result of the reduction
-       *   operation
-       * - MPI_SUM is a pre-defined reduction function (double-precision
-       *   floating-point vector addition).  Must be declared extern.
-       * - MPI_COMM_WORLD is the group of tasks that will participate.
-       */
-
-      rc = MPI_Reduce(&homepi, &pisum, 1, MPI_DOUBLE, MPI_SUM,
-                         MASTER, MPI_COMM_WORLD);
-      if (rc != MPI_SUCCESS)
-         printf("%d: failure on mpc_reduce\n", taskid);
-
-      /* Master computes average for this iteration and all iterations */
-      if (taskid == MASTER)
-      {
-         pi = pisum/numtasks;
-         avepi = ((avepi * i) + pi)/(i + 1); 
-         printf("   After %3d throws, average value of pi = %10.8f\n",
-                   (DARTS * (i + 1)),avepi);
-      }    
-   } 
-   MPI_Finalize();
-   return 0;
-}
diff --git a/scilab/modules/mpi/src/c/mpi_pi_send.c b/scilab/modules/mpi/src/c/mpi_pi_send.c
deleted file mode 100644 (file)
index 953e1fa..0000000
+++ /dev/null
@@ -1,103 +0,0 @@
-/* ---------------------------------------------------------------
- * MPI pi Calculation Example - C Version 
- * Point-to-Point communications example
- *
- * FILE: mpi_pi_send.c
- * OTHER FILES: dboard.c
- * DESCRIPTION:  MPI pi calculation example program.  C Version.
- *   This program calculates pi using a "dartboard" algorithm.  See
- *   Fox et al.(1988) Solving Problems on Concurrent Processors, vol.1
- *   page 207.  All processes contribute to the calculation, with the
- *   master averaging the values for pi.
- *
- *   SPMD version:  Conditional statements check if the process 
- *   is the master or a worker. 
- *
- *   This version uses low level sends and receives to collect results
- *
- * AUTHOR: Roslyn Leibensperger. Converted to MPI: George L. Gusciora (1/25/95)
- * LAST REVISED: 12/14/95 Blaise Barney
- * --------------------------------------------------------------- */
-#include "mpi.h"
-#include <stdlib.h>
-#include <stdio.h>
-void srandom (unsigned seed);
-double dboard (int darts);
-#define DARTS 5000      /* number of throws at dartboard */
-#define ROUNDS 100       /* number of times "darts" is iterated */
-#define MASTER 0        /* task ID of master task */
-
-int main(int argc,char *argv[])
-{
-       double  homepi,         /* value of pi calculated by current task */
-               pi,             /* average of pi after "darts" is thrown */
-               avepi,          /* average pi value for all iterations */
-               pirecv,         /* pi received from worker */
-               pisum;          /* sum of workers pi values */
-       int     taskid,         /* task ID - also used as seed number */
-               numtasks,       /* number of tasks */
-               source,         /* source of incoming message */ 
-               mtype,          /* message type */
-               rc,             /* return code */
-               i, n;
-       MPI_Status status;
-
-       /* Obtain number of tasks and task ID */
-       rc = MPI_Init(&argc,&argv);
-       rc = MPI_Comm_size(MPI_COMM_WORLD,&numtasks);
-       rc = MPI_Comm_rank(MPI_COMM_WORLD,&taskid);
-       printf("numtasks : %d\n",numtasks);
-       printf("taskid : %d\n",taskid);
-       /* Set seed for random number generator equal to task ID */
-       srandom (taskid);
-
-       avepi = 0;
-       for (i = 0; i < ROUNDS; i++)
-               {
-                       /* All tasks calculate pi using dartboard algorithm */
-                       homepi = dboard(DARTS);
-
-                       /* Workers send homepi to master */
-                       /* - Message type will be set to the iteration count */
-                       if (taskid != MASTER)
-                               {
-                                       printf("On the Slave, taskid : %d\n",taskid);
-                                       mtype = i;
-                                       rc = MPI_Send(&homepi, 1, MPI_DOUBLE,
-                                                                 MASTER, mtype, MPI_COMM_WORLD);
-                                       if (rc != MPI_SUCCESS)
-                                               printf("%d: Send failure on round %d\n", taskid, mtype);
-                               } else
-                                       {
-                                       printf("On the Master, taskid : %d\n",taskid);
-
-                                               /* Master receives messages from all workers */
-                                               /* - Message type will be set to the iteration count */
-                                               /* - Message source will be set to the wildcard DONTCARE: */
-                                               /*   a message can be received from any task, as long as the */
-                                               /*   message types match */
-                                               /* - The return code will be checked, and a message displayed */
-                                               /*   if a problem occurred */
-                                               mtype = i;
-                                               pisum = 0;
-                                               for (n = 1; n < numtasks; n++)
-                                                       {
-                                                               rc = MPI_Recv(&pirecv, 1, MPI_DOUBLE, MPI_ANY_SOURCE,
-                                                                                         mtype, MPI_COMM_WORLD, &status);
-                                                               if (rc != MPI_SUCCESS) 
-                                                                       printf("%d: Receive failure on round %d\n", taskid, mtype);
-                                                               /* keep running total of pi */
-                                                               pisum = pisum + pirecv;
-                                                       }
-                                               /* Master calculates the average value of pi for this iteration */
-                                               pi = (pisum + homepi)/numtasks;
-                                               /* Master calculates the average value of pi over all iterations */
-                                               avepi = ((avepi * i) + pi)/(i + 1); 
-                                               printf("   After %3d throws, average value of pi = %10.8f\n",
-                                                          (DARTS * (i + 1)),avepi);
-                                       }    
-               } 
-
-       MPI_Finalize();
-       return 0;
-}
diff --git a/scilab/modules/mpi/src/c/pre_send_recv_metadata.c b/scilab/modules/mpi/src/c/pre_send_recv_metadata.c
deleted file mode 100644 (file)
index 2f76618..0000000
+++ /dev/null
@@ -1,45 +0,0 @@
-/*
- * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
- * Copyright (C) 2010-2010 - DIGITEO - Sylvestre LEDRU
- *
- * This file must be used under the terms of the CeCILL.
- * This source file is licensed as described in the file COPYING, which
- * you should have received as part of this distribution.  The terms
- * are also available at
- * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
- *
- */
-#include <stdio.h>
-#include <mpi.h>
-#include "MALLOC.h"
-
-int pre_send_metadata(int size, MPI_Datatype dataType, int dest, int tag)
-{
-    /* Find out the buffer size */
-    int mpi_buffsize = (1 * sizeof(int)) + (1 * sizeof(MPI_Datatype));
-    char *mpi_buff = (char *) MALLOC(mpi_buffsize * sizeof(char));
-    int position = 0;
-
-    /* Serialize both size and type to send it the slave */
-    MPI_Pack(&size, 1, MPI_INT, mpi_buff, mpi_buffsize, &position, MPI_COMM_WORLD);
-    MPI_Pack(&dataType, 1, MPI_INT, mpi_buff, mpi_buffsize, &position, MPI_COMM_WORLD);
-    MPI_Send(mpi_buff, position, MPI_PACKED, dest, tag, MPI_COMM_WORLD);
-    /* TODO: check this result */
-    FREE(mpi_buff);
-    return 0;
-}
-
-int pre_recv_metadata(int source, int tag, int *size, MPI_Datatype *dataType)
-{
-    int position = 0;
-    MPI_Status stat;
-    int mpi_buffsize = (1 * sizeof(int)) + (1 * sizeof(MPI_Datatype));
-    char *mpi_buff = (char *) MALLOC(mpi_buffsize * sizeof(char));
-
-    /* DeSerialize both size and type from the master */
-    MPI_Recv(mpi_buff, mpi_buffsize, MPI_PACKED, source, tag, MPI_COMM_WORLD, &stat);
-    /* TODO: check stat */
-    MPI_Unpack(mpi_buff, mpi_buffsize, &position, &size, 1, MPI_INT, MPI_COMM_WORLD);
-    MPI_Unpack(mpi_buff, mpi_buffsize, &position, &dataType, 1, MPI_INT, MPI_COMM_WORLD);
-    return 0;
-}
diff --git a/scilab/modules/mpi/src/fortran/intmpi.f b/scilab/modules/mpi/src/fortran/intmpi.f
deleted file mode 100644 (file)
index 3d9ba84..0000000
+++ /dev/null
@@ -1,46 +0,0 @@
-c     $Log: INTMPI.f,v $
-c     Revision 1.4  1999/09/14 12:41:13  fleury
-c     Mise a jour pour la version de scilabp
-c      - macro de blacs_init: permet de demarrer une grille blacs a partir
-c     de la console scilex
-c      - script de demarage de scilabp: initialise les blacs et se met en
-c     mode recv/exec
-c
-c     Modif ds pvm
-c      - pvm_start prend en argument un fichier de config pvm
-c
-c     Modif des conversion de complexe
-c
-c     Modif des blacs
-c      - suppression des _ ds le nom des funct car ca fout la merde sous gcc
-c
-c     Modif ds l interface MPI
-c      - TODO: a reprendre pour le nom des function et pour le lancement des
-c     prg
-c
-
-c  interface function 
-c   ********************
-       subroutine intmpi
-       include 'stack.h'
-       rhs = max(0,rhs)
-c
-       goto (1,2,3,4,5,6,7,8) fin
-       return
-1      call intsmpi_send('mpi_send')
-       return
-2      call intsmpi_recv('mpi_recv')
-       return
-3      call intsmpi_isend('mpi_isend')
-       return
-4      call intsmpi_irecv('mpi_irecv')
-       return
-5      call intsmpi_init('mpi_init')
-       return
-6      call intsmpi_finalize('mpi_finalize')
-       return
-7      call intsmpi_comm_rank('mpi_comm_rank')
-       return
-8      call intsmpi_comm_size('mpi_comm_size')
-       return
-       end
diff --git a/scilab/modules/mpi/src/fortran/intsmpi_comm_rank.f b/scilab/modules/mpi/src/fortran/intsmpi_comm_rank.f
deleted file mode 100644 (file)
index a4e9851..0000000
+++ /dev/null
@@ -1,66 +0,0 @@
-c SCILAB function : mpi_comm_rank, fin = 7
-       subroutine intsmpi_comm_rank(fname)
-c
-       character*(*) fname
-       include 'stack.h'
-c
-       integer iadr, sadr
-       integer topk,rhsk,topl
-       logical checkrhs,checklhs,cremat,getscalar
-       iadr(l)=l+l-1
-       sadr(l)=(l/2)+1
-       rhs = max(0,rhs)
-c
-       topk = top 
-       rhsk = rhs 
-       if(.not.checkrhs(fname,0,1)) return
-       if(.not.checklhs(fname,1,2)) return
-c       checking variable comm (number 1)
-c       
-       if(rhs .le. 0) then
-        top = top+1
-        rhs = rhs+1
-        if(.not.cremat(fname,top,0,1,1,lr1,lc1)) return
-        stk(lr1)= 0
-       endif
-       if(.not.getscalar(fname,top,top-rhs+1,lr1)) return
-c     
-c       cross variable size checking
-c     
-       call entier(1,stk(lr1),istk(iadr(lr1)))
-       if(.not.cremat(fname,top+1,0,1,1,lw2,loc2)) return
-       if(.not.cremat(fname,top+2,0,1,1,lw3,loc3)) return
-       call MPI_COMM_RANK(istk(iadr(lr1)),stk(lw2),stk(lw3))
-       if(err .gt. 0) then 
-        buf = fname // ' Internal Error' 
-        call error(999)
-        return
-       endif
-c
-       topk=top-rhs
-       topl=top+2
-c     
-       if(lhs .ge. 1) then
-c       --------------output variable: myid
-        top=topl+1
-        if(.not.cremat(fname,top,0,1,1,lrs,lcs)) return
-        call int2db(1*1,istk(iadr(lw2)),-1,stk(lrs),-1)
-       endif
-c     
-       if(lhs .ge. 2) then
-c       --------------output variable: res
-        top=topl+2
-        if(.not.cremat(fname,top,0,1,1,lrs,lcs)) return
-        call int2db(1*1,istk(iadr(lw3)),-1,stk(lrs),-1)
-       endif
-c     Putting in order the stack
-       if(lhs .ge. 1) then
-        call copyobj(fname,topl+1,topk+1)
-       endif
-       if(lhs .ge. 2) then
-        call copyobj(fname,topl+2,topk+2)
-       endif
-       top=topk+lhs
-       return
-       end
-c
diff --git a/scilab/modules/mpi/src/fortran/intsmpi_comm_size.f b/scilab/modules/mpi/src/fortran/intsmpi_comm_size.f
deleted file mode 100644 (file)
index 4a8756b..0000000
+++ /dev/null
@@ -1,66 +0,0 @@
-c SCILAB function : mpi_comm_size, fin = 8
-       subroutine intsmpi_comm_size(fname)
-c
-       character*(*) fname
-       include 'stack.h'
-c
-       integer iadr, sadr
-       integer topk,rhsk,topl
-       logical checkrhs,checklhs,cremat,getscalar
-       iadr(l)=l+l-1
-       sadr(l)=(l/2)+1
-       rhs = max(0,rhs)
-c
-       topk = top 
-       rhsk = rhs 
-       if(.not.checkrhs(fname,0,1)) return
-       if(.not.checklhs(fname,1,2)) return
-c       checking variable comm (number 1)
-c       
-       if(rhs .le. 0) then
-        top = top+1
-        rhs = rhs+1
-        if(.not.cremat(fname,top,0,1,1,lr1,lc1)) return
-        stk(lr1)= 0
-       endif
-       if(.not.getscalar(fname,top,top-rhs+1,lr1)) return
-c     
-c       cross variable size checking
-c     
-       call entier(1,stk(lr1),istk(iadr(lr1)))
-       if(.not.cremat(fname,top+1,0,1,1,lw2,loc2)) return
-       if(.not.cremat(fname,top+2,0,1,1,lw3,loc3)) return
-       call MPI_COMM_SIZE(istk(iadr(lr1)),stk(lw2),stk(lw3))
-       if(err .gt. 0) then 
-        buf = fname // ' Internal Error' 
-        call error(999)
-        return
-       endif
-c
-       topk=top-rhs
-       topl=top+2
-c     
-       if(lhs .ge. 1) then
-c       --------------output variable: numprocs
-        top=topl+1
-        if(.not.cremat(fname,top,0,1,1,lrs,lcs)) return
-        call int2db(1*1,istk(iadr(lw2)),-1,stk(lrs),-1)
-       endif
-c     
-       if(lhs .ge. 2) then
-c       --------------output variable: res
-        top=topl+2
-        if(.not.cremat(fname,top,0,1,1,lrs,lcs)) return
-        call int2db(1*1,istk(iadr(lw3)),-1,stk(lrs),-1)
-       endif
-c     Putting in order the stack
-       if(lhs .ge. 1) then
-        call copyobj(fname,topl+1,topk+1)
-       endif
-       if(lhs .ge. 2) then
-        call copyobj(fname,topl+2,topk+2)
-       endif
-       top=topk+lhs
-       return
-       end
-c
diff --git a/scilab/modules/mpi/src/fortran/intsmpi_finalize.f b/scilab/modules/mpi/src/fortran/intsmpi_finalize.f
deleted file mode 100644 (file)
index 2157e7f..0000000
+++ /dev/null
@@ -1,45 +0,0 @@
-c SCILAB function : mpi_finalize, fin = 6
-       subroutine intsmpi_finalize(fname)
-c
-       character*(*) fname
-       include 'stack.h'
-c
-       integer iadr, sadr
-       integer topk,rhsk,topl
-       logical checkrhs,checklhs,cremat
-       iadr(l)=l+l-1
-       sadr(l)=(l/2)+1
-       rhs = max(0,rhs)
-c
-       topk = top 
-       rhsk = rhs 
-       if(.not.checkrhs(fname,0,0)) return
-       if(.not.checklhs(fname,1,1)) return
-c     
-c       cross variable size checking
-c     
-       if(.not.cremat(fname,top+1,0,1,1,lw1,loc1)) return
-       call MPI_FINALIZE(stk(lw1))
-       if(err .gt. 0) then 
-        buf = fname // ' Internal Error' 
-        call error(999)
-        return
-       endif
-c
-       topk=top-rhs
-       topl=top+1
-c     
-       if(lhs .ge. 1) then
-c       --------------output variable: res
-        top=topl+1
-        if(.not.cremat(fname,top,0,1,1,lrs,lcs)) return
-        call int2db(1*1,istk(iadr(lw1)),-1,stk(lrs),-1)
-       endif
-c     Putting in order the stack
-       if(lhs .ge. 1) then
-        call copyobj(fname,topl+1,topk+1)
-       endif
-       top=topk+lhs
-       return
-       end
-c
diff --git a/scilab/modules/mpi/src/fortran/intsmpi_init.f b/scilab/modules/mpi/src/fortran/intsmpi_init.f
deleted file mode 100644 (file)
index 73b82c8..0000000
+++ /dev/null
@@ -1,46 +0,0 @@
-
-c SCILAB function : mpi_init, fin = 5
-       subroutine intsmpi_init(fname)
-c
-       character*(*) fname
-       include 'stack.h'
-c
-       integer iadr, sadr
-       integer topk,rhsk,topl
-       logical checkrhs,checklhs,cremat
-       iadr(l)=l+l-1
-       sadr(l)=(l/2)+1
-       rhs = max(0,rhs)
-c
-       topk = top 
-       rhsk = rhs 
-       if(.not.checkrhs(fname,0,0)) return
-       if(.not.checklhs(fname,1,1)) return
-c     
-c       cross variable size checking
-c     
-       if(.not.cremat(fname,top+1,0,1,1,lw1,loc1)) return
-       call MPI_INIT(stk(lw1))
-       if(err .gt. 0) then 
-        buf = fname // ' Internal Error' 
-        call error(999)
-        return
-       endif
-c
-       topk=top-rhs
-       topl=top+1
-c     
-       if(lhs .ge. 1) then
-c       --------------output variable: res
-        top=topl+1
-        if(.not.cremat(fname,top,0,1,1,lrs,lcs)) return
-        call int2db(1*1,istk(iadr(lw1)),-1,stk(lrs),-1)
-       endif
-c     Putting in order the stack
-       if(lhs .ge. 1) then
-        call copyobj(fname,topl+1,topk+1)
-       endif
-       top=topk+lhs
-       return
-       end
-c
diff --git a/scilab/modules/mpi/src/fortran/intsmpi_irecv.f b/scilab/modules/mpi/src/fortran/intsmpi_irecv.f
deleted file mode 100644 (file)
index 8fdcaa3..0000000
+++ /dev/null
@@ -1,74 +0,0 @@
-c SCILAB function : mpi_irecv, fin = 4
-       subroutine intsmpi_irecv(fname)
-c
-       character*(*) fname
-       include 'stack.h'
-c
-       integer iadr, sadr
-       integer topk,rhsk,topl
-       logical checkrhs,checklhs,getscalar,cremat
-       iadr(l)=l+l-1
-       sadr(l)=(l/2)+1
-       rhs = max(0,rhs)
-c
-       topk = top 
-       rhsk = rhs 
-       if(.not.checkrhs(fname,2,3)) return
-       if(.not.checklhs(fname,1,2)) return
-c       checking variable source (number 1)
-c       
-       if(.not.getscalar(fname,top,top-rhs+1,lr1)) return
-c       checking variable tag (number 2)
-c       
-       if(.not.getscalar(fname,top,top-rhs+2,lr2)) return
-c       checking variable comm (number 3)
-c       
-       if(rhs .le. 2) then
-        top = top+1
-        rhs = rhs+1
-        if(.not.cremat(fname,top,0,1,1,lr3,lc3)) return
-        stk(lr3)= MPI_COMM_WORLD
-       endif
-       if(.not.getscalar(fname,top,top-rhs+3,lr3)) return
-c     
-c       cross variable size checking
-c     
-       call entier(1,stk(lr1),istk(iadr(lr1)))
-       call entier(1,stk(lr2),istk(iadr(lr2)))
-       call entier(1,stk(lr3),istk(iadr(lr3)))
-       if(.not.cremat(fname,top+1,0,1,1,lw4,loc4)) return
-       if(.not.cremat(fname,top+2,0,1,1,lw5,loc5)) return
-       call scimpiirecv(istk(iadr(lr1)),istk(iadr(lr2)),istk(iadr(lr3)),
-     $ stk(lw4),stk(lw5))
-       if(err .gt. 0) then 
-        buf = fname // ' Internal Error' 
-        call error(999)
-        return
-       endif
-c
-       topk=top-rhs
-       topl=top+2
-c     
-       if(lhs .ge. 1) then
-c       --------------output variable: request
-        top=topl+1
-        if(.not.cremat(fname,top,0,1,1,lrs,lcs)) return
-        call int2db(1*1,istk(iadr(lw4)),-1,stk(lrs),-1)
-       endif
-c     
-       if(lhs .ge. 2) then
-c       --------------output variable: res
-        top=topl+2
-        if(.not.cremat(fname,top,0,1,1,lrs,lcs)) return
-        call int2db(1*1,istk(iadr(lw5)),-1,stk(lrs),-1)
-       endif
-c     Putting in order the stack
-       if(lhs .ge. 1) then
-        call copyobj(fname,topl+1,topk+1)
-       endif
-       if(lhs .ge. 2) then
-        call copyobj(fname,topl+2,topk+2)
-       endif
-       top=topk+lhs
-       return
-       end
diff --git a/scilab/modules/mpi/src/fortran/intsmpi_isend.f b/scilab/modules/mpi/src/fortran/intsmpi_isend.f
deleted file mode 100644 (file)
index e053634..0000000
+++ /dev/null
@@ -1,110 +0,0 @@
-c SCILAB function : mpi_isend, fin = 3
-       subroutine intsmpi_isend(fname)
-c
-       character*(*) fname
-       include 'stack.h'
-c
-       integer iadr, sadr
-       integer topk,rhsk,topl
-       integer address, n
-       logical checkrhs,checklhs,getscalar,cremat
-       iadr(l)=l+l-1
-       sadr(l)=(l/2)+1
-       rhs = max(0,rhs)
-c
-       topk = top 
-       rhsk = rhs 
-       if(.not.checkrhs(fname,3,4)) return
-       if(.not.checklhs(fname,1,2)) return
-c       checking variable dest (number 2)
-c       
-       if(.not.getscalar(fname,top,top-rhs+2,lr2)) return
-c       checking variable tag (number 3)
-c       
-       if(.not.getscalar(fname,top,top-rhs+3,lr3)) return
-c       checking variable comm (number 4)
-c       
-       if(rhs .le. 3) then
-        top = top+1
-        rhs = rhs+1
-        if(.not.cremat(fname,top,0,1,1,lr4,lc4)) return
-        stk(lr4)= MPI_COMM_WORLD
-       endif
-       if(.not.getscalar(fname,top,top-rhs+4,lr4)) return
-c     construct the pack vector for the variable number 1
-c     set adress where to put the pack vector and its max
-c     allowable size
-       beginvar=lstk(top)
-       maxsize=lstk(bot) - beginvar
-       address = top-rhs+1
-c       write(*,*) 'call varpack'
-       call varpak(address,stk(beginvar),n,maxsize,ierr)
-c       write(*,*) 'callback varpack'
-       if(ierr .gt. 0) then 
-          buf = fname // ' Unknow type or not yet implemented' 
-          call error(999)
-          return
-       endif
-c
-c     Check if maxsize has been enough
-       if(n.gt.maxsize) then
-          err=n-maxsize
-          call error(17)
-          return
-       endif 
-c
-c     set correct size for the pack vect
-       lstk(top+1)=lstk(top)+n
-
-
-c     
-c       cross variable size checking
-c     
-       call entier(1,stk(lr2),istk(iadr(lr2)))
-       call entier(1,stk(lr3),istk(iadr(lr3)))
-c     WARNING: si on met la ligne en dessous, ce ECRASE la 5ieme case
-c       tableau varpack. 
-c     The question is WHY?????
-c       call entier(1,stk(lr4),istk(iadr(lr4)))
-       if(.not.cremat(fname,top+1,0,1,1,lw7,loc7)) return
-       if(.not.cremat(fname,top+2,0,1,1,lw8,loc8)) return
-       call scimpiisend(stk(beginvar),n,
-     $      stk(lstk(address)),
-     $      istk(iadr(lr2)),
-     $      istk(iadr(lr3)),
-     $      istk(iadr(lr4)),
-     $      stk(lw7),
-     $      stk(lw8))
-       if(err .gt. 0) then 
-        buf = fname // ' Internal Error' 
-        call error(999)
-        return
-       endif
-c
-       topk=top-rhs
-       topl=top+2
-c     
-       if(lhs .ge. 1) then
-c       --------------output variable: request
-        top=topl+1
-        if(.not.cremat(fname,top,0,1,1,lrs,lcs)) return
-        call int2db(1*1,istk(iadr(lw7)),-1,stk(lrs),-1)
-       endif
-c     
-       if(lhs .ge. 2) then
-c       --------------output variable: res
-        top=topl+2
-        if(.not.cremat(fname,top,0,1,1,lrs,lcs)) return
-        call int2db(1*1,istk(iadr(lw8)),-1,stk(lrs),-1)
-       endif
-c     Putting in order the stack
-       if(lhs .ge. 1) then
-        call copyobj(fname,topl+1,topk+1)
-       endif
-       if(lhs .ge. 2) then
-        call copyobj(fname,topl+2,topk+2)
-       endif
-       top=topk+lhs
-       return
-       end
-c
diff --git a/scilab/modules/mpi/src/fortran/intsmpi_recv.f b/scilab/modules/mpi/src/fortran/intsmpi_recv.f
deleted file mode 100644 (file)
index 075f7df..0000000
+++ /dev/null
@@ -1,88 +0,0 @@
-c SCILAB function : mpi_recv, fin = 2
-       subroutine intsmpi_recv(fname)
-c
-       character*(*) fname
-       include 'stack.h'
-c      
-       integer iadr, sadr
-       integer beginvar, maxsize, n
-       integer source, tag, comm, status(2), result
-       integer topk,rhsk
-       logical checkrhs,checklhs,getscalar,cremat
-c     
-       iadr(l)=l+l-1
-       sadr(l)=(l/2)+1
-       rhs = max(0,rhs)
-c
-       topk = top 
-       rhsk = rhs 
-       if(.not.checkrhs(fname,2,3)) return
-       if(.not.checklhs(fname,1,3)) return
-c     checking variable source (number 1)
-c       
-       if(.not.getscalar(fname,top,top-rhs+1,lr1)) return
-       source = stk(lr1)       
-c     checking variable tag (number 2)
-c       
-       if(.not.getscalar(fname,top,top-rhs+2,lr2)) return
-       tag = stk(lr2)
-c     checking variable comm (number 3)
-c       
-       if(rhs .le. 2) then
-        top = top+1
-        rhs = rhs+1
-        if(.not.cremat(fname,top,0,1,1,lr3,lc3)) return
-        stk(lr3)= MPI_COMM_WORLD
-       endif
-       if(.not.getscalar(fname,top,top-rhs+3,lr3)) return
-       comm = stk(lr3)
-c
-c     free input variable at the top of the stack
-       top=top-rhs+1
-c
-c     set adress where to put the received variable and its max
-c     allowable size
-       beginvar=lstk(top)
-       maxsize=lstk(bot)-beginvar
-c
-c     receive the variable
-       call scimpirecv(stk(beginvar), maxsize, n,
-     $      source, tag, comm, status, result)
-c     ATTENTION scimpirecv ne doit pas ecrire plus de maxsize double
-c     dans stk(beginvar)
-       if(err .gt. 0) then 
-          buf = fname // ' Internal Error' 
-          call error(999)
-          return
-       endif
-c
-c     Check if maxsize has been enough
-       if(n.gt.maxsize) then
-          err=n-maxsize
-          call error(17)
-          return
-       endif 
-c
-c     set correct size for the received variable
-       lstk(top+1)=lstk(top)+n
-c     MA MODIF: j'incremente top ici et non pas apres la creation de
-c     la variable de retour...
-       top=top+1
-c
-c     
-c     create variable status at the top of the returned variables
-      if(.not.cremat(fname,top,0,1,7,lrs,lcs)) return
-c     set value of the status variable
-      call int2db(2,status,-1,stk(lrs),-1)
-      top=top+1
-c     create variable status at the top of the returned variables
-      if(.not.cremat(fname,top,0,1,1,lrs,lcs)) return
-c     set value of the status variable
-      stk(lrs)=result
-c     clear res & status variable if lhs result 1
-      if(lhs.eq.1) top=top-2
-c     clear res variable if lhs result 2
-      if(lhs.eq.2) top=top-1
-      return
-      end
-c
diff --git a/scilab/modules/mpi/src/fortran/intsmpi_send.f b/scilab/modules/mpi/src/fortran/intsmpi_send.f
deleted file mode 100644 (file)
index 92e4adb..0000000
+++ /dev/null
@@ -1,101 +0,0 @@
-c SCILAB function : mpi_send, fin = 1
-       subroutine intsmpi_send(fname)
-c
-       character*(*) fname
-       include 'stack.h'
-c
-       integer iadr, sadr
-       integer topk,rhsk,topl
-       integer address,n,beginvar
-       logical checkrhs,checklhs,getscalar,cremat
-       iadr(l)=l+l-1
-       sadr(l)=(l/2)+1
-       rhs = max(0,rhs)
-c
-       topk = top 
-       rhsk = rhs 
-       if(.not.checkrhs(fname,3,4)) return
-       if(.not.checklhs(fname,1,1)) return
-c       checking variable buff (number 1)
-c       
-c       if(.not.getmat(fname,top,top-rhs+1,it1,m1,n1,lr1,lc1)) return
-c       checking variable dest (number 2)
-c       
-       if(.not.getscalar(fname,top,top-rhs+2,lr2)) return
-c       checking variable tag (number 3)
-c       
-       if(.not.getscalar(fname,top,top-rhs+3,lr3)) return
-c       checking variable comm (number 4)
-c       
-       if(rhs .le. 3) then
-        top = top+1
-        rhs = rhs+1
-        if(.not.cremat(fname,top,0,1,1,lr4,lc4)) return
-        stk(lr4)= MPI_COMM_WORLD
-       endif
-       if(.not.getscalar(fname,top,top-rhs+4,lr4)) return
-
-c     construct the pack vector for the variable number 1
-c     set adress where to put the pack vector and its max
-c     allowable size
-       beginvar=lstk(top)
-       maxsize=lstk(bot) - beginvar
-       address = top-rhs+1
-c       write(*,*) 'call varpack'
-       call varpak(address,stk(beginvar),n,maxsize,ierr)
-c       write(*,*) 'callback varpack'
-       if(ierr .gt. 0) then 
-          buf = fname // ' Unknow type or not yet implemented' 
-          call error(999)
-          return
-       endif
-c
-c     Check if maxsize has been enough
-      if(n.gt.maxsize) then
-         err=n-maxsize
-         call error(17)
-         return
-      endif 
-c
-c     set correct size for the pack vect
-      lstk(top+1)=lstk(top)+n
-
-
-c     
-c       cross variable size checking
-c     
-c       call entier(1,stk(lr2),istk(iadr(lr2)))
-c       call entier(1,stk(lr3),istk(iadr(lr3)))
-c     WARNING: si on met la ligne en dessous, ce ECRASE la 5ieme case
-c       tableau varpack. 
-c     The question is WHY?????
-c       call entier(1,stk(lr4),istk(iadr(lr4)))
-       if(.not.cremat(fname,top+1,0,1,1,lw7,loc7)) return
-       call scimpisend(stk(beginvar),n,
-     $      stk(lstk(address)),
-     $      istk(iadr(lr2)),
-     $      istk(iadr(lr3)),
-     $      istk(iadr(lr4)),
-     $      stk(lw7))
-       if(err .gt. 0) then 
-        buf = fname // ' Internal Error' 
-        call error(999)
-        return
-       endif
-c
-       topk=top-rhs
-       topl=top+1
-c     
-       if(lhs .ge. 1) then
-c       --------------output variable: res
-        top=topl+1
-        if(.not.cremat(fname,top,0,1,1,lrs,lcs)) return
-        call int2db(1*1,istk(iadr(lw7)),-1,stk(lrs),-1)
-       endif
-c     Putting in order the stack
-       if(lhs .ge. 1) then
-        call copyobj(fname,topl+1,topk+1)
-       endif
-       top=topk+lhs
-       return
-       end
diff --git a/scilab/modules/mpi/src/fortran/mpi_init.f b/scilab/modules/mpi/src/fortran/mpi_init.f
deleted file mode 100644 (file)
index 32366a6..0000000
+++ /dev/null
@@ -1,16 +0,0 @@
-      subroutine scimpiinit(ierr)
-      include "mpif.h"
-      call MPI_INIT(ierr)
-      end
-
-
-      subroutine scimpicommrank(comm, myid, ierr)
-      include "mpif.h"
-      call MPI_COMM_RANK(comm, myid, ierr)
-      end
-
-
-      subroutine scimpicommsize(comm, numprocs, ierr)
-      include "mpif.h"
-      call MPI_COMM_SIZE(comm, numprocs, ierr)
-      end