Switch to unified view

a/SVDLib3.mod b/SVDLib3.mod
...
...
18
  (*                zSVDC und der benoetigten BLAS Routinen                 *)
18
  (*                zSVDC und der benoetigten BLAS Routinen                 *)
19
  (* 21.06.18, MRi: Korrekturen in dznrm2 und zdotc                         *)
19
  (* 21.06.18, MRi: Korrekturen in dznrm2 und zdotc                         *)
20
  (*                Testmatrix wird mit zSVDc korrekt berechnet             *)
20
  (*                Testmatrix wird mit zSVDc korrekt berechnet             *)
21
  (*------------------------------------------------------------------------*)
21
  (*------------------------------------------------------------------------*)
22
  (* Testroutinen fuer zSVDc in TstSVDLib3a, fuer Takagi in TstSVDLib3b     *)
22
  (* Testroutinen fuer zSVDc in TstSVDLib3a, fuer Takagi in TstSVDLib3b     *)
23
  (* Testroutinen fuer das Loesen komplexe lineare Gleichungssystme mit     *)
24
  (*              zSVDc in TstCLQasym                                       *)
23
  (*------------------------------------------------------------------------*)
25
  (*------------------------------------------------------------------------*)
24
  (* Offene Punkte                                                          *)
26
  (* Offene Punkte                                                          *)
25
  (*                                                                        *)
27
  (*                                                                        *)
26
  (* - Weitere Verbesserung der Indizierung in zSVDc ([i-1] Problem)        *)
28
  (* - Weitere Verbesserung der Indizierung in zSVDc ([i-1] Problem)        *)
27
  (*------------------------------------------------------------------------*)
29
  (*------------------------------------------------------------------------*)
...
...
134
            S[l-1] := CMPLX(dznrm2(N-l+1,X[l-1,l-1],1),0.0);
136
            S[l-1] := CMPLX(dznrm2(N-l+1,X[l-1,l-1],1),0.0);
135
            IF (CABS1(S[l-1]) # 0.0) THEN
137
            IF (CABS1(S[l-1]) # 0.0) THEN
136
              IF (CABS1(X[l-1,l-1]) # 0.0) THEN
138
              IF (CABS1(X[l-1,l-1]) # 0.0) THEN
137
                S[l-1] := CSIGN(S[l-1],X[l-1,l-1]);
139
                S[l-1] := CSIGN(S[l-1],X[l-1,l-1]);
138
              END;
140
              END;
139
              zscal(N-l+1,1.0/S[l-1],X[l-1,l-1],1);
141
              zscal(N-l+1,one/S[l-1],X[l-1,l-1],1);
140
              X[l-1,l-1] := one + X[l-1,l-1];
142
              X[l-1,l-1] := one + X[l-1,l-1];
141
            END; (* IF *)
143
            END; (* IF *)
142
            S[l-1] := -S[l-1];
144
            S[l-1] := -S[l-1];
143
          END; (* IF *)
145
          END; (* IF *)
144
          IF (P >= lp1) THEN
146
          IF (P >= lp1) THEN
...
...
168
            E[l-1] := CMPLX(dznrm2(P-l,E[lp1-1],1),0.0);
170
            E[l-1] := CMPLX(dznrm2(P-l,E[lp1-1],1),0.0);
169
            IF (CABS1(E[l-1]) # 0.0) THEN
171
            IF (CABS1(E[l-1]) # 0.0) THEN
170
              IF (CABS1(E[lp1-1]) # 0.0) THEN
172
              IF (CABS1(E[lp1-1]) # 0.0) THEN
171
                E[l-1] := CSIGN(E[l-1],E[lp1-1]);
173
                E[l-1] := CSIGN(E[l-1],E[lp1-1]);
172
              END; (* IF *)
174
              END; (* IF *)
173
              zscal(P-l,1.0/E[l-1],E[lp1-1],1);
175
              zscal(P-l,one/E[l-1],E[lp1-1],1);
174
              E[lp1-1] := one + E[lp1-1];
176
              E[lp1-1] := one + E[lp1-1];
175
            END; (* IF *)
177
            END; (* IF *)
176
            E[l-1] := -conj(E[l-1]);
178
            E[l-1] := -conj(E[l-1]);
177
            IF (lp1 <= N) AND (CABS1(E[l-1]) # 0.0) THEN
179
            IF (lp1 <= N) AND (CABS1(E[l-1]) # 0.0) THEN
178
             (* apply the transformation. *)
180
             (* apply the transformation. *)
...
...
574
              IF (t > 0.0) THEN
576
              IF (t > 0.0) THEN
575
                f := scalarMult(sign2(1.0,sqp-sqq),(ev2^[q]*conj(A[q,p]) + 
577
                f := scalarMult(sign2(1.0,sqp-sqq),(ev2^[q]*conj(A[q,p]) + 
576
                                                    conj(ev2^[p])*A[q,p]));
578
                                                    conj(ev2^[p])*A[q,p]));
577
              ELSE
579
              ELSE
578
                f := one;
580
                f := one;
579
                IF (sqp # 0) THEN
581
                IF (sqp # 0.0) THEN
580
                  f := LongComplexMath.sqrt(ev2^[q] / ev2^[p])
582
                  f := LongComplexMath.sqrt(ev2^[q] / ev2^[p])
581
                END;
583
                END;
582
              END;
584
              END;
583
              t:=t + sqrt(t*t + SQ(f));
585
              t:=t + sqrt(t*t + SQ(f));
584
              f:=f / CMPLX(t,0.0);
586
              f:=f / CMPLX(t,0.0);