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 #pragma ident "@(#) libfi/array/any.c 92.1 07/07/99 15:52:02"
00038 #include <stddef.h>
00039 #include <stdlib.h>
00040 #include <liberrno.h>
00041 #include <cray/dopevec.h>
00042 #include <cray/portdefs.h>
00043 #include "logical.h"
00044
00045 #ifdef _UNICOS
00046 #pragma _CRI duplicate _ANY as ANY@
00047 #endif
00048 void
00049 _ANY ( DopeVectorType * result,
00050 DopeVectorType * mask,
00051 _f_int *dimension)
00052 {
00053 void __any();
00054 (void) __any (result, mask, dimension);
00055 }
00056
00057 #ifdef _UNICOS
00058 #pragma _CRI duplicate _ANY0 as ANY0@
00059 #endif
00060 _f_log
00061 _ANY0 ( DopeVectorType * mask,
00062 _f_int *dimension)
00063 {
00064 void __any();
00065 _f_log logres;
00066 DopeVectorType result, *res_ptr;
00067
00068 res_ptr = (DopeVectorType *) &result;
00069 res_ptr->base_addr.a.ptr = &logres;
00070 res_ptr->base_addr.a.el_len = sizeof(_f_log8) * BITS_PER_BYTE;
00071 res_ptr->assoc = 1;
00072 res_ptr->ptr_alloc = 0;
00073 res_ptr->p_or_a = NOT_P_OR_A;
00074 res_ptr->n_dim = 0;
00075 res_ptr->type_lens.type = DVTYPE_LOGICAL;
00076 res_ptr->type_lens.dpflag = 0;
00077 res_ptr->type_lens.kind_or_star = DVD_DEFAULT;
00078 res_ptr->type_lens.int_len = sizeof(_f_log8) * BITS_PER_BYTE;
00079 res_ptr->type_lens.dec_len = 0;
00080 res_ptr->orig_base = res_ptr->base_addr.a.ptr;
00081 res_ptr->orig_size = 0;
00082 __any (res_ptr, mask, dimension);
00083 return(*(_f_log *) res_ptr->base_addr.a.ptr);
00084 }
00085
00086
00087 void
00088 _ANY_4 (DopeVectorType * result,
00089 DopeVectorType * mask,
00090 _f_int *dimension)
00091 {
00092 void __any();
00093 (void) __any (result, mask, dimension);
00094 }
00095
00096 _f_log4
00097 _ANY0_4 (DopeVectorType * mask,
00098 _f_int *dimension)
00099 {
00100 void __any();
00101 _f_log4 log4res;
00102 DopeVectorType result, *res_ptr;
00103
00104 res_ptr = (DopeVectorType *) &result;
00105 res_ptr->base_addr.a.ptr = &log4res;
00106 res_ptr->base_addr.a.el_len = sizeof(_f_log4) * BITS_PER_BYTE;
00107 res_ptr->assoc = 1;
00108 res_ptr->ptr_alloc = 0;
00109 res_ptr->p_or_a = NOT_P_OR_A;
00110 res_ptr->n_dim = 0;
00111 res_ptr->type_lens.type = DVTYPE_LOGICAL;
00112 res_ptr->type_lens.dpflag = 0;
00113 res_ptr->type_lens.kind_or_star = DVD_DEFAULT;
00114 res_ptr->type_lens.int_len = sizeof(_f_log4) * BITS_PER_BYTE;
00115 res_ptr->type_lens.dec_len = 0;
00116 res_ptr->orig_base = res_ptr->base_addr.a.ptr;
00117 res_ptr->orig_size = 0;
00118 __any (res_ptr, mask, dimension);
00119 return(*(_f_log4 *) res_ptr->base_addr.a.ptr);
00120 }
00121
00122
00123 void
00124 _ANY_8 (DopeVectorType * result,
00125 DopeVectorType * mask,
00126 _f_int *dimension)
00127 {
00128 void __any();
00129 (void) __any (result, mask, dimension);
00130 }
00131
00132 _f_log8
00133 _ANY0_8 (DopeVectorType * mask,
00134 _f_int *dimension)
00135 {
00136 void __any();
00137 _f_log8 log8res;
00138 DopeVectorType result, *res_ptr;
00139
00140 res_ptr = (DopeVectorType *) &result;
00141 res_ptr->base_addr.a.ptr = &log8res;
00142 res_ptr->base_addr.a.el_len = sizeof(_f_log8) * BITS_PER_BYTE;
00143 res_ptr->assoc = 1;
00144 res_ptr->ptr_alloc = 0;
00145 res_ptr->p_or_a = NOT_P_OR_A;
00146 res_ptr->n_dim = 0;
00147 res_ptr->type_lens.type = DVTYPE_LOGICAL;
00148 res_ptr->type_lens.dpflag = 0;
00149 res_ptr->type_lens.kind_or_star = DVD_DEFAULT;
00150 res_ptr->type_lens.int_len = sizeof(_f_log8) * BITS_PER_BYTE;
00151 res_ptr->type_lens.dec_len = 0;
00152 res_ptr->orig_base = res_ptr->base_addr.a.ptr;
00153 res_ptr->orig_size = 0;
00154 __any (res_ptr, mask, dimension);
00155 return(*(_f_log8 *) res_ptr->base_addr.a.ptr);
00156 }
00157
00158
00159 void
00160 _ANY_2 (DopeVectorType * result,
00161 DopeVectorType * mask,
00162 _f_int *dimension)
00163 {
00164 void __any();
00165 (void) __any (result, mask, dimension);
00166 }
00167
00168 _f_log2
00169 _ANY0_2 (DopeVectorType * mask,
00170 _f_int *dimension)
00171 {
00172 void __any();
00173 _f_log2 log2res;
00174 DopeVectorType result, *res_ptr;
00175
00176 res_ptr = (DopeVectorType *) &result;
00177 res_ptr->base_addr.a.ptr = &log2res;
00178 res_ptr->base_addr.a.el_len = sizeof(_f_log2) * BITS_PER_BYTE;
00179 res_ptr->assoc = 1;
00180 res_ptr->ptr_alloc = 0;
00181 res_ptr->p_or_a = NOT_P_OR_A;
00182 res_ptr->n_dim = 0;
00183 res_ptr->type_lens.type = DVTYPE_LOGICAL;
00184 res_ptr->type_lens.dpflag = 0;
00185 res_ptr->type_lens.kind_or_star = DVD_DEFAULT;
00186 res_ptr->type_lens.int_len = sizeof(_f_log2) * BITS_PER_BYTE;
00187 res_ptr->type_lens.dec_len = 0;
00188 res_ptr->orig_base = res_ptr->base_addr.a.ptr;
00189 res_ptr->orig_size = 0;
00190 __any (res_ptr, mask, dimension);
00191 return(*(_f_log2 *) res_ptr->base_addr.a.ptr);
00192 }
00193
00194
00195 void
00196 _ANY_1 (DopeVectorType * result,
00197 DopeVectorType * mask,
00198 _f_int *dimension)
00199 {
00200 void __any();
00201 (void) __any (result, mask, dimension);
00202 }
00203
00204 _f_log1
00205 _ANY0_1 (DopeVectorType * mask,
00206 _f_int *dimension)
00207 {
00208 void __any();
00209 _f_log1 log1res;
00210 DopeVectorType result, *res_ptr;
00211
00212 res_ptr = (DopeVectorType *) &result;
00213 res_ptr->base_addr.a.ptr = &log1res;
00214 res_ptr->base_addr.a.el_len = sizeof(_f_log1) * BITS_PER_BYTE;
00215 res_ptr->assoc = 1;
00216 res_ptr->ptr_alloc = 0;
00217 res_ptr->p_or_a = NOT_P_OR_A;
00218 res_ptr->n_dim = 0;
00219 res_ptr->type_lens.type = DVTYPE_LOGICAL;
00220 res_ptr->type_lens.dpflag = 0;
00221 res_ptr->type_lens.kind_or_star = DVD_DEFAULT;
00222 res_ptr->type_lens.int_len = sizeof(_f_log1) * BITS_PER_BYTE;
00223 res_ptr->type_lens.dec_len = 0;
00224 res_ptr->orig_base = res_ptr->base_addr.a.ptr;
00225 res_ptr->orig_size = 0;
00226 __any (res_ptr, mask, dimension);
00227 return(*(_f_log1 *) res_ptr->base_addr.a.ptr);
00228 }
00229
00230
00231 void
00232 __any (DopeVectorType *result,
00233 DopeVectorType *mask,
00234 _f_int *dimension)
00235 {
00236 int c_dim;
00237 int other_dim;
00238 int num_elts = 1;
00239 long nbytes = 0;
00240 _f_log * irptr;
00241 _f_log * imptr;
00242 _f_log4 * i4rptr;
00243 _f_log4 * i4mptr;
00244 _f_log8 * i8rptr;
00245 _f_log8 * i8mptr;
00246 #ifdef _F_LOG1
00247 _f_log1 * i1mptr;
00248 _f_log1 * i1rptr;
00249 #endif
00250 #ifdef _F_LOG2
00251 _f_log2 * i2mptr;
00252 _f_log2 * i2rptr;
00253 #endif
00254 long i, j;
00255 long indx, jndx;
00256 int done, stop;
00257 int el_len;
00258 int mshftct=0;
00259 int rshftct=0;
00260
00261
00262 long current_place[MAXDIM-1];
00263 long mask_offset[MAXDIM-1];
00264 long mask_extent[MAXDIM-1];
00265 long mask_stride[MAXDIM-1];
00266 long result_offset[MAXDIM-1];
00267 long result_stride[MAXDIM-1];
00268 long cdim_mask_stride;
00269
00270
00271 if (dimension != NULL && mask->n_dim > 1) {
00272 c_dim = *dimension - 1;
00273 if (c_dim < 0 || c_dim >= mask->n_dim)
00274 _lerror (_LELVL_ABORT, FESCIDIM);
00275 } else {
00276 c_dim = 0;
00277 if (dimension != NULL) {
00278 if (*dimension < 1 || *dimension > mask->n_dim)
00279 _lerror (_LELVL_ABORT, FESCIDIM);
00280 }
00281 }
00282
00283
00284 if (!result->assoc) {
00285 int sm = 1;
00286 if (result->base_addr.a.el_len >= BITS_PER_WORD)
00287 sm = result->base_addr.a.el_len / BITS_PER_WORD;
00288 if (dimension != NULL) {
00289 for (i = 0; i < c_dim; i++) {
00290 result->dimension[i].extent =
00291 mask->dimension[i].extent;
00292 result->dimension[i].low_bound = 1;
00293 result->dimension[i].stride_mult =
00294 num_elts * sm;
00295 num_elts *= mask->dimension[i].extent;
00296 }
00297 for ( ; i < result->n_dim; i++) {
00298 result->dimension[i].extent =
00299 mask->dimension[i+1].extent;
00300 result->dimension[i].low_bound = 1;
00301 result->dimension[i].stride_mult =
00302 num_elts * sm;
00303 num_elts *= mask->dimension[i+1].extent;
00304 }
00305 }
00306
00307 result->base_addr.a.ptr = (void *) NULL;
00308
00309 nbytes = ((num_elts * result->base_addr.a.el_len) /
00310 BITS_PER_BYTE);
00311 if (nbytes != 0) {
00312 result->base_addr.a.ptr = (void *) malloc (nbytes);
00313 if (result->base_addr.a.ptr == NULL)
00314 _lerror(_LELVL_ABORT, FENOMEMY);
00315 result->assoc = 1;
00316 }
00317
00318 result->orig_base = result->base_addr.a.ptr;
00319 result->orig_size = nbytes * BITS_PER_BYTE;
00320 }
00321
00322
00323
00324 irptr = (_f_log *) result->base_addr.a.ptr;
00325 switch (result->type_lens.int_len) {
00326 case 64 :
00327 i8rptr = (_f_log8 *) result->base_addr.a.ptr;
00328 #ifdef _F_LOG4
00329 if (sizeof(_f_int) == sizeof(_f_log4))
00330 rshftct = 1;
00331 #endif
00332 #ifdef _UNICOS
00333 #pragma _CRI ivdep
00334 #endif
00335 for (i = 0; i < num_elts; i++) {
00336 i8rptr[i] = (_f_log8) _btol(0);
00337 }
00338 break;
00339 #ifdef _F_LOG2
00340 case 16 :
00341 i2rptr = (_f_log2 *) result->base_addr.a.ptr;
00342 for (i = 0; i < num_elts; i++) {
00343 i2rptr[i] = (_f_log2) _btol(0);
00344 }
00345 break;
00346 #endif
00347 #ifdef _F_LOG1
00348 case 8 :
00349 i1rptr = (_f_log1 *) result->base_addr.a.ptr;
00350 for (i = 0; i < num_elts; i++) {
00351 i1rptr[i] = (_f_log1) _btol(0);
00352 }
00353 break;
00354 #endif
00355 case 32 :
00356 default :
00357 i4rptr = (_f_log4 *) result->base_addr.a.ptr;
00358 #ifdef _UNICOS
00359 #pragma _CRI ivdep
00360 #endif
00361 for (i = 0; i < num_elts; i++) {
00362 i4rptr[i] = (_f_log4) _btol(0);
00363 }
00364 }
00365
00366 imptr = (void *) mask->base_addr.a.ptr;
00367 switch (mask->type_lens.int_len) {
00368 case 64 :
00369 el_len = sizeof(_f_log8) * BITS_PER_BYTE;
00370 i8mptr = (_f_log8 *) imptr;
00371 #ifdef _F_LOG4
00372
00373
00374
00375
00376
00377
00378
00379 if (sizeof(_f_int) == sizeof(_f_log4))
00380 mshftct = 1;
00381 #endif
00382 break;
00383 #ifdef _F_LOG2
00384 case 16 :
00385 el_len = sizeof(_f_log2) * BITS_PER_BYTE;
00386 i2mptr = (_f_log2 *) imptr;
00387 break;
00388 #endif
00389 #ifdef _F_LOG1
00390 case 8 :
00391 el_len = sizeof(_f_log1) * BITS_PER_BYTE;
00392 i1mptr = (_f_log1 *) imptr;
00393 break;
00394 #endif
00395 case 32 :
00396 default :
00397 el_len = sizeof(_f_log4) * BITS_PER_BYTE;
00398 i4mptr = (_f_log4 *) imptr;
00399 }
00400
00401
00402 for (i = 0; i < mask->n_dim; i++) {
00403 if (mask->dimension[i].extent == 0)
00404 return;
00405 }
00406
00407
00408 if (mask->n_dim == 1) {
00409
00410
00411
00412
00413 #ifdef _F_LOG4
00414 mask_stride[0] = (mask->dimension[0].stride_mult) >> mshftct;
00415 #else
00416 mask_stride[0] = mask->dimension[0].stride_mult;
00417 #endif
00418
00419
00420 i = 0;
00421 indx = 0;
00422 switch (mask->type_lens.int_len) {
00423 case 64 :
00424 while (i < mask->dimension[0].extent) {
00425 if (LTOB(el_len, (i8mptr + indx))) {
00426
00427 switch (result->type_lens.int_len) {
00428 case 64 :
00429 i8rptr[0] = (_f_log8) _btol(1);
00430 break;
00431 #ifdef _F_LOG2
00432 case 16 :
00433 i2rptr[0] = (_f_log2) _btol(1);
00434 break;
00435 #endif
00436 #ifdef _F_LOG1
00437 case 8 :
00438 i1rptr[0] = (_f_log1) _btol(1);
00439 break;
00440 #endif
00441 case 32 :
00442 default :
00443 i4rptr[0] = (_f_log4) _btol(1);
00444 }
00445 i = mask->dimension[0].extent;
00446 } else {
00447
00448 i++;
00449 indx = i * mask_stride[0];
00450 }
00451 }
00452 break;
00453 #ifdef _F_LOG2
00454 case 16 :
00455 while (i < mask->dimension[0].extent) {
00456 if (LTOB(el_len, (i2mptr + indx))) {
00457
00458 switch (result->type_lens.int_len) {
00459 case 64 :
00460 i8rptr[0] = (_f_log8) _btol(1);
00461 break;
00462 case 16 :
00463 i2rptr[0] = (_f_log2) _btol(1);
00464 break;
00465 #ifdef _F_LOG1
00466 case 8 :
00467 i1rptr[0] = (_f_log1) _btol(1);
00468 break;
00469 #endif
00470 case 32 :
00471 default :
00472 i4rptr[0] = (_f_log4) _btol(1);
00473 }
00474 i = mask->dimension[0].extent;
00475 } else {
00476
00477 i++;
00478 indx = i * mask_stride[0];
00479 }
00480 }
00481 break;
00482 #endif
00483 #ifdef _F_LOG1
00484 case 8 :
00485 while (i < mask->dimension[0].extent) {
00486 if (LTOB(el_len, (i1mptr + indx))) {
00487
00488 switch (result->type_lens.int_len) {
00489 case 64 :
00490 i8rptr[0] = (_f_log8) _btol(1);
00491 break;
00492 case 16 :
00493 i2rptr[0] = (_f_log2) _btol(1);
00494 break;
00495 case 8 :
00496 i1rptr[0] = (_f_log1) _btol(1);
00497 break;
00498 case 32 :
00499 default :
00500 i4rptr[0] = (_f_log4) _btol(1);
00501 }
00502 i = mask->dimension[0].extent;
00503 } else {
00504
00505 i++;
00506 indx = i * mask_stride[0];
00507 }
00508 }
00509 break;
00510 #endif
00511 case 32 :
00512 default :
00513 while (i < mask->dimension[0].extent) {
00514 if (LTOB(el_len, (i4mptr + indx))) {
00515
00516 switch (result->type_lens.int_len) {
00517 case 64 :
00518 i8rptr[0] = (_f_log8) _btol(1);
00519 break;
00520 #ifdef _F_LOG2
00521 case 16 :
00522 i2rptr[0] = (_f_log2) _btol(1);
00523 break;
00524 #endif
00525 #ifdef _F_LOG1
00526 case 8 :
00527 i1rptr[0] = (_f_log1) _btol(1);
00528 break;
00529 #endif
00530 case 32 :
00531 default :
00532 i4rptr[0] = (_f_log4) _btol(1);
00533 }
00534 i = mask->dimension[0].extent;
00535 } else {
00536
00537 i++;
00538 indx = i * mask_stride[0];
00539 }
00540 }
00541 }
00542
00543
00544 } else if (mask->n_dim == 2) {
00545
00546
00547 if (c_dim == 0)
00548 other_dim = 1;
00549 else
00550 other_dim = 0;
00551 #ifdef _F_LOG4
00552 mask_stride[0] = (mask->dimension[0].stride_mult) >> mshftct;
00553 mask_stride[1] = (mask->dimension[1].stride_mult) >> mshftct;
00554 #else
00555 mask_stride[0] = mask->dimension[0].stride_mult;
00556 mask_stride[1] = mask->dimension[1].stride_mult;
00557 #endif
00558
00559
00560 i = 0;
00561 indx = 0;
00562 while (i < mask->dimension[other_dim].extent) {
00563 j = 0;
00564 jndx = indx;
00565 switch (mask->type_lens.int_len) {
00566 case 64 :
00567 while (j < mask->dimension[c_dim].extent) {
00568 if (LTOB(el_len, (i8mptr + jndx))) {
00569
00570 if (result->n_dim == 0) {
00571 switch (result->type_lens.int_len) {
00572 case 64 :
00573 i8rptr[0] = (_f_log8) _btol(1);
00574 break;
00575 #ifdef _F_LOG2
00576 case 16 :
00577 i2rptr[0] = (_f_log2) _btol(1);
00578 break;
00579 #endif
00580 #ifdef _F_LOG1
00581 case 8 :
00582 i1rptr[0] = (_f_log1) _btol(1);
00583 break;
00584 #endif
00585 case 32 :
00586 default :
00587 i4rptr[0] = (_f_log4) _btol(1);
00588 }
00589 j = mask->dimension[c_dim].extent;
00590 i = mask->dimension[other_dim].extent;
00591 } else {
00592 switch (result->type_lens.int_len) {
00593 case 64 :
00594 i8rptr[i] = (_f_log8) _btol(1);
00595 break;
00596 #ifdef _F_LOG2
00597 case 16 :
00598 i2rptr[i] = (_f_log2) _btol(1);
00599 break;
00600 #endif
00601 #ifdef _F_LOG1
00602 case 8 :
00603 i1rptr[i] = (_f_log1) _btol(1);
00604 break;
00605 #endif
00606 case 32 :
00607 default :
00608 i4rptr[i] = (_f_log4) _btol(1);
00609 }
00610 j = mask->dimension[c_dim].extent;
00611 }
00612 } else {
00613
00614 j++;
00615 jndx = indx + j *
00616 mask_stride[c_dim];
00617 }
00618 }
00619 break;
00620 #ifdef _F_LOG2
00621 case 16 :
00622 while (j < mask->dimension[c_dim].extent) {
00623 if (LTOB(el_len, (i2mptr + jndx))) {
00624
00625 if (result->n_dim == 0) {
00626 switch (result->type_lens.int_len) {
00627 case 64 :
00628 i8rptr[0] = (_f_log8) _btol(1);
00629 break;
00630 case 16 :
00631 i2rptr[0] = (_f_log2) _btol(1);
00632 break;
00633 #ifdef _F_LOG1
00634 case 8 :
00635 i1rptr[0] = (_f_log1) _btol(1);
00636 break;
00637 #endif
00638 case 32 :
00639 default :
00640 i4rptr[0] = (_f_log4) _btol(1);
00641 }
00642 j = mask->dimension[c_dim].extent;
00643 i = mask->dimension[other_dim].extent;
00644 } else {
00645 switch (result->type_lens.int_len) {
00646 case 64 :
00647 i8rptr[i] = (_f_log8) _btol(1);
00648 break;
00649 case 16 :
00650 i2rptr[i] = (_f_log2) _btol(1);
00651 break;
00652 #ifdef _F_LOG1
00653 case 8 :
00654 i1rptr[i] = (_f_log1) _btol(1);
00655 break;
00656 #endif
00657 case 32 :
00658 default :
00659 i4rptr[i] = (_f_log4) _btol(1);
00660 }
00661 j = mask->dimension[c_dim].extent;
00662 }
00663 } else {
00664
00665 j++;
00666 jndx = indx + j *
00667 mask_stride[c_dim];
00668 }
00669 }
00670 break;
00671 #endif
00672 #ifdef _F_LOG1
00673 case 8 :
00674 while (j < mask->dimension[c_dim].extent) {
00675 if (LTOB(el_len, (i8mptr + jndx))) {
00676
00677 if (result->n_dim == 0) {
00678 switch (result->type_lens.int_len) {
00679 case 64 :
00680 i8rptr[0] = (_f_log8) _btol(1);
00681 break;
00682 case 16 :
00683 i2rptr[0] = (_f_log2) _btol(1);
00684 break;
00685 case 8 :
00686 i1rptr[0] = (_f_log1) _btol(1);
00687 break;
00688 case 32 :
00689 default :
00690 i4rptr[0] = (_f_log4) _btol(1);
00691 }
00692 j = mask->dimension[c_dim].extent;
00693 i = mask->dimension[other_dim].extent;
00694 } else {
00695 switch (result->type_lens.int_len) {
00696 case 64 :
00697 i8rptr[i] = (_f_log8) _btol(1);
00698 break;
00699 case 16 :
00700 i2rptr[i] = (_f_log2) _btol(1);
00701 break;
00702 case 8 :
00703 i1rptr[i] = (_f_log1) _btol(1);
00704 break;
00705 case 32 :
00706 default :
00707 i4rptr[i] = (_f_log4) _btol(1);
00708 }
00709 j = mask->dimension[c_dim].extent;
00710 }
00711 } else {
00712
00713 j++;
00714 jndx = indx + j *
00715 mask_stride[c_dim];
00716 }
00717 }
00718 break;
00719 #endif
00720 case 32 :
00721 default :
00722 while (j < mask->dimension[c_dim].extent) {
00723 if (LTOB(el_len, (i4mptr + jndx))) {
00724
00725 if (result->n_dim == 0) {
00726 switch (result->type_lens.int_len) {
00727 case 64 :
00728 i8rptr[0] = (_f_log8) _btol(1);
00729 break;
00730 #ifdef _F_LOG2
00731 case 16 :
00732 i2rptr[0] = (_f_log2) _btol(1);
00733 break;
00734 #endif
00735 #ifdef _F_LOG1
00736 case 8 :
00737 i1rptr[0] = (_f_log1) _btol(1);
00738 break;
00739 #endif
00740 case 32 :
00741 default :
00742 i4rptr[0] = (_f_log4) _btol(1);
00743 }
00744 j = mask->dimension[c_dim].extent;
00745 i = mask->dimension[other_dim].extent;
00746 } else {
00747 switch (result->type_lens.int_len) {
00748 case 64 :
00749 i8rptr[i] = (_f_log8) _btol(1);
00750 break;
00751 #ifdef _F_LOG2
00752 case 16 :
00753 i2rptr[i] = (_f_log2) _btol(1);
00754 break;
00755 #endif
00756 #ifdef _F_LOG1
00757 case 8 :
00758 i1rptr[i] = (_f_log1) _btol(1);
00759 break;
00760 #endif
00761 case 32 :
00762 default :
00763 i4rptr[i] = (_f_log4) _btol(1);
00764 }
00765 j = mask->dimension[c_dim].extent;
00766 }
00767 } else {
00768
00769 j++;
00770 jndx = indx + j *
00771 mask_stride[c_dim];
00772 }
00773 }
00774 }
00775
00776 if (i != mask->dimension[other_dim].extent) {
00777 i++;
00778 indx = i * mask_stride[other_dim];
00779 }
00780 }
00781
00782
00783 } else {
00784
00785
00786 if (result->n_dim != 0)
00787 #ifdef _UNICOS
00788 #pragma _CRI shortloop
00789 #endif
00790 for (i = 0; i < result->n_dim; i++) {
00791 result_offset[i] = 0;
00792 #ifdef _F_LOG4
00793 result_stride[i] =
00794 (result->dimension[i].stride_mult) >> rshftct;
00795 #else
00796 result_stride[i] =
00797 result->dimension[i].stride_mult;
00798 #endif
00799 }
00800
00801
00802
00803
00804 if (c_dim == 0)
00805 i = 0;
00806 else
00807 #ifdef _UNICOS
00808 #pragma _CRI shortloop
00809 #endif
00810 for (i = 0; i < c_dim; i++) {
00811 current_place[i] = 0;
00812 mask_offset[i] = 0;
00813 mask_extent[i] = mask->dimension[i].extent;
00814 #ifdef _F_LOG4
00815 mask_stride[i] =
00816 (mask->dimension[i].stride_mult) >> mshftct;
00817 #else
00818 mask_stride[i] = mask->dimension[i].stride_mult;
00819 #endif
00820 }
00821 if (i < (mask->n_dim - 1))
00822 #ifdef _UNICOS
00823 #pragma _CRI shortloop
00824 #endif
00825 for ( ; i < mask->n_dim - 1; i++) {
00826 current_place[i] = 0;
00827 mask_offset[i] = 0;
00828 mask_extent[i] = mask->dimension[i+1].extent;
00829 #ifdef _F_LOG4
00830 mask_stride[i] =
00831 (mask->dimension[i+1].stride_mult) >> mshftct;
00832 #else
00833 mask_stride[i] = mask->dimension[i+1].stride_mult;
00834 #endif
00835 }
00836 #ifdef _F_LOG4
00837 cdim_mask_stride = mask->dimension[c_dim].stride_mult >> mshftct;
00838 #else
00839 cdim_mask_stride = mask->dimension[c_dim].stride_mult;
00840 #endif
00841
00842
00843 done = FALSE;
00844 while (!done) {
00845
00846 indx = 0;
00847 #ifdef _UNICOS
00848 #pragma _CRI shortloop
00849 #endif
00850 for (i = 0; i < mask->n_dim - 1; i++)
00851 indx += mask_offset[i];
00852 j = 0;
00853 jndx = indx;
00854
00855
00856 switch (mask->type_lens.int_len) {
00857 case 64 :
00858 while (j < mask->dimension[c_dim].extent) {
00859 if (LTOB(el_len, (i8mptr + jndx))) {
00860
00861 if (result->n_dim == 0) {
00862 switch (result->type_lens.int_len) {
00863 case 64 :
00864 i8rptr[0] = (_f_log8) _btol(1);
00865 break;
00866 #ifdef _F_LOG2
00867 case 16 :
00868 i2rptr[0] = (_f_log2) _btol(1);
00869 break;
00870 #endif
00871 #ifdef _F_LOG1
00872 case 8 :
00873 i1rptr[0] = (_f_log1) _btol(1);
00874 break;
00875 #endif
00876 case 32 :
00877 default :
00878 i4rptr[0] = (_f_log4) _btol(1);
00879 }
00880 j = mask->dimension[c_dim].extent;
00881 done = TRUE;
00882 } else {
00883 indx = 0;
00884 #ifdef _UNICOS
00885 #pragma _CRI shortloop
00886 #endif
00887 for (i = 0; i < mask->n_dim - 1; i++)
00888 indx += result_offset[i];
00889 switch (result->type_lens.int_len) {
00890 case 64 :
00891 i8rptr[indx] = (_f_log8) _btol(1);
00892 break;
00893 #ifdef _F_LOG2
00894 case 16 :
00895 i2rptr[indx] = (_f_log2) _btol(1);
00896 break;
00897 #endif
00898 #ifdef _F_LOG1
00899 case 8 :
00900 i1rptr[indx] = (_f_log1) _btol(1);
00901 break;
00902 #endif
00903 case 32 :
00904 default :
00905 i4rptr[indx] = (_f_log4) _btol(1);
00906 }
00907 j = mask->dimension[c_dim].extent;
00908 }
00909 } else {
00910
00911 j++;
00912 jndx = indx + j *
00913 cdim_mask_stride;
00914 }
00915 }
00916 break;
00917 #ifdef _F_LOG2
00918 case 16 :
00919 while (j < mask->dimension[c_dim].extent) {
00920 if (LTOB(el_len, (i2mptr + jndx))) {
00921
00922 if (result->n_dim == 0) {
00923 switch (result->type_lens.int_len) {
00924 case 64 :
00925 i8rptr[0] = (_f_log8) _btol(1);
00926 break;
00927 case 16 :
00928 i2rptr[0] = (_f_log2) _btol(1);
00929 break;
00930 #ifdef _F_LOG1
00931 case 8 :
00932 i1rptr[0] = (_f_log1) _btol(1);
00933 break;
00934 #endif
00935 case 32 :
00936 default :
00937 i4rptr[0] = (_f_log4) _btol(1);
00938 }
00939 j = mask->dimension[c_dim].extent;
00940 done = TRUE;
00941 } else {
00942 indx = 0;
00943 #ifdef _UNICOS
00944 #pragma _CRI shortloop
00945 #endif
00946 for (i = 0; i < mask->n_dim - 1; i++)
00947 indx += result_offset[i];
00948 switch (result->type_lens.int_len) {
00949 case 64 :
00950 i8rptr[indx] = (_f_log8) _btol(1);
00951 break;
00952 case 16 :
00953 i2rptr[indx] = (_f_log2) _btol(1);
00954 break;
00955 #ifdef _F_LOG1
00956 case 8 :
00957 i1rptr[indx] = (_f_log1) _btol(1);
00958 break;
00959 #endif
00960 case 32 :
00961 default :
00962 i4rptr[indx] = (_f_log4) _btol(1);
00963 }
00964 j = mask->dimension[c_dim].extent;
00965 }
00966 } else {
00967
00968 j++;
00969 jndx = indx + j *
00970 cdim_mask_stride;
00971 }
00972 }
00973 break;
00974 #endif
00975 #ifdef _F_LOG1
00976 case 8 :
00977 while (j < mask->dimension[c_dim].extent) {
00978 if (LTOB(el_len, (i1mptr + jndx))) {
00979
00980 if (result->n_dim == 0) {
00981 switch (result->type_lens.int_len) {
00982 case 64 :
00983 i8rptr[0] = (_f_log8) _btol(1);
00984 break;
00985 case 16 :
00986 i2rptr[0] = (_f_log2) _btol(1);
00987 break;
00988 case 8 :
00989 i1rptr[0] = (_f_log1) _btol(1);
00990 break;
00991 case 32 :
00992 default :
00993 i4rptr[0] = (_f_log4) _btol(1);
00994 }
00995 j = mask->dimension[c_dim].extent;
00996 done = TRUE;
00997 } else {
00998 indx = 0;
00999 #ifdef _UNICOS
01000 #pragma _CRI shortloop
01001 #endif
01002 for (i = 0; i < mask->n_dim - 1; i++)
01003 indx += result_offset[i];
01004 switch (result->type_lens.int_len) {
01005 case 64 :
01006 i8rptr[indx] = (_f_log8) _btol(1);
01007 break;
01008 case 16 :
01009 i2rptr[indx] = (_f_log2) _btol(1);
01010 break;
01011 case 8 :
01012 i1rptr[indx] = (_f_log1) _btol(1);
01013 break;
01014 case 32 :
01015 default :
01016 i4rptr[indx] = (_f_log4) _btol(1);
01017 }
01018 j = mask->dimension[c_dim].extent;
01019 }
01020 } else {
01021
01022 j++;
01023 jndx = indx + j *
01024 cdim_mask_stride;
01025 }
01026 }
01027 break;
01028 #endif
01029 case 32 :
01030 default :
01031 while (j < mask->dimension[c_dim].extent) {
01032 if (LTOB(el_len, (i4mptr + jndx))) {
01033
01034 if (result->n_dim == 0) {
01035 switch (result->type_lens.int_len) {
01036 case 64 :
01037 i8rptr[0] = (_f_log8) _btol(1);
01038 break;
01039 #ifdef _F_LOG2
01040 case 16 :
01041 i2rptr[0] = (_f_log2) _btol(1);
01042 break;
01043 #endif
01044 #ifdef _F_LOG1
01045 case 8 :
01046 i1rptr[0] = (_f_log1) _btol(1);
01047 break;
01048 #endif
01049 case 32 :
01050 default :
01051 i4rptr[0] = (_f_log4) _btol(1);
01052 }
01053 j = mask->dimension[c_dim].extent;
01054 done = TRUE;
01055 } else {
01056 indx = 0;
01057 #ifdef _UNICOS
01058 #pragma _CRI shortloop
01059 #endif
01060 for (i = 0; i < mask->n_dim - 1; i++)
01061 indx += result_offset[i];
01062 switch (result->type_lens.int_len) {
01063 case 64 :
01064 i8rptr[indx] = (_f_log8) _btol(1);
01065 break;
01066 #ifdef _F_LOG2
01067 case 16 :
01068 i2rptr[indx] = (_f_log2) _btol(1);
01069 break;
01070 #endif
01071 #ifdef _F_LOG1
01072 case 8 :
01073 i1rptr[indx] = (_f_log1) _btol(1);
01074 break;
01075 #endif
01076 case 32 :
01077 default :
01078 i4rptr[indx] = (_f_log4) _btol(1);
01079 }
01080 j = mask->dimension[c_dim].extent;
01081 }
01082 } else {
01083
01084 j++;
01085 jndx = indx + j *
01086 cdim_mask_stride;
01087 }
01088 }
01089 }
01090
01091
01092 if (!done) {
01093 i = 0;
01094 stop = FALSE;
01095 while (stop == FALSE && i < mask->n_dim - 1) {
01096 if (current_place[i] == mask_extent[i] - 1) {
01097 current_place[i] = 0;
01098 mask_offset[i] = 0;
01099 if (result->n_dim != 0)
01100 result_offset[i] = 0;
01101 } else {
01102 current_place[i]++;
01103 mask_offset[i] = current_place[i] *
01104 mask_stride[i];
01105 if (result->n_dim != 0)
01106 result_offset[i] = current_place[i] *
01107 result_stride[i];
01108 stop = TRUE;
01109 }
01110 i++;
01111 }
01112 if (!stop)
01113
01114
01115
01116 done = TRUE;
01117 }
01118 }
01119 }
01120 }
