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