| 3077 | |
| 3078 | |
| 3079 | static inline int |
| 3080 | init_geqrf(GEQRF_PARAMS_t<fortran_doublereal> *params, |
| 3081 | fortran_int m, |
| 3082 | fortran_int n) |
| 3083 | { |
| 3084 | using ftyp = fortran_doublereal; |
| 3085 | npy_uint8 *mem_buff = NULL; |
| 3086 | npy_uint8 *mem_buff2 = NULL; |
| 3087 | npy_uint8 *a, *tau, *work; |
| 3088 | fortran_int min_m_n = fortran_int_min(m, n); |
| 3089 | size_t safe_min_m_n = min_m_n; |
| 3090 | size_t safe_m = m; |
| 3091 | size_t safe_n = n; |
| 3092 | |
| 3093 | size_t a_size = safe_m * safe_n * sizeof(ftyp); |
| 3094 | size_t tau_size = safe_min_m_n * sizeof(ftyp); |
| 3095 | |
| 3096 | fortran_int work_count; |
| 3097 | size_t work_size; |
| 3098 | fortran_int lda = fortran_int_max(1, m); |
| 3099 | |
| 3100 | mem_buff = (npy_uint8 *)malloc(a_size + tau_size); |
| 3101 | |
| 3102 | if (!mem_buff) |
| 3103 | goto error; |
| 3104 | |
| 3105 | a = mem_buff; |
| 3106 | tau = a + a_size; |
| 3107 | memset(tau, 0, tau_size); |
| 3108 | |
| 3109 | |
| 3110 | params->M = m; |
| 3111 | params->N = n; |
| 3112 | params->A = (ftyp*)a; |
| 3113 | params->TAU = (ftyp*)tau; |
| 3114 | params->LDA = lda; |
| 3115 | |
| 3116 | { |
| 3117 | /* compute optimal work size */ |
| 3118 | |
| 3119 | ftyp work_size_query; |
| 3120 | |
| 3121 | params->WORK = &work_size_query; |
| 3122 | params->LWORK = -1; |
| 3123 | |
| 3124 | if (call_geqrf(params) != 0) |
| 3125 | goto error; |
| 3126 | |
| 3127 | work_count = (fortran_int) *(ftyp*) params->WORK; |
| 3128 | |
| 3129 | } |
| 3130 | |
| 3131 | params->LWORK = fortran_int_max(fortran_int_max(1, n), work_count); |
| 3132 | |
| 3133 | work_size = (size_t) params->LWORK * sizeof(ftyp); |
| 3134 | mem_buff2 = (npy_uint8 *)malloc(work_size); |
| 3135 | if (!mem_buff2) |
| 3136 | goto error; |
no test coverage detected