The R Project SVN – R – Diff – /trunk/src/extra/blas/blas.f

Rev 38751		Rev 53001
Line 424...		Line 424...
424	`* Form y := alphaAx + y.`	424	`* Form y := alphaAx + y.`
425	`*`	425	`*`
426	`JX = KX`	426	`JX = KX`
427	`IF( INCY.EQ.1 )THEN`	427	`IF( INCY.EQ.1 )THEN`
428	`DO 60, J = 1, N`	428	`DO 60, J = 1, N`
429	`IF( X( JX ).NE.ZERO )THEN`	429	`c IF( X( JX ).NE.ZERO )THEN`
430	`TEMP = ALPHA*X( JX )`	430	`TEMP = ALPHA*X( JX )`
431	`K = KUP1 - J`	431	`K = KUP1 - J`
432	`DO 50, I = MAX( 1, J - KU ), MIN( M, J + KL )`	432	`DO 50, I = MAX( 1, J - KU ), MIN( M, J + KL )`
433	`Y( I ) = Y( I ) + TEMP*A( K + I, J )`	433	`Y( I ) = Y( I ) + TEMP*A( K + I, J )`
434	`50 CONTINUE`	434	`50 CONTINUE`
435	`END IF`	435	`c END IF`
436	`JX = JX + INCX`	436	`JX = JX + INCX`
437	`60 CONTINUE`	437	`60 CONTINUE`
438	`ELSE`	438	`ELSE`
439	`DO 80, J = 1, N`	439	`DO 80, J = 1, N`
440	`IF( X( JX ).NE.ZERO )THEN`	440	`c IF( X( JX ).NE.ZERO )THEN`
441	`TEMP = ALPHA*X( JX )`	441	`TEMP = ALPHA*X( JX )`
442	`IY = KY`	442	`IY = KY`
443	`K = KUP1 - J`	443	`K = KUP1 - J`
444	`DO 70, I = MAX( 1, J - KU ), MIN( M, J + KL )`	444	`DO 70, I = MAX( 1, J - KU ), MIN( M, J + KL )`
445	`Y( IY ) = Y( IY ) + TEMP*A( K + I, J )`	445	`Y( IY ) = Y( IY ) + TEMP*A( K + I, J )`
446	`IY = IY + INCY`	446	`IY = IY + INCY`
447	`70 CONTINUE`	447	`70 CONTINUE`
448	`END IF`	448	`c END IF`
449	`JX = JX + INCX`	449	`JX = JX + INCX`
450	`IF( J.GT.KU )`	450	`IF( J.GT.KU )`
451	`$ KY = KY + INCY`	451	`$ KY = KY + INCY`
452	`80 CONTINUE`	452	`80 CONTINUE`
453	`END IF`	453	`END IF`
Line 724...		Line 724...
724	`DO 60, I = 1, M`	724	`DO 60, I = 1, M`
725	`C( I, J ) = BETA*C( I, J )`	725	`C( I, J ) = BETA*C( I, J )`
726	`60 CONTINUE`	726	`60 CONTINUE`
727	`END IF`	727	`END IF`
728	`DO 80, L = 1, K`	728	`DO 80, L = 1, K`
729	`IF( B( L, J ).NE.ZERO )THEN`	729	`c IF( B( L, J ).NE.ZERO )THEN`
730	`TEMP = ALPHA*B( L, J )`	730	`TEMP = ALPHA*B( L, J )`
731	`DO 70, I = 1, M`	731	`DO 70, I = 1, M`
732	`C( I, J ) = C( I, J ) + TEMP*A( I, L )`	732	`C( I, J ) = C( I, J ) + TEMP*A( I, L )`
733	`70 CONTINUE`	733	`70 CONTINUE`
734	`END IF`	734	`c END IF`
735	`80 CONTINUE`	735	`80 CONTINUE`
736	`90 CONTINUE`	736	`90 CONTINUE`
737	`ELSE`	737	`ELSE`
738	`*`	738	`*`
739	`* Form C := alphaA'B + beta*C`	739	`* Form C := alphaA'B + beta*C`
Line 766...		Line 766...
766	`DO 140, I = 1, M`	766	`DO 140, I = 1, M`
767	`C( I, J ) = BETA*C( I, J )`	767	`C( I, J ) = BETA*C( I, J )`
768	`140 CONTINUE`	768	`140 CONTINUE`
769	`END IF`	769	`END IF`
770	`DO 160, L = 1, K`	770	`DO 160, L = 1, K`
771	`IF( B( J, L ).NE.ZERO )THEN`	771	`c IF( B( J, L ).NE.ZERO )THEN`
772	`TEMP = ALPHA*B( J, L )`	772	`TEMP = ALPHA*B( J, L )`
773	`DO 150, I = 1, M`	773	`DO 150, I = 1, M`
774	`C( I, J ) = C( I, J ) + TEMP*A( I, L )`	774	`C( I, J ) = C( I, J ) + TEMP*A( I, L )`
775	`150 CONTINUE`	775	`150 CONTINUE`
776	`END IF`	776	`c END IF`
777	`160 CONTINUE`	777	`160 CONTINUE`
778	`170 CONTINUE`	778	`170 CONTINUE`
779	`ELSE`	779	`ELSE`
780	`*`	780	`*`
781	`* Form C := alphaA'B' + beta*C`	781	`* Form C := alphaA'B' + beta*C`
Line 1006...		Line 1006...
1006	`* Form y := alphaAx + y.`	1006	`* Form y := alphaAx + y.`
1007	`*`	1007	`*`
1008	`JX = KX`	1008	`JX = KX`
1009	`IF( INCY.EQ.1 )THEN`	1009	`IF( INCY.EQ.1 )THEN`
1010	`DO 60, J = 1, N`	1010	`DO 60, J = 1, N`
1011	`IF( X( JX ).NE.ZERO )THEN`	1011	`c IF( X( JX ).NE.ZERO )THEN`
1012	`TEMP = ALPHA*X( JX )`	1012	`TEMP = ALPHA*X( JX )`
1013	`DO 50, I = 1, M`	1013	`DO 50, I = 1, M`
1014	`Y( I ) = Y( I ) + TEMP*A( I, J )`	1014	`Y( I ) = Y( I ) + TEMP*A( I, J )`
1015	`50 CONTINUE`	1015	`50 CONTINUE`
1016	`END IF`	1016	`c END IF`
1017	`JX = JX + INCX`	1017	`JX = JX + INCX`
1018	`60 CONTINUE`	1018	`60 CONTINUE`
1019	`ELSE`	1019	`ELSE`
1020	`DO 80, J = 1, N`	1020	`DO 80, J = 1, N`
1021	`IF( X( JX ).NE.ZERO )THEN`	1021	`c IF( X( JX ).NE.ZERO )THEN`
1022	`TEMP = ALPHA*X( JX )`	1022	`TEMP = ALPHA*X( JX )`
1023	`IY = KY`	1023	`IY = KY`
1024	`DO 70, I = 1, M`	1024	`DO 70, I = 1, M`
1025	`Y( IY ) = Y( IY ) + TEMP*A( I, J )`	1025	`Y( IY ) = Y( IY ) + TEMP*A( I, J )`
1026	`IY = IY + INCY`	1026	`IY = IY + INCY`
1027	`70 CONTINUE`	1027	`70 CONTINUE`
1028	`END IF`	1028	`c END IF`
1029	`JX = JX + INCX`	1029	`JX = JX + INCX`
1030	`80 CONTINUE`	1030	`80 CONTINUE`
1031	`END IF`	1031	`END IF`
1032	`ELSE`	1032	`ELSE`
1033	`*`	1033	`*`

The R Project SVN R

(root)/trunk/src/extra/blas/blas.f – Rev 38751 → 53001