wrfv2_fire/external/RSL/RSL/rsl_mpi_compat.c

   1 /***********************************************************************
   2
   3                               COPYRIGHT
   4
   5      The following is a notice of limited availability of the code and
   6      Government license and disclaimer which must be included in the
   7      prologue of the code and in all source listings of the code.
   8
   9      Copyright notice
  10        (c) 1977  University of Chicago
  11
  12      Permission is hereby granted to use, reproduce, prepare
  13      derivative works, and to redistribute to others at no charge.  If
  14      you distribute a copy or copies of the Software, or you modify a
  15      copy or copies of the Software or any portion of it, thus forming
  16      a work based on the Software and make and/or distribute copies of
  17      such work, you must meet the following conditions:
  18
  19           a) If you make a copy of the Software (modified or verbatim)
  20              it must include the copyright notice and Government
  21              license and disclaimer.
  22
  23           b) You must cause the modified Software to carry prominent
  24              notices stating that you changed specified portions of
  25              the Software.
  26
  27      This software was authored by:
  28
  29      Argonne National Laboratory
  30      J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
  31      Mathematics and Computer Science Division
  32      Argonne National Laboratory, Argonne, IL  60439
  33
  34      ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES
  35      OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT,
  36      AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A
  37      CONTRACT WITH THE DEPARTMENT OF ENERGY.
  38
  39                       GOVERNMENT LICENSE AND DISCLAIMER
  40
  41      This computer code material was prepared, in part, as an account
  42      of work sponsored by an agency of the United States Government.
  43      The Government is granted for itself and others acting on its
  44      behalf a paid-up, nonexclusive, irrevocable worldwide license in
  45      this data to reproduce, prepare derivative works, distribute
  46      copies to the public, perform publicly and display publicly, and
  47      to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT
  48      NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF
  49      THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR
  50      ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY,
  51      COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS,
  52      PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD
  53      NOT INFRINGE PRIVATELY OWNED RIGHTS.
  54
  55 ***************************************************************************/
  56
  57 #ifdef MPI
  58 #ifndef __MPI_COMPAT__
  59 #define __MPI_COMPAT__
  60
  61 #include <stdio.h>
  62 #include <stdlib.h>
  63 #include "mpi.h"
  64 #include "rsl.h"
  65
  66 #define RSLHandleInc 32
  67
  68
  69 struct tagsToHandles
  70        {
  71        int tag;
  72        MPI_Request Handle;
  73        };
  74 struct rslMPIHandles
  75        {
  76        int nHandles;
  77        int nUsed;
  78        struct tagsToHandles *tags;
  79        } rslMPIHandleLUT;
  80
  81 /******************************************************
  82  * rslMPIInit ()
  83  *   do whatever initialization is necessary for the
  84  *   MPI port
  85  *
  86  *  Initial coding: Leslie Hart, 22 Apr 94
  87  *  Adapted to MPI: J. Michalakes 7/13/94
  88  *
  89  *****************************************************/
  90
  91 static int dummy = 0 ;
  92
  93 #ifdef linux
  94 int xargc ;
  95 #endif
  96
  97 void rslMPIInit()
  98   {
  99   int flag ;
 100   rslMPIHandleLUT.nHandles = RSLHandleInc;
 101   rslMPIHandleLUT.nUsed = 0;
 102   rslMPIHandleLUT.tags = (struct tagsToHandles *)
 103                      malloc (sizeof (struct tagsToHandles) * RSLHandleInc);
 104
 105   MPI_Initialized( &flag ) ;
 106
 107   if ( ! flag ) {
 108
 109 #ifndef linux
 110   MPI_INIT_F ( &dummy ) ;  /* call to fortran wrapper */
 111 #else
 112   xargc = iargc_()+1;
 113 #  ifdef F2CSTYLE
 114   mpi_init__( &dummy ) ;
 115 #  else
 116   mpi_init_( &dummy ) ;
 117 #  endif
 118 #endif
 119
 120   }
 121
 122 #ifdef FATAL_ERRORS
 123   if (rslMPIHandleLUT.tags == NULL)
 124     {
 125     fprintf (stderr, "Fatal Error: malloc failure in rslMPIInit\n");
 126     exit(1);
 127     }
 128 #endif
 129   }
 130
 131
 132 /******************************************************
 133  * rslMPIWho ( numproc, myproc )
 134  *  Use the LUT to find an MPI wait handle from a tag
 135  *
 136  *  Initial coding: J. Michalakes  7/13/94
 137  *
 138  *****************************************************/
 139
 140 long rslMPIWho( numproc, myproc )
 141   int * numproc, * myproc ;
 142 {
 143   MPI_Comm_rank( rsl_mpi_communicator, myproc ) ;
 144   MPI_Comm_size( rsl_mpi_communicator, numproc ) ;
 145   return( 0L ) ;
 146 }
 147
 148 /******************************************************
 149  * rslMPIFindWaitH (tag)
 150  *  Use the LUT to find an MPI wait handle from a tag
 151  *
 152  *  Initial coding: Leslie Hart, 22 Apr 94
 153  *
 154  *****************************************************/
 155
 156 long rslMPIFindWaitH (tag, waitHandle)
 157   int tag;   /* Tag for which we lookup a wait handle */
 158   MPI_Request *waitHandle ;
 159   {
 160   int i;
 161   long retVal = -1;
 162
 163   for (i=0; i < rslMPIHandleLUT.nUsed; i++)
 164     {
 165     if (rslMPIHandleLUT.tags[i].tag == tag)
 166       {
 167       *waitHandle = rslMPIHandleLUT.tags[i].Handle;
 168       rslMPIHandleLUT.nUsed--;  /* Keep them contiguous */
 169       rslMPIHandleLUT.tags[i].tag=rslMPIHandleLUT.tags[rslMPIHandleLUT.nUsed].tag;
 170       rslMPIHandleLUT.tags[i].Handle=
 171                   rslMPIHandleLUT.tags[rslMPIHandleLUT.nUsed].Handle;
 172       break;
 173       }
 174     }
 175     return(0L) ;
 176   }
 177
 178 /******************************************************
 179  * rslMPISaveWaitH (tag, waitHandle)
 180  *  Use the LUT to save an MPI wait handle referenced by a tag
 181  *
 182  *  Initial coding: Leslie Hart, 22 Apr 94
 183  *
 184  *****************************************************/
 185
 186 void rslMPISaveWaitH (tag, waitHandle)
 187  int tag;
 188  MPI_Request * waitHandle;
 189  {
 190  /* Make sure there is enough space, if not, try a realloc */
 191  /* If the realloc fails we're in deep trouble */
 192  if (rslMPIHandleLUT.nUsed == rslMPIHandleLUT.nHandles)
 193    {
 194    struct tagsToHandles *tags;  /* Temp pointer */
 195    tags = (struct tagsToHandles *)
 196       realloc (rslMPIHandleLUT.tags,
 197       sizeof (struct tagsToHandles) * (rslMPIHandleLUT.nHandles + RSLHandleInc));
 198    if (tags != NULL)
 199      {
 200      rslMPIHandleLUT.tags = tags;
 201      rslMPIHandleLUT.nHandles += RSLHandleInc;
 202      }
 203    else
 204      {
 205 #ifdef FATAL_ERRORS
 206      fprintf (stderr, "Fatal Error: realloc failure in rslMPISaveWaitH\n");
 207      exit(1);
 208 #endif
 209      return;
 210      }
 211    }
 212  /* Stash the handle */
 213  rslMPIHandleLUT.tags[rslMPIHandleLUT.nUsed].tag = tag;
 214  rslMPIHandleLUT.tags[rslMPIHandleLUT.nUsed].Handle = *waitHandle;
 215  rslMPIHandleLUT.nUsed++;
 216  }
 217
 218 /******************************************************
 219  * rslMPIISend (buff, mlen, tag, dest)
 220  *  Post a non blocking send an stash a wait handle
 221  *
 222  *  Initial coding: Leslie Hart, 22 Apr 94
 223  *
 224  *****************************************************/
 225
 226 void rslMPIISend (buff, mlen, tag, dest)
 227  char *buff;
 228  int mlen;
 229  int tag;
 230  int dest;
 231  {
 232    MPI_Request waitHandle;
 233
 234    MPI_Isend (buff,
 235               mlen,
 236               MPI_BYTE,
 237               dest,
 238               tag,
 239               rsl_mpi_communicator,
 240               &waitHandle);
 241
 242    rslMPISaveWaitH (tag, &waitHandle);
 243  }
 244
 245 /******************************************************
 246  * rslMPIIRecv (buff, mlen, tag)
 247  *  Post a non blocking receive an stash a wait handle
 248  *
 249  *  Initial coding: Leslie Hart, 22 Apr 94
 250  *
 251  *****************************************************/
 252
 253 void rslMPIIRecv (buff, mlen, tag)
 254  char *buff;
 255  int mlen;
 256  int tag;
 257  {
 258    MPI_Request waitHandle;
 259
 260    MPI_Irecv (buff,
 261               mlen,
 262               MPI_BYTE,
 263               MPI_ANY_SOURCE,
 264               tag,
 265               rsl_mpi_communicator,
 266               &waitHandle);
 267
 268    rslMPISaveWaitH (tag, &waitHandle);
 269  }
 270
 271 /******************************************************
 272  * rslMPIWait (tag)
 273  *  Wait for a pending send/recv
 274  *
 275  *  Initial coding: Leslie Hart, 22 Apr 94
 276  *
 277  *****************************************************/
 278
 279 void rslMPIWait (tag)
 280  int tag;
 281  {
 282  MPI_Request waitHandle;
 283  MPI_Status status ;
 284
 285  rslMPIFindWaitH (tag, &waitHandle );
 286  (void) MPI_Wait ( &waitHandle, &status  );
 287  }
 288
 289 #endif /* __MPI_COMPAT__ */
 290 #endif /* MPI */