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 ***************************************************************************/
62 RSL_CREATE_XPOSE -- Create a stencil descriptor.
65 The output argument is the integer Arg1, a descriptor to
66 a new RSL stencil. The stencil is then built (RSL_DESCRIBE_STENCIL)
67 and used in stencil exchanges (RSL_EXCH_STENCIL) during the model
71 RSL_DESCRIBE_STENCIL, RSL_EXCH_STENCIL
74 RSL_CREATE_XPOSE ( xp_p
)
75 int_p xp_p
; /* (O) New RSL xpose descriptor. */
80 /* NOTE: never return the 0th stencil */
81 for ( i
= 1 ; i
< RSL_MAXDESCRIPTORS
; i
++ )
82 if ( xp_descriptors
[i
] == NULL
) break ; /* got one */
84 RSL_TEST_ERR( i
== RSL_MAXDESCRIPTORS
,
85 "rsl_create_xpose: out of descriptors.");
88 xpose
= RSL_MALLOC(xpose_desc_t
,1) ;
89 xpose
->tag
= XPOSE_DESC
;
90 xpose
->has_f90_fields
= 0 ;
91 xp_descriptors
[*xp_p
] = xpose
;
95 release_xp_descriptor (xp_p
)
101 RSL_TEST_ERR( xp
< 0 || xp
>= RSL_MAXDESCRIPTORS
,
102 "internal error. Invalid xpose descriptor.") ;
103 if ( xp_descriptors
[xp
] != NULL
)
105 xp_descriptors
[xp
] = NULL
;
110 RSL_DESCRIBE_XPOSE -- Defines an RSL transpose exchange on a domain.
114 RSL_DESCRIBE_XPOSE ( d_p
, xp_p
, message_mn_p
, message_mz_p
, message_nz_p
)
115 int_p d_p
, /* (I) Domain descriptor. */
116 xp_p
, /* (I) Xpose handle */
117 message_mn_p
, /* (I) Message descriptor. */
118 message_mz_p
, /* (I) Message descriptor. */
119 message_nz_p
; /* (I) Message descriptor. */
122 rsl_domain_info_t
* dinfo
;
123 xpose_desc_t
*xpose
;
124 message_desc_t
*msg_mn
, *msg_mz
, *msg_nz
;
127 d
= *d_p
; xp
= *xp_p
;
129 RSL_TEST_ERR( d
< 0 || d
>= RSL_MAXDOMAINS
,
130 "rsl_describe_xpose: bad domain descriptor\n") ;
131 dinfo
= &(domain_info
[d
]) ;
132 RSL_TEST_ERR(dinfo
->valid
!= RSL_VALID
,
133 "rsl_describe_xpose: descriptor is not for a valid domain\n") ;
135 RSL_TEST_ERR( xp
< 0 || xp
>= RSL_MAXDESCRIPTORS
,
136 "rsl_describe_stencil: bad stencil handle" ) ;
137 xpose
= (xpose_desc_t
*) xp_descriptors
[xp
] ;
138 RSL_TEST_ERR( xpose
->tag
!= XPOSE_DESC
,
139 "rsl_describe_xpose: handle given is not for an rsl xpose def" ) ;
141 xpose
->compiled
[d
] = 0 ;
143 RSL_TEST_ERR( (*message_mn_p
<= 0 || *message_mn_p
>=RSL_MAXDESCRIPTORS
),
144 "rsl_describe_xpose: bad message handle in list,\n must be valid message") ;
145 msg_mn
= (message_desc_t
*) mh_descriptors
[ *message_mn_p
] ;
146 xpose
->msgs_mn
[d
] = msg_mn
;
148 RSL_TEST_ERR( (*message_mz_p
<= 0 || *message_mz_p
>=RSL_MAXDESCRIPTORS
),
149 "rsl_describe_xpose: bad message handle in list,\n must be valid message") ;
150 msg_mz
= (message_desc_t
*) mh_descriptors
[ *message_mz_p
] ;
151 xpose
->msgs_mz
[d
] = msg_mz
;
153 RSL_TEST_ERR( (*message_nz_p
<= 0 || *message_nz_p
>=RSL_MAXDESCRIPTORS
),
154 "rsl_describe_xpose: bad message handle in list,\n must be valid message") ;
155 msg_nz
= (message_desc_t
*) mh_descriptors
[ *message_nz_p
] ;
156 xpose
->msgs_nz
[d
] = msg_nz
;
158 /* free up the message descriptor; it has done its job */
159 release_mh_descriptor( message_mn_p
) ;
160 release_mh_descriptor( message_mz_p
) ;
161 release_mh_descriptor( message_nz_p
) ;
163 /* add my descriptor to the list for the domain */
164 dinfo
->xposelist
[dinfo
->xposecurs
] = xp
;
165 dinfo
->xposecurs
++ ; /* 970317 */
167 if ( dinfo
->xposecurs
>= RSL_MAXDESCRIPTORS
)
170 "Domain %d doesn't have room for any more xposes, but the allowable\nlimit of %d should have been more than enough.\nYou might recompile RSL with a higher setting for RSL_MAXDESCRIPTORS, but\n it's likely something else is wrong.",
171 d
, RSL_MAXDESCRIPTORS
) ;
172 RSL_TEST_ERR( 1, mess
) ;
178 /* some of these need to be converted for xposes; others need to be eliminated */
179 /* only used internally within the RSL package */
180 destroy_stencil( sten
)
181 stencil_desc_t
* sten
;
184 rsl_fldspec_t
*fld
, *doomed
;
185 if ( sten
== NULL
) return ;
186 RSL_TEST_ERR( sten
->tag
!= STENCIL_DESC
, "destroy_stencil: arg not a stencil.") ;
188 for ( d
= 0 ; d
< RSL_MAXDOMAINS
; d
++ )
190 destroy_stencil_on_domain( d
, sten
) ;
192 release_sh_descriptor (sten
->sh
) ;
196 destroy_stencil_on_domain( d
, sten
)
198 stencil_desc_t
* sten
;
202 if ( sten
== NULL
) return ;
203 RSL_TEST_ERR( d
< 0 || d
>= RSL_MAXDOMAINS
,
204 "destroy_stencil_on_domain: bad domain descriptor") ;
205 for ( i
= 0 ; i
< RSL_MAXSTEN
+1 ; i
++ )
207 destroy_message( sten
->msgs
[d
][i
] ) ;
209 sten
->f
[d
].ptfcn
= NULL
;
211 uncompile_stencil_on_domain( d
, sten
) ;
214 uncompile_stencil_on_domain( d
, sten
)
216 stencil_desc_t
* sten
;
220 if ( sten
== NULL
) return ;
221 RSL_TEST_ERR( d
< 0 || d
>= RSL_MAXDOMAINS
,
222 "uncompile_stencil_on_domain: bad domain descriptor") ;
223 sten
->compiled
[d
] = 0 ;
224 destroy_procrec_list( sten
->procs
[d
] ) ;
225 sten
->procs
[d
] = NULL
; /* 970317 */
228 destroy_procrec_list( prec
)
229 rsl_procrec_t
*prec
;
231 rsl_procrec_t
*p
, *doomed
;
232 int destroy_ptrec_list() ;
233 if ( prec
== NULL
) return ;
234 for ( p
= prec
; p
!= NULL
; )
238 destroy_list( &(doomed
->point_list
), destroy_ptrec_list
) ;
243 destroy_ptrec_list( ptrec
)
246 rsl_ptrec_t
*p
, *doomed
;
247 if ( ptrec
== NULL
) return ;
248 for ( p
= ptrec
; p
!= NULL
; )
252 destroy_list( &(doomed
->send_messages
), NULL
) ;
253 destroy_list( &(doomed
->recv_messages
), NULL
) ;