|
Open64 (mfef90, whirl2f, and IR tools)
TAG: version-openad; SVN changeset: 916
|
|
Open64 (mfef90, whirl2f, and IR tools)
TAG: version-openad; SVN changeset: 916
|
00001 /* 00002 00003 Copyright (C) 2000, 2001 Silicon Graphics, Inc. All Rights Reserved. 00004 00005 This program is free software; you can redistribute it and/or modify it 00006 under the terms of version 2.1 of the GNU Lesser General Public License 00007 as published by the Free Software Foundation. 00008 00009 This program is distributed in the hope that it would be useful, but 00010 WITHOUT ANY WARRANTY; without even the implied warranty of 00011 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 00012 00013 Further, this software is distributed without any warranty that it is 00014 free of the rightful claim of any third person regarding infringement 00015 or the like. Any license provided herein, whether implied or 00016 otherwise, applies only to this software file. Patent licenses, if 00017 any, provided herein do not apply to combinations of this program with 00018 other software, or any other product whatsoever. 00019 00020 You should have received a copy of the GNU Lesser General Public 00021 License along with this program; if not, write the Free Software 00022 Foundation, Inc., 59 Temple Place - Suite 330, Boston MA 02111-1307, 00023 USA. 00024 00025 Contact information: Silicon Graphics, Inc., 1600 Amphitheatre Pky, 00026 Mountain View, CA 94043, or: 00027 00028 http://www.sgi.com 00029 00030 For further information regarding this notice, see: 00031 00032 http://oss.sgi.com/projects/GenInfo/NoticeExplan 00033 00034 */ 00035 00036 00037 static char USMID[] = "@(#) libfi/array/minval.c 92.0 10/08/98 14:37:14"; 00038 00039 #include <stddef.h> 00040 #include <liberrno.h> 00041 #include <fmath.h> 00042 #include <cray/dopevec.h> 00043 #include <cray/portdefs.h> 00044 #include "arraydefs.h" 00045 00046 #define USE_INT8 1 00047 #define USE_INT6 2 00048 #define USE_INT4 3 00049 #define USE_INT2 4 00050 #define USE_INT1 5 00051 #define USE_REAL16 6 00052 #define USE_REAL8 7 00053 #define USE_REAL4 8 00054 00055 /* 00056 * INCREMENT calculates the offset for each dimension of the source, 00057 * mask and result arrays. The sum of the offsets gives the number 00058 * of elements from the beginning of the array. 00059 */ 00060 00061 #define INCREMENT() \ 00062 curdim[0]++; \ 00063 if (curdim[0] < src_ext[0]) { \ 00064 src_off[0] = curdim[0] * src_strd[0]; \ 00065 msk_off[0] = curdim[0] * msk_strd[0]; \ 00066 res_off[0] = curdim[0] * res_strd[0]; \ 00067 } else { \ 00068 curdim[0] = 0; \ 00069 src_off[0] = 0; \ 00070 msk_off[0] = 0; \ 00071 res_off[0] = 0; \ 00072 curdim[1]++; \ 00073 if (curdim[1] < src_ext[1]) { \ 00074 src_off[1] = curdim[1] * src_strd[1]; \ 00075 msk_off[1] = curdim[1] * msk_strd[1]; \ 00076 res_off[1] = curdim[1] * res_strd[1]; \ 00077 } else { \ 00078 curdim[1] = 0; \ 00079 src_off[1] = 0; \ 00080 msk_off[1] = 0; \ 00081 res_off[1] = 0; \ 00082 curdim[2]++; \ 00083 if (curdim[2] < src_ext[2]) { \ 00084 src_off[2] = curdim[2] * src_strd[2]; \ 00085 msk_off[2] = curdim[2] * msk_strd[2]; \ 00086 res_off[2] = curdim[2] * res_strd[2]; \ 00087 } else { \ 00088 curdim[2] = 0; \ 00089 src_off[2] = 0; \ 00090 msk_off[2] = 0; \ 00091 res_off[2] = 0; \ 00092 curdim[3]++; \ 00093 if (curdim[3] < src_ext[3]) { \ 00094 src_off[3] = curdim[3] * src_strd[3]; \ 00095 msk_off[3] = curdim[3] * msk_strd[3]; \ 00096 res_off[3] = curdim[3] * res_strd[3]; \ 00097 } else { \ 00098 curdim[3] = 0; \ 00099 src_off[3] = 0; \ 00100 msk_off[3] = 0; \ 00101 res_off[3] = 0; \ 00102 curdim[4]++; \ 00103 if (curdim[4] < src_ext[4]) { \ 00104 src_off[4] = curdim[4] * src_strd[4]; \ 00105 msk_off[4] = curdim[4] * msk_strd[4]; \ 00106 res_off[4] = curdim[4] * res_strd[4]; \ 00107 } else { \ 00108 curdim[4] = 0; \ 00109 src_off[4] = 0; \ 00110 msk_off[4] = 0; \ 00111 res_off[4] = 0; \ 00112 curdim[5]++; \ 00113 src_off[5] = curdim[5] * src_strd[5]; \ 00114 msk_off[5] = curdim[5] * msk_strd[5]; \ 00115 res_off[5] = curdim[5] * res_strd[5]; \ 00116 } \ 00117 } \ 00118 } \ 00119 } \ 00120 } 00121 00122 /* INCR_RES calculates the offset for the result array */ 00123 00124 #define INCR_RES() \ 00125 curdim[0]++; \ 00126 if (curdim[0] < res_ext[0]) { \ 00127 res_off[0] = curdim[0] * res_strd[0]; \ 00128 } else { \ 00129 curdim[0] = 0; \ 00130 res_off[0] = 0; \ 00131 curdim[1]++; \ 00132 if (curdim[1] < res_ext[1]) { \ 00133 res_off[1] = curdim[1] * res_strd[1]; \ 00134 } else { \ 00135 curdim[1] = 0; \ 00136 res_off[1] = 0; \ 00137 curdim[2]++; \ 00138 if (curdim[2] < res_ext[2]) { \ 00139 res_off[2] = curdim[2] * res_strd[2]; \ 00140 } else { \ 00141 curdim[2] = 0; \ 00142 res_off[2] = 0; \ 00143 curdim[3]++; \ 00144 if (curdim[3] < res_ext[3]) { \ 00145 res_off[3] = curdim[3] * res_strd[3]; \ 00146 } else { \ 00147 curdim[3] = 0; \ 00148 res_off[3] = 0; \ 00149 curdim[4]++; \ 00150 if (curdim[4] < res_ext[4]) { \ 00151 res_off[4] = curdim[4] * res_strd[4]; \ 00152 } else { \ 00153 curdim[4] = 0; \ 00154 res_off[4] = 0; \ 00155 curdim[5]++; \ 00156 res_off[5] = curdim[5] * res_strd[5]; \ 00157 } \ 00158 } \ 00159 } \ 00160 } \ 00161 } \ 00162 if (rank == 2) \ 00163 rindx = res_off[0]; \ 00164 else if (rank == 3) \ 00165 rindx = res_off[0] + res_off[1]; \ 00166 else if (rank == 4) \ 00167 rindx = res_off[0] + res_off[1] + res_off[2]; \ 00168 else if (rank == 5) \ 00169 rindx = res_off[0] + res_off[1] + \ 00170 res_off[2] + res_off[3]; \ 00171 else if (rank == 6) \ 00172 rindx = res_off[0] + res_off[1] + res_off[2] + \ 00173 res_off[3] + res_off[4]; \ 00174 else \ 00175 rindx = res_off[0] + res_off[1] + res_off[2] + \ 00176 res_off[3] + res_off[4] + res_off[5]; 00177 00178 /* LOAD_DM_MK correctly for P.E. 3.0 and above */ 00179 00180 #define LOAD_DM_MK() \ 00181 dm = dimp; \ 00182 mk = mask; \ 00183 /* if last arg = NULL, is last-1 arg mask or dim? */ \ 00184 if (mask == NULL) { \ 00185 /* last arg = NULL, is last-1 arg mask or dim? */ \ 00186 if (dimp != NULL) { \ 00187 if (dimp->type_lens.type == DVTYPE_LOGICAL) { \ 00188 /* last-1 argument is mask. */ \ 00189 mk = dimp; \ 00190 dm = mask; \ 00191 } \ 00192 } \ 00193 } \ 00194 if (dm != NULL) { \ 00195 _f_int dmintlen; \ 00196 dmintlen = dm->type_lens.int_len >> 3; \ 00197 dimenp = (_f_int *) &dimenlc; \ 00198 if (dmintlen == sizeof(_f_int8)) { \ 00199 *dimenp = *(_f_int8 *) dm->base_addr.a.ptr; \ 00200 } else if (dmintlen == sizeof(_f_int4)) { \ 00201 *dimenp = *(_f_int4 *) dm->base_addr.a.ptr; \ 00202 } else if (dmintlen == sizeof(_f_int2)) { \ 00203 *dimenp = *(_f_int2 *) dm->base_addr.a.ptr; \ 00204 } else if (dmintlen == sizeof(_f_int1)) { \ 00205 *dimenp = *(_f_int1 *) dm->base_addr.a.ptr; \ 00206 } \ 00207 } 00208 00209 /* 00210 * MINVAL has six entry points. There is an entry point for a dope 00211 * vector return, and a scalar return for integer, real and double 00212 * precision. 00213 */ 00214 00215 /* P.E. 2.0 and earlier entry points for MINVAL contain only a single 00216 * underbar after MINVAL and before the TYPE letter. Only these entry 00217 * points may specify DVSUBTYPE_INT46 and INTEGER(KIND=6). P.E. 3.0 00218 * does not have INTEGER(KIND=6). 00219 * 00220 * P.E. 3.0 uses the double underbar between MINVAL and the TYPE letter. 00221 * Note that we can never do a fast compare the way in which the routine 00222 * is written because it starts with with -HUGE as the first maxinum 00223 * value it is comparing against to find the maximum location. 00224 */ 00225 00226 #ifdef _UNICOS 00227 #pragma _CRI duplicate _MINVAL_J as MINVAL_J@ 00228 #endif 00229 void 00230 _MINVAL_J ( DopeVectorType * result, 00231 DopeVectorType * source, 00232 _f_int * dimp, 00233 DopeVectorType * mask) 00234 { 00235 void __minval(); 00236 (void) __minval (result, source, dimp, mask, 0, DVSUBTYPE_INT64, 00237 USE_INT8); 00238 } 00239 00240 void 00241 _MINVAL__J ( DopeVectorType * result, 00242 DopeVectorType * source, 00243 DopeVectorType * dimp, 00244 DopeVectorType * mask) 00245 { 00246 void __minval(); 00247 DopeVectorType *dm, *mk; 00248 _f_int *dimenp = NULL; 00249 _f_int dimenlc = 0; 00250 LOAD_DM_MK(); 00251 (void) __minval (result, source, dimenp, mk, 0, DVSUBTYPE_INT64, 00252 USE_INT8); 00253 } 00254 00255 00256 #ifdef _UNICOS 00257 #pragma _CRI duplicate _MINVAL_S as MINVAL_S@ 00258 #endif 00259 void 00260 _MINVAL_S ( DopeVectorType * result, 00261 DopeVectorType * source, 00262 _f_int * dimp, 00263 DopeVectorType * mask) 00264 { 00265 void __minval(); 00266 (void) __minval (result, source, dimp, mask, 0, DVSUBTYPE_REAL64, 00267 USE_REAL8); 00268 } 00269 00270 void 00271 _MINVAL__S ( DopeVectorType * result, 00272 DopeVectorType * source, 00273 DopeVectorType * dimp, 00274 DopeVectorType * mask) 00275 { 00276 void __minval(); 00277 DopeVectorType *dm, *mk; 00278 _f_int *dimenp = NULL; 00279 _f_int dimenlc = 0; 00280 LOAD_DM_MK(); 00281 (void) __minval (result, source, dimenp, mk, 0, DVSUBTYPE_REAL64, 00282 USE_REAL8); 00283 } 00284 00285 #if defined _F_REAL16 && _F_REAL16 != (-1) 00286 #ifdef _UNICOS 00287 #pragma _CRI duplicate _MINVAL_D as MINVAL_D@ 00288 #endif 00289 void 00290 _MINVAL_D ( DopeVectorType * result, 00291 DopeVectorType * source, 00292 _f_int * dimp, 00293 DopeVectorType * mask) 00294 { 00295 void __minval(); 00296 (void) __minval (result, source, dimp, mask, 0, DVSUBTYPE_REAL128, 00297 USE_REAL16); 00298 } 00299 00300 void 00301 _MINVAL__D ( DopeVectorType * result, 00302 DopeVectorType * source, 00303 DopeVectorType * dimp, 00304 DopeVectorType * mask) 00305 { 00306 void __minval(); 00307 DopeVectorType *dm, *mk; 00308 _f_int *dimenp = NULL; 00309 _f_int dimenlc = 0; 00310 LOAD_DM_MK(); 00311 (void) __minval (result, source, dimenp, mk, 0, DVSUBTYPE_REAL128, 00312 USE_REAL16); 00313 } 00314 #endif 00315 00316 #ifdef _UNICOS 00317 #pragma _CRI duplicate _MINVAL_I as MINVAL_I@ 00318 #endif 00319 void 00320 _MINVAL_I ( DopeVectorType * result, 00321 DopeVectorType * source, 00322 _f_int * dimp, 00323 DopeVectorType * mask) 00324 { 00325 void __minval(); 00326 #ifdef _F_INT6 00327 (void) __minval (result, source, dimp, mask, 0, DVSUBTYPE_INT46, 00328 USE_INT6); 00329 #else 00330 (void) __minval (result, source, dimp, mask, 0, DVSUBTYPE_INT64, 00331 USE_INT8); 00332 #endif 00333 } 00334 00335 void 00336 _MINVAL__I ( DopeVectorType * result, 00337 DopeVectorType * source, 00338 DopeVectorType * dimp, 00339 DopeVectorType * mask) 00340 { 00341 void __minval(); 00342 DopeVectorType *dm, *mk; 00343 _f_int *dimenp = NULL; 00344 _f_int dimenlc = 0; 00345 LOAD_DM_MK(); 00346 #ifdef _F_INT6 00347 (void) __minval (result, source, dimenp, mk, 0, DVSUBTYPE_INT46, 00348 USE_INT6); 00349 #else 00350 (void) __minval (result, source, dimenp, mk, 0, DVSUBTYPE_INT64, 00351 USE_INT8); 00352 #endif 00353 } 00354 00355 #ifndef _F_INT6 00356 #ifdef __mips 00357 typedef _f_int8 _f_int6; /* integer of default kind */ 00358 #else 00359 typedef int _f_int6; /* integer of default kind */ 00360 #endif /* __mips */ 00361 #endif /* Not _F_INT6 */ 00362 00363 #ifdef _UNICOS 00364 #pragma _CRI duplicate _MINVAL0_I as MINVAL0_I@ 00365 #endif 00366 _f_int6 00367 _MINVAL0_I ( DopeVectorType * source, 00368 _f_int * dimp, 00369 DopeVectorType * mask) 00370 { 00371 void __minval(); 00372 int i = 1; 00373 _f_int6 i6; 00374 DopeVectorType result, *res_ptr; 00375 00376 i6 = (_f_int6) HUGE_INT6_F90; 00377 res_ptr = (DopeVectorType *) &result; 00378 res_ptr->assoc = 1; 00379 res_ptr->base_addr.a.ptr = (_f_int6 *) &i6; 00380 res_ptr->base_addr.a.el_len = source->base_addr.a.el_len; 00381 res_ptr->ptr_alloc = 0; 00382 res_ptr->p_or_a = NOT_P_OR_A; 00383 res_ptr->n_dim = 0; 00384 res_ptr->type_lens.type = DVTYPE_INTEGER; 00385 res_ptr->type_lens.dpflag = source->type_lens.dpflag; 00386 res_ptr->type_lens.kind_or_star = source->type_lens.kind_or_star; 00387 res_ptr->type_lens.int_len = source->type_lens.int_len; 00388 res_ptr->type_lens.dec_len = source->type_lens.dec_len; 00389 res_ptr->orig_base = (_f_int6 *) NULL; 00390 res_ptr->orig_size = 0; 00391 #ifdef _F_INT6 00392 __minval (res_ptr, source, dimp, mask, 1, DVSUBTYPE_INT46, 00393 USE_INT6); 00394 #else 00395 (void) __minval (res_ptr, source, dimp, mask, 0, DVSUBTYPE_INT64, 00396 USE_INT8); 00397 #endif 00398 return (*(_f_int6 *) res_ptr->base_addr.a.ptr); 00399 } 00400 00401 _f_int8 00402 _MINVAL0__I ( DopeVectorType * source, 00403 DopeVectorType * dimp, 00404 DopeVectorType * mask) 00405 { 00406 void __minval(); 00407 int i = 1; 00408 _f_int6 i6; 00409 DopeVectorType result, *res_ptr; 00410 DopeVectorType *dm, *mk; 00411 _f_int *dimenp = NULL; 00412 _f_int dimenlc = 0; 00413 00414 LOAD_DM_MK(); 00415 i6 = (_f_int6) HUGE_INT6_F90; 00416 res_ptr = (DopeVectorType *) &result; 00417 res_ptr->assoc = 1; 00418 res_ptr->base_addr.a.ptr = (_f_int6 *) &i6; 00419 res_ptr->base_addr.a.el_len = source->base_addr.a.el_len; 00420 res_ptr->ptr_alloc = 0; 00421 res_ptr->p_or_a = NOT_P_OR_A; 00422 res_ptr->n_dim = 0; 00423 res_ptr->type_lens.type = DVTYPE_INTEGER; 00424 res_ptr->type_lens.dpflag = source->type_lens.dpflag; 00425 res_ptr->type_lens.kind_or_star = source->type_lens.kind_or_star; 00426 res_ptr->type_lens.int_len = source->type_lens.int_len; 00427 res_ptr->type_lens.dec_len = source->type_lens.dec_len; 00428 res_ptr->orig_base = (_f_int6 *) NULL; 00429 res_ptr->orig_size = 0; 00430 #ifdef _F_INT6 00431 __minval (res_ptr, source, dimenp, mk, 1, DVSUBTYPE_INT46, 00432 USE_INT6); 00433 #else 00434 (void) __minval (res_ptr, source, dimenp, mk, 0, DVSUBTYPE_INT64, 00435 USE_INT8); 00436 #endif 00437 return (*(_f_int6 *) res_ptr->base_addr.a.ptr); 00438 } 00439 00440 #ifdef _UNICOS 00441 #pragma _CRI duplicate _MINVAL_I4 as MINVAL_I4@ 00442 #endif 00443 void 00444 _MINVAL_I4 ( DopeVectorType * result, 00445 DopeVectorType * source, 00446 _f_int * dimp, 00447 DopeVectorType * mask) 00448 { 00449 void __minval(); 00450 #ifndef _F_INT4 00451 (void) __minval (result, source, dimp, mask, 0, DVSUBTYPE_INT46, 00452 USE_INT4); 00453 #else 00454 (void) __minval (result, source, dimp, mask, 0, DVSUBTYPE_INT32, 00455 USE_INT4); 00456 #endif 00457 } 00458 00459 void 00460 _MINVAL__I4 ( DopeVectorType * result, 00461 DopeVectorType * source, 00462 DopeVectorType * dimp, 00463 DopeVectorType * mask) 00464 { 00465 void __minval(); 00466 DopeVectorType *dm, *mk; 00467 _f_int *dimenp = NULL; 00468 _f_int dimenlc = 0; 00469 LOAD_DM_MK(); 00470 #ifndef _F_INT4 00471 (void) __minval (result, source, dimenp, mk, 0, DVSUBTYPE_INT46, 00472 USE_INT4); 00473 #else 00474 (void) __minval (result, source, dimenp, mk, 0, DVSUBTYPE_INT32, 00475 USE_INT4); 00476 #endif 00477 } 00478 00479 #ifdef _UNICOS 00480 #pragma _CRI duplicate _MINVAL_I2 as MINVAL_I2@ 00481 #endif 00482 void 00483 _MINVAL_I2 ( DopeVectorType * result, 00484 DopeVectorType * source, 00485 _f_int * dimp, 00486 DopeVectorType * mask) 00487 { 00488 void __minval(); 00489 #ifndef _F_INT4 00490 (void) __minval (result, source, dimp, mask, 0, DVSUBTYPE_INT46, 00491 USE_INT2); 00492 #else 00493 (void) __minval (result, source, dimp, mask, 0, DVSUBTYPE_INT32, 00494 USE_INT2); 00495 #endif 00496 } 00497 00498 void 00499 _MINVAL__I2 ( DopeVectorType * result, 00500 DopeVectorType * source, 00501 DopeVectorType * dimp, 00502 DopeVectorType * mask) 00503 { 00504 void __minval(); 00505 DopeVectorType *dm, *mk; 00506 _f_int *dimenp = NULL; 00507 _f_int dimenlc = 0; 00508 LOAD_DM_MK(); 00509 #ifndef _F_INT4 00510 (void) __minval (result, source, dimenp, mk, 0, DVSUBTYPE_INT46, 00511 USE_INT2); 00512 #else 00513 (void) __minval (result, source, dimenp, mk, 0, DVSUBTYPE_INT32, 00514 USE_INT2); 00515 #endif 00516 } 00517 00518 #ifdef _UNICOS 00519 #pragma _CRI duplicate _MINVAL_I1 as MINVAL_I1@ 00520 #endif 00521 void 00522 _MINVAL_I1 ( DopeVectorType * result, 00523 DopeVectorType * source, 00524 _f_int * dimp, 00525 DopeVectorType * mask) 00526 { 00527 void __minval(); 00528 #ifndef _F_INT4 00529 (void) __minval (result, source, dimp, mask, 0, DVSUBTYPE_INT46, 00530 USE_INT1); 00531 #else 00532 (void) __minval (result, source, dimp, mask, 0, DVSUBTYPE_INT32, 00533 USE_INT1); 00534 #endif 00535 } 00536 00537 void 00538 _MINVAL__I1 ( DopeVectorType * result, 00539 DopeVectorType * source, 00540 DopeVectorType * dimp, 00541 DopeVectorType * mask) 00542 { 00543 void __minval(); 00544 DopeVectorType *dm, *mk; 00545 _f_int *dimenp = NULL; 00546 _f_int dimenlc = 0; 00547 LOAD_DM_MK(); 00548 #ifndef _F_INT4 00549 (void) __minval (result, source, dimenp, mk, 0, DVSUBTYPE_INT46, 00550 USE_INT1); 00551 #else 00552 (void) __minval (result, source, dimenp, mk, 0, DVSUBTYPE_INT32, 00553 USE_INT1); 00554 #endif 00555 } 00556 00557 #ifdef _UNICOS 00558 #pragma _CRI duplicate _MINVAL0_I4 as MINVAL0_I4@ 00559 #endif 00560 _f_int4 00561 _MINVAL0_I4 ( DopeVectorType * source, 00562 _f_int * dimp, 00563 DopeVectorType * mask) 00564 { 00565 void __minval(); 00566 int i = 1; 00567 _f_int4 i4; 00568 DopeVectorType result, *res_ptr; 00569 00570 i4 = (_f_int4) HUGE_INT4_F90; 00571 res_ptr = (DopeVectorType *) &result; 00572 res_ptr->assoc = 1; 00573 res_ptr->base_addr.a.ptr = (_f_int4 *) &i4; 00574 res_ptr->base_addr.a.el_len = source->base_addr.a.el_len; 00575 res_ptr->ptr_alloc = 0; 00576 res_ptr->p_or_a = NOT_P_OR_A; 00577 res_ptr->n_dim = 0; 00578 res_ptr->type_lens.type = DVTYPE_INTEGER; 00579 res_ptr->type_lens.dpflag = source->type_lens.dpflag; 00580 res_ptr->type_lens.kind_or_star = source->type_lens.kind_or_star; 00581 res_ptr->type_lens.int_len = source->type_lens.int_len; 00582 res_ptr->type_lens.dec_len = source->type_lens.dec_len; 00583 res_ptr->orig_base = (_f_int4 *) NULL; 00584 res_ptr->orig_size = 0; 00585 #ifndef _F_INT4 00586 __minval (res_ptr, source, dimp, mask, 1, DVSUBTYPE_INT46, 00587 USE_INT4); 00588 #else 00589 __minval (res_ptr, source, dimp, mask, 1, DVSUBTYPE_INT32, 00590 USE_INT4); 00591 #endif 00592 return (*(_f_int4 *) res_ptr->base_addr.a.ptr); 00593 } 00594 00595 _f_int4 00596 _MINVAL0__I4 ( DopeVectorType * source, 00597 DopeVectorType * dimp, 00598 DopeVectorType * mask) 00599 { 00600 void __minval(); 00601 int i = 1; 00602 _f_int4 i4; 00603 DopeVectorType result, *res_ptr; 00604 DopeVectorType *dm, *mk; 00605 _f_int *dimenp = NULL; 00606 _f_int dimenlc = 0; 00607 00608 LOAD_DM_MK(); 00609 i4 = (_f_int4) HUGE_INT4_F90; 00610 res_ptr = (DopeVectorType *) &result; 00611 res_ptr->assoc = 1; 00612 res_ptr->base_addr.a.ptr = (_f_int4 *) &i4; 00613 res_ptr->base_addr.a.el_len = source->base_addr.a.el_len; 00614 res_ptr->ptr_alloc = 0; 00615 res_ptr->p_or_a = NOT_P_OR_A; 00616 res_ptr->n_dim = 0; 00617 res_ptr->type_lens.type = DVTYPE_INTEGER; 00618 res_ptr->type_lens.dpflag = source->type_lens.dpflag; 00619 res_ptr->type_lens.kind_or_star = source->type_lens.kind_or_star; 00620 res_ptr->type_lens.int_len = source->type_lens.int_len; 00621 res_ptr->type_lens.dec_len = source->type_lens.dec_len; 00622 res_ptr->orig_base = (_f_int4 *) NULL; 00623 res_ptr->orig_size = 0; 00624 #ifndef _F_INT4 00625 __minval (res_ptr, source, dimenp, mk, 1, DVSUBTYPE_INT46, 00626 USE_INT4); 00627 #else 00628 __minval (res_ptr, source, dimenp, mk, 1, DVSUBTYPE_INT32, 00629 USE_INT4); 00630 #endif 00631 return (*(_f_int4 *) res_ptr->base_addr.a.ptr); 00632 } 00633 00634 #ifdef _UNICOS 00635 #pragma _CRI duplicate _MINVAL0_I2 as MINVAL0_I2@ 00636 #endif 00637 _f_int2 00638 _MINVAL0_I2 ( DopeVectorType * source, 00639 _f_int * dimp, 00640 DopeVectorType * mask) 00641 { 00642 void __minval(); 00643 int i = 1; 00644 _f_int2 i2; 00645 DopeVectorType result, *res_ptr; 00646 00647 i2 = (_f_int2) HUGE_INT2_F90; 00648 res_ptr = (DopeVectorType *) &result; 00649 res_ptr->assoc = 1; 00650 res_ptr->base_addr.a.ptr = (_f_int2 *) &i2; 00651 res_ptr->base_addr.a.el_len = source->base_addr.a.el_len; 00652 res_ptr->ptr_alloc = 0; 00653 res_ptr->p_or_a = NOT_P_OR_A; 00654 res_ptr->n_dim = 0; 00655 res_ptr->type_lens.type = DVTYPE_INTEGER; 00656 res_ptr->type_lens.dpflag = source->type_lens.dpflag; 00657 res_ptr->type_lens.kind_or_star = source->type_lens.kind_or_star; 00658 res_ptr->type_lens.int_len = source->type_lens.int_len; 00659 res_ptr->type_lens.dec_len = source->type_lens.dec_len; 00660 res_ptr->orig_base = (_f_int2 *) NULL; 00661 res_ptr->orig_size = 0; 00662 #ifndef _F_INT4 00663 __minval (res_ptr, source, dimp, mask, 1, DVSUBTYPE_INT46, 00664 USE_INT2); 00665 #else 00666 __minval (res_ptr, source, dimp, mask, 1, DVSUBTYPE_INT32, 00667 USE_INT2); 00668 #endif 00669 return (*(_f_int2 *) res_ptr->base_addr.a.ptr); 00670 } 00671 00672 _f_int2 00673 _MINVAL0__I2 ( DopeVectorType * source, 00674 DopeVectorType * dimp, 00675 DopeVectorType * mask) 00676 { 00677 void __minval(); 00678 int i = 1; 00679 _f_int2 i2; 00680 DopeVectorType result, *res_ptr; 00681 DopeVectorType *dm, *mk; 00682 _f_int *dimenp = NULL; 00683 _f_int dimenlc = 0; 00684 00685 LOAD_DM_MK(); 00686 i2 = (_f_int2) HUGE_INT2_F90; 00687 res_ptr = (DopeVectorType *) &result; 00688 res_ptr->assoc = 1; 00689 res_ptr->base_addr.a.ptr = (_f_int2 *) &i2; 00690 res_ptr->base_addr.a.el_len = source->base_addr.a.el_len; 00691 res_ptr->ptr_alloc = 0; 00692 res_ptr->p_or_a = NOT_P_OR_A; 00693 res_ptr->n_dim = 0; 00694 res_ptr->type_lens.type = DVTYPE_INTEGER; 00695 res_ptr->type_lens.dpflag = source->type_lens.dpflag; 00696 res_ptr->type_lens.kind_or_star = source->type_lens.kind_or_star; 00697 res_ptr->type_lens.int_len = source->type_lens.int_len; 00698 res_ptr->type_lens.dec_len = source->type_lens.dec_len; 00699 res_ptr->orig_base = (_f_int2 *) NULL; 00700 res_ptr->orig_size = 0; 00701 #ifndef _F_INT4 00702 __minval (res_ptr, source, dimenp, mk, 1, DVSUBTYPE_INT46, 00703 USE_INT2); 00704 #else 00705 __minval (res_ptr, source, dimenp, mk, 1, DVSUBTYPE_INT32, 00706 USE_INT2); 00707 #endif 00708 return (*(_f_int2 *) res_ptr->base_addr.a.ptr); 00709 } 00710 00711 #ifdef _UNICOS 00712 #pragma _CRI duplicate _MINVAL0_I1 as MINVAL0_I1@ 00713 #endif 00714 _f_int1 00715 _MINVAL0_I1 ( DopeVectorType * source, 00716 _f_int * dimp, 00717 DopeVectorType * mask) 00718 { 00719 void __minval(); 00720 int i = 1; 00721 _f_int1 i1; 00722 DopeVectorType result, *res_ptr; 00723 00724 i1 = (_f_int1) HUGE_INT1_F90; 00725 res_ptr = (DopeVectorType *) &result; 00726 res_ptr->assoc = 1; 00727 res_ptr->base_addr.a.ptr = (_f_int1 *) &i1; 00728 res_ptr->base_addr.a.el_len = source->base_addr.a.el_len; 00729 res_ptr->ptr_alloc = 0; 00730 res_ptr->p_or_a = NOT_P_OR_A; 00731 res_ptr->n_dim = 0; 00732 res_ptr->type_lens.type = DVTYPE_INTEGER; 00733 res_ptr->type_lens.dpflag = source->type_lens.dpflag; 00734 res_ptr->type_lens.kind_or_star = source->type_lens.kind_or_star; 00735 res_ptr->type_lens.int_len = source->type_lens.int_len; 00736 res_ptr->type_lens.dec_len = source->type_lens.dec_len; 00737 res_ptr->orig_base = (_f_int1 *) NULL; 00738 res_ptr->orig_size = 0; 00739 #ifndef _F_INT4 00740 __minval (res_ptr, source, dimp, mask, 1, DVSUBTYPE_INT46, 00741 USE_INT1); 00742 #else 00743 __minval (res_ptr, source, dimp, mask, 1, DVSUBTYPE_INT32, 00744 USE_INT1); 00745 #endif 00746 return (*(_f_int1 *) res_ptr->base_addr.a.ptr); 00747 } 00748 00749 _f_int1 00750 _MINVAL0__I1 ( DopeVectorType * source, 00751 DopeVectorType * dimp, 00752 DopeVectorType * mask) 00753 { 00754 void __minval(); 00755 int i = 1; 00756 _f_int1 i1; 00757 DopeVectorType result, *res_ptr; 00758 DopeVectorType *dm, *mk; 00759 _f_int *dimenp = NULL; 00760 _f_int dimenlc = 0; 00761 00762 LOAD_DM_MK(); 00763 i1 = (_f_int1) HUGE_INT1_F90; 00764 res_ptr = (DopeVectorType *) &result; 00765 res_ptr->assoc = 1; 00766 res_ptr->base_addr.a.ptr = (_f_int1 *) &i1; 00767 res_ptr->base_addr.a.el_len = source->base_addr.a.el_len; 00768 res_ptr->ptr_alloc = 0; 00769 res_ptr->p_or_a = NOT_P_OR_A; 00770 res_ptr->n_dim = 0; 00771 res_ptr->type_lens.type = DVTYPE_INTEGER; 00772 res_ptr->type_lens.dpflag = source->type_lens.dpflag; 00773 res_ptr->type_lens.kind_or_star = source->type_lens.kind_or_star; 00774 res_ptr->type_lens.int_len = source->type_lens.int_len; 00775 res_ptr->type_lens.dec_len = source->type_lens.dec_len; 00776 res_ptr->orig_base = (_f_int1 *) NULL; 00777 res_ptr->orig_size = 0; 00778 #ifndef _F_INT4 00779 __minval (res_ptr, source, dimenp, mk, 1, DVSUBTYPE_INT46, 00780 USE_INT1); 00781 #else 00782 __minval (res_ptr, source, dimenp, mk, 1, DVSUBTYPE_INT32, 00783 USE_INT1); 00784 #endif 00785 return (*(_f_int1 *) res_ptr->base_addr.a.ptr); 00786 } 00787 00788 #ifdef _UNICOS 00789 #pragma _CRI duplicate _MINVAL_S4 as MINVAL_S4@ 00790 #endif 00791 void 00792 _MINVAL_S4 ( DopeVectorType * result, 00793 DopeVectorType * source, 00794 _f_int * dimp, 00795 DopeVectorType * mask) 00796 { 00797 void __minval(); 00798 #ifndef _F_REAL4 00799 (void) __minval (result, source, dimp, mask, 0, DVSUBTYPE_REAL64, 00800 USE_REAL4); 00801 #else 00802 (void) __minval (result, source, dimp, mask, 0, DVSUBTYPE_REAL32, 00803 USE_REAL4); 00804 #endif 00805 } 00806 00807 void 00808 _MINVAL__S4 ( DopeVectorType * result, 00809 DopeVectorType * source, 00810 DopeVectorType * dimp, 00811 DopeVectorType * mask) 00812 { 00813 void __minval(); 00814 DopeVectorType *dm, *mk; 00815 _f_int *dimenp = NULL; 00816 _f_int dimenlc = 0; 00817 LOAD_DM_MK(); 00818 #ifndef _F_REAL4 00819 (void) __minval (result, source, dimenp, mk, 0, DVSUBTYPE_REAL64, 00820 USE_REAL4); 00821 #else 00822 (void) __minval (result, source, dimenp, mk, 0, DVSUBTYPE_REAL32, 00823 USE_REAL4); 00824 #endif 00825 } 00826 00827 #ifdef _UNICOS 00828 #pragma _CRI duplicate _MINVAL0_S4 as MINVAL0_S4@ 00829 #endif 00830 _f_real4 00831 _MINVAL0_S4 ( DopeVectorType * source, 00832 _f_int * dimp, 00833 DopeVectorType * mask) 00834 { 00835 void __minval(); 00836 int i = 1; 00837 _f_real4 s4; 00838 DopeVectorType result, *res_ptr; 00839 00840 s4 = (_f_real4) HUGE_REAL4_F90; 00841 res_ptr = (DopeVectorType *) &result; 00842 res_ptr->assoc = 1; 00843 res_ptr->base_addr.a.ptr = (_f_real4 *) &s4; 00844 res_ptr->base_addr.a.el_len = source->base_addr.a.el_len; 00845 res_ptr->ptr_alloc = 0; 00846 res_ptr->p_or_a = NOT_P_OR_A; 00847 res_ptr->n_dim = 0; 00848 res_ptr->type_lens.type = DVTYPE_REAL; 00849 res_ptr->type_lens.dpflag = source->type_lens.dpflag; 00850 res_ptr->type_lens.kind_or_star = source->type_lens.kind_or_star; 00851 res_ptr->type_lens.int_len = source->type_lens.int_len; 00852 res_ptr->type_lens.dec_len = source->type_lens.dec_len; 00853 res_ptr->orig_base = (_f_real4 *) NULL; 00854 res_ptr->orig_size = 0; 00855 #ifndef _F_REAL4 00856 __minval (res_ptr, source, dimp, mask, 1, DVSUBTYPE_REAL64, 00857 USE_REAL4); 00858 #else 00859 __minval (res_ptr, source, dimp, mask, 1, DVSUBTYPE_REAL32, 00860 USE_REAL4); 00861 #endif 00862 return(*(_f_real4 *) res_ptr->base_addr.a.ptr); 00863 } 00864 00865 _f_real4 00866 _MINVAL0__S4 ( DopeVectorType * source, 00867 DopeVectorType * dimp, 00868 DopeVectorType * mask) 00869 { 00870 void __minval(); 00871 int i = 1; 00872 _f_real4 s4; 00873 DopeVectorType result, *res_ptr; 00874 DopeVectorType *dm, *mk; 00875 _f_int *dimenp = NULL; 00876 _f_int dimenlc = 0; 00877 00878 LOAD_DM_MK(); 00879 s4 = (_f_real4) HUGE_REAL4_F90; 00880 res_ptr = (DopeVectorType *) &result; 00881 res_ptr->assoc = 1; 00882 res_ptr->base_addr.a.ptr = (_f_real4 *) &s4; 00883 res_ptr->base_addr.a.el_len = source->base_addr.a.el_len; 00884 res_ptr->ptr_alloc = 0; 00885 res_ptr->p_or_a = NOT_P_OR_A; 00886 res_ptr->n_dim = 0; 00887 res_ptr->type_lens.type = DVTYPE_REAL; 00888 res_ptr->type_lens.dpflag = source->type_lens.dpflag; 00889 res_ptr->type_lens.kind_or_star = source->type_lens.kind_or_star; 00890 res_ptr->type_lens.int_len = source->type_lens.int_len; 00891 res_ptr->type_lens.dec_len = source->type_lens.dec_len; 00892 res_ptr->orig_base = (_f_real4 *) NULL; 00893 res_ptr->orig_size = 0; 00894 #ifndef _F_REAL4 00895 __minval (res_ptr, source, dimenp, mk, 1, DVSUBTYPE_REAL64, 00896 USE_REAL4); 00897 #else 00898 __minval (res_ptr, source, dimenp, mk, 1, DVSUBTYPE_REAL32, 00899 USE_REAL4); 00900 #endif 00901 return(*(_f_real4 *) res_ptr->base_addr.a.ptr); 00902 } 00903 00904 #ifdef _UNICOS 00905 #pragma _CRI duplicate _MINVAL0_J as MINVAL0_J@ 00906 #endif 00907 _f_int8 00908 _MINVAL0_J ( DopeVectorType * source, 00909 _f_int * dimp, 00910 DopeVectorType * mask) 00911 { 00912 void __minval(); 00913 int i = 1; 00914 _f_int8 i8; 00915 DopeVectorType result, *res_ptr; 00916 00917 i8 = (_f_int8) HUGE_INT8_F90; 00918 res_ptr = (DopeVectorType *) &result; 00919 res_ptr->assoc = 1; 00920 res_ptr->base_addr.a.ptr = (_f_int8 *) &i8; 00921 res_ptr->base_addr.a.el_len = source->base_addr.a.el_len; 00922 res_ptr->ptr_alloc = 0; 00923 res_ptr->p_or_a = NOT_P_OR_A; 00924 res_ptr->n_dim = 0; 00925 res_ptr->type_lens.type = DVTYPE_INTEGER; 00926 res_ptr->type_lens.dpflag = source->type_lens.dpflag; 00927 res_ptr->type_lens.kind_or_star = source->type_lens.kind_or_star; 00928 res_ptr->type_lens.int_len = source->type_lens.int_len; 00929 res_ptr->type_lens.dec_len = source->type_lens.dec_len; 00930 res_ptr->orig_base = (_f_int8 *) NULL; 00931 res_ptr->orig_size = 0; 00932 __minval (res_ptr, source, dimp, mask, 1, DVSUBTYPE_INT64, 00933 USE_INT8); 00934 return(*(_f_int8 *) res_ptr->base_addr.a.ptr); 00935 } 00936 00937 _f_int8 00938 _MINVAL0__J ( DopeVectorType * source, 00939 DopeVectorType * dimp, 00940 DopeVectorType * mask) 00941 { 00942 void __minval(); 00943 int i = 1; 00944 _f_int8 i8; 00945 DopeVectorType result, *res_ptr; 00946 DopeVectorType *dm, *mk; 00947 _f_int *dimenp = NULL; 00948 _f_int dimenlc = 0; 00949 00950 LOAD_DM_MK(); 00951 i8 = (_f_int8) HUGE_INT8_F90; 00952 res_ptr = (DopeVectorType *) &result; 00953 res_ptr->assoc = 1; 00954 res_ptr->base_addr.a.ptr = (_f_int8 *) &i8; 00955 res_ptr->base_addr.a.el_len = source->base_addr.a.el_len; 00956 res_ptr->ptr_alloc = 0; 00957 res_ptr->p_or_a = NOT_P_OR_A; 00958 res_ptr->n_dim = 0; 00959 res_ptr->type_lens.type = DVTYPE_INTEGER; 00960 res_ptr->type_lens.dpflag = source->type_lens.dpflag; 00961 res_ptr->type_lens.kind_or_star = source->type_lens.kind_or_star; 00962 res_ptr->type_lens.int_len = source->type_lens.int_len; 00963 res_ptr->type_lens.dec_len = source->type_lens.dec_len; 00964 res_ptr->orig_base = (_f_int8 *) NULL; 00965 res_ptr->orig_size = 0; 00966 __minval (res_ptr, source, dimenp, mk, 1, DVSUBTYPE_INT64, 00967 USE_INT8); 00968 return(*(_f_int8 *) res_ptr->base_addr.a.ptr); 00969 } 00970 00971 #ifdef _UNICOS 00972 #pragma _CRI duplicate _MINVAL0_S as MINVAL0_S@ 00973 #endif 00974 _f_real8 00975 _MINVAL0_S ( DopeVectorType * source, 00976 _f_int * dimp, 00977 DopeVectorType * mask) 00978 { 00979 void __minval(); 00980 int i = 1; 00981 _f_real8 s8; 00982 DopeVectorType result, *res_ptr; 00983 00984 s8 = (_f_real8) HUGE_REAL8_F90; 00985 res_ptr = (DopeVectorType *) &result; 00986 res_ptr->assoc = 1; 00987 res_ptr->base_addr.a.ptr = (_f_real8 *) &s8; 00988 res_ptr->base_addr.a.el_len = source->base_addr.a.el_len; 00989 res_ptr->ptr_alloc = 0; 00990 res_ptr->p_or_a = NOT_P_OR_A; 00991 res_ptr->n_dim = 0; 00992 res_ptr->type_lens.type = DVTYPE_REAL; 00993 res_ptr->type_lens.dpflag = source->type_lens.dpflag; 00994 res_ptr->type_lens.kind_or_star = source->type_lens.kind_or_star; 00995 res_ptr->type_lens.int_len = source->type_lens.int_len; 00996 res_ptr->type_lens.dec_len = source->type_lens.dec_len; 00997 res_ptr->orig_base = (_f_real8 *) NULL; 00998 res_ptr->orig_size = 0; 00999 __minval (res_ptr, source, dimp, mask, 1, DVSUBTYPE_REAL64, 01000 USE_REAL8); 01001 return(*(_f_real8 *) res_ptr->base_addr.a.ptr); 01002 } 01003 01004 _f_real8 01005 _MINVAL0__S ( DopeVectorType * source, 01006 DopeVectorType * dimp, 01007 DopeVectorType * mask) 01008 { 01009 void __minval(); 01010 int i = 1; 01011 _f_real8 s8; 01012 DopeVectorType result, *res_ptr; 01013 DopeVectorType *dm, *mk; 01014 _f_int *dimenp = NULL; 01015 _f_int dimenlc = 0; 01016 01017 LOAD_DM_MK(); 01018 s8 = (_f_real8) HUGE_REAL8_F90; 01019 res_ptr = (DopeVectorType *) &result; 01020 res_ptr->assoc = 1; 01021 res_ptr->base_addr.a.ptr = (_f_real8 *) &s8; 01022 res_ptr->base_addr.a.el_len = source->base_addr.a.el_len; 01023 res_ptr->ptr_alloc = 0; 01024 res_ptr->p_or_a = NOT_P_OR_A; 01025 res_ptr->n_dim = 0; 01026 res_ptr->type_lens.type = DVTYPE_REAL; 01027 res_ptr->type_lens.dpflag = source->type_lens.dpflag; 01028 res_ptr->type_lens.kind_or_star = source->type_lens.kind_or_star; 01029 res_ptr->type_lens.int_len = source->type_lens.int_len; 01030 res_ptr->type_lens.dec_len = source->type_lens.dec_len; 01031 res_ptr->orig_base = (_f_real8 *) NULL; 01032 res_ptr->orig_size = 0; 01033 __minval (res_ptr, source, dimenp, mk, 1, DVSUBTYPE_REAL64, 01034 USE_REAL8); 01035 return(*(_f_real8 *) res_ptr->base_addr.a.ptr); 01036 } 01037 01038 #if defined _F_REAL16 && _F_REAL16 != (-1) 01039 #ifdef _UNICOS 01040 #pragma _CRI duplicate _MINVAL0_D as MINVAL0_D@ 01041 #endif 01042 _f_real16 01043 _MINVAL0_D ( DopeVectorType * source, 01044 _f_int * dimp, 01045 DopeVectorType * mask) 01046 { 01047 void __minval(); 01048 int i = 1; 01049 _f_real16 s16; 01050 DopeVectorType result, *res_ptr; 01051 01052 s16 = (_f_real16) HUGE_REAL16_F90; 01053 res_ptr = (DopeVectorType *) &result; 01054 res_ptr->assoc = 1; 01055 res_ptr->base_addr.a.ptr = (_f_real16 *) &s16; 01056 res_ptr->base_addr.a.el_len = source->base_addr.a.el_len; 01057 res_ptr->ptr_alloc = 0; 01058 res_ptr->p_or_a = NOT_P_OR_A; 01059 res_ptr->n_dim = 0; 01060 res_ptr->type_lens.type = DVTYPE_REAL; 01061 res_ptr->type_lens.dpflag = source->type_lens.dpflag; 01062 res_ptr->type_lens.kind_or_star = source->type_lens.kind_or_star; 01063 res_ptr->type_lens.int_len = source->type_lens.int_len; 01064 res_ptr->type_lens.dec_len = source->type_lens.dec_len; 01065 res_ptr->orig_base = (_f_real16 *) NULL; 01066 res_ptr->orig_size = 0; 01067 __minval (res_ptr, source, dimp, mask, 1, DVSUBTYPE_REAL128, 01068 USE_REAL16); 01069 return(*(_f_real16 *) res_ptr->base_addr.a.ptr); 01070 } 01071 01072 _f_real16 01073 _MINVAL0__D ( DopeVectorType * source, 01074 DopeVectorType * dimp, 01075 DopeVectorType * mask) 01076 { 01077 void __minval(); 01078 int i = 1; 01079 _f_real16 s16; 01080 DopeVectorType result, *res_ptr; 01081 DopeVectorType *dm, *mk; 01082 _f_int *dimenp = NULL; 01083 _f_int dimenlc = 0; 01084 01085 LOAD_DM_MK(); 01086 s16 = (_f_real16) HUGE_REAL16_F90; 01087 res_ptr = (DopeVectorType *) &result; 01088 res_ptr->assoc = 1; 01089 res_ptr->base_addr.a.ptr = (_f_real16 *) &s16; 01090 res_ptr->base_addr.a.el_len = source->base_addr.a.el_len; 01091 res_ptr->ptr_alloc = 0; 01092 res_ptr->p_or_a = NOT_P_OR_A; 01093 res_ptr->n_dim = 0; 01094 res_ptr->type_lens.type = DVTYPE_REAL; 01095 res_ptr->type_lens.dpflag = source->type_lens.dpflag; 01096 res_ptr->type_lens.kind_or_star = source->type_lens.kind_or_star; 01097 res_ptr->type_lens.int_len = source->type_lens.int_len; 01098 res_ptr->type_lens.dec_len = source->type_lens.dec_len; 01099 res_ptr->orig_base = (_f_real16 *) NULL; 01100 res_ptr->orig_size = 0; 01101 __minval (res_ptr, source, dimenp, mk, 1, DVSUBTYPE_REAL128, 01102 USE_REAL16); 01103 return(*(_f_real16 *) res_ptr->base_addr.a.ptr); 01104 } 01105 #endif 01106 01107 void 01108 __minval ( DopeVectorType * result, 01109 DopeVectorType * source, 01110 _f_int * dimp, 01111 DopeVectorType * mask, 01112 int scalar, 01113 int subtype, 01114 int init_val) 01115 01116 { 01117 _f_int4 * restrict i4ptr1; /* 32-bit int */ 01118 _f_int4 * restrict i4ptr2; /* 32-bit int */ 01119 #ifdef _F_INT6 01120 _f_int6 * restrict i6ptr1; /* 46-bit int */ 01121 _f_int6 * restrict i6ptr2; /* 46-bit int */ 01122 #endif 01123 _f_int8 * restrict i8ptr1; /* 64-bit int */ 01124 _f_int8 * restrict i8ptr2; /* 64-bit int */ 01125 _f_real8 * restrict r8ptr1; /* 64-bit real */ 01126 _f_real8 * restrict r8ptr2; /* 64-bit real */ 01127 #if defined _F_REAL16 && _F_REAL16 != (-1) 01128 _f_real16 * restrict r16ptr1; /* 128-bit real */ 01129 _f_real16 * restrict r16ptr2; /* 128-bit real */ 01130 #endif 01131 _f_real4 * restrict r4ptr1; /* 32-bit real */ 01132 _f_real4 * restrict r4ptr2; /* 32-bit real */ 01133 _f_mask * restrict lptr; /* "logical" */ 01134 void * restrict sptr; /* source */ 01135 void * restrict rptr; /* result */ 01136 void * restrict mptr; /* mask */ 01137 _f_int dim; /* dimension to check */ 01138 _f_int bucketsize; /* size of elements */ 01139 long nbytes; /* number of bytes */ 01140 long sindx; /* source index */ 01141 long rindx; /* result index */ 01142 long mindx; /* mask index */ 01143 _f_int type; /* result type */ 01144 _f_int rank; /* rank of source matrix */ 01145 long src_ext[MAXDIM]; /* extents for source */ 01146 long src_strd[MAXDIM]; /* strides for source */ 01147 long src_off[MAXDIM]; /* offset */ 01148 long res_ext[MAXDIM]; /* extents for source */ 01149 long res_strd[MAXDIM]; /* strides for source */ 01150 long res_off[MAXDIM]; /* offset */ 01151 long msk_ext[MAXDIM]; /* extents for source */ 01152 long msk_strd[MAXDIM]; /* strides for source */ 01153 long msk_off[MAXDIM]; /* offset */ 01154 long curdim[MAXDIM]; /* current index counter */ 01155 long src_dim_ext; /* dim index extent */ 01156 long src_dim_strd; /* dim index stride */ 01157 long msk_dim_ext; /* dim index extent */ 01158 long msk_dim_strd; /* dim index stride */ 01159 long indx1_src; /* index for dim 1 of source */ 01160 long indx1_res; /* index for dim 1 of source */ 01161 long indx1_msk; /* index for dim 1 of source */ 01162 long tot_ext; /* total extent counter */ 01163 _f_int ndim; /* non_dim index */ 01164 _f_int first; /* first flag */ 01165 _f_int4 cur_mini4; /* current minimum value */ 01166 _f_int4 i32_result; /* scalar integer result */ 01167 _f_int4 use_int4; /* holder for default ret val */ 01168 #ifdef _F_INT6 01169 _f_int6 cur_mini; /* current minimum value */ 01170 _f_int6 i46_result; /* scalar integer result */ 01171 _f_int6 use_int6; /* holder for default ret val */ 01172 #endif 01173 _f_int8 cur_minj; /* current minimum value */ 01174 _f_int8 i64_result; /* scalar integer result */ 01175 _f_real8 cur_minf; /* current minimum value */ 01176 _f_real8 s64_result; /* scalar float result */ 01177 _f_real8 use_flt8; /* holder for default ret val */ 01178 #if defined _F_REAL16 && _F_REAL16 != (-1) 01179 _f_real16 cur_mind; /* current minimum value */ 01180 _f_real16 s128_result; /* scalar double result */ 01181 #endif 01182 _f_real4 cur_mins4; /* current minimum value */ 01183 _f_real4 s32_result; /* scalar integer result */ 01184 _f_int use_mask; /* use mask flag */ 01185 long i, j; /* index variables */ 01186 long mask_el_len; 01187 _f_int early_exit; /* early exit flag */ 01188 01189 /* 01190 * Set up local copies of the number of dimensions in the source 01191 * array (rank) and the source array data type (type). 01192 */ 01193 01194 type = source->type_lens.type; 01195 rank = source->n_dim; 01196 01197 /* 01198 * If any extent in any matrix has value 0, we can exit without doing 01199 * any work. 01200 */ 01201 01202 early_exit = 0; 01203 for (i = 0; i < rank; i++) { 01204 if (source->dimension[i].extent == 0) 01205 early_exit = 1; 01206 } 01207 if (result->assoc) { 01208 if (!scalar) { 01209 for (i = 0; i < result->n_dim; i++) { 01210 if (result->dimension[i].extent == 0) 01211 early_exit = 1; 01212 } 01213 } 01214 } 01215 if (mask) { 01216 for (i = 0; i < mask->n_dim; i++) { 01217 if (mask->dimension[i].extent == 0) 01218 early_exit = 1; 01219 } 01220 } 01221 01222 /* 01223 * Initialize every array element to 0. 01224 */ 01225 01226 #ifdef _UNICOS 01227 #pragma _CRI shortloop 01228 #endif 01229 for (i = 0; i < MAXDIM; i++) { 01230 curdim[i] = 0; 01231 src_ext[i] = 0; 01232 src_strd[i] = 0; 01233 src_off[i] = 0; 01234 res_ext[i] = 0; 01235 res_strd[i] = 0; 01236 res_off[i] = 0; 01237 msk_ext[i] = 0; 01238 msk_strd[i] = 0; 01239 msk_off[i] = 0; 01240 } 01241 01242 /* 01243 * Set up dim variable. It must be decremented by one to account 01244 * for the difference in reference between C and FORTRAN 01245 */ 01246 01247 if (dimp != NULL && rank > 0) { 01248 dim = *dimp - 1; 01249 if (dim < 0 || dim >= rank) 01250 _lerror (_LELVL_ABORT, FESCIDIM); 01251 } else { 01252 dim = 0; 01253 } 01254 01255 /* Set bucketsize scalar */ 01256 01257 bucketsize = source->type_lens.int_len / BITS_PER_WORD; 01258 #ifdef _CRAYMPP 01259 if (bucketsize == 0) 01260 bucketsize = 1; 01261 #endif 01262 01263 /* Set up dope vector for result array */ 01264 01265 if (!result->assoc) { 01266 result->base_addr.a.ptr = (void *) NULL; 01267 result->orig_base = 0; 01268 result->orig_size = 0; 01269 01270 tot_ext = bucketsize; 01271 nbytes = bucketsize * BYTES_PER_WORD; 01272 if (dimp == NULL || rank == 1) { 01273 result->n_dim = 0; 01274 } else { 01275 result->n_dim = rank - 1; 01276 for (i = 0; i < dim; i++) { 01277 result->dimension[i].extent = 01278 source->dimension[i].extent; 01279 result->dimension[i].low_bound = 1; 01280 result->dimension[i].stride_mult = tot_ext; 01281 tot_ext *= result->dimension[i].extent; 01282 nbytes *= result->dimension[i].extent; 01283 } 01284 for ( ; i < rank-1; i++) { 01285 result->dimension[i].extent = 01286 source->dimension[i+1].extent; 01287 result->dimension[i].low_bound = 1; 01288 result->dimension[i].stride_mult = tot_ext; 01289 tot_ext *= result->dimension[i].extent; 01290 nbytes *= result->dimension[i].extent; 01291 } 01292 } 01293 01294 if (!scalar) { 01295 if (nbytes > 0) { 01296 result->base_addr.a.ptr = (void *) malloc (nbytes); 01297 if (result->base_addr.a.ptr == NULL) 01298 _lerror (_LELVL_ABORT, FENOMEMY); 01299 } 01300 result->assoc = 1; 01301 } else { 01302 if (subtype == DVSUBTYPE_INT64) 01303 result->base_addr.a.ptr = (_f_int8 *) &i64_result; 01304 #ifdef _F_INT6 01305 else if (subtype == DVSUBTYPE_INT46) 01306 result->base_addr.a.ptr = (_f_int6 *) &i46_result; 01307 #endif 01308 else if (subtype == DVSUBTYPE_INT32) 01309 result->base_addr.a.ptr = (_f_int4 *) &i32_result; 01310 else if (subtype == DVSUBTYPE_REAL32) 01311 result->base_addr.a.ptr = (_f_real4 *) &s32_result; 01312 #if defined _F_REAL16 && _F_REAL16 != (-1) 01313 else if (subtype == DVSUBTYPE_REAL128) 01314 result->base_addr.a.ptr = (_f_real16 *) &s128_result; 01315 #endif 01316 else 01317 result->base_addr.a.ptr = (_f_real8 *) &s64_result; 01318 } 01319 result->base_addr.a.el_len = source->base_addr.a.el_len; 01320 result->orig_base = (void *) result->base_addr.a.ptr; 01321 result->orig_size = nbytes * BITS_PER_BYTE; 01322 } else { 01323 tot_ext = bucketsize; 01324 if (dimp == NULL || rank == 1) { 01325 for (i = 0; i < rank; i++) 01326 tot_ext *= source->dimension[i].extent; 01327 } else { 01328 for (i = 0; i < dim; i++) 01329 tot_ext *= source->dimension[i].extent; 01330 for ( ; i < rank-1; i++) 01331 tot_ext *= source->dimension[i].extent; 01332 } 01333 } 01334 01335 /* Set up scalar pointers to all of the argument data areas */ 01336 01337 sptr = (void *) source->base_addr.a.ptr; 01338 rptr = (void *) result->base_addr.a.ptr; 01339 if (mask) 01340 mptr = (void *) mask->base_addr.a.ptr; 01341 01342 /* 01343 * If mask is present as a scalar, and its value is false, we can 01344 * exit early. 01345 */ 01346 01347 if (mask) { 01348 mask_el_len = mask->base_addr.a.el_len; 01349 lptr = (_f_mask *) mptr; 01350 if (mask->n_dim == 0 && !LTOB(mask_el_len, &lptr[0])) 01351 early_exit = 1; 01352 else { 01353 if (mask->n_dim == 0) /* scalar true mask */ 01354 use_mask = 0; /* don't need to check */ 01355 else 01356 use_mask = 1; 01357 } 01358 } else { 01359 use_mask = 0; 01360 } 01361 01362 /* 01363 * If any of our pre-defined early exit conditions have been met, 01364 * we can exit now. 01365 */ 01366 01367 if (early_exit) { 01368 if (scalar) { 01369 if (subtype == DVSUBTYPE_INT64) { 01370 i8ptr2 = (_f_int8 *) rptr; 01371 i8ptr2[0] = HUGE_INT8_F90; 01372 #ifdef _F_INT6 01373 } else if (subtype == DVSUBTYPE_INT46) { 01374 i6ptr2 = (_f_int6 *) rptr; 01375 if (init_val == USE_INT6) 01376 i6ptr2[0] = HUGE_INT6_F90; 01377 else if (init_val == USE_INT4) 01378 i6ptr2[0] = HUGE_INT4_F90; 01379 else if (init_val == USE_INT2) 01380 i6ptr2[0] = HUGE_INT2_F90; 01381 else 01382 i6ptr2[0] = HUGE_INT1_F90; 01383 #else 01384 } else if (subtype == DVSUBTYPE_INT32) { 01385 i4ptr2 = (_f_int4 *) rptr; 01386 if (init_val == USE_INT4) 01387 i4ptr2[0] = HUGE_INT4_F90; 01388 else if (init_val == USE_INT2) 01389 i4ptr2[0] = HUGE_INT2_F90; 01390 else 01391 i4ptr2[0] = HUGE_INT1_F90; 01392 #endif 01393 #if defined _F_REAL16 && _F_REAL16 != (-1) 01394 } else if (subtype == DVSUBTYPE_REAL128) { 01395 r16ptr2 = (_f_real16 *) rptr; 01396 r16ptr2[0] = HUGE_REAL16_F90; 01397 #endif 01398 } else if (subtype == DVSUBTYPE_REAL32) { 01399 r4ptr2 = (_f_real4 *) rptr; 01400 r4ptr2[0] = HUGE_REAL4_F90; 01401 } else { 01402 r8ptr2 = (_f_real8 *) rptr; 01403 if (init_val == USE_REAL8) 01404 r8ptr2[0] = HUGE_REAL8_F90; 01405 else 01406 r8ptr2[0] = HUGE_REAL4_F90; 01407 } 01408 } else { 01409 for (i = 0; i < rank-1; i++) { 01410 res_strd[i] = result->dimension[i].stride_mult / bucketsize; 01411 res_ext[i] = result->dimension[i].extent; 01412 curdim[i] = 0; 01413 } 01414 rindx = 0; 01415 if (subtype == DVSUBTYPE_INT64) { 01416 i8ptr2 = (_f_int8 *) rptr; 01417 for (i = 0; i < tot_ext; i++) { 01418 i8ptr2[rindx] = HUGE_INT8_F90; 01419 INCR_RES(); 01420 } 01421 #ifdef _F_INT6 01422 } else if (subtype == DVSUBTYPE_INT46) { 01423 i6ptr2 = (_f_int6 *) rptr; 01424 if (init_val == USE_INT6) 01425 use_int6 = HUGE_INT6_F90; 01426 else if (init_val == USE_INT4) 01427 use_int6 = HUGE_INT4_F90; 01428 else if (init_val == USE_INT2) 01429 use_int6 = HUGE_INT2_F90; 01430 else 01431 use_int6 = HUGE_INT1_F90; 01432 for (i = 0; i < tot_ext; i++) { 01433 i6ptr2[rindx] = use_int6; 01434 INCR_RES(); 01435 } 01436 #endif 01437 } else if (subtype == DVSUBTYPE_INT32) { 01438 i4ptr2 = (_f_int4 *) rptr; 01439 if (init_val == USE_INT4) 01440 use_int4 = HUGE_INT4_F90; 01441 else if (init_val == USE_INT2) 01442 use_int4 = HUGE_INT2_F90; 01443 else 01444 use_int4 = HUGE_INT1_F90; 01445 for (i = 0; i < tot_ext; i++) { 01446 i4ptr2[rindx] = use_int4; 01447 INCR_RES(); 01448 } 01449 #if defined _F_REAL16 && _F_REAL16 != (-1) 01450 } else if (subtype == DVSUBTYPE_REAL128) { 01451 r16ptr2 = (_f_real16 *) rptr; 01452 for (i = 0; i < tot_ext; i++) { 01453 r16ptr2[rindx] = HUGE_REAL16_F90; 01454 INCR_RES(); 01455 } 01456 #endif 01457 } else if (subtype == DVSUBTYPE_REAL32) { 01458 r4ptr2 = (_f_real4 *) rptr; 01459 for (i = 0; i < tot_ext; i++) { 01460 r4ptr2[rindx] = HUGE_REAL4_F90; 01461 INCR_RES(); 01462 } 01463 } else { 01464 r8ptr2 = (_f_real8 *) rptr; 01465 if (init_val == USE_REAL8) 01466 use_flt8 = HUGE_REAL8_F90; 01467 else 01468 use_flt8 = HUGE_REAL4_F90; 01469 for (i = 0; i < tot_ext; i++) { 01470 r8ptr2[rindx] = use_flt8; 01471 INCR_RES(); 01472 } 01473 } 01474 } 01475 return; 01476 } 01477 01478 if (rank == 1) { 01479 if (bucketsize > 1) 01480 src_strd[0] = source->dimension[0].stride_mult / bucketsize; 01481 else 01482 src_strd[0] = source->dimension[0].stride_mult; 01483 src_ext[0] = source->dimension[0].extent; 01484 if (use_mask) { 01485 if (mask->n_dim > 0) { 01486 msk_strd[0] = mask->dimension[0].stride_mult; 01487 #ifdef _CRAYMPP 01488 if (mask_el_len == 64 && sizeof(lptr[0]) == 4) 01489 msk_strd[0] <<= 1; 01490 #endif 01491 } else 01492 msk_strd[0] = 0; 01493 } 01494 01495 switch (subtype) { 01496 #ifdef _F_INT6 01497 case DVSUBTYPE_INT46 : 01498 i6ptr1 = (_f_int6 *) sptr; 01499 i6ptr2 = (_f_int6 *) rptr; 01500 if (init_val == USE_INT6) 01501 i6ptr2[0] = HUGE_INT6_F90; 01502 else if (init_val == USE_INT4) 01503 i6ptr2[0] = HUGE_INT4_F90; 01504 else if (init_val == USE_INT2) 01505 i6ptr2[0] = HUGE_INT2_F90; 01506 else 01507 i6ptr2[0] = HUGE_INT1_F90; 01508 if (use_mask) { 01509 lptr = (_f_mask *) mptr; 01510 for (i = 0; i < src_ext[0]; i++) { 01511 mindx = i * msk_strd[0]; 01512 if (LTOB(mask_el_len, &lptr[mindx])) { 01513 sindx = i * src_strd[0]; 01514 if (i6ptr1[sindx] < i6ptr2[0]) 01515 i6ptr2[0] = i6ptr1[sindx]; 01516 } 01517 } 01518 } else { 01519 for (i = 0; i < src_ext[0]; i++) { 01520 sindx = i * src_strd[0]; 01521 if (i6ptr1[sindx] < i6ptr2[0]) 01522 i6ptr2[0] = i6ptr1[sindx]; 01523 } 01524 } 01525 break; 01526 #endif 01527 01528 case DVSUBTYPE_INT32 : 01529 i4ptr1 = (_f_int4 *) sptr; 01530 i4ptr2 = (_f_int4 *) rptr; 01531 if (use_mask) { 01532 lptr = (_f_mask *) mptr; 01533 if (init_val == USE_INT4) 01534 i4ptr2[0] = HUGE_INT4_F90; 01535 else if (init_val == USE_INT2) 01536 i4ptr2[0] = HUGE_INT2_F90; 01537 else 01538 i4ptr2[0] = HUGE_INT1_F90; 01539 for (i = 0; i < src_ext[0]; i++) { 01540 mindx = i * msk_strd[0]; 01541 if (LTOB(mask_el_len, &lptr[mindx])) { 01542 sindx = i * src_strd[0]; 01543 i4ptr2[0] = i4ptr1[sindx]; 01544 break; 01545 } 01546 } 01547 for ( ; i < src_ext[0]; i++) { 01548 mindx = i * msk_strd[0]; 01549 if (LTOB(mask_el_len, &lptr[mindx])) { 01550 sindx = i * src_strd[0]; 01551 if ((i4ptr1[sindx]^i4ptr2[0]) >= 0) { 01552 if (i4ptr1[sindx] < i4ptr2[0]) 01553 i4ptr2[0] = i4ptr1[sindx]; 01554 } else { 01555 if (i4ptr1[sindx] < 0) 01556 i4ptr2[0] = i4ptr1[sindx]; 01557 } 01558 } 01559 } 01560 } else { 01561 i4ptr2[0] = i4ptr1[0]; 01562 for (i = 1; i < src_ext[0]; i++) { 01563 sindx = i * src_strd[0]; 01564 if ((i4ptr1[sindx]^i4ptr2[0]) >= 0) { 01565 if (i4ptr1[sindx] < i4ptr2[0]) 01566 i4ptr2[0] = i4ptr1[sindx]; 01567 } else { 01568 if (i4ptr1[sindx] < 0) 01569 i4ptr2[0] = i4ptr1[sindx]; 01570 } 01571 } 01572 } 01573 break; 01574 01575 case DVSUBTYPE_INT64 : 01576 i8ptr1 = (_f_int8 *) sptr; 01577 i8ptr2 = (_f_int8 *) rptr; 01578 if (use_mask) { 01579 lptr = (_f_mask *) mptr; 01580 i8ptr2[0] = HUGE_INT8_F90; 01581 for (i = 0; i < src_ext[0]; i++) { 01582 mindx = i * msk_strd[0]; 01583 if (LTOB(mask_el_len, &lptr[mindx])) { 01584 sindx = i * src_strd[0]; 01585 i8ptr2[0] = i8ptr1[sindx]; 01586 break; 01587 } 01588 } 01589 for ( ; i < src_ext[0]; i++) { 01590 mindx = i * msk_strd[0]; 01591 if (LTOB(mask_el_len, &lptr[mindx])) { 01592 sindx = i * src_strd[0]; 01593 if ((i8ptr1[sindx]^i8ptr2[0]) >= 0) { 01594 if (i8ptr1[sindx] < i8ptr2[0]) 01595 i8ptr2[0] = i8ptr1[sindx]; 01596 } else { 01597 if (i8ptr1[sindx] < 0) 01598 i8ptr2[0] = i8ptr1[sindx]; 01599 } 01600 } 01601 } 01602 } else { 01603 i8ptr2[0] = i8ptr1[0]; 01604 for (i = 1; i < src_ext[0]; i++) { 01605 sindx = i * src_strd[0]; 01606 if ((i8ptr1[sindx]^i8ptr2[0]) >= 0) { 01607 if (i8ptr1[sindx] < i8ptr2[0]) 01608 i8ptr2[0] = i8ptr1[sindx]; 01609 } else { 01610 if (i8ptr1[sindx] < 0) 01611 i8ptr2[0] = i8ptr1[sindx]; 01612 } 01613 } 01614 } 01615 break; 01616 01617 case DVSUBTYPE_REAL64 : 01618 r8ptr1 = (_f_real8 *) sptr; 01619 r8ptr2 = (_f_real8 *) rptr; 01620 if (init_val == USE_REAL8) 01621 r8ptr2[0] = HUGE_REAL8_F90; 01622 else 01623 r8ptr2[0] = HUGE_REAL4_F90; 01624 if (use_mask) { 01625 lptr = (_f_mask *) mptr; 01626 for (i = 0; i < src_ext[0]; i++) { 01627 mindx = i * msk_strd[0]; 01628 if (LTOB(mask_el_len, &lptr[mindx])) { 01629 sindx = i * src_strd[0]; 01630 if (r8ptr1[sindx] < r8ptr2[0]) 01631 r8ptr2[0] = r8ptr1[sindx]; 01632 } 01633 } 01634 } else { 01635 for (i = 0; i < src_ext[0]; i++) { 01636 sindx = i * src_strd[0]; 01637 if (r8ptr1[sindx] < r8ptr2[0]) 01638 r8ptr2[0] = r8ptr1[sindx]; 01639 } 01640 } 01641 break; 01642 01643 case DVSUBTYPE_REAL32 : 01644 r4ptr1 = (_f_real4 *) sptr; 01645 r4ptr2 = (_f_real4 *) rptr; 01646 r4ptr2[0] = HUGE_REAL4_F90; 01647 if (use_mask) { 01648 lptr = (_f_mask *) mptr; 01649 for (i = 0; i < src_ext[0]; i++) { 01650 mindx = i * msk_strd[0]; 01651 if (LTOB(mask_el_len, &lptr[mindx])) { 01652 sindx = i * src_strd[0]; 01653 if (r4ptr1[sindx] < r4ptr2[0]) 01654 r4ptr2[0] = r4ptr1[sindx]; 01655 } 01656 } 01657 } else { 01658 for (i = 0; i < src_ext[0]; i++) { 01659 sindx = i * src_strd[0]; 01660 if (r4ptr1[sindx] < r4ptr2[0]) 01661 r4ptr2[0] = r4ptr1[sindx]; 01662 } 01663 } 01664 break; 01665 01666 #if defined _F_REAL16 && _F_REAL16 != (-1) 01667 case DVSUBTYPE_REAL128 : 01668 r16ptr1 = (_f_real16 *) sptr; 01669 r16ptr2 = (_f_real16 *) rptr; 01670 r16ptr2[0] = HUGE_REAL16_F90; 01671 if (use_mask) { 01672 lptr = (_f_mask *) mptr; 01673 for (i = 0; i < src_ext[0]; i++) { 01674 mindx = i * msk_strd[0]; 01675 if (LTOB(mask_el_len, &lptr[mindx])) { 01676 sindx = i * src_strd[0]; 01677 if (r16ptr1[sindx] < r16ptr2[0]) 01678 r16ptr2[0] = r16ptr1[sindx]; 01679 } 01680 } 01681 } else { 01682 for (i = 0; i < src_ext[0]; i++) { 01683 sindx = i * src_strd[0]; 01684 if (r16ptr1[sindx] < r16ptr2[0]) 01685 r16ptr2[0] = r16ptr1[sindx]; 01686 } 01687 } 01688 break; 01689 #endif 01690 01691 default : 01692 _lerror (_LELVL_ABORT, FEINTDTY); 01693 } 01694 01695 } else if (rank == 2) { 01696 if (bucketsize > 1) { 01697 src_strd[0] = source->dimension[0].stride_mult / bucketsize; 01698 src_strd[1] = source->dimension[1].stride_mult / bucketsize; 01699 } else { 01700 src_strd[0] = source->dimension[0].stride_mult; 01701 src_strd[1] = source->dimension[1].stride_mult; 01702 } 01703 src_ext[0] = source->dimension[0].extent; 01704 src_ext[1] = source->dimension[1].extent; 01705 if (use_mask) { 01706 if (mask->n_dim > 0) { 01707 msk_strd[0] = mask->dimension[0].stride_mult; 01708 msk_strd[1] = mask->dimension[1].stride_mult; 01709 #ifdef _CRAYMPP 01710 if (mask_el_len == 64 && sizeof(lptr[0]) == 4) { 01711 msk_strd[0] <<= 1; 01712 msk_strd[1] <<= 1; 01713 } 01714 #endif 01715 msk_ext[0] = mask->dimension[0].extent; 01716 msk_ext[1] = mask->dimension[1].extent; 01717 } else { 01718 msk_strd[0] = 0; 01719 msk_strd[1] = 0; 01720 msk_ext[0] = 0; 01721 msk_ext[1] = 0; 01722 } 01723 } 01724 01725 if (scalar) { 01726 dim = 0; 01727 ndim = 1; 01728 } else { 01729 res_ext[0] = result->dimension[0].extent; 01730 if (bucketsize > 1) 01731 res_strd[0] = result->dimension[0].stride_mult / bucketsize; 01732 else 01733 res_strd[0] = result->dimension[0].stride_mult; 01734 if (dim == 0) 01735 ndim = 1; 01736 else 01737 ndim = 0; 01738 } 01739 01740 switch (subtype) { 01741 #ifdef _F_INT6 01742 case DVSUBTYPE_INT46 : 01743 i6ptr2 = (_f_int6 *) rptr; 01744 if (init_val == USE_INT6) 01745 cur_mini = HUGE_INT6_F90; 01746 else if (init_val == USE_INT4) 01747 cur_mini = HUGE_INT4_F90; 01748 else if (init_val == USE_INT2) 01749 cur_mini = HUGE_INT2_F90; 01750 else 01751 cur_mini = HUGE_INT1_F90; 01752 use_int6 = cur_mini; 01753 if (use_mask) { 01754 i6ptr1 = (_f_int6 *) sptr; 01755 lptr = (_f_mask *) mptr; 01756 for (i = 0; i < src_ext[ndim]; i++) { 01757 indx1_src = i * src_strd[ndim]; 01758 indx1_msk = i * msk_strd[ndim]; 01759 for (j = 0; j < src_ext[dim]; j++) { 01760 mindx = indx1_msk + (j * msk_strd[dim]); 01761 if (LTOB(mask_el_len, &lptr[mindx])) { 01762 sindx = indx1_src + (j * src_strd[dim]); 01763 if (i6ptr1[sindx] < cur_mini) 01764 cur_mini = i6ptr1[sindx]; 01765 } 01766 } 01767 if (!scalar) { 01768 rindx = i * res_strd[0]; 01769 i6ptr2[rindx] = cur_mini; 01770 cur_mini = use_int6; 01771 } 01772 } 01773 } else { 01774 i6ptr1 = (_f_int6 *) sptr; 01775 for (i = 0; i < src_ext[ndim]; i++) { 01776 indx1_src = i * src_strd[ndim]; 01777 for (j = 0; j < src_ext[dim]; j++) { 01778 sindx = indx1_src + (j * src_strd[dim]); 01779 if (i6ptr1[sindx] < cur_mini) 01780 cur_mini = i6ptr1[sindx]; 01781 } 01782 if (!scalar) { 01783 rindx = i * res_strd[0]; 01784 i6ptr2[rindx] = cur_mini; 01785 cur_mini = use_int6; 01786 } 01787 } 01788 } 01789 if (scalar) 01790 i6ptr2[0] = cur_mini; 01791 break; 01792 #endif 01793 01794 case DVSUBTYPE_INT32 : 01795 i4ptr2 = (_f_int4 *) rptr; 01796 if (init_val == USE_INT4) 01797 cur_mini4 = HUGE_INT4_F90; 01798 else if (init_val == USE_INT2) 01799 cur_mini4 = HUGE_INT2_F90; 01800 else 01801 cur_mini4 = HUGE_INT1_F90; 01802 use_int4 = cur_mini4; 01803 if (use_mask) { 01804 i4ptr1 = (_f_int4 *) sptr; 01805 lptr = (_f_mask *) mptr; 01806 first = 1; 01807 for (i = 0; i < src_ext[ndim]; i++) { 01808 indx1_src = i * src_strd[ndim]; 01809 indx1_msk = i * msk_strd[ndim]; 01810 for (j = 0; j < src_ext[dim]; j++) { 01811 mindx = indx1_msk + (j * msk_strd[dim]); 01812 if (LTOB(mask_el_len, &lptr[mindx])) { 01813 sindx = indx1_src + (j * src_strd[dim]); 01814 if (!first) { 01815 if ((i4ptr1[sindx]^cur_mini4) >= 0) { 01816 if (i4ptr1[sindx] < cur_mini4) 01817 cur_mini4 = i4ptr1[sindx]; 01818 } else { 01819 if (i4ptr1[sindx] < 0) 01820 cur_mini4 = i4ptr1[sindx]; 01821 } 01822 } else { 01823 cur_mini4 = i4ptr1[sindx]; 01824 first = 0; 01825 } 01826 } 01827 } 01828 if (!scalar) { 01829 rindx = i * res_strd[0]; 01830 i4ptr2[rindx] = cur_mini4; 01831 cur_mini4 = use_int4; 01832 first = 1; 01833 } 01834 } 01835 } else { 01836 i4ptr1 = (_f_int4 *) sptr; 01837 first = 1; 01838 for (i = 0; i < src_ext[ndim]; i++) { 01839 indx1_src = i * src_strd[ndim]; 01840 for (j = 0; j < src_ext[dim]; j++) { 01841 sindx = indx1_src + (j * src_strd[dim]); 01842 if (!first) { 01843 if ((i4ptr1[sindx]^cur_mini4) >= 0) { 01844 if (i4ptr1[sindx] < cur_mini4) 01845 cur_mini4 = i4ptr1[sindx]; 01846 } else { 01847 if (i4ptr1[sindx] < 0) 01848 cur_mini4 = i4ptr1[sindx]; 01849 } 01850 } else { 01851 cur_mini4 = i4ptr1[sindx]; 01852 first = 0; 01853 } 01854 } 01855 if (!scalar) { 01856 rindx = i * res_strd[0]; 01857 i4ptr2[rindx] = cur_mini4; 01858 cur_mini4 = use_int4; 01859 first = 1; 01860 } 01861 } 01862 } 01863 if (scalar) 01864 i4ptr2[0] = cur_mini4; 01865 break; 01866 01867 case DVSUBTYPE_INT64 : 01868 i8ptr2 = (_f_int8 *) rptr; 01869 if (use_mask) { 01870 cur_minj = HUGE_INT8_F90; 01871 i8ptr1 = (_f_int8 *) sptr; 01872 lptr = (_f_mask *) mptr; 01873 first = 1; 01874 for (i = 0; i < src_ext[ndim]; i++) { 01875 indx1_src = i * src_strd[ndim]; 01876 indx1_msk = i * msk_strd[ndim]; 01877 for (j = 0; j < src_ext[dim]; j++) { 01878 mindx = indx1_msk + (j * msk_strd[dim]); 01879 if (LTOB(mask_el_len, &lptr[mindx])) { 01880 sindx = indx1_src + (j * src_strd[dim]); 01881 if (!first) { 01882 if ((i8ptr1[sindx]^cur_minj) >= 0) { 01883 if (i8ptr1[sindx] < cur_minj) 01884 cur_minj = i8ptr1[sindx]; 01885 } else { 01886 if (i8ptr1[sindx] < 0) 01887 cur_minj = i8ptr1[sindx]; 01888 } 01889 } else { 01890 cur_minj = i8ptr1[sindx]; 01891 first = 0; 01892 } 01893 } 01894 } 01895 if (!scalar) { 01896 rindx = i * res_strd[0]; 01897 i8ptr2[rindx] = cur_minj; 01898 cur_minj = HUGE_INT8_F90; 01899 first = 1; 01900 } 01901 } 01902 } else { 01903 i8ptr1 = (_f_int8 *) sptr; 01904 first = 1; 01905 for (i = 0; i < src_ext[ndim]; i++) { 01906 indx1_src = i * src_strd[ndim]; 01907 for (j = 0; j < src_ext[dim]; j++) { 01908 sindx = indx1_src + (j * src_strd[dim]); 01909 if (!first) { 01910 if ((i8ptr1[sindx]^cur_minj) >= 0) { 01911 if (i8ptr1[sindx] < cur_minj) 01912 cur_minj = i8ptr1[sindx]; 01913 } else { 01914 if (i8ptr1[sindx] < 0) 01915 cur_minj = i8ptr1[sindx]; 01916 } 01917 } else { 01918 cur_minj = i8ptr1[sindx]; 01919 first = 0; 01920 } 01921 } 01922 if (!scalar) { 01923 rindx = i * res_strd[0]; 01924 i8ptr2[rindx] = cur_minj; 01925 cur_minj = HUGE_INT8_F90; 01926 first = 1; 01927 } 01928 } 01929 } 01930 if (scalar) 01931 i8ptr2[0] = cur_minj; 01932 break; 01933 01934 case DVSUBTYPE_REAL64 : 01935 r8ptr2 = (_f_real8 *) rptr; 01936 if (init_val == USE_REAL8) 01937 cur_minf = HUGE_REAL8_F90; 01938 else 01939 cur_minf = HUGE_REAL4_F90; 01940 use_flt8 = cur_minf; 01941 if (use_mask) { 01942 r8ptr1 = (_f_real8 *) sptr; 01943 lptr = (_f_mask *) mptr; 01944 for (i = 0; i < src_ext[ndim]; i++) { 01945 indx1_src = i * src_strd[ndim]; 01946 indx1_msk = i * msk_strd[ndim]; 01947 for (j = 0; j < src_ext[dim]; j++) { 01948 mindx = indx1_msk + (j * msk_strd[dim]); 01949 if (LTOB(mask_el_len, &lptr[mindx])) { 01950 sindx = indx1_src + (j * src_strd[dim]); 01951 if (r8ptr1[sindx] < cur_minf) 01952 cur_minf = r8ptr1[sindx]; 01953 } 01954 } 01955 if (!scalar) { 01956 rindx = i * res_strd[0]; 01957 r8ptr2[rindx] = cur_minf; 01958 cur_minf = use_flt8; 01959 } 01960 } 01961 } else { 01962 r8ptr1 = (_f_real8 *) sptr; 01963 for (i = 0; i < src_ext[ndim]; i++) { 01964 indx1_src = i * src_strd[ndim]; 01965 for (j = 0; j < src_ext[dim]; j++) { 01966 sindx = indx1_src + (j * src_strd[dim]); 01967 if (r8ptr1[sindx] < cur_minf) 01968 cur_minf = r8ptr1[sindx]; 01969 } 01970 if (!scalar) { 01971 rindx = i * res_strd[0]; 01972 r8ptr2[rindx] = cur_minf; 01973 cur_minf = use_flt8; 01974 } 01975 } 01976 } 01977 if (scalar) 01978 r8ptr2[0] = cur_minf; 01979 break; 01980 01981 case DVSUBTYPE_REAL32 : 01982 r4ptr2 = (_f_real4 *) rptr; 01983 cur_mins4 = HUGE_REAL4_F90; 01984 if (use_mask) { 01985 r4ptr1 = (_f_real4 *) sptr; 01986 lptr = (_f_mask *) mptr; 01987 for (i = 0; i < src_ext[ndim]; i++) { 01988 indx1_src = i * src_strd[ndim]; 01989 indx1_msk = i * msk_strd[ndim]; 01990 for (j = 0; j < src_ext[dim]; j++) { 01991 mindx = indx1_msk + (j * msk_strd[dim]); 01992 if (LTOB(mask_el_len, &lptr[mindx])) { 01993 sindx = indx1_src + (j * src_strd[dim]); 01994 if (r4ptr1[sindx] < cur_mins4) 01995 cur_mins4 = r4ptr1[sindx]; 01996 } 01997 } 01998 if (!scalar) { 01999 rindx = i * res_strd[0]; 02000 r4ptr2[rindx] = cur_mins4; 02001 cur_mins4 = HUGE_REAL4_F90; 02002 } 02003 } 02004 } else { 02005 r4ptr1 = (_f_real4 *) sptr; 02006 for (i = 0; i < src_ext[ndim]; i++) { 02007 indx1_src = i * src_strd[ndim]; 02008 for (j = 0; j < src_ext[dim]; j++) { 02009 sindx = indx1_src + (j * src_strd[dim]); 02010 if (r4ptr1[sindx] < cur_mins4) 02011 cur_mins4 = r4ptr1[sindx]; 02012 } 02013 if (!scalar) { 02014 rindx = i * res_strd[0]; 02015 r4ptr2[rindx] = cur_mins4; 02016 cur_mins4 = HUGE_REAL4_F90; 02017 } 02018 } 02019 } 02020 if (scalar) 02021 r4ptr2[0] = cur_mins4; 02022 break; 02023 02024 #if defined _F_REAL16 && _F_REAL16 != (-1) 02025 case DVSUBTYPE_REAL128 : 02026 r16ptr1 = (_f_real16 *) sptr; 02027 r16ptr2 = (_f_real16 *) rptr; 02028 if (mask) 02029 lptr = (_f_mask *) mptr; 02030 cur_mind = HUGE_REAL16_F90; 02031 for (i = 0; i < src_ext[ndim]; i++) { 02032 indx1_src = i * src_strd[ndim]; 02033 indx1_msk = i * msk_strd[ndim]; 02034 for (j = 0; j < src_ext[dim]; j++) { 02035 if (use_mask) { 02036 mindx = indx1_msk + (j * msk_strd[dim]); 02037 if (LTOB(mask_el_len, &lptr[mindx])) { 02038 sindx = indx1_src + (j * src_strd[dim]); 02039 if (r16ptr1[sindx] < cur_mind) 02040 cur_mind = r16ptr1[sindx]; 02041 } 02042 } else { 02043 sindx = indx1_src + (j * src_strd[dim]); 02044 if (r16ptr1[sindx] < cur_mind) 02045 cur_mind = r16ptr1[sindx]; 02046 } 02047 } 02048 if (!scalar) { 02049 rindx = i * res_strd[0]; 02050 r16ptr2[rindx] = cur_mind; 02051 cur_mind = HUGE_REAL16_F90; 02052 } 02053 } 02054 if (scalar) 02055 r16ptr2[0] = cur_mind; 02056 break; 02057 #endif 02058 02059 default : 02060 _lerror (_LELVL_ABORT, FEINTDTY); 02061 } 02062 } else { 02063 if (scalar) { 02064 dim = 0; 02065 } else { 02066 #ifdef _UNICOS 02067 #pragma _CRI shortloop 02068 #endif 02069 for (i = 0; i < rank-1; i++) { 02070 res_off[i] = 0; 02071 res_ext[i] = result->dimension[i].extent; 02072 if (bucketsize > 1) 02073 res_strd[i]=result->dimension[i].stride_mult/bucketsize; 02074 else 02075 res_strd[i] = result->dimension[i].stride_mult; 02076 } 02077 } 02078 02079 tot_ext = 1; 02080 for (i = 0; i < dim; i++) { 02081 src_off[i] = 0; 02082 src_ext[i] = source->dimension[i].extent; 02083 if (bucketsize > 1) 02084 src_strd[i] = source->dimension[i].stride_mult / bucketsize; 02085 else 02086 src_strd[i] = source->dimension[i].stride_mult; 02087 if (mask && mask->n_dim > 0) { 02088 msk_ext[i] = mask->dimension[i].extent; 02089 msk_strd[i] = mask->dimension[i].stride_mult; 02090 #ifdef _CRAYMPP 02091 if (mask_el_len == 64 && sizeof(lptr[0]) == 4) 02092 msk_strd[i] <<= 1; 02093 #endif 02094 msk_off[i] = 0; 02095 } else { 02096 msk_strd[i] = 0; 02097 msk_off[i] = 0; 02098 } 02099 tot_ext *= src_ext[i]; 02100 } 02101 02102 src_dim_ext = source->dimension[dim].extent; 02103 if (bucketsize > 1) 02104 src_dim_strd = source->dimension[dim].stride_mult / bucketsize; 02105 else 02106 src_dim_strd = source->dimension[dim].stride_mult; 02107 if (use_mask) { 02108 msk_dim_ext = mask->dimension[dim].extent; 02109 msk_dim_strd = mask->dimension[dim].stride_mult; 02110 #ifdef _CRAYMPP 02111 if (mask_el_len == 64 && sizeof(lptr[0]) == 4) 02112 msk_dim_strd <<= 1; 02113 #endif 02114 } 02115 02116 for ( ; i < rank - 1; i++) { 02117 src_off[i] = 0; 02118 src_ext[i] = source->dimension[i+1].extent; 02119 if (bucketsize > 1) 02120 src_strd[i] = source->dimension[i+1].stride_mult/bucketsize; 02121 else 02122 src_strd[i] = source->dimension[i+1].stride_mult; 02123 if (mask && mask->n_dim > 1) { 02124 msk_ext[i] = mask->dimension[i+1].extent; 02125 msk_strd[i] = mask->dimension[i+1].stride_mult; 02126 #ifdef _CRAYMPP 02127 if (mask_el_len == 64 && sizeof(lptr[0]) == 4) 02128 msk_strd[i] <<= 1; 02129 #endif 02130 msk_off[i] = 0; 02131 } else { 02132 msk_strd[i] = 0; 02133 msk_off[i] = 0; 02134 } 02135 tot_ext *= src_ext[i]; 02136 } 02137 02138 /* Initialize curdim array */ 02139 02140 for (i = 0; i < rank - 1; i++) 02141 curdim[i] = 0; 02142 02143 switch (subtype) { 02144 #ifdef _F_INT6 02145 case DVSUBTYPE_INT46 : 02146 i6ptr2 = (_f_int6 *) rptr; 02147 if (init_val == USE_INT6) 02148 cur_mini = HUGE_INT6_F90; 02149 else if (init_val == USE_INT4) 02150 cur_mini = HUGE_INT4_F90; 02151 else if (init_val == USE_INT2) 02152 cur_mini = HUGE_INT2_F90; 02153 else 02154 cur_mini = HUGE_INT1_F90; 02155 use_int6 = cur_mini; 02156 if (use_mask) { 02157 i6ptr1 = (_f_int6 *) sptr; 02158 lptr = (_f_mask *) mptr; 02159 for (i = 0; i < tot_ext; i++) { 02160 indx1_src = 0; 02161 indx1_msk = 0; 02162 for (j = 0; j < rank - 1; j++) { 02163 indx1_src += src_off[j]; 02164 indx1_msk += msk_off[j]; 02165 } 02166 for (j = 0; j < src_dim_ext; j++) { 02167 mindx = indx1_msk + (j * msk_dim_strd); 02168 if (LTOB(mask_el_len, &lptr[mindx])) { 02169 sindx = indx1_src + (j * src_dim_strd); 02170 if (i6ptr1[sindx] < cur_mini) 02171 cur_mini = i6ptr1[sindx]; 02172 } 02173 } 02174 if (!scalar) { 02175 indx1_res = 0; 02176 for (j = 0; j < rank - 1; j++) 02177 indx1_res += res_off[j]; 02178 i6ptr2[indx1_res] = cur_mini; 02179 cur_mini = use_int6; 02180 } 02181 INCREMENT(); 02182 } 02183 } else { 02184 i6ptr1 = (_f_int6 *) sptr; 02185 for (i = 0; i < tot_ext; i++) { 02186 indx1_src = 0; 02187 for (j = 0; j < rank - 1; j++) 02188 indx1_src += src_off[j]; 02189 for (j = 0; j < src_dim_ext; j++) { 02190 sindx = indx1_src + (j * src_dim_strd); 02191 if (i6ptr1[sindx] < cur_mini) 02192 cur_mini = i6ptr1[sindx]; 02193 } 02194 if (!scalar) { 02195 indx1_res = 0; 02196 for (j = 0; j < rank - 1; j++) 02197 indx1_res += res_off[j]; 02198 i6ptr2[indx1_res] = cur_mini; 02199 cur_mini = use_int6; 02200 } 02201 INCREMENT(); 02202 } 02203 } 02204 if (scalar) 02205 i6ptr2[0] = cur_mini; 02206 break; 02207 #endif 02208 02209 case DVSUBTYPE_INT32 : 02210 i4ptr2 = (_f_int4 *) rptr; 02211 if (init_val == USE_INT4) 02212 cur_mini4 = HUGE_INT4_F90; 02213 else if (init_val == USE_INT2) 02214 cur_mini4 = HUGE_INT2_F90; 02215 else 02216 cur_mini4 = HUGE_INT1_F90; 02217 use_int4 = cur_mini4; 02218 if (use_mask) { 02219 i4ptr1 = (_f_int4 *) sptr; 02220 lptr = (_f_mask *) mptr; 02221 first = 1; 02222 for (i = 0; i < tot_ext; i++) { 02223 indx1_src = 0; 02224 indx1_msk = 0; 02225 for (j = 0; j < rank - 1; j++) { 02226 indx1_src += src_off[j]; 02227 indx1_msk += msk_off[j]; 02228 } 02229 for (j = 0; j < src_dim_ext; j++) { 02230 mindx = indx1_msk + (j * msk_dim_strd); 02231 if (LTOB(mask_el_len, &lptr[mindx])) { 02232 sindx = indx1_src + (j * src_dim_strd); 02233 if (!first) { 02234 if ((i4ptr1[sindx]^cur_mini4) >= 0) { 02235 if (i4ptr1[sindx] < cur_mini4) 02236 cur_mini4 = i4ptr1[sindx]; 02237 } else { 02238 if (i4ptr1[sindx] < 0) 02239 cur_mini4 = i4ptr1[sindx]; 02240 } 02241 } else { 02242 cur_mini4 = i4ptr1[sindx]; 02243 first = 0; 02244 } 02245 } 02246 } 02247 if (!scalar) { 02248 indx1_res = 0; 02249 for (j = 0; j < rank - 1; j++) 02250 indx1_res += res_off[j]; 02251 i4ptr2[indx1_res] = cur_mini4; 02252 cur_mini4 = use_int4; 02253 first = 1; 02254 } 02255 INCREMENT(); 02256 } 02257 } else { 02258 i4ptr1 = (_f_int4 *) sptr; 02259 first = 1; 02260 for (i = 0; i < tot_ext; i++) { 02261 indx1_src = 0; 02262 for (j = 0; j < rank - 1; j++) 02263 indx1_src += src_off[j]; 02264 for (j = 0; j < src_dim_ext; j++) { 02265 sindx = indx1_src + (j * src_dim_strd); 02266 if (!first) { 02267 if ((i4ptr1[sindx]^cur_mini4) >= 0) { 02268 if (i4ptr1[sindx] < cur_mini4) 02269 cur_mini4 = i4ptr1[sindx]; 02270 } else { 02271 if (i4ptr1[sindx] < 0) 02272 cur_mini4 = i4ptr1[sindx]; 02273 } 02274 } else { 02275 cur_mini4 = i4ptr1[sindx]; 02276 first = 0; 02277 } 02278 } 02279 if (!scalar) { 02280 indx1_res = 0; 02281 for (j = 0; j < rank - 1; j++) 02282 indx1_res += res_off[j]; 02283 i4ptr2[indx1_res] = cur_mini4; 02284 cur_mini4 = use_int4; 02285 first = 1; 02286 } 02287 INCREMENT(); 02288 } 02289 } 02290 if (scalar) 02291 i4ptr2[0] = cur_mini4; 02292 break; 02293 02294 case DVSUBTYPE_INT64 : 02295 i8ptr2 = (_f_int8 *) rptr; 02296 cur_minj = HUGE_INT8_F90; 02297 if (use_mask) { 02298 i8ptr1 = (_f_int8 *) sptr; 02299 lptr = (_f_mask *) mptr; 02300 first = 1; 02301 for (i = 0; i < tot_ext; i++) { 02302 indx1_src = 0; 02303 indx1_msk = 0; 02304 for (j = 0; j < rank - 1; j++) { 02305 indx1_src += src_off[j]; 02306 indx1_msk += msk_off[j]; 02307 } 02308 for (j = 0; j < src_dim_ext; j++) { 02309 mindx = indx1_msk + (j * msk_dim_strd); 02310 if (LTOB(mask_el_len, &lptr[mindx])) { 02311 sindx = indx1_src + (j * src_dim_strd); 02312 if (!first) { 02313 if ((i8ptr1[sindx]^cur_minj) >= 0) { 02314 if (i8ptr1[sindx] < cur_minj) 02315 cur_minj = i8ptr1[sindx]; 02316 } else { 02317 if (i8ptr1[sindx] < 0) 02318 cur_minj = i8ptr1[sindx]; 02319 } 02320 } else { 02321 cur_minj = i8ptr1[sindx]; 02322 first = 0; 02323 } 02324 } 02325 } 02326 if (!scalar) { 02327 indx1_res = 0; 02328 for (j = 0; j < rank - 1; j++) 02329 indx1_res += res_off[j]; 02330 i8ptr2[indx1_res] = cur_minj; 02331 cur_minj = HUGE_INT8_F90; 02332 first = 1; 02333 } 02334 INCREMENT(); 02335 } 02336 } else { 02337 i8ptr1 = (_f_int8 *) sptr; 02338 first = 1; 02339 for (i = 0; i < tot_ext; i++) { 02340 indx1_src = 0; 02341 for (j = 0; j < rank - 1; j++) 02342 indx1_src += src_off[j]; 02343 for (j = 0; j < src_dim_ext; j++) { 02344 sindx = indx1_src + (j * src_dim_strd); 02345 if (!first) { 02346 if ((i8ptr1[sindx]^cur_minj) >= 0) { 02347 if (i8ptr1[sindx] < cur_minj) 02348 cur_minj = i8ptr1[sindx]; 02349 } else { 02350 if (i8ptr1[sindx] < 0) 02351 cur_minj = i8ptr1[sindx]; 02352 } 02353 } else { 02354 cur_minj = i8ptr1[sindx]; 02355 first = 0; 02356 } 02357 } 02358 if (!scalar) { 02359 indx1_res = 0; 02360 for (j = 0; j < rank - 1; j++) 02361 indx1_res += res_off[j]; 02362 i8ptr2[indx1_res] = cur_minj; 02363 cur_minj = HUGE_INT8_F90; 02364 first = 1; 02365 } 02366 INCREMENT(); 02367 } 02368 } 02369 if (scalar) 02370 i8ptr2[0] = cur_minj; 02371 break; 02372 02373 case DVSUBTYPE_REAL64 : 02374 r8ptr2 = (_f_real8 *) rptr; 02375 if (init_val == USE_REAL8) 02376 cur_minf = HUGE_REAL8_F90; 02377 else 02378 cur_minf = HUGE_REAL4_F90; 02379 use_flt8 = cur_minf; 02380 if (use_mask) { 02381 r8ptr1 = (_f_real8 *) sptr; 02382 lptr = (_f_mask *) mptr; 02383 for (i = 0; i < tot_ext; i++) { 02384 indx1_src = 0; 02385 indx1_msk = 0; 02386 for (j = 0; j < rank - 1; j++) { 02387 indx1_src += src_off[j]; 02388 indx1_msk += msk_off[j]; 02389 } 02390 for (j = 0; j < src_dim_ext; j++) { 02391 mindx = indx1_msk + (j * msk_dim_strd); 02392 if (LTOB(mask_el_len, &lptr[mindx])) { 02393 sindx = indx1_src + (j * src_dim_strd); 02394 if (r8ptr1[sindx] < cur_minf) 02395 cur_minf = r8ptr1[sindx]; 02396 } 02397 } 02398 if (!scalar) { 02399 indx1_res = 0; 02400 for (j = 0; j < rank - 1; j++) 02401 indx1_res += res_off[j]; 02402 r8ptr2[indx1_res] = cur_minf; 02403 cur_minf = use_flt8; 02404 } 02405 INCREMENT(); 02406 } 02407 } else { 02408 r8ptr1 = (_f_real8 *) sptr; 02409 for (i = 0; i < tot_ext; i++) { 02410 indx1_src = 0; 02411 for (j = 0; j < rank - 1; j++) 02412 indx1_src += src_off[j]; 02413 for (j = 0; j < src_dim_ext; j++) { 02414 sindx = indx1_src + (j * src_dim_strd); 02415 if (r8ptr1[sindx] < cur_minf) 02416 cur_minf = r8ptr1[sindx]; 02417 } 02418 if (!scalar) { 02419 indx1_res = 0; 02420 for (j = 0; j < rank - 1; j++) 02421 indx1_res += res_off[j]; 02422 r8ptr2[indx1_res] = cur_minf; 02423 cur_minf = use_flt8; 02424 } 02425 INCREMENT(); 02426 } 02427 } 02428 if (scalar) 02429 r8ptr2[0] = cur_minf; 02430 break; 02431 02432 case DVSUBTYPE_REAL32 : 02433 r4ptr2 = (_f_real4 *) rptr; 02434 cur_mins4 = HUGE_REAL4_F90; 02435 if (use_mask) { 02436 r4ptr1 = (_f_real4 *) sptr; 02437 lptr = (_f_mask *) mptr; 02438 for (i = 0; i < tot_ext; i++) { 02439 indx1_src = 0; 02440 indx1_msk = 0; 02441 for (j = 0; j < rank - 1; j++) { 02442 indx1_src += src_off[j]; 02443 indx1_msk += msk_off[j]; 02444 } 02445 for (j = 0; j < src_dim_ext; j++) { 02446 mindx = indx1_msk + (j * msk_dim_strd); 02447 if (LTOB(mask_el_len, &lptr[mindx])) { 02448 sindx = indx1_src + (j * src_dim_strd); 02449 if (r4ptr1[sindx] < cur_mins4) 02450 cur_mins4 = r4ptr1[sindx]; 02451 } 02452 } 02453 if (!scalar) { 02454 indx1_res = 0; 02455 for (j = 0; j < rank - 1; j++) 02456 indx1_res += res_off[j]; 02457 r4ptr2[indx1_res] = cur_mins4; 02458 cur_mins4 = HUGE_REAL4_F90; 02459 } 02460 INCREMENT(); 02461 } 02462 } else { 02463 r4ptr1 = (_f_real4 *) sptr; 02464 for (i = 0; i < tot_ext; i++) { 02465 indx1_src = 0; 02466 for (j = 0; j < rank - 1; j++) 02467 indx1_src += src_off[j]; 02468 for (j = 0; j < src_dim_ext; j++) { 02469 sindx = indx1_src + (j * src_dim_strd); 02470 if (r4ptr1[sindx] < cur_mins4) 02471 cur_mins4 = r4ptr1[sindx]; 02472 } 02473 if (!scalar) { 02474 indx1_res = 0; 02475 for (j = 0; j < rank - 1; j++) 02476 indx1_res += res_off[j]; 02477 r4ptr2[indx1_res] = cur_mins4; 02478 cur_mins4 = HUGE_REAL4_F90; 02479 } 02480 INCREMENT(); 02481 } 02482 } 02483 if (scalar) 02484 r4ptr2[0] = cur_mins4; 02485 break; 02486 02487 #if defined _F_REAL16 && _F_REAL16 != (-1) 02488 case DVSUBTYPE_REAL128 : 02489 r16ptr1 = (_f_real16 *) sptr; 02490 r16ptr2 = (_f_real16 *) rptr; 02491 if (mask) 02492 lptr = (_f_mask *) mptr; 02493 cur_mind = HUGE_REAL16_F90; 02494 for (i = 0; i < tot_ext; i++) { 02495 indx1_src = 0; 02496 if (use_mask) { 02497 indx1_msk = 0; 02498 for (j = 0; j < rank - 1; j++) { 02499 indx1_src += src_off[j]; 02500 indx1_msk += msk_off[j]; 02501 } 02502 } else { 02503 for (j = 0; j < rank - 1; j++) 02504 indx1_src += src_off[j]; 02505 } 02506 for (j = 0; j < src_dim_ext; j++) { 02507 if (use_mask) { 02508 mindx = indx1_msk + (j * msk_dim_strd); 02509 if (LTOB(mask_el_len, &lptr[mindx])) { 02510 sindx = indx1_src + (j * src_dim_strd); 02511 if (r16ptr1[sindx] < cur_mind) 02512 cur_mind = r16ptr1[sindx]; 02513 } 02514 } else { 02515 sindx = indx1_src + (j * src_dim_strd); 02516 if (r16ptr1[sindx] < cur_mind) 02517 cur_mind = r16ptr1[sindx]; 02518 } 02519 } 02520 if (!scalar) { 02521 indx1_res = 0; 02522 for (j = 0; j < rank - 1; j++) 02523 indx1_res += res_off[j]; 02524 r16ptr2[indx1_res] = cur_mind; 02525 cur_mind = HUGE_REAL16_F90; 02526 } 02527 INCREMENT(); 02528 } 02529 if (scalar) 02530 r16ptr2[0] = cur_mind; 02531 break; 02532 #endif 02533 02534 default : 02535 _lerror (_LELVL_ABORT, FEINTDTY); 02536 } 02537 } 02538 }
1.7.6.1 
