From 43613a76420ffa839c53d469297ebdce41208eb8 Mon Sep 17 00:00:00 2001 From: "weslley.spereira" Date: Fri, 19 Feb 2021 12:39:16 -0300 Subject: [PATCH 01/12] Adds safe scaling xLARTG routines proposed in https://doi.org/10.1145/3061665; Let the compiler determine the Fortran layout by the file extension --- CMakeLists.txt | 3 - SRC/CMakeLists.txt | 10 ++- SRC/clartg.f90 | 165 +++++++++++++++++++++++++++++++++++++++++ SRC/dlartg.f90 | 90 ++++++++++++++++++++++ SRC/la_constants.f90 | 40 ++++++++++ SRC/la_constants32.f90 | 40 ++++++++++ SRC/slartg.f90 | 90 ++++++++++++++++++++++ SRC/zlartg.f90 | 165 +++++++++++++++++++++++++++++++++++++++++ 8 files changed, 596 insertions(+), 7 deletions(-) create mode 100644 SRC/clartg.f90 create mode 100644 SRC/dlartg.f90 create mode 100644 SRC/la_constants.f90 create mode 100644 SRC/la_constants32.f90 create mode 100644 SRC/slartg.f90 create mode 100644 SRC/zlartg.f90 diff --git a/CMakeLists.txt b/CMakeLists.txt index 73ab55f3d2..b36fec1540 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -16,9 +16,6 @@ set(CMAKE_MODULE_PATH "${LAPACK_SOURCE_DIR}/CMAKE" ${CMAKE_MODULE_PATH}) # Export all symbols on Windows when building shared libraries SET(CMAKE_WINDOWS_EXPORT_ALL_SYMBOLS TRUE) -# Tell CMake that our Fortran sources are written in fixed format. -set(CMAKE_Fortran_FORMAT FIXED) - # Set a default build type if none was specified if(NOT CMAKE_BUILD_TYPE AND NOT CMAKE_CONFIGURATION_TYPES) message(STATUS "Setting build type to 'Release' as none was specified.") diff --git a/SRC/CMakeLists.txt b/SRC/CMakeLists.txt index bd3be3c6e8..e8842c6741 100644 --- a/SRC/CMakeLists.txt +++ b/SRC/CMakeLists.txt @@ -41,6 +41,7 @@ set(ALLAUX ilaenv.f ilaenv2stage.f ieeeck.f lsamen.f iparmq.f iparam2stage.F ../INSTALL/slamch.f) set(SCLAUX + la_constants32.f90 sbdsdc.f sbdsqr.f sdisna.f slabad.f slacpy.f sladiv.f slae2.f slaebz.f slaed0.f slaed1.f slaed2.f slaed3.f slaed4.f slaed5.f slaed6.f @@ -49,7 +50,7 @@ set(SCLAUX slapy2.f slapy3.f slarnv.f slarra.f slarrb.f slarrc.f slarrd.f slarre.f slarrf.f slarrj.f slarrk.f slarrr.f slaneg.f - slartg.f slaruv.f slas2.f slascl.f + slartg.f90 slaruv.f slas2.f slascl.f slasd0.f slasd1.f slasd2.f slasd3.f slasd4.f slasd5.f slasd6.f slasd7.f slasd8.f slasda.f slasdq.f slasdt.f slaset.f slasq1.f slasq2.f slasq3.f slasq4.f slasq5.f slasq6.f @@ -59,6 +60,7 @@ set(SCLAUX ${SECOND_SRC}) set(DZLAUX + la_constants.f90 dbdsdc.f dbdsqr.f ddisna.f dlabad.f dlacpy.f dladiv.f dlae2.f dlaebz.f dlaed0.f dlaed1.f dlaed2.f dlaed3.f dlaed4.f dlaed5.f dlaed6.f @@ -67,7 +69,7 @@ set(DZLAUX dlapy2.f dlapy3.f dlarnv.f dlarra.f dlarrb.f dlarrc.f dlarrd.f dlarre.f dlarrf.f dlarrj.f dlarrk.f dlarrr.f dlaneg.f - dlartg.f dlaruv.f dlas2.f dlascl.f + dlartg.f90 dlaruv.f dlas2.f dlascl.f dlasd0.f dlasd1.f dlasd2.f dlasd3.f dlasd4.f dlasd5.f dlasd6.f dlasd7.f dlasd8.f dlasda.f dlasdq.f dlasdt.f dlaset.f dlasq1.f dlasq2.f dlasq3.f dlasq4.f dlasq5.f dlasq6.f @@ -208,7 +210,7 @@ set(CLASRC claqr0.f claqr1.f claqr2.f claqr3.f claqr4.f claqr5.f claqsp.f claqsy.f clar1v.f clar2v.f ilaclr.f ilaclc.f clarf.f clarfb.f clarfb_gett.f clarfg.f clarfgp.f clarft.f - clarfx.f clarfy.f clargv.f clarnv.f clarrv.f clartg.f clartv.f + clarfx.f clarfy.f clargv.f clarnv.f clarrv.f clartg.f90 clartv.f clarz.f clarzb.f clarzt.f clascl.f claset.f clasr.f classq.f claswp.f clasyf.f clasyf_rook.f clasyf_rk.f clasyf_aa.f clatbs.f clatdf.f clatps.f clatrd.f clatrs.f clatrz.f @@ -403,7 +405,7 @@ set(ZLASRC zlaqsp.f zlaqsy.f zlar1v.f zlar2v.f ilazlr.f ilazlc.f zlarcm.f zlarf.f zlarfb.f zlarfb_gett.f zlarfg.f zlarfgp.f zlarft.f - zlarfx.f zlarfy.f zlargv.f zlarnv.f zlarrv.f zlartg.f zlartv.f + zlarfx.f zlarfy.f zlargv.f zlarnv.f zlarrv.f zlartg.f90 zlartv.f zlarz.f zlarzb.f zlarzt.f zlascl.f zlaset.f zlasr.f zlassq.f zlaswp.f zlasyf.f zlasyf_rook.f zlasyf_rk.f zlasyf_aa.f zlatbs.f zlatdf.f zlatps.f zlatrd.f zlatrs.f zlatrz.f zlauu2.f diff --git a/SRC/clartg.f90 b/SRC/clartg.f90 new file mode 100644 index 0000000000..1e44e35bbd --- /dev/null +++ b/SRC/clartg.f90 @@ -0,0 +1,165 @@ +subroutine CLARTG( f, g, c, s, r ) + use LA_CONSTANTS32, only: wp, zero, one, two, czero, rtmin, rtmax, & + safmin, safmax +! +! LAPACK auxiliary routine +! E. Anderson +! August 4, 2016 +! +! .. Scalar Arguments .. + real(wp) c + complex(wp) f, g, r, s +! .. +! +! Purpose +! ======= +! +! CLARTG generates a plane rotation so that +! +! [ C S ] . [ F ] = [ R ] +! [ -conjg(S) C ] [ G ] [ 0 ] +! +! where C is real and C**2 + |S|**2 = 1. +! +! The mathematical formulas used for C and S are +! +! sgn(x) = { x / |x|, x != 0 +! { 1, x = 0 +! +! R = sgn(F) * sqrt(|F|**2 + |G|**2) +! +! C = |F| / sqrt(|F|**2 + |G|**2) +! +! S = sgn(F) * conjg(G) / sqrt(|F|**2 + |G|**2) +! +! When F and G are real, the formulas simplify to C = F/R and +! S = G/R, and the returned values of C, S, and R should be +! identical to those returned by SLARTG. +! +! The algorithm used to compute these quantities incorporates scaling +! to avoid overflow or underflow in computing the square root of the +! sum of squares. +! +! Arguments +! ========= +! +! F (input) COMPLEX +! The first component of vector to be rotated. +! +! G (input) COMPLEX +! The second component of vector to be rotated. +! +! C (output) REAL +! The cosine of the rotation. +! +! S (output) COMPLEX +! The sine of the rotation. +! +! R (output) COMPLEX +! The nonzero component of the rotated vector. +! +! ===================================================================== +! +! .. Local Scalars .. + real(wp) :: d, f1, f2, g1, g2, h2, p, u, uu, v, vv, w + complex(wp) :: fs, gs, 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 .. +! + if( g == czero ) then + c = one + s = czero + r = f + else if( f == czero ) then + c = zero + g1 = max( abs(real(g)), abs(aimag(g)) ) + if( g1 > rtmin .and. g1 < rtmax ) then +! +! Use unscaled algorithm +! + g2 = ABSSQ( g ) + d = sqrt( g2 ) + s = conjg( g ) / d + r = d + else +! +! Use scaled algorithm +! + u = min( safmax, max( safmin, g1 ) ) + uu = one / u + gs = g*uu + g2 = ABSSQ( gs ) + d = sqrt( g2 ) + s = conjg( gs ) / d + r = d*u + end if + else + f1 = max( abs(real(f)), abs(aimag(f)) ) + g1 = max( abs(real(g)), abs(aimag(g)) ) + 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 + if( f2 > rtmin .and. h2 < rtmax ) then + d = sqrt( f2*h2 ) + else + d = sqrt( f2 )*sqrt( h2 ) + end if + p = 1 / d + c = f2*p + s = conjg( g )*( f*p ) + r = f*( h2*p ) + else +! +! Use scaled algorithm +! + u = min( safmax, max( safmin, f1, g1 ) ) + uu = one / u + gs = g*uu + g2 = ABSSQ( gs ) + if( f1*uu < rtmin ) then +! +! f is not well-scaled when scaled by g1. +! Use a different scaling for f. +! + v = min( safmax, max( safmin, f1 ) ) + vv = one / v + w = v * uu + fs = f*vv + f2 = ABSSQ( fs ) + h2 = f2*w**2 + g2 + else +! +! Otherwise use the same scaling for f and g. +! + w = one + fs = f*uu + f2 = ABSSQ( fs ) + h2 = f2 + g2 + end if + if( f2 > rtmin .and. h2 < rtmax ) then + d = sqrt( f2*h2 ) + else + d = sqrt( f2 )*sqrt( h2 ) + end if + p = 1 / d + c = ( f2*p )*w + s = conjg( gs )*( fs*p ) + r = ( fs*( h2*p ) )*u + end if + end if + return +end subroutine diff --git a/SRC/dlartg.f90 b/SRC/dlartg.f90 new file mode 100644 index 0000000000..32e8997a17 --- /dev/null +++ b/SRC/dlartg.f90 @@ -0,0 +1,90 @@ +subroutine DLARTG( f, g, c, s, r ) + use LA_CONSTANTS, only: wp, zero, half, one, rtmin, rtmax, safmin, safmax +! +! LAPACK auxiliary routine +! E. Anderson +! July 30, 2016 +! +! .. Scalar Arguments .. + real(wp) :: c, f, g, r, s +! .. +! +! Purpose +! ======= +! +! DLARTG generates a plane rotation so that +! +! [ C S ] . [ F ] = [ R ] +! [ -S C ] [ G ] [ 0 ] +! +! where C**2 + S**2 = 1. +! +! The mathematical formulas used for C and S are +! R = sign(F) * sqrt(F**2 + G**2) +! C = F / R +! S = G / R +! Hence C >= 0. The algorithm used to compute these quantities +! incorporates scaling to avoid overflow or underflow in computing the +! square root of the sum of squares. +! +! This version is discontinuous in R at F = 0 but it returns the same +! C and S as CLARTG for complex inputs (F,0) and (G,0). +! +! Arguments +! ========= +! +! F (input) REAL +! The first component of vector to be rotated. +! +! G (input) REAL +! The second component of vector to be rotated. +! +! C (output) REAL +! The cosine of the rotation. +! +! S (output) REAL +! The sine of the rotation. +! +! R (output) REAL +! The nonzero component of the rotated vector. +! +! ===================================================================== +! +! .. Local Scalars .. + real(wp) :: d, f1, fs, g1, gs, p, u, uu +! .. +! .. Intrinsic Functions .. + intrinsic :: abs, sign, sqrt +! .. +! .. Executable Statements .. +! + f1 = abs( f ) + g1 = abs( g ) + if( g == zero ) then + c = one + s = zero + r = f + else if( f == zero ) then + c = zero + s = sign( one, g ) + r = g1 + else if( f1 > rtmin .and. f1 < rtmax .and. & + g1 > rtmin .and. g1 < rtmax ) then + d = sqrt( f*f + g*g ) + p = one / d + c = f1*p + s = g*sign( p, f ) + r = sign( d, f ) + else + u = min( safmax, max( safmin, f1, g1 ) ) + uu = one / u + fs = f*uu + gs = g*uu + d = sqrt( fs*fs + gs*gs ) + p = one / d + c = abs( fs )*p + s = gs*sign( p, f ) + r = sign( d, f )*u + end if + return +end subroutine diff --git a/SRC/la_constants.f90 b/SRC/la_constants.f90 new file mode 100644 index 0000000000..8306d1ed83 --- /dev/null +++ b/SRC/la_constants.f90 @@ -0,0 +1,40 @@ +module LA_CONSTANTS +! +! -- BLAS/LAPACK module -- +! May 06, 2016 +! +! Standard constants +! + integer, parameter :: wp = 8 + real(wp), parameter :: zero = 0.0_wp + real(wp), parameter :: half = 0.5_wp + real(wp), parameter :: one = 1.0_wp + real(wp), parameter :: two = 2.0_wp + real(wp), parameter :: three = 3.0_wp + real(wp), parameter :: four = 4.0_wp + real(wp), parameter :: eight = 8.0_wp + real(wp), parameter :: ten = 10.0_wp + complex(wp), parameter :: czero = ( 0.0_wp, 0.0_wp ) + complex(wp), parameter :: chalf = ( 0.5_wp, 0.0_wp ) + complex(wp), parameter :: cone = ( 1.0_wp, 0.0_wp ) + character*1, parameter :: sprefix = 'D' + character*1, parameter :: cprefix = 'Z' +! +! Model parameters +! + real(wp), parameter :: eps = 0.11102230246251565404E-015_wp + real(wp), parameter :: ulp = 0.22204460492503130808E-015_wp + real(wp), parameter :: safmin = 0.22250738585072013831E-307_wp + real(wp), parameter :: safmax = 0.44942328371557897693E+308_wp + real(wp), parameter :: smlnum = 0.10020841800044863890E-291_wp + real(wp), parameter :: bignum = 0.99792015476735990583E+292_wp + real(wp), parameter :: rtmin = 0.10010415475915504622E-145_wp + real(wp), parameter :: rtmax = 0.99895953610111751404E+146_wp +! +! Blue's scaling constants +! + real(wp), parameter :: tsml = 0.14916681462400413487E-153_wp + real(wp), parameter :: tbig = 0.19979190722022350281E+147_wp + real(wp), parameter :: ssml = 0.44989137945431963828E+162_wp + real(wp), parameter :: sbig = 0.11113793747425387417E-161_wp +end module LA_CONSTANTS diff --git a/SRC/la_constants32.f90 b/SRC/la_constants32.f90 new file mode 100644 index 0000000000..d495709e92 --- /dev/null +++ b/SRC/la_constants32.f90 @@ -0,0 +1,40 @@ +module LA_CONSTANTS32 +! +! -- BLAS/LAPACK module -- +! May 06, 2016 +! +! Standard constants +! + integer, parameter :: wp = 4 + real(wp), parameter :: zero = 0.0_wp + real(wp), parameter :: half = 0.5_wp + real(wp), parameter :: one = 1.0_wp + real(wp), parameter :: two = 2.0_wp + real(wp), parameter :: three = 3.0_wp + real(wp), parameter :: four = 4.0_wp + real(wp), parameter :: eight = 8.0_wp + real(wp), parameter :: ten = 10.0_wp + complex(wp), parameter :: czero = ( 0.0_wp, 0.0_wp ) + complex(wp), parameter :: chalf = ( 0.5_wp, 0.0_wp ) + complex(wp), parameter :: cone = ( 1.0_wp, 0.0_wp ) + character*1, parameter :: sprefix = 'S' + character*1, parameter :: cprefix = 'C' +! +! Model parameters +! + real(wp), parameter :: eps = 0.5960464478E-07_wp + real(wp), parameter :: ulp = 0.1192092896E-06_wp + real(wp), parameter :: safmin = 0.1175494351E-37_wp + real(wp), parameter :: safmax = 0.8507059173E+38_wp + real(wp), parameter :: smlnum = 0.9860761315E-31_wp + real(wp), parameter :: bignum = 0.1014120480E+32_wp + real(wp), parameter :: rtmin = 0.3140184864E-15_wp + real(wp), parameter :: rtmax = 0.3184525782E+16_wp +! +! Blue's scaling constants +! + real(wp), parameter :: tsml = 0.1084202172E-18_wp + real(wp), parameter :: tbig = 0.4503599627E+16_wp + real(wp), parameter :: ssml = 0.3777893186E+23_wp + real(wp), parameter :: sbig = 0.1323488980E-22_wp +end module LA_CONSTANTS32 diff --git a/SRC/slartg.f90 b/SRC/slartg.f90 new file mode 100644 index 0000000000..71f3ed7a76 --- /dev/null +++ b/SRC/slartg.f90 @@ -0,0 +1,90 @@ +subroutine SLARTG( f, g, c, s, r ) + use LA_CONSTANTS32, only: wp, zero, half, one, rtmin, rtmax, safmin, safmax +! +! LAPACK auxiliary routine +! E. Anderson +! July 30, 2016 +! +! .. Scalar Arguments .. + real(wp) :: c, f, g, r, s +! .. +! +! Purpose +! ======= +! +! SLARTG generates a plane rotation so that +! +! [ C S ] . [ F ] = [ R ] +! [ -S C ] [ G ] [ 0 ] +! +! where C**2 + S**2 = 1. +! +! The mathematical formulas used for C and S are +! R = sign(F) * sqrt(F**2 + G**2) +! C = F / R +! S = G / R +! Hence C >= 0. The algorithm used to compute these quantities +! incorporates scaling to avoid overflow or underflow in computing the +! square root of the sum of squares. +! +! This version is discontinuous in R at F = 0 but it returns the same +! C and S as CLARTG for complex inputs (F,0) and (G,0). +! +! Arguments +! ========= +! +! F (input) REAL +! The first component of vector to be rotated. +! +! G (input) REAL +! The second component of vector to be rotated. +! +! C (output) REAL +! The cosine of the rotation. +! +! S (output) REAL +! The sine of the rotation. +! +! R (output) REAL +! The nonzero component of the rotated vector. +! +! ===================================================================== +! +! .. Local Scalars .. + real(wp) :: d, f1, fs, g1, gs, p, u, uu +! .. +! .. Intrinsic Functions .. + intrinsic :: abs, sign, sqrt +! .. +! .. Executable Statements .. +! + f1 = abs( f ) + g1 = abs( g ) + if( g == zero ) then + c = one + s = zero + r = f + else if( f == zero ) then + c = zero + s = sign( one, g ) + r = g1 + else if( f1 > rtmin .and. f1 < rtmax .and. & + g1 > rtmin .and. g1 < rtmax ) then + d = sqrt( f*f + g*g ) + p = one / d + c = f1*p + s = g*sign( p, f ) + r = sign( d, f ) + else + u = min( safmax, max( safmin, f1, g1 ) ) + uu = one / u + fs = f*uu + gs = g*uu + d = sqrt( fs*fs + gs*gs ) + p = one / d + c = abs( fs )*p + s = gs*sign( p, f ) + r = sign( d, f )*u + end if + return +end subroutine diff --git a/SRC/zlartg.f90 b/SRC/zlartg.f90 new file mode 100644 index 0000000000..17edd006f8 --- /dev/null +++ b/SRC/zlartg.f90 @@ -0,0 +1,165 @@ +subroutine ZLARTG( f, g, c, s, r ) + use LA_CONSTANTS, only: wp, zero, one, two, czero, rtmin, rtmax, & + safmin, safmax +! +! LAPACK auxiliary routine +! E. Anderson +! August 4, 2016 +! +! .. Scalar Arguments .. + real(wp) c + complex(wp) f, g, r, s +! .. +! +! Purpose +! ======= +! +! ZLARTG generates a plane rotation so that +! +! [ C S ] . [ F ] = [ R ] +! [ -conjg(S) C ] [ G ] [ 0 ] +! +! where C is real and C**2 + |S|**2 = 1. +! +! The mathematical formulas used for C and S are +! +! sgn(x) = { x / |x|, x != 0 +! { 1, x = 0 +! +! R = sgn(F) * sqrt(|F|**2 + |G|**2) +! +! C = |F| / sqrt(|F|**2 + |G|**2) +! +! S = sgn(F) * conjg(G) / sqrt(|F|**2 + |G|**2) +! +! When F and G are real, the formulas simplify to C = F/R and +! S = G/R, and the returned values of C, S, and R should be +! identical to those returned by DLARTG. +! +! The algorithm used to compute these quantities incorporates scaling +! to avoid overflow or underflow in computing the square root of the +! sum of squares. +! +! Arguments +! ========= +! +! F (input) COMPLEX +! The first component of vector to be rotated. +! +! G (input) COMPLEX +! The second component of vector to be rotated. +! +! C (output) REAL +! The cosine of the rotation. +! +! S (output) COMPLEX +! The sine of the rotation. +! +! R (output) COMPLEX +! The nonzero component of the rotated vector. +! +! ===================================================================== +! +! .. Local Scalars .. + real(wp) :: d, f1, f2, g1, g2, h2, p, u, uu, v, vv, w + complex(wp) :: fs, gs, 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 .. +! + if( g == czero ) then + c = one + s = czero + r = f + else if( f == czero ) then + c = zero + g1 = max( abs(real(g)), abs(aimag(g)) ) + if( g1 > rtmin .and. g1 < rtmax ) then +! +! Use unscaled algorithm +! + g2 = ABSSQ( g ) + d = sqrt( g2 ) + s = conjg( g ) / d + r = d + else +! +! Use scaled algorithm +! + u = min( safmax, max( safmin, g1 ) ) + uu = one / u + gs = g*uu + g2 = ABSSQ( gs ) + d = sqrt( g2 ) + s = conjg( gs ) / d + r = d*u + end if + else + f1 = max( abs(real(f)), abs(aimag(f)) ) + g1 = max( abs(real(g)), abs(aimag(g)) ) + 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 + if( f2 > rtmin .and. h2 < rtmax ) then + d = sqrt( f2*h2 ) + else + d = sqrt( f2 )*sqrt( h2 ) + end if + p = 1 / d + c = f2*p + s = conjg( g )*( f*p ) + r = f*( h2*p ) + else +! +! Use scaled algorithm +! + u = min( safmax, max( safmin, f1, g1 ) ) + uu = one / u + gs = g*uu + g2 = ABSSQ( gs ) + if( f1*uu < rtmin ) then +! +! f is not well-scaled when scaled by g1. +! Use a different scaling for f. +! + v = min( safmax, max( safmin, f1 ) ) + vv = one / v + w = v * uu + fs = f*vv + f2 = ABSSQ( fs ) + h2 = f2*w**2 + g2 + else +! +! Otherwise use the same scaling for f and g. +! + w = one + fs = f*uu + f2 = ABSSQ( fs ) + h2 = f2 + g2 + end if + if( f2 > rtmin .and. h2 < rtmax ) then + d = sqrt( f2*h2 ) + else + d = sqrt( f2 )*sqrt( h2 ) + end if + p = 1 / d + c = ( f2*p )*w + s = conjg( gs )*( fs*p ) + r = ( fs*( h2*p ) )*u + end if + end if + return +end subroutine From a35a5ca7ed101a8e69c1dc084bfa3dd4b3a33492 Mon Sep 17 00:00:00 2001 From: "weslley.spereira" Date: Fri, 19 Feb 2021 17:47:04 -0300 Subject: [PATCH 02/12] Fix Makefile and Meson builds; Rename original xlartg.f files to xlartg_lapackv390.f --- SRC/Makefile | 6 +++++- SRC/{clartg.f => clartg_lapackv390.f} | 0 SRC/{dlartg.f => dlartg_lapackv390.f} | 0 SRC/{slartg.f => slartg_lapackv390.f} | 0 SRC/{zlartg.f => zlartg_lapackv390.f} | 0 5 files changed, 5 insertions(+), 1 deletion(-) rename SRC/{clartg.f => clartg_lapackv390.f} (100%) rename SRC/{dlartg.f => dlartg_lapackv390.f} (100%) rename SRC/{slartg.f => slartg_lapackv390.f} (100%) rename SRC/{zlartg.f => zlartg_lapackv390.f} (100%) diff --git a/SRC/Makefile b/SRC/Makefile index 3895fe5963..f860394ed2 100644 --- a/SRC/Makefile +++ b/SRC/Makefile @@ -57,9 +57,11 @@ TOPSRCDIR = .. include $(TOPSRCDIR)/make.inc -.SUFFIXES: .F .o +.SUFFIXES: .F .f90 .o .F.o: $(FC) $(FFLAGS) -c -o $@ $< +.f90.o: + $(FC) $(FFLAGS) -c -o $@ $< ALLAUX = ilaenv.o ilaenv2stage.o ieeeck.o lsamen.o xerbla.o xerbla_array.o \ iparmq.o iparam2stage.o \ @@ -67,6 +69,7 @@ ALLAUX = ilaenv.o ilaenv2stage.o ieeeck.o lsamen.o xerbla.o xerbla_array.o \ ../INSTALL/ilaver.o ../INSTALL/lsame.o ../INSTALL/slamch.o SCLAUX = \ + la_constants32.o \ sbdsdc.o \ sbdsqr.o sdisna.o slabad.o slacpy.o sladiv.o slae2.o slaebz.o \ slaed0.o slaed1.o slaed2.o slaed3.o slaed4.o slaed5.o slaed6.o \ @@ -85,6 +88,7 @@ SCLAUX = \ ../INSTALL/second_$(TIMER).o DZLAUX = \ + la_constants.o \ dbdsdc.o \ dbdsqr.o ddisna.o dlabad.o dlacpy.o dladiv.o dlae2.o dlaebz.o \ dlaed0.o dlaed1.o dlaed2.o dlaed3.o dlaed4.o dlaed5.o dlaed6.o \ diff --git a/SRC/clartg.f b/SRC/clartg_lapackv390.f similarity index 100% rename from SRC/clartg.f rename to SRC/clartg_lapackv390.f diff --git a/SRC/dlartg.f b/SRC/dlartg_lapackv390.f similarity index 100% rename from SRC/dlartg.f rename to SRC/dlartg_lapackv390.f diff --git a/SRC/slartg.f b/SRC/slartg_lapackv390.f similarity index 100% rename from SRC/slartg.f rename to SRC/slartg_lapackv390.f diff --git a/SRC/zlartg.f b/SRC/zlartg_lapackv390.f similarity index 100% rename from SRC/zlartg.f rename to SRC/zlartg_lapackv390.f From 6fad11cf3798a71dd55d03b4888c621353b353b8 Mon Sep 17 00:00:00 2001 From: "weslley.spereira" Date: Mon, 22 Feb 2021 16:40:12 -0300 Subject: [PATCH 03/12] Move original xLARTG to DEPRECATED; Fix SRC/Makefile --- SRC/{ => DEPRECATED}/clartg_lapackv390.f | 3 +++ SRC/{ => DEPRECATED}/dlartg_lapackv390.f | 3 +++ SRC/{ => DEPRECATED}/slartg_lapackv390.f | 3 +++ SRC/{ => DEPRECATED}/zlartg_lapackv390.f | 3 +++ SRC/Makefile | 25 +++++++++++++++++++----- 5 files changed, 32 insertions(+), 5 deletions(-) rename SRC/{ => DEPRECATED}/clartg_lapackv390.f (97%) rename SRC/{ => DEPRECATED}/dlartg_lapackv390.f (97%) rename SRC/{ => DEPRECATED}/slartg_lapackv390.f (97%) rename SRC/{ => DEPRECATED}/zlartg_lapackv390.f (97%) diff --git a/SRC/clartg_lapackv390.f b/SRC/DEPRECATED/clartg_lapackv390.f similarity index 97% rename from SRC/clartg_lapackv390.f rename to SRC/DEPRECATED/clartg_lapackv390.f index 308900797d..4c5a4dc7a5 100644 --- a/SRC/clartg_lapackv390.f +++ b/SRC/DEPRECATED/clartg_lapackv390.f @@ -85,6 +85,9 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * +*> This implementation of CLARTG has been deprecated with LAPACKv3.10. +*> A better version of CLARTG was contributed by Ed Anderson and released in 3.10. +* *> \ingroup complexOTHERauxiliary * *> \par Further Details: diff --git a/SRC/dlartg_lapackv390.f b/SRC/DEPRECATED/dlartg_lapackv390.f similarity index 97% rename from SRC/dlartg_lapackv390.f rename to SRC/DEPRECATED/dlartg_lapackv390.f index 453bbe78ad..1d77f1d979 100644 --- a/SRC/dlartg_lapackv390.f +++ b/SRC/DEPRECATED/dlartg_lapackv390.f @@ -90,6 +90,9 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * +*> This implementation of DLARTG has been deprecated with LAPACKv3.10. +*> A better version of DLARTG was contributed by Ed Anderson and released in 3.10. +* *> \ingroup OTHERauxiliary * * ===================================================================== diff --git a/SRC/slartg_lapackv390.f b/SRC/DEPRECATED/slartg_lapackv390.f similarity index 97% rename from SRC/slartg_lapackv390.f rename to SRC/DEPRECATED/slartg_lapackv390.f index 6c23d57cc2..16f948944a 100644 --- a/SRC/slartg_lapackv390.f +++ b/SRC/DEPRECATED/slartg_lapackv390.f @@ -90,6 +90,9 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * +*> This implementation of SLARTG has been deprecated with LAPACKv3.10. +*> A better version of SLARTG was contributed by Ed Anderson and released in 3.10. +* *> \ingroup OTHERauxiliary * * ===================================================================== diff --git a/SRC/zlartg_lapackv390.f b/SRC/DEPRECATED/zlartg_lapackv390.f similarity index 97% rename from SRC/zlartg_lapackv390.f rename to SRC/DEPRECATED/zlartg_lapackv390.f index b89761aaf5..a9a16f4fbb 100644 --- a/SRC/zlartg_lapackv390.f +++ b/SRC/DEPRECATED/zlartg_lapackv390.f @@ -85,6 +85,9 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * +*> This implementation of ZLARTG has been deprecated with LAPACKv3.10. +*> A better version of ZLARTG was contributed by Ed Anderson and released in 3.10. +* *> \ingroup complex16OTHERauxiliary * *> \par Further Details: diff --git a/SRC/Makefile b/SRC/Makefile index f860394ed2..e4ea4f1369 100644 --- a/SRC/Makefile +++ b/SRC/Makefile @@ -57,12 +57,20 @@ TOPSRCDIR = .. include $(TOPSRCDIR)/make.inc -.SUFFIXES: .F .f90 .o -.F.o: +ALLMOD = la_constants.mod la_constants32.mod + +.SUFFIXES: .f .F .f90 .F90 .o .mod +%.o: %.f $(ALLMOD) $(FC) $(FFLAGS) -c -o $@ $< -.f90.o: +%.o: %.F $(ALLMOD) $(FC) $(FFLAGS) -c -o $@ $< - +%.o: %.f90 $(ALLMOD) + $(FC) $(FFLAGS) -c -o $@ $< +%.o: %.F90 $(ALLMOD) + $(FC) $(FFLAGS) -c -o $@ $< +.o.mod: + @true + ALLAUX = ilaenv.o ilaenv2stage.o ieeeck.o lsamen.o xerbla.o xerbla_array.o \ iparmq.o iparam2stage.o \ ilaprec.o ilatrans.o ilauplo.o iladiag.o chla_transtype.o \ @@ -612,7 +620,7 @@ endif .PHONY: clean cleanobj cleanlib clean: cleanobj cleanlib cleanobj: - rm -f *.o DEPRECATED/*.o + rm -f *.o *.mod DEPRECATED/*.o DEPRECATED/*.mod cleanlib: rm -f $(LAPACKLIB) @@ -622,3 +630,10 @@ sla_wwaddw.o: sla_wwaddw.f ; $(FC) $(FFLAGS_NOOPT) -c -o $@ $< dla_wwaddw.o: dla_wwaddw.f ; $(FC) $(FFLAGS_NOOPT) -c -o $@ $< cla_wwaddw.o: cla_wwaddw.f ; $(FC) $(FFLAGS_NOOPT) -c -o $@ $< zla_wwaddw.o: zla_wwaddw.f ; $(FC) $(FFLAGS_NOOPT) -c -o $@ $< + +# Modules +la_constants32.o: la_constants32.f90 + $(FC) $(FFLAGS) -c -o $@ $< +la_constants.o: la_constants.f90 + $(FC) $(FFLAGS) -c -o $@ $< + From 9fdf99fe5ab35b9d16348cdd68156a75f63cc5ed Mon Sep 17 00:00:00 2001 From: "weslley.spereira" Date: Wed, 24 Feb 2021 17:24:08 -0300 Subject: [PATCH 04/12] Removes original xLARTG from DEPRECATED; Homogenize float types --- SRC/DEPRECATED/clartg_lapackv390.f | 250 ----------------------------- SRC/DEPRECATED/dlartg_lapackv390.f | 204 ----------------------- SRC/DEPRECATED/slartg_lapackv390.f | 204 ----------------------- SRC/DEPRECATED/zlartg_lapackv390.f | 250 ----------------------------- SRC/clartg.f90 | 12 +- SRC/dlartg.f90 | 6 +- SRC/la_constants.f90 | 47 +++--- SRC/la_constants32.f90 | 47 +++--- SRC/slartg.f90 | 6 +- SRC/zlartg.f90 | 12 +- 10 files changed, 64 insertions(+), 974 deletions(-) delete mode 100644 SRC/DEPRECATED/clartg_lapackv390.f delete mode 100644 SRC/DEPRECATED/dlartg_lapackv390.f delete mode 100644 SRC/DEPRECATED/slartg_lapackv390.f delete mode 100644 SRC/DEPRECATED/zlartg_lapackv390.f diff --git a/SRC/DEPRECATED/clartg_lapackv390.f b/SRC/DEPRECATED/clartg_lapackv390.f deleted file mode 100644 index 4c5a4dc7a5..0000000000 --- a/SRC/DEPRECATED/clartg_lapackv390.f +++ /dev/null @@ -1,250 +0,0 @@ -*> \brief \b CLARTG generates a plane rotation with real cosine and complex sine. -* -* =========== DOCUMENTATION =========== -* -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ -* -*> \htmlonly -*> Download CLARTG + dependencies -*> -*> [TGZ] -*> -*> [ZIP] -*> -*> [TXT] -*> \endhtmlonly -* -* Definition: -* =========== -* -* SUBROUTINE CLARTG( F, G, CS, SN, R ) -* -* .. Scalar Arguments .. -* REAL CS -* COMPLEX F, G, R, SN -* .. -* -* -*> \par Purpose: -* ============= -*> -*> \verbatim -*> -*> CLARTG generates a plane rotation so that -*> -*> [ CS SN ] [ F ] [ R ] -*> [ __ ] . [ ] = [ ] where CS**2 + |SN|**2 = 1. -*> [ -SN CS ] [ G ] [ 0 ] -*> -*> This is a faster version of the BLAS1 routine CROTG, except for -*> the following differences: -*> F and G are unchanged on return. -*> If G=0, then CS=1 and SN=0. -*> If F=0, then CS=0 and SN is chosen so that R is real. -*> \endverbatim -* -* Arguments: -* ========== -* -*> \param[in] F -*> \verbatim -*> F is COMPLEX -*> The first component of vector to be rotated. -*> \endverbatim -*> -*> \param[in] G -*> \verbatim -*> G is COMPLEX -*> The second component of vector to be rotated. -*> \endverbatim -*> -*> \param[out] CS -*> \verbatim -*> CS is REAL -*> The cosine of the rotation. -*> \endverbatim -*> -*> \param[out] SN -*> \verbatim -*> SN is COMPLEX -*> The sine of the rotation. -*> \endverbatim -*> -*> \param[out] R -*> \verbatim -*> R is COMPLEX -*> The nonzero component of the rotated vector. -*> \endverbatim -* -* Authors: -* ======== -* -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> This implementation of CLARTG has been deprecated with LAPACKv3.10. -*> A better version of CLARTG was contributed by Ed Anderson and released in 3.10. -* -*> \ingroup complexOTHERauxiliary -* -*> \par Further Details: -* ===================== -*> -*> \verbatim -*> -*> 3-5-96 - Modified with a new algorithm by W. Kahan and J. Demmel -*> -*> This version has a few statements commented out for thread safety -*> (machine parameters are computed on each entry). 10 feb 03, SJH. -*> \endverbatim -*> -* ===================================================================== - SUBROUTINE CLARTG( F, G, CS, SN, R ) -* -* -- LAPACK auxiliary routine -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* -* .. Scalar Arguments .. - REAL CS - COMPLEX F, G, R, SN -* .. -* -* ===================================================================== -* -* .. Parameters .. - REAL TWO, ONE, ZERO - PARAMETER ( TWO = 2.0E+0, ONE = 1.0E+0, ZERO = 0.0E+0 ) - COMPLEX CZERO - PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ) ) -* .. -* .. Local Scalars .. -* LOGICAL FIRST - INTEGER COUNT, I - REAL D, DI, DR, EPS, F2, F2S, G2, G2S, SAFMIN, - $ SAFMN2, SAFMX2, SCALE - COMPLEX FF, FS, GS -* .. -* .. External Functions .. - REAL SLAMCH, SLAPY2 - LOGICAL SISNAN - EXTERNAL SLAMCH, SLAPY2, SISNAN -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, AIMAG, CMPLX, CONJG, INT, LOG, MAX, REAL, - $ SQRT -* .. -* .. Statement Functions .. - REAL ABS1, ABSSQ -* .. -* .. Statement Function definitions .. - ABS1( FF ) = MAX( ABS( REAL( FF ) ), ABS( AIMAG( FF ) ) ) - ABSSQ( FF ) = REAL( FF )**2 + AIMAG( FF )**2 -* .. -* .. Executable Statements .. -* - SAFMIN = SLAMCH( 'S' ) - EPS = SLAMCH( 'E' ) - SAFMN2 = SLAMCH( 'B' )**INT( LOG( SAFMIN / EPS ) / - $ LOG( SLAMCH( 'B' ) ) / TWO ) - SAFMX2 = ONE / SAFMN2 - SCALE = MAX( ABS1( F ), ABS1( G ) ) - FS = F - GS = G - COUNT = 0 - IF( SCALE.GE.SAFMX2 ) THEN - 10 CONTINUE - COUNT = COUNT + 1 - FS = FS*SAFMN2 - GS = GS*SAFMN2 - SCALE = SCALE*SAFMN2 - IF( SCALE.GE.SAFMX2 .AND. COUNT .LT. 20) - $ GO TO 10 - ELSE IF( SCALE.LE.SAFMN2 ) THEN - IF( G.EQ.CZERO.OR.SISNAN( ABS( G ) ) ) THEN - CS = ONE - SN = CZERO - R = F - RETURN - END IF - 20 CONTINUE - COUNT = COUNT - 1 - FS = FS*SAFMX2 - GS = GS*SAFMX2 - SCALE = SCALE*SAFMX2 - IF( SCALE.LE.SAFMN2 ) - $ GO TO 20 - END IF - F2 = ABSSQ( FS ) - G2 = ABSSQ( GS ) - IF( F2.LE.MAX( G2, ONE )*SAFMIN ) THEN -* -* This is a rare case: F is very small. -* - IF( F.EQ.CZERO ) THEN - CS = ZERO - R = SLAPY2( REAL( G ), AIMAG( G ) ) -* Do complex/real division explicitly with two real divisions - D = SLAPY2( REAL( GS ), AIMAG( GS ) ) - SN = CMPLX( REAL( GS ) / D, -AIMAG( GS ) / D ) - RETURN - END IF - F2S = SLAPY2( REAL( FS ), AIMAG( FS ) ) -* G2 and G2S are accurate -* G2 is at least SAFMIN, and G2S is at least SAFMN2 - G2S = SQRT( G2 ) -* Error in CS from underflow in F2S is at most -* UNFL / SAFMN2 .lt. sqrt(UNFL*EPS) .lt. EPS -* If MAX(G2,ONE)=G2, then F2 .lt. G2*SAFMIN, -* and so CS .lt. sqrt(SAFMIN) -* If MAX(G2,ONE)=ONE, then F2 .lt. SAFMIN -* and so CS .lt. sqrt(SAFMIN)/SAFMN2 = sqrt(EPS) -* Therefore, CS = F2S/G2S / sqrt( 1 + (F2S/G2S)**2 ) = F2S/G2S - CS = F2S / G2S -* Make sure abs(FF) = 1 -* Do complex/real division explicitly with 2 real divisions - IF( ABS1( F ).GT.ONE ) THEN - D = SLAPY2( REAL( F ), AIMAG( F ) ) - FF = CMPLX( REAL( F ) / D, AIMAG( F ) / D ) - ELSE - DR = SAFMX2*REAL( F ) - DI = SAFMX2*AIMAG( F ) - D = SLAPY2( DR, DI ) - FF = CMPLX( DR / D, DI / D ) - END IF - SN = FF*CMPLX( REAL( GS ) / G2S, -AIMAG( GS ) / G2S ) - R = CS*F + SN*G - ELSE -* -* This is the most common case. -* Neither F2 nor F2/G2 are less than SAFMIN -* F2S cannot overflow, and it is accurate -* - F2S = SQRT( ONE+G2 / F2 ) -* Do the F2S(real)*FS(complex) multiply with two real multiplies - R = CMPLX( F2S*REAL( FS ), F2S*AIMAG( FS ) ) - CS = ONE / F2S - D = F2 + G2 -* Do complex/real division explicitly with two real divisions - SN = CMPLX( REAL( R ) / D, AIMAG( R ) / D ) - SN = SN*CONJG( GS ) - IF( COUNT.NE.0 ) THEN - IF( COUNT.GT.0 ) THEN - DO 30 I = 1, COUNT - R = R*SAFMX2 - 30 CONTINUE - ELSE - DO 40 I = 1, -COUNT - R = R*SAFMN2 - 40 CONTINUE - END IF - END IF - END IF - RETURN -* -* End of CLARTG -* - END diff --git a/SRC/DEPRECATED/dlartg_lapackv390.f b/SRC/DEPRECATED/dlartg_lapackv390.f deleted file mode 100644 index 1d77f1d979..0000000000 --- a/SRC/DEPRECATED/dlartg_lapackv390.f +++ /dev/null @@ -1,204 +0,0 @@ -*> \brief \b DLARTG generates a plane rotation with real cosine and real sine. -* -* =========== DOCUMENTATION =========== -* -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ -* -*> \htmlonly -*> Download DLARTG + dependencies -*> -*> [TGZ] -*> -*> [ZIP] -*> -*> [TXT] -*> \endhtmlonly -* -* Definition: -* =========== -* -* SUBROUTINE DLARTG( F, G, CS, SN, R ) -* -* .. Scalar Arguments .. -* DOUBLE PRECISION CS, F, G, R, SN -* .. -* -* -*> \par Purpose: -* ============= -*> -*> \verbatim -*> -*> DLARTG generate a plane rotation so that -*> -*> [ CS SN ] . [ F ] = [ R ] where CS**2 + SN**2 = 1. -*> [ -SN CS ] [ G ] [ 0 ] -*> -*> This is a slower, more accurate version of the BLAS1 routine DROTG, -*> with the following other differences: -*> F and G are unchanged on return. -*> If G=0, then CS=1 and SN=0. -*> If F=0 and (G .ne. 0), then CS=0 and SN=1 without doing any -*> floating point operations (saves work in DBDSQR when -*> there are zeros on the diagonal). -*> -*> If F exceeds G in magnitude, CS will be positive. -*> \endverbatim -* -* Arguments: -* ========== -* -*> \param[in] F -*> \verbatim -*> F is DOUBLE PRECISION -*> The first component of vector to be rotated. -*> \endverbatim -*> -*> \param[in] G -*> \verbatim -*> G is DOUBLE PRECISION -*> The second component of vector to be rotated. -*> \endverbatim -*> -*> \param[out] CS -*> \verbatim -*> CS is DOUBLE PRECISION -*> The cosine of the rotation. -*> \endverbatim -*> -*> \param[out] SN -*> \verbatim -*> SN is DOUBLE PRECISION -*> The sine of the rotation. -*> \endverbatim -*> -*> \param[out] R -*> \verbatim -*> R is DOUBLE PRECISION -*> The nonzero component of the rotated vector. -*> -*> This version has a few statements commented out for thread safety -*> (machine parameters are computed on each entry). 10 feb 03, SJH. -*> \endverbatim -* -* Authors: -* ======== -* -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> This implementation of DLARTG has been deprecated with LAPACKv3.10. -*> A better version of DLARTG was contributed by Ed Anderson and released in 3.10. -* -*> \ingroup OTHERauxiliary -* -* ===================================================================== - SUBROUTINE DLARTG( F, G, CS, SN, R ) -* -* -- LAPACK auxiliary routine -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* -* .. Scalar Arguments .. - DOUBLE PRECISION CS, F, G, R, SN -* .. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO - PARAMETER ( ZERO = 0.0D0 ) - DOUBLE PRECISION ONE - PARAMETER ( ONE = 1.0D0 ) - DOUBLE PRECISION TWO - PARAMETER ( TWO = 2.0D0 ) -* .. -* .. Local Scalars .. -* LOGICAL FIRST - INTEGER COUNT, I - DOUBLE PRECISION EPS, F1, G1, SAFMIN, SAFMN2, SAFMX2, SCALE -* .. -* .. External Functions .. - DOUBLE PRECISION DLAMCH - EXTERNAL DLAMCH -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, INT, LOG, MAX, SQRT -* .. -* .. Save statement .. -* SAVE FIRST, SAFMX2, SAFMIN, SAFMN2 -* .. -* .. Data statements .. -* DATA FIRST / .TRUE. / -* .. -* .. Executable Statements .. -* -* IF( FIRST ) THEN - SAFMIN = DLAMCH( 'S' ) - EPS = DLAMCH( 'E' ) - SAFMN2 = DLAMCH( 'B' )**INT( LOG( SAFMIN / EPS ) / - $ LOG( DLAMCH( 'B' ) ) / TWO ) - SAFMX2 = ONE / SAFMN2 -* FIRST = .FALSE. -* END IF - IF( G.EQ.ZERO ) THEN - CS = ONE - SN = ZERO - R = F - ELSE IF( F.EQ.ZERO ) THEN - CS = ZERO - SN = ONE - R = G - ELSE - F1 = F - G1 = G - SCALE = MAX( ABS( F1 ), ABS( G1 ) ) - IF( SCALE.GE.SAFMX2 ) THEN - COUNT = 0 - 10 CONTINUE - COUNT = COUNT + 1 - F1 = F1*SAFMN2 - G1 = G1*SAFMN2 - SCALE = MAX( ABS( F1 ), ABS( G1 ) ) - IF( SCALE.GE.SAFMX2 .AND. COUNT .LT. 20) - $ GO TO 10 - R = SQRT( F1**2+G1**2 ) - CS = F1 / R - SN = G1 / R - DO 20 I = 1, COUNT - R = R*SAFMX2 - 20 CONTINUE - ELSE IF( SCALE.LE.SAFMN2 ) THEN - COUNT = 0 - 30 CONTINUE - COUNT = COUNT + 1 - F1 = F1*SAFMX2 - G1 = G1*SAFMX2 - SCALE = MAX( ABS( F1 ), ABS( G1 ) ) - IF( SCALE.LE.SAFMN2 ) - $ GO TO 30 - R = SQRT( F1**2+G1**2 ) - CS = F1 / R - SN = G1 / R - DO 40 I = 1, COUNT - R = R*SAFMN2 - 40 CONTINUE - ELSE - R = SQRT( F1**2+G1**2 ) - CS = F1 / R - SN = G1 / R - END IF - IF( ABS( F ).GT.ABS( G ) .AND. CS.LT.ZERO ) THEN - CS = -CS - SN = -SN - R = -R - END IF - END IF - RETURN -* -* End of DLARTG -* - END diff --git a/SRC/DEPRECATED/slartg_lapackv390.f b/SRC/DEPRECATED/slartg_lapackv390.f deleted file mode 100644 index 16f948944a..0000000000 --- a/SRC/DEPRECATED/slartg_lapackv390.f +++ /dev/null @@ -1,204 +0,0 @@ -*> \brief \b SLARTG generates a plane rotation with real cosine and real sine. -* -* =========== DOCUMENTATION =========== -* -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ -* -*> \htmlonly -*> Download SLARTG + dependencies -*> -*> [TGZ] -*> -*> [ZIP] -*> -*> [TXT] -*> \endhtmlonly -* -* Definition: -* =========== -* -* SUBROUTINE SLARTG( F, G, CS, SN, R ) -* -* .. Scalar Arguments .. -* REAL CS, F, G, R, SN -* .. -* -* -*> \par Purpose: -* ============= -*> -*> \verbatim -*> -*> SLARTG generate a plane rotation so that -*> -*> [ CS SN ] . [ F ] = [ R ] where CS**2 + SN**2 = 1. -*> [ -SN CS ] [ G ] [ 0 ] -*> -*> This is a slower, more accurate version of the BLAS1 routine SROTG, -*> with the following other differences: -*> F and G are unchanged on return. -*> If G=0, then CS=1 and SN=0. -*> If F=0 and (G .ne. 0), then CS=0 and SN=1 without doing any -*> floating point operations (saves work in SBDSQR when -*> there are zeros on the diagonal). -*> -*> If F exceeds G in magnitude, CS will be positive. -*> \endverbatim -* -* Arguments: -* ========== -* -*> \param[in] F -*> \verbatim -*> F is REAL -*> The first component of vector to be rotated. -*> \endverbatim -*> -*> \param[in] G -*> \verbatim -*> G is REAL -*> The second component of vector to be rotated. -*> \endverbatim -*> -*> \param[out] CS -*> \verbatim -*> CS is REAL -*> The cosine of the rotation. -*> \endverbatim -*> -*> \param[out] SN -*> \verbatim -*> SN is REAL -*> The sine of the rotation. -*> \endverbatim -*> -*> \param[out] R -*> \verbatim -*> R is REAL -*> The nonzero component of the rotated vector. -*> -*> This version has a few statements commented out for thread safety -*> (machine parameters are computed on each entry). 10 feb 03, SJH. -*> \endverbatim -* -* Authors: -* ======== -* -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> This implementation of SLARTG has been deprecated with LAPACKv3.10. -*> A better version of SLARTG was contributed by Ed Anderson and released in 3.10. -* -*> \ingroup OTHERauxiliary -* -* ===================================================================== - SUBROUTINE SLARTG( F, G, CS, SN, R ) -* -* -- LAPACK auxiliary routine -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* -* .. Scalar Arguments .. - REAL CS, F, G, R, SN -* .. -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO - PARAMETER ( ZERO = 0.0E0 ) - REAL ONE - PARAMETER ( ONE = 1.0E0 ) - REAL TWO - PARAMETER ( TWO = 2.0E0 ) -* .. -* .. Local Scalars .. -* LOGICAL FIRST - INTEGER COUNT, I - REAL EPS, F1, G1, SAFMIN, SAFMN2, SAFMX2, SCALE -* .. -* .. External Functions .. - REAL SLAMCH - EXTERNAL SLAMCH -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, INT, LOG, MAX, SQRT -* .. -* .. Save statement .. -* SAVE FIRST, SAFMX2, SAFMIN, SAFMN2 -* .. -* .. Data statements .. -* DATA FIRST / .TRUE. / -* .. -* .. Executable Statements .. -* -* IF( FIRST ) THEN - SAFMIN = SLAMCH( 'S' ) - EPS = SLAMCH( 'E' ) - SAFMN2 = SLAMCH( 'B' )**INT( LOG( SAFMIN / EPS ) / - $ LOG( SLAMCH( 'B' ) ) / TWO ) - SAFMX2 = ONE / SAFMN2 -* FIRST = .FALSE. -* END IF - IF( G.EQ.ZERO ) THEN - CS = ONE - SN = ZERO - R = F - ELSE IF( F.EQ.ZERO ) THEN - CS = ZERO - SN = ONE - R = G - ELSE - F1 = F - G1 = G - SCALE = MAX( ABS( F1 ), ABS( G1 ) ) - IF( SCALE.GE.SAFMX2 ) THEN - COUNT = 0 - 10 CONTINUE - COUNT = COUNT + 1 - F1 = F1*SAFMN2 - G1 = G1*SAFMN2 - SCALE = MAX( ABS( F1 ), ABS( G1 ) ) - IF( SCALE.GE.SAFMX2 .AND. COUNT .LT. 20) - $ GO TO 10 - R = SQRT( F1**2+G1**2 ) - CS = F1 / R - SN = G1 / R - DO 20 I = 1, COUNT - R = R*SAFMX2 - 20 CONTINUE - ELSE IF( SCALE.LE.SAFMN2 ) THEN - COUNT = 0 - 30 CONTINUE - COUNT = COUNT + 1 - F1 = F1*SAFMX2 - G1 = G1*SAFMX2 - SCALE = MAX( ABS( F1 ), ABS( G1 ) ) - IF( SCALE.LE.SAFMN2 ) - $ GO TO 30 - R = SQRT( F1**2+G1**2 ) - CS = F1 / R - SN = G1 / R - DO 40 I = 1, COUNT - R = R*SAFMN2 - 40 CONTINUE - ELSE - R = SQRT( F1**2+G1**2 ) - CS = F1 / R - SN = G1 / R - END IF - IF( ABS( F ).GT.ABS( G ) .AND. CS.LT.ZERO ) THEN - CS = -CS - SN = -SN - R = -R - END IF - END IF - RETURN -* -* End of SLARTG -* - END diff --git a/SRC/DEPRECATED/zlartg_lapackv390.f b/SRC/DEPRECATED/zlartg_lapackv390.f deleted file mode 100644 index a9a16f4fbb..0000000000 --- a/SRC/DEPRECATED/zlartg_lapackv390.f +++ /dev/null @@ -1,250 +0,0 @@ -*> \brief \b ZLARTG generates a plane rotation with real cosine and complex sine. -* -* =========== DOCUMENTATION =========== -* -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ -* -*> \htmlonly -*> Download ZLARTG + dependencies -*> -*> [TGZ] -*> -*> [ZIP] -*> -*> [TXT] -*> \endhtmlonly -* -* Definition: -* =========== -* -* SUBROUTINE ZLARTG( F, G, CS, SN, R ) -* -* .. Scalar Arguments .. -* DOUBLE PRECISION CS -* COMPLEX*16 F, G, R, SN -* .. -* -* -*> \par Purpose: -* ============= -*> -*> \verbatim -*> -*> ZLARTG generates a plane rotation so that -*> -*> [ CS SN ] [ F ] [ R ] -*> [ __ ] . [ ] = [ ] where CS**2 + |SN|**2 = 1. -*> [ -SN CS ] [ G ] [ 0 ] -*> -*> This is a faster version of the BLAS1 routine ZROTG, except for -*> the following differences: -*> F and G are unchanged on return. -*> If G=0, then CS=1 and SN=0. -*> If F=0, then CS=0 and SN is chosen so that R is real. -*> \endverbatim -* -* Arguments: -* ========== -* -*> \param[in] F -*> \verbatim -*> F is COMPLEX*16 -*> The first component of vector to be rotated. -*> \endverbatim -*> -*> \param[in] G -*> \verbatim -*> G is COMPLEX*16 -*> The second component of vector to be rotated. -*> \endverbatim -*> -*> \param[out] CS -*> \verbatim -*> CS is DOUBLE PRECISION -*> The cosine of the rotation. -*> \endverbatim -*> -*> \param[out] SN -*> \verbatim -*> SN is COMPLEX*16 -*> The sine of the rotation. -*> \endverbatim -*> -*> \param[out] R -*> \verbatim -*> R is COMPLEX*16 -*> The nonzero component of the rotated vector. -*> \endverbatim -* -* Authors: -* ======== -* -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> This implementation of ZLARTG has been deprecated with LAPACKv3.10. -*> A better version of ZLARTG was contributed by Ed Anderson and released in 3.10. -* -*> \ingroup complex16OTHERauxiliary -* -*> \par Further Details: -* ===================== -*> -*> \verbatim -*> -*> 3-5-96 - Modified with a new algorithm by W. Kahan and J. Demmel -*> -*> This version has a few statements commented out for thread safety -*> (machine parameters are computed on each entry). 10 feb 03, SJH. -*> \endverbatim -*> -* ===================================================================== - SUBROUTINE ZLARTG( F, G, CS, SN, R ) -* -* -- LAPACK auxiliary routine -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* -* .. Scalar Arguments .. - DOUBLE PRECISION CS - COMPLEX*16 F, G, R, SN -* .. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION TWO, ONE, ZERO - PARAMETER ( TWO = 2.0D+0, ONE = 1.0D+0, ZERO = 0.0D+0 ) - COMPLEX*16 CZERO - PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ) ) -* .. -* .. Local Scalars .. -* LOGICAL FIRST - INTEGER COUNT, I - DOUBLE PRECISION D, DI, DR, EPS, F2, F2S, G2, G2S, SAFMIN, - $ SAFMN2, SAFMX2, SCALE - COMPLEX*16 FF, FS, GS -* .. -* .. External Functions .. - DOUBLE PRECISION DLAMCH, DLAPY2 - LOGICAL DISNAN - EXTERNAL DLAMCH, DLAPY2, DISNAN -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, DBLE, DCMPLX, DCONJG, DIMAG, INT, LOG, - $ MAX, SQRT -* .. -* .. Statement Functions .. - DOUBLE PRECISION ABS1, ABSSQ -* .. -* .. Statement Function definitions .. - ABS1( FF ) = MAX( ABS( DBLE( FF ) ), ABS( DIMAG( FF ) ) ) - ABSSQ( FF ) = DBLE( FF )**2 + DIMAG( FF )**2 -* .. -* .. Executable Statements .. -* - SAFMIN = DLAMCH( 'S' ) - EPS = DLAMCH( 'E' ) - SAFMN2 = DLAMCH( 'B' )**INT( LOG( SAFMIN / EPS ) / - $ LOG( DLAMCH( 'B' ) ) / TWO ) - SAFMX2 = ONE / SAFMN2 - SCALE = MAX( ABS1( F ), ABS1( G ) ) - FS = F - GS = G - COUNT = 0 - IF( SCALE.GE.SAFMX2 ) THEN - 10 CONTINUE - COUNT = COUNT + 1 - FS = FS*SAFMN2 - GS = GS*SAFMN2 - SCALE = SCALE*SAFMN2 - IF( SCALE.GE.SAFMX2 .AND. COUNT .LT. 20 ) - $ GO TO 10 - ELSE IF( SCALE.LE.SAFMN2 ) THEN - IF( G.EQ.CZERO.OR.DISNAN( ABS( G ) ) ) THEN - CS = ONE - SN = CZERO - R = F - RETURN - END IF - 20 CONTINUE - COUNT = COUNT - 1 - FS = FS*SAFMX2 - GS = GS*SAFMX2 - SCALE = SCALE*SAFMX2 - IF( SCALE.LE.SAFMN2 ) - $ GO TO 20 - END IF - F2 = ABSSQ( FS ) - G2 = ABSSQ( GS ) - IF( F2.LE.MAX( G2, ONE )*SAFMIN ) THEN -* -* This is a rare case: F is very small. -* - IF( F.EQ.CZERO ) THEN - CS = ZERO - R = DLAPY2( DBLE( G ), DIMAG( G ) ) -* Do complex/real division explicitly with two real divisions - D = DLAPY2( DBLE( GS ), DIMAG( GS ) ) - SN = DCMPLX( DBLE( GS ) / D, -DIMAG( GS ) / D ) - RETURN - END IF - F2S = DLAPY2( DBLE( FS ), DIMAG( FS ) ) -* G2 and G2S are accurate -* G2 is at least SAFMIN, and G2S is at least SAFMN2 - G2S = SQRT( G2 ) -* Error in CS from underflow in F2S is at most -* UNFL / SAFMN2 .lt. sqrt(UNFL*EPS) .lt. EPS -* If MAX(G2,ONE)=G2, then F2 .lt. G2*SAFMIN, -* and so CS .lt. sqrt(SAFMIN) -* If MAX(G2,ONE)=ONE, then F2 .lt. SAFMIN -* and so CS .lt. sqrt(SAFMIN)/SAFMN2 = sqrt(EPS) -* Therefore, CS = F2S/G2S / sqrt( 1 + (F2S/G2S)**2 ) = F2S/G2S - CS = F2S / G2S -* Make sure abs(FF) = 1 -* Do complex/real division explicitly with 2 real divisions - IF( ABS1( F ).GT.ONE ) THEN - D = DLAPY2( DBLE( F ), DIMAG( F ) ) - FF = DCMPLX( DBLE( F ) / D, DIMAG( F ) / D ) - ELSE - DR = SAFMX2*DBLE( F ) - DI = SAFMX2*DIMAG( F ) - D = DLAPY2( DR, DI ) - FF = DCMPLX( DR / D, DI / D ) - END IF - SN = FF*DCMPLX( DBLE( GS ) / G2S, -DIMAG( GS ) / G2S ) - R = CS*F + SN*G - ELSE -* -* This is the most common case. -* Neither F2 nor F2/G2 are less than SAFMIN -* F2S cannot overflow, and it is accurate -* - F2S = SQRT( ONE+G2 / F2 ) -* Do the F2S(real)*FS(complex) multiply with two real multiplies - R = DCMPLX( F2S*DBLE( FS ), F2S*DIMAG( FS ) ) - CS = ONE / F2S - D = F2 + G2 -* Do complex/real division explicitly with two real divisions - SN = DCMPLX( DBLE( R ) / D, DIMAG( R ) / D ) - SN = SN*DCONJG( GS ) - IF( COUNT.NE.0 ) THEN - IF( COUNT.GT.0 ) THEN - DO 30 I = 1, COUNT - R = R*SAFMX2 - 30 CONTINUE - ELSE - DO 40 I = 1, -COUNT - R = R*SAFMN2 - 40 CONTINUE - END IF - END IF - END IF - RETURN -* -* End of ZLARTG -* - END diff --git a/SRC/clartg.f90 b/SRC/clartg.f90 index 1e44e35bbd..6d3cca7566 100644 --- a/SRC/clartg.f90 +++ b/SRC/clartg.f90 @@ -1,5 +1,5 @@ subroutine CLARTG( f, g, c, s, r ) - use LA_CONSTANTS32, only: wp, zero, one, two, czero, rtmin, rtmax, & + use LA_CONSTANTS32, only: zero, one, two, czero, rtmin, rtmax, & safmin, safmax ! ! LAPACK auxiliary routine @@ -7,8 +7,8 @@ subroutine CLARTG( f, g, c, s, r ) ! August 4, 2016 ! ! .. Scalar Arguments .. - real(wp) c - complex(wp) f, g, r, s + real c + complex f, g, r, s ! .. ! ! Purpose @@ -61,14 +61,14 @@ subroutine CLARTG( f, g, c, s, r ) ! ===================================================================== ! ! .. Local Scalars .. - real(wp) :: d, f1, f2, g1, g2, h2, p, u, uu, v, vv, w - complex(wp) :: fs, gs, t + real :: d, f1, f2, g1, g2, h2, p, u, uu, v, vv, w + complex :: fs, gs, t ! .. ! .. Intrinsic Functions .. intrinsic :: abs, aimag, conjg, max, min, real, sqrt ! .. ! .. Statement Functions .. - real(wp) :: ABSSQ + real :: ABSSQ ! .. ! .. Statement Function definitions .. ABSSQ( t ) = real( t )**2 + aimag( t )**2 diff --git a/SRC/dlartg.f90 b/SRC/dlartg.f90 index 32e8997a17..d409a7ec83 100644 --- a/SRC/dlartg.f90 +++ b/SRC/dlartg.f90 @@ -1,12 +1,12 @@ subroutine DLARTG( f, g, c, s, r ) - use LA_CONSTANTS, only: wp, zero, half, one, rtmin, rtmax, safmin, safmax + use LA_CONSTANTS, only: zero, half, one, rtmin, rtmax, safmin, safmax ! ! LAPACK auxiliary routine ! E. Anderson ! July 30, 2016 ! ! .. Scalar Arguments .. - real(wp) :: c, f, g, r, s + double precision :: c, f, g, r, s ! .. ! ! Purpose @@ -51,7 +51,7 @@ subroutine DLARTG( f, g, c, s, r ) ! ===================================================================== ! ! .. Local Scalars .. - real(wp) :: d, f1, fs, g1, gs, p, u, uu + double precision :: d, f1, fs, g1, gs, p, u, uu ! .. ! .. Intrinsic Functions .. intrinsic :: abs, sign, sqrt diff --git a/SRC/la_constants.f90 b/SRC/la_constants.f90 index 8306d1ed83..a071a1472e 100644 --- a/SRC/la_constants.f90 +++ b/SRC/la_constants.f90 @@ -5,36 +5,35 @@ module LA_CONSTANTS ! ! Standard constants ! - integer, parameter :: wp = 8 - real(wp), parameter :: zero = 0.0_wp - real(wp), parameter :: half = 0.5_wp - real(wp), parameter :: one = 1.0_wp - real(wp), parameter :: two = 2.0_wp - real(wp), parameter :: three = 3.0_wp - real(wp), parameter :: four = 4.0_wp - real(wp), parameter :: eight = 8.0_wp - real(wp), parameter :: ten = 10.0_wp - complex(wp), parameter :: czero = ( 0.0_wp, 0.0_wp ) - complex(wp), parameter :: chalf = ( 0.5_wp, 0.0_wp ) - complex(wp), parameter :: cone = ( 1.0_wp, 0.0_wp ) + double precision, parameter :: zero = 0.0 + double precision, parameter :: half = 0.5 + double precision, parameter :: one = 1.0 + double precision, parameter :: two = 2.0 + double precision, parameter :: three = 3.0 + double precision, parameter :: four = 4.0 + double precision, parameter :: eight = 8.0 + double precision, parameter :: ten = 10.0 + complex*16, parameter :: czero = ( 0.0, 0.0 ) + complex*16, parameter :: chalf = ( 0.5, 0.0 ) + complex*16, parameter :: cone = ( 1.0, 0.0 ) character*1, parameter :: sprefix = 'D' character*1, parameter :: cprefix = 'Z' ! ! Model parameters ! - real(wp), parameter :: eps = 0.11102230246251565404E-015_wp - real(wp), parameter :: ulp = 0.22204460492503130808E-015_wp - real(wp), parameter :: safmin = 0.22250738585072013831E-307_wp - real(wp), parameter :: safmax = 0.44942328371557897693E+308_wp - real(wp), parameter :: smlnum = 0.10020841800044863890E-291_wp - real(wp), parameter :: bignum = 0.99792015476735990583E+292_wp - real(wp), parameter :: rtmin = 0.10010415475915504622E-145_wp - real(wp), parameter :: rtmax = 0.99895953610111751404E+146_wp + double precision, parameter :: eps = 0.11102230246251565404D-015 + double precision, parameter :: ulp = 0.22204460492503130808D-015 + double precision, parameter :: safmin = 0.22250738585072013831D-307 + double precision, parameter :: safmax = 0.44942328371557897693D+308 + double precision, parameter :: smlnum = 0.10020841800044863890D-291 + double precision, parameter :: bignum = 0.99792015476735990583D+292 + double precision, parameter :: rtmin = 0.10010415475915504622D-145 + double precision, parameter :: rtmax = 0.99895953610111751404D+146 ! ! Blue's scaling constants ! - real(wp), parameter :: tsml = 0.14916681462400413487E-153_wp - real(wp), parameter :: tbig = 0.19979190722022350281E+147_wp - real(wp), parameter :: ssml = 0.44989137945431963828E+162_wp - real(wp), parameter :: sbig = 0.11113793747425387417E-161_wp + double precision, parameter :: tsml = 0.14916681462400413487D-153 + double precision, parameter :: tbig = 0.19979190722022350281D+147 + double precision, parameter :: ssml = 0.44989137945431963828D+162 + double precision, parameter :: sbig = 0.11113793747425387417D-161 end module LA_CONSTANTS diff --git a/SRC/la_constants32.f90 b/SRC/la_constants32.f90 index d495709e92..547e0f276b 100644 --- a/SRC/la_constants32.f90 +++ b/SRC/la_constants32.f90 @@ -5,36 +5,35 @@ module LA_CONSTANTS32 ! ! Standard constants ! - integer, parameter :: wp = 4 - real(wp), parameter :: zero = 0.0_wp - real(wp), parameter :: half = 0.5_wp - real(wp), parameter :: one = 1.0_wp - real(wp), parameter :: two = 2.0_wp - real(wp), parameter :: three = 3.0_wp - real(wp), parameter :: four = 4.0_wp - real(wp), parameter :: eight = 8.0_wp - real(wp), parameter :: ten = 10.0_wp - complex(wp), parameter :: czero = ( 0.0_wp, 0.0_wp ) - complex(wp), parameter :: chalf = ( 0.5_wp, 0.0_wp ) - complex(wp), parameter :: cone = ( 1.0_wp, 0.0_wp ) + real, parameter :: zero = 0.0 + real, parameter :: half = 0.5 + real, parameter :: one = 1.0 + real, parameter :: two = 2.0 + real, parameter :: three = 3.0 + real, parameter :: four = 4.0 + real, parameter :: eight = 8.0 + real, parameter :: ten = 10.0 + complex, parameter :: czero = ( 0.0, 0.0 ) + complex, parameter :: chalf = ( 0.5, 0.0 ) + complex, parameter :: cone = ( 1.0, 0.0 ) character*1, parameter :: sprefix = 'S' character*1, parameter :: cprefix = 'C' ! ! Model parameters ! - real(wp), parameter :: eps = 0.5960464478E-07_wp - real(wp), parameter :: ulp = 0.1192092896E-06_wp - real(wp), parameter :: safmin = 0.1175494351E-37_wp - real(wp), parameter :: safmax = 0.8507059173E+38_wp - real(wp), parameter :: smlnum = 0.9860761315E-31_wp - real(wp), parameter :: bignum = 0.1014120480E+32_wp - real(wp), parameter :: rtmin = 0.3140184864E-15_wp - real(wp), parameter :: rtmax = 0.3184525782E+16_wp + real, parameter :: eps = 0.5960464478E-07 + real, parameter :: ulp = 0.1192092896E-06 + real, parameter :: safmin = 0.1175494351E-37 + real, parameter :: safmax = 0.8507059173E+38 + real, parameter :: smlnum = 0.9860761315E-31 + real, parameter :: bignum = 0.1014120480E+32 + real, parameter :: rtmin = 0.3140184864E-15 + real, parameter :: rtmax = 0.3184525782E+16 ! ! Blue's scaling constants ! - real(wp), parameter :: tsml = 0.1084202172E-18_wp - real(wp), parameter :: tbig = 0.4503599627E+16_wp - real(wp), parameter :: ssml = 0.3777893186E+23_wp - real(wp), parameter :: sbig = 0.1323488980E-22_wp + real, parameter :: tsml = 0.1084202172E-18 + real, parameter :: tbig = 0.4503599627E+16 + real, parameter :: ssml = 0.3777893186E+23 + real, parameter :: sbig = 0.1323488980E-22 end module LA_CONSTANTS32 diff --git a/SRC/slartg.f90 b/SRC/slartg.f90 index 71f3ed7a76..176959cf26 100644 --- a/SRC/slartg.f90 +++ b/SRC/slartg.f90 @@ -1,12 +1,12 @@ subroutine SLARTG( f, g, c, s, r ) - use LA_CONSTANTS32, only: wp, zero, half, one, rtmin, rtmax, safmin, safmax + use LA_CONSTANTS32, only: zero, half, one, rtmin, rtmax, safmin, safmax ! ! LAPACK auxiliary routine ! E. Anderson ! July 30, 2016 ! ! .. Scalar Arguments .. - real(wp) :: c, f, g, r, s + real :: c, f, g, r, s ! .. ! ! Purpose @@ -51,7 +51,7 @@ subroutine SLARTG( f, g, c, s, r ) ! ===================================================================== ! ! .. Local Scalars .. - real(wp) :: d, f1, fs, g1, gs, p, u, uu + real :: d, f1, fs, g1, gs, p, u, uu ! .. ! .. Intrinsic Functions .. intrinsic :: abs, sign, sqrt diff --git a/SRC/zlartg.f90 b/SRC/zlartg.f90 index 17edd006f8..5c7443e8af 100644 --- a/SRC/zlartg.f90 +++ b/SRC/zlartg.f90 @@ -1,5 +1,5 @@ subroutine ZLARTG( f, g, c, s, r ) - use LA_CONSTANTS, only: wp, zero, one, two, czero, rtmin, rtmax, & + use LA_CONSTANTS, only: zero, one, two, czero, rtmin, rtmax, & safmin, safmax ! ! LAPACK auxiliary routine @@ -7,8 +7,8 @@ subroutine ZLARTG( f, g, c, s, r ) ! August 4, 2016 ! ! .. Scalar Arguments .. - real(wp) c - complex(wp) f, g, r, s + double precision c + complex*16 f, g, r, s ! .. ! ! Purpose @@ -61,14 +61,14 @@ subroutine ZLARTG( f, g, c, s, r ) ! ===================================================================== ! ! .. Local Scalars .. - real(wp) :: d, f1, f2, g1, g2, h2, p, u, uu, v, vv, w - complex(wp) :: fs, gs, t + double precision :: d, f1, f2, g1, g2, h2, p, u, uu, v, vv, w + complex*16 :: fs, gs, t ! .. ! .. Intrinsic Functions .. intrinsic :: abs, aimag, conjg, max, min, real, sqrt ! .. ! .. Statement Functions .. - real(wp) :: ABSSQ + double precision :: ABSSQ ! .. ! .. Statement Function definitions .. ABSSQ( t ) = real( t )**2 + aimag( t )**2 From a373e72bb71f5190682c6fa15a28e142dc5f8b8a Mon Sep 17 00:00:00 2001 From: "weslley.spereira" Date: Thu, 25 Feb 2021 12:57:44 -0300 Subject: [PATCH 05/12] Header of slartg.f90 compatible with Doxygen and with Lapack convention --- SRC/slartg.f90 | 168 ++++++++++++++++++++++++++++++++++++------------- 1 file changed, 123 insertions(+), 45 deletions(-) diff --git a/SRC/slartg.f90 b/SRC/slartg.f90 index 176959cf26..98584bd827 100644 --- a/SRC/slartg.f90 +++ b/SRC/slartg.f90 @@ -1,55 +1,133 @@ +!> \brief \b SLARTG generates a plane rotation with real cosine and real sine. +! +! =========== DOCUMENTATION =========== +! +! Online html documentation available at +! http://www.netlib.org/lapack/explore-html/ +! +!> \htmlonly +!> Download SLARTG + dependencies +!> +!> [TGZ] +!> +!> [ZIP] +!> +!> [TXT] +!> \endhtmlonly +! +! Definition: +! =========== +! +! SUBROUTINE SLARTG( F, G, CS, SN, R ) +! +! .. Scalar Arguments .. +! REAL CS, F, G, R, SN +! .. +! +! +!> \par Purpose: +! ============= +!> +!> \verbatim +!> +!> SLARTG generates a plane rotation so that +!> +!> [ C S ] . [ F ] = [ R ] +!> [ -S C ] [ G ] [ 0 ] +!> +!> where C**2 + S**2 = 1. +!> +!> The mathematical formulas used for C and S are +!> R = sign(F) * sqrt(F**2 + G**2) +!> C = F / R +!> S = G / R +!> Hence C >= 0. The algorithm used to compute these quantities +!> incorporates scaling to avoid overflow or underflow in computing the +!> square root of the sum of squares. +!> +!> This version is discontinuous in R at F = 0 but it returns the same +!> C and S as CLARTG for complex inputs (F,0) and (G,0). +!> +!> This is a more accurate version of the BLAS1 routine SROTG, +!> with the following other differences: +!> F and G are unchanged on return. +!> If G=0, then C=1 and S=0. +!> If F=0 and (G .ne. 0), then C=0 and S=sign(1,G) without doing any +!> floating point operations (saves work in SBDSQR when +!> there are zeros on the diagonal). +!> +!> If F exceeds G in magnitude, CS will be positive. +!> \endverbatim +! +! Arguments: +! ========== +! +!> \param[in] F +!> \verbatim +!> F is REAL +!> The first component of vector to be rotated. +!> \endverbatim +!> +!> \param[in] G +!> \verbatim +!> G is REAL +!> The second component of vector to be rotated. +!> \endverbatim +!> +!> \param[out] CS +!> \verbatim +!> CS is REAL +!> The cosine of the rotation. +!> \endverbatim +!> +!> \param[out] SN +!> \verbatim +!> SN is REAL +!> The sine of the rotation. +!> \endverbatim +!> +!> \param[out] R +!> \verbatim +!> R is REAL +!> The nonzero component of the rotated vector. +! +! Authors: +! ======== +! +!> \author Edward Anderson, Lockheed Martin +! +!> \date July 2016 +! +!> \ingroup OTHERauxiliary +! +!> \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 +!> +!> \endverbatim +! subroutine SLARTG( f, g, c, s, r ) use LA_CONSTANTS32, only: zero, half, one, rtmin, rtmax, safmin, safmax ! -! LAPACK auxiliary routine -! E. Anderson -! July 30, 2016 +! -- LAPACK auxiliary routine (version 3.9.0) -- +! -- LAPACK is a software package provided by Univ. of Tennessee, -- +! -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +! February 2021 ! ! .. Scalar Arguments .. real :: c, f, g, r, s ! .. -! -! Purpose -! ======= -! -! SLARTG generates a plane rotation so that -! -! [ C S ] . [ F ] = [ R ] -! [ -S C ] [ G ] [ 0 ] -! -! where C**2 + S**2 = 1. -! -! The mathematical formulas used for C and S are -! R = sign(F) * sqrt(F**2 + G**2) -! C = F / R -! S = G / R -! Hence C >= 0. The algorithm used to compute these quantities -! incorporates scaling to avoid overflow or underflow in computing the -! square root of the sum of squares. -! -! This version is discontinuous in R at F = 0 but it returns the same -! C and S as CLARTG for complex inputs (F,0) and (G,0). -! -! Arguments -! ========= -! -! F (input) REAL -! The first component of vector to be rotated. -! -! G (input) REAL -! The second component of vector to be rotated. -! -! C (output) REAL -! The cosine of the rotation. -! -! S (output) REAL -! The sine of the rotation. -! -! R (output) REAL -! The nonzero component of the rotated vector. -! -! ===================================================================== -! ! .. Local Scalars .. real :: d, f1, fs, g1, gs, p, u, uu ! .. From f77081264ac70a7c263ca088cae5e435fd712942 Mon Sep 17 00:00:00 2001 From: "weslley.spereira" Date: Mon, 1 Mar 2021 11:26:26 -0300 Subject: [PATCH 06/12] Fixes Doxygen --- DOCS/Doxyfile | 1 + SRC/slartg.f90 | 1 + 2 files changed, 2 insertions(+) diff --git a/DOCS/Doxyfile b/DOCS/Doxyfile index f1d9c3d400..e6053c43bc 100644 --- a/DOCS/Doxyfile +++ b/DOCS/Doxyfile @@ -886,6 +886,7 @@ INPUT_ENCODING = UTF-8 FILE_PATTERNS = *.c \ *.f \ + *.f90 \ *.h # The RECURSIVE tag can be used to specify whether or not subdirectories should diff --git a/SRC/slartg.f90 b/SRC/slartg.f90 index 98584bd827..b923fb5754 100644 --- a/SRC/slartg.f90 +++ b/SRC/slartg.f90 @@ -90,6 +90,7 @@ !> \verbatim !> R is REAL !> The nonzero component of the rotated vector. +!> \endverbatim ! ! Authors: ! ======== From b68d4c3dd10365c6bc6168233ada59fedc79b799 Mon Sep 17 00:00:00 2001 From: "weslley.spereira" Date: Mon, 1 Mar 2021 17:38:46 -0300 Subject: [PATCH 07/12] Add the module la_constants from @ecanesc with the suggestions of @zerothi --- SRC/CMakeLists.txt | 2 +- SRC/Makefile | 8 +- SRC/la_constants.f90 | 170 ++++++++++++++++++++++++++++++++++--------- 3 files changed, 141 insertions(+), 39 deletions(-) diff --git a/SRC/CMakeLists.txt b/SRC/CMakeLists.txt index e8842c6741..3b9031ffe5 100644 --- a/SRC/CMakeLists.txt +++ b/SRC/CMakeLists.txt @@ -41,7 +41,7 @@ set(ALLAUX ilaenv.f ilaenv2stage.f ieeeck.f lsamen.f iparmq.f iparam2stage.F ../INSTALL/slamch.f) set(SCLAUX - la_constants32.f90 + la_constants.f90 sbdsdc.f sbdsqr.f sdisna.f slabad.f slacpy.f sladiv.f slae2.f slaebz.f slaed0.f slaed1.f slaed2.f slaed3.f slaed4.f slaed5.f slaed6.f diff --git a/SRC/Makefile b/SRC/Makefile index e4ea4f1369..25e47a365b 100644 --- a/SRC/Makefile +++ b/SRC/Makefile @@ -57,7 +57,7 @@ TOPSRCDIR = .. include $(TOPSRCDIR)/make.inc -ALLMOD = la_constants.mod la_constants32.mod +ALLMOD = la_constants.mod .SUFFIXES: .f .F .f90 .F90 .o .mod %.o: %.f $(ALLMOD) @@ -70,14 +70,14 @@ ALLMOD = la_constants.mod la_constants32.mod $(FC) $(FFLAGS) -c -o $@ $< .o.mod: @true - + ALLAUX = ilaenv.o ilaenv2stage.o ieeeck.o lsamen.o xerbla.o xerbla_array.o \ iparmq.o iparam2stage.o \ ilaprec.o ilatrans.o ilauplo.o iladiag.o chla_transtype.o \ ../INSTALL/ilaver.o ../INSTALL/lsame.o ../INSTALL/slamch.o SCLAUX = \ - la_constants32.o \ + la_constants.o \ sbdsdc.o \ sbdsqr.o sdisna.o slabad.o slacpy.o sladiv.o slae2.o slaebz.o \ slaed0.o slaed1.o slaed2.o slaed3.o slaed4.o slaed5.o slaed6.o \ @@ -632,8 +632,6 @@ cla_wwaddw.o: cla_wwaddw.f ; $(FC) $(FFLAGS_NOOPT) -c -o $@ $< zla_wwaddw.o: zla_wwaddw.f ; $(FC) $(FFLAGS_NOOPT) -c -o $@ $< # Modules -la_constants32.o: la_constants32.f90 - $(FC) $(FFLAGS) -c -o $@ $< la_constants.o: la_constants.f90 $(FC) $(FFLAGS) -c -o $@ $< diff --git a/SRC/la_constants.f90 b/SRC/la_constants.f90 index a071a1472e..0bf798195d 100644 --- a/SRC/la_constants.f90 +++ b/SRC/la_constants.f90 @@ -1,39 +1,143 @@ +!> \brief \b LA_CONSTANTS is a module for the scaling constants for the compiled Fortran single and double precisions +! +! =========== DOCUMENTATION =========== +! +! Online html documentation available at +! http://www.netlib.org/lapack/explore-html/ +! +! Authors: +! ======== +! +!> \author Edward Anderson, Lockheed Martin +! +!> \date May 2016 +! +!> \ingroup OTHERauxiliary +! +!> \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 +! module LA_CONSTANTS ! -! -- BLAS/LAPACK module -- -! May 06, 2016 -! -! Standard constants -! - double precision, parameter :: zero = 0.0 - double precision, parameter :: half = 0.5 - double precision, parameter :: one = 1.0 - double precision, parameter :: two = 2.0 - double precision, parameter :: three = 3.0 - double precision, parameter :: four = 4.0 - double precision, parameter :: eight = 8.0 - double precision, parameter :: ten = 10.0 - complex*16, parameter :: czero = ( 0.0, 0.0 ) - complex*16, parameter :: chalf = ( 0.5, 0.0 ) - complex*16, parameter :: cone = ( 1.0, 0.0 ) - character*1, parameter :: sprefix = 'D' - character*1, parameter :: cprefix = 'Z' -! -! Model parameters -! - double precision, parameter :: eps = 0.11102230246251565404D-015 - double precision, parameter :: ulp = 0.22204460492503130808D-015 - double precision, parameter :: safmin = 0.22250738585072013831D-307 - double precision, parameter :: safmax = 0.44942328371557897693D+308 - double precision, parameter :: smlnum = 0.10020841800044863890D-291 - double precision, parameter :: bignum = 0.99792015476735990583D+292 - double precision, parameter :: rtmin = 0.10010415475915504622D-145 - double precision, parameter :: rtmax = 0.99895953610111751404D+146 +! -- LAPACK auxiliary module (version 3.9.0) -- +! -- LAPACK is a software package provided by Univ. of Tennessee, -- +! -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +! February 2021 +! +! Standard constants for + integer, parameter :: sp = kind(1.e0) +! + real(sp), parameter :: szero = 0.0_sp + real(sp), parameter :: shalf = 0.5_sp + real(sp), parameter :: sone = 1.0_sp + real(sp), parameter :: stwo = 2.0_sp + real(sp), parameter :: sthree = 3.0_sp + real(sp), parameter :: sfour = 4.0_sp + real(sp), parameter :: seight = 8.0_sp + real(sp), parameter :: sten = 10.0_sp + complex(sp), parameter :: czero = ( 0.0_sp, 0.0_sp ) + complex(sp), parameter :: chalf = ( 0.5_sp, 0.0_sp ) + complex(sp), parameter :: cone = ( 1.0_sp, 0.0_sp ) + character*1, parameter :: sprefix = 'S' + character*1, parameter :: cprefix = 'C' +! +! Scaling constants +! + real(sp), parameter :: sulp = epsilon(0._sp) + real(sp), parameter :: seps = sulp * 0.5_sp + real(sp), parameter :: ssafmin = real(radix(0._sp),sp)**max( & + minexponent(0._sp)-1, & + 1-maxexponent(0._sp) & + ) + real(sp), parameter :: ssafmax = sone / ssafmin + real(sp), parameter :: ssmlnum = ssafmin / sulp + real(sp), parameter :: sbignum = ssafmax * sulp + real(sp), parameter :: srtmin = sqrt(ssmlnum) + real(sp), parameter :: srtmax = sqrt(sbignum) +! +! Blue's scaling constants +! + real(sp), parameter :: stsml = real(radix(0._sp), sp)**ceiling( & + real(( minexponent(0._sp) - 1_sp ) / 2, sp) & + ) + real(sp), parameter :: stbig = real(radix(0._sp), sp)**floor( & + real(( maxexponent(0._sp) - digits(0._sp) + 1_sp) / 2, sp) & + ) +! ssml = 1/s, where s was defined in https://doi.org/10.1145/355769.355771 + real(sp), parameter :: sssml = real(radix(0._sp), sp)**( - floor( & + real(( minexponent(0._sp) - 1_sp ) / 2 ), sp) & + ) +! ssml = 1/S, where S was defined in https://doi.org/10.1145/355769.355771 + real(sp), parameter :: ssbig = real(radix(0._sp), sp)**( - ceiling( & + real(( maxexponent(0._sp) - digits(0._sp) + 1_sp) / 2 ), sp) & + ) +! +! +! Standard constants for + integer, parameter :: dp = kind(1.d0) +! + real(dp), parameter :: dzero = 0.0_dp + real(dp), parameter :: dhalf = 0.5_dp + real(dp), parameter :: done = 1.0_dp + real(dp), parameter :: dtwo = 2.0_dp + real(dp), parameter :: dthree = 3.0_dp + real(dp), parameter :: dfour = 4.0_dp + real(dp), parameter :: deight = 8.0_dp + real(dp), parameter :: dten = 10.0_dp + complex(dp), parameter :: zzero = ( 0.0_dp, 0.0_dp ) + complex(dp), parameter :: zhalf = ( 0.5_dp, 0.0_dp ) + complex(dp), parameter :: zone = ( 1.0_dp, 0.0_dp ) + character*1, parameter :: dprefix = 'D' + character*1, parameter :: zprefix = 'Z' +! +! Scaling constants +! + real(dp), parameter :: dulp = epsilon(0._dp) + real(dp), parameter :: deps = dulp * 0.5_dp + real(dp), parameter :: dsafmin = real(radix(0._dp),dp)**max( & + minexponent(0._dp)-1, & + 1-maxexponent(0._dp) & + ) + real(dp), parameter :: dsafmax = done / dsafmin + real(dp), parameter :: dsmlnum = dsafmin / dulp + real(dp), parameter :: dbignum = dsafmax * dulp + real(dp), parameter :: drtmin = sqrt(dsmlnum) + real(dp), parameter :: drtmax = sqrt(dbignum) ! ! Blue's scaling constants ! - double precision, parameter :: tsml = 0.14916681462400413487D-153 - double precision, parameter :: tbig = 0.19979190722022350281D+147 - double precision, parameter :: ssml = 0.44989137945431963828D+162 - double precision, parameter :: sbig = 0.11113793747425387417D-161 + real(dp), parameter :: dtsml = real(radix(0._dp), dp)**ceiling( & + real(( minexponent(0._dp) - 1_sp ) / 2, dp) & + ) + real(dp), parameter :: dtbig = real(radix(0._dp), dp)**floor( & + real(( maxexponent(0._dp) - digits(0._dp) + 1_sp) / 2, dp) & + ) +! ssml = 1/s, where s was defined in https://doi.org/10.1145/355769.355771 + real(dp), parameter :: dssml = real(radix(0._dp) ,dp)**( - floor( & + real(( minexponent(0._dp) - 1_sp ) / 2 ), dp) & + ) +! ssml = 1/S, where S was defined in https://doi.org/10.1145/355769.355771 + real(dp), parameter :: dsbig = real(radix(0._dp), dp)**( - ceiling( & + real(( maxexponent(0._dp) - digits(0._dp) + 1_sp) / 2 ), dp) & + ) +! end module LA_CONSTANTS From 090add87c2f36edf1ce8abfca3e5d347467e4ac0 Mon Sep 17 00:00:00 2001 From: "Weslley S. Pereira" Date: Mon, 1 Mar 2021 17:52:45 -0300 Subject: [PATCH 08/12] Includes Nick Papior as a contributor --- SRC/la_constants.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/SRC/la_constants.f90 b/SRC/la_constants.f90 index 0bf798195d..07b37bc109 100644 --- a/SRC/la_constants.f90 +++ b/SRC/la_constants.f90 @@ -18,6 +18,7 @@ ! ================== !> !> Weslley Pereira, University of Colorado Denver, USA +!> Nick Papior, Technical University of Denmark, DNK ! !> \par Further Details: ! ===================== From d7f15a98624cf5673eff5c58753e689de03acdc7 Mon Sep 17 00:00:00 2001 From: Nick Papior Date: Tue, 2 Mar 2021 09:47:39 +0100 Subject: [PATCH 09/12] mnt: cleanup and removal of erroneous kind specifications --- SRC/la_constants.f90 | 52 ++++++++++++++++---------------------------- 1 file changed, 19 insertions(+), 33 deletions(-) diff --git a/SRC/la_constants.f90 b/SRC/la_constants.f90 index 07b37bc109..0b9af3739d 100644 --- a/SRC/la_constants.f90 +++ b/SRC/la_constants.f90 @@ -18,7 +18,7 @@ ! ================== !> !> Weslley Pereira, University of Colorado Denver, USA -!> Nick Papior, Technical University of Denmark, DNK +!> Nick Papior, Technical University of Denmark, DK ! !> \par Further Details: ! ===================== @@ -38,15 +38,14 @@ !> \endverbatim ! module LA_CONSTANTS -! ! -- LAPACK auxiliary module (version 3.9.0) -- ! -- LAPACK is a software package provided by Univ. of Tennessee, -- ! -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- ! February 2021 -! + ! Standard constants for integer, parameter :: sp = kind(1.e0) -! + real(sp), parameter :: szero = 0.0_sp real(sp), parameter :: shalf = 0.5_sp real(sp), parameter :: sone = 1.0_sp @@ -60,9 +59,8 @@ module LA_CONSTANTS complex(sp), parameter :: cone = ( 1.0_sp, 0.0_sp ) character*1, parameter :: sprefix = 'S' character*1, parameter :: cprefix = 'C' -! + ! Scaling constants -! real(sp), parameter :: sulp = epsilon(0._sp) real(sp), parameter :: seps = sulp * 0.5_sp real(sp), parameter :: ssafmin = real(radix(0._sp),sp)**max( & @@ -74,28 +72,22 @@ module LA_CONSTANTS real(sp), parameter :: sbignum = ssafmax * sulp real(sp), parameter :: srtmin = sqrt(ssmlnum) real(sp), parameter :: srtmax = sqrt(sbignum) -! + ! Blue's scaling constants -! real(sp), parameter :: stsml = real(radix(0._sp), sp)**ceiling( & - real(( minexponent(0._sp) - 1_sp ) / 2, sp) & - ) + (minexponent(0._sp) - 1) * 0.5_sp) real(sp), parameter :: stbig = real(radix(0._sp), sp)**floor( & - real(( maxexponent(0._sp) - digits(0._sp) + 1_sp) / 2, sp) & - ) + (maxexponent(0._sp) - digits(0._sp) + 1) * 0.5_sp) ! ssml = 1/s, where s was defined in https://doi.org/10.1145/355769.355771 real(sp), parameter :: sssml = real(radix(0._sp), sp)**( - floor( & - real(( minexponent(0._sp) - 1_sp ) / 2 ), sp) & - ) + (minexponent(0._sp) - 1) * 0.5_sp)) ! ssml = 1/S, where S was defined in https://doi.org/10.1145/355769.355771 real(sp), parameter :: ssbig = real(radix(0._sp), sp)**( - ceiling( & - real(( maxexponent(0._sp) - digits(0._sp) + 1_sp) / 2 ), sp) & - ) -! -! + (maxexponent(0._sp) - digits(0._sp) + 1) * 0.5_sp)) + ! Standard constants for integer, parameter :: dp = kind(1.d0) -! + real(dp), parameter :: dzero = 0.0_dp real(dp), parameter :: dhalf = 0.5_dp real(dp), parameter :: done = 1.0_dp @@ -109,9 +101,8 @@ module LA_CONSTANTS complex(dp), parameter :: zone = ( 1.0_dp, 0.0_dp ) character*1, parameter :: dprefix = 'D' character*1, parameter :: zprefix = 'Z' -! + ! Scaling constants -! real(dp), parameter :: dulp = epsilon(0._dp) real(dp), parameter :: deps = dulp * 0.5_dp real(dp), parameter :: dsafmin = real(radix(0._dp),dp)**max( & @@ -123,22 +114,17 @@ module LA_CONSTANTS real(dp), parameter :: dbignum = dsafmax * dulp real(dp), parameter :: drtmin = sqrt(dsmlnum) real(dp), parameter :: drtmax = sqrt(dbignum) -! + ! Blue's scaling constants -! real(dp), parameter :: dtsml = real(radix(0._dp), dp)**ceiling( & - real(( minexponent(0._dp) - 1_sp ) / 2, dp) & - ) + (minexponent(0._dp) - 1) * 0.5_dp) real(dp), parameter :: dtbig = real(radix(0._dp), dp)**floor( & - real(( maxexponent(0._dp) - digits(0._dp) + 1_sp) / 2, dp) & - ) + (maxexponent(0._dp) - digits(0._dp) + 1) * 0.5_dp) ! ssml = 1/s, where s was defined in https://doi.org/10.1145/355769.355771 - real(dp), parameter :: dssml = real(radix(0._dp) ,dp)**( - floor( & - real(( minexponent(0._dp) - 1_sp ) / 2 ), dp) & - ) + real(dp), parameter :: dssml = real(radix(0._dp), dp)**( - floor( & + (minexponent(0._dp) - 1) * 0.5_dp)) ! ssml = 1/S, where S was defined in https://doi.org/10.1145/355769.355771 real(dp), parameter :: dsbig = real(radix(0._dp), dp)**( - ceiling( & - real(( maxexponent(0._dp) - digits(0._dp) + 1_sp) / 2 ), dp) & - ) -! + (maxexponent(0._dp) - digits(0._dp) + 1) * 0.5_dp)) + end module LA_CONSTANTS From e39bc0f752443f89a2cfd34e58bcb976b70b8c02 Mon Sep 17 00:00:00 2001 From: "Weslley S. Pereira" Date: Tue, 2 Mar 2021 12:22:54 -0300 Subject: [PATCH 10/12] Update la_constants.f90 --- SRC/la_constants.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/SRC/la_constants.f90 b/SRC/la_constants.f90 index 0b9af3739d..8781d3760e 100644 --- a/SRC/la_constants.f90 +++ b/SRC/la_constants.f90 @@ -38,11 +38,11 @@ !> \endverbatim ! module LA_CONSTANTS -! -- LAPACK auxiliary module (version 3.9.0) -- +! +! -- LAPACK auxiliary module -- ! -- LAPACK is a software package provided by Univ. of Tennessee, -- ! -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -! February 2021 - +! ! Standard constants for integer, parameter :: sp = kind(1.e0) From 93173dd91b788de9e533b035f73c4d339ec07bd7 Mon Sep 17 00:00:00 2001 From: "weslley.spereira" Date: Wed, 3 Mar 2021 20:14:58 -0300 Subject: [PATCH 11/12] Adding Doxygen preambles; Return to original real(wp) and complex(wp) --- SRC/clartg.f90 | 188 +++++++++++++++++++++++++++++++++---------------- SRC/dlartg.f90 | 168 ++++++++++++++++++++++++++++++------------- SRC/slartg.f90 | 45 +++++------- SRC/zlartg.f90 | 188 +++++++++++++++++++++++++++++++++---------------- 4 files changed, 395 insertions(+), 194 deletions(-) diff --git a/SRC/clartg.f90 b/SRC/clartg.f90 index 6d3cca7566..f63a0f8d20 100644 --- a/SRC/clartg.f90 +++ b/SRC/clartg.f90 @@ -1,74 +1,142 @@ +!> \brief \b CLARTG generates a plane rotation with real cosine and complex sine. +! +! =========== DOCUMENTATION =========== +! +! Online html documentation available at +! http://www.netlib.org/lapack/explore-html/ +! +! Definition: +! =========== +! +! SUBROUTINE CLARTG( F, G, C, S, R ) +! +! .. Scalar Arguments .. +! REAL(wp) C +! COMPLEX(wp) F, G, R, S +! .. +! +!> \par Purpose: +! ============= +!> +!> \verbatim +!> +!> CLARTG generates a plane rotation so that +!> +!> [ C S ] . [ F ] = [ R ] +!> [ -conjg(S) C ] [ G ] [ 0 ] +!> +!> where C is real and C**2 + |S|**2 = 1. +!> +!> The mathematical formulas used for C and S are +!> +!> sgn(x) = { x / |x|, x != 0 +!> { 1, x = 0 +!> +!> R = sgn(F) * sqrt(|F|**2 + |G|**2) +!> +!> C = |F| / sqrt(|F|**2 + |G|**2) +!> +!> S = sgn(F) * conjg(G) / sqrt(|F|**2 + |G|**2) +!> +!> When F and G are real, the formulas simplify to C = F/R and +!> S = G/R, and the returned values of C, S, and R should be +!> identical to those returned by CLARTG. +!> +!> The algorithm used to compute these quantities incorporates scaling +!> to avoid overflow or underflow in computing the square root of the +!> sum of squares. +!> +!> This is a faster version of the BLAS1 routine CROTG, except for +!> the following differences: +!> F and G are unchanged on return. +!> If G=0, then C=1 and S=0. +!> If F=0, then C=0 and S is chosen so that R is real. +!> +!> Below, wp=>sp stands for single precision from LA_CONSTANTS module. +!> \endverbatim +! +! Arguments: +! ========== +! +!> \param[in] F +!> \verbatim +!> F is COMPLEX(wp) +!> The first component of vector to be rotated. +!> \endverbatim +!> +!> \param[in] G +!> \verbatim +!> G is COMPLEX(wp) +!> The second component of vector to be rotated. +!> \endverbatim +!> +!> \param[out] C +!> \verbatim +!> C is REAL(wp) +!> The cosine of the rotation. +!> \endverbatim +!> +!> \param[out] S +!> \verbatim +!> S is COMPLEX(wp) +!> The sine of the rotation. +!> \endverbatim +!> +!> \param[out] R +!> \verbatim +!> R is COMPLEX(wp) +!> The nonzero component of the rotated vector. +!> \endverbatim +! +! Authors: +! ======== +! +!> \author Edward Anderson, Lockheed Martin +! +!> \date August 2016 +! +!> \ingroup OTHERauxiliary +! +!> \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 +!> +!> \endverbatim +! subroutine CLARTG( f, g, c, s, r ) - use LA_CONSTANTS32, only: zero, one, two, czero, rtmin, rtmax, & - safmin, safmax + use LA_CONSTANTS, & + only: wp=>sp, zero=>szero, one=>sone, two=>stwo, czero, & + rtmin=>srtmin, rtmax=>srtmax, safmin=>ssafmin, safmax=>ssafmax ! -! LAPACK auxiliary routine -! E. Anderson -! August 4, 2016 +! -- LAPACK auxiliary routine (version 3.10.0) -- +! -- LAPACK is a software package provided by Univ. of Tennessee, -- +! -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +! February 2021 ! ! .. Scalar Arguments .. - real c - complex f, g, r, s + real(wp) c + complex(wp) f, g, r, s ! .. -! -! Purpose -! ======= -! -! CLARTG generates a plane rotation so that -! -! [ C S ] . [ F ] = [ R ] -! [ -conjg(S) C ] [ G ] [ 0 ] -! -! where C is real and C**2 + |S|**2 = 1. -! -! The mathematical formulas used for C and S are -! -! sgn(x) = { x / |x|, x != 0 -! { 1, x = 0 -! -! R = sgn(F) * sqrt(|F|**2 + |G|**2) -! -! C = |F| / sqrt(|F|**2 + |G|**2) -! -! S = sgn(F) * conjg(G) / sqrt(|F|**2 + |G|**2) -! -! When F and G are real, the formulas simplify to C = F/R and -! S = G/R, and the returned values of C, S, and R should be -! identical to those returned by SLARTG. -! -! The algorithm used to compute these quantities incorporates scaling -! to avoid overflow or underflow in computing the square root of the -! sum of squares. -! -! Arguments -! ========= -! -! F (input) COMPLEX -! The first component of vector to be rotated. -! -! G (input) COMPLEX -! The second component of vector to be rotated. -! -! C (output) REAL -! The cosine of the rotation. -! -! S (output) COMPLEX -! The sine of the rotation. -! -! R (output) COMPLEX -! The nonzero component of the rotated vector. -! -! ===================================================================== -! ! .. Local Scalars .. - real :: d, f1, f2, g1, g2, h2, p, u, uu, v, vv, w - complex :: fs, gs, t + real(wp) :: d, f1, f2, g1, g2, h2, p, u, uu, v, vv, w + complex(wp) :: fs, gs, t ! .. ! .. Intrinsic Functions .. intrinsic :: abs, aimag, conjg, max, min, real, sqrt ! .. ! .. Statement Functions .. - real :: ABSSQ + real(wp) :: ABSSQ ! .. ! .. Statement Function definitions .. ABSSQ( t ) = real( t )**2 + aimag( t )**2 diff --git a/SRC/dlartg.f90 b/SRC/dlartg.f90 index d409a7ec83..03a708f863 100644 --- a/SRC/dlartg.f90 +++ b/SRC/dlartg.f90 @@ -1,57 +1,129 @@ +!> \brief \b DLARTG generates a plane rotation with real cosine and real sine. +! +! =========== DOCUMENTATION =========== +! +! Online html documentation available at +! http://www.netlib.org/lapack/explore-html/ +! +! Definition: +! =========== +! +! SUBROUTINE DLARTG( F, G, C, S, R ) +! +! .. Scalar Arguments .. +! REAL(wp) C, F, G, R, S +! .. +! +!> \par Purpose: +! ============= +!> +!> \verbatim +!> +!> DLARTG generates a plane rotation so that +!> +!> [ C S ] . [ F ] = [ R ] +!> [ -S C ] [ G ] [ 0 ] +!> +!> where C**2 + S**2 = 1. +!> +!> The mathematical formulas used for C and S are +!> R = sign(F) * sqrt(F**2 + G**2) +!> C = F / R +!> S = G / R +!> Hence C >= 0. The algorithm used to compute these quantities +!> incorporates scaling to avoid overflow or underflow in computing the +!> square root of the sum of squares. +!> +!> This version is discontinuous in R at F = 0 but it returns the same +!> C and S as ZLARTG for complex inputs (F,0) and (G,0). +!> +!> This is a more accurate version of the BLAS1 routine DROTG, +!> with the following other differences: +!> F and G are unchanged on return. +!> If G=0, then C=1 and S=0. +!> If F=0 and (G .ne. 0), then C=0 and S=sign(1,G) without doing any +!> floating point operations (saves work in DBDSQR when +!> there are zeros on the diagonal). +!> +!> If F exceeds G in magnitude, C will be positive. +!> +!> Below, wp=>dp stands for double precision from LA_CONSTANTS module. +!> \endverbatim +! +! Arguments: +! ========== +! +!> \param[in] F +!> \verbatim +!> F is REAL(wp) +!> The first component of vector to be rotated. +!> \endverbatim +!> +!> \param[in] G +!> \verbatim +!> G is REAL(wp) +!> The second component of vector to be rotated. +!> \endverbatim +!> +!> \param[out] C +!> \verbatim +!> C is REAL(wp) +!> The cosine of the rotation. +!> \endverbatim +!> +!> \param[out] S +!> \verbatim +!> S is REAL(wp) +!> The sine of the rotation. +!> \endverbatim +!> +!> \param[out] R +!> \verbatim +!> R is REAL(wp) +!> The nonzero component of the rotated vector. +!> \endverbatim +! +! Authors: +! ======== +! +!> \author Edward Anderson, Lockheed Martin +! +!> \date July 2016 +! +!> \ingroup OTHERauxiliary +! +!> \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 +!> +!> \endverbatim +! subroutine DLARTG( f, g, c, s, r ) - use LA_CONSTANTS, only: zero, half, one, rtmin, rtmax, safmin, safmax + use LA_CONSTANTS, & + only: wp=>dp, zero=>dzero, half=>dhalf, one=>done, & + rtmin=>drtmin, rtmax=>drtmax, safmin=>dsafmin, safmax=>dsafmax ! -! LAPACK auxiliary routine -! E. Anderson -! July 30, 2016 +! -- LAPACK auxiliary routine (version 3.10.0) -- +! -- LAPACK is a software package provided by Univ. of Tennessee, -- +! -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +! February 2021 ! ! .. Scalar Arguments .. - double precision :: c, f, g, r, s + real(wp) :: c, f, g, r, s ! .. -! -! Purpose -! ======= -! -! DLARTG generates a plane rotation so that -! -! [ C S ] . [ F ] = [ R ] -! [ -S C ] [ G ] [ 0 ] -! -! where C**2 + S**2 = 1. -! -! The mathematical formulas used for C and S are -! R = sign(F) * sqrt(F**2 + G**2) -! C = F / R -! S = G / R -! Hence C >= 0. The algorithm used to compute these quantities -! incorporates scaling to avoid overflow or underflow in computing the -! square root of the sum of squares. -! -! This version is discontinuous in R at F = 0 but it returns the same -! C and S as CLARTG for complex inputs (F,0) and (G,0). -! -! Arguments -! ========= -! -! F (input) REAL -! The first component of vector to be rotated. -! -! G (input) REAL -! The second component of vector to be rotated. -! -! C (output) REAL -! The cosine of the rotation. -! -! S (output) REAL -! The sine of the rotation. -! -! R (output) REAL -! The nonzero component of the rotated vector. -! -! ===================================================================== -! ! .. Local Scalars .. - double precision :: d, f1, fs, g1, gs, p, u, uu + real(wp) :: d, f1, fs, g1, gs, p, u, uu ! .. ! .. Intrinsic Functions .. intrinsic :: abs, sign, sqrt diff --git a/SRC/slartg.f90 b/SRC/slartg.f90 index b923fb5754..2a936a919f 100644 --- a/SRC/slartg.f90 +++ b/SRC/slartg.f90 @@ -5,26 +5,15 @@ ! Online html documentation available at ! http://www.netlib.org/lapack/explore-html/ ! -!> \htmlonly -!> Download SLARTG + dependencies -!> -!> [TGZ] -!> -!> [ZIP] -!> -!> [TXT] -!> \endhtmlonly -! ! Definition: ! =========== ! -! SUBROUTINE SLARTG( F, G, CS, SN, R ) +! SUBROUTINE SLARTG( F, G, C, S, R ) ! ! .. Scalar Arguments .. -! REAL CS, F, G, R, SN +! REAL(wp) C, F, G, R, S ! .. ! -! !> \par Purpose: ! ============= !> @@ -46,7 +35,7 @@ !> square root of the sum of squares. !> !> This version is discontinuous in R at F = 0 but it returns the same -!> C and S as CLARTG for complex inputs (F,0) and (G,0). +!> C and S as SLARTG for complex inputs (F,0) and (G,0). !> !> This is a more accurate version of the BLAS1 routine SROTG, !> with the following other differences: @@ -56,7 +45,9 @@ !> floating point operations (saves work in SBDSQR when !> there are zeros on the diagonal). !> -!> If F exceeds G in magnitude, CS will be positive. +!> If F exceeds G in magnitude, C will be positive. +!> +!> Below, wp=>sp stands for single precision from LA_CONSTANTS module. !> \endverbatim ! ! Arguments: @@ -64,31 +55,31 @@ ! !> \param[in] F !> \verbatim -!> F is REAL +!> F is REAL(wp) !> The first component of vector to be rotated. !> \endverbatim !> !> \param[in] G !> \verbatim -!> G is REAL +!> G is REAL(wp) !> The second component of vector to be rotated. !> \endverbatim !> -!> \param[out] CS +!> \param[out] C !> \verbatim -!> CS is REAL +!> C is REAL(wp) !> The cosine of the rotation. !> \endverbatim !> -!> \param[out] SN +!> \param[out] S !> \verbatim -!> SN is REAL +!> S is REAL(wp) !> The sine of the rotation. !> \endverbatim !> !> \param[out] R !> \verbatim -!> R is REAL +!> R is REAL(wp) !> The nonzero component of the rotated vector. !> \endverbatim ! @@ -119,18 +110,20 @@ !> \endverbatim ! subroutine SLARTG( f, g, c, s, r ) - use LA_CONSTANTS32, only: zero, half, one, rtmin, rtmax, safmin, safmax + use LA_CONSTANTS, & + only: wp=>sp, zero=>szero, half=>shalf, one=>sone, & + rtmin=>srtmin, rtmax=>srtmax, safmin=>ssafmin, safmax=>ssafmax ! -! -- LAPACK auxiliary routine (version 3.9.0) -- +! -- LAPACK auxiliary routine (version 3.10.0) -- ! -- LAPACK is a software package provided by Univ. of Tennessee, -- ! -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- ! February 2021 ! ! .. Scalar Arguments .. - real :: c, f, g, r, s + real(wp) :: c, f, g, r, s ! .. ! .. Local Scalars .. - real :: d, f1, fs, g1, gs, p, u, uu + real(wp) :: d, f1, fs, g1, gs, p, u, uu ! .. ! .. Intrinsic Functions .. intrinsic :: abs, sign, sqrt diff --git a/SRC/zlartg.f90 b/SRC/zlartg.f90 index 5c7443e8af..e509898a1c 100644 --- a/SRC/zlartg.f90 +++ b/SRC/zlartg.f90 @@ -1,74 +1,142 @@ +!> \brief \b ZLARTG generates a plane rotation with real cosine and complex sine. +! +! =========== DOCUMENTATION =========== +! +! Online html documentation available at +! http://www.netlib.org/lapack/explore-html/ +! +! Definition: +! =========== +! +! SUBROUTINE ZLARTG( F, G, C, S, R ) +! +! .. Scalar Arguments .. +! REAL(wp) C +! COMPLEX(wp) F, G, R, S +! .. +! +!> \par Purpose: +! ============= +!> +!> \verbatim +!> +!> ZLARTG generates a plane rotation so that +!> +!> [ C S ] . [ F ] = [ R ] +!> [ -conjg(S) C ] [ G ] [ 0 ] +!> +!> where C is real and C**2 + |S|**2 = 1. +!> +!> The mathematical formulas used for C and S are +!> +!> sgn(x) = { x / |x|, x != 0 +!> { 1, x = 0 +!> +!> R = sgn(F) * sqrt(|F|**2 + |G|**2) +!> +!> C = |F| / sqrt(|F|**2 + |G|**2) +!> +!> S = sgn(F) * conjg(G) / sqrt(|F|**2 + |G|**2) +!> +!> When F and G are real, the formulas simplify to C = F/R and +!> S = G/R, and the returned values of C, S, and R should be +!> identical to those returned by DLARTG. +!> +!> The algorithm used to compute these quantities incorporates scaling +!> to avoid overflow or underflow in computing the square root of the +!> sum of squares. +!> +!> This is a faster version of the BLAS1 routine ZROTG, except for +!> the following differences: +!> F and G are unchanged on return. +!> If G=0, then C=1 and S=0. +!> If F=0, then C=0 and S is chosen so that R is real. +!> +!> Below, wp=>dp stands for double precision from LA_CONSTANTS module. +!> \endverbatim +! +! Arguments: +! ========== +! +!> \param[in] F +!> \verbatim +!> F is COMPLEX(wp) +!> The first component of vector to be rotated. +!> \endverbatim +!> +!> \param[in] G +!> \verbatim +!> G is COMPLEX(wp) +!> The second component of vector to be rotated. +!> \endverbatim +!> +!> \param[out] C +!> \verbatim +!> C is REAL(wp) +!> The cosine of the rotation. +!> \endverbatim +!> +!> \param[out] S +!> \verbatim +!> S is COMPLEX(wp) +!> The sine of the rotation. +!> \endverbatim +!> +!> \param[out] R +!> \verbatim +!> R is COMPLEX(wp) +!> The nonzero component of the rotated vector. +!> \endverbatim +! +! Authors: +! ======== +! +!> \author Edward Anderson, Lockheed Martin +! +!> \date August 2016 +! +!> \ingroup OTHERauxiliary +! +!> \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 +!> +!> \endverbatim +! subroutine ZLARTG( f, g, c, s, r ) - use LA_CONSTANTS, only: zero, one, two, czero, rtmin, rtmax, & - safmin, safmax + use LA_CONSTANTS, & + only: wp=>dp, zero=>dzero, one=>done, two=>dtwo, czero=>zzero, & + rtmin=>drtmin, rtmax=>drtmax, safmin=>dsafmin, safmax=>dsafmax ! -! LAPACK auxiliary routine -! E. Anderson -! August 4, 2016 +! -- LAPACK auxiliary routine (version 3.10.0) -- +! -- LAPACK is a software package provided by Univ. of Tennessee, -- +! -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +! February 2021 ! ! .. Scalar Arguments .. - double precision c - complex*16 f, g, r, s + real(wp) c + complex(wp) f, g, r, s ! .. -! -! Purpose -! ======= -! -! ZLARTG generates a plane rotation so that -! -! [ C S ] . [ F ] = [ R ] -! [ -conjg(S) C ] [ G ] [ 0 ] -! -! where C is real and C**2 + |S|**2 = 1. -! -! The mathematical formulas used for C and S are -! -! sgn(x) = { x / |x|, x != 0 -! { 1, x = 0 -! -! R = sgn(F) * sqrt(|F|**2 + |G|**2) -! -! C = |F| / sqrt(|F|**2 + |G|**2) -! -! S = sgn(F) * conjg(G) / sqrt(|F|**2 + |G|**2) -! -! When F and G are real, the formulas simplify to C = F/R and -! S = G/R, and the returned values of C, S, and R should be -! identical to those returned by DLARTG. -! -! The algorithm used to compute these quantities incorporates scaling -! to avoid overflow or underflow in computing the square root of the -! sum of squares. -! -! Arguments -! ========= -! -! F (input) COMPLEX -! The first component of vector to be rotated. -! -! G (input) COMPLEX -! The second component of vector to be rotated. -! -! C (output) REAL -! The cosine of the rotation. -! -! S (output) COMPLEX -! The sine of the rotation. -! -! R (output) COMPLEX -! The nonzero component of the rotated vector. -! -! ===================================================================== -! ! .. Local Scalars .. - double precision :: d, f1, f2, g1, g2, h2, p, u, uu, v, vv, w - complex*16 :: fs, gs, t + real(wp) :: d, f1, f2, g1, g2, h2, p, u, uu, v, vv, w + complex(wp) :: fs, gs, t ! .. ! .. Intrinsic Functions .. intrinsic :: abs, aimag, conjg, max, min, real, sqrt ! .. ! .. Statement Functions .. - double precision :: ABSSQ + real(wp) :: ABSSQ ! .. ! .. Statement Function definitions .. ABSSQ( t ) = real( t )**2 + aimag( t )**2 From f1550e0aecba51d1f9491ed4513149679b6367ff Mon Sep 17 00:00:00 2001 From: "weslley.spereira" Date: Wed, 3 Mar 2021 20:16:41 -0300 Subject: [PATCH 12/12] Removes module la_constants32 --- SRC/la_constants32.f90 | 39 --------------------------------------- 1 file changed, 39 deletions(-) delete mode 100644 SRC/la_constants32.f90 diff --git a/SRC/la_constants32.f90 b/SRC/la_constants32.f90 deleted file mode 100644 index 547e0f276b..0000000000 --- a/SRC/la_constants32.f90 +++ /dev/null @@ -1,39 +0,0 @@ -module LA_CONSTANTS32 -! -! -- BLAS/LAPACK module -- -! May 06, 2016 -! -! Standard constants -! - real, parameter :: zero = 0.0 - real, parameter :: half = 0.5 - real, parameter :: one = 1.0 - real, parameter :: two = 2.0 - real, parameter :: three = 3.0 - real, parameter :: four = 4.0 - real, parameter :: eight = 8.0 - real, parameter :: ten = 10.0 - complex, parameter :: czero = ( 0.0, 0.0 ) - complex, parameter :: chalf = ( 0.5, 0.0 ) - complex, parameter :: cone = ( 1.0, 0.0 ) - character*1, parameter :: sprefix = 'S' - character*1, parameter :: cprefix = 'C' -! -! Model parameters -! - real, parameter :: eps = 0.5960464478E-07 - real, parameter :: ulp = 0.1192092896E-06 - real, parameter :: safmin = 0.1175494351E-37 - real, parameter :: safmax = 0.8507059173E+38 - real, parameter :: smlnum = 0.9860761315E-31 - real, parameter :: bignum = 0.1014120480E+32 - real, parameter :: rtmin = 0.3140184864E-15 - real, parameter :: rtmax = 0.3184525782E+16 -! -! Blue's scaling constants -! - real, parameter :: tsml = 0.1084202172E-18 - real, parameter :: tbig = 0.4503599627E+16 - real, parameter :: ssml = 0.3777893186E+23 - real, parameter :: sbig = 0.1323488980E-22 -end module LA_CONSTANTS32