Merge pull request #751 from weslleyspereira/lapack-3.11-preparation

Preparing LAPACK 3.11

.appveyor.yml

@@ -11,17 +11,14 @@ skip_commits:
 # Add [av skip] to commit messages
   message: /\[av skip\]/
 
-cache:
-  - '%APPVEYOR_BUILD_FOLDER%\build'
-
 environment:
   global:
-    CONDA_INSTALL_LOCN: C:\\Miniconda36-x64
+    CONDA_INSTALL_LOCN: C:\\Miniconda37-x64
 
 install:
   - call %CONDA_INSTALL_LOCN%\Scripts\activate.bat
-  - conda config --add channels conda-forge --force
-  - conda install --yes --quiet flang jom
+#  - conda config --set auto_update_conda false
+  - conda install -c conda-forge --yes --quiet flang jom
   - call "C:\Program Files (x86)\Microsoft Visual Studio 14.0\VC\vcvarsall.bat" amd64
   - set "LIB=%CONDA_INSTALL_LOCN%\Library\lib;%LIB%"
   - set "CPATH=%CONDA_INSTALL_LOCN%\Library\include;%CPATH%"

.github/ISSUE_TEMPLATE/bug_report.md

@@ -0,0 +1,14 @@
+---
+name: Bug report
+about: Create a report to help us improve
+title: ''
+labels: 'Type: Bug'
+assignees: ''
+
+---
+**Description**
+
+**Checklist**
+
+- [ ] I've included a minimal example to reproduce the issue
+- [ ] I'd be willing to make a PR to solve this issue

.github/ISSUE_TEMPLATE/feature_request.md

@@ -0,0 +1,8 @@
+---
+name: Feature request
+about: Request a feature
+title: ''
+labels: 'Type: Feature request'
+assignees: ''
+
+---

.github/ISSUE_TEMPLATE/help_wanted.md

@@ -0,0 +1,8 @@
+---
+name: Question
+about: Ask a question related to the use of the package
+title: ''
+labels: 'Type: Question'
+assignees: ''
+
+---

.github/PULL_REQUEST_TEMPLATE.md

@@ -0,0 +1,6 @@
+**Description**
+
+**Checklist**
+
+- [ ] The documentation has been updated.
+- [ ] If the PR solves a specific issue, it is set to be closed on merge.

.github/workflows/cmake.yml

@@ -0,0 +1,155 @@
+name: CMake
+
+on:
+  push:
+    branches:
+    - master
+    - try-github-actions
+    paths:
+    - .github/workflows/cmake.yml
+    - '**CMakeLists.txt'
+    - 'BLAS/**'
+    - 'CBLAS/**'
+    - 'CMAKE/**'
+    - 'INSTALL/**'
+    - 'LAPACKE/**'
+    - 'SRC/**'
+    - 'TESTING/**'
+    - '!**README'
+    - '!**Makefile'
+    - '!**md'
+  pull_request:
+    paths:
+    - .github/workflows/cmake.yml
+    - '**CMakeLists.txt'
+    - 'BLAS/**'
+    - 'CBLAS/**'
+    - 'CMAKE/**'
+    - 'INSTALL/**'
+    - 'LAPACKE/**'
+    - 'SRC/**'
+    - 'TESTING/**'
+    - '!**README'
+    - '!**Makefile'
+    - '!**md'
+
+env:
+  CFLAGS: "-Wall -pedantic"
+  # Customize the CMake build type here (Release, Debug, RelWithDebInfo, etc.)
+
+defaults:
+  run:
+    shell: bash
+
+jobs:
+
+  test-install-release:
+    # Use GNU compilers
+  
+    # The CMake configure and build commands are platform agnostic and should work equally
+    # well on Windows or Mac.  You can convert this to a matrix build if you need
+    # cross-platform coverage.
+    # See: https://docs.github.com/en/free-pro-team@latest/actions/learn-github-actions/managing-complex-workflows#using-a-build-matrix
+    runs-on: ${{ matrix.os }}
+
+    env:
+      BUILD_TYPE: Release
+      FFLAGS: ${{ matrix.fflags }}
+
+    strategy:
+      fail-fast: true
+      matrix:
+        os: [ macos-latest, ubuntu-latest ]
+        fflags: [
+          "-Wall -Wno-unused-dummy-argument -Wno-unused-variable -Wno-unused-label -Werror=conversion -fimplicit-none -frecursive -fcheck=all",
+          "-Wall -Wno-unused-dummy-argument -Wno-unused-variable -Wno-unused-label -Werror=conversion -fimplicit-none -frecursive -fcheck=all -fopenmp" ]
+    
+    steps:
+    
+    - name: Checkout LAPACK
+      uses: actions/checkout@v2
+
+    - name: Use GCC-11 on MacOS
+      if: ${{ matrix.os == 'macos-latest' }}
+      run: >
+        cmake -B build
+        -D CMAKE_C_COMPILER="gcc-11"
+        -D CMAKE_Fortran_COMPILER="gfortran-11"
+
+    # - name: Use Unix Makefiles on Windows
+    #   if: ${{ matrix.os == 'windows-latest' }}
+    #   run: >
+    #     cmake -B build
+    #     -G "Unix Makefiles"
+    #     -D CMAKE_C_FLAGS="${{env.CFLAGS}} -Wl,--stack=1000000000"
+
+    - name: Configure CMake
+      # Configure CMake in a 'build' subdirectory. `CMAKE_BUILD_TYPE` is only required if you are using a single-configuration generator such as make.
+      # See https://cmake.org/cmake/help/latest/variable/CMAKE_BUILD_TYPE.html?highlight=cmake_build_type
+      run: >
+        cmake -B build
+        -D CMAKE_BUILD_TYPE=${{env.BUILD_TYPE}}
+        -D CMAKE_INSTALL_PREFIX=${{github.workspace}}/lapack_install
+        -D CBLAS:BOOL=ON
+        -D LAPACKE:BOOL=ON
+        -D BUILD_TESTING:BOOL=ON
+        -D LAPACKE_WITH_TMG:BOOL=ON
+        -D BUILD_SHARED_LIBS:BOOL=ON
+
+    - name: Build
+      working-directory: ${{github.workspace}}/build
+      # Execute tests defined by the CMake configuration.  
+      # See https://cmake.org/cmake/help/latest/manual/ctest.1.html for more detail
+      run: |
+        ctest -D ExperimentalStart
+        ctest -D ExperimentalConfigure
+        ctest -D ExperimentalBuild -j2
+
+    - name: Test with OpenMP
+      working-directory: ${{github.workspace}}/build
+      if: ${{ contains( matrix.fflags, 'openmp' ) }}
+      run: |
+        ctest -D ExperimentalTest --schedule-random -j1 --output-on-failure --timeout 100
+        ctest -D ExperimentalSubmit
+
+    - name: Test
+      working-directory: ${{github.workspace}}/build
+      if: ${{ !contains( matrix.fflags, 'openmp' ) }}
+      run: |
+        ctest -D ExperimentalTest --schedule-random -j2 --output-on-failure --timeout 100
+        ctest -D ExperimentalSubmit
+
+    - name: Install
+      run: cmake --build build --target install -j2
+
+  coverage:
+    runs-on: ubuntu-latest 
+    env:
+      BUILD_TYPE: Coverage
+      FFLAGS: "-fopenmp"
+    steps:     
+    
+    - name: Checkout LAPACK
+      uses: actions/checkout@v2
+
+    - name: Configure CMake
+      # Configure CMake in a 'build' subdirectory. `CMAKE_BUILD_TYPE` is only required if you are using a single-configuration generator such as make.
+      # See https://cmake.org/cmake/help/latest/variable/CMAKE_BUILD_TYPE.html?highlight=cmake_build_type
+      run: >
+        cmake -B build
+        -D CMAKE_BUILD_TYPE=${{env.BUILD_TYPE}}
+        -D CMAKE_INSTALL_PREFIX=${{github.workspace}}/lapack_install
+        -D CBLAS:BOOL=ON
+        -D LAPACKE:BOOL=ON
+        -D BUILD_TESTING:BOOL=ON
+        -D LAPACKE_WITH_TMG:BOOL=ON
+        -D BUILD_SHARED_LIBS:BOOL=ON
+
+    - name: Install
+      run: cmake --build build --target install -j2
+
+    - name: Coverage
+      run: |
+        echo "Coverage"
+        cmake --build build --target coverage
+        bash <(curl -s https://codecov.io/bash) -X gcov

.github/workflows/makefile.yml

@@ -0,0 +1,95 @@
+name: Makefile
+
+on:
+  push:
+    branches:
+    - master
+    - try-github-actions
+    paths:
+    - .github/workflows/makefile.yml
+    - '**Makefile'
+    - 'BLAS/**'
+    - 'CBLAS/**'
+    - 'INSTALL/**'
+    - 'LAPACKE/**'
+    - 'SRC/**'
+    - 'TESTING/**'
+    - '!**README'
+    - '!**CMakeLists.txt'
+    - '!**md'
+  pull_request:
+    paths:
+    - .github/workflows/makefile.yml
+    - '**Makefile'
+    - 'BLAS/**'
+    - 'CBLAS/**'
+    - 'INSTALL/**'
+    - 'LAPACKE/**'
+    - 'SRC/**'
+    - 'TESTING/**'
+    - '!**README'
+    - '!**CMakeLists.txt'
+    - '!**md'
+
+env:
+  CC: "gcc"
+  FC: "gfortran"
+  CFLAGS: "-O3 -flto -Wall -pedantic-errors"
+  FFLAGS: "-O2 -flto -Wall -Werror=conversion -pedantic -fimplicit-none -frecursive -fopenmp -fcheck=all"
+  FFLAGS_NOOPT: "-O0 -flto -Wall -fimplicit-none -frecursive -fopenmp -fcheck=all"
+  LDFLAGS: ""
+  AR: "ar"
+  ARFLAGS: "cr"
+  RANLIB: "ranlib"
+
+defaults:
+  run:
+    shell: bash
+
+jobs:
+
+  install-ubuntu:
+    runs-on: ubuntu-latest
+    steps:
+    - name: Checkout LAPACK
+      uses: actions/checkout@v2
+    - name: Set configurations
+      run: |
+        echo "SHELL = /bin/sh" >> make.inc
+        echo "FFLAGS_DRV = ${{env.FFLAGS}}" >> make.inc
+        echo "TIMER = INT_ETIME" >> make.inc
+        echo "BLASLIB = ${{github.workspace}}/librefblas.a" >> make.inc
+        echo "CBLASLIB = ${{github.workspace}}/libcblas.a" >> make.inc
+        echo "LAPACKLIB = ${{github.workspace}}/liblapack.a" >> make.inc
+        echo "TMGLIB = ${{github.workspace}}/libtmglib.a" >> make.inc
+        echo "LAPACKELIB = ${{github.workspace}}/liblapacke.a" >> make.inc
+        echo "DOCSDIR = ${{github.workspace}}/DOCS" >> make.inc
+    - name: Install
+      run: |
+        make -s -j2 all
+        make -j2 lapack_install
+
+  install-macos:
+    runs-on: macos-latest
+    steps:
+    - name: Checkout LAPACK
+      uses: actions/checkout@v2
+    - name: Set configurations
+      run: |
+        echo "SHELL = /bin/sh" >> make.inc
+        echo "FFLAGS_DRV = ${{env.FFLAGS}}" >> make.inc
+        echo "TIMER = INT_ETIME" >> make.inc
+        echo "BLASLIB = ${{github.workspace}}/librefblas.a" >> make.inc
+        echo "CBLASLIB = ${{github.workspace}}/libcblas.a" >> make.inc
+        echo "LAPACKLIB = ${{github.workspace}}/liblapack.a" >> make.inc
+        echo "TMGLIB = ${{github.workspace}}/libtmglib.a" >> make.inc
+        echo "LAPACKELIB = ${{github.workspace}}/liblapacke.a" >> make.inc
+        echo "DOCSDIR = ${{github.workspace}}/DOCS" >> make.inc
+    - name: Alias for GCC compilers
+      run: |
+        sudo ln -s $(which gcc-11) /usr/local/bin/gcc
+        sudo ln -s $(which gfortran-11) /usr/local/bin/gfortran
+    - name: Install
+      run: |
+        make -s -j2 all
+        make -j2 lapack_install

.gitignore

@@ -27,6 +27,7 @@ TESTING/LIN/xlintst*
 TESTING/EIG/xeigtst*
 TESTING/*.out
 TESTING/*.txt
+!TESTING/CMakeLists.txt
 TESTING/x*
 
 # LAPACKE example

.travis.yml

@@ -14,24 +14,37 @@ addons:
 matrix:
   include:
   - os: linux
+    name: "CMake Release Test on Linux"
     env: CMAKE_BUILD_TYPE=Release
   - os: linux
+    name: "Makefile Test on Linux"
+    script:
+    - rm -f make.inc
+    - cp make.inc.example make.inc
+    - make FFLAGS="-fimplicit-none -frecursive -fcheck=all" -s -j2 all
+    - make -j2 lapack_install
+  - os: linux
+    name: "CMake Coverage Test on Linux"
     env: CMAKE_BUILD_TYPE=Coverage
   - os: osx
+    name: "CMake Release Test on macOS Big Sur"
+    osx_image: xcode12.3
     env: CMAKE_BUILD_TYPE=Release
-    before_install:
-    - brew update > /dev/null
-    - brew upgrade gcc > /dev/null
   - os: osx
-    env: CMAKE_BUILD_TYPE=Coverage
-    before_install:
-    - brew update > /dev/null
-    - brew upgrade gcc > /dev/null
+    osx_image: xcode12.3
+    name: "Makefile Test on on macOS Big Sur"
+    script:
+    - rm -f make.inc
+    - cp make.inc.example make.inc
+    - make FFLAGS="-fimplicit-none -frecursive -fcheck=all" -s -j2 all
+    - make -j2 lapack_install
 
-script:
+before_script:
   - export PR=https://api.github.com/repos/$TRAVIS_REPO_SLUG/pulls/$TRAVIS_PULL_REQUEST
   - export BRANCH=$(if [ "$TRAVIS_PULL_REQUEST" == "false" ]; then echo $TRAVIS_BRANCH; else echo `curl -s $PR | jq -r .head.ref`; fi)
   - echo "TRAVIS_BRANCH=$TRAVIS_BRANCH, PR=$PR, BRANCH=$BRANCH"
+
+script:
   - export SRC_DIR=$(pwd)
   - export BLD_DIR=${SRC_DIR}/lapack-travis-bld
   - export INST_DIR=${SRC_DIR}/../lapack-travis-install
@@ -46,6 +59,9 @@ script:
     -DLAPACKE:BOOL=ON
     -DBUILD_TESTING=ON
     -DLAPACKE_WITH_TMG:BOOL=ON
+    -DBUILD_SHARED_LIBS:BOOL=ON
+    -DCMAKE_Fortran_FLAGS:STRING="-fimplicit-none -frecursive -fcheck=all"
+    -DCMAKE_C_FLAGS=${CMAKE_C_FLAGS}
     ${SRC_DIR}
   - ctest -D ExperimentalStart
   - ctest -D ExperimentalConfigure

BLAS/SRC/CMakeLists.txt

@@ -28,21 +28,32 @@
 #---------------------------------------------------------
 #  Level 1 BLAS
 #---------------------------------------------------------
-set(SBLAS1 isamax.f sasum.f saxpy.f scopy.f sdot.f snrm2.f
-	srot.f srotg.f sscal.f sswap.f sdsdot.f srotmg.f srotm.f)
 
-set(CBLAS1 scabs1.f scasum.f scnrm2.f icamax.f caxpy.f ccopy.f
-	cdotc.f cdotu.f csscal.f crotg.f cscal.f cswap.f csrot.f)
+set(SBLAS1 isamax.f sasum.f saxpy.f scopy.f sdot.f snrm2.f90
+	srot.f srotg.f90 sscal.f sswap.f sdsdot.f srotmg.f srotm.f)
 
-set(DBLAS1 idamax.f dasum.f daxpy.f dcopy.f ddot.f dnrm2.f
-	drot.f drotg.f dscal.f dsdot.f dswap.f drotmg.f drotm.f)
+set(CBLAS1 scabs1.f scasum.f scnrm2.f90 icamax.f caxpy.f ccopy.f
+	cdotc.f cdotu.f csscal.f crotg.f90 cscal.f cswap.f csrot.f)
 
-set(ZBLAS1 dcabs1.f dzasum.f dznrm2.f izamax.f zaxpy.f zcopy.f
-	zdotc.f zdotu.f zdscal.f zrotg.f zscal.f zswap.f zdrot.f)
+set(DBLAS1 idamax.f dasum.f daxpy.f dcopy.f ddot.f dnrm2.f90
+	drot.f drotg.f90 dscal.f dsdot.f dswap.f drotmg.f drotm.f)
 
-set(CB1AUX isamax.f sasum.f saxpy.f scopy.f snrm2.f sscal.f)
+set(DB1AUX sscal.f isamax.f)
 
-set(ZB1AUX idamax.f dasum.f daxpy.f dcopy.f dnrm2.f dscal.f)
+set(ZBLAS1 dcabs1.f dzasum.f dznrm2.f90 izamax.f zaxpy.f zcopy.f
+	zdotc.f zdotu.f zdscal.f zrotg.f90 zscal.f zswap.f zdrot.f)
+
+set(CB1AUX
+    isamax.f idamax.f
+    sasum.f saxpy.f scopy.f sdot.f sgemm.f sgemv.f snrm2.f90 srot.f sscal.f
+    sswap.f)
+
+set(ZB1AUX
+    icamax.f idamax.f
+    cgemm.f cherk.f cscal.f ctrsm.f
+    dasum.f daxpy.f dcopy.f ddot.f dgemm.f dgemv.f dnrm2.f90 drot.f dscal.f
+    dswap.f
+    scabs1.f)
 
 #---------------------------------------------------------------------
 #  Auxiliary routines needed by both the Level 2 and Level 3 BLAS
@@ -87,7 +98,8 @@ if(BUILD_SINGLE)
   list(APPEND SOURCES ${SBLAS1} ${ALLBLAS} ${SBLAS2} ${SBLAS3})
 endif()
 if(BUILD_DOUBLE)
-  list(APPEND SOURCES ${DBLAS1} ${ALLBLAS} ${DBLAS2} ${DBLAS3})
+  list(APPEND SOURCES
+       ${DBLAS1} ${DB1AUX} ${ALLBLAS} ${DBLAS2} ${DBLAS3} ${SBLAS3})
 endif()
 if(BUILD_COMPLEX)
   list(APPEND SOURCES ${CBLAS1} ${CB1AUX} ${ALLBLAS} ${CBLAS2} ${CBLAS3})
@@ -104,3 +116,7 @@ set_target_properties(
   SOVERSION ${LAPACK_MAJOR_VERSION}
   )
 lapack_install_library(${BLASLIB})
+
+if( TEST_FORTRAN_COMPILER )
+  add_dependencies( ${BLASLIB} run_test_zcomplexabs run_test_zcomplexdiv run_test_zcomplexmult run_test_zminMax )
+endif()

BLAS/SRC/Makefile

@@ -56,6 +56,12 @@
 TOPSRCDIR = ../..
 include $(TOPSRCDIR)/make.inc
 
+.SUFFIXES: .F .f90 .o
+.F.o:
+	$(FC) $(FFLAGS) -c -o $@ $<
+.f90.o:
+	$(FC) $(FFLAGS) -c -o $@ $<
+
 .PHONY: all
 all: $(BLASLIB)
 

BLAS/SRC/caxpy.f

@@ -72,8 +72,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2017
-*
 *> \ingroup complex_blas_level1
 *
 *> \par Further Details:
@@ -88,10 +86,9 @@
 *  =====================================================================
       SUBROUTINE CAXPY(N,CA,CX,INCX,CY,INCY)
 *
-*  -- Reference BLAS level1 routine (version 3.8.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
 *
 *     .. Scalar Arguments ..
       COMPLEX CA
@@ -136,4 +133,7 @@
       END IF
 *
       RETURN
+*
+*     End of CAXPY
+*
       END

BLAS/SRC/ccopy.f

@@ -65,8 +65,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2017
-*
 *> \ingroup complex_blas_level1
 *
 *> \par Further Details:
@@ -81,10 +79,9 @@
 *  =====================================================================
       SUBROUTINE CCOPY(N,CX,INCX,CY,INCY)
 *
-*  -- Reference BLAS level1 routine (version 3.8.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,INCY,N
@@ -122,4 +119,7 @@
          END DO
       END IF
       RETURN
+*
+*     End of CCOPY
+*
       END

BLAS/SRC/cdotc.f

@@ -67,8 +67,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2017
-*
 *> \ingroup complex_blas_level1
 *
 *> \par Further Details:
@@ -83,10 +81,9 @@
 *  =====================================================================
       COMPLEX FUNCTION CDOTC(N,CX,INCX,CY,INCY)
 *
-*  -- Reference BLAS level1 routine (version 3.8.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,INCY,N
@@ -131,4 +128,7 @@
       END IF
       CDOTC = CTEMP
       RETURN
+*
+*     End of CDOTC
+*
       END

BLAS/SRC/cdotu.f

@@ -67,8 +67,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2017
-*
 *> \ingroup complex_blas_level1
 *
 *> \par Further Details:
@@ -83,10 +81,9 @@
 *  =====================================================================
       COMPLEX FUNCTION CDOTU(N,CX,INCX,CY,INCY)
 *
-*  -- Reference BLAS level1 routine (version 3.8.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,INCY,N
@@ -128,4 +125,7 @@
       END IF
       CDOTU = CTEMP
       RETURN
+*
+*     End of CDOTU
+*
       END

BLAS/SRC/cgbmv.f

@@ -165,8 +165,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup complex_blas_level2
 *
 *> \par Further Details:
@@ -187,10 +185,9 @@
 *  =====================================================================
       SUBROUTINE CGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       COMPLEX ALPHA,BETA
@@ -385,6 +382,6 @@
 *
       RETURN
 *
-*     End of CGBMV .
+*     End of CGBMV
 *
       END

BLAS/SRC/cgemm.f

@@ -166,8 +166,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup complex_blas_level3
 *
 *> \par Further Details:
@@ -187,10 +185,9 @@
 *  =====================================================================
       SUBROUTINE CGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
 *
-*  -- Reference BLAS level3 routine (version 3.7.0) --
+*  -- Reference BLAS level3 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       COMPLEX ALPHA,BETA
@@ -475,6 +472,6 @@
 *
       RETURN
 *
-*     End of CGEMM .
+*     End of CGEMM
 *
       END

BLAS/SRC/cgemv.f

@@ -136,8 +136,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup complex_blas_level2
 *
 *> \par Further Details:
@@ -158,10 +156,9 @@
 *  =====================================================================
       SUBROUTINE CGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       COMPLEX ALPHA,BETA
@@ -345,6 +342,6 @@
 *
       RETURN
 *
-*     End of CGEMV .
+*     End of CGEMV
 *
       END

BLAS/SRC/cgerc.f

@@ -109,8 +109,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup complex_blas_level2
 *
 *> \par Further Details:
@@ -130,10 +128,9 @@
 *  =====================================================================
       SUBROUTINE CGERC(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       COMPLEX ALPHA
@@ -222,6 +219,6 @@
 *
       RETURN
 *
-*     End of CGERC .
+*     End of CGERC
 *
       END

BLAS/SRC/cgeru.f

@@ -109,8 +109,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup complex_blas_level2
 *
 *> \par Further Details:
@@ -130,10 +128,9 @@
 *  =====================================================================
       SUBROUTINE CGERU(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       COMPLEX ALPHA
@@ -222,6 +219,6 @@
 *
       RETURN
 *
-*     End of CGERU .
+*     End of CGERU
 *
       END

BLAS/SRC/chbmv.f

@@ -165,8 +165,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup complex_blas_level2
 *
 *> \par Further Details:
@@ -187,10 +185,9 @@
 *  =====================================================================
       SUBROUTINE CHBMV(UPLO,N,K,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       COMPLEX ALPHA,BETA
@@ -375,6 +372,6 @@
 *
       RETURN
 *
-*     End of CHBMV .
+*     End of CHBMV
 *
       END

BLAS/SRC/chemm.f

@@ -170,8 +170,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup complex_blas_level3
 *
 *> \par Further Details:
@@ -191,10 +189,9 @@
 *  =====================================================================
       SUBROUTINE CHEMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
 *
-*  -- Reference BLAS level3 routine (version 3.7.0) --
+*  -- Reference BLAS level3 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       COMPLEX ALPHA,BETA
@@ -366,6 +363,6 @@
 *
       RETURN
 *
-*     End of CHEMM .
+*     End of CHEMM
 *
       END

BLAS/SRC/chemv.f

@@ -132,8 +132,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup complex_blas_level2
 *
 *> \par Further Details:
@@ -154,10 +152,9 @@
 *  =====================================================================
       SUBROUTINE CHEMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       COMPLEX ALPHA,BETA
@@ -332,6 +329,6 @@
 *
       RETURN
 *
-*     End of CHEMV .
+*     End of CHEMV
 *
       END

BLAS/SRC/cher.f

@@ -114,8 +114,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup complex_blas_level2
 *
 *> \par Further Details:
@@ -135,10 +133,9 @@
 *  =====================================================================
       SUBROUTINE CHER(UPLO,N,ALPHA,X,INCX,A,LDA)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       REAL ALPHA
@@ -273,6 +270,6 @@
 *
       RETURN
 *
-*     End of CHER  .
+*     End of CHER
 *
       END

BLAS/SRC/cher2.f

@@ -129,8 +129,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup complex_blas_level2
 *
 *> \par Further Details:
@@ -150,10 +148,9 @@
 *  =====================================================================
       SUBROUTINE CHER2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       COMPLEX ALPHA
@@ -312,6 +309,6 @@
 *
       RETURN
 *
-*     End of CHER2 .
+*     End of CHER2
 *
       END

BLAS/SRC/cher2k.f

@@ -173,8 +173,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup complex_blas_level3
 *
 *> \par Further Details:
@@ -197,10 +195,9 @@
 *  =====================================================================
       SUBROUTINE CHER2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
 *
-*  -- Reference BLAS level3 routine (version 3.7.0) --
+*  -- Reference BLAS level3 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       COMPLEX ALPHA
@@ -437,6 +434,6 @@
 *
       RETURN
 *
-*     End of CHER2K.
+*     End of CHER2K
 *
       END

BLAS/SRC/cherk.f

@@ -149,8 +149,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup complex_blas_level3
 *
 *> \par Further Details:
@@ -173,10 +171,9 @@
 *  =====================================================================
       SUBROUTINE CHERK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC)
 *
-*  -- Reference BLAS level3 routine (version 3.7.0) --
+*  -- Reference BLAS level3 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       REAL ALPHA,BETA
@@ -355,7 +352,7 @@
   200             CONTINUE
                   RTEMP = ZERO
                   DO 210 L = 1,K
-                      RTEMP = RTEMP + CONJG(A(L,J))*A(L,J)
+                      RTEMP = RTEMP + REAL(CONJG(A(L,J))*A(L,J))
   210             CONTINUE
                   IF (BETA.EQ.ZERO) THEN
                       C(J,J) = ALPHA*RTEMP
@@ -367,7 +364,7 @@
               DO 260 J = 1,N
                   RTEMP = ZERO
                   DO 230 L = 1,K
-                      RTEMP = RTEMP + CONJG(A(L,J))*A(L,J)
+                      RTEMP = RTEMP + REAL(CONJG(A(L,J))*A(L,J))
   230             CONTINUE
                   IF (BETA.EQ.ZERO) THEN
                       C(J,J) = ALPHA*RTEMP
@@ -391,6 +388,6 @@
 *
       RETURN
 *
-*     End of CHERK .
+*     End of CHERK
 *
       END

BLAS/SRC/chpmv.f

@@ -127,8 +127,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup complex_blas_level2
 *
 *> \par Further Details:
@@ -149,10 +147,9 @@
 *  =====================================================================
       SUBROUTINE CHPMV(UPLO,N,ALPHA,AP,X,INCX,BETA,Y,INCY)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       COMPLEX ALPHA,BETA
@@ -333,6 +330,6 @@
 *
       RETURN
 *
-*     End of CHPMV .
+*     End of CHPMV
 *
       END

BLAS/SRC/chpr.f

@@ -109,8 +109,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup complex_blas_level2
 *
 *> \par Further Details:
@@ -130,10 +128,9 @@
 *  =====================================================================
       SUBROUTINE CHPR(UPLO,N,ALPHA,X,INCX,AP)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       REAL ALPHA
@@ -274,6 +271,6 @@
 *
       RETURN
 *
-*     End of CHPR  .
+*     End of CHPR
 *
       END

BLAS/SRC/chpr2.f

@@ -124,8 +124,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup complex_blas_level2
 *
 *> \par Further Details:
@@ -145,10 +143,9 @@
 *  =====================================================================
       SUBROUTINE CHPR2(UPLO,N,ALPHA,X,INCX,Y,INCY,AP)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       COMPLEX ALPHA
@@ -313,6 +310,6 @@
 *
       RETURN
 *
-*     End of CHPR2 .
+*     End of CHPR2
 *
       END

BLAS/SRC/crotg.f

@@ -1,97 +0,0 @@
-*> \brief \b CROTG
-*
-*  =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-*            http://www.netlib.org/lapack/explore-html/
-*
-*  Definition:
-*  ===========
-*
-*       SUBROUTINE CROTG(CA,CB,C,S)
-*
-*       .. Scalar Arguments ..
-*       COMPLEX CA,CB,S
-*       REAL C
-*       ..
-*
-*
-*> \par Purpose:
-*  =============
-*>
-*> \verbatim
-*>
-*> CROTG determines a complex Givens rotation.
-*> \endverbatim
-*
-*  Arguments:
-*  ==========
-*
-*> \param[in,out] CA
-*> \verbatim
-*>          CA is COMPLEX
-*> \endverbatim
-*>
-*> \param[in] CB
-*> \verbatim
-*>          CB is COMPLEX
-*> \endverbatim
-*>
-*> \param[out] C
-*> \verbatim
-*>          C is REAL
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*>          S is COMPLEX
-*> \endverbatim
-*
-*  Authors:
-*  ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2017
-*
-*> \ingroup complex_blas_level1
-*
-*  =====================================================================
-      SUBROUTINE CROTG(CA,CB,C,S)
-*
-*  -- Reference BLAS level1 routine (version 3.8.0) --
-*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
-*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
-*
-*     .. Scalar Arguments ..
-      COMPLEX CA,CB,S
-      REAL C
-*     ..
-*
-*  =====================================================================
-*
-*     .. Local Scalars ..
-      COMPLEX ALPHA
-      REAL NORM,SCALE
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC CABS,CONJG,SQRT
-*     ..
-      IF (CABS(CA).EQ.0.) THEN
-         C = 0.
-         S = (1.,0.)
-         CA = CB
-      ELSE
-         SCALE = CABS(CA) + CABS(CB)
-         NORM = SCALE*SQRT((CABS(CA/SCALE))**2+ (CABS(CB/SCALE))**2)
-         ALPHA = CA/CABS(CA)
-         C = CABS(CA)/NORM
-         S = ALPHA*CONJG(CB)/NORM
-         CA = ALPHA*NORM
-      END IF
-      RETURN
-      END

BLAS/SRC/crotg.f90

@@ -0,0 +1,277 @@
+!> \brief \b CROTG  generates a Givens rotation with real cosine and complex sine.
+!
+!  =========== DOCUMENTATION ===========
+!
+! Online html documentation available at
+!            http://www.netlib.org/lapack/explore-html/
+!
+!  Definition:
+!  ===========
+!
+!  CROTG constructs a plane rotation
+!     [  c         s ] [ a ] = [ r ]
+!     [ -conjg(s)  c ] [ b ]   [ 0 ]
+!  where c is real, s is complex, and c**2 + conjg(s)*s = 1.
+!
+!> \par Purpose:
+!  =============
+!>
+!> \verbatim
+!>
+!> The computation uses the formulas
+!>    |x| = sqrt( Re(x)**2 + Im(x)**2 )
+!>    sgn(x) = x / |x|  if x /= 0
+!>           = 1        if x  = 0
+!>    c = |a| / sqrt(|a|**2 + |b|**2)
+!>    s = sgn(a) * conjg(b) / sqrt(|a|**2 + |b|**2)
+!>    r = sgn(a)*sqrt(|a|**2 + |b|**2)
+!> When a and b are real and r /= 0, the formulas simplify to
+!>    c = a / r
+!>    s = b / r
+!> the same as in SROTG when |a| > |b|.  When |b| >= |a|, the
+!> sign of c and s will be different from those computed by SROTG
+!> if the signs of a and b are not the same.
+!>
+!> \endverbatim
+!
+!  Arguments:
+!  ==========
+!
+!> \param[in,out] A
+!> \verbatim
+!>          A is COMPLEX
+!>          On entry, the scalar a.
+!>          On exit, the scalar r.
+!> \endverbatim
+!>
+!> \param[in] B
+!> \verbatim
+!>          B is COMPLEX
+!>          The scalar b.
+!> \endverbatim
+!>
+!> \param[out] C
+!> \verbatim
+!>          C is REAL
+!>          The scalar c.
+!> \endverbatim
+!>
+!> \param[out] S
+!> \verbatim
+!>          S is COMPLEX
+!>          The scalar s.
+!> \endverbatim
+!
+!  Authors:
+!  ========
+!
+!> \author Weslley Pereira, University of Colorado Denver, USA
+!
+!> \date December 2021
+!
+!> \ingroup single_blas_level1
+!
+!> \par Further Details:
+!  =====================
+!>
+!> \verbatim
+!>
+!> Based on the algorithm from
+!>
+!>  Anderson E. (2017)
+!>  Algorithm 978: Safe Scaling in the Level 1 BLAS
+!>  ACM Trans Math Softw 44:1--28
+!>  https://doi.org/10.1145/3061665
+!>
+!> \endverbatim
+!
+!  =====================================================================
+subroutine CROTG( a, b, c, s )
+   integer, parameter :: wp = kind(1.e0)
+!
+!  -- Reference BLAS level1 routine --
+!  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
+!  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+!
+!  .. Constants ..
+   real(wp), parameter :: zero = 0.0_wp
+   real(wp), parameter :: one  = 1.0_wp
+   complex(wp), parameter :: czero  = 0.0_wp
+!  ..
+!  .. Scaling constants ..
+   real(wp), parameter :: safmin = real(radix(0._wp),wp)**max( &
+      minexponent(0._wp)-1, &
+      1-maxexponent(0._wp) &
+   )
+   real(wp), parameter :: safmax = real(radix(0._wp),wp)**max( &
+      1-minexponent(0._wp), &
+      maxexponent(0._wp)-1 &
+   )
+   real(wp), parameter :: rtmin = sqrt( safmin )
+!  ..
+!  .. Scalar Arguments ..
+   real(wp) :: c
+   complex(wp) :: a, b, s
+!  ..
+!  .. Local Scalars ..
+   real(wp) :: d, f1, f2, g1, g2, h2, u, v, w, rtmax
+   complex(wp) :: f, fs, g, gs, r, t
+!  ..
+!  .. Intrinsic Functions ..
+   intrinsic :: abs, aimag, conjg, max, min, real, sqrt
+!  ..
+!  .. Statement Functions ..
+   real(wp) :: ABSSQ
+!  ..
+!  .. Statement Function definitions ..
+   ABSSQ( t ) = real( t )**2 + aimag( t )**2
+!  ..
+!  .. Executable Statements ..
+!
+   f = a
+   g = b
+   if( g == czero ) then
+      c = one
+      s = czero
+      r = f
+   else if( f == czero ) then
+      c = zero
+      if( real(g) == zero ) then
+         r = abs(aimag(g))
+         s = conjg( g ) / r
+      elseif( aimag(g) == zero ) then
+         r = abs(real(g))
+         s = conjg( g ) / r
+      else
+         g1 = max( abs(real(g)), abs(aimag(g)) )
+         rtmax = sqrt( safmax/2 )
+         if( g1 > rtmin .and. g1 < rtmax ) then
+!
+!        Use unscaled algorithm
+!
+!           The following two lines can be replaced by `d = abs( g )`.
+!           This algorithm do not use the intrinsic complex abs.
+            g2 = ABSSQ( g )
+            d = sqrt( g2 )
+            s = conjg( g ) / d
+            r = d
+         else
+!
+!        Use scaled algorithm
+!
+            u = min( safmax, max( safmin, g1 ) )
+            gs = g / u
+!           The following two lines can be replaced by `d = abs( gs )`.
+!           This algorithm do not use the intrinsic complex abs.
+            g2 = ABSSQ( gs )
+            d = sqrt( g2 )
+            s = conjg( gs ) / d
+            r = d*u
+         end if
+      end if
+   else
+      f1 = max( abs(real(f)), abs(aimag(f)) )
+      g1 = max( abs(real(g)), abs(aimag(g)) )
+      rtmax = sqrt( safmax/4 )
+      if( f1 > rtmin .and. f1 < rtmax .and. &
+          g1 > rtmin .and. g1 < rtmax ) then
+!
+!        Use unscaled algorithm
+!
+         f2 = ABSSQ( f )
+         g2 = ABSSQ( g )
+         h2 = f2 + g2
+         ! safmin <= f2 <= h2 <= safmax 
+         if( f2 >= h2 * safmin ) then
+            ! safmin <= f2/h2 <= 1, and h2/f2 is finite
+            c = sqrt( f2 / h2 )
+            r = f / c
+            rtmax = rtmax * 2
+            if( f2 > rtmin .and. h2 < rtmax ) then
+               ! safmin <= sqrt( f2*h2 ) <= safmax
+               s = conjg( g ) * ( f / sqrt( f2*h2 ) )
+            else
+               s = conjg( g ) * ( r / h2 )
+            end if
+         else
+            ! f2/h2 <= safmin may be subnormal, and h2/f2 may overflow.
+            ! Moreover,
+            !  safmin <= f2*f2 * safmax < f2 * h2 < h2*h2 * safmin <= safmax,
+            !  sqrt(safmin) <= sqrt(f2 * h2) <= sqrt(safmax).
+            ! Also,
+            !  g2 >> f2, which means that h2 = g2.
+            d = sqrt( f2 * h2 )
+            c = f2 / d
+            if( c >= safmin ) then
+               r = f / c
+            else
+               ! f2 / sqrt(f2 * h2) < safmin, then
+               !  sqrt(safmin) <= f2 * sqrt(safmax) <= h2 / sqrt(f2 * h2) <= h2 * (safmin / f2) <= h2 <= safmax
+               r = f * ( h2 / d )
+            end if
+            s = conjg( g ) * ( f / d )
+         end if
+      else
+!
+!        Use scaled algorithm
+!
+         u = min( safmax, max( safmin, f1, g1 ) )
+         gs = g / u
+         g2 = ABSSQ( gs )
+         if( f1 / u < rtmin ) then
+!
+!           f is not well-scaled when scaled by g1.
+!           Use a different scaling for f.
+!
+            v = min( safmax, max( safmin, f1 ) )
+            w = v / u
+            fs = f / v
+            f2 = ABSSQ( fs )
+            h2 = f2*w**2 + g2
+         else
+!
+!           Otherwise use the same scaling for f and g.
+!
+            w = one
+            fs = f / u
+            f2 = ABSSQ( fs )
+            h2 = f2 + g2
+         end if
+         ! safmin <= f2 <= h2 <= safmax 
+         if( f2 >= h2 * safmin ) then
+            ! safmin <= f2/h2 <= 1, and h2/f2 is finite
+            c = sqrt( f2 / h2 )
+            r = fs / c
+            rtmax = rtmax * 2
+            if( f2 > rtmin .and. h2 < rtmax ) then
+               ! safmin <= sqrt( f2*h2 ) <= safmax
+               s = conjg( gs ) * ( fs / sqrt( f2*h2 ) )
+            else
+               s = conjg( gs ) * ( r / h2 )
+            end if
+         else
+            ! f2/h2 <= safmin may be subnormal, and h2/f2 may overflow.
+            ! Moreover,
+            !  safmin <= f2*f2 * safmax < f2 * h2 < h2*h2 * safmin <= safmax,
+            !  sqrt(safmin) <= sqrt(f2 * h2) <= sqrt(safmax).
+            ! Also,
+            !  g2 >> f2, which means that h2 = g2.
+            d = sqrt( f2 * h2 )
+            c = f2 / d
+            if( c >= safmin ) then
+               r = fs / c
+            else
+               ! f2 / sqrt(f2 * h2) < safmin, then
+               !  sqrt(safmin) <= f2 * sqrt(safmax) <= h2 / sqrt(f2 * h2) <= h2 * (safmin / f2) <= h2 <= safmax
+               r = fs * ( h2 / d )
+            end if
+            s = conjg( gs ) * ( fs / d )
+         end if
+         ! Rescale c and r
+         c = c * w
+         r = r * u
+      end if
+   end if
+   a = r
+   return
+end subroutine

BLAS/SRC/cscal.f

@@ -61,8 +61,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2017
-*
 *> \ingroup complex_blas_level1
 *
 *> \par Further Details:
@@ -78,10 +76,9 @@
 *  =====================================================================
       SUBROUTINE CSCAL(N,CA,CX,INCX)
 *
-*  -- Reference BLAS level1 routine (version 3.8.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
 *
 *     .. Scalar Arguments ..
       COMPLEX CA
@@ -96,7 +93,11 @@
 *     .. Local Scalars ..
       INTEGER I,NINCX
 *     ..
-      IF (N.LE.0 .OR. INCX.LE.0) RETURN
+*     .. Parameters ..
+      COMPLEX ONE
+      PARAMETER (ONE= (1.0E+0,0.0E+0))
+*     ..
+      IF (N.LE.0 .OR. INCX.LE.0 .OR. CA.EQ.ONE) RETURN
       IF (INCX.EQ.1) THEN
 *
 *        code for increment equal to 1
@@ -114,4 +115,7 @@
          END DO
       END IF
       RETURN
+*
+*     End of CSCAL
+*
       END

BLAS/SRC/csrot.f

@@ -91,17 +91,14 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup complex_blas_level1
 *
 *  =====================================================================
       SUBROUTINE CSROT( N, CX, INCX, CY, INCY, C, S )
 *
-*  -- Reference BLAS level1 routine (version 3.7.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       INTEGER           INCX, INCY, N
@@ -150,4 +147,7 @@
          END DO
       END IF
       RETURN
+*
+*     End of CSROT
+*
       END

BLAS/SRC/csscal.f

@@ -61,8 +61,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2017
-*
 *> \ingroup complex_blas_level1
 *
 *> \par Further Details:
@@ -78,10 +76,9 @@
 *  =====================================================================
       SUBROUTINE CSSCAL(N,SA,CX,INCX)
 *
-*  -- Reference BLAS level1 routine (version 3.8.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
 *
 *     .. Scalar Arguments ..
       REAL SA
@@ -96,10 +93,14 @@
 *     .. Local Scalars ..
       INTEGER I,NINCX
 *     ..
+*     .. Parameters ..
+      REAL ONE
+      PARAMETER (ONE=1.0E+0)
+*     ..
 *     .. Intrinsic Functions ..
       INTRINSIC AIMAG,CMPLX,REAL
 *     ..
-      IF (N.LE.0 .OR. INCX.LE.0) RETURN
+      IF (N.LE.0 .OR. INCX.LE.0 .OR. SA.EQ.ONE) RETURN
       IF (INCX.EQ.1) THEN
 *
 *        code for increment equal to 1
@@ -117,4 +118,7 @@
          END DO
       END IF
       RETURN
+*
+*     End of CSSCAL
+*
       END

BLAS/SRC/cswap.f

@@ -65,8 +65,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2017
-*
 *> \ingroup complex_blas_level1
 *
 *> \par Further Details:
@@ -81,10 +79,9 @@
 *  =====================================================================
       SUBROUTINE CSWAP(N,CX,INCX,CY,INCY)
 *
-*  -- Reference BLAS level1 routine (version 3.8.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,INCY,N
@@ -126,4 +123,7 @@
          END DO
       END IF
       RETURN
+*
+*     End of CSWAP
+*
       END

BLAS/SRC/csymm.f

@@ -168,8 +168,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup complex_blas_level3
 *
 *> \par Further Details:
@@ -189,10 +187,9 @@
 *  =====================================================================
       SUBROUTINE CSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
 *
-*  -- Reference BLAS level3 routine (version 3.7.0) --
+*  -- Reference BLAS level3 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       COMPLEX ALPHA,BETA
@@ -364,6 +361,6 @@
 *
       RETURN
 *
-*     End of CSYMM .
+*     End of CSYMM
 *
       END

BLAS/SRC/csyr2k.f

@@ -167,8 +167,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup complex_blas_level3
 *
 *> \par Further Details:
@@ -188,10 +186,9 @@
 *  =====================================================================
       SUBROUTINE CSYR2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
 *
-*  -- Reference BLAS level3 routine (version 3.7.0) --
+*  -- Reference BLAS level3 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       COMPLEX ALPHA,BETA
@@ -391,6 +388,6 @@
 *
       RETURN
 *
-*     End of CSYR2K.
+*     End of CSYR2K
 *
       END

BLAS/SRC/csyrk.f

@@ -146,8 +146,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup complex_blas_level3
 *
 *> \par Further Details:
@@ -167,10 +165,9 @@
 *  =====================================================================
       SUBROUTINE CSYRK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC)
 *
-*  -- Reference BLAS level3 routine (version 3.7.0) --
+*  -- Reference BLAS level3 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       COMPLEX ALPHA,BETA
@@ -358,6 +355,6 @@
 *
       RETURN
 *
-*     End of CSYRK .
+*     End of CSYRK
 *
       END

BLAS/SRC/ctbmv.f

@@ -164,8 +164,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup complex_blas_level2
 *
 *> \par Further Details:
@@ -186,10 +184,9 @@
 *  =====================================================================
       SUBROUTINE CTBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,K,LDA,N
@@ -424,6 +421,6 @@
 *
       RETURN
 *
-*     End of CTBMV .
+*     End of CTBMV
 *
       END

BLAS/SRC/ctbsv.f

@@ -168,8 +168,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup complex_blas_level2
 *
 *> \par Further Details:
@@ -189,10 +187,9 @@
 *  =====================================================================
       SUBROUTINE CTBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,K,LDA,N
@@ -427,6 +424,6 @@
 *
       RETURN
 *
-*     End of CTBSV .
+*     End of CTBSV
 *
       END

BLAS/SRC/ctpmv.f

@@ -120,8 +120,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup complex_blas_level2
 *
 *> \par Further Details:
@@ -142,10 +140,9 @@
 *  =====================================================================
       SUBROUTINE CTPMV(UPLO,TRANS,DIAG,N,AP,X,INCX)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,N
@@ -383,6 +380,6 @@
 *
       RETURN
 *
-*     End of CTPMV .
+*     End of CTPMV
 *
       END

BLAS/SRC/ctpsv.f

@@ -123,8 +123,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup complex_blas_level2
 *
 *> \par Further Details:
@@ -144,10 +142,9 @@
 *  =====================================================================
       SUBROUTINE CTPSV(UPLO,TRANS,DIAG,N,AP,X,INCX)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,N
@@ -385,6 +382,6 @@
 *
       RETURN
 *
-*     End of CTPSV .
+*     End of CTPSV
 *
       END

BLAS/SRC/ctrmm.f

@@ -156,8 +156,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup complex_blas_level3
 *
 *> \par Further Details:
@@ -177,10 +175,9 @@
 *  =====================================================================
       SUBROUTINE CTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
 *
-*  -- Reference BLAS level3 routine (version 3.7.0) --
+*  -- Reference BLAS level3 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       COMPLEX ALPHA
@@ -447,6 +444,6 @@
 *
       RETURN
 *
-*     End of CTRMM .
+*     End of CTRMM
 *
       END

BLAS/SRC/ctrmv.f

@@ -125,8 +125,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup complex_blas_level2
 *
 *> \par Further Details:
@@ -147,10 +145,9 @@
 *  =====================================================================
       SUBROUTINE CTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,LDA,N
@@ -368,6 +365,6 @@
 *
       RETURN
 *
-*     End of CTRMV .
+*     End of CTRMV
 *
       END

BLAS/SRC/ctrsm.f

@@ -159,8 +159,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup complex_blas_level3
 *
 *> \par Further Details:
@@ -180,10 +178,9 @@
 *  =====================================================================
       SUBROUTINE CTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
 *
-*  -- Reference BLAS level3 routine (version 3.7.0) --
+*  -- Reference BLAS level3 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       COMPLEX ALPHA
@@ -472,6 +469,6 @@
 *
       RETURN
 *
-*     End of CTRSM .
+*     End of CTRSM
 *
       END

BLAS/SRC/ctrsv.f

@@ -128,8 +128,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup complex_blas_level2
 *
 *> \par Further Details:
@@ -149,10 +147,9 @@
 *  =====================================================================
       SUBROUTINE CTRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,LDA,N
@@ -370,6 +367,6 @@
 *
       RETURN
 *
-*     End of CTRSV .
+*     End of CTRSV
 *
       END

BLAS/SRC/dasum.f

@@ -54,8 +54,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2017
-*
 *> \ingroup double_blas_level1
 *
 *> \par Further Details:
@@ -71,10 +69,9 @@
 *  =====================================================================
       DOUBLE PRECISION FUNCTION DASUM(N,DX,INCX)
 *
-*  -- Reference BLAS level1 routine (version 3.8.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,N
@@ -128,4 +125,7 @@
       END IF
       DASUM = DTEMP
       RETURN
+*
+*     End of DASUM
+*
       END

BLAS/SRC/daxpy.f

@@ -73,8 +73,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2017
-*
 *> \ingroup double_blas_level1
 *
 *> \par Further Details:
@@ -89,10 +87,9 @@
 *  =====================================================================
       SUBROUTINE DAXPY(N,DA,DX,INCX,DY,INCY)
 *
-*  -- Reference BLAS level1 routine (version 3.8.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
 *
 *     .. Scalar Arguments ..
       DOUBLE PRECISION DA
@@ -149,4 +146,7 @@
          END DO
       END IF
       RETURN
+*
+*     End of DAXPY
+*
       END

BLAS/SRC/dcabs1.f

@@ -40,17 +40,14 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2017
-*
 *> \ingroup double_blas_level1
 *
 *  =====================================================================
       DOUBLE PRECISION FUNCTION DCABS1(Z)
 *
-*  -- Reference BLAS level1 routine (version 3.8.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
 *
 *     .. Scalar Arguments ..
       COMPLEX*16 Z
@@ -63,4 +60,7 @@
 *
       DCABS1 = ABS(DBLE(Z)) + ABS(DIMAG(Z))
       RETURN
+*
+*     End of DCABS1
+*
       END

BLAS/SRC/dcopy.f

@@ -66,8 +66,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2017
-*
 *> \ingroup double_blas_level1
 *
 *> \par Further Details:
@@ -82,10 +80,9 @@
 *  =====================================================================
       SUBROUTINE DCOPY(N,DX,INCX,DY,INCY)
 *
-*  -- Reference BLAS level1 routine (version 3.8.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,INCY,N
@@ -143,4 +140,7 @@
          END DO
       END IF
       RETURN
+*
+*     End of DCOPY
+*
       END

BLAS/SRC/ddot.f

@@ -66,8 +66,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2017
-*
 *> \ingroup double_blas_level1
 *
 *> \par Further Details:
@@ -82,10 +80,9 @@
 *  =====================================================================
       DOUBLE PRECISION FUNCTION DDOT(N,DX,INCX,DY,INCY)
 *
-*  -- Reference BLAS level1 routine (version 3.8.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,INCY,N
@@ -145,4 +142,7 @@
       END IF
       DDOT = DTEMP
       RETURN
+*
+*     End of DDOT
+*
       END

BLAS/SRC/dgbmv.f

@@ -163,8 +163,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup double_blas_level2
 *
 *> \par Further Details:
@@ -185,10 +183,9 @@
 *  =====================================================================
       SUBROUTINE DGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       DOUBLE PRECISION ALPHA,BETA
@@ -365,6 +362,6 @@
 *
       RETURN
 *
-*     End of DGBMV .
+*     End of DGBMV
 *
       END

BLAS/SRC/dgemm.f

@@ -166,8 +166,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup double_blas_level3
 *
 *> \par Further Details:
@@ -187,10 +185,9 @@
 *  =====================================================================
       SUBROUTINE DGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
 *
-*  -- Reference BLAS level3 routine (version 3.7.0) --
+*  -- Reference BLAS level3 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       DOUBLE PRECISION ALPHA,BETA
@@ -377,6 +374,6 @@
 *
       RETURN
 *
-*     End of DGEMM .
+*     End of DGEMM
 *
       END

BLAS/SRC/dgemv.f

@@ -134,8 +134,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup double_blas_level2
 *
 *> \par Further Details:
@@ -156,10 +154,9 @@
 *  =====================================================================
       SUBROUTINE DGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       DOUBLE PRECISION ALPHA,BETA
@@ -325,6 +322,6 @@
 *
       RETURN
 *
-*     End of DGEMV .
+*     End of DGEMV
 *
       END

BLAS/SRC/dger.f

@@ -109,8 +109,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup double_blas_level2
 *
 *> \par Further Details:
@@ -130,10 +128,9 @@
 *  =====================================================================
       SUBROUTINE DGER(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       DOUBLE PRECISION ALPHA
@@ -222,6 +219,6 @@
 *
       RETURN
 *
-*     End of DGER  .
+*     End of DGER
 *
       END

BLAS/SRC/dnrm2.f

@@ -1,132 +0,0 @@
-*> \brief \b DNRM2
-*
-*  =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-*            http://www.netlib.org/lapack/explore-html/
-*
-*  Definition:
-*  ===========
-*
-*       DOUBLE PRECISION FUNCTION DNRM2(N,X,INCX)
-*
-*       .. Scalar Arguments ..
-*       INTEGER INCX,N
-*       ..
-*       .. Array Arguments ..
-*       DOUBLE PRECISION X(*)
-*       ..
-*
-*
-*> \par Purpose:
-*  =============
-*>
-*> \verbatim
-*>
-*> DNRM2 returns the euclidean norm of a vector via the function
-*> name, so that
-*>
-*>    DNRM2 := sqrt( x'*x )
-*> \endverbatim
-*
-*  Arguments:
-*  ==========
-*
-*> \param[in] N
-*> \verbatim
-*>          N is INTEGER
-*>         number of elements in input vector(s)
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*>          X is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*>          INCX is INTEGER
-*>         storage spacing between elements of DX
-*> \endverbatim
-*
-*  Authors:
-*  ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2017
-*
-*> \ingroup double_blas_level1
-*
-*> \par Further Details:
-*  =====================
-*>
-*> \verbatim
-*>
-*>  -- This version written on 25-October-1982.
-*>     Modified on 14-October-1993 to inline the call to DLASSQ.
-*>     Sven Hammarling, Nag Ltd.
-*> \endverbatim
-*>
-*  =====================================================================
-      DOUBLE PRECISION FUNCTION DNRM2(N,X,INCX)
-*
-*  -- Reference BLAS level1 routine (version 3.8.0) --
-*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
-*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
-*
-*     .. Scalar Arguments ..
-      INTEGER INCX,N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION X(*)
-*     ..
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION ONE,ZERO
-      PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
-*     ..
-*     .. Local Scalars ..
-      DOUBLE PRECISION ABSXI,NORM,SCALE,SSQ
-      INTEGER IX
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC ABS,SQRT
-*     ..
-      IF (N.LT.1 .OR. INCX.LT.1) THEN
-          NORM = ZERO
-      ELSE IF (N.EQ.1) THEN
-          NORM = ABS(X(1))
-      ELSE
-          SCALE = ZERO
-          SSQ = ONE
-*        The following loop is equivalent to this call to the LAPACK
-*        auxiliary routine:
-*        CALL DLASSQ( N, X, INCX, SCALE, SSQ )
-*
-          DO 10 IX = 1,1 + (N-1)*INCX,INCX
-              IF (X(IX).NE.ZERO) THEN
-                  ABSXI = ABS(X(IX))
-                  IF (SCALE.LT.ABSXI) THEN
-                      SSQ = ONE + SSQ* (SCALE/ABSXI)**2
-                      SCALE = ABSXI
-                  ELSE
-                      SSQ = SSQ + (ABSXI/SCALE)**2
-                  END IF
-              END IF
-   10     CONTINUE
-          NORM = SCALE*SQRT(SSQ)
-      END IF
-*
-      DNRM2 = NORM
-      RETURN
-*
-*     End of DNRM2.
-*
-      END

BLAS/SRC/dnrm2.f90

@@ -0,0 +1,199 @@
+!> \brief \b DNRM2
+!
+!  =========== DOCUMENTATION ===========
+!
+! Online html documentation available at
+!            http://www.netlib.org/lapack/explore-html/
+!
+!  Definition:
+!  ===========
+!
+!       DOUBLE PRECISION FUNCTION DNRM2(N,X,INCX)
+!
+!       .. Scalar Arguments ..
+!       INTEGER INCX,N
+!       ..
+!       .. Array Arguments ..
+!       DOUBLE PRECISION X(*)
+!       ..
+!
+!
+!> \par Purpose:
+!  =============
+!>
+!> \verbatim
+!>
+!> DNRM2 returns the euclidean norm of a vector via the function
+!> name, so that
+!>
+!>    DNRM2 := sqrt( x'*x )
+!> \endverbatim
+!
+!  Arguments:
+!  ==========
+!
+!> \param[in] N
+!> \verbatim
+!>          N is INTEGER
+!>         number of elements in input vector(s)
+!> \endverbatim
+!>
+!> \param[in] X
+!> \verbatim
+!>          X is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+!> \endverbatim
+!>
+!> \param[in] INCX
+!> \verbatim
+!>          INCX is INTEGER, storage spacing between elements of X
+!>          If INCX > 0, X(1+(i-1)*INCX) = x(i) for 1 <= i <= n
+!>          If INCX < 0, X(1-(n-i)*INCX) = x(i) for 1 <= i <= n
+!>          If INCX = 0, x isn't a vector so there is no need to call
+!>          this subroutine.  If you call it anyway, it will count x(1)
+!>          in the vector norm N times.
+!> \endverbatim
+!
+!  Authors:
+!  ========
+!
+!> \author Edward Anderson, Lockheed Martin
+!
+!> \date August 2016
+!
+!> \ingroup single_blas_level1
+!
+!> \par Contributors:
+!  ==================
+!>
+!> Weslley Pereira, University of Colorado Denver, USA
+!
+!> \par Further Details:
+!  =====================
+!>
+!> \verbatim
+!>
+!>  Anderson E. (2017)
+!>  Algorithm 978: Safe Scaling in the Level 1 BLAS
+!>  ACM Trans Math Softw 44:1--28
+!>  https://doi.org/10.1145/3061665
+!>
+!>  Blue, James L. (1978)
+!>  A Portable Fortran Program to Find the Euclidean Norm of a Vector
+!>  ACM Trans Math Softw 4:15--23
+!>  https://doi.org/10.1145/355769.355771
+!>
+!> \endverbatim
+!>
+!  =====================================================================
+function DNRM2( n, x, incx ) 
+   integer, parameter :: wp = kind(1.d0)
+   real(wp) :: DNRM2
+!
+!  -- Reference BLAS level1 routine (version 3.9.1) --
+!  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
+!  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+!     March 2021
+!
+!  .. Constants ..
+   real(wp), parameter :: zero = 0.0_wp
+   real(wp), parameter :: one  = 1.0_wp
+   real(wp), parameter :: maxN = huge(0.0_wp)
+!  ..
+!  .. Blue's scaling constants ..
+   real(wp), parameter :: tsml = real(radix(0._wp), wp)**ceiling( &
+       (minexponent(0._wp) - 1) * 0.5_wp)
+   real(wp), parameter :: tbig = real(radix(0._wp), wp)**floor( &
+       (maxexponent(0._wp) - digits(0._wp) + 1) * 0.5_wp)
+   real(wp), parameter :: ssml = real(radix(0._wp), wp)**( - floor( &
+       (minexponent(0._wp) - digits(0._wp)) * 0.5_wp))
+   real(wp), parameter :: sbig = real(radix(0._wp), wp)**( - ceiling( &
+       (maxexponent(0._wp) + digits(0._wp) - 1) * 0.5_wp))
+!  ..
+!  .. Scalar Arguments ..
+   integer :: incx, n
+!  ..
+!  .. Array Arguments ..
+   real(wp) :: x(*)
+!  ..
+!  .. Local Scalars ..
+   integer :: i, ix
+   logical :: notbig
+   real(wp) :: abig, amed, asml, ax, scl, sumsq, ymax, ymin
+!
+!  Quick return if possible
+!
+   DNRM2 = zero
+   if( n <= 0 ) return
+!
+   scl = one
+   sumsq = zero
+!
+!  Compute the sum of squares in 3 accumulators:
+!     abig -- sums of squares scaled down to avoid overflow
+!     asml -- sums of squares scaled up to avoid underflow
+!     amed -- sums of squares that do not require scaling
+!  The thresholds and multipliers are
+!     tbig -- values bigger than this are scaled down by sbig
+!     tsml -- values smaller than this are scaled up by ssml
+!
+   notbig = .true.
+   asml = zero
+   amed = zero
+   abig = zero
+   ix = 1
+   if( incx < 0 ) ix = 1 - (n-1)*incx
+   do i = 1, n
+      ax = abs(x(ix))
+      if (ax > tbig) then
+         abig = abig + (ax*sbig)**2
+         notbig = .false.
+      else if (ax < tsml) then
+         if (notbig) asml = asml + (ax*ssml)**2
+      else
+         amed = amed + ax**2
+      end if
+      ix = ix + incx
+   end do
+!
+!  Combine abig and amed or amed and asml if more than one
+!  accumulator was used.
+!
+   if (abig > zero) then
+!
+!     Combine abig and amed if abig > 0.
+!
+      if ( (amed > zero) .or. (amed > maxN) .or. (amed /= amed) ) then
+         abig = abig + (amed*sbig)*sbig
+      end if
+      scl = one / sbig
+      sumsq = abig
+   else if (asml > zero) then
+!
+!     Combine amed and asml if asml > 0.
+!
+      if ( (amed > zero) .or. (amed > maxN) .or. (amed /= amed) ) then
+         amed = sqrt(amed)
+         asml = sqrt(asml) / ssml
+         if (asml > amed) then
+            ymin = amed
+            ymax = asml
+         else
+            ymin = asml
+            ymax = amed
+         end if
+         scl = one
+         sumsq = ymax**2*( one + (ymin/ymax)**2 )
+      else
+         scl = one / ssml
+         sumsq = asml
+      end if
+   else
+!
+!     Otherwise all values are mid-range
+!
+      scl = one
+      sumsq = amed
+   end if
+   DNRM2 = scl*sqrt( sumsq )
+   return
+end function

BLAS/SRC/drot.f

@@ -76,8 +76,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2017
-*
 *> \ingroup double_blas_level1
 *
 *> \par Further Details:
@@ -92,10 +90,9 @@
 *  =====================================================================
       SUBROUTINE DROT(N,DX,INCX,DY,INCY,C,S)
 *
-*  -- Reference BLAS level1 routine (version 3.8.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
 *
 *     .. Scalar Arguments ..
       DOUBLE PRECISION C,S
@@ -139,4 +136,7 @@
          END DO
       END IF
       RETURN
+*
+*     End of DROT
+*
       END

BLAS/SRC/drotg.f

@@ -1,109 +0,0 @@
-*> \brief \b DROTG
-*
-*  =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-*            http://www.netlib.org/lapack/explore-html/
-*
-*  Definition:
-*  ===========
-*
-*       SUBROUTINE DROTG(DA,DB,C,S)
-*
-*       .. Scalar Arguments ..
-*       DOUBLE PRECISION C,DA,DB,S
-*       ..
-*
-*
-*> \par Purpose:
-*  =============
-*>
-*> \verbatim
-*>
-*>    DROTG construct givens plane rotation.
-*> \endverbatim
-*
-*  Arguments:
-*  ==========
-*
-*> \param[in,out] DA
-*> \verbatim
-*>          DA is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[in,out] DB
-*> \verbatim
-*>          DB is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[out] C
-*> \verbatim
-*>          C is DOUBLE PRECISION
-*> \endverbatim
-*>
-*> \param[out] S
-*> \verbatim
-*>          S is DOUBLE PRECISION
-*> \endverbatim
-*
-*  Authors:
-*  ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2017
-*
-*> \ingroup double_blas_level1
-*
-*> \par Further Details:
-*  =====================
-*>
-*> \verbatim
-*>
-*>     jack dongarra, linpack, 3/11/78.
-*> \endverbatim
-*>
-*  =====================================================================
-      SUBROUTINE DROTG(DA,DB,C,S)
-*
-*  -- Reference BLAS level1 routine (version 3.8.0) --
-*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
-*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
-*
-*     .. Scalar Arguments ..
-      DOUBLE PRECISION C,DA,DB,S
-*     ..
-*
-*  =====================================================================
-*
-*     .. Local Scalars ..
-      DOUBLE PRECISION R,ROE,SCALE,Z
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC DABS,DSIGN,DSQRT
-*     ..
-      SCALE = DABS(DA) + DABS(DB)
-      IF (SCALE.EQ.0.0d0) THEN
-         C = 1.0d0
-         S = 0.0d0
-         R = 0.0d0
-         Z = 0.0d0
-      ELSE
-         ROE = DB
-         IF (DABS(DA).GT.DABS(DB)) ROE = DA
-         R = SCALE*DSQRT((DA/SCALE)**2+ (DB/SCALE)**2)
-         R = DSIGN(1.0d0,ROE)*R
-         C = DA/R
-         S = DB/R
-         Z = 1.0d0
-         IF (DABS(DA).GT.DABS(DB)) Z = S
-         IF (DABS(DB).GE.DABS(DA) .AND. C.NE.0.0d0) Z = 1.0d0/C
-      END IF
-      DA = R
-      DB = Z
-      RETURN
-      END

BLAS/SRC/drotg.f90

@@ -0,0 +1,151 @@
+!> \brief \b DROTG
+!
+!  =========== DOCUMENTATION ===========
+!
+! Online html documentation available at
+!            http://www.netlib.org/lapack/explore-html/
+!
+!  Definition:
+!  ===========
+!
+!  DROTG constructs a plane rotation
+!     [  c  s ] [ a ] = [ r ]
+!     [ -s  c ] [ b ]   [ 0 ]
+!  satisfying c**2 + s**2 = 1.
+!
+!> \par Purpose:
+!  =============
+!>
+!> \verbatim
+!>
+!> The computation uses the formulas
+!>    sigma = sgn(a)    if |a| >  |b|
+!>          = sgn(b)    if |b| >= |a|
+!>    r = sigma*sqrt( a**2 + b**2 )
+!>    c = 1; s = 0      if r = 0
+!>    c = a/r; s = b/r  if r != 0
+!> The subroutine also computes
+!>    z = s    if |a| > |b|,
+!>      = 1/c  if |b| >= |a| and c != 0
+!>      = 1    if c = 0
+!> This allows c and s to be reconstructed from z as follows:
+!>    If z = 1, set c = 0, s = 1.
+!>    If |z| < 1, set c = sqrt(1 - z**2) and s = z.
+!>    If |z| > 1, set c = 1/z and s = sqrt( 1 - c**2).
+!>
+!> \endverbatim
+!
+!  Arguments:
+!  ==========
+!
+!> \param[in,out] A
+!> \verbatim
+!>          A is DOUBLE PRECISION
+!>          On entry, the scalar a.
+!>          On exit, the scalar r.
+!> \endverbatim
+!>
+!> \param[in,out] B
+!> \verbatim
+!>          B is DOUBLE PRECISION
+!>          On entry, the scalar b.
+!>          On exit, the scalar z.
+!> \endverbatim
+!>
+!> \param[out] C
+!> \verbatim
+!>          C is DOUBLE PRECISION
+!>          The scalar c.
+!> \endverbatim
+!>
+!> \param[out] S
+!> \verbatim
+!>          S is DOUBLE PRECISION
+!>          The scalar s.
+!> \endverbatim
+!
+!  Authors:
+!  ========
+!
+!> \author Edward Anderson, Lockheed Martin
+!
+!> \par Contributors:
+!  ==================
+!>
+!> Weslley Pereira, University of Colorado Denver, USA
+!
+!> \ingroup single_blas_level1
+!
+!> \par Further Details:
+!  =====================
+!>
+!> \verbatim
+!>
+!>  Anderson E. (2017)
+!>  Algorithm 978: Safe Scaling in the Level 1 BLAS
+!>  ACM Trans Math Softw 44:1--28
+!>  https://doi.org/10.1145/3061665
+!>
+!> \endverbatim
+!
+!  =====================================================================
+subroutine DROTG( a, b, c, s )
+   integer, parameter :: wp = kind(1.d0)
+!
+!  -- Reference BLAS level1 routine --
+!  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
+!  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+!
+!  .. Constants ..
+   real(wp), parameter :: zero = 0.0_wp
+   real(wp), parameter :: one  = 1.0_wp
+!  ..
+!  .. Scaling constants ..
+   real(wp), parameter :: safmin = real(radix(0._wp),wp)**max( &
+      minexponent(0._wp)-1, &
+      1-maxexponent(0._wp) &
+   )
+   real(wp), parameter :: safmax = real(radix(0._wp),wp)**max( &
+      1-minexponent(0._wp), &
+      maxexponent(0._wp)-1 &
+   )
+!  ..
+!  .. Scalar Arguments ..
+   real(wp) :: a, b, c, s
+!  ..
+!  .. Local Scalars ..
+   real(wp) :: anorm, bnorm, scl, sigma, r, z
+!  ..
+   anorm = abs(a)
+   bnorm = abs(b)
+   if( bnorm == zero ) then
+      c = one
+      s = zero
+      b = zero
+   else if( anorm == zero ) then
+      c = zero
+      s = one
+      a = b
+      b = one
+   else
+      scl = min( safmax, max( safmin, anorm, bnorm ) )
+      if( anorm > bnorm ) then
+         sigma = sign(one,a)
+      else
+         sigma = sign(one,b)
+      end if
+      r = sigma*( scl*sqrt((a/scl)**2 + (b/scl)**2) )
+      c = a/r
+      s = b/r
+      if( anorm > bnorm ) then
+         z = s
+      else if( c /= zero ) then
+         z = one/c
+      else
+         z = one
+      end if
+      a = r
+      b = z
+   end if
+   return
+end subroutine

BLAS/SRC/drotm.f

@@ -89,17 +89,14 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2017
-*
 *> \ingroup double_blas_level1
 *
 *  =====================================================================
       SUBROUTINE DROTM(N,DX,INCX,DY,INCY,DPARAM)
 *
-*  -- Reference BLAS level1 routine (version 3.8.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,INCY,N
@@ -197,4 +194,7 @@
          END IF
       END IF
       RETURN
+*
+*     End of DROTM
+*
       END

BLAS/SRC/drotmg.f

@@ -83,17 +83,14 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2017
-*
 *> \ingroup double_blas_level1
 *
 *  =====================================================================
       SUBROUTINE DROTMG(DD1,DD2,DX1,DY1,DPARAM)
 *
-*  -- Reference BLAS level1 routine (version 3.8.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
 *
 *     .. Scalar Arguments ..
       DOUBLE PRECISION DD1,DD2,DX1,DY1
@@ -257,8 +254,7 @@
 
       DPARAM(1) = DFLAG
       RETURN
+*
+*     End of DROTMG
+*
       END
-
-
-
-

BLAS/SRC/dsbmv.f

@@ -162,8 +162,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup double_blas_level2
 *
 *> \par Further Details:
@@ -184,10 +182,9 @@
 *  =====================================================================
       SUBROUTINE DSBMV(UPLO,N,K,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       DOUBLE PRECISION ALPHA,BETA
@@ -370,6 +367,6 @@
 *
       RETURN
 *
-*     End of DSBMV .
+*     End of DSBMV
 *
       END

BLAS/SRC/dscal.f

@@ -62,8 +62,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2017
-*
 *> \ingroup double_blas_level1
 *
 *> \par Further Details:
@@ -79,10 +77,9 @@
 *  =====================================================================
       SUBROUTINE DSCAL(N,DA,DX,INCX)
 *
-*  -- Reference BLAS level1 routine (version 3.8.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
 *
 *     .. Scalar Arguments ..
       DOUBLE PRECISION DA
@@ -96,11 +93,14 @@
 *
 *     .. Local Scalars ..
       INTEGER I,M,MP1,NINCX
+*     .. Parameters ..
+      DOUBLE PRECISION ONE
+      PARAMETER (ONE=1.0D+0)
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC MOD
 *     ..
-      IF (N.LE.0 .OR. INCX.LE.0) RETURN
+      IF (N.LE.0 .OR. INCX.LE.0 .OR. DA.EQ.ONE) RETURN
       IF (INCX.EQ.1) THEN
 *
 *        code for increment equal to 1
@@ -133,4 +133,7 @@
          END DO
       END IF
       RETURN
+*
+*     End of DSCAL
+*
       END

BLAS/SRC/dsdot.f

@@ -84,8 +84,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup double_blas_level1
 *
 *> \par Further Details:
@@ -119,10 +117,9 @@
 *  =====================================================================
       DOUBLE PRECISION FUNCTION DSDOT(N,SX,INCX,SY,INCY)
 *
-*  -- Reference BLAS level1 routine (version 3.7.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,INCY,N
@@ -169,4 +166,7 @@
          END DO
       END IF
       RETURN
+*
+*     End of DSDOT
+*
       END

BLAS/SRC/dspmv.f

@@ -125,8 +125,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup double_blas_level2
 *
 *> \par Further Details:
@@ -147,10 +145,9 @@
 *  =====================================================================
       SUBROUTINE DSPMV(UPLO,N,ALPHA,AP,X,INCX,BETA,Y,INCY)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       DOUBLE PRECISION ALPHA,BETA
@@ -326,6 +323,6 @@
 *
       RETURN
 *
-*     End of DSPMV .
+*     End of DSPMV
 *
       END

BLAS/SRC/dspr.f

@@ -106,8 +106,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup double_blas_level2
 *
 *> \par Further Details:
@@ -127,10 +125,9 @@
 *  =====================================================================
       SUBROUTINE DSPR(UPLO,N,ALPHA,X,INCX,AP)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       DOUBLE PRECISION ALPHA
@@ -256,6 +253,6 @@
 *
       RETURN
 *
-*     End of DSPR  .
+*     End of DSPR
 *
       END

BLAS/SRC/dspr2.f

@@ -121,8 +121,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup double_blas_level2
 *
 *> \par Further Details:
@@ -142,10 +140,9 @@
 *  =====================================================================
       SUBROUTINE DSPR2(UPLO,N,ALPHA,X,INCX,Y,INCY,AP)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       DOUBLE PRECISION ALPHA
@@ -291,6 +288,6 @@
 *
       RETURN
 *
-*     End of DSPR2 .
+*     End of DSPR2
 *
       END

BLAS/SRC/dswap.f

@@ -66,8 +66,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2017
-*
 *> \ingroup double_blas_level1
 *
 *> \par Further Details:
@@ -82,10 +80,9 @@
 *  =====================================================================
       SUBROUTINE DSWAP(N,DX,INCX,DY,INCY)
 *
-*  -- Reference BLAS level1 routine (version 3.8.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,INCY,N
@@ -150,4 +147,7 @@
          END DO
       END IF
       RETURN
+*
+*     End of DSWAP
+*
       END

BLAS/SRC/dsymm.f

@@ -168,8 +168,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup double_blas_level3
 *
 *> \par Further Details:
@@ -189,10 +187,9 @@
 *  =====================================================================
       SUBROUTINE DSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
 *
-*  -- Reference BLAS level3 routine (version 3.7.0) --
+*  -- Reference BLAS level3 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       DOUBLE PRECISION ALPHA,BETA
@@ -362,6 +359,6 @@
 *
       RETURN
 *
-*     End of DSYMM .
+*     End of DSYMM
 *
       END

BLAS/SRC/dsymv.f

@@ -130,8 +130,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup double_blas_level2
 *
 *> \par Further Details:
@@ -152,10 +150,9 @@
 *  =====================================================================
       SUBROUTINE DSYMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       DOUBLE PRECISION ALPHA,BETA
@@ -328,6 +325,6 @@
 *
       RETURN
 *
-*     End of DSYMV .
+*     End of DSYMV
 *
       END

BLAS/SRC/dsyr.f

@@ -111,8 +111,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup double_blas_level2
 *
 *> \par Further Details:
@@ -132,10 +130,9 @@
 *  =====================================================================
       SUBROUTINE DSYR(UPLO,N,ALPHA,X,INCX,A,LDA)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       DOUBLE PRECISION ALPHA
@@ -258,6 +255,6 @@
 *
       RETURN
 *
-*     End of DSYR  .
+*     End of DSYR
 *
       END

BLAS/SRC/dsyr2.f

@@ -126,8 +126,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup double_blas_level2
 *
 *> \par Further Details:
@@ -147,10 +145,9 @@
 *  =====================================================================
       SUBROUTINE DSYR2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       DOUBLE PRECISION ALPHA
@@ -293,6 +290,6 @@
 *
       RETURN
 *
-*     End of DSYR2 .
+*     End of DSYR2
 *
       END

BLAS/SRC/dsyr2k.f

@@ -170,8 +170,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup double_blas_level3
 *
 *> \par Further Details:
@@ -192,10 +190,9 @@
 *  =====================================================================
       SUBROUTINE DSYR2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
 *
-*  -- Reference BLAS level3 routine (version 3.7.0) --
+*  -- Reference BLAS level3 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       DOUBLE PRECISION ALPHA,BETA
@@ -394,6 +391,6 @@
 *
       RETURN
 *
-*     End of DSYR2K.
+*     End of DSYR2K
 *
       END

BLAS/SRC/dsyrk.f

@@ -148,8 +148,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup double_blas_level3
 *
 *> \par Further Details:
@@ -169,10 +167,9 @@
 *  =====================================================================
       SUBROUTINE DSYRK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC)
 *
-*  -- Reference BLAS level3 routine (version 3.7.0) --
+*  -- Reference BLAS level3 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       DOUBLE PRECISION ALPHA,BETA
@@ -359,6 +356,6 @@
 *
       RETURN
 *
-*     End of DSYRK .
+*     End of DSYRK
 *
       END

BLAS/SRC/dtbmv.f

@@ -164,8 +164,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup double_blas_level2
 *
 *> \par Further Details:
@@ -186,10 +184,9 @@
 *  =====================================================================
       SUBROUTINE DTBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,K,LDA,N
@@ -393,6 +390,6 @@
 *
       RETURN
 *
-*     End of DTBMV .
+*     End of DTBMV
 *
       END

BLAS/SRC/dtbsv.f

@@ -168,8 +168,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup double_blas_level2
 *
 *> \par Further Details:
@@ -189,10 +187,9 @@
 *  =====================================================================
       SUBROUTINE DTBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,K,LDA,N
@@ -396,6 +393,6 @@
 *
       RETURN
 *
-*     End of DTBSV .
+*     End of DTBSV
 *
       END

BLAS/SRC/dtpmv.f

@@ -120,8 +120,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup double_blas_level2
 *
 *> \par Further Details:
@@ -142,10 +140,9 @@
 *  =====================================================================
       SUBROUTINE DTPMV(UPLO,TRANS,DIAG,N,AP,X,INCX)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,N
@@ -347,6 +344,6 @@
 *
       RETURN
 *
-*     End of DTPMV .
+*     End of DTPMV
 *
       END

BLAS/SRC/dtpsv.f

@@ -123,8 +123,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup double_blas_level2
 *
 *> \par Further Details:
@@ -144,10 +142,9 @@
 *  =====================================================================
       SUBROUTINE DTPSV(UPLO,TRANS,DIAG,N,AP,X,INCX)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,N
@@ -349,6 +346,6 @@
 *
       RETURN
 *
-*     End of DTPSV .
+*     End of DTPSV
 *
       END

BLAS/SRC/dtrmm.f

@@ -156,8 +156,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup double_blas_level3
 *
 *> \par Further Details:
@@ -177,10 +175,9 @@
 *  =====================================================================
       SUBROUTINE DTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
 *
-*  -- Reference BLAS level3 routine (version 3.7.0) --
+*  -- Reference BLAS level3 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       DOUBLE PRECISION ALPHA
@@ -410,6 +407,6 @@
 *
       RETURN
 *
-*     End of DTRMM .
+*     End of DTRMM
 *
       END

BLAS/SRC/dtrmv.f

@@ -125,8 +125,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup double_blas_level2
 *
 *> \par Further Details:
@@ -147,10 +145,9 @@
 *  =====================================================================
       SUBROUTINE DTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
 *
-*  -- Reference BLAS level2 routine (version 3.7.0) --
+*  -- Reference BLAS level2 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,LDA,N
@@ -337,6 +334,6 @@
 *
       RETURN
 *
-*     End of DTRMV .
+*     End of DTRMV
 *
       END

BLAS/SRC/dtrsm.f

@@ -159,8 +159,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup double_blas_level3
 *
 *> \par Further Details:
@@ -181,10 +179,9 @@
 *  =====================================================================
       SUBROUTINE DTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
 *
-*  -- Reference BLAS level3 routine (version 3.7.0) --
+*  -- Reference BLAS level3 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       DOUBLE PRECISION ALPHA
@@ -438,6 +435,6 @@
 *
       RETURN
 *
-*     End of DTRSM .
+*     End of DTRSM
 *
       END

BLAS/SRC/dtrsv.f

@@ -136,17 +136,14 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup double_blas_level1
 *
 *  =====================================================================
       SUBROUTINE DTRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
 *
-*  -- Reference BLAS level1 routine (version 3.7.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,LDA,N
@@ -333,6 +330,6 @@
 *
       RETURN
 *
-*     End of DTRSV .
+*     End of DTRSV
 *
       END

BLAS/SRC/dzasum.f

@@ -55,8 +55,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2017
-*
 *> \ingroup double_blas_level1
 *
 *> \par Further Details:
@@ -72,10 +70,9 @@
 *  =====================================================================
       DOUBLE PRECISION FUNCTION DZASUM(N,ZX,INCX)
 *
-*  -- Reference BLAS level1 routine (version 3.8.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,N
@@ -115,4 +112,7 @@
       END IF
       DZASUM = STEMP
       RETURN
+*
+*     End of DZASUM
+*
       END

BLAS/SRC/dznrm2.f

@@ -1,140 +0,0 @@
-*> \brief \b DZNRM2
-*
-*  =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-*            http://www.netlib.org/lapack/explore-html/
-*
-*  Definition:
-*  ===========
-*
-*       DOUBLE PRECISION FUNCTION DZNRM2(N,X,INCX)
-*
-*       .. Scalar Arguments ..
-*       INTEGER INCX,N
-*       ..
-*       .. Array Arguments ..
-*       COMPLEX*16 X(*)
-*       ..
-*
-*
-*> \par Purpose:
-*  =============
-*>
-*> \verbatim
-*>
-*> DZNRM2 returns the euclidean norm of a vector via the function
-*> name, so that
-*>
-*>    DZNRM2 := sqrt( x**H*x )
-*> \endverbatim
-*
-*  Arguments:
-*  ==========
-*
-*> \param[in] N
-*> \verbatim
-*>          N is INTEGER
-*>         number of elements in input vector(s)
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*>          X is COMPLEX*16 array, dimension (N)
-*>         complex vector with N elements
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*>          INCX is INTEGER
-*>         storage spacing between elements of X
-*> \endverbatim
-*
-*  Authors:
-*  ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2017
-*
-*> \ingroup double_blas_level1
-*
-*> \par Further Details:
-*  =====================
-*>
-*> \verbatim
-*>
-*>  -- This version written on 25-October-1982.
-*>     Modified on 14-October-1993 to inline the call to ZLASSQ.
-*>     Sven Hammarling, Nag Ltd.
-*> \endverbatim
-*>
-*  =====================================================================
-      DOUBLE PRECISION FUNCTION DZNRM2(N,X,INCX)
-*
-*  -- Reference BLAS level1 routine (version 3.8.0) --
-*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
-*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
-*
-*     .. Scalar Arguments ..
-      INTEGER INCX,N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16 X(*)
-*     ..
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION ONE,ZERO
-      PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
-*     ..
-*     .. Local Scalars ..
-      DOUBLE PRECISION NORM,SCALE,SSQ,TEMP
-      INTEGER IX
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC ABS,DBLE,DIMAG,SQRT
-*     ..
-      IF (N.LT.1 .OR. INCX.LT.1) THEN
-          NORM = ZERO
-      ELSE
-          SCALE = ZERO
-          SSQ = ONE
-*        The following loop is equivalent to this call to the LAPACK
-*        auxiliary routine:
-*        CALL ZLASSQ( N, X, INCX, SCALE, SSQ )
-*
-          DO 10 IX = 1,1 + (N-1)*INCX,INCX
-              IF (DBLE(X(IX)).NE.ZERO) THEN
-                  TEMP = ABS(DBLE(X(IX)))
-                  IF (SCALE.LT.TEMP) THEN
-                      SSQ = ONE + SSQ* (SCALE/TEMP)**2
-                      SCALE = TEMP
-                  ELSE
-                      SSQ = SSQ + (TEMP/SCALE)**2
-                  END IF
-              END IF
-              IF (DIMAG(X(IX)).NE.ZERO) THEN
-                  TEMP = ABS(DIMAG(X(IX)))
-                  IF (SCALE.LT.TEMP) THEN
-                      SSQ = ONE + SSQ* (SCALE/TEMP)**2
-                      SCALE = TEMP
-                  ELSE
-                      SSQ = SSQ + (TEMP/SCALE)**2
-                  END IF
-              END IF
-   10     CONTINUE
-          NORM = SCALE*SQRT(SSQ)
-      END IF
-*
-      DZNRM2 = NORM
-      RETURN
-*
-*     End of DZNRM2.
-*
-      END

BLAS/SRC/dznrm2.f90

@@ -0,0 +1,209 @@
+!> \brief \b DZNRM2
+!
+!  =========== DOCUMENTATION ===========
+!
+! Online html documentation available at
+!            http://www.netlib.org/lapack/explore-html/
+!
+!  Definition:
+!  ===========
+!
+!       DOUBLE PRECISION FUNCTION DZNRM2(N,X,INCX)
+!
+!       .. Scalar Arguments ..
+!       INTEGER INCX,N
+!       ..
+!       .. Array Arguments ..
+!       DOUBLE COMPLEX X(*)
+!       ..
+!
+!
+!> \par Purpose:
+!  =============
+!>
+!> \verbatim
+!>
+!> DZNRM2 returns the euclidean norm of a vector via the function
+!> name, so that
+!>
+!>    DZNRM2 := sqrt( x**H*x )
+!> \endverbatim
+!
+!  Arguments:
+!  ==========
+!
+!> \param[in] N
+!> \verbatim
+!>          N is INTEGER
+!>         number of elements in input vector(s)
+!> \endverbatim
+!>
+!> \param[in] X
+!> \verbatim
+!>          X is COMPLEX*16 array, dimension (N)
+!>         complex vector with N elements
+!> \endverbatim
+!>
+!> \param[in] INCX
+!> \verbatim
+!>          INCX is INTEGER, storage spacing between elements of X
+!>          If INCX > 0, X(1+(i-1)*INCX) = x(i) for 1 <= i <= n
+!>          If INCX < 0, X(1-(n-i)*INCX) = x(i) for 1 <= i <= n
+!>          If INCX = 0, x isn't a vector so there is no need to call
+!>          this subroutine.  If you call it anyway, it will count x(1)
+!>          in the vector norm N times.
+!> \endverbatim
+!
+!  Authors:
+!  ========
+!
+!> \author Edward Anderson, Lockheed Martin
+!
+!> \date August 2016
+!
+!> \ingroup single_blas_level1
+!
+!> \par Contributors:
+!  ==================
+!>
+!> Weslley Pereira, University of Colorado Denver, USA
+!
+!> \par Further Details:
+!  =====================
+!>
+!> \verbatim
+!>
+!>  Anderson E. (2017)
+!>  Algorithm 978: Safe Scaling in the Level 1 BLAS
+!>  ACM Trans Math Softw 44:1--28
+!>  https://doi.org/10.1145/3061665
+!>
+!>  Blue, James L. (1978)
+!>  A Portable Fortran Program to Find the Euclidean Norm of a Vector
+!>  ACM Trans Math Softw 4:15--23
+!>  https://doi.org/10.1145/355769.355771
+!>
+!> \endverbatim
+!>
+!  =====================================================================
+function DZNRM2( n, x, incx ) 
+   integer, parameter :: wp = kind(1.d0)
+   real(wp) :: DZNRM2
+!
+!  -- Reference BLAS level1 routine (version 3.9.1) --
+!  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
+!  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+!     March 2021
+!
+!  .. Constants ..
+   real(wp), parameter :: zero = 0.0_wp
+   real(wp), parameter :: one  = 1.0_wp
+   real(wp), parameter :: maxN = huge(0.0_wp)
+!  ..
+!  .. Blue's scaling constants ..
+   real(wp), parameter :: tsml = real(radix(0._wp), wp)**ceiling( &
+       (minexponent(0._wp) - 1) * 0.5_wp)
+   real(wp), parameter :: tbig = real(radix(0._wp), wp)**floor( &
+       (maxexponent(0._wp) - digits(0._wp) + 1) * 0.5_wp)
+   real(wp), parameter :: ssml = real(radix(0._wp), wp)**( - floor( &
+       (minexponent(0._wp) - digits(0._wp)) * 0.5_wp))
+   real(wp), parameter :: sbig = real(radix(0._wp), wp)**( - ceiling( &
+       (maxexponent(0._wp) + digits(0._wp) - 1) * 0.5_wp))
+!  ..
+!  .. Scalar Arguments ..
+   integer :: incx, n
+!  ..
+!  .. Array Arguments ..
+   complex(wp) :: x(*)
+!  ..
+!  .. Local Scalars ..
+   integer :: i, ix
+   logical :: notbig
+   real(wp) :: abig, amed, asml, ax, scl, sumsq, ymax, ymin
+!
+!  Quick return if possible
+!
+   DZNRM2 = zero
+   if( n <= 0 ) return
+!
+   scl = one
+   sumsq = zero
+!
+!  Compute the sum of squares in 3 accumulators:
+!     abig -- sums of squares scaled down to avoid overflow
+!     asml -- sums of squares scaled up to avoid underflow
+!     amed -- sums of squares that do not require scaling
+!  The thresholds and multipliers are
+!     tbig -- values bigger than this are scaled down by sbig
+!     tsml -- values smaller than this are scaled up by ssml
+!
+   notbig = .true.
+   asml = zero
+   amed = zero
+   abig = zero
+   ix = 1
+   if( incx < 0 ) ix = 1 - (n-1)*incx
+   do i = 1, n
+      ax = abs(real(x(ix)))
+      if (ax > tbig) then
+         abig = abig + (ax*sbig)**2
+         notbig = .false.
+      else if (ax < tsml) then
+         if (notbig) asml = asml + (ax*ssml)**2
+      else
+         amed = amed + ax**2
+      end if
+      ax = abs(aimag(x(ix)))
+      if (ax > tbig) then
+         abig = abig + (ax*sbig)**2
+         notbig = .false.
+      else if (ax < tsml) then
+         if (notbig) asml = asml + (ax*ssml)**2
+      else
+         amed = amed + ax**2
+      end if
+      ix = ix + incx
+   end do
+!
+!  Combine abig and amed or amed and asml if more than one
+!  accumulator was used.
+!
+   if (abig > zero) then
+!
+!     Combine abig and amed if abig > 0.
+!
+      if ( (amed > zero) .or. (amed > maxN) .or. (amed /= amed) ) then
+         abig = abig + (amed*sbig)*sbig
+      end if
+      scl = one / sbig
+      sumsq = abig
+   else if (asml > zero) then
+!
+!     Combine amed and asml if asml > 0.
+!
+      if ( (amed > zero) .or. (amed > maxN) .or. (amed /= amed) ) then
+         amed = sqrt(amed)
+         asml = sqrt(asml) / ssml
+         if (asml > amed) then
+            ymin = amed
+            ymax = asml
+         else
+            ymin = asml
+            ymax = amed
+         end if
+         scl = one
+         sumsq = ymax**2*( one + (ymin/ymax)**2 )
+      else
+         scl = one / ssml
+         sumsq = asml
+      end if
+   else
+!
+!     Otherwise all values are mid-range
+!
+      scl = one
+      sumsq = amed
+   end if
+   DZNRM2 = scl*sqrt( sumsq )
+   return
+end function

BLAS/SRC/icamax.f

@@ -54,8 +54,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2017
-*
 *> \ingroup aux_blas
 *
 *> \par Further Details:
@@ -71,10 +69,9 @@
 *  =====================================================================
       INTEGER FUNCTION ICAMAX(N,CX,INCX)
 *
-*  -- Reference BLAS level1 routine (version 3.8.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,N
@@ -124,4 +121,7 @@
          END DO
       END IF
       RETURN
+*
+*     End of ICAMAX
+*
       END

BLAS/SRC/idamax.f

@@ -54,8 +54,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2017
-*
 *> \ingroup aux_blas
 *
 *> \par Further Details:
@@ -71,10 +69,9 @@
 *  =====================================================================
       INTEGER FUNCTION IDAMAX(N,DX,INCX)
 *
-*  -- Reference BLAS level1 routine (version 3.8.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,N
@@ -123,4 +120,7 @@
          END DO
       END IF
       RETURN
+*
+*     End of IDAMAX
+*
       END

BLAS/SRC/isamax.f

@@ -54,8 +54,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2017
-*
 *> \ingroup aux_blas
 *
 *> \par Further Details:
@@ -71,10 +69,9 @@
 *  =====================================================================
       INTEGER FUNCTION ISAMAX(N,SX,INCX)
 *
-*  -- Reference BLAS level1 routine (version 3.8.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,N
@@ -123,4 +120,7 @@
          END DO
       END IF
       RETURN
+*
+*     End of ISAMAX
+*
       END

BLAS/SRC/izamax.f

@@ -54,8 +54,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2017
-*
 *> \ingroup aux_blas
 *
 *> \par Further Details:
@@ -71,10 +69,9 @@
 *  =====================================================================
       INTEGER FUNCTION IZAMAX(N,ZX,INCX)
 *
-*  -- Reference BLAS level1 routine (version 3.8.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,N
@@ -124,4 +121,7 @@
          END DO
       END IF
       RETURN
+*
+*     End of IZAMAX
+*
       END

BLAS/SRC/lsame.f

@@ -46,17 +46,14 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup aux_blas
 *
 *  =====================================================================
       LOGICAL FUNCTION LSAME(CA,CB)
 *
-*  -- Reference BLAS level1 routine (version 3.1) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       CHARACTER CA,CB

BLAS/SRC/meson.build

@@ -1,29 +0,0 @@
-SBLAS1 = files('isamax.f', 'sasum.f', 'saxpy.f', 'scopy.f', 'sdot.f', 'snrm2.f', 'srot.f', 'srotg.f', 'sscal.f', 'sswap.f', 'sdsdot.f', 'srotmg.f', 'srotm.f')
-
-CBLAS1 = files('scabs1.f', 'scasum.f', 'scnrm2.f', 'icamax.f', 'caxpy.f', 'ccopy.f', 'cdotc.f', 'cdotu.f', 'csscal.f', 'crotg.f', 'cscal.f', 'cswap.f', 'csrot.f')
-
-DBLAS1 = files('idamax.f', 'dasum.f', 'daxpy.f', 'dcopy.f', 'ddot.f', 'dnrm2.f', 'drot.f', 'drotg.f', 'dscal.f', 'dsdot.f', 'dswap.f', 'drotmg.f', 'drotm.f')
-
-ZBLAS1 = files('dcabs1.f', 'dzasum.f', 'dznrm2.f', 'izamax.f', 'zaxpy.f', 'zcopy.f', 'zdotc.f', 'zdotu.f', 'zdscal.f', 'zrotg.f', 'zscal.f', 'zswap.f', 'zdrot.f')
-
-CB1AUX = files('isamax.f', 'sasum.f', 'saxpy.f', 'scopy.f', 'snrm2.f', 'sscal.f')
-
-ZB1AUX = files('idamax.f', 'dasum.f', 'daxpy.f', 'dcopy.f', 'dnrm2.f', 'dscal.f')
-
-ALLBLAS = files('lsame.f', 'xerbla.f', 'xerbla_array.f')
-
-SBLAS2 = files('sgemv.f', 'sgbmv.f', 'ssymv.f', 'ssbmv.f', 'sspmv.f', 'strmv.f', 'stbmv.f', 'stpmv.f', 'strsv.f', 'stbsv.f', 'stpsv.f', 'sger.f', 'ssyr.f', 'sspr.f', 'ssyr2.f', 'sspr2.f')
-
-CBLAS2 = files('cgemv.f', 'cgbmv.f', 'chemv.f', 'chbmv.f', 'chpmv.f', 'ctrmv.f', 'ctbmv.f', 'ctpmv.f', 'ctrsv.f', 'ctbsv.f', 'ctpsv.f', 'cgerc.f', 'cgeru.f', 'cher.f', 'chpr.f', 'cher2.f', 'chpr2.f')
-
-DBLAS2 = files('dgemv.f', 'dgbmv.f', 'dsymv.f', 'dsbmv.f', 'dspmv.f', 'dtrmv.f', 'dtbmv.f', 'dtpmv.f', 'dtrsv.f', 'dtbsv.f', 'dtpsv.f', 'dger.f', 'dsyr.f', 'dspr.f', 'dsyr2.f', 'dspr2.f')
-
-ZBLAS2 = files('zgemv.f', 'zgbmv.f', 'zhemv.f', 'zhbmv.f', 'zhpmv.f', 'ztrmv.f', 'ztbmv.f', 'ztpmv.f', 'ztrsv.f', 'ztbsv.f', 'ztpsv.f', 'zgerc.f', 'zgeru.f', 'zher.f', 'zhpr.f', 'zher2.f', 'zhpr2.f')
-
-SBLAS3 = files('sgemm.f', 'ssymm.f', 'ssyrk.f', 'ssyr2k.f', 'strmm.f', 'strsm.f')
-
-CBLAS3 = files('cgemm.f', 'csymm.f', 'csyrk.f', 'csyr2k.f', 'ctrmm.f', 'ctrsm.f', 'chemm.f', 'cherk.f', 'cher2k.f')
-
-DBLAS3 = files('dgemm.f', 'dsymm.f', 'dsyrk.f', 'dsyr2k.f', 'dtrmm.f', 'dtrsm.f')
-
-ZBLAS3 = files('zgemm.f', 'zsymm.f', 'zsyrk.f', 'zsyr2k.f', 'ztrmm.f', 'ztrsm.f', 'zhemm.f', 'zherk.f', 'zher2k.f')

BLAS/SRC/sasum.f

@@ -55,8 +55,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2017
-*
 *> \ingroup single_blas_level1
 *
 *> \par Further Details:
@@ -72,10 +70,9 @@
 *  =====================================================================
       REAL FUNCTION SASUM(N,SX,INCX)
 *
-*  -- Reference BLAS level1 routine (version 3.8.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,N
@@ -129,4 +126,7 @@
       END IF
       SASUM = STEMP
       RETURN
+*
+*     End of SASUM
+*
       END

BLAS/SRC/saxpy.f

@@ -73,8 +73,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2017
-*
 *> \ingroup single_blas_level1
 *
 *> \par Further Details:
@@ -89,10 +87,9 @@
 *  =====================================================================
       SUBROUTINE SAXPY(N,SA,SX,INCX,SY,INCY)
 *
-*  -- Reference BLAS level1 routine (version 3.8.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
 *
 *     .. Scalar Arguments ..
       REAL SA
@@ -149,4 +146,7 @@
          END DO
       END IF
       RETURN
+*
+*     End of SAXPY
+*
       END

BLAS/SRC/scabs1.f

@@ -39,17 +39,14 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2017
-*
 *> \ingroup single_blas_level1
 *
 *  =====================================================================
       REAL FUNCTION SCABS1(Z)
 *
-*  -- Reference BLAS level1 routine (version 3.8.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
 *
 *     .. Scalar Arguments ..
       COMPLEX Z
@@ -62,4 +59,7 @@
 *     ..
       SCABS1 = ABS(REAL(Z)) + ABS(AIMAG(Z))
       RETURN
+*
+*     End of SCABS1
+*
       END

BLAS/SRC/scasum.f

@@ -55,8 +55,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2017
-*
 *> \ingroup single_blas_level1
 *
 *> \par Further Details:
@@ -72,10 +70,9 @@
 *  =====================================================================
       REAL FUNCTION SCASUM(N,CX,INCX)
 *
-*  -- Reference BLAS level1 routine (version 3.8.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,N
@@ -114,4 +111,7 @@
       END IF
       SCASUM = STEMP
       RETURN
+*
+*     End of SCASUM
+*
       END

BLAS/SRC/scnrm2.f

@@ -1,140 +0,0 @@
-*> \brief \b SCNRM2
-*
-*  =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-*            http://www.netlib.org/lapack/explore-html/
-*
-*  Definition:
-*  ===========
-*
-*       REAL FUNCTION SCNRM2(N,X,INCX)
-*
-*       .. Scalar Arguments ..
-*       INTEGER INCX,N
-*       ..
-*       .. Array Arguments ..
-*       COMPLEX X(*)
-*       ..
-*
-*
-*> \par Purpose:
-*  =============
-*>
-*> \verbatim
-*>
-*> SCNRM2 returns the euclidean norm of a vector via the function
-*> name, so that
-*>
-*>    SCNRM2 := sqrt( x**H*x )
-*> \endverbatim
-*
-*  Arguments:
-*  ==========
-*
-*> \param[in] N
-*> \verbatim
-*>          N is INTEGER
-*>         number of elements in input vector(s)
-*> \endverbatim
-*>
-*> \param[in] X
-*> \verbatim
-*>          X is COMPLEX array, dimension (N)
-*>         complex vector with N elements
-*> \endverbatim
-*>
-*> \param[in] INCX
-*> \verbatim
-*>          INCX is INTEGER
-*>         storage spacing between elements of X
-*> \endverbatim
-*
-*  Authors:
-*  ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2017
-*
-*> \ingroup single_blas_level1
-*
-*> \par Further Details:
-*  =====================
-*>
-*> \verbatim
-*>
-*>  -- This version written on 25-October-1982.
-*>     Modified on 14-October-1993 to inline the call to CLASSQ.
-*>     Sven Hammarling, Nag Ltd.
-*> \endverbatim
-*>
-*  =====================================================================
-      REAL FUNCTION SCNRM2(N,X,INCX)
-*
-*  -- Reference BLAS level1 routine (version 3.8.0) --
-*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
-*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
-*
-*     .. Scalar Arguments ..
-      INTEGER INCX,N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX X(*)
-*     ..
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      REAL ONE,ZERO
-      PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
-*     ..
-*     .. Local Scalars ..
-      REAL NORM,SCALE,SSQ,TEMP
-      INTEGER IX
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC ABS,AIMAG,REAL,SQRT
-*     ..
-      IF (N.LT.1 .OR. INCX.LT.1) THEN
-          NORM = ZERO
-      ELSE
-          SCALE = ZERO
-          SSQ = ONE
-*        The following loop is equivalent to this call to the LAPACK
-*        auxiliary routine:
-*        CALL CLASSQ( N, X, INCX, SCALE, SSQ )
-*
-          DO 10 IX = 1,1 + (N-1)*INCX,INCX
-              IF (REAL(X(IX)).NE.ZERO) THEN
-                  TEMP = ABS(REAL(X(IX)))
-                  IF (SCALE.LT.TEMP) THEN
-                      SSQ = ONE + SSQ* (SCALE/TEMP)**2
-                      SCALE = TEMP
-                  ELSE
-                      SSQ = SSQ + (TEMP/SCALE)**2
-                  END IF
-              END IF
-              IF (AIMAG(X(IX)).NE.ZERO) THEN
-                  TEMP = ABS(AIMAG(X(IX)))
-                  IF (SCALE.LT.TEMP) THEN
-                      SSQ = ONE + SSQ* (SCALE/TEMP)**2
-                      SCALE = TEMP
-                  ELSE
-                      SSQ = SSQ + (TEMP/SCALE)**2
-                  END IF
-              END IF
-   10     CONTINUE
-          NORM = SCALE*SQRT(SSQ)
-      END IF
-*
-      SCNRM2 = NORM
-      RETURN
-*
-*     End of SCNRM2.
-*
-      END

BLAS/SRC/scnrm2.f90

@@ -0,0 +1,209 @@
+!> \brief \b SCNRM2
+!
+!  =========== DOCUMENTATION ===========
+!
+! Online html documentation available at
+!            http://www.netlib.org/lapack/explore-html/
+!
+!  Definition:
+!  ===========
+!
+!       REAL FUNCTION SCNRM2(N,X,INCX)
+!
+!       .. Scalar Arguments ..
+!       INTEGER INCX,N
+!       ..
+!       .. Array Arguments ..
+!       COMPLEX X(*)
+!       ..
+!
+!
+!> \par Purpose:
+!  =============
+!>
+!> \verbatim
+!>
+!> SCNRM2 returns the euclidean norm of a vector via the function
+!> name, so that
+!>
+!>    SCNRM2 := sqrt( x**H*x )
+!> \endverbatim
+!
+!  Arguments:
+!  ==========
+!
+!> \param[in] N
+!> \verbatim
+!>          N is INTEGER
+!>         number of elements in input vector(s)
+!> \endverbatim
+!>
+!> \param[in] X
+!> \verbatim
+!>          X is COMPLEX array, dimension (N)
+!>         complex vector with N elements
+!> \endverbatim
+!>
+!> \param[in] INCX
+!> \verbatim
+!>          INCX is INTEGER, storage spacing between elements of X
+!>          If INCX > 0, X(1+(i-1)*INCX) = x(i) for 1 <= i <= n
+!>          If INCX < 0, X(1-(n-i)*INCX) = x(i) for 1 <= i <= n
+!>          If INCX = 0, x isn't a vector so there is no need to call
+!>          this subroutine.  If you call it anyway, it will count x(1)
+!>          in the vector norm N times.
+!> \endverbatim
+!
+!  Authors:
+!  ========
+!
+!> \author Edward Anderson, Lockheed Martin
+!
+!> \date August 2016
+!
+!> \ingroup single_blas_level1
+!
+!> \par Contributors:
+!  ==================
+!>
+!> Weslley Pereira, University of Colorado Denver, USA
+!
+!> \par Further Details:
+!  =====================
+!>
+!> \verbatim
+!>
+!>  Anderson E. (2017)
+!>  Algorithm 978: Safe Scaling in the Level 1 BLAS
+!>  ACM Trans Math Softw 44:1--28
+!>  https://doi.org/10.1145/3061665
+!>
+!>  Blue, James L. (1978)
+!>  A Portable Fortran Program to Find the Euclidean Norm of a Vector
+!>  ACM Trans Math Softw 4:15--23
+!>  https://doi.org/10.1145/355769.355771
+!>
+!> \endverbatim
+!>
+!  =====================================================================
+function SCNRM2( n, x, incx ) 
+   integer, parameter :: wp = kind(1.e0)
+   real(wp) :: SCNRM2
+!
+!  -- Reference BLAS level1 routine (version 3.9.1) --
+!  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
+!  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+!     March 2021
+!
+!  .. Constants ..
+   real(wp), parameter :: zero = 0.0_wp
+   real(wp), parameter :: one  = 1.0_wp
+   real(wp), parameter :: maxN = huge(0.0_wp)
+!  ..
+!  .. Blue's scaling constants ..
+   real(wp), parameter :: tsml = real(radix(0._wp), wp)**ceiling( &
+       (minexponent(0._wp) - 1) * 0.5_wp)
+   real(wp), parameter :: tbig = real(radix(0._wp), wp)**floor( &
+       (maxexponent(0._wp) - digits(0._wp) + 1) * 0.5_wp)
+   real(wp), parameter :: ssml = real(radix(0._wp), wp)**( - floor( &
+       (minexponent(0._wp) - digits(0._wp)) * 0.5_wp))
+   real(wp), parameter :: sbig = real(radix(0._wp), wp)**( - ceiling( &
+       (maxexponent(0._wp) + digits(0._wp) - 1) * 0.5_wp))
+!  ..
+!  .. Scalar Arguments ..
+   integer :: incx, n
+!  ..
+!  .. Array Arguments ..
+   complex(wp) :: x(*)
+!  ..
+!  .. Local Scalars ..
+   integer :: i, ix
+   logical :: notbig
+   real(wp) :: abig, amed, asml, ax, scl, sumsq, ymax, ymin
+!
+!  Quick return if possible
+!
+   SCNRM2 = zero
+   if( n <= 0 ) return
+!
+   scl = one
+   sumsq = zero
+!
+!  Compute the sum of squares in 3 accumulators:
+!     abig -- sums of squares scaled down to avoid overflow
+!     asml -- sums of squares scaled up to avoid underflow
+!     amed -- sums of squares that do not require scaling
+!  The thresholds and multipliers are
+!     tbig -- values bigger than this are scaled down by sbig
+!     tsml -- values smaller than this are scaled up by ssml
+!
+   notbig = .true.
+   asml = zero
+   amed = zero
+   abig = zero
+   ix = 1
+   if( incx < 0 ) ix = 1 - (n-1)*incx
+   do i = 1, n
+      ax = abs(real(x(ix)))
+      if (ax > tbig) then
+         abig = abig + (ax*sbig)**2
+         notbig = .false.
+      else if (ax < tsml) then
+         if (notbig) asml = asml + (ax*ssml)**2
+      else
+         amed = amed + ax**2
+      end if
+      ax = abs(aimag(x(ix)))
+      if (ax > tbig) then
+         abig = abig + (ax*sbig)**2
+         notbig = .false.
+      else if (ax < tsml) then
+         if (notbig) asml = asml + (ax*ssml)**2
+      else
+         amed = amed + ax**2
+      end if
+      ix = ix + incx
+   end do
+!
+!  Combine abig and amed or amed and asml if more than one
+!  accumulator was used.
+!
+   if (abig > zero) then
+!
+!     Combine abig and amed if abig > 0.
+!
+      if ( (amed > zero) .or. (amed > maxN) .or. (amed /= amed) ) then
+         abig = abig + (amed*sbig)*sbig
+      end if
+      scl = one / sbig
+      sumsq = abig
+   else if (asml > zero) then
+!
+!     Combine amed and asml if asml > 0.
+!
+      if ( (amed > zero) .or. (amed > maxN) .or. (amed /= amed) ) then
+         amed = sqrt(amed)
+         asml = sqrt(asml) / ssml
+         if (asml > amed) then
+            ymin = amed
+            ymax = asml
+         else
+            ymin = asml
+            ymax = amed
+         end if
+         scl = one
+         sumsq = ymax**2*( one + (ymin/ymax)**2 )
+      else
+         scl = one / ssml
+         sumsq = asml
+      end if
+   else
+!
+!     Otherwise all values are mid-range
+!
+      scl = one
+      sumsq = amed
+   end if
+   SCNRM2 = scl*sqrt( sumsq )
+   return
+end function

BLAS/SRC/scopy.f

@@ -66,8 +66,6 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2017
-*
 *> \ingroup single_blas_level1
 *
 *> \par Further Details:
@@ -82,10 +80,9 @@
 *  =====================================================================
       SUBROUTINE SCOPY(N,SX,INCX,SY,INCY)
 *
-*  -- Reference BLAS level1 routine (version 3.8.0) --
+*  -- Reference BLAS level1 routine --
 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2017
 *
 *     .. Scalar Arguments ..
       INTEGER INCX,INCY,N
@@ -143,4 +140,7 @@
          END DO
       END IF
       RETURN
+*
+*     End of SCOPY
+*
       END