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 void alloc_res(DopeVectorType * result,
00054 size_t src_extent[MAX_NARY_DIMS]);
00055
00056 void
00057 _COUNT_1(
00058 DopeVectorType *result,
00059 DopeVectorType *array,
00060 i4 *dim)
00061 {
00062 char * result_p, * result_b ;
00063 char * array_p, * array_b ;
00064
00065 size_t src_extent [MAX_NARY_DIMS] ;
00066 size_t counter [MAX_NARY_DIMS] ;
00067 size_t src_offset [MAX_NARY_DIMS] ;
00068 size_t src_stride [MAX_NARY_DIMS] ;
00069 size_t src_size ;
00070
00071 size_t res_stride [MAX_NARY_DIMS] ;
00072 size_t res_offset [MAX_NARY_DIMS] ;
00073
00074 int32_t ddim ;
00075 uint32_t src_rank ;
00076 uint32_t res_rank ;
00077
00078 size_t j,k,i ;
00079 size_t res_sz ;
00080 int64_t count ;
00081
00082 i1 accum ;
00083 i1 const initv = 0 ;
00084 size_t a_size,a_stride;
00085
00086 i1 temp,new ;
00087
00088 if (dim != NULL) {
00089 ddim = (* dim) - 1 ;
00090 } else
00091 ddim = 0 ;
00092
00093 array_b = (char *) GET_ADDRESS_FROM_DESC(array) ;
00094 src_rank = GET_RANK_FROM_DESC(array) - 1;
00095
00096 src_size = read_source_desc(array, src_extent, src_stride, src_offset, ddim);
00097
00098 for (i = 0 ; i <= src_rank ; i ++)
00099 counter[i] = 0 ;
00100
00101 if ((ddim > src_rank ) || (ddim < 0))
00102 ERROR(_LELVL_ABORT,FESCIDIM);
00103
00104 res_rank = GET_RANK_FROM_DESC(result);
00105
00106 if (!GET_ASSOCIATED_FROM_DESC(result)) {
00107 alloc_res(result,src_extent);
00108 }
00109
00110 res_stride[0] = 0;
00111 for (j = 0 ; j <= src_rank; j ++ ) res_offset[j] = 0 ;
00112 for (j = 0 ; j < res_rank ; j ++ ) {
00113 res_stride[j] = GET_STRIDE_FROM_DESC(result,j) ;
00114 }
00115
00116 res_offset[0] = res_stride[0] ;
00117 for ( j = 1 ; j < res_rank ; j ++ )
00118 res_offset[j] = res_stride[j] - (res_stride[j-1]*(src_extent[j])) ;
00119
00120 result_b = GET_ADDRESS_FROM_DESC(result);
00121 res_sz = GET_ELEMENT_SZ_FROM_DESC(result);
00122
00123 accum = initv ;
00124 count = 0;
00125
00126 if (src_size == 0 ) {
00127 for (i = 1 ; i <= src_rank ; i ++ )
00128 if (src_extent[i] == 0)
00129 return ;
00130 *(i4 *)result_b = accum;
00131 }
00132 array_p = array_b ;
00133 result_p = result_b ;
00134
00135 a_size = src_extent[0] ;
00136 a_stride = src_stride[0] ;
00137
00138 while (counter[src_rank] < src_extent[src_rank] ) {
00139
00140 if(res_rank != 0) accum = initv ;
00141 if (res_rank != 0) count = 0 ;
00142
00143 for ( i = 0 ; i < a_size ; i ++ ) {
00144 if ( *(i1 *) array_p) count ++ ;
00145 array_p += a_stride ;
00146 }
00147
00148 switch (res_sz) {
00149 case sizeof(i1):
00150 *(i1 *) result_p = count ;
00151 break;
00152
00153 case sizeof(i2):
00154 *(i2 *) result_p = count ;
00155 break;
00156
00157 case sizeof(i4):
00158 *(i4 *) result_p = count ;
00159 break;
00160
00161 case sizeof(i8):
00162 *(i8 *) result_p = count ;
00163 break;
00164 }
00165
00166 counter[0] = a_size ;
00167 j = 0 ;
00168 while ((counter[j] == src_extent[j]) && (j < src_rank)) {
00169 array_p += src_offset[j] ;
00170 result_p += res_offset[j] ;
00171 counter[j+1]++ ;
00172 counter[j] = 0 ;
00173 j ++ ;
00174 }
00175 }
00176 }
00177 void
00178 _COUNT_2(
00179 DopeVectorType *result,
00180 DopeVectorType *array,
00181 i4 *dim)
00182 {
00183 char * result_p, * result_b ;
00184 char * array_p, * array_b ;
00185
00186 size_t src_extent [MAX_NARY_DIMS] ;
00187 size_t counter [MAX_NARY_DIMS] ;
00188 size_t src_offset [MAX_NARY_DIMS] ;
00189 size_t src_stride [MAX_NARY_DIMS] ;
00190 size_t src_size ;
00191
00192 size_t res_stride [MAX_NARY_DIMS] ;
00193 size_t res_offset [MAX_NARY_DIMS] ;
00194
00195 int32_t ddim ;
00196 uint32_t src_rank ;
00197 uint32_t res_rank ;
00198
00199 size_t j,k,i ;
00200 size_t res_sz ;
00201 int64_t count ;
00202
00203 i2 accum ;
00204 i2 const initv = 0 ;
00205 size_t a_size,a_stride;
00206
00207 i2 temp,new ;
00208
00209 if (dim != NULL) {
00210 ddim = (* dim) - 1 ;
00211 } else
00212 ddim = 0 ;
00213
00214 array_b = (char *) GET_ADDRESS_FROM_DESC(array) ;
00215 src_rank = GET_RANK_FROM_DESC(array) - 1;
00216
00217 src_size = read_source_desc(array, src_extent, src_stride, src_offset, ddim);
00218
00219 for (i = 0 ; i <= src_rank ; i ++)
00220 counter[i] = 0 ;
00221
00222 if ((ddim > src_rank ) || (ddim < 0))
00223 ERROR(_LELVL_ABORT,FESCIDIM);
00224
00225 res_rank = GET_RANK_FROM_DESC(result);
00226
00227 if (!GET_ASSOCIATED_FROM_DESC(result)) {
00228 alloc_res(result,src_extent);
00229 }
00230
00231 res_stride[0] = 0;
00232 for (j = 0 ; j <= src_rank; j ++ ) res_offset[j] = 0 ;
00233 for (j = 0 ; j < res_rank ; j ++ ) {
00234 res_stride[j] = GET_STRIDE_FROM_DESC(result,j) ;
00235 }
00236
00237 res_offset[0] = res_stride[0] ;
00238 for ( j = 1 ; j < res_rank ; j ++ )
00239 res_offset[j] = res_stride[j] - (res_stride[j-1]*(src_extent[j])) ;
00240
00241 result_b = GET_ADDRESS_FROM_DESC(result);
00242 res_sz = GET_ELEMENT_SZ_FROM_DESC(result);
00243
00244 accum = initv ;
00245 count = 0;
00246
00247 if (src_size == 0 ) {
00248 for (i = 1 ; i <= src_rank ; i ++ )
00249 if (src_extent[i] == 0)
00250 return ;
00251 *(i4 *)result_b = accum;
00252 }
00253 array_p = array_b ;
00254 result_p = result_b ;
00255
00256 a_size = src_extent[0] ;
00257 a_stride = src_stride[0] ;
00258
00259 while (counter[src_rank] < src_extent[src_rank] ) {
00260
00261 if(res_rank != 0) accum = initv ;
00262 if (res_rank != 0) count = 0 ;
00263
00264 for ( i = 0 ; i < a_size ; i ++ ) {
00265 if ( *(i2 *) array_p) count ++ ;
00266 array_p += a_stride ;
00267 }
00268
00269 switch (res_sz) {
00270 case sizeof(i1):
00271 *(i1 *) result_p = count ;
00272 break;
00273
00274 case sizeof(i2):
00275 *(i2 *) result_p = count ;
00276 break;
00277
00278 case sizeof(i4):
00279 *(i4 *) result_p = count ;
00280 break;
00281
00282 case sizeof(i8):
00283 *(i8 *) result_p = count ;
00284 break;
00285 }
00286
00287 counter[0] = a_size ;
00288 j = 0 ;
00289 while ((counter[j] == src_extent[j]) && (j < src_rank)) {
00290 array_p += src_offset[j] ;
00291 result_p += res_offset[j] ;
00292 counter[j+1]++ ;
00293 counter[j] = 0 ;
00294 j ++ ;
00295 }
00296 }
00297 }
00298 void
00299 _COUNT_4(
00300 DopeVectorType *result,
00301 DopeVectorType *array,
00302 i4 *dim)
00303 {
00304 char * result_p, * result_b ;
00305 char * array_p, * array_b ;
00306
00307 size_t src_extent [MAX_NARY_DIMS] ;
00308 size_t counter [MAX_NARY_DIMS] ;
00309 size_t src_offset [MAX_NARY_DIMS] ;
00310 size_t src_stride [MAX_NARY_DIMS] ;
00311 size_t src_size ;
00312
00313 size_t res_stride [MAX_NARY_DIMS] ;
00314 size_t res_offset [MAX_NARY_DIMS] ;
00315
00316 int32_t ddim ;
00317 uint32_t src_rank ;
00318 uint32_t res_rank ;
00319
00320 size_t j,k,i ;
00321 size_t res_sz ;
00322 int64_t count ;
00323
00324 i4 accum ;
00325 i4 const initv = 0 ;
00326 size_t a_size,a_stride;
00327
00328 i4 temp,new ;
00329
00330 if (dim != NULL) {
00331 ddim = (* dim) - 1 ;
00332 } else
00333 ddim = 0 ;
00334
00335 array_b = (char *) GET_ADDRESS_FROM_DESC(array) ;
00336 src_rank = GET_RANK_FROM_DESC(array) - 1;
00337
00338 src_size = read_source_desc(array, src_extent, src_stride, src_offset, ddim);
00339
00340 for (i = 0 ; i <= src_rank ; i ++)
00341 counter[i] = 0 ;
00342
00343 if ((ddim > src_rank ) || (ddim < 0))
00344 ERROR(_LELVL_ABORT,FESCIDIM);
00345
00346 res_rank = GET_RANK_FROM_DESC(result);
00347
00348 if (!GET_ASSOCIATED_FROM_DESC(result)) {
00349 alloc_res(result,src_extent);
00350 }
00351
00352 res_stride[0] = 0;
00353 for (j = 0 ; j <= src_rank; j ++ ) res_offset[j] = 0 ;
00354 for (j = 0 ; j < res_rank ; j ++ ) {
00355 res_stride[j] = GET_STRIDE_FROM_DESC(result,j) ;
00356 }
00357
00358 res_offset[0] = res_stride[0] ;
00359 for ( j = 1 ; j < res_rank ; j ++ )
00360 res_offset[j] = res_stride[j] - (res_stride[j-1]*(src_extent[j])) ;
00361
00362 result_b = GET_ADDRESS_FROM_DESC(result);
00363 res_sz = GET_ELEMENT_SZ_FROM_DESC(result);
00364
00365 accum = initv ;
00366 count = 0;
00367
00368 if (src_size == 0 ) {
00369 for (i = 1 ; i <= src_rank ; i ++ )
00370 if (src_extent[i] == 0)
00371 return ;
00372 *(i4 *)result_b = accum;
00373 }
00374 array_p = array_b ;
00375 result_p = result_b ;
00376
00377 a_size = src_extent[0] ;
00378 a_stride = src_stride[0] ;
00379
00380 while (counter[src_rank] < src_extent[src_rank] ) {
00381
00382 if(res_rank != 0) accum = initv ;
00383 if (res_rank != 0) count = 0 ;
00384
00385 for ( i = 0 ; i < a_size ; i ++ ) {
00386 if ( *(i4 *) array_p) count ++ ;
00387 array_p += a_stride ;
00388 }
00389
00390 switch (res_sz) {
00391 case sizeof(i1):
00392 *(i1 *) result_p = count ;
00393 break;
00394
00395 case sizeof(i2):
00396 *(i2 *) result_p = count ;
00397 break;
00398
00399 case sizeof(i4):
00400 *(i4 *) result_p = count ;
00401 break;
00402
00403 case sizeof(i8):
00404 *(i8 *) result_p = count ;
00405 break;
00406 }
00407
00408 counter[0] = a_size ;
00409 j = 0 ;
00410 while ((counter[j] == src_extent[j]) && (j < src_rank)) {
00411 array_p += src_offset[j] ;
00412 result_p += res_offset[j] ;
00413 counter[j+1]++ ;
00414 counter[j] = 0 ;
00415 j ++ ;
00416 }
00417 }
00418 }
00419 void
00420 _COUNT(
00421 DopeVectorType *result,
00422 DopeVectorType *array,
00423 i4 *dim)
00424 {
00425 char * result_p, * result_b ;
00426 char * array_p, * array_b ;
00427
00428 size_t src_extent [MAX_NARY_DIMS] ;
00429 size_t counter [MAX_NARY_DIMS] ;
00430 size_t src_offset [MAX_NARY_DIMS] ;
00431 size_t src_stride [MAX_NARY_DIMS] ;
00432 size_t src_size ;
00433
00434 size_t res_stride [MAX_NARY_DIMS] ;
00435 size_t res_offset [MAX_NARY_DIMS] ;
00436
00437 int32_t ddim ;
00438 uint32_t src_rank ;
00439 uint32_t res_rank ;
00440
00441 size_t j,k,i ;
00442 size_t res_sz ;
00443 int64_t count ;
00444
00445 i8 accum ;
00446 i8 const initv = 0 ;
00447 size_t a_size,a_stride;
00448
00449 i8 temp,new ;
00450
00451 if (dim != NULL) {
00452 ddim = (* dim) - 1 ;
00453 } else
00454 ddim = 0 ;
00455
00456 array_b = (char *) GET_ADDRESS_FROM_DESC(array) ;
00457 src_rank = GET_RANK_FROM_DESC(array) - 1;
00458
00459 src_size = read_source_desc(array, src_extent, src_stride, src_offset, ddim);
00460
00461 for (i = 0 ; i <= src_rank ; i ++)
00462 counter[i] = 0 ;
00463
00464 if ((ddim > src_rank ) || (ddim < 0))
00465 ERROR(_LELVL_ABORT,FESCIDIM);
00466
00467 res_rank = GET_RANK_FROM_DESC(result);
00468
00469 if (!GET_ASSOCIATED_FROM_DESC(result)) {
00470 alloc_res(result,src_extent);
00471 }
00472
00473 res_stride[0] = 0;
00474 for (j = 0 ; j <= src_rank; j ++ ) res_offset[j] = 0 ;
00475 for (j = 0 ; j < res_rank ; j ++ ) {
00476 res_stride[j] = GET_STRIDE_FROM_DESC(result,j) ;
00477 }
00478
00479 res_offset[0] = res_stride[0] ;
00480 for ( j = 1 ; j < res_rank ; j ++ )
00481 res_offset[j] = res_stride[j] - (res_stride[j-1]*(src_extent[j])) ;
00482
00483 result_b = GET_ADDRESS_FROM_DESC(result);
00484 res_sz = GET_ELEMENT_SZ_FROM_DESC(result);
00485
00486 accum = initv ;
00487 count = 0;
00488
00489 if (src_size == 0 ) {
00490 for (i = 1 ; i <= src_rank ; i ++ )
00491 if (src_extent[i] == 0)
00492 return ;
00493 *(i4 *)result_b = accum;
00494 }
00495 array_p = array_b ;
00496 result_p = result_b ;
00497
00498 a_size = src_extent[0] ;
00499 a_stride = src_stride[0] ;
00500
00501 while (counter[src_rank] < src_extent[src_rank] ) {
00502
00503 if(res_rank != 0) accum = initv ;
00504 if (res_rank != 0) count = 0 ;
00505
00506 for ( i = 0 ; i < a_size ; i ++ ) {
00507 if ( *(i8 *) array_p) count ++ ;
00508 array_p += a_stride ;
00509 }
00510
00511 switch (res_sz) {
00512 case sizeof(i1):
00513 *(i1 *) result_p = count ;
00514 break;
00515
00516 case sizeof(i2):
00517 *(i2 *) result_p = count ;
00518 break;
00519
00520 case sizeof(i4):
00521 *(i4 *) result_p = count ;
00522 break;
00523
00524 case sizeof(i8):
00525 *(i8 *) result_p = count ;
00526 break;
00527 }
00528
00529 counter[0] = a_size ;
00530 j = 0 ;
00531 while ((counter[j] == src_extent[j]) && (j < src_rank)) {
00532 array_p += src_offset[j] ;
00533 result_p += res_offset[j] ;
00534 counter[j+1]++ ;
00535 counter[j] = 0 ;
00536 j ++ ;
00537 }
00538 }
00539 }
00540 static void
00541 alloc_res(DopeVectorType * result,
00542 size_t src_extent[MAX_NARY_DIMS])
00543 {
00544 size_t tot_ext ;
00545 size_t str_sz ;
00546 size_t nbytes ;
00547 size_t esz ;
00548 int32_t res_rank ;
00549 char *p = NULL ;
00550 int32_t i ;
00551
00552 SET_ADDRESS_IN_DESC(result,NULL);
00553 SET_ORIG_BS_IN_DESC(result,NULL) ;
00554 SET_ORIG_SZ_IN_DESC(result,0) ;
00555
00556 res_rank = GET_RANK_FROM_DESC(result);
00557 tot_ext = 1 ;
00558 esz = GET_ALEN_FROM_DESC(result) >> 3 ;
00559 nbytes = esz ;
00560 str_sz = MK_STRIDE(FALSE,esz);
00561
00562 for ( i = 0 ; i < res_rank ; i ++) {
00563 SET_LBOUND_IN_DESC(result,i,1);
00564 SET_EXTENT_IN_DESC(result,i,src_extent[i+1]);
00565 SET_STRMULT_IN_DESC(result,i,tot_ext * str_sz );
00566 tot_ext *= src_extent[i+1] ;
00567 }
00568 nbytes *= tot_ext;
00569 if (nbytes > 0 ) {
00570 p = (void *) malloc (nbytes);
00571 if (p == NULL)
00572 ERROR(_LELVL_ABORT, FENOMEMY);
00573
00574 SET_ADDRESS_IN_DESC(result,p);
00575 }
00576 SET_ASSOCIATED_IN_DESC(result);
00577 SET_CONTIG_IN_DESC(result);
00578 SET_ORIG_BS_IN_DESC(result,p) ;
00579 SET_ORIG_SZ_IN_DESC(result,nbytes * 8) ;
00580 }
00581
00582 static size_t
00583 read_source_desc(DopeVectorType * array,
00584 size_t src_extent[MAX_NARY_DIMS],
00585 size_t src_stride[MAX_NARY_DIMS],
00586 size_t src_offset[MAX_NARY_DIMS],
00587 int32_t ddim)
00588 {
00589 int32_t src_rank ,k,j ;
00590 size_t src_size ;
00591
00592 src_extent[0] = GET_EXTENT_FROM_DESC(array,ddim) ;
00593 src_rank = GET_RANK_FROM_DESC(array);
00594
00595 src_size = src_extent[0];
00596
00597 for ( k = 1, j = 0 ; j < src_rank ; j ++ ) {
00598 if (j != ddim ) {
00599 src_extent[k] = GET_EXTENT_FROM_DESC(array,j) ;
00600 src_size *= src_extent[k];
00601 k++ ;
00602 }
00603 }
00604 get_offset_and_stride(array, src_extent, src_stride, src_offset, ddim);
00605
00606 return src_size;
00607 }
00608
00609 static void
00610 get_offset_and_stride(DopeVectorType * array,
00611 size_t src_extent[MAX_NARY_DIMS],
00612 size_t src_stride[MAX_NARY_DIMS],
00613 size_t src_offset[MAX_NARY_DIMS],
00614 int32_t ddim)
00615 {
00616
00617 int32_t src_rank ,k,j ;
00618
00619 src_stride[0] = GET_STRIDE_FROM_DESC(array,ddim) ;
00620 src_offset[0] = 0;
00621 src_rank = GET_RANK_FROM_DESC(array);
00622
00623 for ( k = 1, j = 0 ; j < src_rank ; j ++ ) {
00624 if (j != ddim ) {
00625 src_stride[k] = GET_STRIDE_FROM_DESC(array,j) ;
00626 src_offset[k-1] = src_stride[k] - (src_stride [k-1] * (src_extent[k-1])) ;
00627 k++ ;
00628 }
00629 }
00630 }