1 module qdldl;
2 
3 nothrow @nogc extern(C):
4 
5 import qdldl_types;
6 
7 enum int QDLDL_UNKNOWN = -1;
8 enum int QDLDL_USED = 1;
9 enum int QDLDL_UNUSED = 0;
10 
11 // //DEBUG
12 // #include <stdio.h>
13 // void qdprint_arrayi(const QDLDL_int* data, QDLDL_int n,char* varName){
14 
15 //   QDLDL_int i;
16 //   printf("%s = [",varName);
17 //   for(i=0; i< n; i++){
18 //     printf("%lli,",data[i]);
19 //   }
20 //   printf("]\n");
21 
22 // }
23 
24 // void qdprint_arrayf(const QDLDL_float* data, QDLDL_int n, char* varName){
25 
26 //   QDLDL_int i;
27 //   printf("%s = [",varName);
28 //   for(i=0; i< n; i++){
29 //     printf("%.3g,",data[i]);
30 //   }
31 //   printf("]\n");
32 
33 // }
34 // // END DEBUG
35 
36 /* Compute the elimination tree for a quasidefinite matrix
37    in compressed sparse column form.
38 */
39 
40 QDLDL_int QDLDL_etree(const QDLDL_int  n,
41                       const QDLDL_int* Ap,
42                       const QDLDL_int* Ai,
43                       QDLDL_int* work,
44                       QDLDL_int* Lnz,
45                       QDLDL_int* etree){
46   QDLDL_int sumLnz = 0;
47   QDLDL_int i,j,p;
48 
49 
50   for(i = 0; i < n; i++){
51   // zero out Lnz and work.  Set all etree values to unknown
52     work[i]  = 0;
53     Lnz[i]   = 0;
54     etree[i] = QDLDL_UNKNOWN;
55 
56     //Abort if A doesn't have at least one entry
57     //one entry in every column
58     if(Ap[i] == Ap[i+1]){
59       return -1;
60     }
61 
62   }
63 
64   for(j = 0; j < n; j++){
65     work[j] = j;
66     for(p = Ap[j]; p < Ap[j+1]; p++){
67       i = Ai[p];
68       if(i > j){return -1;} //abort if entries on lower triangle
69       while(work[i] != j){
70         if(etree[i] == QDLDL_UNKNOWN){
71           etree[i] = j;
72         }
73         Lnz[i]++;         //nonzeros in this column
74         work[i] = j;
75         i = etree[i];
76       }
77     }
78   }
79 
80   //compute the total nonzeros in L.  This much
81   //space is required to store Li and Lx
82   for(i = 0; i < n; i++){sumLnz += Lnz[i];}
83 
84   return sumLnz;
85 }
86 
87 
88 
89 QDLDL_int QDLDL_factor(const QDLDL_int    n,
90                   const QDLDL_int*   Ap,
91                   const QDLDL_int*   Ai,
92                   const QDLDL_float* Ax,
93                   QDLDL_int*   Lp,
94                   QDLDL_int*   Li,
95                   QDLDL_float* Lx,
96                   QDLDL_float* D,
97                   QDLDL_float* Dinv,
98                   const QDLDL_int* Lnz,
99                   const QDLDL_int* etree,
100                   QDLDL_bool*  bwork,
101                   QDLDL_int*   iwork,
102                   QDLDL_float* fwork){
103 
104   QDLDL_int i,j,k,nnzY, bidx, cidx, nextIdx, nnzE, tmpIdx;
105   QDLDL_int *yIdx;
106   QDLDL_int *elimBuffer;
107   QDLDL_int *LNextSpaceInCol;
108   QDLDL_float *yVals;
109   QDLDL_float yVals_cidx;
110   QDLDL_bool  *yMarkers;
111   QDLDL_int   positiveValuesInD = 0;
112 
113   //partition working memory into pieces
114   yMarkers        = bwork;
115   yIdx            = iwork;
116   elimBuffer      = iwork + n;
117   LNextSpaceInCol = iwork + n*2;
118   yVals           = fwork;
119 
120 
121   Lp[0] = 0; //first column starts at index zero
122 
123   for(i = 0; i < n; i++){
124 
125     //compute L column indices
126     Lp[i+1] = Lp[i] + Lnz[i];   //cumsum, total at the end
127 
128     // set all Yidx to be 'unused' initially
129     //in each column of L, the next available space
130     //to start is just the first space in the column
131     yMarkers[i]  = QDLDL_UNUSED;
132     yVals[i]     = 0.0;
133     D[i]         = 0.0;
134     LNextSpaceInCol[i] = Lp[i];
135   }
136 
137   // First element of the diagonal D.
138   D[0]     = Ax[0];
139   if(D[0] == 0.0){return -1;}
140   if(D[0]  > 0.0){positiveValuesInD++;}
141   Dinv[0] = 1/D[0];
142 
143   //Start from 1 here. The upper LH corner is trivially 0
144   //in L b/c we are only computing the subdiagonal elements
145   for(k = 1; k < n; k++){
146 
147     //NB : For each k, we compute a solution to
148     //y = L(0:(k-1),0:k-1))\b, where b is the kth
149     //column of A that sits above the diagonal.
150     //The solution y is then the kth row of L,
151     //with an implied '1' at the diagonal entry.
152 
153     //number of nonzeros in this row of L
154     nnzY = 0;  //number of elements in this row
155 
156     //This loop determines where nonzeros
157     //will go in the kth row of L, but doesn't
158     //compute the actual values
159     tmpIdx = Ap[k+1];
160 
161     for(i = Ap[k]; i < tmpIdx; i++){
162 
163       bidx = Ai[i];   // we are working on this element of b
164 
165       //Initialize D[k] as the element of this column
166       //corresponding to the diagonal place.  Don't use
167       //this element as part of the elimination step
168       //that computes the k^th row of L
169       if(bidx == k){
170         D[k] = Ax[i];
171         continue;
172       }
173 
174       yVals[bidx] = Ax[i];   // initialise y(bidx) = b(bidx)
175 
176       // use the forward elimination tree to figure
177       // out which elements must be eliminated after
178       // this element of b
179       nextIdx = bidx;
180 
181       if(yMarkers[nextIdx] == QDLDL_UNUSED){   //this y term not already visited
182 
183         yMarkers[nextIdx] = QDLDL_USED;     //I touched this one
184         elimBuffer[0]     = nextIdx;  // It goes at the start of the current list
185         nnzE              = 1;         //length of unvisited elimination path from here
186 
187         nextIdx = etree[bidx];
188 
189         while(nextIdx != QDLDL_UNKNOWN && nextIdx < k){
190           if(yMarkers[nextIdx] == QDLDL_USED) break;
191 
192           yMarkers[nextIdx] = QDLDL_USED;   //I touched this one
193           elimBuffer[nnzE] = nextIdx; //It goes in the current list
194           nnzE++;                     //the list is one longer than before
195           nextIdx = etree[nextIdx];   //one step further along tree
196 
197         } //end while
198 
199         // now I put the buffered elimination list into
200         // my current ordering in reverse order
201         while(nnzE){
202           yIdx[nnzY++] = elimBuffer[--nnzE];
203         } //end while
204       } //end if
205 
206     } //end for i
207 
208     //This for loop places nonzeros values in the k^th row
209     for(i = (nnzY-1); i >=0; i--){
210 
211       //which column are we working on?
212       cidx = yIdx[i];
213 
214       // loop along the elements in this
215       // column of L and subtract to solve to y
216       tmpIdx = LNextSpaceInCol[cidx];
217       yVals_cidx = yVals[cidx];
218       for(j = Lp[cidx]; j < tmpIdx; j++){
219         yVals[Li[j]] -= Lx[j]*yVals_cidx;
220       }
221 
222       //Now I have the cidx^th element of y = L\b.
223       //so compute the corresponding element of
224       //this row of L and put it into the right place
225       Li[tmpIdx] = k;
226       Lx[tmpIdx] = yVals_cidx *Dinv[cidx];
227 
228       //D[k] -= yVals[cidx]*yVals[cidx]*Dinv[cidx];
229       D[k] -= yVals_cidx*Lx[tmpIdx];
230       LNextSpaceInCol[cidx]++;
231 
232       //reset the yvalues and indices back to zero and QDLDL_UNUSED
233       //once I'm done with them
234       yVals[cidx]     = 0.0;
235       yMarkers[cidx]  = QDLDL_UNUSED;
236 
237     } //end for i
238 
239     //Maintain a count of the positive entries
240     //in D.  If we hit a zero, we can't factor
241     //this matrix, so abort
242     if(D[k] == 0.0){return -1;}
243     if(D[k]  > 0.0){positiveValuesInD++;}
244 
245     //compute the inverse of the diagonal
246     Dinv[k]= 1/D[k];
247 
248   } //end for k
249 
250   return positiveValuesInD;
251 
252 }
253 
254 // Solves (L+I)x = b
255 void QDLDL_Lsolve(const QDLDL_int    n,
256                   const QDLDL_int*   Lp,
257                   const QDLDL_int*   Li,
258                   const QDLDL_float* Lx,
259                   QDLDL_float* x){
260 
261 QDLDL_int i,j;
262   for(i = 0; i < n; i++){
263       for(j = Lp[i]; j < Lp[i+1]; j++){
264           x[Li[j]] -= Lx[j]*x[i];
265       }
266   }
267 }
268 
269 // Solves (L+I)'x = b
270 void QDLDL_Ltsolve(const QDLDL_int    n,
271                    const QDLDL_int*   Lp,
272                    const QDLDL_int*   Li,
273                    const QDLDL_float* Lx,
274                    QDLDL_float* x){
275 
276 QDLDL_int i,j;
277   for(i = n-1; i>=0; i--){
278       for(j = Lp[i]; j < Lp[i+1]; j++){
279           x[i] -= Lx[j]*x[Li[j]];
280       }
281   }
282 }
283 
284 // Solves Ax = b where A has given LDL factors
285 void QDLDL_solve(const QDLDL_int       n,
286                     const QDLDL_int*   Lp,
287                     const QDLDL_int*   Li,
288                     const QDLDL_float* Lx,
289                     const QDLDL_float* Dinv,
290                     QDLDL_float* x){
291 
292 QDLDL_int i;
293 
294 QDLDL_Lsolve(n,Lp,Li,Lx,x);
295 for(i = 0; i < n; i++) x[i] *= Dinv[i];
296 QDLDL_Ltsolve(n,Lp,Li,Lx,x);
297 
298 }