"Fossies" - the Fresh Open Source Software Archive

Member "laspack/qmatrix.c" (8 Aug 1995, 19972 Bytes) of package /linux/privat/old/laspack.tgz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) C and C++ source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 /****************************************************************************/
    2 /*                                qmatrix.c                                 */
    3 /****************************************************************************/
    4 /*                                                                          */
    5 /* type QMATRIX                                                             */
    6 /*                                                                          */
    7 /* Copyright (C) 1992-1995 Tomas Skalicky. All rights reserved.             */
    8 /*                                                                          */
    9 /****************************************************************************/
   10 /*                                                                          */
   11 /*        ANY USE OF THIS CODE CONSTITUTES ACCEPTANCE OF THE TERMS          */
   12 /*              OF THE COPYRIGHT NOTICE (SEE FILE COPYRGHT.H)               */
   13 /*                                                                          */
   14 /****************************************************************************/
   15 
   16 #include <stddef.h>
   17 #include <stdlib.h>
   18 #include <math.h>
   19 #include <string.h>
   20 
   21 #include "laspack/qmatrix.h"
   22 #include "laspack/errhandl.h"
   23 #include "laspack/copyrght.h"
   24 
   25 static ElType ZeroEl = { 0, 0.0 };
   26 
   27 static int ElCompar(const void *El1, const void *El2);
   28 
   29 void Q_Constr(QMatrix *Q, char *Name, size_t Dim, Boolean Symmetry,
   30               ElOrderType ElOrder, InstanceType Instance, Boolean OwnData)
   31 /* constructor of the type QMatrix */
   32 {
   33     size_t RoC;
   34 
   35     Q->Name = (char *)malloc((strlen(Name) + 1) * sizeof(char));
   36     if (Q->Name != NULL)
   37         strcpy(Q->Name, Name);
   38     else
   39         LASError(LASMemAllocErr, "Q_Constr", Name, NULL, NULL);
   40     Q->Dim = Dim;
   41     Q->Symmetry = Symmetry;
   42     Q->ElOrder = ElOrder;
   43     Q->Instance = Instance;
   44     Q->LockLevel = 0;
   45     Q->MultiplD = 1.0;
   46     Q->MultiplU = 1.0;
   47     Q->MultiplL = 1.0;
   48     Q->OwnData = OwnData;
   49     if (OwnData) {
   50         if (LASResult() == LASOK) {
   51         Q->Len = (size_t *)malloc((Dim + 1) * sizeof(size_t));
   52         Q->El = (ElType **)malloc((Dim + 1) * sizeof(ElType *));
   53         Q->ElSorted = (Boolean *)malloc(sizeof(Boolean));
   54         Q->DiagElAlloc = (Boolean *)malloc(sizeof(Boolean));
   55         Q->DiagEl = (ElType **)malloc((Dim + 1) * sizeof(ElType *));
   56         Q->ZeroInDiag = (Boolean *)malloc(sizeof(Boolean));
   57             Q->InvDiagEl = (Real *)malloc((Dim + 1) * sizeof(Real));
   58         Q->ILUExists = (Boolean *)malloc(sizeof(Boolean));
   59             Q->ILU = (QMatrix *)malloc(sizeof(QMatrix));
   60         if (Q->Len != NULL && Q->El != NULL && Q->ElSorted != NULL
   61             && Q->DiagElAlloc != NULL && Q->DiagEl != NULL && Q->ZeroInDiag != NULL
   62             && Q->InvDiagEl != NULL && Q->ILUExists != NULL && Q->ILU != NULL) {
   63                 for (RoC = 1; RoC <= Dim; RoC++) {
   64                     Q->Len[RoC] = 0;
   65                     Q->El[RoC] = NULL;
   66                     Q->DiagEl[RoC] = NULL;
   67                     Q->InvDiagEl[RoC] = 0.0;
   68                 }
   69                 *Q->ElSorted = False;
   70                 *Q->DiagElAlloc = False;
   71                 *Q->ZeroInDiag = True;
   72                 *Q->ILUExists = False;
   73             } else {
   74             LASError(LASMemAllocErr, "Q_Constr", Name, NULL, NULL);
   75             }
   76         } else {
   77         Q->Len = NULL;
   78         Q->El = NULL;
   79         Q->ElSorted = NULL;
   80         Q->DiagElAlloc = NULL;
   81         Q->DiagEl = NULL;
   82         Q->ZeroInDiag = NULL;
   83             Q->InvDiagEl = NULL;
   84         Q->ILUExists = NULL;
   85         Q->ILU = NULL;
   86         }
   87     }
   88     Q->UnitRightKer = False;
   89     Q->RightKerCmp = NULL;
   90     Q->UnitLeftKer = False;
   91     Q->LeftKerCmp = NULL;
   92     Q->EigenvalInfo = NULL;
   93 }
   94 
   95 void Q_Destr(QMatrix *Q)
   96 /* destructor of the type QMatrix */
   97 {
   98     size_t Dim, RoC;
   99 
  100     if (Q->Name != NULL)
  101         free(Q->Name);
  102     Dim = Q->Dim;
  103     if (Q->OwnData) {
  104     if (Q->Len != NULL && Q->El != NULL) {
  105             for (RoC = 1; RoC <= Dim; RoC++) {
  106                 if (Q->Len[RoC] > 0) {
  107                     if (Q->El[RoC] != NULL)
  108                         free(Q->El[RoC]);
  109                 }
  110             }
  111         }
  112         if (Q->Len != NULL) {
  113             free(Q->Len);
  114             Q->Len = NULL;
  115         }
  116         if (Q->El != NULL) {
  117             free(Q->El);
  118             Q->El = NULL;
  119         }
  120         if (Q->ElSorted != NULL) {
  121             free(Q->ElSorted);
  122             Q->ElSorted = NULL;
  123         }
  124         if (Q->DiagElAlloc != NULL) {
  125             free(Q->DiagElAlloc);
  126             Q->DiagElAlloc = NULL;
  127         }
  128         if (Q->DiagEl != NULL) {
  129             free(Q->DiagEl);
  130             Q->DiagEl = NULL;
  131         }
  132         if (Q->ZeroInDiag != NULL) {
  133             free(Q->ZeroInDiag);
  134             Q->ZeroInDiag = NULL;
  135         }
  136         if (Q->InvDiagEl != NULL) {
  137             free(Q->InvDiagEl);
  138             Q->InvDiagEl = NULL;
  139         }
  140         if (Q->ILUExists != NULL && Q->ILU != NULL) {
  141             if (*Q->ILUExists) 
  142                 Q_Destr(Q->ILU);
  143         }
  144         if (Q->ILUExists != NULL) {
  145             free(Q->ILUExists);
  146             Q->ILUExists = NULL;
  147         }
  148         if (Q->ILU != NULL) {
  149             free(Q->ILU);
  150             Q->ILU = NULL;
  151         }
  152     }
  153     if (Q->RightKerCmp != NULL) {
  154         free(Q->RightKerCmp);
  155         Q->RightKerCmp = NULL;
  156     }
  157     if (Q->LeftKerCmp != NULL) {
  158         free(Q->LeftKerCmp);
  159         Q->LeftKerCmp = NULL;
  160     }
  161     if (Q->EigenvalInfo != NULL) {
  162         free(Q->EigenvalInfo);
  163         Q->EigenvalInfo = NULL;
  164     }
  165 }
  166 
  167 void Q_SetName(QMatrix *Q, char *Name)
  168 /* (re)set name of the matrix Q */
  169 {
  170     if (LASResult() == LASOK) {
  171         free(Q->Name);
  172         Q->Name = (char *)malloc((strlen(Name) + 1) * sizeof(char));
  173         if (Q->Name != NULL)
  174             strcpy(Q->Name, Name);
  175         else
  176             LASError(LASMemAllocErr, "Q_SetName", Name, NULL, NULL);
  177     }
  178 }
  179 
  180 char *Q_GetName(QMatrix *Q)
  181 /* returns the name of the matrix Q */
  182 {
  183     if (LASResult() == LASOK)
  184         return(Q->Name);
  185     else
  186         return("");
  187 }
  188 
  189 size_t Q_GetDim(QMatrix *Q)
  190 /* returns the dimension of the matrix Q */
  191 {
  192     size_t Dim;
  193 
  194     if (LASResult() == LASOK)
  195         Dim = Q->Dim;
  196     else
  197         Dim = 0;
  198     return(Dim);
  199 }
  200 
  201 Boolean Q_GetSymmetry(QMatrix *Q)
  202 /* returns True if Q is symmetric otherwise False */
  203 {
  204     Boolean Symmetry;
  205 
  206     if (LASResult() == LASOK) {
  207         Symmetry = Q->Symmetry;
  208     } else {
  209         Symmetry = (Boolean)0;
  210     }
  211     return(Symmetry);
  212 }
  213 
  214 ElOrderType Q_GetElOrder(QMatrix *Q)
  215 /* returns element order of the matrix Q */
  216 {
  217     ElOrderType ElOrder;
  218 
  219     if (LASResult() == LASOK) {
  220         ElOrder = Q->ElOrder;
  221     } else {
  222         ElOrder = (ElOrderType)0;
  223     }
  224     return(ElOrder);
  225 }
  226 
  227 void Q_SetLen(QMatrix *Q, size_t RoC, size_t Len)
  228 /* set the lenght of a row or column of the matrix Q */
  229 {
  230     size_t ElCount;
  231     ElType *PtrEl;
  232 
  233     if (LASResult() == LASOK) {
  234         if (Q->Instance == Normal && RoC > 0 && RoC <= Q->Dim) {
  235             Q->Len[RoC] = Len;
  236 
  237             PtrEl = Q->El[RoC];
  238 
  239             if (PtrEl != NULL) {
  240                 free(PtrEl);
  241         PtrEl = NULL;
  242         }
  243 
  244             if (Len > 0) {
  245                 PtrEl = (ElType *)malloc(Len * sizeof(ElType));
  246                 Q->El[RoC] = PtrEl;
  247 
  248                 if (PtrEl != NULL) {
  249                     for (ElCount = Len; ElCount > 0; ElCount--) {
  250                         *PtrEl = ZeroEl;
  251                         PtrEl++;
  252                     }
  253                 } else {
  254                     LASError(LASMemAllocErr, "Q_SetLen", Q->Name, NULL, NULL);
  255                 }
  256             } else {
  257                 Q->El[RoC] = NULL;
  258             }
  259         } else {
  260             if (Q->Instance != Normal)
  261                 LASError(LASLValErr, "Q_SetLen", Q->Name, NULL, NULL);
  262             else
  263                 LASError(LASRangeErr, "Q_SetLen", Q->Name, NULL, NULL);
  264         }
  265     }
  266 }
  267 
  268 size_t Q_GetLen(QMatrix *Q, size_t RoC)
  269 /* returns the lenght of a row or column of the matrix Q */
  270 {
  271     size_t Len;
  272 
  273     if (LASResult() == LASOK) {
  274         if (RoC > 0 && RoC <= Q->Dim) {
  275             Len = Q->Len[RoC];
  276         } else {
  277             LASError(LASRangeErr, "Q_GetLen", Q->Name, NULL, NULL);
  278             Len = 0;
  279         }
  280     } else {
  281         Len = 0;
  282     }
  283     return(Len);
  284 }
  285 
  286 void Q_SetEntry(QMatrix *Q, size_t RoC, size_t Entry, size_t Pos, Real Val)
  287 /* set a new matrix entry */
  288 {
  289     if (LASResult() == LASOK) {
  290         if ((RoC > 0 && RoC <= Q->Dim && Pos > 0 && Pos <= Q->Dim) &&
  291             (Entry < Q->Len[RoC])) {
  292             Q->El[RoC][Entry].Pos = Pos;
  293             Q->El[RoC][Entry].Val = Val;
  294         } else {
  295             LASError(LASRangeErr, "Q_SetEntry", Q->Name, NULL, NULL);
  296         }
  297     }
  298 }
  299 
  300 size_t Q_GetPos(QMatrix *Q, size_t RoC, size_t Entry)
  301 /* returns the position of a matrix element */
  302 {
  303     size_t Pos;
  304 
  305     if (LASResult() == LASOK)
  306         if (RoC > 0 && RoC <= Q->Dim && Entry < Q->Len[RoC]) {
  307             Pos = Q->El[RoC][Entry].Pos;
  308         } else {
  309             LASError(LASRangeErr, "Q_GetPos", Q->Name, NULL, NULL);
  310             Pos = 0;
  311         }
  312     else
  313         Pos = 0;
  314     return(Pos);
  315 }
  316 
  317 Real Q_GetVal(QMatrix *Q, size_t RoC, size_t Entry)
  318 /* returns the value of a matrix element */
  319 {
  320     Real Val;
  321 
  322     if (LASResult() == LASOK)
  323         if (RoC > 0 && RoC <= Q->Dim && Entry < Q->Len[RoC]) {
  324             Val = Q->El[RoC][Entry].Val;
  325         } else {
  326             LASError(LASRangeErr, "Q_GetVal", Q->Name, NULL, NULL);
  327             Val = 0.0;
  328         }
  329     else
  330         Val = 0.0;
  331     return(Val);
  332 }
  333 
  334 void Q_AddVal(QMatrix *Q, size_t RoC, size_t Entry, Real Val)
  335 /* add a value to a matrix entry */
  336 {
  337     if (LASResult() == LASOK) {
  338         if ((RoC > 0 && RoC <= Q->Dim) && (Entry < Q->Len[RoC]))
  339             Q->El[RoC][Entry].Val += Val;
  340         else
  341             LASError(LASRangeErr, "Q_AddVal", Q->Name, NULL, NULL);
  342     }
  343 }
  344 
  345 Real Q_GetEl(QMatrix *Q, size_t Row, size_t Clm)
  346 /* returns the value of a matrix element (all matrix elements are considered) */
  347 {
  348     Real Val;
  349     
  350     size_t Len, ElCount;
  351     ElType *PtrEl;
  352 
  353     if (LASResult() == LASOK) {
  354         if (Row > 0 && Row <= Q->Dim && Clm > 0 && Clm <= Q->Dim) {
  355             Val = 0.0;
  356             if (Q->Symmetry && Q->ElOrder == Rowws) {
  357                 if (Clm >= Row) {
  358                     Len = Q->Len[Row];
  359                     PtrEl = Q->El[Row];
  360                     for (ElCount = Len; ElCount > 0; ElCount--) {
  361                         if ((*PtrEl).Pos == Clm)
  362                             Val = (*PtrEl).Val;
  363                         PtrEl++;
  364                     }
  365                 } else {
  366                     Len = Q->Len[Clm];
  367                     PtrEl = Q->El[Clm];
  368                     for (ElCount = Len; ElCount > 0; ElCount--) {
  369                         if ((*PtrEl).Pos == Row)
  370                             Val = (*PtrEl).Val;
  371                         PtrEl++;
  372                     }
  373                 }
  374             } else if (Q->Symmetry && Q->ElOrder == Clmws) {
  375                 if (Clm >= Row) {
  376                     Len = Q->Len[Clm];
  377                     PtrEl = Q->El[Clm];
  378                     for (ElCount = Len; ElCount > 0; ElCount--) {
  379                         if ((*PtrEl).Pos == Row)
  380                             Val = (*PtrEl).Val;
  381                         PtrEl++;
  382                     }
  383                 } else {
  384                     Len = Q->Len[Row];
  385                     PtrEl = Q->El[Row];
  386                     for (ElCount = Len; ElCount > 0; ElCount--) {
  387                         if ((*PtrEl).Pos == Clm)
  388                             Val = (*PtrEl).Val;
  389                         PtrEl++;
  390                     }
  391                 }
  392             } else if (!Q->Symmetry && Q->ElOrder == Rowws) {
  393                 Len = Q->Len[Row];
  394                 PtrEl = Q->El[Row];
  395                 for (ElCount = Len; ElCount > 0; ElCount--) {
  396                     if ((*PtrEl).Pos == Clm)
  397                         Val = (*PtrEl).Val;
  398                     PtrEl++;
  399                 }
  400             } else if (!Q->Symmetry && Q->ElOrder == Clmws) {
  401                 Len = Q->Len[Clm];
  402                 PtrEl = Q->El[Clm];
  403                 for (ElCount = Len; ElCount > 0; ElCount--) {
  404                     if ((*PtrEl).Pos == Row)
  405                         Val = (*PtrEl).Val;
  406                     PtrEl++;
  407                 }
  408             }
  409 
  410             if (Row == Clmws)
  411                 Val *= Q->MultiplD;
  412             if (Row > Clm)
  413                 Val *= Q->MultiplU;
  414             if (Row > Clm)
  415                 Val *= Q->MultiplL;
  416         } else {
  417             LASError(LASRangeErr, "Q_GetEl", Q->Name, NULL, NULL);
  418             Val = 0.0;
  419         }
  420     } else {
  421         Val = 0.0;
  422     }
  423     return(Val);
  424 }
  425 
  426 void Q_SortEl(QMatrix *Q)
  427 /* sorts elements of a row or column in ascended order */
  428 {
  429     size_t Dim, RoC;
  430     Boolean UpperOnly;
  431 
  432     if (LASResult() == LASOK && !(*Q->ElSorted)) {
  433         Dim = Q->Dim;
  434         UpperOnly = True;
  435         for (RoC = 1; RoC <= Dim; RoC++) {
  436             /* sort of elements by the quick sort algorithms */
  437             qsort((void *)Q->El[RoC], Q->Len[RoC], sizeof(ElType), ElCompar);
  438 
  439             /* test whether elements contained in upper triangular part
  440                (incl. diagonal) of the matrix only */
  441             if (Q->ElOrder == Rowws) {
  442                 if (Q->El[RoC][0].Pos < RoC)
  443                     UpperOnly = False;
  444             }
  445             if (Q->ElOrder == Clmws) {
  446                 if (Q->El[RoC][Q->Len[RoC] - 1].Pos > RoC)
  447                     UpperOnly = False;
  448             }
  449         }
  450         
  451         *Q->ElSorted = True;
  452         *Q->DiagElAlloc = False;
  453         *Q->ZeroInDiag = True;
  454         
  455         if (Q->Symmetry) {
  456             if(!UpperOnly)
  457                 LASError(LASSymStorErr, "Q_SortEl", Q->Name, NULL, NULL);
  458         }
  459     }
  460 }
  461 
  462 void Q_AllocInvDiagEl(QMatrix *Q)
  463 /* allocate pointers and compute inverse for diagonal elements of the matrix Q */
  464 {
  465     size_t Dim, RoC, Len, ElCount;
  466     Boolean Found;
  467     ElType *PtrEl;
  468 
  469     if (LASResult() == LASOK && !(*Q->DiagElAlloc)) {
  470         Dim = Q->Dim;
  471         *Q->ZeroInDiag = False;
  472         if (Q->Symmetry && Q->ElOrder == Rowws) {
  473             for (RoC = 1; RoC <= Dim; RoC++) {
  474                 if (Q->El[RoC][0].Pos == RoC) {
  475                     Q->DiagEl[RoC] = Q->El[RoC];
  476                 } else {
  477                     *Q->ZeroInDiag = True;
  478                     Q->DiagEl[RoC] = &ZeroEl;
  479                 }
  480             }
  481         }
  482         if (Q->Symmetry && Q->ElOrder == Clmws) {
  483             for (RoC = 1; RoC <= Dim; RoC++) {
  484                 Len = Q->Len[RoC];
  485                 if (Q->El[RoC][Len - 1].Pos == RoC) {
  486                     Q->DiagEl[RoC] = Q->El[RoC] + Len - 1;
  487                 } else {
  488                     *Q->ZeroInDiag = True;
  489                     Q->DiagEl[RoC] = &ZeroEl;
  490                 }
  491             }
  492         }
  493         if (!Q->Symmetry) {
  494             for (RoC = 1; RoC <= Dim; RoC++) {
  495                 Found = False;
  496                 Len = Q->Len[RoC];
  497                 PtrEl = Q->El[RoC] + Len - 1;
  498                 for (ElCount = Len; ElCount > 0; ElCount--) {
  499                     if ((*PtrEl).Pos == RoC) {
  500                         Found = True;
  501                         Q->DiagEl[RoC] = PtrEl;
  502                     }
  503                     PtrEl--;
  504                 }
  505                 if (!Found) {
  506                     *Q->ZeroInDiag = True;
  507                     Q->DiagEl[RoC] = &ZeroEl;
  508                 }
  509             }
  510         }
  511         *Q->DiagElAlloc = True;
  512         
  513         if (!(*Q->ZeroInDiag)) {
  514             for (RoC = 1; RoC <= Dim; RoC++)
  515                 Q->InvDiagEl[RoC] = 1.0 / (*Q->DiagEl[RoC]).Val;
  516         }
  517     }
  518 }
  519 
  520 static int ElCompar(const void *El1, const void *El2)
  521 /* compares positions of two matrix elements */
  522 {
  523     int Compar;
  524 
  525     Compar = 0;
  526     if (((ElType *)El1)->Pos < ((ElType *)El2)->Pos)
  527         Compar = -1;
  528     if (((ElType *)El1)->Pos > ((ElType *)El2)->Pos)
  529         Compar = +1;
  530 
  531     return(Compar);
  532 }
  533 
  534 void Q_SetKer(QMatrix *Q, Vector *RightKer, Vector *LeftKer)
  535 /* defines the null space in the case of a singular matrix */
  536 {
  537     double Sum, Mean, Cmp, Norm;
  538     size_t Dim, Ind;
  539     Real *KerCmp;
  540 
  541     V_Lock(RightKer);
  542     V_Lock(LeftKer);
  543     
  544     if (LASResult() == LASOK) {
  545     if (Q->Dim == RightKer->Dim && (Q->Symmetry || Q->Dim == LeftKer->Dim)) {
  546         Dim = Q->Dim;
  547         
  548         /* release array for old null space components when it exists */ 
  549         if (Q->RightKerCmp != NULL) {
  550             free(Q->RightKerCmp);
  551             Q->RightKerCmp = NULL;
  552         }
  553         if (Q->LeftKerCmp != NULL) {
  554             free(Q->LeftKerCmp);
  555             Q->LeftKerCmp = NULL;
  556         }
  557         Q->UnitRightKer = False;
  558         Q->UnitLeftKer = False;
  559         
  560         /* right null space */
  561             KerCmp = RightKer->Cmp;
  562         /* test whether the matrix Q has a unit right null space */
  563         Sum = 0.0;
  564         for(Ind = 1; Ind <= Dim; Ind++)
  565             Sum += KerCmp[Ind];
  566         Mean = Sum / (double)Dim;
  567         Q->UnitRightKer = True;
  568         if (!IsZero(Mean)) {
  569             for(Ind = 1; Ind <= Dim; Ind++)
  570                     if (!IsOne(KerCmp[Ind] / Mean))
  571                 Q->UnitRightKer = False;
  572             } else {
  573             Q->UnitRightKer = False;
  574         }
  575         if (!Q->UnitRightKer) {
  576             Sum = 0.0;
  577             for(Ind = 1; Ind <= Dim; Ind++) {
  578                 Cmp = KerCmp[Ind];
  579                 Sum += Cmp * Cmp;
  580             }
  581         Norm = sqrt(Sum);
  582         if (!IsZero(Norm)) {
  583                     Q->RightKerCmp = (Real *)malloc((Dim + 1) * sizeof(Real));
  584             if (Q->RightKerCmp != NULL) {
  585                 for(Ind = 1; Ind <= Dim; Ind++)
  586                         Q->RightKerCmp[Ind] = KerCmp[Ind] / Norm;
  587             } else {
  588                     LASError(LASMemAllocErr, "Q_SetKer", Q->Name, RightKer->Name,
  589                     LeftKer->Name);
  590             }
  591         }
  592         }
  593         
  594         if (!Q->Symmetry) {
  595             /* left null space */
  596                 KerCmp = LeftKer->Cmp;
  597             /* test whether the matrix Q has a unit left null space */
  598             Sum = 0.0;
  599             for(Ind = 1; Ind <= Dim; Ind++)
  600                 Sum += KerCmp[Ind];
  601             Mean = Sum / (double)Dim;
  602             Q->UnitLeftKer = True;
  603             if (!IsZero(Mean)) {
  604                 for(Ind = 1; Ind <= Dim; Ind++)
  605                         if (!IsOne(KerCmp[Ind] / Mean))
  606                     Q->UnitLeftKer = False;
  607                 } else {
  608                 Q->UnitLeftKer = False;
  609             }
  610             if (!Q->UnitLeftKer) {
  611                 Sum = 0.0;
  612                 for(Ind = 1; Ind <= Dim; Ind++) {
  613                     Cmp = KerCmp[Ind];
  614                     Sum += Cmp * Cmp;
  615                 }
  616             Norm = sqrt(Sum);
  617             if (!IsZero(Norm)) {
  618                         Q->LeftKerCmp = (Real *)malloc((Dim + 1) * sizeof(Real));
  619                 if (Q->LeftKerCmp != NULL) {
  620                     for(Ind = 1; Ind <= Dim; Ind++)
  621                             Q->LeftKerCmp[Ind] = KerCmp[Ind] / Norm;
  622                 } else {
  623                         LASError(LASMemAllocErr, "Q_SetKer", Q->Name,
  624                 RightKer->Name, LeftKer->Name);
  625                 }
  626                 }
  627             }
  628         } else {
  629         }
  630     } else {
  631         LASError(LASDimErr, "Q_SetKer", Q->Name, RightKer->Name, LeftKer->Name);
  632     }
  633     }
  634 
  635     V_Unlock(RightKer);
  636     V_Unlock(LeftKer);
  637 }
  638 
  639 Boolean Q_KerDefined(QMatrix *Q)
  640 /* returns True if Q is singular and the null space has been defined
  641    otherwise False */ 
  642 {
  643     Boolean KerDefined;
  644 
  645     if (LASResult() == LASOK) {
  646         if ((Q->UnitRightKer || Q->RightKerCmp != NULL) && !IsZero(Q->MultiplD)
  647         && IsOne(Q->MultiplU / Q->MultiplD) && IsOne(Q->MultiplL / Q->MultiplD))
  648         KerDefined = True;
  649     else
  650         KerDefined = False;
  651     } else {
  652         KerDefined = (Boolean)0;
  653     }
  654     return(KerDefined);
  655 }
  656 
  657 void **Q_EigenvalInfo(QMatrix *Q)
  658 /* return address of the infos for eigenvalues */
  659 {
  660     return(&(Q->EigenvalInfo));
  661 }
  662 
  663 void Q_Lock(QMatrix *Q)
  664 /* lock the matrix Q */
  665 {
  666     if (Q != NULL) 
  667         Q->LockLevel++;
  668 }
  669 
  670 void Q_Unlock(QMatrix *Q)
  671 /* unlock the matrix Q */
  672 {
  673     if (Q != NULL) {
  674         Q->LockLevel--;
  675         if (Q->Instance == Tempor && Q->LockLevel <= 0) {
  676             Q_Destr(Q); 
  677         free(Q);
  678     }
  679     }
  680 }