automate type conversion routines

Author: perazz

scripts/modularize_blas.py

@@ -36,10 +36,6 @@ def create_constants_module(module_name,out_folder,stdlib_integration=None):
     fid.write(INDENT + "implicit none(type,external)\n")
     fid.write(INDENT + "public\n\n\n\n")
 
-#:if WITH_QP
-#:set REAL_KINDS = REAL_KINDS + ["qp"]
-#:endif
-
     # Temporary: to be replaced with stdlib_kinds
     if not stdlib_integration:
         fid.write(INDENT + "integer, parameter :: sp  = real32\n")
@@ -51,9 +47,6 @@ def create_constants_module(module_name,out_folder,stdlib_integration=None):
     fid.write(INDENT + "integer, parameter :: ilp = int32\n")
     fid.write(INDENT + "private            :: int32, int64\n\n\n")
 
-    # Arithmetic constants (private)
-    # print_lapack_constants(fid,INDENT)
-
     # Close module
     fid.write("\n\n\n\n\nend module {}\n".format(module_name))
 
@@ -109,7 +102,7 @@ def patch_lapack_aux(fid,prefix,indent):
 # Read all source files from the source folder, process them, refactor them, and put all
 # subroutines/function into a module
 def create_fortran_module(module_name,source_folder,out_folder,prefix,ext_functions,used_modules, \
-                          split_by_initial,stdlib_export=False):
+                          split_by_initial=True,stdlib_export=False):
 
     from datetime import date
     from platform import os
@@ -487,7 +480,6 @@ def double_to_quad(lines,initial,newinit,prefix,procedure_name=None):
     whole = re.sub(prefix[:-1]+r'\_delect',prefix+r'select',whole)
     whole = re.sub(prefix[:-1]+r'\_dlag2d',prefix+r'dlag2q',whole)
     whole = re.sub(prefix[:-1]+r'\_zlag2z',prefix+r'zlag2w',whole)
-    whole = re.sub(prefix[:-1]+r'\_zlag2w',prefix+r'clag2z',whole)
 
     whole = re.sub(r'32\-bit',r'64-bit',whole)
     whole = re.sub(r'single precision',r'double precision',whole)
@@ -3138,11 +3130,13 @@ def parse_fortran_source(source_folder,file_name,prefix,remove_headers):
            double_procedure.new_name = prefix+double_procedure.old_name
 
            whole = '\n'.join(double_procedure.body)
-           whole = whole.replace(prefix+single_to_double[kk],prefix+single_to_doublen[kk])
+           whole = whole.replace(single_to_double[kk],single_to_doublen[kk])
+           whole = whole.replace(single_to_double[kk].upper(),single_to_doublen[kk].upper())
            double_procedure.body = whole.splitlines()
 
            whole = '\n'.join(double_procedure.header)
-           whole = whole.replace(prefix+single_to_double[kk],prefix+single_to_doublen[kk])
+           whole = whole.replace(single_to_double[kk],single_to_doublen[kk])
+           whole = whole.replace(single_to_double[kk].upper(),single_to_doublen[kk].upper())
            double_procedure.header = whole.splitlines()
 
            Procedures.append(double_procedure)
@@ -3253,19 +3247,18 @@ def parse_interfaces(Sources):
 
 # Run script
 funs = []
-create_constants_module("stdlib_linalg_constants","../src")
+create_constants_module("stdlib_linalg_constants","../src",False)
 funs = create_fortran_module("stdlib_linalg_blas",\
                              "../assets/reference_lapack/BLAS/SRC","../src",\
                              "stdlib_",\
                              funs,\
-                             ["stdlib_linalg_constants"],True,True)
-#funs = create_fortran_module("stdlib_linalg_lapack",\
-#                             "../assets/lapack_sources",\
-#                             "../src",\
-#                             "stdlib_",\
-#                             funs,\
-#                             ["stdlib_linalg_constants","stdlib_linalg_blas"],True)
-#create_fortran_module("stdlib_linalg_blas_test_eig","../assets/reference_lapack/TESTING/EIG","../test","stdlib_test_")
+                             ["stdlib_linalg_constants"],True,False)
+funs = create_fortran_module("stdlib_linalg_lapack",\
+                             "../assets/lapack_sources",\
+                             "../src",\
+                             "stdlib_",\
+                             funs,\
+                             ["stdlib_linalg_constants","stdlib_linalg_blas"],True)
 
 
 

src/stdlib_linalg_constants.f90

@@ -1,15 +1,15 @@
 module stdlib_linalg_constants
-     use iso_fortran_env,only:int32,int64
+     use iso_fortran_env,only:real32,real64,real128,int32,int64
      use,intrinsic :: ieee_arithmetic,only:ieee_is_nan
 #if defined(_OPENMP)
      use omp_lib
 #endif
      implicit none(type,external)
      public
 
-     integer,parameter :: sp = selected_real_kind(6)
-     integer,parameter :: dp = selected_real_kind(15)
-     integer,parameter :: qp = selected_real_kind(33)
+     integer,parameter :: sp = real32
+     integer,parameter :: dp = real64
+     integer,parameter :: qp = real128
      integer,parameter :: lk = kind(.true.)
      ! Integer size support for ILP64 builds should be done here
      integer,parameter :: ilp = int32

src/stdlib_linalg_lapack_d.f90

@@ -24107,7 +24107,7 @@ pure real(dp) function stdlib_dzsum1(n,cx,incx)
            return
      end function stdlib_dzsum1
 
-     !> DLAG2Q: converts a DOUBLE PRECISION matrix, SA, to a QUAD
+     !> DLAG2Q: converts a SINGLE PRECISION matrix, SA, to a DOUBLE
      !> PRECISION matrix, A.
      !> Note that while it is possible to overflow while converting
      !> from double to single, it is not possible to overflow when

src/stdlib_linalg_lapack_q.f90

@@ -478,6 +478,7 @@ module stdlib_linalg_lapack_q
      public :: stdlib_qtrttp
      public :: stdlib_qtzrzf
      public :: stdlib_qzsum1
+     public :: stdlib_qlag2q
 
      ! 128-bit real constants
      real(qp),parameter,private :: negone = -1.00_qp
@@ -85112,4 +85113,34 @@ pure real(qp) function stdlib_qzsum1(n,cx,incx)
            return
      end function stdlib_qzsum1
 
+     !> DLAG2Q: converts a SINGLE PRECISION matrix, SA, to a DOUBLE
+     !> PRECISION matrix, A.
+     !> Note that while it is possible to overflow while converting
+     !> from double to single, it is not possible to overflow when
+     !> converting from single to double.
+     !> This is an auxiliary routine so there is no argument checking.
+
+     pure subroutine stdlib_qlag2q(m,n,sa,ldsa,a,lda,info)
+        ! -- 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
+           integer(ilp),intent(out) :: info
+           integer(ilp),intent(in) :: lda,ldsa,m,n
+           ! Array Arguments
+           real(qp),intent(in) :: sa(ldsa,*)
+           real(qp),intent(out) :: a(lda,*)
+        ! =====================================================================
+           ! Local Scalars
+           integer(ilp) :: i,j
+           ! Executable Statements
+           info = 0
+           do j = 1,n
+              do i = 1,m
+                 a(i,j) = sa(i,j)
+              end do
+           end do
+           return
+     end subroutine stdlib_qlag2q
+
 end module stdlib_linalg_lapack_q

src/stdlib_linalg_lapack_w.f90

@@ -11,6 +11,7 @@ module stdlib_linalg_lapack_w
      private
 
      public :: sp,dp,qp,lk,ilp
+     public :: stdlib_wlag2w
      public :: stdlib_wbbcsd
      public :: stdlib_wbdsqr
      public :: stdlib_wcgesv
@@ -501,6 +502,35 @@ module stdlib_linalg_lapack_w
 
      contains
 
+     !> ZLAG2W: converts a COMPLEX matrix, SA, to a COMPLEX*16 matrix, A.
+     !> Note that while it is possible to overflow while converting
+     !> from double to single, it is not possible to overflow when
+     !> converting from single to double.
+     !> This is an auxiliary routine so there is no argument checking.
+
+     pure subroutine stdlib_wlag2w(m,n,sa,ldsa,a,lda,info)
+        ! -- 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
+           integer(ilp),intent(out) :: info
+           integer(ilp),intent(in) :: lda,ldsa,m,n
+           ! Array Arguments
+           complex(qp),intent(in) :: sa(ldsa,*)
+           complex(qp),intent(out) :: a(lda,*)
+        ! =====================================================================
+           ! Local Scalars
+           integer(ilp) :: i,j
+           ! Executable Statements
+           info = 0
+           do j = 1,n
+              do i = 1,m
+                 a(i,j) = sa(i,j)
+              end do
+           end do
+           return
+     end subroutine stdlib_wlag2w
+
      !> ZBBCSD: computes the CS decomposition of a unitary matrix in
      !> bidiagonal-block form,
      !> [ B11 | B12 0  0 ]

src/stdlib_linalg_lapack_z.f90

@@ -500,7 +500,7 @@ module stdlib_linalg_lapack_z
 
      contains
 
-     !> ZLAG2W: converts a COMPLEX*16 matrix, SA, to a QUAD-COMPLEX matrix, A.
+     !> ZLAG2W: converts a COMPLEX matrix, SA, to a COMPLEX*16 matrix, A.
      !> Note that while it is possible to overflow while converting
      !> from double to single, it is not possible to overflow when
      !> converting from single to double.