1 /***********************************************************************
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.
10 (c) 1977 University of Chicago
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:
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.
23 b) You must cause the modified Software to carry prominent
24 notices stating that you changed specified portions of
27 This software was authored by:
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
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.
39 GOVERNMENT LICENSE AND DISCLAIMER
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.
55 ***************************************************************************/
63 RSL_INITIALIZE - initialize the RSL package.
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
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.
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.
81 $ namelist /config/ nproc_m, nproc_n ! Will be read in from namelist.
83 $ call RSL_INITIALIZE ! Initialize RSL
84 $ call RSL_IAMMONITOR( retval ) ! Read namelist on processor zero
85 $ if ( retval .eq. 1 ) then
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.
99 RSL_SHUTDOWN, RSL_MESH, RSL_MON_BCAST
107 rsl_mpi_communicator
= MPI_COMM_WORLD
;
109 rsl_initialize_internal() ;
111 RSL_DEBUG( &s
, &o
) ;
116 RSL_INITIALIZE1 ( MPI_Fint
* comm
)
118 rsl_mpi_communicator
= MPI_Comm_f2c( *comm
) ;
119 rsl_initialize_internal() ;
122 RSL_INITIALIZE1 ( int * comm
)
124 rsl_initialize_internal() ;
128 rsl_initialize_internal()
133 int rsl_default_decomp() ; /* defined in cd.c */
135 for ( d
= 0 ; d
< RSL_MAXDOMAINS
; d
++ )
137 domain_info
[d
].valid
= RSL_INVALID
;
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 */
152 MPI_Comm_size( rsl_mpi_communicator
, &rsl_nproc_all
) ;
153 MPI_Comm_rank( rsl_mpi_communicator
, &rsl_myproc
) ;
159 /* John's patented brain substitute ; 5/3/2002 */
160 if ( rsl_nproc_all
> RSL_MAXPROC
)
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)"
165 RSL_TEST_ERR( 1, mess
) ;
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 */
174 sw_allow_dynpad
= 0 ;
178 RSL_INIT_FORTRAN ( &rsl_nproc_all
, &rsl_nproc
, &rsl_myproc
,
179 &rsl_nproc_m
, &rsl_nproc_n
, &rsl_ndomains
) ;
182 gethostname(name
,255) ;
183 fprintf(stderr
,"%s -- rsl_nproc_all %d, rsl_myproc %d\n",name
,
184 rsl_nproc_all
, rsl_myproc
) ;
187 RSL_F_SET_PADAREA ( &rsl_padarea
) ;
189 rsl_noprobe
= (char *)getenv( "RSL_NOPROBE" ) ;
190 if ( rsl_noprobe
!= NULL
&& rsl_myproc
== 0 )
192 if ( rsl_myproc
== 0 )
193 fprintf(stderr
,"Advisory: RSL_NOPROBE defined. Won't probe.\n") ;
196 for ( d
= 0 ; d
< RSL_MAXDOMAINS
; d
++ )
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
;
204 for ( p
= 0 ; p
< MAX_KINDPAD
; p
++ )
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
;
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
;
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
++ )
231 SET_DEF_DECOMP_INFO ( &d
, NULL
) ;
236 RSL_SHUTDOWN - shut down the RSL package.
239 This routine shuts down the RSL package at the end of the program
240 and should be called before program termination.
243 RSL_INITIALIZE, RSL_MESH
252 RSL_MESH - specify a 2-dimensional mesh of processors for the RSL package.
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.
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.
268 $ namelist /config/ nproc_m, nproc_n ! Will be read in from namelist.
270 $ call RSL_INITIALIZE ! Initialize RSL
271 $ call RSL_IAMMONITOR( retval ) ! Read namelist on processor zero
272 $ if ( retval .eq. 1 ) then
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.
285 RSL_INITIALIZE, RSL_MON_BCAST, RSL_SHUTDOWN
287 RSL_MESH (nproc_m_p
, nproc_n_p
)
289 nproc_m_p
/* (I) Number of processors decomposing M dimension. */
290 ,nproc_n_p
/* (I) Number of processors decomposing N dimension. */
296 int rsl_default_decomp() ; /* defined in cd.c */
298 rsl_nproc_m
= *nproc_m_p
;
299 rsl_nproc_n
= *nproc_n_p
;
300 rsl_nproc
= rsl_nproc_n
* rsl_nproc_m
;
302 rsl_padarea
= RSL_DEFAULT_PADAREA
;
303 io_seq_monitor
= 0 ; /* OBS */
304 io_seq_compute
= 1 ; /* OBS */
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
)
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
) ;
319 RSL_OLD_OFFSETS -- Calculate local indices using old F77 MPMM strategy.
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.
336 RSL_SET_REGULAR_DECOMP ()
341 RSL_GET_COMMUNICATOR ( communicator
)
342 int_p communicator
; /* (O) return value with communicator from underlying mp layer (mpi probably) */
345 *communicator
= MPI_Comm_c2f( rsl_mpi_communicator
) ;
351 RSL_SET_COMMUNICATOR ( communicator
)
352 int_p communicator
; /* (O) return value with communicator from underlying mp layer (mpi probably) */
355 rsl_mpi_communicator
= MPI_Comm_f2c( *communicator
) ;