SUBROUTINE COQDS(UPLO,N0,A,B,SCALE,RANK,SU,LDSU,SV,LDSV,WORK, $ WORK2,INFO) IMPLICIT NONE CHARACTER UPLO INTEGER N0, INFO, LDSU, LDSV, ISUB, MAXITER, FLAG, IINFO, RANK INTEGER SCALE REAL A(*), B(*), WORK2(*) COMPLEX SU(LDSU, *), SV(LDSV, *), WORK(N0,*) INTEGER*8 ITER0 INTEGER N, M, I, J, K, OLDM, OLDN INTEGER INDRV1, INDRV2, INDRV3, INDRV4, INDRV5, INDRV6, INDRV7, $ INDRV8 REAL TMP1, TMP2, TMP3, TMP4, TMP5 REAL TAU, TAU1, TAU2 REAL SIGMA, SIGMA2, DESIG, T, DESIG0, S REAL C1, S1, C2, S2, SMIN, EPS, TOL, SAFMIN, SCALE1, SIGMX REAL ONE, ZERO, HALF, TWO, CONST PARAMETER (ONE = 1.0E0, ZERO = 0.0E0, HALF = 0.5E0, TWO = 2.0E0) PARAMETER (CONST = 0.75E0) REAL TEN PARAMETER (TEN = 10.0E0) * INTRINSIC REAL EXTERNAL SLAMCH REAL SLAMCH EXTERNAL SFMA0 REAL SFMA0 LOGICAL LSAME EXTERNAL LSAME * INDRV1 = 0 INDRV2 = INDRV1+N0 INDRV3 = INDRV2+N0 INDRV4 = INDRV3+N0 INDRV5 = INDRV4+N0 INDRV6 = INDRV5+N0 INDRV7 = INDRV6+N0 INDRV8 = INDRV7+N0 * EPS = SLAMCH( 'Precision' ) TOL = TEN*EPS SAFMIN = SLAMCH( 'S' ) * IF ( LSAME( UPLO, 'U' ) ) THEN DO I = 1, N0-1 IF (A(I) .LT. ZERO) THEN A(I) = -A(I) B(I) = -B(I) CALL CSSCAL(N0,-ONE,SU(1,I),1) ENDIF IF (B(I) .LT. ZERO) THEN B(I) = -B(I) A(I+1) = -A(I+1) CALL CSSCAL(N0,-ONE,SV(1,I+1),1) ENDIF ENDDO IF (A(N0) .LT. ZERO) THEN A(N0) = -A(N0) CALL CSSCAL(N0,-ONE,SU(1,N0),1) ENDIF K=N0/2 DO J=1,K TMP1=A(J) A(J)=A(N0+1-J) A(N0+1-J)=TMP1 TMP1=B(J) B(J)=B(N0-J) B(N0-J)=TMP1 CALL CSWAP(N0,SU(1,J),1,SU(1,N0+1-J),1) CALL CSWAP(N0,SV(1,J),1,SV(1,N0+1-J),1) ENDDO ELSE * DO I = 1, N0-1 IF (A(I) .LT. ZERO) THEN A(I) = -A(I) B(I) = -B(I) CALL CSSCAL(N0,-ONE,SV(1,I),1) ENDIF IF (B(I) .LT. ZERO) THEN B(I) = -B(I) A(I+1) = -A(I+1) CALL CSSCAL(N0,-ONE,SU(1,I+1),1) ENDIF ENDDO IF (A(N0) .LT. ZERO) THEN A(N0) = -A(N0) CALL CSSCAL(N0,-ONE,SV(1,N0),1) ENDIF * ENDIF * IF (SCALE .EQ. 0) THEN SIGMX = ZERO ELSE SCALE1 = HALF/SAFMIN SIGMX = MAX(MAXVAL(A(1:N0)),MAXVAL(B(1:N0-1))) IF (SIGMX .GT. ZERO) THEN CALL SLASCL( 'G', 0, 0, SIGMX, SCALE1, N0, 1, $ A(1), N0, IINFO ) CALL SLASCL( 'G', 0, 0, SIGMX, SCALE1, N0-1, 1, $ B(1), N0-1, IINFO ) ENDIF ENDIF * OLDM = -1 OLDN = -1 * DO I = 1, N0 DO J = 1, N0 WORK(J,I)=ZERO ENDDO ENDDO * M = 1 N = N0 * ITER0 = 0 B(N) = ZERO WORK2(INDRV6+N) = ZERO * 3000 SIGMA = -B(N) SIGMA2 = TOL*SIGMA DESIG = -WORK2(INDRV6+N) MAXITER = 30*(N-M+1) DO I = 1, MAXITER * 15 IF (N-M+1 .EQ. 1) THEN CALL SLARTG(A(N),SIGMA,C1,S1,TMP1) CALL CSROT2(N0,SU(1,N),1,WORK(1,N),1,C1,S1) CALL SLARTG7(SIGMA,DESIG,A(N),A(N),DESIG0) GO TO 700 ENDIF IF (N-M+1 .EQ. 2) THEN IF (A(M) .GE. A(N)) THEN TMP1 = A(M) IF (TMP1 .EQ. B(N-1)+TMP1) THEN B(N-1) = -SIGMA WORK2(INDRV6+N-1) = -DESIG M = N GO TO 15 ENDIF ELSE TMP1 = A(N) IF (TMP1 .EQ. B(N-1)+TMP1) THEN B(N-1) = -SIGMA WORK2(INDRV6+N-1) = -DESIG M = N GO TO 15 ENDIF ENDIF ENDIF IF (N-M+1 .EQ. 2) THEN CALL SLASV2(A(N-1), B(N-1), A(N), A(N), A(N-1), S1, C1, $ S2, C2) CALL CSROT2(N0,SV(1,N-1),1,SV(1,N),1,C2,S2) CALL CSROT2(N0,SU(1,N-1),1,SU(1,N),1,C1,S1) CALL CSROT2(N0,WORK(1,N-1),1,WORK(1,N),1,C2,S2) CALL SLARTG(A(N-1),SIGMA,C1,S1,TMP1) CALL CSROT2(N0,SU(1,N-1),1,WORK(1,N-1),1,C1,S1) CALL SLARTG7(SIGMA,DESIG,A(N-1),A(N-1),DESIG0) CALL SLARTG(A(N),SIGMA,C1,S1,TMP1) CALL CSROT2(N0,SU(1,N),1,WORK(1,N),1,C1,S1) CALL SLARTG7(SIGMA,DESIG,A(N),A(N),DESIG0) GO TO 700 ENDIF * ITER0 = ITER0 + N - M * IF (M .GT. OLDN .OR. N .LT. OLDM) THEN IF ( A(M) .LT. A(N) ) THEN TMP1 = A(N) DO J = N-1, M, -1 IF (B(J) .LE. SIGMA2 .OR. $ TMP1 .EQ. TMP1+B(J)) THEN B(J) = -SIGMA WORK2(INDRV6+J) = -DESIG M = J+1 GO TO 15 ELSE TMP1 = A(J)*(TMP1/(TMP1+B(J))) ENDIF ENDDO DO J=M,N WORK2(INDRV5+N+M-J)=A(J) ENDDO DO J=M,N-1 WORK2(INDRV6+N-1+M-J)=B(J) ENDDO K=(N-M+1)/2+M-1 DO J=M,K CALL CSWAP(N0,SU(1,J),1,SU(1,N+M-J),1) CALL CSWAP(N0,WORK(1,J),1,WORK(1,N+M-J),1) CALL CSWAP(N0,SV(1,J),1,SV(1,N+M-J),1) ENDDO TMP1 = WORK2(INDRV5+M) DO J = M, N-1 CALL SLARTG(TMP1,WORK2(INDRV6+J),C1,S1,A(J)) WORK2(INDRV3+J) = C1 WORK2(INDRV4+J) = S1 B(J) = S1*WORK2(INDRV5+J+1) TMP1 = C1*WORK2(INDRV5+J+1) ENDDO A(N) = TMP1 * DO J = M, N-1 CALL CSROT2(N0, WORK( 1, J), 1, WORK( 1, J+1), 1, $ WORK2( INDRV3+J ), WORK2( INDRV4+J )) ENDDO * DO J = M, N-1 CALL CSROT2(N0, SV( 1, J), 1, SV( 1, J+1), 1, $ WORK2( INDRV3+J ), WORK2( INDRV4+J )) ENDDO GO TO 400 ENDIF ENDIF * TMP1 = A(M) DO J = M, N-1 IF (B(J) .LE. SIGMA2 .OR. $ TMP1 .EQ. TMP1+B(J)) THEN B(J) = -SIGMA WORK2(INDRV6+J) = -DESIG M = J+1 GO TO 15 ELSE TMP1 = A(J+1)*(TMP1/(TMP1+B(J))) ENDIF ENDDO * CALL SLAS2U(A(N-1), B(N-1), A(N), TAU, TMP3) TAU = MIN(TAU,A(N)) IF (TAU .EQ. ZERO) GO TO 350 TAU2 = MINVAL(A(M:N-1)) IF (TAU2 .LE. TAU) THEN IF (TAU2 .EQ. ZERO) GO TO 350 TAU1 = TAU2 GO TO 160 ELSE TAU1 = TAU ENDIF * TMP4 = A(M)-TAU TMP5 = A(M)+TAU IF (TMP4 .LE. ZERO) THEN GO TO 160 ELSE TMP3 = SQRT(TMP4)*SQRT(TMP5) ENDIF DO J = M, N-2 CALL SLARTG(TMP3,B(J),C1,S1,T) TMP4 = SFMA0(C1,A(J+1),-TAU) TMP5 = SFMA0(C1,A(J+1),TAU) IF (TMP4 .LE. ZERO) THEN GO TO 160 ELSE TMP3 = SQRT(TMP4)*SQRT(TMP5) ENDIF ENDDO CALL SLARTG(TMP3,B(N-1),C1,S1,T) TMP4 = SFMA0(C1,A(N),-TAU) IF (TMP4 .LT. ZERO .AND. TAU+TMP4 .EQ. TAU) TMP4 = ZERO IF (TMP4 .LT. ZERO) THEN TAU2 = MAX(TMP4+TAU,ZERO) IF (TAU2 .EQ. TAU) TAU2 = CONST*TAU IF (TAU2 .EQ. TAU) TAU2 = HALF*TAU TAU = TAU2 ENDIF IF (TAU .GT. ZERO) GO TO 125 * 160 WORK2(INDRV5+N) = ONE/A(N) TMP3 = WORK2(INDRV5+N) DO J = N-1,M,-1 WORK2(INDRV3+J) = B(J)/A(J) WORK2(INDRV5+J) = ONE/A(J)+ $ WORK2(INDRV3+J)*WORK2(INDRV5+J+1) TMP3 = MAX(TMP3,WORK2(INDRV5+J)) ENDDO WORK2(INDRV5+M) = (WORK2(INDRV5+M)/TMP3)/A(M) TMP1 = WORK2(INDRV5+M) DO J = M+1,N WORK2(INDRV4+J) = B(J-1)/A(J) WORK2(INDRV5+J) = (WORK2(INDRV5+J)/TMP3)/A(J)+ $ WORK2(INDRV4+J)*WORK2(INDRV5+J-1) TMP1 = MAX(TMP1,WORK2(INDRV5+J)) ENDDO TAU = ZERO IF (TMP3 .GT. ZERO .AND. TMP1 .GT. ZERO) THEN TAU = MAX(TAU,ONE/SQRT(TMP1)/SQRT(TMP3)) ENDIF WORK2(INDRV5+N) = WORK2(INDRV5+N)/TMP1 WORK2(INDRV6+N) = WORK2(INDRV5+N)/A(N) TMP3 = WORK2(INDRV6+N) DO J = N-1,M,-1 WORK2(INDRV5+J) = WORK2(INDRV5+J)/TMP1 WORK2(INDRV6+J) = WORK2(INDRV5+J)/A(J)+ $ WORK2(INDRV3+J)*WORK2(INDRV6+J+1) TMP3 = MAX(TMP3,WORK2(INDRV6+J)) ENDDO TMP2 = (WORK2(INDRV6+M)/TMP3)/A(M) TMP1 = TMP2/WORK2(INDRV5+M) DO J = M+1,N TMP2 = (WORK2(INDRV6+J)/TMP3)/A(J)+WORK2(INDRV4+J)*TMP2 TMP1 = MAX(TMP1,TMP2/WORK2(INDRV5+J)) ENDDO IF (TMP3 .GT. ZERO .AND. TMP1 .GT. ZERO) THEN TAU = MAX(TAU,ONE/SQRT(TMP1)/SQRT(TMP3)) ENDIF TAU = MIN(TAU,TAU1) IF (TAU .GT. ZERO) GO TO 125 TAU=A(N)-HALF*B(N-1) IF (TAU .LE. ZERO) GO TO 350 DO J=N-1,M+1,-1 TMP2=A(J)-HALF*(B(J)+B(J-1)) IF (TMP2 .LE. ZERO) GO TO 350 TAU=MIN(TAU,TMP2) ENDDO TMP2=A(M)-HALF*B(M) IF (TMP2 .LE. ZERO) GO TO 350 TAU=MIN(TAU,TMP2) * 125 IF (TAU .EQ. ZERO) GO TO 350 * IF (SIGMA .EQ. ZERO) THEN * T = TAU DESIG0 = ZERO * TMP4 = A(M)-TAU TMP5 = A(M)+TAU IF (TMP4 .LE. ZERO) THEN TAU2 = MAX(TMP4+TAU,ZERO) IF (TAU2 .EQ. TAU) TAU2 = CONST*TAU IF (TAU2 .EQ. TAU) TAU2 = HALF*TAU TAU = TAU2 GO TO 125 ELSE TMP3 = SQRT(TMP4)*SQRT(TMP5) ENDIF CALL SLARTG(TMP3,TAU,C1,S1,S) WORK2(INDRV1+M) = C1 WORK2(INDRV2+M) = -S1 DO J = M, N-2 CALL SLARTG(TMP3,B(J),C1,S1,WORK2(INDRV5+J)) WORK2(INDRV7+J) = C1 WORK2(INDRV8+J) = S1 WORK2(INDRV6+J) = S1*A(J+1) TMP4 = SFMA0(C1,A(J+1),-TAU) TMP5 = SFMA0(C1,A(J+1),TAU) IF (TMP4 .LE. ZERO) THEN TAU2 = MAX(TMP4+TAU,ZERO) IF (TAU2 .EQ. TAU) TAU2 = CONST*TAU IF (TAU2 .EQ. TAU) TAU2 = HALF*TAU TAU = TAU2 GO TO 125 ELSE TMP3 = SQRT(TMP4)*SQRT(TMP5) ENDIF CALL SLARTG(TMP3,TAU,C1,S1,S) WORK2(INDRV1+J+1) = C1 WORK2(INDRV2+J+1) = -S1 ENDDO CALL SLARTG(TMP3,B(N-1),C1,S1,WORK2(INDRV5+N-1)) WORK2(INDRV7+N-1) = C1 WORK2(INDRV8+N-1) = S1 WORK2(INDRV6+N-1) = S1*A(N) TMP4 = SFMA0(C1,A(N),-TAU) TMP5 = SFMA0(C1,A(N),TAU) IF (TMP4 .LT. ZERO .AND. TAU+TMP4 .EQ. TAU) TMP4 = ZERO IF (TMP4 .LT. ZERO) THEN TAU2 = MAX(TMP4+TAU,ZERO) IF (TAU2 .EQ. TAU) TAU2 = CONST*TAU IF (TAU2 .EQ. TAU) TAU2 = HALF*TAU TAU = TAU2 GO TO 125 ELSE TMP3 = SQRT(TMP4)*SQRT(TMP5) ENDIF IF (TMP3 .GE. A(N)) THEN TMP2 = TAU/A(N) IF (C1 .GE. TMP2) THEN TMP3 = A(N)*SQRT(C1-TMP2)*SQRT(C1+TMP2) ENDIF ENDIF CALL SLARTG(TMP3,TAU,C1,S1,S) WORK2(INDRV1+N) = C1 WORK2(INDRV2+N) = -S1 WORK2(INDRV5+N) = TMP3 * ELSE * CALL SLARTG7(SIGMA,DESIG,TAU,T,DESIG0) * TMP4 = A(M)-TAU TMP5 = A(M)+TAU IF (TMP4 .LE. ZERO) THEN TAU2 = MAX(TMP4+TAU,ZERO) IF (TAU2 .EQ. TAU) TAU2 = CONST*TAU IF (TAU2 .EQ. TAU) TAU2 = HALF*TAU TAU = TAU2 GO TO 125 ELSE TMP3 = SQRT(TMP4)*SQRT(TMP5) ENDIF CALL SLARTG6(A(M),TMP3,SIGMA,T,C1,S1) WORK2(INDRV1+M) = C1 WORK2(INDRV2+M) = S1 DO J = M, N-2 CALL SLARTG(TMP3,B(J),C1,S1,WORK2(INDRV5+J)) WORK2(INDRV7+J) = C1 WORK2(INDRV8+J) = S1 WORK2(INDRV6+J) = S1*A(J+1) TMP4 = SFMA0(C1,A(J+1),-TAU) TMP5 = SFMA0(C1,A(J+1),TAU) IF (TMP4 .LE. ZERO) THEN TAU2 = MAX(TMP4+TAU,ZERO) IF (TAU2 .EQ. TAU) TAU2 = CONST*TAU IF (TAU2 .EQ. TAU) TAU2 = HALF*TAU TAU = TAU2 GO TO 125 ELSE TMP3 = SQRT(TMP4)*SQRT(TMP5) ENDIF CALL SLARTG6(C1*A(J+1),TMP3,SIGMA,T,C1,S1) WORK2(INDRV1+J+1) = C1 WORK2(INDRV2+J+1) = S1 ENDDO CALL SLARTG(TMP3,B(N-1),C1,S1,WORK2(INDRV5+N-1)) WORK2(INDRV7+N-1) = C1 WORK2(INDRV8+N-1) = S1 WORK2(INDRV6+N-1) = S1*A(N) TMP4 = SFMA0(C1,A(N),-TAU) TMP5 = SFMA0(C1,A(N),TAU) IF (TMP4 .LT. ZERO .AND. TAU+TMP4 .EQ. TAU) TMP4 = ZERO IF (TMP4 .LT. ZERO) THEN TAU2 = MAX(TMP4+TAU,ZERO) IF (TAU2 .EQ. TAU) TAU2 = CONST*TAU IF (TAU2 .EQ. TAU) TAU2 = HALF*TAU TAU = TAU2 GO TO 125 ELSE TMP3 = SQRT(TMP4)*SQRT(TMP5) ENDIF IF (TMP3 .GE. A(N)) THEN TMP2 = TAU/A(N) IF (C1 .GE. TMP2) THEN TMP3 = A(N)*SQRT(C1-TMP2)*SQRT(C1+TMP2) ENDIF ENDIF IF (TMP3 .EQ. ZERO) THEN CALL SLARTG(SIGMA,C1*A(N),C1,S1,S) S1 = -S1 ELSE CALL SLARTG6(C1*A(N),TMP3,SIGMA,T,C1,S1) ENDIF WORK2(INDRV1+N) = C1 WORK2(INDRV2+N) = S1 WORK2(INDRV5+N) = TMP3 * ENDIF * SIGMA = T SIGMA2 = TOL*SIGMA DESIG = DESIG0 * TMP1 = WORK2(INDRV5+M) DO J = M, N-1 CALL SLARTG(TMP1,WORK2(INDRV6+J),C1,S1,A(J)) WORK2(INDRV3+J) = C1 WORK2(INDRV4+J) = S1 B(J) = S1*WORK2(INDRV5+J+1) TMP1 = C1*WORK2(INDRV5+J+1) ENDDO A(N) = TMP1 * CALL CSROT2(N0,SU(1,M),1,WORK(1,M),1, $ WORK2(INDRV1+M),WORK2(INDRV2+M)) DO J = M, N-1 CALL CSROT2(N0,SU(1,J),1,SU(1,J+1),1,WORK2(INDRV7+J), $ WORK2(INDRV8+J)) CALL CSROT2(N0,SU(1,J+1),1,WORK(1,J+1),1, $ WORK2(INDRV1+J+1),WORK2(INDRV2+J+1)) CALL CSROT2(N0,WORK(1,J),1,WORK(1,J+1),1, $ WORK2(INDRV3+J),WORK2(INDRV4+J)) ENDDO * DO J = M, N-1 CALL CSROT2(N0, SV( 1, J), 1, SV( 1, J+1), 1, $ WORK2( INDRV3+J ), WORK2( INDRV4+J )) ENDDO * GO TO 400 * 350 FLAG = -1 TMP1 = A(M) TMP2 = TMP1/SIGMA T = SIGMA*SQRT(SFMA0(TMP2,TMP2,ONE)) IF (T .LE. SIGMA) THEN CALL SLARTG(SIGMA,TMP1,C1,S1,T) FLAG = M-1 WORK2(INDRV1+M) = C1 WORK2(INDRV2+M) = -S1 TMP1 = ZERO ELSE WORK2(INDRV1+M) = ONE WORK2(INDRV2+M) = ZERO ENDIF DO J = M, N-1 CALL SLARTG(TMP1,B(J),C1,S1,WORK2(INDRV5+J)) WORK2(INDRV7+J) = C1 WORK2(INDRV8+J) = S1 WORK2(INDRV6+J) = S1*A(J+1) TMP1 = C1*A(J+1) TMP2 = TMP1/SIGMA T = SIGMA*SQRT(SFMA0(TMP2,TMP2,ONE)) IF (T .LE. SIGMA) THEN CALL SLARTG(SIGMA,TMP1,C1,S1,T) IF (FLAG .EQ. -1) FLAG = J WORK2(INDRV1+J+1) = C1 WORK2(INDRV2+J+1) = -S1 TMP1 = ZERO ELSE WORK2(INDRV1+J+1) = ONE WORK2(INDRV2+J+1) = ZERO ENDIF ENDDO WORK2(INDRV5+N) = TMP1 * TMP1 = WORK2(INDRV5+M) DO J = M, N-1 CALL SLARTG(TMP1,WORK2(INDRV6+J),C1,S1,A(J)) WORK2(INDRV3+J) = C1 WORK2(INDRV4+J) = S1 B(J) = S1*WORK2(INDRV5+J+1) TMP1 = C1*WORK2(INDRV5+J+1) ENDDO A(N) = TMP1 * IF (FLAG .EQ. -1) THEN DO J = M, N-1 CALL CSROT2(N0, SU( 1, J), 1, SU( 1, J+1), 1, $ WORK2( INDRV7+J ), WORK2( INDRV8+J )) ENDDO ELSE DO J = M, FLAG CALL CSROT2(N0, SU( 1, J), 1, SU( 1, J+1), 1, $ WORK2( INDRV7+J ), WORK2( INDRV8+J )) ENDDO CALL CSROT2(N0,SU(1,FLAG+1),1,WORK(1,FLAG+1),1, $ WORK2(INDRV1+FLAG+1),WORK2(INDRV2+FLAG+1)) DO J = FLAG+1, N-1 CALL CSROT2(N0, SU( 1, J), 1, SU( 1, J+1), 1, $ WORK2( INDRV7+J ), WORK2( INDRV8+J )) ENDDO ENDIF * DO J = M, N-1 CALL CSROT2(N0, WORK( 1, J), 1, WORK( 1, J+1), 1, $ WORK2( INDRV3+J ), WORK2( INDRV4+J )) ENDDO * DO J = M, N-1 CALL CSROT2(N0, SV( 1, J), 1, SV( 1, J+1), 1, $ WORK2( INDRV3+J ), WORK2( INDRV4+J )) ENDDO * 400 OLDM = M OLDN = N * ENDDO INFO = 2 RETURN 700 N = M-1 IF (N .LE. 0) THEN GO TO 4000 ENDIF * DO J = M-2,1,-1 IF (B(J) .LE. ZERO) THEN M = J+1 GO TO 3000 ENDIF ENDDO M = 1 GO TO 3000 * 4000 DO I = 1, N0 - 1 * * Scan for smallest D(I) * ISUB = 1 SMIN = A( 1 ) DO J = 2, N0 + 1 - I IF( A( J ).LE.SMIN ) THEN ISUB = J SMIN = A( J ) END IF ENDDO IF( ISUB.NE.N0+1-I ) THEN * * Swap singular values and vectors * A( ISUB ) = A( N0+1-I ) A( N0+1-I ) = SMIN CALL CSWAP( N0, SV( 1, ISUB ), 1, SV( 1, N0+1-I ), 1 ) CALL CSWAP( N0, SU( 1, ISUB ), 1, SU( 1, N0+1-I ), 1 ) END IF ENDDO * DO I = 1,N0 IF(A(I) .LT. SAFMIN) THEN RANK = I-1 GO TO 30 ENDIF ENDDO RANK = N0 30 IF (SIGMX .GT. ZERO) THEN CALL SLASCL( 'G', 0, 0, SCALE1, SIGMX, N0, 1, A(1), N0, IINFO ) ENDIF INFO = 0 RETURN * END