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/all.c 92.1 07/07/99 15:52:02"
00038 #include <stddef.h>
00039 #include <liberrno.h>
00040 #include <cray/dopevec.h>
00041 #include <cray/portdefs.h>
00042 #include "logical.h"
00043
00044 #ifdef _UNICOS
00045 #pragma _CRI duplicate _ALL as ALL@
00046 #endif
00047 void
00048 _ALL ( DopeVectorType * result,
00049 DopeVectorType * mask,
00050 _f_int *dimension)
00051 {
00052 void __all();
00053 (void) __all (result, mask, dimension);
00054 }
00055
00056
00057 #ifdef _UNICOS
00058 #pragma _CRI duplicate _ALL0 as ALL0@
00059 #endif
00060 _f_log
00061 _ALL0 ( DopeVectorType * mask,
00062 _f_int *dimension)
00063 {
00064 void __all();
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 __all (res_ptr, mask, dimension);
00083 return(*(_f_log *) res_ptr->base_addr.a.ptr);
00084 }
00085
00086
00087 void
00088 _ALL_4 (DopeVectorType * result,
00089 DopeVectorType * mask,
00090 _f_int *dimension)
00091 {
00092 void __all();
00093 (void) __all (result, mask, dimension);
00094 }
00095
00096 _f_log4
00097 _ALL0_4 (DopeVectorType * mask,
00098 _f_int *dimension)
00099 {
00100 void __all();
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 __all (res_ptr, mask, dimension);
00119 return(*(_f_log4 *) res_ptr->base_addr.a.ptr);
00120 }
00121
00122
00123 void
00124 _ALL_8 (DopeVectorType * result,
00125 DopeVectorType * mask,
00126 _f_int *dimension)
00127 {
00128 void __all();
00129 (void) __all (result, mask, dimension);
00130 }
00131
00132 _f_log8
00133 _ALL0_8 (DopeVectorType * mask,
00134 _f_int *dimension)
00135 {
00136 void __all();
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 __all (res_ptr, mask, dimension);
00155 return(*(_f_log8 *) res_ptr->base_addr.a.ptr);
00156 }
00157
00158
00159 void
00160 _ALL_2 (DopeVectorType * result,
00161 DopeVectorType * mask,
00162 _f_int *dimension)
00163 {
00164 void __all();
00165 (void) __all (result, mask, dimension);
00166 }
00167
00168 _f_log2
00169 _ALL0_2 (DopeVectorType * mask,
00170 _f_int *dimension)
00171 {
00172 void __all();
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 __all (res_ptr, mask, dimension);
00191 return(*(_f_log2 *) res_ptr->base_addr.a.ptr);
00192 }
00193
00194
00195 void
00196 _ALL_1 (DopeVectorType * result,
00197 DopeVectorType * mask,
00198 _f_int *dimension)
00199 {
00200 void __all();
00201 (void) __all (result, mask, dimension);
00202 }
00203
00204 _f_log1
00205 _ALL0_1 (DopeVectorType * mask,
00206 _f_int *dimension)
00207 {
00208 void __all();
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 __all (res_ptr, mask, dimension);
00227 return(*(_f_log1 *) res_ptr->base_addr.a.ptr);
00228 }
00229
00230
00231 void
00232 __all ( 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 * i1rptr;
00248 _f_log1 * i1mptr;
00249 #endif
00250 #ifdef _F_LOG2
00251 _f_log2 * i2rptr;
00252 _f_log2 * i2mptr;
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
00319 result->orig_base = result->base_addr.a.ptr;
00320 result->orig_size = nbytes * BITS_PER_BYTE;
00321 }
00322
00323
00324 irptr = (void *) 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(1);
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(1);
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(1);
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(1);
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 i = 0;
00420 indx = 0;
00421 switch (mask->type_lens.int_len) {
00422 case 64 :
00423 while (i < mask->dimension[0].extent) {
00424 if (LTOB(el_len, (i8mptr + indx))) {
00425
00426 i++;
00427 indx = i * mask_stride[0];
00428 } else {
00429
00430 switch (result->type_lens.int_len) {
00431 case 64 :
00432 i8rptr[0] = (_f_log8) _btol(0);
00433 break;
00434 #ifdef _F_LOG2
00435 case 16 :
00436 i2rptr[0] = (_f_log2) _btol(0);
00437 break;
00438 #endif
00439 #ifdef _F_LOG1
00440 case 8 :
00441 i1rptr[0] = (_f_log1) _btol(0);
00442 break;
00443 #endif
00444 case 32 :
00445 default :
00446 i4rptr[0] = (_f_log4) _btol(0);
00447 }
00448 i = mask->dimension[0].extent;
00449 }
00450 }
00451 break;
00452 #ifdef _F_LOG2
00453 case 16 :
00454 while (i < mask->dimension[0].extent) {
00455 if (LTOB(el_len, (i2mptr + indx))) {
00456
00457 i++;
00458 indx = i * mask_stride[0];
00459 } else {
00460
00461 switch (result->type_lens.int_len) {
00462 case 64 :
00463 i8rptr[0] = (_f_log8) _btol(0);
00464 break;
00465 case 16 :
00466 i2rptr[0] = (_f_log2) _btol(0);
00467 break;
00468 #ifdef _F_LOG1
00469 case 8 :
00470 i1rptr[0] = (_f_log1) _btol(0);
00471 break;
00472 #endif
00473 case 32 :
00474 default :
00475 i4rptr[0] = (_f_log4) _btol(0);
00476 }
00477 i = mask->dimension[0].extent;
00478 }
00479 }
00480 break;
00481 #endif
00482 #ifdef _F_LOG1
00483 case 8 :
00484 while (i < mask->dimension[0].extent) {
00485 if (LTOB(el_len, (i1mptr + indx))) {
00486
00487 i++;
00488 indx = i * mask_stride[0];
00489 } else {
00490
00491 switch (result->type_lens.int_len) {
00492 case 64 :
00493 i8rptr[0] = (_f_log8) _btol(0);
00494 break;
00495 case 16 :
00496 i2rptr[0] = (_f_log2) _btol(0);
00497 break;
00498 case 8 :
00499 i1rptr[0] = (_f_log1) _btol(0);
00500 break;
00501 case 32 :
00502 default :
00503 i4rptr[0] = (_f_log4) _btol(0);
00504 }
00505 i = mask->dimension[0].extent;
00506 }
00507 }
00508 break;
00509 #endif
00510 case 32 :
00511 default :
00512 while (i < mask->dimension[0].extent) {
00513 if (LTOB(el_len, (i4mptr + indx))) {
00514
00515 i++;
00516 indx = i * mask_stride[0];
00517 } else {
00518
00519 switch (result->type_lens.int_len) {
00520 case 64 :
00521 i8rptr[0] = (_f_log8) _btol(0);
00522 break;
00523 #ifdef _F_LOG2
00524 case 16 :
00525 i2rptr[0] = (_f_log2) _btol(0);
00526 break;
00527 #endif
00528 #ifdef _F_LOG1
00529 case 8 :
00530 i1rptr[0] = (_f_log1) _btol(0);
00531 break;
00532 #endif
00533 case 32 :
00534 default :
00535 i4rptr[0] = (_f_log4) _btol(0);
00536 }
00537 i = mask->dimension[0].extent;
00538 }
00539 }
00540 }
00541
00542
00543 } else if (mask->n_dim == 2) {
00544
00545
00546 if (c_dim == 0)
00547 other_dim = 1;
00548 else
00549 other_dim = 0;
00550 #ifdef _F_LOG4
00551 mask_stride[0] = (mask->dimension[0].stride_mult) >> mshftct;
00552 mask_stride[1] = (mask->dimension[1].stride_mult) >> mshftct;
00553 #else
00554 mask_stride[0] = mask->dimension[0].stride_mult;
00555 mask_stride[1] = mask->dimension[1].stride_mult;
00556 #endif
00557
00558 i = 0;
00559 indx = 0;
00560 while (i < mask->dimension[other_dim].extent) {
00561 j = 0;
00562 jndx = indx;
00563 switch (mask->type_lens.int_len) {
00564 case 64 :
00565 while (j < mask->dimension[c_dim].extent) {
00566 if (LTOB(el_len, (i8mptr + jndx))) {
00567
00568 j++;
00569 jndx = indx + j *
00570 mask_stride[c_dim];
00571 } else {
00572
00573 if (result->n_dim == 0) {
00574 switch (result->type_lens.int_len) {
00575 case 64 :
00576 i8rptr[0] = (_f_log8) _btol(0);
00577 break;
00578 #ifdef _F_LOG2
00579 case 16 :
00580 i2rptr[0] = (_f_log2) _btol(0);
00581 break;
00582 #endif
00583 #ifdef _F_LOG1
00584 case 8 :
00585 i1rptr[0] = (_f_log1) _btol(0);
00586 break;
00587 #endif
00588 case 32 :
00589 default :
00590 i4rptr[0] = (_f_log4) _btol(0);
00591 }
00592 j = mask->dimension[c_dim].extent;
00593 i = mask->dimension[other_dim].extent;
00594 } else {
00595 switch (result->type_lens.int_len) {
00596 case 64 :
00597 i8rptr[i] = (_f_log8) _btol(0);
00598 break;
00599 #ifdef _F_LOG2
00600 case 16 :
00601 i2rptr[i] = (_f_log2) _btol(0);
00602 break;
00603 #endif
00604 #ifdef _F_LOG1
00605 case 8 :
00606 i1rptr[i] = (_f_log1) _btol(0);
00607 break;
00608 #endif
00609 case 32 :
00610 default :
00611 i4rptr[i] = (_f_log4) _btol(0);
00612 }
00613 j = mask->dimension[c_dim].extent;
00614 }
00615 }
00616 }
00617 break;
00618 #ifdef _F_LOG2
00619 case 16 :
00620 while (j < mask->dimension[c_dim].extent) {
00621 if (LTOB(el_len, (i2mptr + jndx))) {
00622
00623 j++;
00624 jndx = indx + j *
00625 mask_stride[c_dim];
00626 } else {
00627
00628 if (result->n_dim == 0) {
00629 switch (result->type_lens.int_len) {
00630 case 64 :
00631 i8rptr[0] = (_f_log8) _btol(0);
00632 break;
00633 case 16 :
00634 i2rptr[0] = (_f_log2) _btol(0);
00635 break;
00636 #ifdef _F_LOG1
00637 case 8 :
00638 i1rptr[0] = (_f_log1) _btol(0);
00639 break;
00640 #endif
00641 case 32 :
00642 default :
00643 i4rptr[0] = (_f_log4) _btol(0);
00644 }
00645 j = mask->dimension[c_dim].extent;
00646 i = mask->dimension[other_dim].extent;
00647 } else {
00648 switch (result->type_lens.int_len) {
00649 case 64 :
00650 i8rptr[i] = (_f_log8) _btol(0);
00651 break;
00652 case 16 :
00653 i2rptr[i] = (_f_log2) _btol(0);
00654 break;
00655 #ifdef _F_LOG1
00656 case 8 :
00657 i1rptr[i] = (_f_log1) _btol(0);
00658 break;
00659 #endif
00660 case 32 :
00661 default :
00662 i4rptr[i] = (_f_log4) _btol(0);
00663 }
00664 j = mask->dimension[c_dim].extent;
00665 }
00666 }
00667 }
00668 break;
00669 #endif
00670 #ifdef _F_LOG1
00671 case 8 :
00672 while (j < mask->dimension[c_dim].extent) {
00673 if (LTOB(el_len, (i1mptr + jndx))) {
00674
00675 j++;
00676 jndx = indx + j *
00677 mask_stride[c_dim];
00678 } else {
00679
00680 if (result->n_dim == 0) {
00681 switch (result->type_lens.int_len) {
00682 case 64 :
00683 i8rptr[0] = (_f_log8) _btol(0);
00684 break;
00685 case 16 :
00686 i2rptr[0] = (_f_log2) _btol(0);
00687 break;
00688 case 8 :
00689 i1rptr[0] = (_f_log1) _btol(0);
00690 break;
00691 case 32 :
00692 default :
00693 i4rptr[0] = (_f_log4) _btol(0);
00694 }
00695 j = mask->dimension[c_dim].extent;
00696 i = mask->dimension[other_dim].extent;
00697 } else {
00698 switch (result->type_lens.int_len) {
00699 case 64 :
00700 i8rptr[i] = (_f_log8) _btol(0);
00701 break;
00702 case 16 :
00703 i2rptr[i] = (_f_log2) _btol(0);
00704 break;
00705 case 8 :
00706 i1rptr[i] = (_f_log1) _btol(0);
00707 break;
00708 case 32 :
00709 default :
00710 i4rptr[i] = (_f_log4) _btol(0);
00711 }
00712 j = mask->dimension[c_dim].extent;
00713 }
00714 }
00715 }
00716 break;
00717 #endif
00718 case 32 :
00719 default :
00720 while (j < mask->dimension[c_dim].extent) {
00721 if (LTOB(el_len, (i4mptr + jndx))) {
00722
00723 j++;
00724 jndx = indx + j *
00725 mask_stride[c_dim];
00726 } else {
00727
00728 if (result->n_dim == 0) {
00729 switch (result->type_lens.int_len) {
00730 case 64 :
00731 i8rptr[0] = (_f_log8) _btol(0);
00732 break;
00733 #ifdef _F_LOG2
00734 case 16 :
00735 i2rptr[0] = (_f_log2) _btol(0);
00736 break;
00737 #endif
00738 #ifdef _F_LOG1
00739 case 8 :
00740 i1rptr[0] = (_f_log1) _btol(0);
00741 break;
00742 #endif
00743 case 32 :
00744 default :
00745 i4rptr[0] = (_f_log4) _btol(0);
00746 }
00747 j = mask->dimension[c_dim].extent;
00748 i = mask->dimension[other_dim].extent;
00749 } else {
00750 switch (result->type_lens.int_len) {
00751 case 64 :
00752 i8rptr[i] = (_f_log8) _btol(0);
00753 break;
00754 #ifdef _F_LOG2
00755 case 16 :
00756 i2rptr[i] = (_f_log2) _btol(0);
00757 break;
00758 #endif
00759 #ifdef _F_LOG1
00760 case 8 :
00761 i1rptr[i] = (_f_log1) _btol(0);
00762 break;
00763 #endif
00764 case 32 :
00765 default :
00766 i4rptr[i] = (_f_log4) _btol(0);
00767 }
00768 j = mask->dimension[c_dim].extent;
00769 }
00770 }
00771 }
00772 }
00773 if (i != mask->dimension[other_dim].extent) {
00774 i++;
00775 indx = i * mask_stride[other_dim];
00776 }
00777 }
00778
00779
00780 } else {
00781
00782
00783 if (result->n_dim != 0)
00784 #ifdef _UNICOS
00785 #pragma _CRI shortloop
00786 #endif
00787 for (i = 0; i < result->n_dim; i++) {
00788 result_offset[i] = 0;
00789 #ifdef _F_LOG4
00790 result_stride[i] =
00791 (result->dimension[i].stride_mult) >> rshftct;
00792 #else
00793 result_stride[i] =
00794 result->dimension[i].stride_mult;
00795 #endif
00796 }
00797
00798
00799
00800
00801
00802 if (c_dim == 0)
00803 i = 0;
00804 else
00805 #ifdef _UNICOS
00806 #pragma _CRI shortloop
00807 #endif
00808 for (i = 0; i < c_dim; i++) {
00809 current_place[i] = 0;
00810 mask_offset[i] = 0;
00811 mask_extent[i] = mask->dimension[i].extent;
00812 #ifdef _F_LOG4
00813 mask_stride[i] =
00814 (mask->dimension[i].stride_mult) >> mshftct;
00815 #else
00816 mask_stride[i] = mask->dimension[i].stride_mult;
00817 #endif
00818 }
00819 if (i < (mask->n_dim - 1))
00820 #ifdef _UNICOS
00821 #pragma _CRI shortloop
00822 #endif
00823 for ( ; i < mask->n_dim - 1; i++) {
00824 current_place[i] = 0;
00825 mask_offset[i] = 0;
00826 mask_extent[i] = mask->dimension[i+1].extent;
00827 #ifdef _F_LOG4
00828 mask_stride[i] =
00829 (mask->dimension[i+1].stride_mult) >> mshftct;
00830 #else
00831 mask_stride[i] = mask->dimension[i+1].stride_mult;
00832 #endif
00833 }
00834 #ifdef _F_LOG4
00835 cdim_mask_stride = mask->dimension[c_dim].stride_mult >> mshftct;
00836 #else
00837 cdim_mask_stride = mask->dimension[c_dim].stride_mult;
00838 #endif
00839
00840
00841 done = FALSE;
00842 while (!done) {
00843
00844
00845 indx = 0;
00846 #ifdef _UNICOS
00847 #pragma _CRI shortloop
00848 #endif
00849 for (i = 0; i < mask->n_dim - 1; i++)
00850 indx += mask_offset[i];
00851 j = 0;
00852 jndx = indx;
00853
00854
00855 switch (mask->type_lens.int_len) {
00856 case 64 :
00857 while (j < mask->dimension[c_dim].extent) {
00858 if (LTOB(el_len, (i8mptr + jndx))) {
00859
00860 j++;
00861 jndx = indx + j *
00862 cdim_mask_stride;
00863 } else {
00864
00865 if (result->n_dim == 0) {
00866 switch (result->type_lens.int_len) {
00867 case 64 :
00868 i8rptr[0] = (_f_log8) _btol(0);
00869 break;
00870 #ifdef _F_LOG2
00871 case 16 :
00872 i2rptr[0] = (_f_log2) _btol(0);
00873 break;
00874 #endif
00875 #ifdef _F_LOG1
00876 case 8 :
00877 i1rptr[0] = (_f_log1) _btol(0);
00878 break;
00879 #endif
00880 case 32 :
00881 default :
00882 i4rptr[0] = (_f_log4) _btol(0);
00883 }
00884 j = mask->dimension[c_dim].extent;
00885 done = TRUE;
00886 } else {
00887 indx = 0;
00888 for (i = 0; i < mask->n_dim - 1; i++)
00889 indx += result_offset[i];
00890 switch (result->type_lens.int_len) {
00891 case 64 :
00892 i8rptr[indx] = (_f_log8) _btol(0);
00893 break;
00894 #ifdef _F_LOG2
00895 case 16 :
00896 i2rptr[indx] = (_f_log2) _btol(0);
00897 break;
00898 #endif
00899 #ifdef _F_LOG1
00900 case 8 :
00901 i1rptr[indx] = (_f_log1) _btol(0);
00902 break;
00903 #endif
00904 case 32 :
00905 default :
00906 i4rptr[indx] = (_f_log4) _btol(0);
00907 }
00908 j = mask->dimension[c_dim].extent;
00909 }
00910 }
00911 }
00912 break;
00913 #ifdef _F_LOG2
00914 case 16 :
00915 while (j < mask->dimension[c_dim].extent) {
00916 if (LTOB(el_len, (i2mptr + jndx))) {
00917
00918 j++;
00919 jndx = indx + j *
00920 cdim_mask_stride;
00921 } else {
00922
00923 if (result->n_dim == 0) {
00924 switch (result->type_lens.int_len) {
00925 case 64 :
00926 i8rptr[0] = (_f_log8) _btol(0);
00927 break;
00928 case 16 :
00929 i2rptr[0] = (_f_log2) _btol(0);
00930 break;
00931 #ifdef _F_LOG1
00932 case 8 :
00933 i1rptr[0] = (_f_log1) _btol(0);
00934 break;
00935 #endif
00936 case 32 :
00937 default :
00938 i4rptr[0] = (_f_log4) _btol(0);
00939 }
00940 j = mask->dimension[c_dim].extent;
00941 done = TRUE;
00942 } else {
00943 indx = 0;
00944 for (i = 0; i < mask->n_dim - 1; i++)
00945 indx += result_offset[i];
00946 switch (result->type_lens.int_len) {
00947 case 64 :
00948 i8rptr[indx] = (_f_log8) _btol(0);
00949 break;
00950 case 16 :
00951 i2rptr[indx] = (_f_log2) _btol(0);
00952 break;
00953 #ifdef _F_LOG1
00954 case 8 :
00955 i1rptr[indx] = (_f_log1) _btol(0);
00956 break;
00957 #endif
00958 case 32 :
00959 default :
00960 i4rptr[indx] = (_f_log4) _btol(0);
00961 }
00962 j = mask->dimension[c_dim].extent;
00963 }
00964 }
00965 }
00966 break;
00967 #endif
00968 #ifdef _F_LOG1
00969 case 8 :
00970 while (j < mask->dimension[c_dim].extent) {
00971 if (LTOB(el_len, (i1mptr + jndx))) {
00972
00973 j++;
00974 jndx = indx + j *
00975 cdim_mask_stride;
00976 } else {
00977
00978 if (result->n_dim == 0) {
00979 switch (result->type_lens.int_len) {
00980 case 64 :
00981 i8rptr[0] = (_f_log8) _btol(0);
00982 break;
00983 case 16 :
00984 i2rptr[0] = (_f_log2) _btol(0);
00985 break;
00986 case 8 :
00987 i1rptr[0] = (_f_log1) _btol(0);
00988 break;
00989 case 32 :
00990 default :
00991 i4rptr[0] = (_f_log4) _btol(0);
00992 }
00993 j = mask->dimension[c_dim].extent;
00994 done = TRUE;
00995 } else {
00996 indx = 0;
00997 for (i = 0; i < mask->n_dim - 1; i++)
00998 indx += result_offset[i];
00999 switch (result->type_lens.int_len) {
01000 case 64 :
01001 i8rptr[indx] = (_f_log8) _btol(0);
01002 break;
01003 case 16 :
01004 i2rptr[indx] = (_f_log2) _btol(0);
01005 break;
01006 case 8 :
01007 i1rptr[indx] = (_f_log1) _btol(0);
01008 break;
01009 case 32 :
01010 default :
01011 i4rptr[indx] = (_f_log4) _btol(0);
01012 }
01013 j = mask->dimension[c_dim].extent;
01014 }
01015 }
01016 }
01017 break;
01018 #endif
01019 case 32 :
01020 default :
01021 while (j < mask->dimension[c_dim].extent) {
01022 if (LTOB(el_len, (i4mptr + jndx))) {
01023
01024 j++;
01025 jndx = indx + j *
01026 cdim_mask_stride;
01027 } else {
01028
01029 if (result->n_dim == 0) {
01030 switch (result->type_lens.int_len) {
01031 case 64 :
01032 i8rptr[0] = (_f_log8) _btol(0);
01033 break;
01034 #ifdef _F_LOG2
01035 case 16 :
01036 i2rptr[0] = (_f_log2) _btol(0);
01037 break;
01038 #endif
01039 #ifdef _F_LOG1
01040 case 8 :
01041 i1rptr[0] = (_f_log1) _btol(0);
01042 break;
01043 #endif
01044 case 32 :
01045 default :
01046 i4rptr[0] = (_f_log4) _btol(0);
01047 }
01048 j = mask->dimension[c_dim].extent;
01049 done = TRUE;
01050 } else {
01051 indx = 0;
01052 #ifdef _UNICOS
01053 #pragma _CRI shortloop
01054 #endif
01055 for (i = 0; i < mask->n_dim - 1; i++)
01056 indx += result_offset[i];
01057 switch (result->type_lens.int_len) {
01058 case 64 :
01059 i8rptr[indx] = (_f_log8)_btol(0);
01060 break;
01061 #ifdef _F_LOG2
01062 case 16 :
01063 i2rptr[indx] = (_f_log2)_btol(0);
01064 break;
01065 #endif
01066 #ifdef _F_LOG1
01067 case 8 :
01068 i1rptr[indx] = (_f_log1)_btol(0);
01069 break;
01070 #endif
01071 case 32 :
01072 default :
01073 i4rptr[indx] = (_f_log4)_btol(0);
01074 }
01075 j = mask->dimension[c_dim].extent;
01076 }
01077 }
01078 }
01079 }
01080
01081
01082 if (!done) {
01083 i = 0;
01084 stop = FALSE;
01085 while (stop == FALSE && i < mask->n_dim - 1) {
01086 if (current_place[i] == mask_extent[i] - 1) {
01087 current_place[i] = 0;
01088 mask_offset[i] = 0;
01089 if (result->n_dim != 0)
01090 result_offset[i] = 0;
01091 } else {
01092 current_place[i]++;
01093 mask_offset[i] =
01094 current_place[i] *
01095 mask_stride[i];
01096 if (result->n_dim != 0)
01097 result_offset[i] =
01098 current_place[i] *
01099 result_stride[i];
01100 stop = TRUE;
01101 }
01102 i++;
01103 }
01104 if (stop == FALSE)
01105
01106
01107
01108
01109 done = TRUE;
01110 }
01111 }
01112 }
01113 }
