Open64: osprey/libf90/prod0

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