feat: add C / Fortran implementation for drotg

Author: aman-095

lib/node_modules/@stdlib/blas/base/drotg/benchmark/c/benchmark.length.c

@@ -109,7 +109,7 @@ double benchmark( int iterations ) {
 	s = 0.6;
 	t = tic();
 	for ( i = 0; i < iterations; i++ ) {
-		c_drotg( x, y, c, s );
+		c_drotg( &x, &y, &c, &s );
 		if ( y != y ) {
 			printf( "should not return NaN\n" );
 			break;

lib/node_modules/@stdlib/blas/base/drotg/benchmark/fortran/benchmark.length.f

@@ -16,12 +16,19 @@
 ! limitations under the License.
 !<
 
+!> Benchmark `drotg`.
+!
+! ## Notes
+!
+! -   Written in "free form" Fortran 95.
+!
+!<
 program bench
   implicit none
   ! ..
   ! Local constants:
   character(5), parameter :: name = 'drotg' ! if changed, be sure to adjust length
-  integer, parameter :: iterations = 10000000
+  integer, parameter :: iterations = 1000000
   integer, parameter :: repeats = 3
   integer, parameter :: min = 1
   integer, parameter :: max = 6
@@ -110,39 +117,42 @@ end subroutine print_results
   ! Runs a benchmark.
   !
   ! @param {integer} iterations - number of iterations
-  ! @param {integer} len - array length
   ! @return {double} elapsed time in seconds
   ! ..
   double precision function benchmark( iterations )
     ! ..
     ! External functions:
     interface
       subroutine drotg( da, db, c, s )
-        double precision :: da, db, c, s
+      double precision :: c, da, db, s
       end subroutine drotg
     end interface
     ! ..
     ! Scalar arguments:
     integer, intent(in) :: iterations
     ! ..
     ! Local scalars:
-    double precision :: elapsed, r, x, y
-    real :: t1, t2
+    double precision :: elapsed, r1, r2
+    real ::  t1, t2
     integer :: i
     ! ..
+    ! Local scalar:
+    double precision :: da, db
+    ! ..
     ! Intrinsic functions:
     intrinsic random_number, cpu_time
     ! ..
-    call random_number( r )
-    x = ( r*200.0d0 ) - 100.0d0
-    y = ( r*200.0d0 ) - 100.0d0
+    call random_number( r1 )
+    call random_number( r2 )
+    da = (r1*100.0d0)-50.0d0 
+    db = (r2*100.0d0)-50.0d0 
     ! ..
     call cpu_time( t1 )
     ! ..
     do i = 1, iterations
-      call drotg( x, y, 1.0d0, 0.0d0 );
-      if ( y /= y ) then
-        print '(A)', 'should not return NaN'
+      call drotg( da, db, 0.8d0, 0.6d0 )
+      if ( db /= db ) then
+        print '(A)', 'unexpected result'
         exit
       end if
     end do
@@ -151,8 +161,8 @@ end subroutine drotg
     ! ..
     elapsed = t2 - t1
     ! ..
-    if ( y /= y ) then
-      print '(A)', 'should not return NaN'
+    if ( db /= db ) then
+      print '(A)', 'unexpected result'
     end if
     ! ..
     benchmark = elapsed
@@ -164,9 +174,9 @@ end function benchmark
   subroutine main()
     ! ..
     ! Local variables:
-    integer :: count, iter, i, j
-    double precision :: elapsed
     character(len=999) :: str, tmp
+    double precision :: elapsed
+    integer :: i, j, count, iter
     ! ..
     ! Intrinsic functions:
     intrinsic adjustl, trim

lib/node_modules/@stdlib/blas/base/drotg/src/addon.c

@@ -33,18 +33,18 @@ static napi_value addon( napi_env env, napi_callback_info info ) {
 	napi_status status;
 
 	// Get callback arguments:
-	size_t argc = 2;
+	size_t argc = 3;
 	napi_value argv[ 3 ];
 	status = napi_get_cb_info( env, info, &argc, argv, NULL, NULL );
 	assert( status == napi_ok );
 
 	// Check whether we were provided the correct number of arguments:
-	if ( argc < 2 ) {
+	if ( argc < 3 ) {
 		status = napi_throw_error( env, NULL, "invalid invocation. Insufficient arguments." );
 		assert( status == napi_ok );
 		return NULL;
 	}
-	if ( argc > 2 ) {
+	if ( argc > 3 ) {
 		status = napi_throw_error( env, NULL, "invalid invocation. Too many arguments." );
 		assert( status == napi_ok );
 		return NULL;

lib/node_modules/@stdlib/blas/base/drotg/src/drotg.f

@@ -55,9 +55,6 @@
 subroutine drotg( da, db, c, s )
   implicit none
   ! ..
-  ! Internal parameters:
-  integer, parameter :: dp=kind(0.0d0)  ! double-precision
-  ! ..
   ! Scalar arguments:
   double precision :: c, da, db, s
   ! ..

lib/node_modules/@stdlib/blas/base/drotg/test/test.native.js

@@ -0,0 +1,119 @@
+/**
+* @license Apache-2.0
+*
+* Copyright (c) 2023 The Stdlib Authors.
+*
+* Licensed under the Apache License, Version 2.0 (the "License");
+* you may not use this file except in compliance with the License.
+* You may obtain a copy of the License at
+*
+*    http://www.apache.org/licenses/LICENSE-2.0
+*
+* Unless required by applicable law or agreed to in writing, software
+* distributed under the License is distributed on an "AS IS" BASIS,
+* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+* See the License for the specific language governing permissions and
+* limitations under the License.
+*/
+
+'use strict';
+
+// MODULES //
+
+var resolve = require( 'path' ).resolve;
+var tape = require( 'tape' );
+var Float64Array = require( '@stdlib/array/float64' );
+var isnan = require( '@stdlib/math/base/assert/is-nan' );
+var EPS = require( '@stdlib/constants/float64/eps' );
+var abs = require( '@stdlib/math/base/special/abs' );
+var tryRequire = require( '@stdlib/utils/try-require' );
+
+
+// VARIABLES //
+
+var drotg = tryRequire( resolve( __dirname, './../lib/native.js' ) );
+var opts = {
+	'skip': ( drotg instanceof Error )
+};
+
+
+// TESTS //
+
+tape( 'main export is a function', opts, function test( t ) {
+	t.ok( true, __filename );
+	t.strictEqual( typeof drotg, 'function', 'main export is a function' );
+	t.end();
+});
+
+tape( 'the function has an arity of 2', opts, function test( t ) {
+	t.strictEqual( drotg.length, 2, 'returns expected value' );
+	t.end();
+});
+
+tape( 'the function computes a Givens plane rotation', opts, function test( t ) {
+	var expected;
+	var values;
+	var delta;
+	var tol;
+	var out;
+	var i;
+	var j;
+	var e;
+
+	expected = [
+		[ 0.5, 1.0/0.6, 0.6, 0.8 ],
+		[ 0.5, 0.6, 0.8, 0.6 ],
+		[ 0.5, -1.0/0.6, -0.6, 0.8 ],
+		[ -0.5, -0.6, 0.8, -0.6 ],
+		[ -0.5, 1.0/0.6, 0.6, 0.8 ],
+		[ 0.0, 0.0, 1.0, 0.0 ],
+		[ 1.0, 1.0, 0.0, 1.0 ],
+		[ 1.0, 0.0, 1.0, 0.0 ]
+	];
+	values = [
+		[ 0.3, 0.4 ],
+		[ 0.4, 0.3 ],
+		[ -0.3, 0.4 ],
+		[ -0.4, 0.3 ],
+		[ -0.3, -0.4 ],
+		[ 0.0, 0.0 ],
+		[ 0.0, 1.0 ],
+		[ 1.0, 0.0 ]
+	];
+
+	for ( i = 0; i < values.length; i++ ) {
+		e = new Float64Array( expected[i] );
+		out = drotg( values[i][0], values[i][1] );
+		for ( j = 0; j < out.length; j++ ) {
+			if ( out[j] === expected[j] ) {
+				t.strictEqual( out[j], e[j], 'returns expected value' );
+			} else {
+				delta = abs( out[j] - e[j] );
+				tol = 1.5 * EPS * abs( e[j] );
+				t.ok( delta <= tol, 'within tolerance. out: '+out[j]+'. expected: '+e[j]+'. delta: '+delta+'. tol: '+tol+'.' );
+			}
+		}
+	}
+	t.end();
+});
+
+tape( 'the function returns an array of NaNs if provided a rotational elimination parameter equal to NaN', opts, function test( t ) {
+	var actual;
+	var i;
+
+	actual = drotg( NaN, 1.0 );
+	for ( i = 0; i < actual.length; i++ ) {
+		t.strictEqual( isnan( abs( actual[i] ) ), true, 'returns expected value' );
+	}
+
+	actual = drotg( 1.0, NaN );
+	for ( i = 0; i < actual.length; i++ ) {
+		t.strictEqual( isnan( abs( actual[i] ) ), true, 'returns expected value' );
+	}
+
+	actual = drotg( NaN, NaN );
+	for ( i = 0; i < actual.length; i++ ) {
+		t.strictEqual( isnan( abs( actual[i] ) ), true, 'returns expected value' );
+	}
+	t.end();
+});