wrfv2_fire/external/RSL/RSL/rsl_initial.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 #undef AP1000
  58 #include <stdio.h>
  59 #include <stdlib.h>
  60 #include "rsl.h"
  61
  62 /*@
  63   RSL_INITIALIZE - initialize the RSL package.
  64
  65   Notes:
  66   This routine initializes the RSL package and must be called on each
  67   processor before any other RSL routine.  Once RSL_INITIALIZE is called,
  68   RSL_MON_BCAST and several other low-level informational RSL routines
  69   (e.g. RSL_IAMMONITOR)
  70   may be used to broadcast configuration data read in on
  71   processor zero to other processors.  Other RSL routines may not be
  72   used until RSL_MESH has been called.
  73
  74   Example:
  75
  76 $  program model
  77 $  integer intsize                     ! Size in bytes of an integer.
  78 $  parameter (intsize = 4)
  79 $  integer nproc_m, nproc_n            ! Number of processors in m, n.
  80 $  integer retval
  81 $  namelist /config/ nproc_m, nproc_n  ! Will be read in from namelist.
  82
  83 $  call RSL_INITIALIZE                 ! Initialize RSL
  84 $  call RSL_IAMMONITOR( retval )       ! Read namelist on processor zero
  85 $  if ( retval .eq. 1 ) then
  86 $    read(10,config)
  87 $  endif
  88 $  call RSL_MON_BCAST( nproc_m, intsize )   ! Broadcast config to other procs.
  89 $  call RSL_MON_BCAST( nproc_n, intsize )   ! Broadcast config to other procs.
  90 $  call RSL_MESH( nproc_m, nproc_n )   ! All processors define processor mesh.
  91 $  ...                                 ! Rest of model.
  92 $  call RSL_SHUTDOWN                   ! Shutdown.
  93 $  stop
  94 $  end
  95
  96 BREAKTHEEXAMPLECODE
  97
  98   See also:
  99   RSL_SHUTDOWN, RSL_MESH, RSL_MON_BCAST
 100
 101 @*/
 102 RSL_INITIALIZE ()
 103 {
 104   int s, o ;
 105 #ifndef STUBS
 106   rslMPIInit() ;
 107   rsl_mpi_communicator = MPI_COMM_WORLD ;
 108 #endif
 109   rsl_initialize_internal() ;
 110   s = 1 ; o = 0 ;
 111   RSL_DEBUG( &s , &o ) ;
 112
 113 }
 114
 115 #ifndef STUBS
 116 RSL_INITIALIZE1 ( MPI_Fint * comm )
 117 {
 118   rsl_mpi_communicator = MPI_Comm_f2c( *comm ) ;
 119   rsl_initialize_internal() ;
 120 }
 121 #else
 122 RSL_INITIALIZE1 ( int * comm )
 123 {
 124   rsl_initialize_internal() ;
 125 }
 126 #endif
 127
 128 rsl_initialize_internal()
 129 {
 130   char name[256] ;
 131   int d ;
 132   int i ;
 133   int rsl_default_decomp() ;            /* defined in cd.c */
 134
 135   for ( d = 0 ; d < RSL_MAXDOMAINS ; d++ )
 136   {
 137     domain_info[d].valid = RSL_INVALID ;
 138   }
 139   for ( i = 0 ; i < RSL_MAXDESCRIPTORS ; i++ ) mh_descriptors[i] = NULL ;
 140   for ( i = 0 ; i < RSL_MAXDESCRIPTORS ; i++ ) sh_descriptors[i] = NULL ;
 141   for ( i = 0 ; i < RSL_MAXDESCRIPTORS ; i++ ) xp_descriptors[i] = NULL ;
 142   for ( i = 0 ; i < RSL_MAXDESCRIPTORS ; i++ ) pr_descriptors[i] = NULL ;
 143   mh_descriptors[0] = (void*)1 ;  /* leave 0th one alone -- never use.
 144                                    this means that a message handle of
 145                                    zero is always an error */
 146   rsl_ndomains = 0 ;
 147   old_offsets = 0 ;
 148
 149 #ifndef STUBS
 150   rslMPIInit() ;
 151
 152   MPI_Comm_size( rsl_mpi_communicator , &rsl_nproc_all ) ;
 153   MPI_Comm_rank( rsl_mpi_communicator , &rsl_myproc ) ;
 154 #else
 155   rsl_nproc_all = 1 ;
 156   rsl_myproc = 0 ;
 157 #endif
 158
 159 /* John's patented brain substitute ; 5/3/2002 */
 160   if ( rsl_nproc_all > RSL_MAXPROC )
 161   {
 162     sprintf(mess,"rsl_nproc_all (%d) > RSL_MAXPROC (%d). Recompile RSL with larger value.\n%s\n",rsl_nproc_all,RSL_MAXPROC,
 163                  "(For WRF, change value of MAX_PROC in configure.wrf)"
 164     ) ;
 165     RSL_TEST_ERR( 1, mess ) ;
 166   }
 167
 168   rsl_nproc = rsl_nproc_all ;   /* this may be reset by RSL_MESH */
 169   rsl_padarea = RSL_DEFAULT_PADAREA ;
 170   io_seq_monitor = 0 ;  /* OBS */
 171   io_seq_compute = 1 ;  /* OBS */
 172
 173   regular_decomp = 0 ;
 174   sw_allow_dynpad = 0 ;
 175
 176
 177
 178   RSL_INIT_FORTRAN ( &rsl_nproc_all, &rsl_nproc, &rsl_myproc,
 179                      &rsl_nproc_m, &rsl_nproc_n, &rsl_ndomains ) ;
 180
 181 #ifndef T3D
 182   gethostname(name,255) ;
 183   fprintf(stderr,"%s -- rsl_nproc_all %d, rsl_myproc %d\n",name,
 184                   rsl_nproc_all, rsl_myproc ) ;
 185 #endif
 186
 187   RSL_F_SET_PADAREA ( &rsl_padarea ) ;
 188
 189   rsl_noprobe = (char *)getenv( "RSL_NOPROBE" ) ;
 190   if ( rsl_noprobe != NULL && rsl_myproc == 0 )
 191   {
 192     if ( rsl_myproc == 0 )
 193       fprintf(stderr,"Advisory: RSL_NOPROBE defined.  Won't probe.\n") ;
 194   }
 195
 196   for (  d = 0 ; d < RSL_MAXDOMAINS ; d++ )
 197   {
 198     domain_info[d].valid = RSL_INVALID ;
 199     domain_info[d].iruns = NULL ;
 200     domain_info[d].domain = NULL ;
 201     domain_info[d].bcast_Xlist = NULL ;
 202     domain_info[d].merge_Xlist = NULL ;
 203     { int p ;
 204       for ( p = 0 ; p < MAX_KINDPAD ; p++ )
 205       {
 206         domain_info[d].js[p] = NULL ;
 207         domain_info[d].is[p] = NULL ;
 208         domain_info[d].ie[p] = NULL ;
 209         domain_info[d].jg2n[p] = NULL ;
 210         domain_info[d].is2[p] = NULL ;
 211         domain_info[d].js2[p] = NULL ;
 212         domain_info[d].je2[p] = NULL ;
 213         domain_info[d].ig2n[p] = NULL ;
 214       }
 215     }
 216     domain_info[d].is_write = RSL_INVALID ;
 217     domain_info[d].ie_write = RSL_INVALID ;
 218     domain_info[d].js_write = RSL_INVALID ;
 219     domain_info[d].je_write = RSL_INVALID ;
 220     domain_info[d].is_read = RSL_INVALID ;
 221     domain_info[d].ie_read = RSL_INVALID ;
 222     domain_info[d].js_read = RSL_INVALID ;
 223     domain_info[d].je_read = RSL_INVALID ;
 224
 225   }
 226
 227   /* set up default decomposition fuctions */
 228   SET_DEF_DECOMP_FCN ( rsl_default_decomp ) ;  /* defined in cd.c */
 229   for (  d = 0 ; d < RSL_MAXDOMAINS ; d++ )
 230   {
 231     SET_DEF_DECOMP_INFO ( &d, NULL ) ;
 232   }
 233 }
 234
 235 /*@
 236   RSL_SHUTDOWN - shut down the RSL package.
 237
 238   Notes:
 239   This routine shuts down the RSL package at the end of the program
 240   and should be called before program termination.
 241
 242   See also:
 243   RSL_INITIALIZE, RSL_MESH
 244
 245 @*/
 246 RSL_SHUTDOWN ()
 247 {
 248   RSL_CLOSE0 () ;
 249 }
 250
 251 /*@
 252   RSL_MESH - specify a 2-dimensional mesh of processors for the RSL package.
 253
 254   Notes:
 255   This routine is used to specify the two-dimensional mesh of processors.
 256   RSL_INITIALIZE must have already been called.  RSL_MESH
 257   must be called before any RSL domain has been defined.  Only RSL_MON_BCAST
 258   will work prior to the call to RSL_MESH; this allows node zero to read
 259   and broadcast to the other processors configuration information.
 260   RSL_MESH must be called on all processors.
 261
 262   Example:
 263 $  program model
 264 $  integer intsize                     ! Size in bytes of an integer.
 265 $  parameter (intsize = 4)
 266 $  integer nproc_m, nproc_n            ! Number of processors in m, n.
 267 $  integer retval
 268 $  namelist /config/ nproc_m, nproc_n  ! Will be read in from namelist.
 269 $
 270 $  call RSL_INITIALIZE                 ! Initialize RSL
 271 $  call RSL_IAMMONITOR( retval )       ! Read namelist on processor zero
 272 $  if ( retval .eq. 1 ) then
 273 $    read(10,config)
 274 $  endif
 275 $  call RSL_MON_BCAST( nproc_m, intsize )   ! Broadcast config to other procs.
 276 $  call RSL_MON_BCAST( nproc_n, intsize )   ! Broadcast config to other procs.
 277 $  call RSL_MESH( nproc_m, nproc_n )   ! All processors define processor mesh.
 278 $  ...                                 ! Rest of model.
 279 $  call RSL_SHUTDOWN                   ! Shutdown.
 280 $  stop
 281 $  end
 282 BREAKTHEEXAMPLECODE
 283
 284   See also:
 285   RSL_INITIALIZE, RSL_MON_BCAST, RSL_SHUTDOWN
 286 @*/
 287 RSL_MESH (nproc_m_p, nproc_n_p )
 288   int_p
 289     nproc_m_p   /* (I) Number of processors decomposing M dimension. */
 290    ,nproc_n_p   /* (I) Number of processors decomposing N dimension. */
 291    ;
 292 {
 293   char name[256] ;
 294   int d ;
 295   int i ;
 296   int rsl_default_decomp() ;            /* defined in cd.c */
 297
 298   rsl_nproc_m = *nproc_m_p ;
 299   rsl_nproc_n = *nproc_n_p ;
 300   rsl_nproc = rsl_nproc_n * rsl_nproc_m ;
 301
 302   rsl_padarea = RSL_DEFAULT_PADAREA ;
 303   io_seq_monitor = 0 ;  /* OBS */
 304   io_seq_compute = 1 ;  /* OBS */
 305
 306   RSL_INIT_FORTRAN ( &rsl_nproc_all, &rsl_nproc, &rsl_myproc,
 307                      &rsl_nproc_m, &rsl_nproc_n, &rsl_ndomains ) ;
 308   RSL_F_SET_PADAREA ( &rsl_padarea ) ;
 309   if ( rsl_nproc_all < rsl_nproc )
 310   {
 311     sprintf(mess,"RSL_MESH: %d is too few processors (need px*py=%d)",
 312                  rsl_nproc_all, rsl_nproc ) ;
 313     RSL_TEST_ERR( rsl_nproc_all < rsl_nproc, mess ) ;
 314   }
 315
 316 }
 317
 318 /*@
 319   RSL_OLD_OFFSETS -- Calculate local indices using old F77 MPMM strategy.
 320
 321   Notes:
 322   This routine is provided for backward compatibility with the F77
 323   parallel implementation of MM5, MPMM, which was developed
 324   using an earlier version of RSL.  Call this routine after
 325   RSL_INITIALIZE in the model to use this version of RSL with MPMM.
 326
 327   See also:
 328   RSL_INITIALIZE
 329
 330 @*/
 331 RSL_OLD_OFFSETS ()
 332 {
 333   old_offsets = 1 ;
 334 }
 335
 336 RSL_SET_REGULAR_DECOMP ()
 337 {
 338   regular_decomp = 1 ;
 339 }
 340
 341 RSL_GET_COMMUNICATOR ( communicator )
 342   int_p  communicator ;  /* (O) return value with communicator from underlying mp layer (mpi probably) */
 343 {
 344 #ifdef MPI
 345   *communicator = MPI_Comm_c2f( rsl_mpi_communicator ) ;
 346 #else
 347   *communicator = 0 ;
 348 #endif
 349 }
 350
 351 RSL_SET_COMMUNICATOR ( communicator )
 352   int_p  communicator ;  /* (O) return value with communicator from underlying mp layer (mpi probably) */
 353 {
 354 #ifdef MPI
 355   rsl_mpi_communicator = MPI_Comm_f2c( *communicator ) ;
 356 #endif
 357 }
 358
 359