Skip to content

Commit b68d4c3

Browse files
weslleyspereiraweslleyspereira
committed
Add the module la_constants from @ecanesc with the suggestions of @zerothi 
1 parent f770812 commit b68d4c3

File tree

3 files changed

+141
-39
lines changed

3 files changed

+141
-39
lines changed

‎SRC/CMakeLists.txt

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -41,7 +41,7 @@ set(ALLAUX ilaenv.f ilaenv2stage.f ieeeck.f lsamen.f iparmq.f iparam2stage.F
4141
../INSTALL/slamch.f)
4242

4343
set(SCLAUX
44-
la_constants32.f90
44+
la_constants.f90
4545
sbdsdc.f
4646
sbdsqr.f sdisna.f slabad.f slacpy.f sladiv.f slae2.f slaebz.f
4747
slaed0.f slaed1.f slaed2.f slaed3.f slaed4.f slaed5.f slaed6.f

‎SRC/Makefile

Lines changed: 3 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -57,7 +57,7 @@
5757
TOPSRCDIR = ..
5858
include $(TOPSRCDIR)/make.inc
5959

60-
ALLMOD = la_constants.mod la_constants32.mod
60+
ALLMOD = la_constants.mod
6161

6262
.SUFFIXES: .f .F .f90 .F90 .o .mod
6363
%.o: %.f $(ALLMOD)
@@ -70,14 +70,14 @@ ALLMOD = la_constants.mod la_constants32.mod
7070
$(FC) $(FFLAGS) -c -o $@ $<
7171
.o.mod:
7272
@true
73-
73+
7474
ALLAUX = ilaenv.o ilaenv2stage.o ieeeck.o lsamen.o xerbla.o xerbla_array.o \
7575
iparmq.o iparam2stage.o \
7676
ilaprec.o ilatrans.o ilauplo.o iladiag.o chla_transtype.o \
7777
../INSTALL/ilaver.o ../INSTALL/lsame.o ../INSTALL/slamch.o
7878

7979
SCLAUX = \
80-
la_constants32.o \
80+
la_constants.o \
8181
sbdsdc.o \
8282
sbdsqr.o sdisna.o slabad.o slacpy.o sladiv.o slae2.o slaebz.o \
8383
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 $@ $<
632632
zla_wwaddw.o: zla_wwaddw.f ; $(FC) $(FFLAGS_NOOPT) -c -o $@ $<
633633

634634
# Modules
635-
la_constants32.o: la_constants32.f90
636-
$(FC) $(FFLAGS) -c -o $@ $<
637635
la_constants.o: la_constants.f90
638636
$(FC) $(FFLAGS) -c -o $@ $<
639637

‎SRC/la_constants.f90

Lines changed: 137 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -1,39 +1,143 @@
1+
!> \brief \b LA_CONSTANTS is a module for the scaling constants for the compiled Fortran single and double precisions
2+
!
3+
! =========== DOCUMENTATION ===========
4+
!
5+
! Online html documentation available at
6+
! http://www.netlib.org/lapack/explore-html/
7+
!
8+
! Authors:
9+
! ========
10+
!
11+
!> \author Edward Anderson, Lockheed Martin
12+
!
13+
!> \date May 2016
14+
!
15+
!> \ingroup OTHERauxiliary
16+
!
17+
!> \par Contributors:
18+
! ==================
19+
!>
20+
!> Weslley Pereira, University of Colorado Denver, USA
21+
!
22+
!> \par Further Details:
23+
! =====================
24+
!>
25+
!> \verbatim
26+
!>
27+
!> Anderson E. (2017)
28+
!> Algorithm 978: Safe Scaling in the Level 1 BLAS
29+
!> ACM Trans Math Softw 44:1--28
30+
!> https://doi.org/10.1145/3061665
31+
!>
32+
!> Blue, James L. (1978)
33+
!> A Portable Fortran Program to Find the Euclidean Norm of a Vector
34+
!> ACM Trans Math Softw 4:15--23
35+
!> https://doi.org/10.1145/355769.355771
36+
!>
37+
!> \endverbatim
38+
!
139
module LA_CONSTANTS
240
!
3-
! -- BLAS/LAPACK module --
4-
! May 06, 2016
5-
!
6-
! Standard constants
7-
!
8-
double precision, parameter :: zero = 0.0
9-
double precision, parameter :: half = 0.5
10-
double precision, parameter :: one = 1.0
11-
double precision, parameter :: two = 2.0
12-
double precision, parameter :: three = 3.0
13-
double precision, parameter :: four = 4.0
14-
double precision, parameter :: eight = 8.0
15-
double precision, parameter :: ten = 10.0
16-
complex*16, parameter :: czero = ( 0.0, 0.0 )
17-
complex*16, parameter :: chalf = ( 0.5, 0.0 )
18-
complex*16, parameter :: cone = ( 1.0, 0.0 )
19-
character*1, parameter :: sprefix = 'D'
20-
character*1, parameter :: cprefix = 'Z'
21-
!
22-
! Model parameters
23-
!
24-
double precision, parameter :: eps = 0.11102230246251565404D-015
25-
double precision, parameter :: ulp = 0.22204460492503130808D-015
26-
double precision, parameter :: safmin = 0.22250738585072013831D-307
27-
double precision, parameter :: safmax = 0.44942328371557897693D+308
28-
double precision, parameter :: smlnum = 0.10020841800044863890D-291
29-
double precision, parameter :: bignum = 0.99792015476735990583D+292
30-
double precision, parameter :: rtmin = 0.10010415475915504622D-145
31-
double precision, parameter :: rtmax = 0.99895953610111751404D+146
41+
! -- LAPACK auxiliary module (version 3.9.0) --
42+
! -- LAPACK is a software package provided by Univ. of Tennessee, --
43+
! -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
44+
! February 2021
45+
!
46+
! Standard constants for
47+
integer, parameter :: sp = kind(1.e0)
48+
!
49+
real(sp), parameter :: szero = 0.0_sp
50+
real(sp), parameter :: shalf = 0.5_sp
51+
real(sp), parameter :: sone = 1.0_sp
52+
real(sp), parameter :: stwo = 2.0_sp
53+
real(sp), parameter :: sthree = 3.0_sp
54+
real(sp), parameter :: sfour = 4.0_sp
55+
real(sp), parameter :: seight = 8.0_sp
56+
real(sp), parameter :: sten = 10.0_sp
57+
complex(sp), parameter :: czero = ( 0.0_sp, 0.0_sp )
58+
complex(sp), parameter :: chalf = ( 0.5_sp, 0.0_sp )
59+
complex(sp), parameter :: cone = ( 1.0_sp, 0.0_sp )
60+
character*1, parameter :: sprefix = 'S'
61+
character*1, parameter :: cprefix = 'C'
62+
!
63+
! Scaling constants
64+
!
65+
real(sp), parameter :: sulp = epsilon(0._sp)
66+
real(sp), parameter :: seps = sulp * 0.5_sp
67+
real(sp), parameter :: ssafmin = real(radix(0._sp),sp)**max( &
68+
minexponent(0._sp)-1, &
69+
1-maxexponent(0._sp) &
70+
)
71+
real(sp), parameter :: ssafmax = sone / ssafmin
72+
real(sp), parameter :: ssmlnum = ssafmin / sulp
73+
real(sp), parameter :: sbignum = ssafmax * sulp
74+
real(sp), parameter :: srtmin = sqrt(ssmlnum)
75+
real(sp), parameter :: srtmax = sqrt(sbignum)
76+
!
77+
! Blue's scaling constants
78+
!
79+
real(sp), parameter :: stsml = real(radix(0._sp), sp)**ceiling( &
80+
real(( minexponent(0._sp) - 1_sp ) / 2, sp) &
81+
)
82+
real(sp), parameter :: stbig = real(radix(0._sp), sp)**floor( &
83+
real(( maxexponent(0._sp) - digits(0._sp) + 1_sp) / 2, sp) &
84+
)
85+
! ssml = 1/s, where s was defined in https://doi.org/10.1145/355769.355771
86+
real(sp), parameter :: sssml = real(radix(0._sp), sp)**( - floor( &
87+
real(( minexponent(0._sp) - 1_sp ) / 2 ), sp) &
88+
)
89+
! ssml = 1/S, where S was defined in https://doi.org/10.1145/355769.355771
90+
real(sp), parameter :: ssbig = real(radix(0._sp), sp)**( - ceiling( &
91+
real(( maxexponent(0._sp) - digits(0._sp) + 1_sp) / 2 ), sp) &
92+
)
93+
!
94+
!
95+
! Standard constants for
96+
integer, parameter :: dp = kind(1.d0)
97+
!
98+
real(dp), parameter :: dzero = 0.0_dp
99+
real(dp), parameter :: dhalf = 0.5_dp
100+
real(dp), parameter :: done = 1.0_dp
101+
real(dp), parameter :: dtwo = 2.0_dp
102+
real(dp), parameter :: dthree = 3.0_dp
103+
real(dp), parameter :: dfour = 4.0_dp
104+
real(dp), parameter :: deight = 8.0_dp
105+
real(dp), parameter :: dten = 10.0_dp
106+
complex(dp), parameter :: zzero = ( 0.0_dp, 0.0_dp )
107+
complex(dp), parameter :: zhalf = ( 0.5_dp, 0.0_dp )
108+
complex(dp), parameter :: zone = ( 1.0_dp, 0.0_dp )
109+
character*1, parameter :: dprefix = 'D'
110+
character*1, parameter :: zprefix = 'Z'
111+
!
112+
! Scaling constants
113+
!
114+
real(dp), parameter :: dulp = epsilon(0._dp)
115+
real(dp), parameter :: deps = dulp * 0.5_dp
116+
real(dp), parameter :: dsafmin = real(radix(0._dp),dp)**max( &
117+
minexponent(0._dp)-1, &
118+
1-maxexponent(0._dp) &
119+
)
120+
real(dp), parameter :: dsafmax = done / dsafmin
121+
real(dp), parameter :: dsmlnum = dsafmin / dulp
122+
real(dp), parameter :: dbignum = dsafmax * dulp
123+
real(dp), parameter :: drtmin = sqrt(dsmlnum)
124+
real(dp), parameter :: drtmax = sqrt(dbignum)
32125
!
33126
! Blue's scaling constants
34127
!
35-
double precision, parameter :: tsml = 0.14916681462400413487D-153
36-
double precision, parameter :: tbig = 0.19979190722022350281D+147
37-
double precision, parameter :: ssml = 0.44989137945431963828D+162
38-
double precision, parameter :: sbig = 0.11113793747425387417D-161
128+
real(dp), parameter :: dtsml = real(radix(0._dp), dp)**ceiling( &
129+
real(( minexponent(0._dp) - 1_sp ) / 2, dp) &
130+
)
131+
real(dp), parameter :: dtbig = real(radix(0._dp), dp)**floor( &
132+
real(( maxexponent(0._dp) - digits(0._dp) + 1_sp) / 2, dp) &
133+
)
134+
! ssml = 1/s, where s was defined in https://doi.org/10.1145/355769.355771
135+
real(dp), parameter :: dssml = real(radix(0._dp) ,dp)**( - floor( &
136+
real(( minexponent(0._dp) - 1_sp ) / 2 ), dp) &
137+
)
138+
! ssml = 1/S, where S was defined in https://doi.org/10.1145/355769.355771
139+
real(dp), parameter :: dsbig = real(radix(0._dp), dp)**( - ceiling( &
140+
real(( maxexponent(0._dp) - digits(0._dp) + 1_sp) / 2 ), dp) &
141+
)
142+
!
39143
end module LA_CONSTANTS

0 commit comments

Comments
 (0)