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
00038 #include "f90_intrinsic.h"
00039
00040 static size_t read_source_desc(DopeVectorType * array,
00041 size_t src_extent[MAX_NARY_DIMS],
00042 size_t src_stride[MAX_NARY_DIMS],
00043 size_t src_offset[MAX_NARY_DIMS],
00044 int32_t ddim) ;
00045
00046 static void
00047 get_offset_and_stride(DopeVectorType * array,
00048 size_t src_extent[MAX_NARY_DIMS],
00049 size_t src_stride[MAX_NARY_DIMS],
00050 size_t src_offset[MAX_NARY_DIMS],
00051 int32_t ddim) ;
00052
00053 static int32_t read_dim(DopeVectorType * dim) ;
00054
00055 static void alloc_res(DopeVectorType * result,
00056 size_t src_extent[MAX_NARY_DIMS]);
00057
00058 static void
00059 update_resloc(DopeVectorType * result,int32_t src_rank, size_t src_stride[MAX_NARY_DIMS],char* newaddr,char* base) ;
00060
00061 void
00062 _MINLOC__I1(
00063 DopeVectorType *result,
00064 DopeVectorType *array,
00065 DopeVectorType *dim,
00066 DopeVectorType *mask)
00067 {
00068 char * result_p, * result_b ;
00069 char * array_p, * array_b ;
00070 char * dim_p, * dim_b ;
00071 char * mask_p, * mask_b ;
00072
00073 size_t src_extent [MAX_NARY_DIMS] ;
00074 size_t counter [MAX_NARY_DIMS] ;
00075 size_t src_offset [MAX_NARY_DIMS] ;
00076 size_t src_stride [MAX_NARY_DIMS] ;
00077 size_t src_size ;
00078
00079 size_t res_stride [MAX_NARY_DIMS] ;
00080 size_t res_offset [MAX_NARY_DIMS] ;
00081
00082 size_t msk_stride [MAX_NARY_DIMS] ;
00083 size_t msk_offset [MAX_NARY_DIMS] ;
00084
00085 int32_t ddim ;
00086 uint32_t src_rank ;
00087 uint32_t res_rank ;
00088
00089 size_t j,k,i ;
00090 size_t msk_typ_sz;
00091
00092 i1 accum ;
00093 i1 const initv = INT8_MAX ;
00094 size_t a_size,a_stride;
00095 size_t m_stride ;
00096
00097 i1 temp,new ;
00098
00099 char *newaddr ;
00100 size_t offs;
00101 size_t lexts[2];
00102
00103 if (mask == NULL) {
00104 if (dim != NULL) {
00105 if (GET_DV_LOGICAL_FROM_DESC(dim)) {
00106 mask = (DopeVectorType *) dim ;
00107 dim = NULL;
00108 }
00109 }
00110 }
00111
00112 if (dim != NULL) {
00113 ddim = read_dim(dim);
00114 } else
00115 ddim = 0 ;
00116
00117 array_b = (char *) GET_ADDRESS_FROM_DESC(array) ;
00118 src_rank = GET_RANK_FROM_DESC(array) - 1;
00119
00120 src_size = read_source_desc(array, src_extent, src_stride, src_offset, ddim);
00121
00122 for (i = 0 ; i <= src_rank ; i ++)
00123 counter[i] = 0 ;
00124
00125 if ((ddim > src_rank ) || (ddim < 0))
00126 ERROR(_LELVL_ABORT,FESCIDIM);
00127
00128 res_rank = GET_RANK_FROM_DESC(result);
00129
00130 if (!GET_ASSOCIATED_FROM_DESC(result)) {
00131 if (dim == NULL) {
00132 lexts[0] = 0;
00133 lexts[1] = src_rank + 1 ;
00134 alloc_res(result,lexts);
00135 } else
00136 alloc_res(result,src_extent);
00137 }
00138
00139 res_stride[0] = 0;
00140 for (j = 0 ; j <= src_rank; j ++ ) res_offset[j] = 0 ;
00141 for (j = 0 ; j < res_rank ; j ++ ) {
00142 res_stride[j] = GET_STRIDE_FROM_DESC(result,j) ;
00143 }
00144
00145 if (dim != NULL)
00146 res_offset[0] = res_stride[0] ;
00147 for ( j = 1 ; j < res_rank ; j ++ )
00148 res_offset[j] = res_stride[j] - (res_stride[j-1]*(src_extent[j])) ;
00149
00150 result_b = GET_ADDRESS_FROM_DESC(result);
00151
00152 if (mask != NULL) {
00153
00154 msk_typ_sz = GET_ELEMENT_SZ_FROM_DESC(mask);
00155 mask_b = (char *) GET_ADDRESS_FROM_DESC(mask) + OFFSET_TO_TF_BYTE(msk_typ_sz) ;
00156
00157 if (GET_RANK_FROM_DESC(mask) == 0) {
00158 if (*mask_b) {
00159 mask = NULL;
00160 } else {
00161 src_size = 0;
00162 for (j = 0 ; j <= src_rank ; j ++) {
00163 msk_stride[j] = 0 ;
00164 msk_offset[j] = 0 ;
00165 }
00166 }
00167
00168 } else {
00169
00170 get_offset_and_stride(mask, src_extent, msk_stride, msk_offset, ddim);
00171 }
00172 }
00173
00174 accum = initv ;
00175
00176 if (src_size == 0 ) {
00177 for (i = 1 ; i <= src_rank ; i ++ )
00178 if (src_extent[i] == 0)
00179 return ;
00180 }
00181 array_p = array_b ;
00182 result_p = result_b ;
00183 if (mask == NULL) {
00184
00185 a_size = src_extent[0] ;
00186 a_stride = src_stride[0] ;
00187
00188 while (counter[src_rank] < src_extent[src_rank] ) {
00189
00190 size_t count = 0 ;
00191
00192 for ( i = 0 ; i < a_size ; i ++ ) {
00193 if (*(i1 *) array_p < accum ) {
00194 accum = *(i1 *) array_p ;
00195 newaddr = array_p;
00196 count ++ ;
00197 }
00198 array_p += a_stride ;
00199 if (dim !=NULL) {
00200 *(i1 *) result_p = count ;
00201 accum = initv ;
00202 }
00203 }
00204 counter[0] = a_size ;
00205 j = 0 ;
00206 while ((counter[j] == src_extent[j]) && (j < src_rank)) {
00207 array_p += src_offset[j] ;
00208 result_p += res_offset[j] ;
00209 counter[j+1]++ ;
00210 counter[j] = 0 ;
00211 j ++ ;
00212 }
00213 }
00214 if (dim == NULL)
00215 update_resloc(result,src_rank,src_stride,newaddr,array_b) ;
00216
00217 } else {
00218
00219 a_size = src_extent[0] ;
00220 a_stride = src_stride[0] ;
00221 m_stride = msk_stride[0] ;
00222 mask_p = mask_b ;
00223
00224 while (counter[src_rank] < src_extent[src_rank] ) {
00225
00226 size_t count = 0 ;
00227
00228 for ( i = 0 ; i < a_size ; i ++ ) {
00229 if (*mask_p) {
00230 if (*(i1 *) array_p < accum ) {
00231 accum = *(i1 *) array_p ;
00232 newaddr = array_p;
00233 count ++ ;
00234 }
00235 }
00236 array_p += a_stride ;
00237 mask_p += m_stride ;
00238 if (dim !=NULL) {
00239 *(i1 *) result_p = count ;
00240 accum = initv ;
00241 }
00242 }
00243 counter[0] = a_size ;
00244 j = 0 ;
00245 while ((counter[j] == src_extent[j]) && (j < src_rank)) {
00246 array_p += src_offset[j] ;
00247 mask_p += msk_offset[j] ;
00248 result_p += res_offset[j] ;
00249 counter[j+1]++ ;
00250 counter[j] = 0 ;
00251 j ++ ;
00252 }
00253 }
00254 if (dim == NULL)
00255 update_resloc(result,src_rank,src_stride,newaddr,array_b) ;
00256
00257 }
00258 }
00259 void
00260 _MINLOC__I2(
00261 DopeVectorType *result,
00262 DopeVectorType *array,
00263 DopeVectorType *dim,
00264 DopeVectorType *mask)
00265 {
00266 char * result_p, * result_b ;
00267 char * array_p, * array_b ;
00268 char * dim_p, * dim_b ;
00269 char * mask_p, * mask_b ;
00270
00271 size_t src_extent [MAX_NARY_DIMS] ;
00272 size_t counter [MAX_NARY_DIMS] ;
00273 size_t src_offset [MAX_NARY_DIMS] ;
00274 size_t src_stride [MAX_NARY_DIMS] ;
00275 size_t src_size ;
00276
00277 size_t res_stride [MAX_NARY_DIMS] ;
00278 size_t res_offset [MAX_NARY_DIMS] ;
00279
00280 size_t msk_stride [MAX_NARY_DIMS] ;
00281 size_t msk_offset [MAX_NARY_DIMS] ;
00282
00283 int32_t ddim ;
00284 uint32_t src_rank ;
00285 uint32_t res_rank ;
00286
00287 size_t j,k,i ;
00288 size_t msk_typ_sz;
00289
00290 i2 accum ;
00291 i2 const initv = INT16_MAX ;
00292 size_t a_size,a_stride;
00293 size_t m_stride ;
00294
00295 i2 temp,new ;
00296
00297 char *newaddr ;
00298 size_t offs;
00299 size_t lexts[2];
00300
00301 if (mask == NULL) {
00302 if (dim != NULL) {
00303 if (GET_DV_LOGICAL_FROM_DESC(dim)) {
00304 mask = (DopeVectorType *) dim ;
00305 dim = NULL;
00306 }
00307 }
00308 }
00309
00310 if (dim != NULL) {
00311 ddim = read_dim(dim);
00312 } else
00313 ddim = 0 ;
00314
00315 array_b = (char *) GET_ADDRESS_FROM_DESC(array) ;
00316 src_rank = GET_RANK_FROM_DESC(array) - 1;
00317
00318 src_size = read_source_desc(array, src_extent, src_stride, src_offset, ddim);
00319
00320 for (i = 0 ; i <= src_rank ; i ++)
00321 counter[i] = 0 ;
00322
00323 if ((ddim > src_rank ) || (ddim < 0))
00324 ERROR(_LELVL_ABORT,FESCIDIM);
00325
00326 res_rank = GET_RANK_FROM_DESC(result);
00327
00328 if (!GET_ASSOCIATED_FROM_DESC(result)) {
00329 if (dim == NULL) {
00330 lexts[0] = 0;
00331 lexts[1] = src_rank + 1 ;
00332 alloc_res(result,lexts);
00333 } else
00334 alloc_res(result,src_extent);
00335 }
00336
00337 res_stride[0] = 0;
00338 for (j = 0 ; j <= src_rank; j ++ ) res_offset[j] = 0 ;
00339 for (j = 0 ; j < res_rank ; j ++ ) {
00340 res_stride[j] = GET_STRIDE_FROM_DESC(result,j) ;
00341 }
00342
00343 if (dim != NULL)
00344 res_offset[0] = res_stride[0] ;
00345 for ( j = 1 ; j < res_rank ; j ++ )
00346 res_offset[j] = res_stride[j] - (res_stride[j-1]*(src_extent[j])) ;
00347
00348 result_b = GET_ADDRESS_FROM_DESC(result);
00349
00350 if (mask != NULL) {
00351
00352 msk_typ_sz = GET_ELEMENT_SZ_FROM_DESC(mask);
00353 mask_b = (char *) GET_ADDRESS_FROM_DESC(mask) + OFFSET_TO_TF_BYTE(msk_typ_sz) ;
00354
00355 if (GET_RANK_FROM_DESC(mask) == 0) {
00356 if (*mask_b) {
00357 mask = NULL;
00358 } else {
00359 src_size = 0;
00360 for (j = 0 ; j <= src_rank ; j ++) {
00361 msk_stride[j] = 0 ;
00362 msk_offset[j] = 0 ;
00363 }
00364 }
00365
00366 } else {
00367
00368 get_offset_and_stride(mask, src_extent, msk_stride, msk_offset, ddim);
00369 }
00370 }
00371
00372 accum = initv ;
00373
00374 if (src_size == 0 ) {
00375 for (i = 1 ; i <= src_rank ; i ++ )
00376 if (src_extent[i] == 0)
00377 return ;
00378 }
00379 array_p = array_b ;
00380 result_p = result_b ;
00381 if (mask == NULL) {
00382
00383 a_size = src_extent[0] ;
00384 a_stride = src_stride[0] ;
00385
00386 while (counter[src_rank] < src_extent[src_rank] ) {
00387
00388 size_t count = 0 ;
00389
00390 for ( i = 0 ; i < a_size ; i ++ ) {
00391 if (*(i2 *) array_p < accum ) {
00392 accum = *(i2 *) array_p ;
00393 newaddr = array_p;
00394 count ++ ;
00395 }
00396 array_p += a_stride ;
00397 if (dim !=NULL) {
00398 *(i2 *) result_p = count ;
00399 accum = initv ;
00400 }
00401 }
00402 counter[0] = a_size ;
00403 j = 0 ;
00404 while ((counter[j] == src_extent[j]) && (j < src_rank)) {
00405 array_p += src_offset[j] ;
00406 result_p += res_offset[j] ;
00407 counter[j+1]++ ;
00408 counter[j] = 0 ;
00409 j ++ ;
00410 }
00411 }
00412 if (dim == NULL)
00413 update_resloc(result,src_rank,src_stride,newaddr,array_b) ;
00414
00415 } else {
00416
00417 a_size = src_extent[0] ;
00418 a_stride = src_stride[0] ;
00419 m_stride = msk_stride[0] ;
00420 mask_p = mask_b ;
00421
00422 while (counter[src_rank] < src_extent[src_rank] ) {
00423
00424 size_t count = 0 ;
00425
00426 for ( i = 0 ; i < a_size ; i ++ ) {
00427 if (*mask_p) {
00428 if (*(i2 *) array_p < accum ) {
00429 accum = *(i2 *) array_p ;
00430 newaddr = array_p;
00431 count ++ ;
00432 }
00433 }
00434 array_p += a_stride ;
00435 mask_p += m_stride ;
00436 if (dim !=NULL) {
00437 *(i2 *) result_p = count ;
00438 accum = initv ;
00439 }
00440 }
00441 counter[0] = a_size ;
00442 j = 0 ;
00443 while ((counter[j] == src_extent[j]) && (j < src_rank)) {
00444 array_p += src_offset[j] ;
00445 mask_p += msk_offset[j] ;
00446 result_p += res_offset[j] ;
00447 counter[j+1]++ ;
00448 counter[j] = 0 ;
00449 j ++ ;
00450 }
00451 }
00452 if (dim == NULL)
00453 update_resloc(result,src_rank,src_stride,newaddr,array_b) ;
00454
00455 }
00456 }
00457 void
00458 _MINLOC__I4(
00459 DopeVectorType *result,
00460 DopeVectorType *array,
00461 DopeVectorType *dim,
00462 DopeVectorType *mask)
00463 {
00464 char * result_p, * result_b ;
00465 char * array_p, * array_b ;
00466 char * dim_p, * dim_b ;
00467 char * mask_p, * mask_b ;
00468
00469 size_t src_extent [MAX_NARY_DIMS] ;
00470 size_t counter [MAX_NARY_DIMS] ;
00471 size_t src_offset [MAX_NARY_DIMS] ;
00472 size_t src_stride [MAX_NARY_DIMS] ;
00473 size_t src_size ;
00474
00475 size_t res_stride [MAX_NARY_DIMS] ;
00476 size_t res_offset [MAX_NARY_DIMS] ;
00477
00478 size_t msk_stride [MAX_NARY_DIMS] ;
00479 size_t msk_offset [MAX_NARY_DIMS] ;
00480
00481 int32_t ddim ;
00482 uint32_t src_rank ;
00483 uint32_t res_rank ;
00484
00485 size_t j,k,i ;
00486 size_t msk_typ_sz;
00487
00488 i4 accum ;
00489 i4 const initv = INT32_MAX ;
00490 size_t a_size,a_stride;
00491 size_t m_stride ;
00492
00493 i4 temp,new ;
00494
00495 char *newaddr ;
00496 size_t offs;
00497 size_t lexts[2];
00498
00499 if (mask == NULL) {
00500 if (dim != NULL) {
00501 if (GET_DV_LOGICAL_FROM_DESC(dim)) {
00502 mask = (DopeVectorType *) dim ;
00503 dim = NULL;
00504 }
00505 }
00506 }
00507
00508 if (dim != NULL) {
00509 ddim = read_dim(dim);
00510 } else
00511 ddim = 0 ;
00512
00513 array_b = (char *) GET_ADDRESS_FROM_DESC(array) ;
00514 src_rank = GET_RANK_FROM_DESC(array) - 1;
00515
00516 src_size = read_source_desc(array, src_extent, src_stride, src_offset, ddim);
00517
00518 for (i = 0 ; i <= src_rank ; i ++)
00519 counter[i] = 0 ;
00520
00521 if ((ddim > src_rank ) || (ddim < 0))
00522 ERROR(_LELVL_ABORT,FESCIDIM);
00523
00524 res_rank = GET_RANK_FROM_DESC(result);
00525
00526 if (!GET_ASSOCIATED_FROM_DESC(result)) {
00527 if (dim == NULL) {
00528 lexts[0] = 0;
00529 lexts[1] = src_rank + 1 ;
00530 alloc_res(result,lexts);
00531 } else
00532 alloc_res(result,src_extent);
00533 }
00534
00535 res_stride[0] = 0;
00536 for (j = 0 ; j <= src_rank; j ++ ) res_offset[j] = 0 ;
00537 for (j = 0 ; j < res_rank ; j ++ ) {
00538 res_stride[j] = GET_STRIDE_FROM_DESC(result,j) ;
00539 }
00540
00541 if (dim != NULL)
00542 res_offset[0] = res_stride[0] ;
00543 for ( j = 1 ; j < res_rank ; j ++ )
00544 res_offset[j] = res_stride[j] - (res_stride[j-1]*(src_extent[j])) ;
00545
00546 result_b = GET_ADDRESS_FROM_DESC(result);
00547
00548 if (mask != NULL) {
00549
00550 msk_typ_sz = GET_ELEMENT_SZ_FROM_DESC(mask);
00551 mask_b = (char *) GET_ADDRESS_FROM_DESC(mask) + OFFSET_TO_TF_BYTE(msk_typ_sz) ;
00552
00553 if (GET_RANK_FROM_DESC(mask) == 0) {
00554 if (*mask_b) {
00555 mask = NULL;
00556 } else {
00557 src_size = 0;
00558 for (j = 0 ; j <= src_rank ; j ++) {
00559 msk_stride[j] = 0 ;
00560 msk_offset[j] = 0 ;
00561 }
00562 }
00563
00564 } else {
00565
00566 get_offset_and_stride(mask, src_extent, msk_stride, msk_offset, ddim);
00567 }
00568 }
00569
00570 accum = initv ;
00571
00572 if (src_size == 0 ) {
00573 for (i = 1 ; i <= src_rank ; i ++ )
00574 if (src_extent[i] == 0)
00575 return ;
00576 }
00577 array_p = array_b ;
00578 result_p = result_b ;
00579 if (mask == NULL) {
00580
00581 a_size = src_extent[0] ;
00582 a_stride = src_stride[0] ;
00583
00584 while (counter[src_rank] < src_extent[src_rank] ) {
00585
00586 size_t count = 0 ;
00587
00588 for ( i = 0 ; i < a_size ; i ++ ) {
00589 if (*(i4 *) array_p < accum ) {
00590 accum = *(i4 *) array_p ;
00591 newaddr = array_p;
00592 count ++ ;
00593 }
00594 array_p += a_stride ;
00595 if (dim !=NULL) {
00596 *(i4 *) result_p = count ;
00597 accum = initv ;
00598 }
00599 }
00600 counter[0] = a_size ;
00601 j = 0 ;
00602 while ((counter[j] == src_extent[j]) && (j < src_rank)) {
00603 array_p += src_offset[j] ;
00604 result_p += res_offset[j] ;
00605 counter[j+1]++ ;
00606 counter[j] = 0 ;
00607 j ++ ;
00608 }
00609 }
00610 if (dim == NULL)
00611 update_resloc(result,src_rank,src_stride,newaddr,array_b) ;
00612
00613 } else {
00614
00615 a_size = src_extent[0] ;
00616 a_stride = src_stride[0] ;
00617 m_stride = msk_stride[0] ;
00618 mask_p = mask_b ;
00619
00620 while (counter[src_rank] < src_extent[src_rank] ) {
00621
00622 size_t count = 0 ;
00623
00624 for ( i = 0 ; i < a_size ; i ++ ) {
00625 if (*mask_p) {
00626 if (*(i4 *) array_p < accum ) {
00627 accum = *(i4 *) array_p ;
00628 newaddr = array_p;
00629 count ++ ;
00630 }
00631 }
00632 array_p += a_stride ;
00633 mask_p += m_stride ;
00634 if (dim !=NULL) {
00635 *(i4 *) result_p = count ;
00636 accum = initv ;
00637 }
00638 }
00639 counter[0] = a_size ;
00640 j = 0 ;
00641 while ((counter[j] == src_extent[j]) && (j < src_rank)) {
00642 array_p += src_offset[j] ;
00643 mask_p += msk_offset[j] ;
00644 result_p += res_offset[j] ;
00645 counter[j+1]++ ;
00646 counter[j] = 0 ;
00647 j ++ ;
00648 }
00649 }
00650 if (dim == NULL)
00651 update_resloc(result,src_rank,src_stride,newaddr,array_b) ;
00652
00653 }
00654 }
00655 void
00656 _MINLOC__J(
00657 DopeVectorType *result,
00658 DopeVectorType *array,
00659 DopeVectorType *dim,
00660 DopeVectorType *mask)
00661 {
00662 char * result_p, * result_b ;
00663 char * array_p, * array_b ;
00664 char * dim_p, * dim_b ;
00665 char * mask_p, * mask_b ;
00666
00667 size_t src_extent [MAX_NARY_DIMS] ;
00668 size_t counter [MAX_NARY_DIMS] ;
00669 size_t src_offset [MAX_NARY_DIMS] ;
00670 size_t src_stride [MAX_NARY_DIMS] ;
00671 size_t src_size ;
00672
00673 size_t res_stride [MAX_NARY_DIMS] ;
00674 size_t res_offset [MAX_NARY_DIMS] ;
00675
00676 size_t msk_stride [MAX_NARY_DIMS] ;
00677 size_t msk_offset [MAX_NARY_DIMS] ;
00678
00679 int32_t ddim ;
00680 uint32_t src_rank ;
00681 uint32_t res_rank ;
00682
00683 size_t j,k,i ;
00684 size_t msk_typ_sz;
00685
00686 i8 accum ;
00687 i8 const initv = INT64_MAX ;
00688 size_t a_size,a_stride;
00689 size_t m_stride ;
00690
00691 i8 temp,new ;
00692
00693 char *newaddr ;
00694 size_t offs;
00695 size_t lexts[2];
00696
00697 if (mask == NULL) {
00698 if (dim != NULL) {
00699 if (GET_DV_LOGICAL_FROM_DESC(dim)) {
00700 mask = (DopeVectorType *) dim ;
00701 dim = NULL;
00702 }
00703 }
00704 }
00705
00706 if (dim != NULL) {
00707 ddim = read_dim(dim);
00708 } else
00709 ddim = 0 ;
00710
00711 array_b = (char *) GET_ADDRESS_FROM_DESC(array) ;
00712 src_rank = GET_RANK_FROM_DESC(array) - 1;
00713
00714 src_size = read_source_desc(array, src_extent, src_stride, src_offset, ddim);
00715
00716 for (i = 0 ; i <= src_rank ; i ++)
00717 counter[i] = 0 ;
00718
00719 if ((ddim > src_rank ) || (ddim < 0))
00720 ERROR(_LELVL_ABORT,FESCIDIM);
00721
00722 res_rank = GET_RANK_FROM_DESC(result);
00723
00724 if (!GET_ASSOCIATED_FROM_DESC(result)) {
00725 if (dim == NULL) {
00726 lexts[0] = 0;
00727 lexts[1] = src_rank + 1 ;
00728 alloc_res(result,lexts);
00729 } else
00730 alloc_res(result,src_extent);
00731 }
00732
00733 res_stride[0] = 0;
00734 for (j = 0 ; j <= src_rank; j ++ ) res_offset[j] = 0 ;
00735 for (j = 0 ; j < res_rank ; j ++ ) {
00736 res_stride[j] = GET_STRIDE_FROM_DESC(result,j) ;
00737 }
00738
00739 if (dim != NULL)
00740 res_offset[0] = res_stride[0] ;
00741 for ( j = 1 ; j < res_rank ; j ++ )
00742 res_offset[j] = res_stride[j] - (res_stride[j-1]*(src_extent[j])) ;
00743
00744 result_b = GET_ADDRESS_FROM_DESC(result);
00745
00746 if (mask != NULL) {
00747
00748 msk_typ_sz = GET_ELEMENT_SZ_FROM_DESC(mask);
00749 mask_b = (char *) GET_ADDRESS_FROM_DESC(mask) + OFFSET_TO_TF_BYTE(msk_typ_sz) ;
00750
00751 if (GET_RANK_FROM_DESC(mask) == 0) {
00752 if (*mask_b) {
00753 mask = NULL;
00754 } else {
00755 src_size = 0;
00756 for (j = 0 ; j <= src_rank ; j ++) {
00757 msk_stride[j] = 0 ;
00758 msk_offset[j] = 0 ;
00759 }
00760 }
00761
00762 } else {
00763
00764 get_offset_and_stride(mask, src_extent, msk_stride, msk_offset, ddim);
00765 }
00766 }
00767
00768 accum = initv ;
00769
00770 if (src_size == 0 ) {
00771 for (i = 1 ; i <= src_rank ; i ++ )
00772 if (src_extent[i] == 0)
00773 return ;
00774 }
00775 array_p = array_b ;
00776 result_p = result_b ;
00777 if (mask == NULL) {
00778
00779 a_size = src_extent[0] ;
00780 a_stride = src_stride[0] ;
00781
00782 while (counter[src_rank] < src_extent[src_rank] ) {
00783
00784 size_t count = 0 ;
00785
00786 for ( i = 0 ; i < a_size ; i ++ ) {
00787 if (*(i8 *) array_p < accum ) {
00788 accum = *(i8 *) array_p ;
00789 newaddr = array_p;
00790 count ++ ;
00791 }
00792 array_p += a_stride ;
00793 if (dim !=NULL) {
00794 *(i8 *) result_p = count ;
00795 accum = initv ;
00796 }
00797 }
00798 counter[0] = a_size ;
00799 j = 0 ;
00800 while ((counter[j] == src_extent[j]) && (j < src_rank)) {
00801 array_p += src_offset[j] ;
00802 result_p += res_offset[j] ;
00803 counter[j+1]++ ;
00804 counter[j] = 0 ;
00805 j ++ ;
00806 }
00807 }
00808 if (dim == NULL)
00809 update_resloc(result,src_rank,src_stride,newaddr,array_b) ;
00810
00811 } else {
00812
00813 a_size = src_extent[0] ;
00814 a_stride = src_stride[0] ;
00815 m_stride = msk_stride[0] ;
00816 mask_p = mask_b ;
00817
00818 while (counter[src_rank] < src_extent[src_rank] ) {
00819
00820 size_t count = 0 ;
00821
00822 for ( i = 0 ; i < a_size ; i ++ ) {
00823 if (*mask_p) {
00824 if (*(i8 *) array_p < accum ) {
00825 accum = *(i8 *) array_p ;
00826 newaddr = array_p;
00827 count ++ ;
00828 }
00829 }
00830 array_p += a_stride ;
00831 mask_p += m_stride ;
00832 if (dim !=NULL) {
00833 *(i8 *) result_p = count ;
00834 accum = initv ;
00835 }
00836 }
00837 counter[0] = a_size ;
00838 j = 0 ;
00839 while ((counter[j] == src_extent[j]) && (j < src_rank)) {
00840 array_p += src_offset[j] ;
00841 mask_p += msk_offset[j] ;
00842 result_p += res_offset[j] ;
00843 counter[j+1]++ ;
00844 counter[j] = 0 ;
00845 j ++ ;
00846 }
00847 }
00848 if (dim == NULL)
00849 update_resloc(result,src_rank,src_stride,newaddr,array_b) ;
00850
00851 }
00852 }
00853 void
00854 _MINLOC__S4(
00855 DopeVectorType *result,
00856 DopeVectorType *array,
00857 DopeVectorType *dim,
00858 DopeVectorType *mask)
00859 {
00860 char * result_p, * result_b ;
00861 char * array_p, * array_b ;
00862 char * dim_p, * dim_b ;
00863 char * mask_p, * mask_b ;
00864
00865 size_t src_extent [MAX_NARY_DIMS] ;
00866 size_t counter [MAX_NARY_DIMS] ;
00867 size_t src_offset [MAX_NARY_DIMS] ;
00868 size_t src_stride [MAX_NARY_DIMS] ;
00869 size_t src_size ;
00870
00871 size_t res_stride [MAX_NARY_DIMS] ;
00872 size_t res_offset [MAX_NARY_DIMS] ;
00873
00874 size_t msk_stride [MAX_NARY_DIMS] ;
00875 size_t msk_offset [MAX_NARY_DIMS] ;
00876
00877 int32_t ddim ;
00878 uint32_t src_rank ;
00879 uint32_t res_rank ;
00880
00881 size_t j,k,i ;
00882 size_t msk_typ_sz;
00883
00884 r4 accum ;
00885 r4 const initv = HUGE_REAL4_F90 ;
00886 size_t a_size,a_stride;
00887 size_t m_stride ;
00888
00889 r4 temp,new ;
00890
00891 char *newaddr ;
00892 size_t offs;
00893 size_t lexts[2];
00894
00895 if (mask == NULL) {
00896 if (dim != NULL) {
00897 if (GET_DV_LOGICAL_FROM_DESC(dim)) {
00898 mask = (DopeVectorType *) dim ;
00899 dim = NULL;
00900 }
00901 }
00902 }
00903
00904 if (dim != NULL) {
00905 ddim = read_dim(dim);
00906 } else
00907 ddim = 0 ;
00908
00909 array_b = (char *) GET_ADDRESS_FROM_DESC(array) ;
00910 src_rank = GET_RANK_FROM_DESC(array) - 1;
00911
00912 src_size = read_source_desc(array, src_extent, src_stride, src_offset, ddim);
00913
00914 for (i = 0 ; i <= src_rank ; i ++)
00915 counter[i] = 0 ;
00916
00917 if ((ddim > src_rank ) || (ddim < 0))
00918 ERROR(_LELVL_ABORT,FESCIDIM);
00919
00920 res_rank = GET_RANK_FROM_DESC(result);
00921
00922 if (!GET_ASSOCIATED_FROM_DESC(result)) {
00923 if (dim == NULL) {
00924 lexts[0] = 0;
00925 lexts[1] = src_rank + 1 ;
00926 alloc_res(result,lexts);
00927 } else
00928 alloc_res(result,src_extent);
00929 }
00930
00931 res_stride[0] = 0;
00932 for (j = 0 ; j <= src_rank; j ++ ) res_offset[j] = 0 ;
00933 for (j = 0 ; j < res_rank ; j ++ ) {
00934 res_stride[j] = GET_STRIDE_FROM_DESC(result,j) ;
00935 }
00936
00937 if (dim != NULL)
00938 res_offset[0] = res_stride[0] ;
00939 for ( j = 1 ; j < res_rank ; j ++ )
00940 res_offset[j] = res_stride[j] - (res_stride[j-1]*(src_extent[j])) ;
00941
00942 result_b = GET_ADDRESS_FROM_DESC(result);
00943
00944 if (mask != NULL) {
00945
00946 msk_typ_sz = GET_ELEMENT_SZ_FROM_DESC(mask);
00947 mask_b = (char *) GET_ADDRESS_FROM_DESC(mask) + OFFSET_TO_TF_BYTE(msk_typ_sz) ;
00948
00949 if (GET_RANK_FROM_DESC(mask) == 0) {
00950 if (*mask_b) {
00951 mask = NULL;
00952 } else {
00953 src_size = 0;
00954 for (j = 0 ; j <= src_rank ; j ++) {
00955 msk_stride[j] = 0 ;
00956 msk_offset[j] = 0 ;
00957 }
00958 }
00959
00960 } else {
00961
00962 get_offset_and_stride(mask, src_extent, msk_stride, msk_offset, ddim);
00963 }
00964 }
00965
00966 accum = initv ;
00967
00968 if (src_size == 0 ) {
00969 for (i = 1 ; i <= src_rank ; i ++ )
00970 if (src_extent[i] == 0)
00971 return ;
00972 }
00973 array_p = array_b ;
00974 result_p = result_b ;
00975 if (mask == NULL) {
00976
00977 a_size = src_extent[0] ;
00978 a_stride = src_stride[0] ;
00979
00980 while (counter[src_rank] < src_extent[src_rank] ) {
00981
00982 size_t count = 0 ;
00983
00984 for ( i = 0 ; i < a_size ; i ++ ) {
00985 if (*(r4 *) array_p < accum ) {
00986 accum = *(r4 *) array_p ;
00987 newaddr = array_p;
00988 count ++ ;
00989 }
00990 array_p += a_stride ;
00991 if (dim !=NULL) {
00992 *(r4 *) result_p = count ;
00993 accum = initv ;
00994 }
00995 }
00996 counter[0] = a_size ;
00997 j = 0 ;
00998 while ((counter[j] == src_extent[j]) && (j < src_rank)) {
00999 array_p += src_offset[j] ;
01000 result_p += res_offset[j] ;
01001 counter[j+1]++ ;
01002 counter[j] = 0 ;
01003 j ++ ;
01004 }
01005 }
01006 if (dim == NULL)
01007 update_resloc(result,src_rank,src_stride,newaddr,array_b) ;
01008
01009 } else {
01010
01011 a_size = src_extent[0] ;
01012 a_stride = src_stride[0] ;
01013 m_stride = msk_stride[0] ;
01014 mask_p = mask_b ;
01015
01016 while (counter[src_rank] < src_extent[src_rank] ) {
01017
01018 size_t count = 0 ;
01019
01020 for ( i = 0 ; i < a_size ; i ++ ) {
01021 if (*mask_p) {
01022 if (*(r4 *) array_p < accum ) {
01023 accum = *(r4 *) array_p ;
01024 newaddr = array_p;
01025 count ++ ;
01026 }
01027 }
01028 array_p += a_stride ;
01029 mask_p += m_stride ;
01030 if (dim !=NULL) {
01031 *(r4 *) result_p = count ;
01032 accum = initv ;
01033 }
01034 }
01035 counter[0] = a_size ;
01036 j = 0 ;
01037 while ((counter[j] == src_extent[j]) && (j < src_rank)) {
01038 array_p += src_offset[j] ;
01039 mask_p += msk_offset[j] ;
01040 result_p += res_offset[j] ;
01041 counter[j+1]++ ;
01042 counter[j] = 0 ;
01043 j ++ ;
01044 }
01045 }
01046 if (dim == NULL)
01047 update_resloc(result,src_rank,src_stride,newaddr,array_b) ;
01048
01049 }
01050 }
01051 void
01052 _MINLOC__S(
01053 DopeVectorType *result,
01054 DopeVectorType *array,
01055 DopeVectorType *dim,
01056 DopeVectorType *mask)
01057 {
01058 char * result_p, * result_b ;
01059 char * array_p, * array_b ;
01060 char * dim_p, * dim_b ;
01061 char * mask_p, * mask_b ;
01062
01063 size_t src_extent [MAX_NARY_DIMS] ;
01064 size_t counter [MAX_NARY_DIMS] ;
01065 size_t src_offset [MAX_NARY_DIMS] ;
01066 size_t src_stride [MAX_NARY_DIMS] ;
01067 size_t src_size ;
01068
01069 size_t res_stride [MAX_NARY_DIMS] ;
01070 size_t res_offset [MAX_NARY_DIMS] ;
01071
01072 size_t msk_stride [MAX_NARY_DIMS] ;
01073 size_t msk_offset [MAX_NARY_DIMS] ;
01074
01075 int32_t ddim ;
01076 uint32_t src_rank ;
01077 uint32_t res_rank ;
01078
01079 size_t j,k,i ;
01080 size_t msk_typ_sz;
01081
01082 r8 accum ;
01083 r8 const initv = HUGE_REAL8_F90 ;
01084 size_t a_size,a_stride;
01085 size_t m_stride ;
01086
01087 r8 temp,new ;
01088
01089 char *newaddr ;
01090 size_t offs;
01091 size_t lexts[2];
01092
01093 if (mask == NULL) {
01094 if (dim != NULL) {
01095 if (GET_DV_LOGICAL_FROM_DESC(dim)) {
01096 mask = (DopeVectorType *) dim ;
01097 dim = NULL;
01098 }
01099 }
01100 }
01101
01102 if (dim != NULL) {
01103 ddim = read_dim(dim);
01104 } else
01105 ddim = 0 ;
01106
01107 array_b = (char *) GET_ADDRESS_FROM_DESC(array) ;
01108 src_rank = GET_RANK_FROM_DESC(array) - 1;
01109
01110 src_size = read_source_desc(array, src_extent, src_stride, src_offset, ddim);
01111
01112 for (i = 0 ; i <= src_rank ; i ++)
01113 counter[i] = 0 ;
01114
01115 if ((ddim > src_rank ) || (ddim < 0))
01116 ERROR(_LELVL_ABORT,FESCIDIM);
01117
01118 res_rank = GET_RANK_FROM_DESC(result);
01119
01120 if (!GET_ASSOCIATED_FROM_DESC(result)) {
01121 if (dim == NULL) {
01122 lexts[0] = 0;
01123 lexts[1] = src_rank + 1 ;
01124 alloc_res(result,lexts);
01125 } else
01126 alloc_res(result,src_extent);
01127 }
01128
01129 res_stride[0] = 0;
01130 for (j = 0 ; j <= src_rank; j ++ ) res_offset[j] = 0 ;
01131 for (j = 0 ; j < res_rank ; j ++ ) {
01132 res_stride[j] = GET_STRIDE_FROM_DESC(result,j) ;
01133 }
01134
01135 if (dim != NULL)
01136 res_offset[0] = res_stride[0] ;
01137 for ( j = 1 ; j < res_rank ; j ++ )
01138 res_offset[j] = res_stride[j] - (res_stride[j-1]*(src_extent[j])) ;
01139
01140 result_b = GET_ADDRESS_FROM_DESC(result);
01141
01142 if (mask != NULL) {
01143
01144 msk_typ_sz = GET_ELEMENT_SZ_FROM_DESC(mask);
01145 mask_b = (char *) GET_ADDRESS_FROM_DESC(mask) + OFFSET_TO_TF_BYTE(msk_typ_sz) ;
01146
01147 if (GET_RANK_FROM_DESC(mask) == 0) {
01148 if (*mask_b) {
01149 mask = NULL;
01150 } else {
01151 src_size = 0;
01152 for (j = 0 ; j <= src_rank ; j ++) {
01153 msk_stride[j] = 0 ;
01154 msk_offset[j] = 0 ;
01155 }
01156 }
01157
01158 } else {
01159
01160 get_offset_and_stride(mask, src_extent, msk_stride, msk_offset, ddim);
01161 }
01162 }
01163
01164 accum = initv ;
01165
01166 if (src_size == 0 ) {
01167 for (i = 1 ; i <= src_rank ; i ++ )
01168 if (src_extent[i] == 0)
01169 return ;
01170 }
01171 array_p = array_b ;
01172 result_p = result_b ;
01173 if (mask == NULL) {
01174
01175 a_size = src_extent[0] ;
01176 a_stride = src_stride[0] ;
01177
01178 while (counter[src_rank] < src_extent[src_rank] ) {
01179
01180 size_t count = 0 ;
01181
01182 for ( i = 0 ; i < a_size ; i ++ ) {
01183 if (*(r8 *) array_p < accum ) {
01184 accum = *(r8 *) array_p ;
01185 newaddr = array_p;
01186 count ++ ;
01187 }
01188 array_p += a_stride ;
01189 if (dim !=NULL) {
01190 *(r8 *) result_p = count ;
01191 accum = initv ;
01192 }
01193 }
01194 counter[0] = a_size ;
01195 j = 0 ;
01196 while ((counter[j] == src_extent[j]) && (j < src_rank)) {
01197 array_p += src_offset[j] ;
01198 result_p += res_offset[j] ;
01199 counter[j+1]++ ;
01200 counter[j] = 0 ;
01201 j ++ ;
01202 }
01203 }
01204 if (dim == NULL)
01205 update_resloc(result,src_rank,src_stride,newaddr,array_b) ;
01206
01207 } else {
01208
01209 a_size = src_extent[0] ;
01210 a_stride = src_stride[0] ;
01211 m_stride = msk_stride[0] ;
01212 mask_p = mask_b ;
01213
01214 while (counter[src_rank] < src_extent[src_rank] ) {
01215
01216 size_t count = 0 ;
01217
01218 for ( i = 0 ; i < a_size ; i ++ ) {
01219 if (*mask_p) {
01220 if (*(r8 *) array_p < accum ) {
01221 accum = *(r8 *) array_p ;
01222 newaddr = array_p;
01223 count ++ ;
01224 }
01225 }
01226 array_p += a_stride ;
01227 mask_p += m_stride ;
01228 if (dim !=NULL) {
01229 *(r8 *) result_p = count ;
01230 accum = initv ;
01231 }
01232 }
01233 counter[0] = a_size ;
01234 j = 0 ;
01235 while ((counter[j] == src_extent[j]) && (j < src_rank)) {
01236 array_p += src_offset[j] ;
01237 mask_p += msk_offset[j] ;
01238 result_p += res_offset[j] ;
01239 counter[j+1]++ ;
01240 counter[j] = 0 ;
01241 j ++ ;
01242 }
01243 }
01244 if (dim == NULL)
01245 update_resloc(result,src_rank,src_stride,newaddr,array_b) ;
01246
01247 }
01248 }
01249 void
01250 _MINLOC__D(
01251 DopeVectorType *result,
01252 DopeVectorType *array,
01253 DopeVectorType *dim,
01254 DopeVectorType *mask)
01255 {
01256 char * result_p, * result_b ;
01257 char * array_p, * array_b ;
01258 char * dim_p, * dim_b ;
01259 char * mask_p, * mask_b ;
01260
01261 size_t src_extent [MAX_NARY_DIMS] ;
01262 size_t counter [MAX_NARY_DIMS] ;
01263 size_t src_offset [MAX_NARY_DIMS] ;
01264 size_t src_stride [MAX_NARY_DIMS] ;
01265 size_t src_size ;
01266
01267 size_t res_stride [MAX_NARY_DIMS] ;
01268 size_t res_offset [MAX_NARY_DIMS] ;
01269
01270 size_t msk_stride [MAX_NARY_DIMS] ;
01271 size_t msk_offset [MAX_NARY_DIMS] ;
01272
01273 int32_t ddim ;
01274 uint32_t src_rank ;
01275 uint32_t res_rank ;
01276
01277 size_t j,k,i ;
01278 size_t msk_typ_sz;
01279
01280 r16 accum ;
01281 r16 const initv = HUGE_REAL16_F90 ;
01282 size_t a_size,a_stride;
01283 size_t m_stride ;
01284
01285 r16 temp,new ;
01286
01287 char *newaddr ;
01288 size_t offs;
01289 size_t lexts[2];
01290
01291 if (mask == NULL) {
01292 if (dim != NULL) {
01293 if (GET_DV_LOGICAL_FROM_DESC(dim)) {
01294 mask = (DopeVectorType *) dim ;
01295 dim = NULL;
01296 }
01297 }
01298 }
01299
01300 if (dim != NULL) {
01301 ddim = read_dim(dim);
01302 } else
01303 ddim = 0 ;
01304
01305 array_b = (char *) GET_ADDRESS_FROM_DESC(array) ;
01306 src_rank = GET_RANK_FROM_DESC(array) - 1;
01307
01308 src_size = read_source_desc(array, src_extent, src_stride, src_offset, ddim);
01309
01310 for (i = 0 ; i <= src_rank ; i ++)
01311 counter[i] = 0 ;
01312
01313 if ((ddim > src_rank ) || (ddim < 0))
01314 ERROR(_LELVL_ABORT,FESCIDIM);
01315
01316 res_rank = GET_RANK_FROM_DESC(result);
01317
01318 if (!GET_ASSOCIATED_FROM_DESC(result)) {
01319 if (dim == NULL) {
01320 lexts[0] = 0;
01321 lexts[1] = src_rank + 1 ;
01322 alloc_res(result,lexts);
01323 } else
01324 alloc_res(result,src_extent);
01325 }
01326
01327 res_stride[0] = 0;
01328 for (j = 0 ; j <= src_rank; j ++ ) res_offset[j] = 0 ;
01329 for (j = 0 ; j < res_rank ; j ++ ) {
01330 res_stride[j] = GET_STRIDE_FROM_DESC(result,j) ;
01331 }
01332
01333 if (dim != NULL)
01334 res_offset[0] = res_stride[0] ;
01335 for ( j = 1 ; j < res_rank ; j ++ )
01336 res_offset[j] = res_stride[j] - (res_stride[j-1]*(src_extent[j])) ;
01337
01338 result_b = GET_ADDRESS_FROM_DESC(result);
01339
01340 if (mask != NULL) {
01341
01342 msk_typ_sz = GET_ELEMENT_SZ_FROM_DESC(mask);
01343 mask_b = (char *) GET_ADDRESS_FROM_DESC(mask) + OFFSET_TO_TF_BYTE(msk_typ_sz) ;
01344
01345 if (GET_RANK_FROM_DESC(mask) == 0) {
01346 if (*mask_b) {
01347 mask = NULL;
01348 } else {
01349 src_size = 0;
01350 for (j = 0 ; j <= src_rank ; j ++) {
01351 msk_stride[j] = 0 ;
01352 msk_offset[j] = 0 ;
01353 }
01354 }
01355
01356 } else {
01357
01358 get_offset_and_stride(mask, src_extent, msk_stride, msk_offset, ddim);
01359 }
01360 }
01361
01362 accum = initv ;
01363
01364 if (src_size == 0 ) {
01365 for (i = 1 ; i <= src_rank ; i ++ )
01366 if (src_extent[i] == 0)
01367 return ;
01368 }
01369 array_p = array_b ;
01370 result_p = result_b ;
01371 if (mask == NULL) {
01372
01373 a_size = src_extent[0] ;
01374 a_stride = src_stride[0] ;
01375
01376 while (counter[src_rank] < src_extent[src_rank] ) {
01377
01378 size_t count = 0 ;
01379
01380 for ( i = 0 ; i < a_size ; i ++ ) {
01381 if (*(r16 *) array_p < accum ) {
01382 accum = *(r16 *) array_p ;
01383 newaddr = array_p;
01384 count ++ ;
01385 }
01386 array_p += a_stride ;
01387 if (dim !=NULL) {
01388 *(r16 *) result_p = count ;
01389 accum = initv ;
01390 }
01391 }
01392 counter[0] = a_size ;
01393 j = 0 ;
01394 while ((counter[j] == src_extent[j]) && (j < src_rank)) {
01395 array_p += src_offset[j] ;
01396 result_p += res_offset[j] ;
01397 counter[j+1]++ ;
01398 counter[j] = 0 ;
01399 j ++ ;
01400 }
01401 }
01402 if (dim == NULL)
01403 update_resloc(result,src_rank,src_stride,newaddr,array_b) ;
01404
01405 } else {
01406
01407 a_size = src_extent[0] ;
01408 a_stride = src_stride[0] ;
01409 m_stride = msk_stride[0] ;
01410 mask_p = mask_b ;
01411
01412 while (counter[src_rank] < src_extent[src_rank] ) {
01413
01414 size_t count = 0 ;
01415
01416 for ( i = 0 ; i < a_size ; i ++ ) {
01417 if (*mask_p) {
01418 if (*(r16 *) array_p < accum ) {
01419 accum = *(r16 *) array_p ;
01420 newaddr = array_p;
01421 count ++ ;
01422 }
01423 }
01424 array_p += a_stride ;
01425 mask_p += m_stride ;
01426 if (dim !=NULL) {
01427 *(r16 *) result_p = count ;
01428 accum = initv ;
01429 }
01430 }
01431 counter[0] = a_size ;
01432 j = 0 ;
01433 while ((counter[j] == src_extent[j]) && (j < src_rank)) {
01434 array_p += src_offset[j] ;
01435 mask_p += msk_offset[j] ;
01436 result_p += res_offset[j] ;
01437 counter[j+1]++ ;
01438 counter[j] = 0 ;
01439 j ++ ;
01440 }
01441 }
01442 if (dim == NULL)
01443 update_resloc(result,src_rank,src_stride,newaddr,array_b) ;
01444
01445 }
01446 }
01447 static void
01448 alloc_res(DopeVectorType * result,
01449 size_t src_extent[MAX_NARY_DIMS])
01450 {
01451 size_t tot_ext ;
01452 size_t str_sz ;
01453 size_t nbytes ;
01454 size_t esz ;
01455 int32_t res_rank ;
01456 char *p = NULL ;
01457 int32_t i ;
01458
01459 SET_ADDRESS_IN_DESC(result,NULL);
01460 SET_ORIG_BS_IN_DESC(result,NULL) ;
01461 SET_ORIG_SZ_IN_DESC(result,0) ;
01462
01463 res_rank = GET_RANK_FROM_DESC(result);
01464 tot_ext = 1 ;
01465 esz = GET_ALEN_FROM_DESC(result) >> 3 ;
01466 nbytes = esz ;
01467 str_sz = MK_STRIDE(FALSE,esz);
01468
01469 for ( i = 0 ; i < res_rank ; i ++) {
01470 SET_LBOUND_IN_DESC(result,i,1);
01471 SET_EXTENT_IN_DESC(result,i,src_extent[i+1]);
01472 SET_STRMULT_IN_DESC(result,i,tot_ext * str_sz );
01473 tot_ext *= src_extent[i+1] ;
01474 }
01475 nbytes *= tot_ext;
01476 if (nbytes > 0 ) {
01477 p = (void *) malloc (nbytes);
01478 if (p == NULL)
01479 ERROR(_LELVL_ABORT, FENOMEMY);
01480
01481 SET_ADDRESS_IN_DESC(result,p);
01482 }
01483 SET_ASSOCIATED_IN_DESC(result);
01484 SET_CONTIG_IN_DESC(result);
01485 SET_ORIG_BS_IN_DESC(result,p) ;
01486 SET_ORIG_SZ_IN_DESC(result,nbytes * 8) ;
01487 }
01488
01489 static int32_t
01490 read_dim(DopeVectorType * dim)
01491 {
01492 int32_t ddim ;
01493 char * dim_p ;
01494
01495 dim_p = (char *) GET_ADDRESS_FROM_DESC(dim) ;
01496
01497 switch (GET_ELEMENT_SZ_FROM_DESC(dim)) {
01498 case sizeof(int8_t):
01499 ddim = * (int8_t *) dim_p ;
01500 break;
01501
01502 case sizeof(int16_t):
01503 ddim = * (int16_t *) dim_p ;
01504 break;
01505
01506 case sizeof(int32_t):
01507 ddim = * (int32_t *) dim_p ;
01508 break;
01509
01510 case sizeof(int64_t):
01511 ddim = * (int64_t *) dim_p ;
01512 break;
01513 }
01514
01515 return (ddim - 1) ;
01516 }
01517
01518 static size_t
01519 read_source_desc(DopeVectorType * array,
01520 size_t src_extent[MAX_NARY_DIMS],
01521 size_t src_stride[MAX_NARY_DIMS],
01522 size_t src_offset[MAX_NARY_DIMS],
01523 int32_t ddim)
01524 {
01525 int32_t src_rank ,k,j ;
01526 size_t src_size ;
01527
01528 src_extent[0] = GET_EXTENT_FROM_DESC(array,ddim) ;
01529 src_rank = GET_RANK_FROM_DESC(array);
01530
01531 src_size = src_extent[0];
01532
01533 for ( k = 1, j = 0 ; j < src_rank ; j ++ ) {
01534 if (j != ddim ) {
01535 src_extent[k] = GET_EXTENT_FROM_DESC(array,j) ;
01536 src_size *= src_extent[k];
01537 k++ ;
01538 }
01539 }
01540 get_offset_and_stride(array, src_extent, src_stride, src_offset, ddim);
01541
01542 return src_size;
01543 }
01544
01545 static void
01546 get_offset_and_stride(DopeVectorType * array,
01547 size_t src_extent[MAX_NARY_DIMS],
01548 size_t src_stride[MAX_NARY_DIMS],
01549 size_t src_offset[MAX_NARY_DIMS],
01550 int32_t ddim)
01551 {
01552
01553 int32_t src_rank ,k,j ;
01554
01555 src_stride[0] = GET_STRIDE_FROM_DESC(array,ddim) ;
01556 src_offset[0] = 0;
01557 src_rank = GET_RANK_FROM_DESC(array);
01558
01559 for ( k = 1, j = 0 ; j < src_rank ; j ++ ) {
01560 if (j != ddim ) {
01561 src_stride[k] = GET_STRIDE_FROM_DESC(array,j) ;
01562 src_offset[k-1] = src_stride[k] - (src_stride [k-1] * (src_extent[k-1])) ;
01563 k++ ;
01564 }
01565 }
01566 }
01567 static void
01568 update_resloc(DopeVectorType * result,int32_t src_rank, size_t src_stride[MAX_NARY_DIMS],char* newaddr,char* base)
01569 {
01570 char * result_b ;
01571 size_t stride ;
01572 int32_t i ;
01573 size_t offs;
01574
01575 result_b = (char *) GET_ADDRESS_FROM_DESC(result) ;
01576 stride = GET_STRIDE_FROM_DESC(result,0) ;
01577 offs = newaddr - base ;
01578
01579 switch (GET_ELEMENT_SZ_FROM_DESC(result)) {
01580 case sizeof(int8_t):
01581 for (i = 0 ; i <= src_rank ; i++) {
01582 if(newaddr == 0)
01583 * (int8_t *) (result_b + (stride* (src_rank-i))) = 0 ;
01584 else {
01585 * (int8_t *) (result_b + (stride* (src_rank-i))) = (offs/src_stride[src_rank-i]) + 1 ;
01586 offs = offs%src_stride[src_rank-i] ;
01587 }
01588 }
01589 break;
01590
01591 case sizeof(int16_t):
01592 for (i = 0 ; i <= src_rank ; i++) {
01593 if(newaddr == 0)
01594 * (int16_t *) (result_b + (stride* (src_rank-i))) = 0 ;
01595 else {
01596 * (int16_t *) (result_b + (stride * (src_rank-i))) = (offs/src_stride[src_rank-i]) + 1 ;
01597 offs = offs%src_stride[src_rank-i] ;
01598 }
01599 }
01600 break;
01601
01602 case sizeof(int32_t):
01603 for (i = 0 ; i <= src_rank ; i++) {
01604 if(newaddr == 0)
01605 * (int32_t *) (result_b + (stride* (src_rank-i))) = 0 ;
01606 else {
01607 * (int32_t *) (result_b + (stride * (src_rank-i))) = (offs/src_stride[src_rank-i]) + 1 ;
01608 offs = offs%src_stride[src_rank-i] ;
01609 }
01610 }
01611 break;
01612
01613 case sizeof(int64_t):
01614 for (i = 0 ; i <= src_rank ; i++) {
01615 if(newaddr == 0)
01616 * (int64_t *) (result_b + (stride* (src_rank-i))) = 0 ;
01617 else {
01618 * (int64_t *) (result_b + (stride * (src_rank-i))) = (offs/src_stride[src_rank-i]) + 1 ;
01619 offs = offs%src_stride[src_rank-i] ;
01620 }
01621 }
01622 break;
01623 }
01624 }
