*** empty log message ***

psblas3-type-indexed
Salvatore Filippone 18 years ago
parent 1108d635ef
commit 056f154a13

@ -35,7 +35,7 @@ c
* *
* *
SUBROUTINE DCSRMM(TRANSA,M,K,N,ALPHA,DESCRA,AR, SUBROUTINE DCSRMM(TRANSA,M,K,N,ALPHA,DESCRA,AR,
* JA,IA,B,LDB,BETA,C,LDC,WORK,LWORK,IERROR) * JA,IA,B,LDB,BETA,C,LDC,WORK,LWORK,IERROR)
C C
C C
C .. Scalar Arguments .. C .. Scalar Arguments ..
@ -66,23 +66,23 @@ C
IF (DESCRA(1:1).EQ.'S' .AND. DESCRA(2:2).EQ.'U') TRANS = 'U' IF (DESCRA(1:1).EQ.'S' .AND. DESCRA(2:2).EQ.'U') TRANS = 'U'
IF (DESCRA(1:1).EQ.'S' .AND. DESCRA(2:2).EQ.'L') TRANS = 'L' IF (DESCRA(1:1).EQ.'S' .AND. DESCRA(2:2).EQ.'L') TRANS = 'L'
c c
c Does DSRMV manage this case too? <???????????????????????????? c Does DSRMV manage this case too?
c c
IF (DESCRA(1:1).EQ.'D') THEN IF (DESCRA(1:1).EQ.'D') THEN
IF (DESCRA(3:3).EQ.'U') THEN IF (DESCRA(3:3).EQ.'U') THEN
DO 40 I = 1, K DO 40 I = 1, K
DO 20 J = 1, M DO 20 J = 1, M
C(J,I) = BETA*C(J,I) + ALPHA*B(J,I) C(J,I) = BETA*C(J,I) + ALPHA*B(J,I)
20 CONTINUE 20 CONTINUE
40 CONTINUE 40 CONTINUE
ELSE ELSE
DO 80 I = 1, K DO 80 I = 1, K
DO 60 J = 1, M DO 60 J = 1, M
C(J,I) = BETA*C(J,I) + ALPHA*AR(J)*B(J,I) C(J,I) = BETA*C(J,I) + ALPHA*AR(J)*B(J,I)
60 CONTINUE 60 CONTINUE
80 CONTINUE 80 CONTINUE
END IF END IF
RETURN RETURN
END IF END IF
C C
IF (DESCRA(3:3).EQ.'N') DIAG = 'N' IF (DESCRA(3:3).EQ.'N') DIAG = 'N'
@ -95,38 +95,38 @@ C
K4 = MOD(K,NB) K4 = MOD(K,NB)
SELECT CASE(K4) SELECT CASE(K4)
CASE(1) CASE(1)
IF (K==1) THEN IF (K==1) THEN
CALL DCSRMV(TRANS,DIAG,M,N,ALPHA,AR,JA,IA,B(1,1), CALL DCSRMV(TRANS,DIAG,M,N,ALPHA,AR,JA,IA,B(1,1),
+ BETA,C(1,1),WORK,LWORK,IERROR) + BETA,C(1,1),WORK,LWORK,IERROR)
ELSE ELSE
CALL DCSRMV2(TRANS,DIAG,M,N,ALPHA,AR,JA,IA, CALL DCSRMV2(TRANS,DIAG,M,N,ALPHA,AR,JA,IA,
+ B(1,1),LDB,BETA,C(1,1),LDC,WORK,LWORK,IERROR) + B(1,1),LDB,BETA,C(1,1),LDC,WORK,LWORK,IERROR)
CALL DCSRMV3(TRANS,DIAG,M,N,ALPHA,AR,JA,IA, CALL DCSRMV3(TRANS,DIAG,M,N,ALPHA,AR,JA,IA,
+ B(1,3),LDB,BETA,C(1,3),LDC,WORK,LWORK,IERROR) + B(1,3),LDB,BETA,C(1,3),LDC,WORK,LWORK,IERROR)
K4 = K4 + 4 K4 = K4 + 4
ENDIF ENDIF
CASE(2) CASE(2)
CALL DCSRMV2(TRANS,DIAG,M,N,ALPHA,AR,JA,IA, CALL DCSRMV2(TRANS,DIAG,M,N,ALPHA,AR,JA,IA,
+ B(1,1),LDB,BETA,C(1,1),LDC,WORK,LWORK,IERROR) + B(1,1),LDB,BETA,C(1,1),LDC,WORK,LWORK,IERROR)
CASE(3) CASE(3)
CALL DCSRMV3(TRANS,DIAG,M,N,ALPHA,AR,JA,IA, CALL DCSRMV3(TRANS,DIAG,M,N,ALPHA,AR,JA,IA,
+ B(1,1),LDB,BETA,C(1,1),LDC,WORK,LWORK,IERROR) + B(1,1),LDB,BETA,C(1,1),LDC,WORK,LWORK,IERROR)
END SELECT END SELECT
IF(IERROR.NE.0) THEN IF(IERROR.NE.0) THEN
INT_VAL(1)=IERROR INT_VAL(1)=IERROR
CALL FCPSB_ERRPUSH(4012,NAME,INT_VAL) CALL FCPSB_ERRPUSH(4012,NAME,INT_VAL)
GOTO 9999 GOTO 9999
END IF END IF
DO I=K4+1,K,NB DO I=K4+1,K,NB
CALL DCSRMV4(TRANS,DIAG,M,N,ALPHA,AR,JA,IA, CALL DCSRMV4(TRANS,DIAG,M,N,ALPHA,AR,JA,IA,
+ B(1,I),LDB,BETA,C(1,I),LDC,WORK,LWORK,IERROR) + B(1,I),LDB,BETA,C(1,I),LDC,WORK,LWORK,IERROR)
ENDDO ENDDO
IF(IERROR.NE.0) THEN IF(IERROR.NE.0) THEN
INT_VAL(1)=IERROR INT_VAL(1)=IERROR
CALL FCPSB_ERRPUSH(4012,NAME,INT_VAL) CALL FCPSB_ERRPUSH(4012,NAME,INT_VAL)
GOTO 9999 GOTO 9999
END IF END IF
CALL FCPSB_ERRACTIONRESTORE(ERR_ACT) CALL FCPSB_ERRACTIONRESTORE(ERR_ACT)
@ -136,8 +136,8 @@ C
CALL FCPSB_ERRACTIONRESTORE(ERR_ACT) CALL FCPSB_ERRACTIONRESTORE(ERR_ACT)
IF ( ERR_ACT .NE. 0 ) THEN IF ( ERR_ACT .NE. 0 ) THEN
CALL FCPSB_SERROR() CALL FCPSB_SERROR()
RETURN RETURN
ENDIF ENDIF
RETURN RETURN

Loading…
Cancel
Save