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