wrfv2_fire/frame/collect_on_comm.c

   1 #ifndef MS_SUA
   2 # include <stdio.h>
   3 # include <stdlib.h>
   4 #endif
   5 #if defined( DM_PARALLEL ) && ! defined( STUBMPI )
   6 # include <mpi.h>
   7 #endif
   8
   9 #ifndef CRAY
  10 # ifdef NOUNDERSCORE
  11 #      define COLLECT_ON_COMM  collect_on_comm
  12 #      define COLLECT_ON_COMM0 collect_on_comm0
  13 #      define DIST_ON_COMM  dist_on_comm
  14 #      define DIST_ON_COMM0 dist_on_comm0
  15 #      define INT_PACK_DATA  int_pack_data
  16 #      define INT_GET_TI_HEADER_C  int_get_ti_header_c
  17 #      define INT_GEN_TI_HEADER_C  int_gen_ti_header_c
  18 # else
  19 #   ifdef F2CSTYLE
  20 #      define COLLECT_ON_COMM  collect_on_comm__
  21 #      define COLLECT_ON_COMM0 collect_on_comm0__
  22 #      define DIST_ON_COMM  dist_on_comm__
  23 #      define DIST_ON_COMM0 dist_on_comm0__
  24 #      define INT_PACK_DATA  int_pack_data__
  25 #      define INT_GET_TI_HEADER_C  int_get_ti_header_c__
  26 #      define INT_GEN_TI_HEADER_C  int_gen_ti_header_c__
  27 #   else
  28 #      define COLLECT_ON_COMM  collect_on_comm_
  29 #      define COLLECT_ON_COMM0 collect_on_comm0_
  30 #      define DIST_ON_COMM  dist_on_comm_
  31 #      define DIST_ON_COMM0 dist_on_comm0_
  32 #      define INT_PACK_DATA  int_pack_data_
  33 #      define INT_GET_TI_HEADER_C  int_get_ti_header_c_
  34 #      define INT_GEN_TI_HEADER_C  int_gen_ti_header_c_
  35 #   endif
  36 # endif
  37 #endif
  38
  39
  40 int col_on_comm ( int *, int *, void *, int *, void *, int *, int);
  41 int dst_on_comm ( int *, int *, void *, int *, void *, int *, int);
  42
  43 void
  44 COLLECT_ON_COMM ( int * comm, int * typesize ,
  45                   void * inbuf, int *ninbuf , void * outbuf, int * noutbuf )
  46 {
  47   col_on_comm ( comm, typesize ,
  48                 inbuf, ninbuf , outbuf, noutbuf, 1 ) ;
  49 }
  50
  51 /* collect on node 0*/
  52 void
  53 COLLECT_ON_COMM0 ( int * comm, int * typesize ,
  54                  void * inbuf, int *ninbuf , void * outbuf, int * noutbuf )
  55 {
  56   col_on_comm ( comm, typesize ,
  57                 inbuf, ninbuf , outbuf, noutbuf, 0 ) ;
  58 }
  59
  60 int
  61 col_on_comm ( int * Fcomm, int * typesize ,
  62               void * inbuf, int *ninbuf , void * outbuf, int * noutbuf, int sw )
  63 {
  64 #if defined( DM_PARALLEL ) && ! defined(STUBMPI)
  65   int mytask, ntasks, p ;
  66   int *recvcounts ;
  67   int *displace ;
  68   int noutbuf_loc ;
  69   int root_task ;
  70   MPI_Comm *comm, dummy_comm ;
  71   int ierr ;
  72
  73   comm = &dummy_comm ;
  74   *comm = MPI_Comm_f2c( *Fcomm ) ;
  75   MPI_Comm_size ( *comm, &ntasks ) ;
  76   MPI_Comm_rank ( *comm, &mytask ) ;
  77   recvcounts = (int *) malloc( ntasks * sizeof(int)) ;
  78   displace   = (int *) malloc( ntasks * sizeof(int)) ;
  79   root_task = ( sw == 0 ) ? 0 : ntasks-1 ;
  80
  81   /* collect up recvcounts */
  82   ierr = MPI_Gather( ninbuf , 1 , MPI_INT , recvcounts , 1 , MPI_INT , root_task , *comm ) ;
  83 #ifndef MS_SUA
  84   if ( ierr != 0 ) fprintf(stderr,"%s %d MPI_Gather returns %d\n",__FILE__,__LINE__,ierr ) ;
  85 #endif
  86
  87   if ( mytask == root_task ) {
  88
  89     /* figure out displacements */
  90     for ( p = 1 , displace[0] = 0 , noutbuf_loc = recvcounts[0] ; p < ntasks ; p++ ) {
  91       displace[p] = displace[p-1]+recvcounts[p-1] ;
  92       noutbuf_loc = noutbuf_loc + recvcounts[p] ;
  93     }
  94
  95     if ( noutbuf_loc > * noutbuf )
  96     {
  97 #ifndef MS_SUA
  98       fprintf(stderr,"FATAL ERROR: collect_on_comm: noutbuf_loc (%d) > noutbuf (%d)\n",
  99                       noutbuf_loc , * noutbuf ) ;
 100       fprintf(stderr,"WILL NOT perform the collection operation\n") ;
 101 #endif
 102       MPI_Abort(MPI_COMM_WORLD,1) ;
 103     }
 104
 105     /* multiply everything by the size of the type */
 106     for ( p = 0 ; p < ntasks ; p++ ) {
 107       displace[p] *= *typesize ;
 108       recvcounts[p] *= *typesize ;
 109     }
 110   }
 111
 112   ierr = MPI_Gatherv( inbuf  , *ninbuf * *typesize  , MPI_CHAR ,
 113                outbuf , recvcounts , displace, MPI_CHAR ,
 114                root_task , *comm ) ;
 115 #ifndef MS_SUA
 116   if ( ierr != 0 ) fprintf(stderr,"%s %d MPI_Gatherv returns %d\n",__FILE__,__LINE__,ierr ) ;
 117 #endif
 118
 119   free(recvcounts) ;
 120   free(displace) ;
 121 #endif
 122   return(0) ;
 123 }
 124
 125 int
 126 dst_on_comm ( int * Fcomm, int * typesize ,
 127               void * inbuf, int *ninbuf , void * outbuf, int * noutbuf, int sw ) ;
 128
 129 void
 130 DIST_ON_COMM ( int * comm, int * typesize ,
 131                  void * inbuf, int *ninbuf , void * outbuf, int * noutbuf )
 132 {
 133   dst_on_comm ( comm, typesize ,
 134                 inbuf, ninbuf , outbuf, noutbuf, 1 ) ;
 135 }
 136
 137 void
 138 DIST_ON_COMM0 ( int * comm, int * typesize ,
 139                  void * inbuf, int *ninbuf , void * outbuf, int * noutbuf )
 140 {
 141   dst_on_comm ( comm, typesize ,
 142                 inbuf, ninbuf , outbuf, noutbuf, 0 ) ;
 143 }
 144
 145 int
 146 dst_on_comm ( int * Fcomm, int * typesize ,
 147               void * inbuf, int *ninbuf , void * outbuf, int * noutbuf, int sw )
 148 {
 149 #if defined(DM_PARALLEL) && ! defined(STUBMPI)
 150   int mytask, ntasks, p ;
 151   int *sendcounts ;
 152   int *displace ;
 153   int noutbuf_loc ;
 154   int root_task ;
 155   MPI_Comm *comm, dummy_comm ;
 156
 157   comm = &dummy_comm ;
 158   *comm = MPI_Comm_f2c( *Fcomm ) ;
 159   MPI_Comm_size ( *comm, &ntasks ) ;
 160   MPI_Comm_rank ( *comm, &mytask ) ;
 161   sendcounts = (int *) malloc( ntasks * sizeof(int)) ;
 162   displace   = (int *) malloc( ntasks * sizeof(int)) ;
 163   root_task = ( sw == 0 ) ? 0 : ntasks-1 ;
 164
 165   /* collect up sendcounts */
 166   MPI_Gather( noutbuf , 1 , MPI_INT , sendcounts , 1 , MPI_INT , root_task , *comm ) ;
 167
 168   if ( mytask == root_task ) {
 169
 170     /* figure out displacements */
 171     for ( p = 1 , displace[0] = 0 , noutbuf_loc = sendcounts[0] ; p < ntasks ; p++ ) {
 172       displace[p] = displace[p-1]+sendcounts[p-1] ;
 173       noutbuf_loc = noutbuf_loc + sendcounts[p] ;
 174     }
 175
 176     /* multiply everything by the size of the type */
 177     for ( p = 0 ; p < ntasks ; p++ ) {
 178       displace[p] *= *typesize ;
 179       sendcounts[p] *= *typesize ;
 180     }
 181   }
 182
 183   MPI_Scatterv( inbuf   , sendcounts , displace, MPI_CHAR ,
 184                 outbuf  , *noutbuf * *typesize  , MPI_CHAR ,
 185                 root_task , *comm ) ;
 186
 187   free(sendcounts) ;
 188   free(displace) ;
 189 #endif
 190   return(0) ;
 191 }
 192
 193 #ifndef _WIN32
 194 #ifndef MACOS
 195 #  include <malloc.h>
 196 #  include <sys/resource.h>
 197 #endif
 198
 199 #if 0
 200   int getrusage(
 201           int who,
 202           struct rusage *r_usage);
 203 #endif
 204
 205 #if 0
 206 extern int outy ;
 207 extern int maxstug, nouty, maxouty ;
 208 #endif
 209
 210 #if 0
 211 #include <unistd.h>
 212 #include <sys/times.h>
 213 /*  used internally for chasing memory leaks on ibm  */
 214 rlim_ ()
 215 {
 216 #ifndef MACOS
 217
 218    struct rusage r_usage ;
 219    struct mallinfo minf ;
 220    struct tms  tm ;
 221    long tick, tock ;
 222
 223    tick = sysconf( _SC_CLK_TCK ) ;
 224    times( &tm ) ;
 225    tock = (tm.tms_utime + tm.tms_stime)*tick ;
 226
 227    getrusage ( RUSAGE_SELF, &r_usage ) ;
 228    if ( tock != 0 ) {
 229 #ifndef _WIN32
 230      fprintf(stderr,"sm %ld d %ld s %ld maxrss %ld %d %d %ld\n",r_usage.ru_ixrss/tock,r_usage.ru_idrss/tock,r_usage.ru_isrss/tock, r_usage.ru_maxrss,tick,tock,r_usage.ru_ixrss) ;
 231 #endif
 232    }
 233    minf = mallinfo() ;
 234 #ifndef _WIN32
 235    fprintf(stderr,"a %ld usm %ld fsm %ld uord %ld ford %ld hblkhd %d\n",minf.arena,minf.usmblks,minf.fsmblks,minf.uordblks,minf.fordblks,minf.hblkhd) ;
 236 #endif
 237 # if 0
 238    fprintf(stderr," outy %d  nouty %d  maxstug %d maxouty %d \n", outy, nouty, maxstug, maxouty ) ;
 239 # endif
 240 #endif
 241 }
 242 #endif
 243 #endif
 244