Skip to content

Commit c992597

Browse files
Shabareesh ShettyShabareesh Shetty
authored andcommitted
chore: add FORTRAN implementation
--- type: pre_commit_static_analysis_report description: Results of running static analysis checks when committing changes. report: - task: lint_filenames status: passed - task: lint_editorconfig status: passed - task: lint_markdown status: na - task: lint_package_json status: na - task: lint_repl_help status: na - task: lint_javascript_src status: na - task: lint_javascript_cli status: na - task: lint_javascript_examples status: na - task: lint_javascript_tests status: na - task: lint_javascript_benchmarks status: na - task: lint_python status: na - task: lint_r status: na - task: lint_c_src status: missing_dependencies - task: lint_c_examples status: na - task: lint_c_benchmarks status: na - task: lint_c_tests_fixtures status: na - task: lint_shell status: na - task: lint_typescript_declarations status: na - task: lint_typescript_tests status: na - task: lint_license_headers status: passed ---
1 parent d8b965b commit c992597

File tree

2 files changed

+134
-0
lines changed

2 files changed

+134
-0
lines changed
Lines changed: 96 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,96 @@
1+
!>
2+
! @license Apache-2.0
3+
!
4+
! Copyright (c) 2024 The Stdlib Authors.
5+
!
6+
! Licensed under the Apache License, Version 2.0 (the "License");
7+
! you may not use this file except in compliance with the License.
8+
! You may obtain a copy of the License at
9+
!
10+
! http://www.apache.org/licenses/LICENSE-2.0
11+
!
12+
! Unless required by applicable law or agreed to in writing, software
13+
! distributed under the License is distributed on an "AS IS" BASIS,
14+
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15+
! See the License for the specific language governing permissions and
16+
! limitations under the License.
17+
!<
18+
19+
!> Scales a double-precision complex floating-point vector by a double-precision complex floating-point constant and adds the result to a double-precision complex floating-point vector.
20+
!
21+
! ## Notes
22+
!
23+
! * Modified version of reference BLAS level1 routine (version 3.9.0). Updated to "free form" Fortran 95.
24+
!
25+
! ## Authors
26+
!
27+
! * Univ. of Tennessee
28+
! * Univ. of California Berkeley
29+
! * Univ. of Colorado Denver
30+
! * NAG Ltd.
31+
!
32+
! ## History
33+
!
34+
! * Jack Dongarra, linpack, 4/11/78.
35+
!
36+
! - modified 12/3/93, array(1) declarations changed to array(*)
37+
!
38+
! ## License
39+
!
40+
! From <http://netlib.org/blas/faq.html>:
41+
!
42+
! > The reference BLAS is a freely-available software package. It is available from netlib via anonymous ftp and the World Wide Web. Thus, it can be included in commercial software packages (and has been). We only ask that proper credit be given to the authors.
43+
! >
44+
! > Like all software, it is copyrighted. It is not trademarked, but we do ask the following:
45+
! >
46+
! > * If you modify the source for these routines we ask that you change the name of the routine and comment the changes made to the original.
47+
! >
48+
! > * We will gladly answer any questions regarding the software. If a modification is done, however, it is the responsibility of the person who modified the routine to provide support.
49+
!
50+
! @param {integer} N - number of indexed elements
51+
! @param {complex<double>} alpha - scalar constant
52+
! @param {Array<complex<double>>} x - input array
53+
! @param {integer} strideX - `x` stride length
54+
! @param {Array<complex<double>>} y - output array
55+
! @param {integer} strideY - `y` stride length
56+
!<
57+
subroutine zapxy( N, alpha, x, strideX, y, strideY )
58+
implicit none
59+
! ..
60+
! Scalar arguments:
61+
complex(kind=kind(0.0d0)) :: alpha
62+
integer :: strideX, strideY, N
63+
! ..
64+
! Array arguments:
65+
complex(kind=kind(0.0d0)) :: x(*), y(*)
66+
! ..
67+
! Local scalars:
68+
integer :: ix, iy, i
69+
! ..
70+
if ( N <= 0 .OR. dcabs1( alpha ) == 0.0 ) then
71+
return
72+
end if
73+
! ..
74+
if ( strideX == 1 .AND. strideY == 1 ) then
75+
do i = 1, N
76+
y( i ) = y( i ) + alpha * x( i )
77+
end do
78+
else
79+
if ( strideX < 0 ) then
80+
ix = ((1-N)*strideX) + 1
81+
else
82+
ix = 1
83+
end if
84+
if ( strideY < 0 ) then
85+
iy = ((1-N)*strideY) + 1
86+
else
87+
iy = 1
88+
end if
89+
do i = 1, N
90+
y( iy ) = y( iy ) + alpha * x( ix )
91+
ix = ix + strideX
92+
iy = iy + strideY
93+
end do
94+
end if
95+
return
96+
end subroutine zcopy
Lines changed: 38 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,38 @@
1+
/**
2+
* @license Apache-2.0
3+
*
4+
* Copyright (c) 2024 The Stdlib Authors.
5+
*
6+
* Licensed under the Apache License, Version 2.0 (the "License");
7+
* you may not use this file except in compliance with the License.
8+
* You may obtain a copy of the License at
9+
*
10+
* http://www.apache.org/licenses/LICENSE-2.0
11+
*
12+
* Unless required by applicable law or agreed to in writing, software
13+
* distributed under the License is distributed on an "AS IS" BASIS,
14+
* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15+
* See the License for the specific language governing permissions and
16+
* limitations under the License.
17+
*/
18+
19+
#include "stdlib/blas/base/zaxpy.h"
20+
#include "stdlib/blas/base/zaxpy_fortran.h"
21+
#include "stdlib/blas/base/shared.h"
22+
#include "stdlib/complex/float64/ctor.h"
23+
#include "stdlib/blas/base/xerbla.h"
24+
25+
/**
26+
* Scales a double-precision complex floating-point vector by a double-precision complex floating-point constant and adds the result to a double-precision complex floating-point vector.
27+
*
28+
* @param N number of indexed elements
29+
* @param alpha scalar constant
30+
* @param X input array
31+
* @param strideX X stride length
32+
* @param Y output array
33+
* @param strideY Y stride length
34+
*/
35+
void API_SUFFIX(c_zaxpy)( const CBLAS_INT N, const stdlib_complex128_t alpha, const void *X, const CBLAS_INT strideX, void *Y, const CBLAS_INT strideY ) {
36+
zaxpy( &N, &alpha, X, &strideX, Y, &strideY );
37+
return;
38+
}

0 commit comments

Comments
 (0)