Open64 (mfef90, whirl2f, and IR tools)
TAG: version-openad; SVN changeset: 916
|
00001 /* 00002 00003 Copyright (C) 2000, 2001 Silicon Graphics, Inc. All Rights Reserved. 00004 00005 This program is free software; you can redistribute it and/or modify it 00006 under the terms of version 2.1 of the GNU Lesser General Public License 00007 as published by the Free Software Foundation. 00008 00009 This program is distributed in the hope that it would be useful, but 00010 WITHOUT ANY WARRANTY; without even the implied warranty of 00011 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 00012 00013 Further, this software is distributed without any warranty that it is 00014 free of the rightful claim of any third person regarding infringement 00015 or the like. Any license provided herein, whether implied or 00016 otherwise, applies only to this software file. Patent licenses, if 00017 any, provided herein do not apply to combinations of this program with 00018 other software, or any other product whatsoever. 00019 00020 You should have received a copy of the GNU Lesser General Public 00021 License along with this program; if not, write the Free Software 00022 Foundation, Inc., 59 Temple Place - Suite 330, Boston MA 02111-1307, 00023 USA. 00024 00025 Contact information: Silicon Graphics, Inc., 1600 Amphitheatre Pky, 00026 Mountain View, CA 94043, or: 00027 00028 http://www.sgi.com 00029 00030 For further information regarding this notice, see: 00031 00032 http://oss.sgi.com/projects/GenInfo/NoticeExplan 00033 00034 */ 00035 00036 00037 static char USMID[] = "@(#) libfi/array/minloc.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 /* _LOAD_DM_MK correctly for P.E. 3.0 and above */ 00047 #define _LOAD_DM_MK() \ 00048 dm = dimension; \ 00049 mk = mask; \ 00050 /* if last arg = NULL, is last-1 arg mask or dim? */ \ 00051 if (mask == NULL) { \ 00052 /* last arg = NULL, is last-1 arg mask or dim? */ \ 00053 if (dimension != NULL) { \ 00054 if (dimension->type_lens.type == DVTYPE_LOGICAL) { \ 00055 /* last-1 argument is mask. */ \ 00056 mk = dimension; \ 00057 dm = mask; \ 00058 } \ 00059 } \ 00060 } 00061 00062 /* 00063 * Minloc function. Determine the location of the first element of an array 00064 * having the minimum value of the elements identified by a mask variable. 00065 */ 00066 00067 /* P.E. 2.0 and earlier entry points for MINLOC contain only a single 00068 * underbar after MINLOC and before the TYPE letter. Only these entry 00069 * points may specify DVSUBTYPE_INT46 and INTEGER(KIND=6). P.E. 3.0 00070 * does not have INTEGER(KIND=6). 00071 * 00072 * P.E. 3.0 uses the double underbar between MINLOC and the TYPE letter. 00073 * Note that we can never do a fast compare the way in which the routine 00074 * is written because it starts with with HUGE as the first mininum 00075 * value it is comparing against to find the minimum location. 00076 */ 00077 #ifdef _UNICOS 00078 #pragma _CRI duplicate _MINLOC_I4 as MINLOC_I4@ 00079 #endif 00080 void 00081 _MINLOC_I4( DopeVectorType * result, /* integer-32 */ 00082 DopeVectorType * source, 00083 DopeVectorType * mask) 00084 { 00085 void __minloc(); 00086 _f_int dimension = 0; 00087 #ifndef _F_INT4 00088 (void) __minloc (result, source, dimension, mask, DVSUBTYPE_INT46); 00089 #else 00090 (void) __minloc (result, source, dimension, mask, DVSUBTYPE_INT32); 00091 #endif 00092 } 00093 00094 void 00095 _MINLOC__I4( DopeVectorType * result, /* integer-32 */ 00096 DopeVectorType * source, 00097 DopeVectorType * dimension, 00098 DopeVectorType * mask) 00099 { 00100 void __minloc(); 00101 DopeVectorType *dm, *mk; 00102 _LOAD_DM_MK(); 00103 #ifndef _F_INT4 00104 (void) __minloc (result, source, dm, mk, DVSUBTYPE_INT46); 00105 #else 00106 (void) __minloc (result, source, dm, mk, DVSUBTYPE_INT32); 00107 #endif 00108 } 00109 00110 void 00111 _MINLOC_I2( DopeVectorType * result, /* integer-16 */ 00112 DopeVectorType * source, 00113 DopeVectorType * mask) 00114 { 00115 void __minloc(); 00116 _f_int dimension = 0; 00117 #ifndef _F_INT4 00118 (void) __minloc (result, source, dimension, mask, DVSUBTYPE_INT46); 00119 #else 00120 (void) __minloc (result, source, dimension, mask, DVSUBTYPE_INT32); 00121 #endif 00122 } 00123 00124 void 00125 _MINLOC__I2( DopeVectorType * result, /* integer-16 */ 00126 DopeVectorType * source, 00127 DopeVectorType * dimension, 00128 DopeVectorType * mask) 00129 { 00130 void __minloc(); 00131 DopeVectorType *dm, *mk; 00132 _LOAD_DM_MK(); 00133 #if defined(_F_INT2) 00134 (void) __minloc (result, source, dm, mk, DVSUBTYPE_BIT16); 00135 #elif !defined(_F_INT4) 00136 (void) __minloc (result, source, dm, mk, DVSUBTYPE_INT46); 00137 #else 00138 (void) __minloc (result, source, dm, mk, DVSUBTYPE_INT32); 00139 #endif 00140 } 00141 00142 void 00143 _MINLOC_I1( DopeVectorType * result, /* integer-8 */ 00144 DopeVectorType * source, 00145 DopeVectorType * mask) 00146 { 00147 void __minloc(); 00148 _f_int dimension = 0; 00149 #ifndef _F_INT4 00150 (void) __minloc (result, source, dimension, mask, DVSUBTYPE_INT46); 00151 #else 00152 (void) __minloc (result, source, dimension, mask, DVSUBTYPE_INT32); 00153 #endif 00154 } 00155 00156 void 00157 _MINLOC__I1( DopeVectorType * result, /* integer-8 */ 00158 DopeVectorType * source, 00159 DopeVectorType * dimension, 00160 DopeVectorType * mask) 00161 { 00162 void __minloc(); 00163 DopeVectorType *dm, *mk; 00164 _LOAD_DM_MK(); 00165 #if defined(_F_INT1) 00166 (void) __minloc (result, source, dm, mk, DVSUBTYPE_BIT8); 00167 #elif !defined(_F_INT4) 00168 (void) __minloc (result, source, dm, mk, DVSUBTYPE_INT46); 00169 #else 00170 (void) __minloc (result, source, dm, mk, DVSUBTYPE_INT32); 00171 #endif 00172 } 00173 00174 #ifdef _UNICOS 00175 #pragma _CRI duplicate _MINLOC_I as MINLOC_I@ 00176 #endif 00177 void 00178 _MINLOC_I( DopeVectorType * result, /* integer-46 */ 00179 DopeVectorType * source, 00180 DopeVectorType * mask) 00181 { 00182 void __minloc(); 00183 _f_int dimension = 0; 00184 #ifdef _F_INT6 00185 (void) __minloc (result, source, dimension, mask, DVSUBTYPE_INT46); 00186 #else 00187 (void) __minloc (result, source, dimension, mask, DVSUBTYPE_INT64); 00188 #endif 00189 } 00190 00191 void 00192 _MINLOC__I( DopeVectorType * result, /* integer-46 */ 00193 DopeVectorType * source, 00194 DopeVectorType * dimension, 00195 DopeVectorType * mask) 00196 { 00197 void __minloc(); 00198 DopeVectorType *dm, *mk; 00199 _LOAD_DM_MK(); 00200 #ifdef _F_INT6 00201 (void) __minloc (result, source, dm, mk, DVSUBTYPE_INT46); 00202 #else 00203 (void) __minloc (result, source, dm, mk, DVSUBTYPE_INT64); 00204 #endif 00205 } 00206 00207 #ifdef _UNICOS 00208 #pragma _CRI duplicate _MINLOC_J as MINLOC_J@ 00209 #endif 00210 void 00211 _MINLOC_J( DopeVectorType * result, /* integer-64 */ 00212 DopeVectorType * source, 00213 DopeVectorType * mask) 00214 { 00215 void __minloc(); 00216 _f_int dimension = 0; 00217 (void) __minloc (result, source, dimension, mask, DVSUBTYPE_INT64); 00218 } 00219 00220 void 00221 _MINLOC__J( DopeVectorType * result, /* integer-64 */ 00222 DopeVectorType * source, 00223 DopeVectorType * dimension, 00224 DopeVectorType * mask) 00225 { 00226 void __minloc(); 00227 DopeVectorType *dm, *mk; 00228 _LOAD_DM_MK(); 00229 (void) __minloc (result, source, dm, mk, DVSUBTYPE_INT64); 00230 } 00231 00232 #ifdef _UNICOS 00233 #pragma _CRI duplicate _MINLOC_S as MINLOC_S@ 00234 #endif 00235 void 00236 _MINLOC_S( DopeVectorType * result, /* 64-bit real */ 00237 DopeVectorType * source, 00238 DopeVectorType * mask) 00239 { 00240 void __minloc(); 00241 _f_int dimension = 0; 00242 (void) __minloc (result, source, dimension, mask, DVSUBTYPE_REAL64); 00243 } 00244 00245 void 00246 _MINLOC__S( DopeVectorType * result, /* 64-bit real */ 00247 DopeVectorType * source, 00248 DopeVectorType * dimension, 00249 DopeVectorType * mask) 00250 { 00251 void __minloc(); 00252 DopeVectorType *dm, *mk; 00253 _LOAD_DM_MK(); 00254 (void) __minloc (result, source, dm, mk, DVSUBTYPE_REAL64); 00255 } 00256 00257 #if defined _F_REAL16 && _F_REAL16 != (-1) 00258 #ifdef _UNICOS 00259 #pragma _CRI duplicate _MINLOC_D as MINLOC_D@ 00260 #endif 00261 void 00262 _MINLOC_D( DopeVectorType * result, /* 128-bit real */ 00263 DopeVectorType * source, 00264 DopeVectorType * mask) 00265 { 00266 void __minloc(); 00267 _f_int dimension = 0; 00268 (void) __minloc (result, source, dimension, mask, DVSUBTYPE_REAL128); 00269 } 00270 00271 void 00272 _MINLOC__D( DopeVectorType * result, /* 128-bit real */ 00273 DopeVectorType * source, 00274 DopeVectorType * dimension, 00275 DopeVectorType * mask) 00276 { 00277 void __minloc(); 00278 DopeVectorType *dm, *mk; 00279 _LOAD_DM_MK(); 00280 (void) __minloc (result, source, dm, mk, DVSUBTYPE_REAL128); 00281 } 00282 #endif 00283 00284 00285 #ifdef _UNICOS 00286 #pragma _CRI duplicate _MINLOC_S4 as MINLOC_S4@ 00287 #endif 00288 void 00289 _MINLOC_S4( DopeVectorType * result, /* 32-bit real */ 00290 DopeVectorType * source, 00291 DopeVectorType * mask) 00292 { 00293 void __minloc(); 00294 _f_int dimension = 0; 00295 #ifndef _F_REAL4 00296 (void) __minloc (result, source, dimension, mask, DVSUBTYPE_REAL64); 00297 #else 00298 (void) __minloc (result, source, dimension, mask, DVSUBTYPE_REAL32); 00299 #endif 00300 } 00301 00302 void 00303 _MINLOC__S4( DopeVectorType * result, /* 32-bit real */ 00304 DopeVectorType * source, 00305 DopeVectorType * dimension, 00306 DopeVectorType * mask) 00307 { 00308 void __minloc(); 00309 DopeVectorType *dm, *mk; 00310 _LOAD_DM_MK(); 00311 #ifndef _F_REAL4 00312 (void) __minloc (result, source, dm, mk, DVSUBTYPE_REAL64); 00313 #else 00314 (void) __minloc (result, source, dm, mk, DVSUBTYPE_REAL32); 00315 #endif 00316 } 00317 00318 /* 00319 * _SET_INDEX sets the temporary return values to the values of the 00320 * current indices. 00321 */ 00322 00323 #define _SET_INDEX() \ 00324 if (rank == 3) { \ 00325 rptr2 = curdim[2]; \ 00326 rptr1 = curdim[1]; \ 00327 rptr0 = curdim[0]; \ 00328 } else if (rank == 4) { \ 00329 rptr3 = curdim[3]; \ 00330 rptr2 = curdim[2]; \ 00331 rptr1 = curdim[1]; \ 00332 rptr0 = curdim[0]; \ 00333 } else if (rank == 5) { \ 00334 rptr4 = curdim[4]; \ 00335 rptr3 = curdim[3]; \ 00336 rptr2 = curdim[2]; \ 00337 rptr1 = curdim[1]; \ 00338 rptr0 = curdim[0]; \ 00339 } else if (rank == 6) { \ 00340 rptr5 = curdim[5]; \ 00341 rptr4 = curdim[4]; \ 00342 rptr3 = curdim[3]; \ 00343 rptr2 = curdim[2]; \ 00344 rptr1 = curdim[1]; \ 00345 rptr0 = curdim[0]; \ 00346 } else { \ 00347 rptr6 = curdim[6]; \ 00348 rptr5 = curdim[5]; \ 00349 rptr4 = curdim[4]; \ 00350 rptr3 = curdim[3]; \ 00351 rptr2 = curdim[2]; \ 00352 rptr1 = curdim[1]; \ 00353 rptr0 = curdim[0]; \ 00354 } 00355 00356 /* 00357 * _FINAL_INDEX sets the return values in the result array 00358 */ 00359 00360 #ifndef __mips 00361 #define _FINAL_INDEX() \ 00362 if (typeflag == 4) { \ 00363 switch (rank) { \ 00364 case 7 : \ 00365 rptr_4[6 * res_strd] = rptr6 + 1; \ 00366 case 6 : \ 00367 rptr_4[5 * res_strd] = rptr5 + 1; \ 00368 case 5 : \ 00369 rptr_4[4 * res_strd] = rptr4 + 1; \ 00370 case 4 : \ 00371 rptr_4[3 * res_strd] = rptr3 + 1; \ 00372 default : \ 00373 rptr_4[2 * res_strd] = rptr2 + 1; \ 00374 rptr_4[res_strd] = rptr1 + 1; \ 00375 rptr_4[0] = rptr0 + 1; \ 00376 } \ 00377 } else { \ 00378 switch (rank) { \ 00379 case 7 : \ 00380 rptr_8[6 * res_strd] = rptr6 + 1; \ 00381 case 6 : \ 00382 rptr_8[5 * res_strd] = rptr5 + 1; \ 00383 case 5 : \ 00384 rptr_8[4 * res_strd] = rptr4 + 1; \ 00385 case 4 : \ 00386 rptr_8[3 * res_strd] = rptr3 + 1; \ 00387 default : \ 00388 rptr_8[2 * res_strd] = rptr2 + 1; \ 00389 rptr_8[res_strd] = rptr1 + 1; \ 00390 rptr_8[0] = rptr0 + 1; \ 00391 } \ 00392 } 00393 #else 00394 #define _FINAL_INDEX() \ 00395 switch (typeflag) { \ 00396 case 4 : \ 00397 switch (rank) { \ 00398 case 7 : \ 00399 rptr_4[6 * res_strd] = rptr6 + 1; \ 00400 case 6 : \ 00401 rptr_4[5 * res_strd] = rptr5 + 1; \ 00402 case 5 : \ 00403 rptr_4[4 * res_strd] = rptr4 + 1; \ 00404 case 4 : \ 00405 rptr_4[3 * res_strd] = rptr3 + 1; \ 00406 default : \ 00407 rptr_4[2 * res_strd] = rptr2 + 1; \ 00408 rptr_4[res_strd] = rptr1 + 1; \ 00409 rptr_4[0] = rptr0 + 1; \ 00410 } \ 00411 break; \ 00412 case 2 : \ 00413 switch (rank) { \ 00414 case 7 : \ 00415 rptr_2[6 * res_strd] = rptr6 + 1; \ 00416 case 6 : \ 00417 rptr_2[5 * res_strd] = rptr5 + 1; \ 00418 case 5 : \ 00419 rptr_2[4 * res_strd] = rptr4 + 1; \ 00420 case 4 : \ 00421 rptr_2[3 * res_strd] = rptr3 + 1; \ 00422 default : \ 00423 rptr_2[2 * res_strd] = rptr2 + 1; \ 00424 rptr_2[res_strd] = rptr1 + 1; \ 00425 rptr_2[0] = rptr0 + 1; \ 00426 } \ 00427 break; \ 00428 case 1 : \ 00429 switch (rank) { \ 00430 case 7 : \ 00431 rptr_1[6 * res_strd] = rptr6 + 1; \ 00432 case 6 : \ 00433 rptr_1[5 * res_strd] = rptr5 + 1; \ 00434 case 5 : \ 00435 rptr_1[4 * res_strd] = rptr4 + 1; \ 00436 case 4 : \ 00437 rptr_1[3 * res_strd] = rptr3 + 1; \ 00438 default : \ 00439 rptr_1[2 * res_strd] = rptr2 + 1; \ 00440 rptr_1[res_strd] = rptr1 + 1; \ 00441 rptr_1[0] = rptr0 + 1; \ 00442 } \ 00443 break; \ 00444 case 8 : \ 00445 switch (rank) { \ 00446 case 7 : \ 00447 rptr_8[6 * res_strd] = rptr6 + 1; \ 00448 case 6 : \ 00449 rptr_8[5 * res_strd] = rptr5 + 1; \ 00450 case 5 : \ 00451 rptr_8[4 * res_strd] = rptr4 + 1; \ 00452 case 4 : \ 00453 rptr_8[3 * res_strd] = rptr3 + 1; \ 00454 default : \ 00455 rptr_8[2 * res_strd] = rptr2 + 1; \ 00456 rptr_8[res_strd] = rptr1 + 1; \ 00457 rptr_8[0] = rptr0 + 1; \ 00458 } \ 00459 } 00460 #endif 00461 00462 /* 00463 * _INTERM_INDEX sets the return values in the result array 00464 * when a DIM argument is present. 00465 */ 00466 00467 #ifndef __mips 00468 #define _INTERM_INDEX() \ 00469 switch (typeflag) { \ 00470 case 4 : \ 00471 rptr_4[rindx] = res_indx1 + 1; \ 00472 break; \ 00473 case 8 : \ 00474 rptr_8[rindx] = res_indx1 + 1; \ 00475 } 00476 #else 00477 #define _INTERM_INDEX() \ 00478 switch (typeflag) { \ 00479 case 4 : \ 00480 rptr_4[rindx] = res_indx1 + 1; \ 00481 break; \ 00482 case 2 : \ 00483 rptr_2[rindx] = res_indx1 + 1; \ 00484 break; \ 00485 case 1 : \ 00486 rptr_1[rindx] = res_indx1 + 1; \ 00487 break; \ 00488 case 8 : \ 00489 rptr_8[rindx] = res_indx1 + 1; \ 00490 } 00491 #endif 00492 00493 /* 00494 * _INCREMENT_ONE increments the curdim dimension counters and 00495 * the source index variable for rank 3-7 arrays with no mask. 00496 */ 00497 00498 #define _INCREMENT_ONE() \ 00499 curdim[0]++; \ 00500 if (curdim[0] < ext[0]) { \ 00501 sindx += src_incr[0]; \ 00502 } else { \ 00503 curdim[0] = 0; \ 00504 curdim[1]++; \ 00505 if (curdim[1] < ext[1]) { \ 00506 sindx += src_incr[1]; \ 00507 } else { \ 00508 curdim[1] = 0; \ 00509 curdim[2]++; \ 00510 if (curdim[2] < ext[2]) { \ 00511 sindx += src_incr[2]; \ 00512 } else { \ 00513 curdim[2] = 0; \ 00514 curdim[3]++; \ 00515 if (curdim[3] < ext[3]) { \ 00516 sindx += src_incr[3]; \ 00517 } else { \ 00518 curdim[3] = 0; \ 00519 curdim[4]++; \ 00520 if (curdim[4] < ext[4]) { \ 00521 sindx += src_incr[4]; \ 00522 } else { \ 00523 curdim[4] = 0; \ 00524 curdim[5]++; \ 00525 if (curdim[5] < ext[5]) { \ 00526 sindx += src_incr[5]; \ 00527 } else { \ 00528 curdim[5] = 0; \ 00529 curdim[6]++; \ 00530 sindx += src_incr[6]; \ 00531 } \ 00532 } \ 00533 } \ 00534 } \ 00535 } \ 00536 } 00537 00538 /* 00539 * _INCREMENT_TWO increments the curdim dimension counters and 00540 * the source index variable for rank 3-7 arrays with mask. 00541 */ 00542 00543 #define _INCREMENT_TWO() \ 00544 curdim[0]++; \ 00545 if (curdim[0] < ext[0]) { \ 00546 sindx += src_incr[0]; \ 00547 mindx += msk_incr[0]; \ 00548 } else { \ 00549 curdim[0] = 0; \ 00550 curdim[1]++; \ 00551 if (curdim[1] < ext[1]) { \ 00552 sindx += src_incr[1]; \ 00553 mindx += msk_incr[1]; \ 00554 } else { \ 00555 curdim[1] = 0; \ 00556 curdim[2]++; \ 00557 if (curdim[2] < ext[2]) { \ 00558 sindx += src_incr[2]; \ 00559 mindx += msk_incr[2]; \ 00560 } else { \ 00561 curdim[2] = 0; \ 00562 curdim[3]++; \ 00563 if (curdim[3] < ext[3]) { \ 00564 sindx += src_incr[3]; \ 00565 mindx += msk_incr[3]; \ 00566 } else { \ 00567 curdim[3] = 0; \ 00568 curdim[4]++; \ 00569 if (curdim[4] < ext[4]) { \ 00570 sindx += src_incr[4]; \ 00571 mindx += msk_incr[4]; \ 00572 } else { \ 00573 curdim[4] = 0; \ 00574 curdim[5]++; \ 00575 if (curdim[5] < ext[5]) { \ 00576 sindx += src_incr[5]; \ 00577 mindx += msk_incr[5]; \ 00578 } else { \ 00579 curdim[5] = 0; \ 00580 curdim[6]++; \ 00581 sindx += src_incr[6]; \ 00582 mindx += msk_incr[6]; \ 00583 } \ 00584 } \ 00585 } \ 00586 } \ 00587 } \ 00588 } 00589 00590 /* _INCREMENT_D_ONE increments the curdim dimension counters and 00591 * the source index variable for rank 3-7 arrays with no mask and 00592 * a dim argument is present. 00593 */ 00594 00595 #define _INCREMENT_D_ONE() \ 00596 curdim[0]++; \ 00597 if (curdim[0] < ext[0]) { \ 00598 src_off[0] = curdim[0] * src_strd[0]; \ 00599 res_off[0] = curdim[0] * res_strdm[0]; \ 00600 } else { \ 00601 curdim[0] = 0; \ 00602 src_off[0] = 0; \ 00603 res_off[0] = 0; \ 00604 curdim[1]++; \ 00605 if (curdim[1] < ext[1]) { \ 00606 src_off[1] = curdim[1] * src_strd[1]; \ 00607 res_off[1] = curdim[1] * res_strdm[1]; \ 00608 } else { \ 00609 curdim[1] = 0; \ 00610 src_off[1] = 0; \ 00611 res_off[1] = 0; \ 00612 curdim[2]++; \ 00613 if (curdim[2] < ext[2]) { \ 00614 src_off[2] = curdim[2] * src_strd[2]; \ 00615 res_off[2] = curdim[2] * res_strdm[2]; \ 00616 } else { \ 00617 curdim[2] = 0; \ 00618 src_off[2] = 0; \ 00619 res_off[2] = 0; \ 00620 curdim[3]++; \ 00621 if (curdim[3] < ext[3]) { \ 00622 src_off[3] = curdim[3] * src_strd[3]; \ 00623 res_off[3] = curdim[3] * res_strdm[3]; \ 00624 } else { \ 00625 curdim[3] = 0; \ 00626 src_off[3] = 0; \ 00627 res_off[3] = 0; \ 00628 curdim[4]++; \ 00629 if (curdim[4] < ext[4]) { \ 00630 src_off[4] = curdim[4] * src_strd[4]; \ 00631 res_off[4] = curdim[4] * res_strdm[4]; \ 00632 } else { \ 00633 curdim[4] = 0; \ 00634 src_off[4] = 0; \ 00635 res_off[4] = 0; \ 00636 curdim[5]++; \ 00637 if (curdim[5] < ext[5]) { \ 00638 src_off[5] = curdim[5] * src_strd[5]; \ 00639 res_off[5] = curdim[5] * res_strdm[5]; \ 00640 } else { \ 00641 curdim[5] = 0; \ 00642 src_off[5] = 0; \ 00643 res_off[5] = 0; \ 00644 curdim[6]++; \ 00645 src_off[6] = curdim[6] * src_strd[6]; \ 00646 res_off[6] = curdim[6] * res_strdm[6]; \ 00647 } \ 00648 } \ 00649 } \ 00650 } \ 00651 } \ 00652 } 00653 00654 /* 00655 * _INCREMENT_D_TWO increments the curdim dimension counters and 00656 * the source index variable for rank 3-7 arrays with mask and 00657 * a dim argument is present. 00658 */ 00659 00660 #define _INCREMENT_D_TWO() \ 00661 curdim[0]++; \ 00662 if (curdim[0] < ext[0]) { \ 00663 src_off[0] = curdim[0] * src_strd[0]; \ 00664 msk_off[0] = curdim[0] * msk_strd[0]; \ 00665 res_off[0] = curdim[0] * res_strdm[0]; \ 00666 } else { \ 00667 curdim[0] = 0; \ 00668 src_off[0] = 0; \ 00669 msk_off[0] = 0; \ 00670 res_off[0] = 0; \ 00671 curdim[1]++; \ 00672 if (curdim[1] < ext[1]) { \ 00673 src_off[1] = curdim[1] * src_strd[1]; \ 00674 msk_off[1] = curdim[1] * msk_strd[1]; \ 00675 res_off[1] = curdim[1] * res_strdm[1]; \ 00676 } else { \ 00677 curdim[1] = 0; \ 00678 src_off[1] = 0; \ 00679 msk_off[1] = 0; \ 00680 res_off[1] = 0; \ 00681 curdim[2]++; \ 00682 if (curdim[2] < ext[2]) { \ 00683 src_off[2] = curdim[2] * src_strd[2]; \ 00684 msk_off[2] = curdim[2] * msk_strd[2]; \ 00685 res_off[2] = curdim[2] * res_strdm[2]; \ 00686 } else { \ 00687 curdim[2] = 0; \ 00688 src_off[2] = 0; \ 00689 msk_off[2] = 0; \ 00690 res_off[2] = 0; \ 00691 curdim[3]++; \ 00692 if (curdim[3] < ext[3]) { \ 00693 src_off[3] = curdim[3] * src_strd[3]; \ 00694 msk_off[3] = curdim[3] * msk_strd[3]; \ 00695 res_off[3] = curdim[3] * res_strdm[3]; \ 00696 } else { \ 00697 curdim[3] = 0; \ 00698 src_off[3] = 0; \ 00699 msk_off[3] = 0; \ 00700 res_off[3] = 0; \ 00701 curdim[4]++; \ 00702 if (curdim[4] < ext[4]) { \ 00703 src_off[4] = curdim[4] * src_strd[4]; \ 00704 msk_off[4] = curdim[4] * msk_strd[4]; \ 00705 res_off[4] = curdim[4] * res_strdm[4]; \ 00706 } else { \ 00707 curdim[4] = 0; \ 00708 src_off[4] = 0; \ 00709 msk_off[4] = 0; \ 00710 res_off[4] = 0; \ 00711 curdim[5]++; \ 00712 if (curdim[5] < ext[5]) { \ 00713 src_off[5] = curdim[5] * src_strd[5]; \ 00714 msk_off[5] = curdim[5] * msk_strd[5]; \ 00715 res_off[5] = curdim[5] * res_strdm[5]; \ 00716 } else { \ 00717 curdim[5] = 0; \ 00718 src_off[5] = 0; \ 00719 msk_off[5] = 0; \ 00720 res_off[5] = 0; \ 00721 curdim[6]++; \ 00722 src_off[6] = curdim[6] * src_strd[6]; \ 00723 msk_off[6] = curdim[6] * msk_strd[6]; \ 00724 res_off[6] = curdim[6] * res_strdm[6]; \ 00725 } \ 00726 } \ 00727 } \ 00728 } \ 00729 } \ 00730 } 00731 00732 00733 void 00734 __minloc ( DopeVectorType * result, 00735 DopeVectorType * source, 00736 DopeVectorType * dimension, 00737 DopeVectorType * mask, 00738 _f_int subtype) 00739 { 00740 _f_int * restrict rptr; /* ptr to result array */ 00741 _f_int4 * restrict rptr_4; /* ptr to result array */ 00742 _f_int8 * restrict rptr_8; /* ptr to result array */ 00743 #ifdef _F_INT2 00744 _f_int2 * restrict rptr_2; /* ptr to result array */ 00745 _f_int2 * restrict i2ptr; /* 16-bit integer */ 00746 _f_int2 i2lval; /* lowest int value */ 00747 #endif 00748 #ifdef _F_INT1 00749 _f_int1 * restrict rptr_1; /* ptr to result array */ 00750 _f_int1 * restrict i1ptr; /* 8-bit integer */ 00751 _f_int1 i1lval; /* lowest int value */ 00752 #endif 00753 _f_mask * restrict mptr; /* ptr to mask array */ 00754 _f_int bucketsize; /* data element size */ 00755 _f_int4 * restrict i4ptr; /* 32-bit integer */ 00756 _f_int4 i4lval; /* lowest int value */ 00757 #ifdef _F_INT6 00758 _f_int6 * restrict i6ptr; /* 46-bit integer */ 00759 _f_int6 i6lval; /* lowest int value */ 00760 #endif 00761 _f_int8 * restrict i8ptr; /* 64-bit integer */ 00762 _f_int8 i8lval; /* lowest int value */ 00763 _f_real8 * restrict r8ptr; /* 64-bit float */ 00764 _f_real8 r8lval; /* lowest float value */ 00765 _f_real16 * restrict r16ptr; /* 128-bit float */ 00766 _f_real16 r16lval; /* lowest double value */ 00767 _f_real4 * restrict r4ptr; /* 32-bit real */ 00768 _f_real4 r4lval; /* lowest 32-bit value */ 00769 long nbytes; /* # of bytes in data area */ 00770 long indx1; /* i index value */ 00771 long sindx; /* source index */ 00772 long mindx; /* mask index */ 00773 long rindx; /* result index */ 00774 long mndx1; /* mask index counter */ 00775 long curdim[MAXDIM]; /* current indices */ 00776 long extent; /* total extent count */ 00777 long stride; /* stride */ 00778 long ext[MAXDIM]; /* stride by elements */ 00779 long src_strd[MAXDIM]; /* stride by elements */ 00780 long src_incr[MAXDIM]; /* increment counters */ 00781 long src_sub[MAXDIM]; /* temporary counter */ 00782 long src_off[MAXDIM]; /* source offset */ 00783 long msk_strd[MAXDIM]; /* mask stride */ 00784 long msk_incr[MAXDIM]; /* increment counters */ 00785 long msk_sub[MAXDIM]; /* temporary counter */ 00786 long msk_off[MAXDIM]; /* mask offset */ 00787 long res_strd; /* result stride for nondim */ 00788 long res_strdm[MAXDIM]; /* result stride for dim */ 00789 long res_incr[MAXDIM]; /* result increment for dim */ 00790 long res_sub[MAXDIM]; /* result temp counter */ 00791 long res_off[MAXDIM]; /* result offset */ 00792 long msk_ext[MAXDIM]; /* mask extents */ 00793 long res_ext[MAXDIM]; /* result extents */ 00794 long src_dim_ext; /* source extent for dimenlc */ 00795 long src_dim_strd; /* source stride for dimenlc */ 00796 long msk_dim_ext; /* mask extent for dimenlc */ 00797 long msk_dim_strd; /* mask stride for dimenlc */ 00798 _f_int rank; /* rank of source matrix */ 00799 _f_int type; /* type of source matrix */ 00800 long tot_ext = 1; /* total extent */ 00801 long rptr0; /* result scalar */ 00802 long rptr1; /* result scalar */ 00803 long rptr2; /* result scalar */ 00804 long rptr3; /* result scalar */ 00805 long rptr4; /* result scalar */ 00806 long rptr5; /* result scalar */ 00807 long rptr6; /* result scalar */ 00808 long src_indx1; /* temp value holder */ 00809 long msk_indx1; /* temp value holder */ 00810 long res_indx1; /* temp value holder */ 00811 _f_int use_mask; /* mask use flag */ 00812 long i, j; /* index1 variables */ 00813 long mask_el_len; 00814 _f_int typeflag; /* size of result flag */ 00815 _f_int resbucketsize; /* result data element size */ 00816 _f_int dimenlc = 0; /* dimension to check */ 00817 _f_int ndim; /* nondim */ 00818 _f_int nodim; /* no dim argument */ 00819 00820 /* 00821 * Set up local copies of the number of dimensions in the source 00822 * array (rank) and the source array data type (type). 00823 */ 00824 00825 rank = source->n_dim; 00826 type = source->type_lens.type; 00827 00828 /* 00829 * Set up typeflag for size of integer result. 00830 */ 00831 00832 typeflag = ((result->base_addr.a.el_len == 64) ? 8 : 00833 ((result->base_addr.a.el_len == 32) ? 4 : 00834 ((result->base_addr.a.el_len == 16) ? 2 : 00835 ((result->base_addr.a.el_len == 8) ? 1 : -1)))); 00836 00837 /* 00838 * Set up the dim variable. It must be decremented by one to 00839 * account for the difference in reference between C and Fortran. 00840 */ 00841 if (dimension != NULL && rank > 0) { 00842 _f_int dmintlen; 00843 dmintlen = dimension->type_lens.int_len >> 3; 00844 if (dmintlen == sizeof(_f_int8)) { 00845 dimenlc = *(_f_int8 *) dimension->base_addr.a.ptr; 00846 } else if (dmintlen == sizeof(_f_int4)) { 00847 dimenlc = *(_f_int4 *) dimension->base_addr.a.ptr; 00848 } else if (dmintlen == sizeof(_f_int2)) { 00849 dimenlc = *(_f_int2 *) dimension->base_addr.a.ptr; 00850 } else if (dmintlen == sizeof(_f_int1)) { 00851 dimenlc = *(_f_int1 *) dimension->base_addr.a.ptr; 00852 } 00853 dimenlc--; 00854 if (dimenlc < 0 || dimenlc >= rank) 00855 _lerror (_LELVL_ABORT, FESCIDIM); 00856 } 00857 00858 /* Set bucket size scalar */ 00859 00860 bucketsize = source->type_lens.int_len / BITS_PER_WORD; 00861 #if defined(_CRAYMPP) || defined(__mips) 00862 if (bucketsize == 0) 00863 bucketsize = 1; 00864 #endif 00865 00866 /* If necessary, fill result dope vector */ 00867 00868 if (!result->assoc) { 00869 resbucketsize = 1; 00870 if (result->base_addr.a.el_len >= BITS_PER_WORD) 00871 resbucketsize = result->base_addr.a.el_len / BITS_PER_WORD; 00872 #if defined(_CRAYMPP) || defined(__mips) 00873 if (resbucketsize == 0) 00874 resbucketsize = 1; 00875 #endif 00876 result->base_addr.a.ptr = (void *) NULL; 00877 result->orig_base = 0; 00878 result->orig_size = 0; 00879 00880 tot_ext = resbucketsize; 00881 nbytes = typeflag; 00882 00883 /* return a scalar only when the dim is present and rank=1 */ 00884 if (dimension != NULL && rank == 1) 00885 result->n_dim = 0; 00886 else if (dimension != NULL) { 00887 result->n_dim = rank - 1; 00888 for (i = 0; i < dimenlc; i++) { 00889 result->dimension[i].extent = 00890 source->dimension[i].extent; 00891 result->dimension[i].low_bound = 1; 00892 result->dimension[i].stride_mult = tot_ext; 00893 tot_ext *= result->dimension[i].extent; 00894 nbytes *= result->dimension[i].extent; 00895 } 00896 for ( ; i < rank-1; i++) { 00897 result->dimension[i].extent = 00898 source->dimension[i+1].extent; 00899 result->dimension[i].low_bound = 1; 00900 result->dimension[i].stride_mult = tot_ext; 00901 tot_ext *= result->dimension[i].extent; 00902 nbytes *= result->dimension[i].extent; 00903 } 00904 } else { 00905 result->dimension[0].low_bound = 1; 00906 result->dimension[0].extent = rank; 00907 /* Result rank-one array is size of source and 00908 * type default integer 00909 */ 00910 result->dimension[0].stride_mult = resbucketsize; 00911 nbytes *= result->dimension[0].extent; 00912 tot_ext *= result->dimension[0].extent; 00913 } 00914 00915 /* allocate space */ 00916 if (nbytes > 0) { 00917 result->base_addr.a.ptr = (void *) malloc (nbytes); 00918 if (result->base_addr.a.ptr == NULL) 00919 _lerror (_LELVL_ABORT, FENOMEMY); 00920 } 00921 00922 result->assoc = 1; 00923 result->orig_base = (void *) result->base_addr.a.ptr; 00924 result->orig_size = nbytes * BITS_PER_BYTE; 00925 } 00926 00927 /* initialize result array */ 00928 00929 switch (typeflag) { 00930 case 4: 00931 rptr_4 = (_f_int4 *) result->base_addr.a.ptr; 00932 for (i = 0; i < tot_ext; i++) 00933 rptr_4[i] = 0; 00934 break; 00935 #ifdef _F_INT2 00936 case 2: 00937 rptr_2 = (_f_int2 *) result->base_addr.a.ptr; 00938 for (i = 0; i < tot_ext; i++) 00939 rptr_2[i] = 0; 00940 break; 00941 #endif 00942 #ifdef _F_INT1 00943 case 1: 00944 rptr_1 = (_f_int1 *) result->base_addr.a.ptr; 00945 for (i = 0; i < tot_ext; i++) 00946 rptr_1[i] = 0; 00947 break; 00948 #endif 00949 case 8: 00950 rptr_8 = (_f_int8 *) result->base_addr.a.ptr; 00951 for (i = 0; i < tot_ext; i++) 00952 rptr_8[i] = 0; 00953 } /* switch typeflag */ 00954 00955 /* 00956 * If the extent field for any of the dope vectors is 0, we can 00957 * exit early. 00958 */ 00959 00960 #ifdef _UNICOS 00961 #pragma _CRI shortloop 00962 #endif 00963 for (i = 0; i < rank; i++) { 00964 if (source->dimension[i].extent == 0) 00965 return; 00966 } 00967 if (result->assoc) { 00968 if (result->n_dim != 0) { 00969 for (i = 0; i < result->n_dim; i++) { 00970 if (result->dimension[i].extent == 0) 00971 return; 00972 } 00973 } 00974 } 00975 if (mask) { 00976 #ifdef _UNICOS 00977 #pragma _CRI shortloop 00978 #endif 00979 for (i = 0; i < mask->n_dim; i++) { 00980 if (mask->dimension[i].extent == 0) 00981 return; 00982 } 00983 } 00984 00985 /* 00986 * If mask is set and not scalar, set use_mask flag to true. If it is 00987 * scalar and true, all elements will pass mask check, so treat it as if no 00988 * mask was given. If it is false, all elements will fail, and return 00989 * value will be all 0's. Set them now, and return. If no mask is 00990 * specified, set use_mask to false. 00991 */ 00992 if (mask) { 00993 mask_el_len = mask->base_addr.a.el_len; 00994 mptr = (_f_mask *) mask->base_addr.a.ptr; 00995 if (mask->n_dim == 0) { 00996 if (LTOB(mask_el_len, &mptr[0])) 00997 use_mask = 0; 00998 else 00999 return; /* already set to 0, just return */ 01000 } else 01001 use_mask = 1; 01002 } else 01003 use_mask = 0; 01004 01005 /* set up result stride scalar */ 01006 01007 if (resbucketsize > 1) 01008 res_strd = result->dimension[0].stride_mult / resbucketsize; 01009 else 01010 res_strd = result->dimension[0].stride_mult; 01011 01012 /* 01013 * The program is broken down into three sections. Arrays of rank 1, 01014 * arrays of rank 2, and arrays of ranks 3-7. Inside each section, 01015 * they are broken down by data type. 01016 * 01017 * Inside each data type area, the work is divided into two sections. 01018 * If there is a mask specified, each element of the mask is checked, 01019 * and for all true values, the comparable element in the source array 01020 * is compared against the current minimum value. If the source value 01021 * is less, it replaces the current min value, and its index is stored 01022 * in the temporary result counter. If no mask is specified, no check 01023 * of the mask is made, and all elements of the source are tested. 01024 * 01025 * The temporary result scalars are initialized to -1. This indicates 01026 * that no minimum has yet been found. The actual return values are 01027 * set at the end of the loop. If all values of mask are false, then 01028 * these values are returned to indicate that no minimum value was 01029 * found. 01030 */ 01031 if (rank == 1) { 01032 01033 /* 01034 * Stride is set up in actual words, rather than number of elements. 01035 * Therefore, if type is double, we must divide the stride by two to 01036 * get it to point to the number of two-word entities. 01037 */ 01038 if (bucketsize > 1) 01039 stride = source->dimension[0].stride_mult / bucketsize; 01040 else 01041 stride = source->dimension[0].stride_mult; 01042 extent = source->dimension[0].extent; 01043 01044 /* Only initialize mask variables if a mask has been specified. */ 01045 01046 if (use_mask) { 01047 mindx = 0; 01048 msk_strd[0] = mask->dimension[0].stride_mult; 01049 #ifdef _CRAYMPP 01050 if (mask_el_len == 64 && sizeof(mptr[0]) == 4) 01051 msk_strd[0] <<= 1; 01052 #endif 01053 } 01054 01055 /* Integer type */ 01056 01057 switch (subtype) { 01058 #ifdef _F_INT6 01059 case DVSUBTYPE_INT46 : 01060 i6ptr = (_f_int6 *) source->base_addr.a.ptr; 01061 i6lval = HUGE_INT6_F90; 01062 if (use_mask) { /* mask specified */ 01063 rptr0 = -1; 01064 for (i = 0; i < extent; i++) { 01065 mindx = i * msk_strd[0]; 01066 if (LTOB(mask_el_len, &mptr[mindx])) { 01067 sindx = i * stride; 01068 if (i6ptr[sindx] < i6lval) { 01069 i6lval = i6ptr[sindx]; 01070 rptr0 = i; 01071 } 01072 } 01073 } 01074 } else { /* no mask */ 01075 rptr0 = 0; 01076 for (i = 0; i < extent; i++) { 01077 sindx = i * stride; 01078 if (i6ptr[sindx] < i6lval) { 01079 i6lval = i6ptr[sindx]; 01080 rptr0 = i; 01081 } 01082 } 01083 } 01084 switch (typeflag) { 01085 case 4: 01086 rptr_4[0] = rptr0 + 1; 01087 break; 01088 #ifdef _F_INT2 01089 case 2: 01090 rptr_2[0] = rptr0 + 1; 01091 break; 01092 #endif 01093 #ifdef _F_INT1 01094 case 1: 01095 rptr_1[0] = rptr0 + 1; 01096 break; 01097 #endif 01098 case 8: 01099 rptr_8[0] = rptr0 + 1; 01100 } 01101 break; 01102 #endif 01103 01104 #ifdef _F_INT2 01105 case DVSUBTYPE_BIT16 : 01106 i2ptr = (_f_int2 *) source->base_addr.a.ptr; 01107 i2lval = HUGE_INT2_F90; 01108 if (use_mask) { /* mask specified */ 01109 rptr0 = -1; 01110 for (i = 0; i < extent; i++) { 01111 mindx = i * msk_strd[0]; 01112 if (LTOB(mask_el_len, &mptr[mindx])) { 01113 sindx = i * stride; 01114 if (i2ptr[sindx] < i2lval) { 01115 i2lval = i2ptr[sindx]; 01116 rptr0 = i; 01117 } 01118 } 01119 } 01120 } else { /* no mask */ 01121 rptr0 = 0; 01122 for (i = 0; i < extent; i++) { 01123 sindx = i * stride; 01124 if (i2ptr[sindx] < i2lval) { 01125 i2lval = i2ptr[sindx]; 01126 rptr0 = i; 01127 } 01128 } 01129 } 01130 switch (typeflag) { 01131 case 4: 01132 rptr_4[0] = rptr0 + 1; 01133 break; 01134 case 2: 01135 rptr_2[0] = rptr0 + 1; 01136 break; 01137 #ifdef _F_INT1 01138 case 1: 01139 rptr_1[0] = rptr0 + 1; 01140 break; 01141 #endif 01142 case 8: 01143 rptr_8[0] = rptr0 + 1; 01144 } 01145 break; 01146 #endif 01147 01148 #ifdef _F_INT1 01149 case DVSUBTYPE_BIT8 : 01150 i1ptr = (_f_int1 *) source->base_addr.a.ptr; 01151 i1lval = HUGE_INT1_F90; 01152 if (use_mask) { /* mask specified */ 01153 rptr0 = -1; 01154 for (i = 0; i < extent; i++) { 01155 mindx = i * msk_strd[0]; 01156 if (LTOB(mask_el_len, &mptr[mindx])) { 01157 sindx = i * stride; 01158 if (i1ptr[sindx] < i1lval) { 01159 i1lval = i1ptr[sindx]; 01160 rptr0 = i; 01161 } 01162 } 01163 } 01164 } else { /* no mask */ 01165 rptr0 = 0; 01166 for (i = 0; i < extent; i++) { 01167 sindx = i * stride; 01168 if (i1ptr[sindx] < i1lval) { 01169 i1lval = i1ptr[sindx]; 01170 rptr0 = i; 01171 } 01172 } 01173 } 01174 switch (typeflag) { 01175 case 4: 01176 rptr_4[0] = rptr0 + 1; 01177 break; 01178 #ifdef _F_INT2 01179 case 2: 01180 rptr_2[0] = rptr0 + 1; 01181 break; 01182 #endif 01183 case 1: 01184 rptr_1[0] = rptr0 + 1; 01185 break; 01186 case 8: 01187 rptr_8[0] = rptr0 + 1; 01188 } 01189 break; 01190 #endif 01191 01192 case DVSUBTYPE_INT32 : 01193 i4ptr = (_f_int4 *) source->base_addr.a.ptr; 01194 i4lval = HUGE_INT4_F90; 01195 if (use_mask) { /* mask specified */ 01196 rptr0 = -1; 01197 for (i = 0; i < extent; i++) { 01198 mindx = i * msk_strd[0]; 01199 if (LTOB(mask_el_len, &mptr[mindx])) { 01200 sindx = i * stride; 01201 if ((i4ptr[sindx]^i4lval) >= 0) { 01202 if (i4ptr[sindx] < i4lval) { 01203 i4lval = i4ptr[sindx]; 01204 rptr0 = i; 01205 } 01206 } else { 01207 if (i4ptr[sindx] < 0) { 01208 i4lval = i4ptr[sindx]; 01209 rptr0 = i; 01210 } 01211 } 01212 } 01213 } 01214 } else { /* no mask */ 01215 rptr0 = 0; 01216 for (i = 0; i < extent; i++) { 01217 sindx = i * stride; 01218 if ((i4ptr[sindx]^i4lval) >= 0) { 01219 if (i4ptr[sindx] < i4lval) { 01220 i4lval = i4ptr[sindx]; 01221 rptr0 = i; 01222 } 01223 } else { 01224 if (i4ptr[sindx] < 0) { 01225 i4lval = i4ptr[sindx]; 01226 rptr0 = i; 01227 } 01228 } 01229 } 01230 } 01231 switch (typeflag) { 01232 case 4: 01233 rptr_4[0] = rptr0 + 1; 01234 break; 01235 #ifdef _F_INT2 01236 case 2: 01237 rptr_2[0] = rptr0 + 1; 01238 break; 01239 #endif 01240 #ifdef _F_INT1 01241 case 1: 01242 rptr_1[0] = rptr0 + 1; 01243 break; 01244 #endif 01245 case 8: 01246 rptr_8[0] = rptr0 + 1; 01247 } 01248 break; 01249 01250 case DVSUBTYPE_INT64 : 01251 i8ptr = (_f_int8 *) source->base_addr.a.ptr; 01252 i8lval = HUGE_INT8_F90; 01253 if (use_mask) { /* mask specified */ 01254 rptr0 = -1; 01255 for (i = 0; i < extent; i++) { 01256 mindx = i * msk_strd[0]; 01257 if (LTOB(mask_el_len, &mptr[mindx])) { 01258 sindx = i * stride; 01259 if ((i8ptr[sindx]^i8lval) >= 0) { 01260 if (i8ptr[sindx] < i8lval) { 01261 i8lval = i8ptr[sindx]; 01262 rptr0 = i; 01263 } 01264 } else { 01265 if (i8ptr[sindx] < 0) { 01266 i8lval = i8ptr[sindx]; 01267 rptr0 = i; 01268 } 01269 } 01270 } 01271 } 01272 } else { /* no mask */ 01273 rptr0 = 0; 01274 for (i = 0; i < extent; i++) { 01275 sindx = i * stride; 01276 if ((i8ptr[sindx]^i8lval) >= 0) { 01277 if (i8ptr[sindx] < i8lval) { 01278 i8lval = i8ptr[sindx]; 01279 rptr0 = i; 01280 } 01281 } else { 01282 if (i8ptr[sindx] < 0) { 01283 i8lval = i8ptr[sindx]; 01284 rptr0 = i; 01285 } 01286 } 01287 } 01288 } 01289 switch (typeflag) { 01290 case 4: 01291 rptr_4[0] = rptr0 + 1; 01292 break; 01293 #ifdef _F_INT2 01294 case 2: 01295 rptr_2[0] = rptr0 + 1; 01296 break; 01297 #endif 01298 #ifdef _F_INT1 01299 case 1: 01300 rptr_1[0] = rptr0 + 1; 01301 break; 01302 #endif 01303 case 8: 01304 rptr_8[0] = rptr0 + 1; 01305 } 01306 break; 01307 01308 case DVSUBTYPE_REAL64 : 01309 r8ptr = (_f_real8 *) source->base_addr.a.ptr; 01310 r8lval = HUGE_REAL8_F90; 01311 if (use_mask) { /* mask specified */ 01312 rptr0 = -1; 01313 for (i = 0; i < extent; i++) { 01314 mindx = i * msk_strd[0]; 01315 if (LTOB(mask_el_len, &mptr[mindx])) { 01316 sindx = i * stride; 01317 if (r8ptr[sindx] < r8lval) { 01318 r8lval = r8ptr[sindx]; 01319 rptr0 = i; 01320 } 01321 } 01322 } 01323 } else { /* no mask */ 01324 rptr0 = 0; 01325 for (i = 0; i < extent; i++) { 01326 sindx = i * stride; 01327 if (r8ptr[sindx] < r8lval) { 01328 r8lval = r8ptr[sindx]; 01329 rptr0 = i; 01330 } 01331 } 01332 } 01333 switch (typeflag) { 01334 case 4: 01335 rptr_4[0] = rptr0 + 1; 01336 break; 01337 #ifdef _F_INT2 01338 case 2: 01339 rptr_2[0] = rptr0 + 1; 01340 break; 01341 #endif 01342 #ifdef _F_INT1 01343 case 1: 01344 rptr_1[0] = rptr0 + 1; 01345 break; 01346 #endif 01347 case 8: 01348 rptr_8[0] = rptr0 + 1; 01349 } 01350 break; 01351 01352 case DVSUBTYPE_REAL32 : 01353 r4ptr = (_f_real4 *) source->base_addr.a.ptr; 01354 r4lval = HUGE_REAL4_F90; 01355 if (use_mask) { /* mask specified */ 01356 rptr0 = -1; 01357 for (i = 0; i < extent; i++) { 01358 mindx = i * msk_strd[0]; 01359 if (LTOB(mask_el_len, &mptr[mindx])) { 01360 sindx = i * stride; 01361 if (r4ptr[sindx] < r4lval) { 01362 r4lval = r4ptr[sindx]; 01363 rptr0 = i; 01364 } 01365 } 01366 } 01367 } else { /* no mask */ 01368 rptr0 = 0; 01369 for (i = 0; i < extent; i++) { 01370 sindx = i * stride; 01371 if (r4ptr[sindx] < r4lval) { 01372 r4lval = r4ptr[sindx]; 01373 rptr0 = i; 01374 } 01375 } 01376 } 01377 switch (typeflag) { 01378 case 4: 01379 rptr_4[0] = rptr0 + 1; 01380 break; 01381 #ifdef _F_INT2 01382 case 2: 01383 rptr_2[0] = rptr0 + 1; 01384 break; 01385 #endif 01386 #ifdef _F_INT1 01387 case 1: 01388 rptr_1[0] = rptr0 + 1; 01389 break; 01390 #endif 01391 case 8: 01392 rptr_8[0] = rptr0 + 1; 01393 } 01394 break; 01395 01396 #if defined _F_REAL16 && _F_REAL16 != (-1) 01397 case DVSUBTYPE_REAL128 : 01398 r16ptr = (_f_real16 *) source->base_addr.a.ptr; 01399 r16lval = HUGE_REAL16_F90; 01400 if (use_mask) { /* mask specified */ 01401 rptr0 = -1; 01402 for (i = 0; i < extent; i++) { 01403 mindx = i * msk_strd[0]; 01404 if (LTOB(mask_el_len, &mptr[mindx])) { 01405 sindx = i * stride; 01406 if (r16ptr[sindx] < r16lval) { 01407 r16lval = r16ptr[sindx]; 01408 rptr0 = i; 01409 } 01410 } 01411 } 01412 } else { /* no mask */ 01413 rptr0 = 0; 01414 for (i = 0; i < extent; i++) { 01415 sindx = i * stride; 01416 if (r16ptr[sindx] < r16lval) { 01417 r16lval = r16ptr[sindx]; 01418 rptr0 = i; 01419 } 01420 } 01421 } 01422 switch (typeflag) { 01423 case 4: 01424 rptr_4[0] = rptr0 + 1; 01425 break; 01426 #ifdef _F_INT2 01427 case 2: 01428 rptr_2[0] = rptr0 + 1; 01429 break; 01430 #endif 01431 #ifdef _F_INT1 01432 case 1: 01433 rptr_1[0] = rptr0 + 1; 01434 break; 01435 #endif 01436 case 8: 01437 rptr_8[0] = rptr0 + 1; 01438 } 01439 break; 01440 #endif 01441 01442 default : 01443 _lerror (_LELVL_ABORT, FEINTDTY); 01444 } 01445 01446 /* 01447 * The rank 2 arrays are also broken down into each data type. In 01448 * addition, the separation is also made on whether a mask is specified. 01449 * 01450 * The logic within the loops is similar to rank 1, except rank 2 01451 * arrays have an additional loop. The outer loop is set up on the 01452 * second dimension. The offset values for the second dimension are 01453 * put into scalars, and they are used for each iteration of the inner 01454 * loop. 01455 */ 01456 01457 } else if (rank == 2) { 01458 indx1 = 0; 01459 sindx = 0; 01460 01461 /* 01462 * Stride is set up in actual words, rather than number of elements. 01463 * Therefore, if type is double, we must divide the stride by two to 01464 * get it to point to the number of two-word entities. 01465 */ 01466 01467 ext[0] = source->dimension[0].extent; 01468 ext[1] = source->dimension[1].extent; 01469 if (bucketsize > 1) { 01470 src_strd[0] = source->dimension[0].stride_mult / bucketsize; 01471 src_strd[1] = source->dimension[1].stride_mult / bucketsize; 01472 } else { 01473 src_strd[0] = source->dimension[0].stride_mult; 01474 src_strd[1] = source->dimension[1].stride_mult; 01475 } 01476 01477 /* Only intialize mask variables if a mask has been specified */ 01478 01479 if (use_mask) { /* if mask specified */ 01480 if (mask->n_dim > 0) { 01481 msk_strd[0] = mask->dimension[0].stride_mult; 01482 msk_strd[1] = mask->dimension[1].stride_mult; 01483 #ifdef _CRAYMPP 01484 if (mask_el_len == 64 && sizeof(mptr[0]) == 4) { 01485 msk_strd[0] <<= 1; 01486 msk_strd[1] <<= 1; 01487 } 01488 #endif 01489 } else { 01490 msk_strd[0] = 0; 01491 msk_strd[1] = 0; 01492 msk_ext[0] = 0; 01493 msk_ext[1] = 0; 01494 } 01495 mindx = 0; 01496 mndx1 = 0; 01497 } 01498 if (dimension == NULL) { 01499 /* no dimension argument. dimenlc is zero. */ 01500 ndim = 1; 01501 } else { 01502 if (dimenlc == 0) 01503 ndim = 1; 01504 else 01505 ndim = 0; 01506 } 01507 01508 switch (subtype) { 01509 #ifdef _F_INT6 01510 case DVSUBTYPE_INT46 : 01511 i6ptr = (_f_int6 *) source->base_addr.a.ptr; 01512 i6lval = HUGE_INT6_F90; 01513 if (use_mask) { /* mask specified */ 01514 rptr0 = -1; 01515 rptr1 = -1; 01516 for (i = 0; i < ext[ndim]; i++) { 01517 msk_indx1 = i * msk_strd[ndim]; 01518 src_indx1 = i * src_strd[ndim]; 01519 for (j = 0; j < ext[dimenlc]; j++) { 01520 mindx = msk_indx1 + (j * msk_strd[dimenlc]); 01521 if (LTOB(mask_el_len, &mptr[mindx])) { 01522 sindx = src_indx1 + (j * src_strd[dimenlc]); 01523 if (i6ptr[sindx] < i6lval) { 01524 rptr0 = j; 01525 rptr1 = i; 01526 i6lval = i6ptr[sindx]; 01527 } 01528 } 01529 } 01530 if (dimension != NULL) { 01531 rindx = i * res_strd; 01532 i6lval = HUGE_INT6_F90; 01533 switch (typeflag) { 01534 case 4: 01535 rptr_4[rindx] = rptr0 + 1; /* set result */ 01536 break; 01537 #ifdef _F_INT2 01538 case 2: 01539 rptr_2[rindx] = rptr0 + 1; /* set result */ 01540 break; 01541 #endif 01542 #ifdef _F_INT1 01543 case 1: 01544 rptr_1[rindx] = rptr0 + 1; /* set result */ 01545 break; 01546 #endif 01547 case 8: 01548 rptr_8[rindx] = rptr0 + 1; /* set result */ 01549 } 01550 rptr0 = -1; 01551 rptr1 = -1; 01552 } 01553 } 01554 } else { /* no mask */ 01555 rptr0 = 0; 01556 rptr1 = 0; 01557 for (i = 0; i < ext[ndim]; i++) { 01558 src_indx1 = i * src_strd[ndim]; 01559 for (j = 0; j < ext[dimenlc]; j++) { 01560 sindx = src_indx1 + (j * src_strd[dimenlc]); 01561 if (i6ptr[sindx] < i6lval) { 01562 rptr0 = j; 01563 rptr1 = i; 01564 i6lval = i6ptr[sindx]; 01565 } 01566 } 01567 if (dimension != NULL) { 01568 rindx = i * res_strd; 01569 i6lval = HUGE_INT6_F90; 01570 switch (typeflag) { 01571 case 4: 01572 rptr_4[rindx] = rptr0 + 1; /* set result */ 01573 break; 01574 #ifdef _F_INT2 01575 case 2: 01576 rptr_2[rindx] = rptr0 + 1; /* set result */ 01577 break; 01578 #endif 01579 #ifdef _F_INT1 01580 case 1: 01581 rptr_1[rindx] = rptr0 + 1; /* set result */ 01582 break; 01583 #endif 01584 case 8: 01585 rptr_8[rindx] = rptr0 + 1; /* set result */ 01586 } 01587 rptr0 = 0; 01588 rptr1 = 0; 01589 } 01590 } 01591 } 01592 if (dimension == NULL) { 01593 switch (typeflag) { 01594 case 4: 01595 rptr_4[0] = rptr0 + 1; /* set result */ 01596 rptr_4[res_strd] = rptr1 + 1; 01597 break; 01598 #ifdef _F_INT2 01599 case 2: 01600 rptr_2[0] = rptr0 + 1; /* set result */ 01601 rptr_2[res_strd] = rptr1 + 1; 01602 break; 01603 #endif 01604 #ifdef _F_INT1 01605 case 1: 01606 rptr_1[0] = rptr0 + 1; /* set result */ 01607 rptr_1[res_strd] = rptr1 + 1; 01608 break; 01609 #endif 01610 case 8: 01611 rptr_8[0] = rptr0 + 1; /* set result */ 01612 rptr_8[res_strd] = rptr1 + 1; 01613 } 01614 } 01615 break; 01616 #endif 01617 01618 case DVSUBTYPE_INT32 : 01619 i4ptr = (_f_int4 *) source->base_addr.a.ptr; 01620 i4lval = HUGE_INT4_F90; 01621 if (use_mask) { /* mask specified */ 01622 rptr0 = -1; 01623 rptr1 = -1; 01624 for (i = 0; i < ext[ndim]; i++) { 01625 msk_indx1 = i * msk_strd[ndim]; 01626 src_indx1 = i * src_strd[ndim]; 01627 for (j = 0; j < ext[dimenlc]; j++) { 01628 mindx = msk_indx1 + (j * msk_strd[dimenlc]); 01629 if (LTOB(mask_el_len, &mptr[mindx])) { 01630 sindx = src_indx1 + (j * src_strd[dimenlc]); 01631 if ((i4ptr[sindx]^i4lval) >= 0) { 01632 if (i4ptr[sindx] < i4lval) { 01633 rptr0 = j; 01634 rptr1 = i; 01635 i4lval = i4ptr[sindx]; 01636 } 01637 } else { 01638 if (i4ptr[sindx] < 0) { 01639 rptr0 = j; 01640 rptr1 = i; 01641 i4lval = i4ptr[sindx]; 01642 } 01643 } 01644 } 01645 } 01646 if (dimension != NULL) { 01647 rindx = i * res_strd; 01648 i4lval = HUGE_INT4_F90; 01649 switch (typeflag) { 01650 case 4: 01651 rptr_4[rindx] = rptr0 + 1; /* set result */ 01652 break; 01653 #ifdef _F_INT2 01654 case 2: 01655 rptr_2[rindx] = rptr0 + 1; /* set result */ 01656 break; 01657 #endif 01658 #ifdef _F_INT1 01659 case 1: 01660 rptr_1[rindx] = rptr0 + 1; /* set result */ 01661 break; 01662 #endif 01663 case 8: 01664 rptr_8[rindx] = rptr0 + 1; /* set result */ 01665 } 01666 rptr0 = -1; 01667 rptr1 = -1; 01668 } 01669 } 01670 } else { /* no mask */ 01671 rptr0 = 0; 01672 rptr1 = 0; 01673 for (i = 0; i < ext[ndim]; i++) { 01674 src_indx1 = i * src_strd[ndim]; 01675 for (j = 0; j < ext[dimenlc]; j++) { 01676 sindx = src_indx1 + (j * src_strd[dimenlc]); 01677 if ((i4ptr[sindx]^i4lval) >= 0) { 01678 if (i4ptr[sindx] < i4lval) { 01679 rptr0 = j; 01680 rptr1 = i; 01681 i4lval = i4ptr[sindx]; 01682 } 01683 } else { 01684 if (i4ptr[sindx] < 0) { 01685 rptr0 = j; 01686 rptr1 = i; 01687 i4lval = i4ptr[sindx]; 01688 } 01689 } 01690 } 01691 if (dimension != NULL) { 01692 rindx = i * res_strd; 01693 i4lval = HUGE_INT4_F90; 01694 switch (typeflag) { 01695 case 4: 01696 rptr_4[rindx] = rptr0 + 1; /* set result */ 01697 break; 01698 #ifdef _F_INT2 01699 case 2: 01700 rptr_2[rindx] = rptr0 + 1; /* set result */ 01701 break; 01702 #endif 01703 #ifdef _F_INT1 01704 case 1: 01705 rptr_1[rindx] = rptr0 + 1; /* set result */ 01706 break; 01707 #endif 01708 case 8: 01709 rptr_8[rindx] = rptr0 + 1; /* set result */ 01710 } 01711 rptr0 = 0; 01712 rptr1 = 0; 01713 } 01714 } 01715 } 01716 if (dimension == NULL) { 01717 switch (typeflag) { 01718 case 4: 01719 rptr_4[0] = rptr0 + 1; /* set result */ 01720 rptr_4[res_strd] = rptr1 + 1; 01721 break; 01722 #ifdef _F_INT2 01723 case 2: 01724 rptr_2[0] = rptr0 + 1; /* set result */ 01725 rptr_2[res_strd] = rptr1 + 1; 01726 break; 01727 #endif 01728 #ifdef _F_INT1 01729 case 1: 01730 rptr_1[0] = rptr0 + 1; /* set result */ 01731 rptr_1[res_strd] = rptr1 + 1; 01732 break; 01733 #endif 01734 case 8: 01735 rptr_8[0] = rptr0 + 1; /* set result */ 01736 rptr_8[res_strd] = rptr1 + 1; 01737 } 01738 } 01739 break; 01740 01741 #ifdef _F_INT2 01742 case DVSUBTYPE_BIT16 : 01743 i2ptr = (_f_int2 *) source->base_addr.a.ptr; 01744 i2lval = HUGE_INT2_F90; 01745 if (use_mask) { /* mask specified */ 01746 rptr0 = -1; 01747 rptr1 = -1; 01748 for (i = 0; i < ext[ndim]; i++) { 01749 msk_indx1 = i * msk_strd[ndim]; 01750 src_indx1 = i * src_strd[ndim]; 01751 for (j = 0; j < ext[dimenlc]; j++) { 01752 mindx = msk_indx1 + (j * msk_strd[dimenlc]); 01753 if (LTOB(mask_el_len, &mptr[mindx])) { 01754 sindx = src_indx1 + (j * src_strd[dimenlc]); 01755 if ((i2ptr[sindx]^i2lval) >= 0) { 01756 if (i2ptr[sindx] < i2lval) { 01757 rptr0 = j; 01758 rptr1 = i; 01759 i2lval = i2ptr[sindx]; 01760 } 01761 } else { 01762 if (i2ptr[sindx] < 0) { 01763 rptr0 = j; 01764 rptr1 = i; 01765 i2lval = i2ptr[sindx]; 01766 } 01767 } 01768 } 01769 } 01770 if (dimension != NULL) { 01771 rindx = i * res_strd; 01772 i2lval = HUGE_INT2_F90; 01773 switch (typeflag) { 01774 case 4: 01775 rptr_4[rindx] = rptr0 + 1; /* set result */ 01776 break; 01777 case 2: 01778 rptr_2[rindx] = rptr0 + 1; /* set result */ 01779 break; 01780 #ifdef _F_INT1 01781 case 1: 01782 rptr_1[rindx] = rptr0 + 1; /* set result */ 01783 break; 01784 #endif 01785 case 8: 01786 rptr_8[rindx] = rptr0 + 1; /* set result */ 01787 } 01788 rptr0 = -1; 01789 rptr1 = -1; 01790 } 01791 } 01792 } else { /* no mask */ 01793 rptr0 = 0; 01794 rptr1 = 0; 01795 for (i = 0; i < ext[ndim]; i++) { 01796 src_indx1 = i * src_strd[ndim]; 01797 for (j = 0; j < ext[dimenlc]; j++) { 01798 sindx = src_indx1 + (j * src_strd[dimenlc]); 01799 if ((i2ptr[sindx]^i2lval) >= 0) { 01800 if (i2ptr[sindx] < i2lval) { 01801 rptr0 = j; 01802 rptr1 = i; 01803 i2lval = i2ptr[sindx]; 01804 } 01805 } else { 01806 if (i2ptr[sindx] < 0) { 01807 rptr0 = j; 01808 rptr1 = i; 01809 i2lval = i2ptr[sindx]; 01810 } 01811 } 01812 } 01813 if (dimension != NULL) { 01814 rindx = i * res_strd; 01815 i2lval = HUGE_INT2_F90; 01816 switch (typeflag) { 01817 case 4: 01818 rptr_4[rindx] = rptr0 + 1; /* set result */ 01819 break; 01820 case 2: 01821 rptr_2[rindx] = rptr0 + 1; /* set result */ 01822 break; 01823 #ifdef _F_INT1 01824 case 1: 01825 rptr_1[rindx] = rptr0 + 1; /* set result */ 01826 break; 01827 #endif 01828 case 8: 01829 rptr_8[rindx] = rptr0 + 1; /* set result */ 01830 } 01831 rptr0 = 0; 01832 rptr1 = 0; 01833 } 01834 } 01835 } 01836 if (dimension == NULL) { 01837 switch (typeflag) { 01838 case 4: 01839 rptr_4[0] = rptr0 + 1; /* set result */ 01840 rptr_4[res_strd] = rptr1 + 1; 01841 break; 01842 case 2: 01843 rptr_2[0] = rptr0 + 1; /* set result */ 01844 rptr_2[res_strd] = rptr1 + 1; 01845 break; 01846 #ifdef _F_INT1 01847 case 1: 01848 rptr_1[0] = rptr0 + 1; /* set result */ 01849 rptr_1[res_strd] = rptr1 + 1; 01850 break; 01851 #endif 01852 case 8: 01853 rptr_8[0] = rptr0 + 1; /* set result */ 01854 rptr_8[res_strd] = rptr1 + 1; 01855 } 01856 } 01857 break; 01858 #endif 01859 01860 #ifdef _F_INT1 01861 case DVSUBTYPE_BIT8 : 01862 i1ptr = (_f_int1 *) source->base_addr.a.ptr; 01863 i1lval = HUGE_INT1_F90; 01864 if (use_mask) { /* mask specified */ 01865 rptr0 = -1; 01866 rptr1 = -1; 01867 for (i = 0; i < ext[ndim]; i++) { 01868 msk_indx1 = i * msk_strd[ndim]; 01869 src_indx1 = i * src_strd[ndim]; 01870 for (j = 0; j < ext[dimenlc]; j++) { 01871 mindx = msk_indx1 + (j * msk_strd[dimenlc]); 01872 if (LTOB(mask_el_len, &mptr[mindx])) { 01873 sindx = src_indx1 + (j * src_strd[dimenlc]); 01874 if ((i1ptr[sindx]^i1lval) >= 0) { 01875 if (i1ptr[sindx] < i1lval) { 01876 rptr0 = j; 01877 rptr1 = i; 01878 i1lval = i1ptr[sindx]; 01879 } 01880 } else { 01881 if (i1ptr[sindx] < 0) { 01882 rptr0 = j; 01883 rptr1 = i; 01884 i1lval = i1ptr[sindx]; 01885 } 01886 } 01887 } 01888 } 01889 if (dimension != NULL) { 01890 rindx = i * res_strd; 01891 i1lval = HUGE_INT1_F90; 01892 switch (typeflag) { 01893 case 4: 01894 rptr_4[rindx] = rptr0 + 1; /* set result */ 01895 break; 01896 case 2: 01897 rptr_2[rindx] = rptr0 + 1; /* set result */ 01898 break; 01899 case 1: 01900 rptr_1[rindx] = rptr0 + 1; /* set result */ 01901 break; 01902 case 8: 01903 rptr_8[rindx] = rptr0 + 1; /* set result */ 01904 } 01905 rptr0 = -1; 01906 rptr1 = -1; 01907 } 01908 } 01909 } else { /* no mask */ 01910 rptr0 = 0; 01911 rptr1 = 0; 01912 for (i = 0; i < ext[ndim]; i++) { 01913 src_indx1 = i * src_strd[ndim]; 01914 for (j = 0; j < ext[dimenlc]; j++) { 01915 sindx = src_indx1 + (j * src_strd[dimenlc]); 01916 if ((i1ptr[sindx]^i1lval) >= 0) { 01917 if (i1ptr[sindx] < i1lval) { 01918 rptr0 = j; 01919 rptr1 = i; 01920 i1lval = i1ptr[sindx]; 01921 } 01922 } else { 01923 if (i1ptr[sindx] < 0) { 01924 rptr0 = j; 01925 rptr1 = i; 01926 i1lval = i1ptr[sindx]; 01927 } 01928 } 01929 } 01930 if (dimension != NULL) { 01931 rindx = i * res_strd; 01932 i1lval = HUGE_INT1_F90; 01933 switch (typeflag) { 01934 case 4: 01935 rptr_4[rindx] = rptr0 + 1; /* set result */ 01936 break; 01937 case 2: 01938 rptr_2[rindx] = rptr0 + 1; /* set result */ 01939 break; 01940 case 1: 01941 rptr_1[rindx] = rptr0 + 1; /* set result */ 01942 break; 01943 case 8: 01944 rptr_8[rindx] = rptr0 + 1; /* set result */ 01945 } 01946 rptr0 = 0; 01947 rptr1 = 0; 01948 } 01949 } 01950 } 01951 if (dimension == NULL) { 01952 switch (typeflag) { 01953 case 4: 01954 rptr_4[0] = rptr0 + 1; /* set result */ 01955 rptr_4[res_strd] = rptr1 + 1; 01956 break; 01957 case 2: 01958 rptr_2[0] = rptr0 + 1; /* set result */ 01959 rptr_2[res_strd] = rptr1 + 1; 01960 break; 01961 case 1: 01962 rptr_1[0] = rptr0 + 1; /* set result */ 01963 rptr_1[res_strd] = rptr1 + 1; 01964 break; 01965 case 8: 01966 rptr_8[0] = rptr0 + 1; /* set result */ 01967 rptr_8[res_strd] = rptr1 + 1; 01968 } 01969 } 01970 break; 01971 #endif 01972 01973 case DVSUBTYPE_INT64 : 01974 i8ptr = (_f_int8 *) source->base_addr.a.ptr; 01975 i8lval = HUGE_INT8_F90; 01976 if (use_mask) { /* mask specified */ 01977 rptr0 = -1; 01978 rptr1 = -1; 01979 for (i = 0; i < ext[ndim]; i++) { 01980 msk_indx1 = i * msk_strd[ndim]; 01981 src_indx1 = i * src_strd[ndim]; 01982 for (j = 0; j < ext[dimenlc]; j++) { 01983 mindx = msk_indx1 + (j * msk_strd[dimenlc]); 01984 if (LTOB(mask_el_len, &mptr[mindx])) { 01985 sindx = src_indx1 + (j * src_strd[dimenlc]); 01986 if ((i8ptr[sindx]^i8lval) >= 0) { 01987 if (i8ptr[sindx] < i8lval) { 01988 rptr0 = j; 01989 rptr1 = i; 01990 i8lval = i8ptr[sindx]; 01991 } 01992 } else { 01993 if (i8ptr[sindx] < 0) { 01994 rptr0 = j; 01995 rptr1 = i; 01996 i8lval = i8ptr[sindx]; 01997 } 01998 } 01999 } 02000 } 02001 if (dimension != NULL) { 02002 rindx = i * res_strd; 02003 i8lval = HUGE_INT8_F90; 02004 switch (typeflag) { 02005 case 4: 02006 rptr_4[rindx] = rptr0 + 1; /* set result */ 02007 break; 02008 #ifdef _F_INT2 02009 case 2: 02010 rptr_2[rindx] = rptr0 + 1; /* set result */ 02011 break; 02012 #endif 02013 #ifdef _F_INT1 02014 case 1: 02015 rptr_1[rindx] = rptr0 + 1; /* set result */ 02016 break; 02017 #endif 02018 case 8: 02019 rptr_8[rindx] = rptr0 + 1; /* set result */ 02020 } 02021 rptr0 = -1; 02022 rptr1 = -1; 02023 } 02024 } 02025 } else { /* no mask */ 02026 rptr0 = 0; 02027 rptr1 = 0; 02028 for (i = 0; i < ext[ndim]; i++) { 02029 src_indx1 = i * src_strd[ndim]; 02030 for (j = 0; j < ext[dimenlc]; j++) { 02031 sindx = src_indx1 + (j * src_strd[dimenlc]); 02032 if ((i8ptr[sindx]^i8lval) >= 0) { 02033 if (i8ptr[sindx] < i8lval) { 02034 rptr0 = j; 02035 rptr1 = i; 02036 i8lval = i8ptr[sindx]; 02037 } 02038 } else { 02039 if (i8ptr[sindx] < 0) { 02040 rptr0 = j; 02041 rptr1 = i; 02042 i8lval = i8ptr[sindx]; 02043 } 02044 } 02045 } 02046 if (dimension != NULL) { 02047 rindx = i * res_strd; 02048 i8lval = HUGE_INT8_F90; 02049 switch (typeflag) { 02050 case 4: 02051 rptr_4[rindx] = rptr0 + 1; /* set result */ 02052 break; 02053 #ifdef _F_INT2 02054 case 2: 02055 rptr_2[rindx] = rptr0 + 1; /* set result */ 02056 break; 02057 #endif 02058 #ifdef _F_INT1 02059 case 1: 02060 rptr_1[rindx] = rptr0 + 1; /* set result */ 02061 break; 02062 #endif 02063 case 8: 02064 rptr_8[rindx] = rptr0 + 1; /* set result */ 02065 } 02066 rptr0 = 0; 02067 rptr1 = 0; 02068 } 02069 } 02070 } 02071 if (dimension == NULL) { 02072 switch (typeflag) { 02073 case 4: 02074 rptr_4[0] = rptr0 + 1; /* set result */ 02075 rptr_4[res_strd] = rptr1 + 1; 02076 break; 02077 #ifdef _F_INT2 02078 case 2: 02079 rptr_2[0] = rptr0 + 1; /* set result */ 02080 rptr_2[res_strd] = rptr1 + 1; 02081 break; 02082 #endif 02083 #ifdef _F_INT1 02084 case 1: 02085 rptr_1[0] = rptr0 + 1; /* set result */ 02086 rptr_1[res_strd] = rptr1 + 1; 02087 break; 02088 #endif 02089 case 8: 02090 rptr_8[0] = rptr0 + 1; /* set result */ 02091 rptr_8[res_strd] = rptr1 + 1; 02092 } 02093 } 02094 break; 02095 02096 case DVSUBTYPE_REAL64 : 02097 r8ptr = (_f_real8 *) source->base_addr.a.ptr; 02098 r8lval = HUGE_REAL8_F90; 02099 if (use_mask) { /* mask specified */ 02100 rptr0 = -1; 02101 rptr1 = -1; 02102 for (i = 0; i < ext[ndim]; i++) { 02103 msk_indx1 = i * msk_strd[ndim]; 02104 src_indx1 = i * src_strd[ndim]; 02105 for (j = 0; j < ext[dimenlc]; j++) { 02106 mindx = msk_indx1 + (j * msk_strd[dimenlc]); 02107 if (LTOB(mask_el_len, &mptr[mindx])) { 02108 sindx = src_indx1 + (j * src_strd[dimenlc]); 02109 if (r8ptr[sindx] < r8lval) { 02110 rptr0 = j; 02111 rptr1 = i; 02112 r8lval = r8ptr[sindx]; 02113 } 02114 } 02115 } 02116 if (dimension != NULL) { 02117 rindx = i * res_strd; 02118 r8lval = HUGE_REAL8_F90; 02119 switch (typeflag) { 02120 case 4: 02121 rptr_4[rindx] = rptr0 + 1; /* set result */ 02122 break; 02123 #ifdef _F_INT2 02124 case 2: 02125 rptr_2[rindx] = rptr0 + 1; /* set result */ 02126 break; 02127 #endif 02128 #ifdef _F_INT1 02129 case 1: 02130 rptr_1[rindx] = rptr0 + 1; /* set result */ 02131 break; 02132 #endif 02133 case 8: 02134 rptr_8[rindx] = rptr0 + 1; /* set result */ 02135 } 02136 rptr0 = -1; 02137 rptr1 = -1; 02138 } 02139 } 02140 } else { /* no mask */ 02141 rptr0 = 0; 02142 rptr1 = 0; 02143 for (i = 0; i < ext[ndim]; i++) { 02144 src_indx1 = i * src_strd[ndim]; 02145 for (j = 0; j < ext[dimenlc]; j++) { 02146 sindx = src_indx1 + (j * src_strd[dimenlc]); 02147 if (r8ptr[sindx] < r8lval) { 02148 rptr0 = j; 02149 rptr1 = i; 02150 r8lval = r8ptr[sindx]; 02151 } 02152 } 02153 if (dimension != NULL) { 02154 rindx = i * res_strd; 02155 r8lval = HUGE_REAL8_F90; 02156 switch (typeflag) { 02157 case 4: 02158 rptr_4[rindx] = rptr0 + 1; /* set result */ 02159 break; 02160 #ifdef _F_INT2 02161 case 2: 02162 rptr_2[rindx] = rptr0 + 1; /* set result */ 02163 break; 02164 #endif 02165 #ifdef _F_INT1 02166 case 1: 02167 rptr_1[rindx] = rptr0 + 1; /* set result */ 02168 break; 02169 #endif 02170 case 8: 02171 rptr_8[rindx] = rptr0 + 1; /* set result */ 02172 } 02173 rptr0 = 0; 02174 rptr1 = 0; 02175 } 02176 } 02177 } 02178 if (dimension == NULL) { 02179 switch (typeflag) { 02180 case 4: 02181 rptr_4[0] = rptr0 + 1; /* set result */ 02182 rptr_4[res_strd] = rptr1 + 1; 02183 break; 02184 #ifdef _F_INT2 02185 case 2: 02186 rptr_2[0] = rptr0 + 1; /* set result */ 02187 rptr_2[res_strd] = rptr1 + 1; 02188 break; 02189 #endif 02190 #ifdef _F_INT1 02191 case 1: 02192 rptr_1[0] = rptr0 + 1; /* set result */ 02193 rptr_1[res_strd] = rptr1 + 1; 02194 break; 02195 #endif 02196 case 8: 02197 rptr_8[0] = rptr0 + 1; /* set result */ 02198 rptr_8[res_strd] = rptr1 + 1; 02199 } 02200 } 02201 break; 02202 02203 case DVSUBTYPE_REAL32 : 02204 r4ptr = (_f_real4 *) source->base_addr.a.ptr; 02205 r4lval = HUGE_REAL4_F90; 02206 if (use_mask) { /* mask specified */ 02207 rptr0 = -1; 02208 rptr1 = -1; 02209 for (i = 0; i < ext[ndim]; i++) { 02210 msk_indx1 = i * msk_strd[ndim]; 02211 src_indx1 = i * src_strd[ndim]; 02212 for (j = 0; j < ext[dimenlc]; j++) { 02213 mindx = msk_indx1 + (j * msk_strd[dimenlc]); 02214 if (LTOB(mask_el_len, &mptr[mindx])) { 02215 sindx = src_indx1 + (j * src_strd[dimenlc]); 02216 if (r4ptr[sindx] < r4lval) { 02217 rptr0 = j; 02218 rptr1 = i; 02219 r4lval = r4ptr[sindx]; 02220 } 02221 } 02222 } 02223 if (dimension != NULL) { 02224 rindx = i * res_strd; 02225 r4lval = HUGE_REAL4_F90; 02226 switch (typeflag) { 02227 case 4: 02228 rptr_4[rindx] = rptr0 + 1; /* set result */ 02229 break; 02230 #ifdef _F_INT2 02231 case 2: 02232 rptr_2[rindx] = rptr0 + 1; /* set result */ 02233 break; 02234 #endif 02235 #ifdef _F_INT1 02236 case 1: 02237 rptr_1[rindx] = rptr0 + 1; /* set result */ 02238 break; 02239 #endif 02240 case 8: 02241 rptr_8[rindx] = rptr0 + 1; /* set result */ 02242 } 02243 rptr0 = -1; 02244 rptr1 = -1; 02245 } 02246 } 02247 } else { /* no mask */ 02248 rptr0 = 0; 02249 rptr1 = 0; 02250 for (i = 0; i < ext[ndim]; i++) { 02251 src_indx1 = i * src_strd[ndim]; 02252 for (j = 0; j < ext[dimenlc]; j++) { 02253 sindx = src_indx1 + (j * src_strd[dimenlc]); 02254 if (r4ptr[sindx] < r4lval) { 02255 rptr0 = j; 02256 rptr1 = i; 02257 r4lval = r4ptr[sindx]; 02258 } 02259 } 02260 if (dimension != NULL) { 02261 rindx = i * res_strd; 02262 r4lval = HUGE_REAL4_F90; 02263 switch (typeflag) { 02264 case 4: 02265 rptr_4[rindx] = rptr0 + 1; /* set result */ 02266 break; 02267 #ifdef _F_INT2 02268 case 2: 02269 rptr_2[rindx] = rptr0 + 1; /* set result */ 02270 break; 02271 #endif 02272 #ifdef _F_INT1 02273 case 1: 02274 rptr_1[rindx] = rptr0 + 1; /* set result */ 02275 break; 02276 #endif 02277 case 8: 02278 rptr_8[rindx] = rptr0 + 1; /* set result */ 02279 } 02280 rptr0 = 0; 02281 rptr1 = 0; 02282 } 02283 } 02284 } 02285 if (dimension == NULL) { 02286 switch (typeflag) { 02287 case 4: 02288 rptr_4[0] = rptr0 + 1; /* set result */ 02289 rptr_4[res_strd] = rptr1 + 1; 02290 break; 02291 #ifdef _F_INT2 02292 case 2: 02293 rptr_2[0] = rptr0 + 1; /* set result */ 02294 rptr_2[res_strd] = rptr1 + 1; 02295 break; 02296 #endif 02297 #ifdef _F_INT1 02298 case 1: 02299 rptr_1[0] = rptr0 + 1; /* set result */ 02300 rptr_1[res_strd] = rptr1 + 1; 02301 break; 02302 #endif 02303 case 8: 02304 rptr_8[0] = rptr0 + 1; /* set result */ 02305 rptr_8[res_strd] = rptr1 + 1; 02306 } 02307 } 02308 break; 02309 02310 #if defined _F_REAL16 && _F_REAL16 != (-1) 02311 case DVSUBTYPE_REAL128 : 02312 r16ptr = (_f_real16 *) source->base_addr.a.ptr; 02313 r16lval = HUGE_REAL16_F90; 02314 if (use_mask) { /* mask specified */ 02315 rptr0 = -1; 02316 rptr1 = -1; 02317 for (i = 0; i < ext[ndim]; i++) { 02318 msk_indx1 = i * msk_strd[ndim]; 02319 src_indx1 = i * src_strd[ndim]; 02320 for (j = 0; j < ext[dimenlc]; j++) { 02321 mindx = msk_indx1 + (j * msk_strd[dimenlc]); 02322 if (LTOB(mask_el_len, &mptr[mindx])) { 02323 sindx = src_indx1 + (j * src_strd[dimenlc]); 02324 if (r16ptr[sindx] < r16lval) { 02325 rptr0 = j; 02326 rptr1 = i; 02327 r16lval = r16ptr[sindx]; 02328 } 02329 } 02330 } 02331 if (dimension != NULL) { 02332 rindx = i * res_strd; 02333 r16lval = HUGE_REAL16_F90; 02334 switch (typeflag) { 02335 case 4: 02336 rptr_4[rindx] = rptr0 + 1; /* set result */ 02337 break; 02338 #ifdef _F_INT2 02339 case 2: 02340 rptr_2[rindx] = rptr0 + 1; /* set result */ 02341 break; 02342 #endif 02343 #ifdef _F_INT1 02344 case 1: 02345 rptr_1[rindx] = rptr0 + 1; /* set result */ 02346 break; 02347 #endif 02348 case 8: 02349 rptr_8[rindx] = rptr0 + 1; /* set result */ 02350 } 02351 rptr0 = -1; 02352 rptr1 = -1; 02353 } 02354 } 02355 } else { /* no mask */ 02356 rptr0 = 0; 02357 rptr1 = 0; 02358 for (i = 0; i < ext[ndim]; i++) { 02359 src_indx1 = i * src_strd[ndim]; 02360 for (j = 0; j < ext[dimenlc]; j++) { 02361 sindx = src_indx1 + (j * src_strd[dimenlc]); 02362 if (r16ptr[sindx] < r16lval) { 02363 rptr0 = j; 02364 rptr1 = i; 02365 r16lval = r16ptr[sindx]; 02366 } 02367 } 02368 if (dimension != NULL) { 02369 rindx = i * res_strd; 02370 r16lval = HUGE_REAL16_F90; 02371 switch (typeflag) { 02372 case 4: 02373 rptr_4[rindx] = rptr0 + 1; /* set result */ 02374 break; 02375 #ifdef _F_INT2 02376 case 2: 02377 rptr_2[rindx] = rptr0 + 1; /* set result */ 02378 break; 02379 #endif 02380 #ifdef _F_INT1 02381 case 1: 02382 rptr_1[rindx] = rptr0 + 1; /* set result */ 02383 break; 02384 #endif 02385 case 8: 02386 rptr_8[rindx] = rptr0 + 1; /* set result */ 02387 } 02388 rptr0 = 0; 02389 rptr1 = 0; 02390 } 02391 } 02392 } 02393 if (dimension == NULL) { 02394 switch (typeflag) { 02395 case 4: 02396 rptr_4[0] = rptr0 + 1; /* set result */ 02397 rptr_4[res_strd] = rptr1 + 1; 02398 break; 02399 #ifdef _F_INT2 02400 case 2: 02401 rptr_2[0] = rptr0 + 1; /* set result */ 02402 rptr_2[res_strd] = rptr1 + 1; 02403 break; 02404 #endif 02405 #ifdef _F_INT1 02406 case 1: 02407 rptr_1[0] = rptr0 + 1; /* set result */ 02408 rptr_1[res_strd] = rptr1 + 1; 02409 break; 02410 #endif 02411 case 8: 02412 rptr_8[0] = rptr0 + 1; /* set result */ 02413 rptr_8[res_strd] = rptr1 + 1; 02414 } 02415 } 02416 break; 02417 #endif 02418 02419 default : 02420 _lerror (_LELVL_ABORT, FEINTDTY); 02421 } 02422 02423 /* 02424 * Rank 3-7 arrays are all folded into one section for processing. 02425 * These are also broken down by data type. 02426 * 02427 * The processing for these ranks is all done in one loop. The number of 02428 * words added to the base address for each dimension are stored in an 02429 * array. There is one of these arrays for source (src_off), mask 02430 * (msk_off). These offsets are added in a macro before the values are 02431 * referenced. For each iteration, another macro is called to increment 02432 * all of the indices. At the conclusion of the loop, the return values 02433 * are put into the result array. 02434 */ 02435 02436 } else { 02437 02438 /* Initialize the curdim array */ 02439 for (i = 0; i < MAXDIM; i++) 02440 curdim[i] = 0; 02441 02442 /* Initialize arrays used in block for DIM argument entry. */ 02443 02444 if (dimension != NULL) { 02445 src_dim_ext = source->dimension[dimenlc].extent; 02446 if (bucketsize > 1) 02447 src_dim_strd = source->dimension[dimenlc].stride_mult / bucketsize; 02448 else 02449 src_dim_strd = source->dimension[dimenlc].stride_mult; 02450 if (use_mask) { 02451 msk_dim_ext = mask->dimension[dimenlc].extent; 02452 msk_dim_strd = mask->dimension[dimenlc].stride_mult; 02453 #ifdef _CRAYMPP 02454 if (mask_el_len == 64 && sizeof(mptr[0]) == 4) 02455 msk_dim_strd <<= 1; 02456 #endif 02457 } 02458 for (i = 0; i < rank-1; i++) { 02459 res_ext[i] = result->dimension[i].extent; 02460 res_off[i] = 0; 02461 if (resbucketsize > 1) 02462 res_strdm[i] = result->dimension[i].stride_mult / resbucketsize; 02463 else 02464 res_strdm[i] = result->dimension[i].stride_mult; 02465 } 02466 for (i = 0, tot_ext = 1; i < dimenlc; i++) { 02467 if (bucketsize > 1) 02468 src_strd[i] = source->dimension[i].stride_mult / bucketsize; 02469 else 02470 src_strd[i] = source->dimension[i].stride_mult; 02471 ext[i] = source->dimension[i].extent; 02472 src_off[i] = 0; 02473 tot_ext *= ext[i]; 02474 } 02475 for ( ; i < rank - 1; i++) { 02476 src_off[i] = 0; 02477 ext[i] = source->dimension[i+1].extent; 02478 if (bucketsize > 1) 02479 src_strd[i] = source->dimension[i+1].stride_mult / bucketsize; 02480 else 02481 src_strd[i] = source->dimension[i+1].stride_mult; 02482 tot_ext *= ext[i]; 02483 } 02484 02485 for ( ; i < MAXDIM; i++) 02486 ext[i] = 0; 02487 if (use_mask) { 02488 for (i = 0; i < dimenlc; i++) { 02489 msk_strd[i] = mask->dimension[i].stride_mult; 02490 #ifdef _CRAYMPP 02491 if (mask_el_len == 64 && sizeof(mptr[0]) == 4) 02492 msk_strd[i] <<= 1; 02493 #endif 02494 msk_off[i] = 0; 02495 } 02496 02497 for ( ; i < rank - 1; i++) { 02498 msk_strd[i] = mask->dimension[i+1].stride_mult; 02499 #ifdef _CRAYMPP 02500 if (mask_el_len == 64 && sizeof(mptr[0]) == 4) 02501 msk_strd[i] <<= 1; 02502 #endif 02503 msk_off[i] = 0; 02504 } 02505 } 02506 } else { /* non-DIM entry */ 02507 for ( i = 0, tot_ext = 1; i < rank; i++) { 02508 ext[i] = source->dimension[i].extent; 02509 if (bucketsize > 1) 02510 src_strd[i] = source->dimension[i].stride_mult / bucketsize; 02511 else 02512 src_strd[i] = source->dimension[i].stride_mult; 02513 tot_ext *= ext[i]; 02514 } 02515 for ( ; i < MAXDIM; i++) 02516 ext[i] = 0; 02517 src_sub[0] = 0; 02518 src_incr[0] = src_strd[0]; 02519 for (i = 1; i < rank; i++) { 02520 src_sub[i] = src_sub[i-1] + ((ext[i-1] - 1) * src_strd[i-1]); 02521 src_incr[i] = src_strd[i] - src_sub[i]; 02522 } 02523 for ( ; i < MAXDIM; i++) 02524 src_incr[i] = 0; 02525 if (use_mask) { 02526 for ( i = 0; i < rank; i++) { 02527 msk_strd[i] = mask->dimension[i].stride_mult; 02528 #ifdef _CRAYMPP 02529 if (mask_el_len == 64 && sizeof(mptr[0]) == 4) 02530 msk_strd[i] <<= 1; 02531 #endif 02532 } 02533 msk_sub[0] = 0; 02534 msk_incr[0] = msk_strd[0]; 02535 for (i = 1; i < rank; i++) { 02536 msk_sub[i] = msk_sub[i-1] + ((ext[i-1] - 1) * msk_strd[i-1]); 02537 msk_incr[i] = msk_strd[i] - msk_sub[i]; 02538 } 02539 for ( ; i < MAXDIM; i++) 02540 msk_incr[i] = 0; 02541 } 02542 } 02543 02544 /* initialize result scalars for no dim argument. */ 02545 02546 if (dimension == NULL) { 02547 if (use_mask) { 02548 rptr0 = -1; 02549 rptr1 = -1; 02550 rptr2 = -1; 02551 rptr3 = -1; 02552 rptr4 = -1; 02553 rptr5 = -1; 02554 rptr6 = -1; 02555 } else { 02556 rptr0 = 0; 02557 rptr1 = 0; 02558 rptr2 = 0; 02559 rptr3 = 0; 02560 rptr4 = 0; 02561 rptr5 = 0; 02562 rptr6 = 0; 02563 } 02564 } 02565 02566 switch (subtype) { 02567 #ifdef _F_INT6 02568 case DVSUBTYPE_INT46 : 02569 i6ptr = (_f_int6 *) source->base_addr.a.ptr; 02570 i6lval = HUGE_INT6_F90; 02571 if (dimension == NULL) { 02572 sindx = 0; 02573 if (use_mask) { /* mask specified */ 02574 mindx = 0; 02575 for (i = 0; i < tot_ext; i++) { 02576 if (LTOB(mask_el_len, &mptr[mindx])) { 02577 if (i6ptr[sindx] < i6lval) { 02578 i6lval = i6ptr[sindx]; 02579 _SET_INDEX(); 02580 } 02581 } 02582 _INCREMENT_TWO(); 02583 } 02584 } else { 02585 for (i = 0; i < tot_ext; i++) { 02586 if (i6ptr[sindx] < i6lval) { 02587 i6lval = i6ptr[sindx]; 02588 _SET_INDEX(); 02589 } 02590 _INCREMENT_ONE(); 02591 } 02592 } 02593 _FINAL_INDEX(); /* put temp values into result */ 02594 } else { 02595 if (use_mask) { /* mask specified */ 02596 for (i = 0; i < tot_ext; i++) { 02597 src_indx1 = 0; 02598 msk_indx1 = 0; 02599 res_indx1 = -1; 02600 for (j = 0; j < rank - 1; j++) { 02601 src_indx1 += src_off[j]; 02602 msk_indx1 += msk_off[j]; 02603 } 02604 for (j = 0; j < src_dim_ext; j++) { 02605 mindx = msk_indx1 + (j * msk_dim_strd); 02606 if (LTOB(mask_el_len, &mptr[mindx])) { 02607 sindx = src_indx1 + (j * src_dim_strd); 02608 if (i6ptr[sindx] < i6lval) { 02609 i6lval = i6ptr[sindx]; 02610 res_indx1 = j; 02611 } 02612 } 02613 } 02614 rindx = 0; 02615 for (j = 0; j < rank - 1; j++) 02616 rindx += res_off[j]; 02617 _INTERM_INDEX(); 02618 i6lval = HUGE_INT6_F90; 02619 _INCREMENT_D_TWO(); /* increment indices */ 02620 } 02621 } else { 02622 for (i = 0; i < tot_ext; i++) { 02623 src_indx1 = 0; 02624 res_indx1 = -1; 02625 for (j = 0; j < rank - 1; j++) 02626 src_indx1 += src_off[j]; 02627 for (j = 0; j < src_dim_ext; j++) { 02628 sindx = src_indx1 + (j * src_dim_strd); 02629 if (i6ptr[sindx] < i6lval) { 02630 i6lval = i6ptr[sindx]; 02631 res_indx1 = j; 02632 } 02633 } 02634 rindx = 0; 02635 for (j = 0; j < rank - 1; j++) 02636 rindx += res_off[j]; 02637 _INTERM_INDEX(); 02638 i6lval = HUGE_INT6_F90; 02639 _INCREMENT_D_ONE(); 02640 } 02641 } 02642 } 02643 break; 02644 #endif 02645 02646 case DVSUBTYPE_INT32 : 02647 i4ptr = (_f_int4 *) source->base_addr.a.ptr; 02648 i4lval = HUGE_INT4_F90; 02649 if (dimension == NULL) { 02650 sindx = 0; 02651 if (use_mask) { /* mask specified */ 02652 mindx = 0; 02653 for (i = 0; i < tot_ext; i++) { 02654 if (LTOB(mask_el_len, &mptr[mindx])) { 02655 if ((i4ptr[sindx]^i4lval) >= 0) { 02656 if (i4ptr[sindx] < i4lval) { 02657 i4lval = i4ptr[sindx]; 02658 _SET_INDEX(); 02659 } 02660 } else { 02661 if (i4ptr[sindx] < 0) { 02662 i4lval = i4ptr[sindx]; 02663 _SET_INDEX(); 02664 } 02665 } 02666 } 02667 _INCREMENT_TWO(); 02668 } 02669 } else { 02670 for (i = 0; i < tot_ext; i++) { 02671 if ((i4ptr[sindx]^i4lval) >= 0) { 02672 if (i4ptr[sindx] < i4lval) { 02673 i4lval = i4ptr[sindx]; 02674 _SET_INDEX(); 02675 } 02676 } else { 02677 if (i4ptr[sindx] < 0) { 02678 i4lval = i4ptr[sindx]; 02679 _SET_INDEX(); 02680 } 02681 } 02682 _INCREMENT_ONE(); 02683 } 02684 } 02685 _FINAL_INDEX(); /* put temp values into result */ 02686 } else { 02687 if (use_mask) { /* mask specified */ 02688 for (i = 0; i < tot_ext; i++) { 02689 src_indx1 = 0; 02690 msk_indx1 = 0; 02691 res_indx1 = -1; 02692 for (j = 0; j < rank - 1; j++) { 02693 src_indx1 += src_off[j]; 02694 msk_indx1 += msk_off[j]; 02695 } 02696 for (j = 0; j < src_dim_ext; j++) { 02697 mindx = msk_indx1 + (j * msk_dim_strd); 02698 if (LTOB(mask_el_len, &mptr[mindx])) { 02699 sindx = src_indx1 + (j * src_dim_strd); 02700 if ((i4ptr[sindx]^i4lval) >= 0) { 02701 if (i4ptr[sindx] < i4lval) { 02702 i4lval = i4ptr[sindx]; 02703 res_indx1 = j; 02704 } 02705 } else { 02706 if (i4ptr[sindx] < 0) { 02707 i4lval = i4ptr[sindx]; 02708 res_indx1 = j; 02709 } 02710 } 02711 } 02712 } 02713 rindx = 0; 02714 for (j = 0; j < rank - 1; j++) 02715 rindx += res_off[j]; 02716 _INTERM_INDEX(); 02717 i4lval = HUGE_INT4_F90; 02718 _INCREMENT_D_TWO(); /* increment indices */ 02719 } 02720 } else { 02721 for (i = 0; i < tot_ext; i++) { 02722 src_indx1 = 0; 02723 res_indx1 = -1; 02724 for (j = 0; j < rank - 1; j++) 02725 src_indx1 += src_off[j]; 02726 for (j = 0; j < src_dim_ext; j++) { 02727 sindx = src_indx1 + (j * src_dim_strd); 02728 if ((i4ptr[sindx]^i4lval) >= 0) { 02729 if (i4ptr[sindx] < i4lval) { 02730 i4lval = i4ptr[sindx]; 02731 res_indx1 = j; 02732 } 02733 } else { 02734 if (i4ptr[sindx] < 0) { 02735 i4lval = i4ptr[sindx]; 02736 res_indx1 = j; 02737 } 02738 } 02739 } 02740 rindx = 0; 02741 for (j = 0; j < rank - 1; j++) 02742 rindx += res_off[j]; 02743 _INTERM_INDEX(); 02744 i4lval = HUGE_INT4_F90; 02745 _INCREMENT_D_ONE(); 02746 } 02747 } 02748 } 02749 break; 02750 02751 #ifdef _F_INT2 02752 case DVSUBTYPE_BIT16 : 02753 i2ptr = (_f_int2 *) source->base_addr.a.ptr; 02754 i2lval = HUGE_INT2_F90; 02755 if (dimension == NULL) { 02756 sindx = 0; 02757 if (use_mask) { /* mask specified */ 02758 mindx = 0; 02759 for (i = 0; i < tot_ext; i++) { 02760 if (LTOB(mask_el_len, &mptr[mindx])) { 02761 if ((i2ptr[sindx]^i2lval) >= 0) { 02762 if (i2ptr[sindx] < i2lval) { 02763 i2lval = i2ptr[sindx]; 02764 _SET_INDEX(); 02765 } 02766 } else { 02767 if (i2ptr[sindx] < 0) { 02768 i2lval = i2ptr[sindx]; 02769 _SET_INDEX(); 02770 } 02771 } 02772 } 02773 _INCREMENT_TWO(); 02774 } 02775 } else { 02776 for (i = 0; i < tot_ext; i++) { 02777 if ((i2ptr[sindx]^i2lval) >= 0) { 02778 if (i2ptr[sindx] < i2lval) { 02779 i2lval = i2ptr[sindx]; 02780 _SET_INDEX(); 02781 } 02782 } else { 02783 if (i2ptr[sindx] < 0) { 02784 i2lval = i2ptr[sindx]; 02785 _SET_INDEX(); 02786 } 02787 } 02788 _INCREMENT_ONE(); 02789 } 02790 } 02791 _FINAL_INDEX(); /* put temp values into result */ 02792 } else { 02793 if (use_mask) { /* mask specified */ 02794 for (i = 0; i < tot_ext; i++) { 02795 src_indx1 = 0; 02796 msk_indx1 = 0; 02797 res_indx1 = -1; 02798 for (j = 0; j < rank - 1; j++) { 02799 src_indx1 += src_off[j]; 02800 msk_indx1 += msk_off[j]; 02801 } 02802 for (j = 0; j < src_dim_ext; j++) { 02803 mindx = msk_indx1 + (j * msk_dim_strd); 02804 if (LTOB(mask_el_len, &mptr[mindx])) { 02805 sindx = src_indx1 + (j * src_dim_strd); 02806 if ((i2ptr[sindx]^i2lval) >= 0) { 02807 if (i2ptr[sindx] < i2lval) { 02808 i2lval = i2ptr[sindx]; 02809 res_indx1 = j; 02810 } 02811 } else { 02812 if (i2ptr[sindx] < 0) { 02813 i2lval = i2ptr[sindx]; 02814 res_indx1 = j; 02815 } 02816 } 02817 } 02818 } 02819 rindx = 0; 02820 for (j = 0; j < rank - 1; j++) 02821 rindx += res_off[j]; 02822 _INTERM_INDEX(); 02823 i2lval = HUGE_INT2_F90; 02824 _INCREMENT_D_TWO(); /* increment indices */ 02825 } 02826 } else { 02827 for (i = 0; i < tot_ext; i++) { 02828 src_indx1 = 0; 02829 res_indx1 = -1; 02830 for (j = 0; j < rank - 1; j++) 02831 src_indx1 += src_off[j]; 02832 for (j = 0; j < src_dim_ext; j++) { 02833 sindx = src_indx1 + (j * src_dim_strd); 02834 if ((i2ptr[sindx]^i2lval) >= 0) { 02835 if (i2ptr[sindx] < i2lval) { 02836 i2lval = i2ptr[sindx]; 02837 res_indx1 = j; 02838 } 02839 } else { 02840 if (i2ptr[sindx] < 0) { 02841 i2lval = i2ptr[sindx]; 02842 res_indx1 = j; 02843 } 02844 } 02845 } 02846 rindx = 0; 02847 for (j = 0; j < rank - 1; j++) 02848 rindx += res_off[j]; 02849 _INTERM_INDEX(); 02850 i2lval = HUGE_INT2_F90; 02851 _INCREMENT_D_ONE(); 02852 } 02853 } 02854 } 02855 break; 02856 #endif 02857 02858 #ifdef _F_INT1 02859 case DVSUBTYPE_BIT8 : 02860 i1ptr = (_f_int1 *) source->base_addr.a.ptr; 02861 i1lval = HUGE_INT1_F90; 02862 if (dimension == NULL) { 02863 sindx = 0; 02864 if (use_mask) { /* mask specified */ 02865 mindx = 0; 02866 for (i = 0; i < tot_ext; i++) { 02867 if (LTOB(mask_el_len, &mptr[mindx])) { 02868 if ((i1ptr[sindx]^i1lval) >= 0) { 02869 if (i1ptr[sindx] < i1lval) { 02870 i1lval = i1ptr[sindx]; 02871 _SET_INDEX(); 02872 } 02873 } else { 02874 if (i1ptr[sindx] < 0) { 02875 i1lval = i1ptr[sindx]; 02876 _SET_INDEX(); 02877 } 02878 } 02879 } 02880 _INCREMENT_TWO(); 02881 } 02882 } else { 02883 for (i = 0; i < tot_ext; i++) { 02884 if ((i1ptr[sindx]^i1lval) >= 0) { 02885 if (i1ptr[sindx] < i1lval) { 02886 i1lval = i1ptr[sindx]; 02887 _SET_INDEX(); 02888 } 02889 } else { 02890 if (i1ptr[sindx] < 0) { 02891 i1lval = i1ptr[sindx]; 02892 _SET_INDEX(); 02893 } 02894 } 02895 _INCREMENT_ONE(); 02896 } 02897 } 02898 _FINAL_INDEX(); /* put temp values into result */ 02899 } else { 02900 if (use_mask) { /* mask specified */ 02901 for (i = 0; i < tot_ext; i++) { 02902 src_indx1 = 0; 02903 msk_indx1 = 0; 02904 res_indx1 = -1; 02905 for (j = 0; j < rank - 1; j++) { 02906 src_indx1 += src_off[j]; 02907 msk_indx1 += msk_off[j]; 02908 } 02909 for (j = 0; j < src_dim_ext; j++) { 02910 mindx = msk_indx1 + (j * msk_dim_strd); 02911 if (LTOB(mask_el_len, &mptr[mindx])) { 02912 sindx = src_indx1 + (j * src_dim_strd); 02913 if ((i1ptr[sindx]^i1lval) >= 0) { 02914 if (i1ptr[sindx] < i1lval) { 02915 i1lval = i1ptr[sindx]; 02916 res_indx1 = j; 02917 } 02918 } else { 02919 if (i1ptr[sindx] < 0) { 02920 i1lval = i1ptr[sindx]; 02921 res_indx1 = j; 02922 } 02923 } 02924 } 02925 } 02926 rindx = 0; 02927 for (j = 0; j < rank - 1; j++) 02928 rindx += res_off[j]; 02929 _INTERM_INDEX(); 02930 i1lval = HUGE_INT1_F90; 02931 _INCREMENT_D_TWO(); /* increment indices */ 02932 } 02933 } else { 02934 for (i = 0; i < tot_ext; i++) { 02935 src_indx1 = 0; 02936 res_indx1 = -1; 02937 for (j = 0; j < rank - 1; j++) 02938 src_indx1 += src_off[j]; 02939 for (j = 0; j < src_dim_ext; j++) { 02940 sindx = src_indx1 + (j * src_dim_strd); 02941 if ((i1ptr[sindx]^i1lval) >= 0) { 02942 if (i1ptr[sindx] < i1lval) { 02943 i1lval = i1ptr[sindx]; 02944 res_indx1 = j; 02945 } 02946 } else { 02947 if (i1ptr[sindx] < 0) { 02948 i1lval = i1ptr[sindx]; 02949 res_indx1 = j; 02950 } 02951 } 02952 } 02953 rindx = 0; 02954 for (j = 0; j < rank - 1; j++) 02955 rindx += res_off[j]; 02956 _INTERM_INDEX(); 02957 i1lval = HUGE_INT1_F90; 02958 _INCREMENT_D_ONE(); 02959 } 02960 } 02961 } 02962 break; 02963 #endif 02964 02965 case DVSUBTYPE_INT64 : 02966 i8ptr = (_f_int8 *) source->base_addr.a.ptr; 02967 i8lval = HUGE_INT8_F90; 02968 if (dimension == NULL) { 02969 sindx = 0; 02970 if (use_mask) { /* mask specified */ 02971 mindx = 0; 02972 for (i = 0; i < tot_ext; i++) { 02973 if (LTOB(mask_el_len, &mptr[mindx])) { 02974 if ((i8ptr[sindx]^i8lval) >= 0) { 02975 if (i8ptr[sindx] < i8lval) { 02976 i8lval = i8ptr[sindx]; 02977 _SET_INDEX(); 02978 } 02979 } else { 02980 if (i8ptr[sindx] < 0) { 02981 i8lval = i8ptr[sindx]; 02982 _SET_INDEX(); 02983 } 02984 } 02985 } 02986 _INCREMENT_TWO(); 02987 } 02988 } else { 02989 for (i = 0; i < tot_ext; i++) { 02990 if ((i8ptr[sindx]^i8lval) >= 0) { 02991 if (i8ptr[sindx] < i8lval) { 02992 i8lval = i8ptr[sindx]; 02993 _SET_INDEX(); 02994 } 02995 } else { 02996 if (i8ptr[sindx] < 0) { 02997 i8lval = i8ptr[sindx]; 02998 _SET_INDEX(); 02999 } 03000 } 03001 _INCREMENT_ONE(); 03002 } 03003 } 03004 _FINAL_INDEX(); /* put temp values into result */ 03005 } else { 03006 if (use_mask) { /* mask specified */ 03007 for (i = 0; i < tot_ext; i++) { 03008 src_indx1 = 0; 03009 msk_indx1 = 0; 03010 res_indx1 = -1; 03011 for (j = 0; j < rank - 1; j++) { 03012 src_indx1 += src_off[j]; 03013 msk_indx1 += msk_off[j]; 03014 } 03015 for (j = 0; j < src_dim_ext; j++) { 03016 mindx = msk_indx1 + (j * msk_dim_strd); 03017 if (LTOB(mask_el_len, &mptr[mindx])) { 03018 sindx = src_indx1 + (j * src_dim_strd); 03019 if ((i8ptr[sindx]^i8lval) >= 0) { 03020 if (i8ptr[sindx] < i8lval) { 03021 i8lval = i8ptr[sindx]; 03022 res_indx1 = j; 03023 } 03024 } else { 03025 if (i8ptr[sindx] < 0) { 03026 i8lval = i8ptr[sindx]; 03027 res_indx1 = j; 03028 } 03029 } 03030 } 03031 } 03032 rindx = 0; 03033 for (j = 0; j < rank - 1; j++) 03034 rindx += res_off[j]; 03035 _INTERM_INDEX(); 03036 i8lval = HUGE_INT8_F90; 03037 _INCREMENT_D_TWO(); /* increment indices */ 03038 } 03039 } else { 03040 for (i = 0; i < tot_ext; i++) { 03041 src_indx1 = 0; 03042 res_indx1 = -1; 03043 for (j = 0; j < rank - 1; j++) 03044 src_indx1 += src_off[j]; 03045 for (j = 0; j < src_dim_ext; j++) { 03046 sindx = src_indx1 + (j * src_dim_strd); 03047 if ((i8ptr[sindx]^i8lval) >= 0) { 03048 if (i8ptr[sindx] < i8lval) { 03049 i8lval = i8ptr[sindx]; 03050 res_indx1 = j; 03051 } 03052 } else { 03053 if (i8ptr[sindx] < 0) { 03054 i8lval = i8ptr[sindx]; 03055 res_indx1 = j; 03056 } 03057 } 03058 } 03059 rindx = 0; 03060 for (j = 0; j < rank - 1; j++) 03061 rindx += res_off[j]; 03062 _INTERM_INDEX(); 03063 i8lval = HUGE_INT8_F90; 03064 _INCREMENT_D_ONE(); 03065 } 03066 } 03067 } 03068 break; 03069 03070 case DVSUBTYPE_REAL64 : 03071 r8ptr = (_f_real8 *) source->base_addr.a.ptr; 03072 r8lval = HUGE_REAL8_F90; 03073 if (dimension == NULL) { 03074 sindx = 0; 03075 if (use_mask) { /* mask specified */ 03076 mindx = 0; 03077 for (i = 0; i < tot_ext; i++) { 03078 if (LTOB(mask_el_len, &mptr[mindx])) { 03079 if (r8ptr[sindx] < r8lval) { 03080 r8lval = r8ptr[sindx]; 03081 _SET_INDEX(); 03082 } 03083 } 03084 _INCREMENT_TWO(); 03085 } 03086 } else { 03087 for (i = 0; i < tot_ext; i++) { 03088 if (r8ptr[sindx] < r8lval) { 03089 r8lval = r8ptr[sindx]; 03090 _SET_INDEX(); 03091 } 03092 _INCREMENT_ONE(); 03093 } 03094 } 03095 _FINAL_INDEX(); /* put temp values into result */ 03096 } else { 03097 if (use_mask) { /* mask specified */ 03098 for (i = 0; i < tot_ext; i++) { 03099 src_indx1 = 0; 03100 msk_indx1 = 0; 03101 res_indx1 = -1; 03102 for (j = 0; j < rank - 1; j++) { 03103 src_indx1 += src_off[j]; 03104 msk_indx1 += msk_off[j]; 03105 } 03106 for (j = 0; j < src_dim_ext; j++) { 03107 mindx = msk_indx1 + (j * msk_dim_strd); 03108 if (LTOB(mask_el_len, &mptr[mindx])) { 03109 sindx = src_indx1 + (j * src_dim_strd); 03110 if (r8ptr[sindx] < r8lval) { 03111 r8lval = r8ptr[sindx]; 03112 res_indx1 = j; 03113 } 03114 } 03115 } 03116 rindx = 0; 03117 for (j = 0; j < rank - 1; j++) 03118 rindx += res_off[j]; 03119 _INTERM_INDEX(); 03120 r8lval = HUGE_REAL8_F90; 03121 _INCREMENT_D_TWO(); /* increment indices */ 03122 } 03123 } else { /* no mask */ 03124 for (i = 0; i < tot_ext; i++) { 03125 src_indx1 = 0; 03126 res_indx1 = -1; 03127 for (j = 0; j < rank - 1; j++) { 03128 src_indx1 += src_off[j]; 03129 } 03130 for (j = 0; j < src_dim_ext; j++) { 03131 sindx = src_indx1 + (j * src_dim_strd); 03132 if (r8ptr[sindx] < r8lval) { 03133 r8lval = r8ptr[sindx]; 03134 res_indx1 = j; 03135 } 03136 } 03137 rindx = 0; 03138 for (j = 0; j < rank - 1; j++) 03139 rindx += res_off[j]; 03140 _INTERM_INDEX(); 03141 r8lval = HUGE_REAL8_F90; 03142 _INCREMENT_D_ONE(); 03143 } 03144 } 03145 } 03146 break; 03147 03148 case DVSUBTYPE_REAL32 : 03149 r4ptr = (_f_real4 *) source->base_addr.a.ptr; 03150 r4lval = HUGE_REAL4_F90; 03151 if (dimension == NULL) { 03152 sindx = 0; 03153 if (use_mask) { /* mask specified */ 03154 mindx = 0; 03155 for (i = 0; i < tot_ext; i++) { 03156 if (LTOB(mask_el_len, &mptr[mindx])) { 03157 if (r4ptr[sindx] < r4lval) { 03158 r4lval = r4ptr[sindx]; 03159 _SET_INDEX(); 03160 } 03161 } 03162 _INCREMENT_TWO(); 03163 } 03164 } else { 03165 for (i = 0; i < tot_ext; i++) { 03166 if (r4ptr[sindx] < r4lval) { 03167 r4lval = r4ptr[sindx]; 03168 _SET_INDEX(); 03169 } 03170 _INCREMENT_ONE(); 03171 } 03172 } 03173 _FINAL_INDEX(); /* put temp values into result */ 03174 } else { 03175 if (use_mask) { /* mask specified */ 03176 for (i = 0; i < tot_ext; i++) { 03177 src_indx1 = 0; 03178 msk_indx1 = 0; 03179 res_indx1 = -1; 03180 for (j = 0; j < rank - 1; j++) { 03181 src_indx1 += src_off[j]; 03182 msk_indx1 += msk_off[j]; 03183 } 03184 for (j = 0; j < src_dim_ext; j++) { 03185 mindx = msk_indx1 + (j * msk_dim_strd); 03186 if (LTOB(mask_el_len, &mptr[mindx])) { 03187 sindx = src_indx1 + (j * src_dim_strd); 03188 if (r4ptr[sindx] < r4lval) { 03189 r4lval = r4ptr[sindx]; 03190 res_indx1 = j; 03191 } 03192 } 03193 } 03194 rindx = 0; 03195 for (j = 0; j < rank - 1; j++) 03196 rindx += res_off[j]; 03197 _INTERM_INDEX(); 03198 r4lval = HUGE_REAL4_F90; 03199 _INCREMENT_D_TWO(); /* increment indices */ 03200 } 03201 } else { /* no mask */ 03202 for (i = 0; i < tot_ext; i++) { 03203 src_indx1 = 0; 03204 msk_indx1 = 0; 03205 res_indx1 = -1; 03206 for (j = 0; j < rank - 1; j++) { 03207 src_indx1 += src_off[j]; 03208 msk_indx1 += msk_off[j]; 03209 } 03210 for (j = 0; j < src_dim_ext; j++) { 03211 sindx = src_indx1 + (j * src_dim_strd); 03212 if (r4ptr[sindx] < r4lval) { 03213 r4lval = r4ptr[sindx]; 03214 res_indx1 = j; 03215 } 03216 } 03217 rindx = 0; 03218 for (j = 0; j < rank - 1; j++) 03219 rindx += res_off[j]; 03220 _INTERM_INDEX(); 03221 r4lval = HUGE_REAL4_F90; 03222 _INCREMENT_D_ONE(); /* increment sindx */ 03223 } 03224 } 03225 } 03226 break; 03227 03228 #if defined _F_REAL16 && _F_REAL16 != (-1) 03229 case DVSUBTYPE_REAL128 : 03230 r16ptr = (_f_real16 *) source->base_addr.a.ptr; 03231 r16lval = HUGE_REAL16_F90; 03232 if (dimension == NULL) { 03233 sindx = 0; 03234 if (use_mask) { /* mask specified */ 03235 mindx = 0; 03236 for (i = 0; i < tot_ext; i++) { 03237 if (LTOB(mask_el_len, &mptr[mindx])) { 03238 if (r16ptr[sindx] < r16lval) { 03239 r16lval = r16ptr[sindx]; 03240 _SET_INDEX(); 03241 } 03242 } 03243 _INCREMENT_TWO(); 03244 } 03245 } else { 03246 for (i = 0; i < tot_ext; i++) { 03247 if (r16ptr[sindx] < r16lval) { 03248 r16lval = r16ptr[sindx]; 03249 _SET_INDEX(); 03250 } 03251 _INCREMENT_ONE(); 03252 } 03253 } 03254 _FINAL_INDEX(); /* put temp values into result */ 03255 } else { 03256 if (use_mask) { /* mask specified */ 03257 for (i = 0; i < tot_ext; i++) { 03258 src_indx1 = 0; 03259 msk_indx1 = 0; 03260 res_indx1 = -1; 03261 for (j = 0; j < rank - 1; j++) { 03262 src_indx1 += src_off[j]; 03263 msk_indx1 += msk_off[j]; 03264 } 03265 for (j = 0; j < src_dim_ext; j++) { 03266 mindx = msk_indx1 + (j * msk_dim_strd); 03267 if (LTOB(mask_el_len, &mptr[mindx])) { 03268 sindx = src_indx1 + (j * src_dim_strd); 03269 if (r16ptr[sindx] < r16lval) { 03270 r16lval = r16ptr[sindx]; 03271 res_indx1 = j; 03272 } 03273 } 03274 } 03275 rindx = 0; 03276 for (j = 0; j < rank - 1; j++) 03277 rindx += res_off[j]; 03278 _INTERM_INDEX(); 03279 r16lval = HUGE_REAL16_F90; 03280 _INCREMENT_D_TWO(); /* increment indices */ 03281 } 03282 } else { /* no mask */ 03283 for (i = 0; i < tot_ext; i++) { 03284 src_indx1 = 0; 03285 msk_indx1 = 0; 03286 res_indx1 = -1; 03287 for (j = 0; j < rank - 1; j++) { 03288 src_indx1 += src_off[j]; 03289 msk_indx1 += msk_off[j]; 03290 } 03291 for (j = 0; j < src_dim_ext; j++) { 03292 sindx = src_indx1 + (j * src_dim_strd); 03293 if (r16ptr[sindx] < r16lval) { 03294 r16lval = r16ptr[sindx]; 03295 res_indx1 = j; 03296 } 03297 } 03298 rindx = 0; 03299 for (j = 0; j < rank - 1; j++) 03300 rindx += res_off[j]; 03301 _INTERM_INDEX(); 03302 r16lval = HUGE_REAL16_F90; 03303 _INCREMENT_D_ONE(); /* increment sindx */ 03304 } 03305 } 03306 } 03307 break; 03308 #endif 03309 03310 default : 03311 _lerror (_LELVL_ABORT, FEINTDTY); 03312 } 03313 } 03314 }