00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
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
00057
00058
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
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
00179
00180 #define LOAD_DM_MK() \
00181 dm = dimp; \
00182 mk = mask; \
00183 \
00184 if (mask == NULL) { \
00185 \
00186 if (dimp != NULL) { \
00187 if (dimp->type_lens.type == DVTYPE_LOGICAL) { \
00188 \
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
00212
00213
00214
00215
00216
00217
00218
00219
00220
00221
00222
00223
00224
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;
00359 #else
00360 typedef int _f_int6;
00361 #endif
00362 #endif
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;
01119 _f_int4 * restrict i4ptr2;
01120 #ifdef _F_INT6
01121 _f_int6 * restrict i6ptr1;
01122 _f_int6 * restrict i6ptr2;
01123 #endif
01124 _f_int8 * restrict i8ptr1;
01125 _f_int8 * restrict i8ptr2;
01126 _f_real8 * restrict r8ptr1;
01127 _f_real8 * restrict r8ptr2;
01128 #if defined _F_REAL16 && _F_REAL16 != (-1)
01129 _f_real16 * restrict r16ptr1;
01130 _f_real16 * restrict r16ptr2;
01131 #endif
01132 _f_real4 * restrict r4ptr1;
01133 _f_real4 * restrict r4ptr2;
01134 _f_mask * restrict lptr;
01135 void * restrict sptr;
01136 void * restrict rptr;
01137 void * restrict mptr;
01138 _f_int dim;
01139 _f_int bucketsize;
01140 long nbytes;
01141 long sindx;
01142 long rindx;
01143 long mindx;
01144 _f_int type;
01145 _f_int rank;
01146 long src_ext[MAXDIM];
01147 long src_strd[MAXDIM];
01148 long src_off[MAXDIM];
01149 long res_ext[MAXDIM];
01150 long res_strd[MAXDIM];
01151 long res_off[MAXDIM];
01152 long msk_ext[MAXDIM];
01153 long msk_strd[MAXDIM];
01154 long msk_off[MAXDIM];
01155 long curdim[MAXDIM];
01156 long src_dim_ext;
01157 long src_dim_strd;
01158 long msk_dim_ext;
01159 long msk_dim_strd;
01160 long indx1_src;
01161 long indx1_res;
01162 long indx1_msk;
01163 long tot_ext;
01164 _f_int ndim;
01165 _f_int first;
01166 _f_int4 cur_maxi4;
01167 _f_int4 i32_result;
01168 _f_int4 use_int4;
01169 #ifdef _F_INT6
01170 _f_int6 cur_maxi;
01171 _f_int6 i46_result;
01172 _f_int6 use_int6;
01173 #endif
01174 _f_int8 cur_maxj;
01175 _f_int8 i64_result;
01176 _f_real8 cur_maxf;
01177 _f_real8 s64_result;
01178 _f_real8 use_flt8;
01179 #if defined _F_REAL16 && _F_REAL16 != (-1)
01180 _f_real16 cur_maxd;
01181 _f_real16 s128_result;
01182 #endif
01183 _f_real4 cur_maxs4;
01184 _f_real4 s32_result;
01185 _f_int use_mask;
01186 long i, j;
01187 long mask_el_len;
01188 _f_int early_exit;
01189
01190
01191
01192
01193
01194
01195 type = source->type_lens.type;
01196 rank = source->n_dim;
01197
01198
01199
01200
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
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
01245
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
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
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
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
01345
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)
01355 use_mask = 0;
01356 else
01357 use_mask = 1;
01358 }
01359 } else {
01360 use_mask = 0;
01361 }
01362
01363
01364
01365
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
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 }
