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 void
00041 _TRANSFER(
00042 DopeVectorType *result,
00043 DopeVectorType *array,
00044 DopeVectorType *mold,
00045 i4 *size)
00046 {
00047 char * result_p, * result_b ;
00048 char * array_p, * array_b ;
00049 char * mold_p, * mold_b ;
00050
00051 size_t src_extent [MAX_NARY_DIMS] ;
00052 size_t src_stride [MAX_NARY_DIMS] ;
00053 size_t src_offset [MAX_NARY_DIMS] ;
00054 size_t counter[MAX_NARY_DIMS] ;
00055
00056 size_t res_stride [MAX_NARY_DIMS] ;
00057 size_t res_extent [MAX_NARY_DIMS] ;
00058 size_t res_offset [MAX_NARY_DIMS] ;
00059
00060 int32_t j,ii;
00061 char *rp, *ap ;
00062 int32_t res_rank ;
00063 int32_t src_rank = GET_RANK_FROM_DESC(array) - 1;
00064
00065 size_t typ_sz = GET_ELEMENT_SZ_FROM_DESC(array);
00066
00067 size_t a_size,a_stride,r_stride, i,k ;
00068 int8_t zero_szd_source = FALSE;
00069 int8_t byte_aligned = FALSE;
00070
00071 int32_t ddim ;
00072
00073 size_t num_trues ;
00074 int32_t local_alloc ;
00075 size_t tot_ext ;
00076 size_t str_sz ;
00077
00078 size_t src_size ;
00079
00080 size_t res_sz;
00081 size_t xfer_sz;
00082 size_t tot_sz;
00083
00084 byte_aligned = GET_BYTEALIGNED_FROM_DESC(mold) ;
00085
00086 src_extent[0] = 1;
00087 src_stride[0] = GET_ELEMENT_SZ_FROM_DESC(array);
00088 src_offset[0] = 0 ;
00089 counter[0] = 0 ;
00090 src_size = GET_ELEMENT_SZ_FROM_DESC(array);
00091 tot_ext = 1;
00092
00093 for ( j = 0 ; j <= src_rank ; j ++ ) {
00094 src_extent[j] = GET_EXTENT_FROM_DESC(array,j) ;
00095 src_stride[j] = GET_STRIDE_FROM_DESC(array,j) ;
00096 counter[j] = 0 ;
00097 zero_szd_source = zero_szd_source || (src_extent[j] == 0) ;
00098 src_size *= src_extent[j];
00099 }
00100
00101 for ( j = 1 ; j <= src_rank ; j ++ )
00102 src_offset[j-1] = src_stride[j] - (src_stride [j-1] * (src_extent[j-1])) ;
00103
00104 res_sz = GET_ELEMENT_SZ_FROM_DESC(mold);
00105 res_rank = GET_RANK_FROM_DESC(result);
00106 res_offset[0] = 0 ;
00107 res_stride[0] = res_sz ;
00108
00109 k = 0 ;
00110 if (size) {
00111 if (*size > 0)
00112 tot_ext = * size ;
00113 else {
00114 zero_szd_source = TRUE;
00115 tot_ext = 0 ;
00116 }
00117 tot_sz = tot_ext * res_sz ;
00118
00119 } else {
00120 if (GET_RANK_FROM_DESC(mold) == 0) {
00121 tot_ext = 1 ;
00122 tot_sz = res_sz ;
00123
00124 } else {
00125 tot_ext = GET_EXTENT_FROM_DESC(mold,0);
00126
00127 tot_sz = src_size ;
00128 tot_ext = tot_sz/res_sz ;
00129 if (tot_sz%res_sz)
00130 tot_ext ++ ;
00131 }
00132 }
00133
00134 if (!GET_ASSOCIATED_FROM_DESC(result)) {
00135
00136 size_t nbytes ;
00137 char *p ;
00138
00139 SET_ADDRESS_IN_DESC(result,NULL);
00140 SET_ORIG_BS_IN_DESC(result,NULL) ;
00141 SET_ORIG_SZ_IN_DESC(result,0) ;
00142
00143 p = NULL ;
00144 nbytes = tot_ext * res_sz ;
00145 str_sz = MK_STRIDE(byte_aligned,res_sz);
00146
00147 if (res_rank > 0) {
00148 SET_LBOUND_IN_DESC(result,0,1);
00149 SET_EXTENT_IN_DESC(result,0,tot_ext);
00150 SET_STRMULT_IN_DESC(result,0, str_sz );
00151 }
00152
00153 if (nbytes > 0 ) {
00154 p = (void *) malloc (nbytes);
00155 if (p == NULL)
00156 ERROR(_LELVL_ABORT, FENOMEMY);
00157
00158 SET_ADDRESS_IN_DESC(result,p);
00159 }
00160
00161 SET_CONTIG_IN_DESC(result);
00162 SET_ASSOCIATED_IN_DESC(result);
00163 SET_CONTIG_IN_DESC(result);
00164 if (GET_DV_ASCII_FROM_DESC(result)) {
00165 SET_CHARPTR_IN_DESC(result,p,res_sz << 3);
00166 }
00167 SET_ORIG_BS_IN_DESC(result,p) ;
00168 SET_ORIG_SZ_IN_DESC(result,nbytes * 8 ) ;
00169 }
00170
00171 if (res_rank > 0)
00172 res_stride[0] = GET_STRIDE_FROM_DESC(result,0) ;
00173
00174 if (src_rank < 0) src_rank ++ ;
00175
00176 result_b = GET_ADDRESS_FROM_DESC(result);
00177 array_b = GET_ADDRESS_FROM_DESC(array);
00178
00179 if (zero_szd_source)
00180 return ;
00181
00182 a_size = src_extent[0] ;
00183 a_stride = src_stride[0] ;
00184 r_stride = res_stride[0] ;
00185 array_p = GET_ADDRESS_FROM_DESC(array);
00186 result_p = GET_ADDRESS_FROM_DESC(result);
00187
00188 {
00189 while (counter[src_rank] < src_extent[src_rank] ) {
00190 {
00191 size_t todo_s,todo_r ;
00192 todo_r = res_sz ;
00193
00194 for ( i = 0 ; i < a_size ; i ++ ) {
00195
00196 ap = array_p ;
00197 rp = result_p ;
00198 todo_s = typ_sz ;
00199 while (todo_s != 0) {
00200 xfer_sz = todo_s ;
00201 if (xfer_sz > todo_r) xfer_sz = todo_r ;
00202 for (j = 0 ; j < xfer_sz ; j ++) *rp++ = *ap ++ ;
00203
00204 todo_r -= xfer_sz ;
00205 todo_s -= xfer_sz ;
00206
00207 if (todo_r != 0)
00208 result_p += xfer_sz ;
00209 else {
00210 result_b += r_stride ;
00211 result_p = result_b ;
00212 todo_r = res_sz ;
00213 }
00214 k += xfer_sz ;
00215 if (k >= tot_sz)
00216 return ;
00217 }
00218 array_p += a_stride ;
00219 }
00220 }
00221 counter[0] = a_size ;
00222 j = 0 ;
00223 while ((counter[j] == src_extent[j]) && (j < src_rank)) {
00224 array_p += src_offset[j] ;
00225 counter[j+1]++ ;
00226 counter[j] = 0 ;
00227 j ++ ;
00228 }
00229
00230 }
00231 }
00232 }
