Added forsolver

.gitignore

@@ -0,0 +1,5 @@
+/build
+/bin
+/doc
+/.vscode
+/mod

fpm.toml

@@ -0,0 +1,25 @@
+name = "forsolver"
+version = "0.1.0"
+license = "license"
+author = "Seyed Ali Ghasemi"
+maintainer = "[email protected]"
+copyright = "Copyright 2023, Seyed Ali Ghasemi"
+[build]
+auto-executables = false
+auto-tests = false
+auto-examples = false
+module-naming = false
+[install]
+library = false
+[fortran]
+implicit-typing = false
+implicit-external = false
+source-form = "free"
+
+[dependencies]
+kinds = {git="https://github.com/gha3mi/kinds.git"}
+
+[[test]]
+name       = "test1"
+source-dir = "test"
+main       = "test1.f90"

gfortran.rsp

@@ -0,0 +1,2 @@
+@gfortran
+options test --compiler gfortran --flag "-Wno-line-truncation -Ofast -march=native -llapack -lblas"

ifort.rsp

@@ -0,0 +1,2 @@
+@ifort
+options test --compiler ifort --flag "-Ofast -xHost -mtune=native -qopenmp -parallel -qmkl=parallel"

ifx.rsp

@@ -0,0 +1,2 @@
+@ifx
+options test --compiler ifx --flag "-Ofast -xHost -mtune=native -qopenmp -fopenmp-target-do-concurrent -parallel -qmkl=parallel"

nvfortran.rsp

@@ -0,0 +1,2 @@
+@nvfortran
+options test --compiler nvfortran --flag "-O4 -mtune=native -stdpar=gpu,multicore -llapack"

project.yml

@@ -0,0 +1,18 @@
+project:             forsolver
+version:             v0.1.0
+year:                2023
+project_github:      https://github.com/gha3mi/forsolver
+author:              Seyed Ali Ghasemi
+email:               [email protected]
+github:              https://github.com/gha3mi
+src_dir:             ./src
+output_dir:          ./doc
+source:              true
+graph:               true
+coloured_edges:      true
+search:              true
+display:             public
+                     private
+                     protected
+print_creation_date: true
+

src/forsolver.f90

@@ -0,0 +1,76 @@
+module forsolver
+
+   !This module provides functions and subroutines for pseudoinverse calculations.
+
+   use :: kinds
+
+   implicit none
+
+   private
+
+   public ::  solver
+
+   !===============================================================================
+   interface solver
+      procedure :: dgels_rel ! Interface for the pinverse_rel function
+   end interface
+   !===============================================================================
+
+contains
+
+   !===============================================================================
+   !> author: Seyed Ali Ghasemi
+   !> solves an overdetermined or underdetermined linear system using dgels.
+   pure function dgels_rel(A, b) result(x)
+      ! inputs:
+      real(rk), dimension(:, :), contiguous, intent(in)  :: A    ! input matrix A
+      real(rk), dimension(:),    contiguous, intent(in)  :: b    ! right-hand side matrix b
+
+      ! outputs:
+      real(rk), dimension(size(b))                        :: x    ! solution matrix x
+
+      ! local variables
+      integer                          :: info ! result info
+      integer                          :: m, n, lda, ldb, lwork
+      real(rk), allocatable            :: work(:)
+      real(rk)                         :: work1(1)
+      real(rk), dimension(size(b))     :: b_copy
+
+      ! interface for dgels subroutine
+      interface
+         pure subroutine dgels(ftrans, fm, fn, fnrhs, fa, flda, fb, fldb, fwork, flwork, finfo)
+            use kinds
+            character(len=1), intent(in)    :: ftrans
+            integer,          intent(in)    :: fm, fn, fnrhs, flda, fldb, flwork
+            real(rk),         intent(inout) :: fa(flda,*), fb(fldb,*), fwork(*)
+            integer,          intent(out)   :: finfo
+         end subroutine dgels
+      end interface
+
+      b_copy = b
+
+      ! get dimensions
+      m    = size(A, 1)
+      n    = size(A, 2)
+      lda  = max(1, m)
+      ldb  = max(1, max(m, n))
+
+      ! calculate the optimal size of the work array
+      call dgels('n', m, n, 1, A, lda, b_copy, ldb, work1, -1, info)
+
+      ! allocate work array
+      lwork = nint(work1(1))
+      allocate(work(lwork))
+
+      ! call dgels subroutine
+      call dgels('n', m, n, 1, A, lda, b_copy, ldb, work, lwork, info)
+
+      ! copy the solution matrix
+      x = b_copy
+
+      ! deallocate workspace
+      deallocate(work)
+   end function dgels_rel
+   !===============================================================================
+
+end module forsolver

test/test1.f90

@@ -0,0 +1,39 @@
+program test1
+
+   use :: kinds
+   use :: forsolver
+
+   implicit none
+
+   real(rk), dimension(:,:), allocatable :: A
+   real(rk), dimension(:)  , allocatable :: x, b
+   integer                               :: m,n, i, j
+
+   m = 4
+   n = 3
+
+   allocate(A(m,n),b(m),x(n))
+
+   call random_number(A)
+   call random_number(b)
+   A = A*10.0_rk
+   b = b*10.0_rk
+
+   X = solver(A, b)
+
+   ! Print A
+   print *, "A:"
+   print "(4F10.6)", (A(:,j), j = 1, m)
+
+   ! Print b
+   print *, "b:"
+   print "(4F10.6)", b
+
+
+   ! Print x
+   print *, "x:"
+   print "(4F10.6)", x
+
+   deallocate(A,b,x)
+
+end program test1

workspace.code-workspace

@@ -0,0 +1,16 @@
+{
+	"folders": [
+		{
+			"name": "forsolver",
+			"path": "."
+		}
+	],
+	"settings": {
+		"fortran.linter.modOutput": "${workspaceFolder}/mod/",
+		"fortran.fortls.directories": [
+			"${workspaceFolder}/src",
+			"${workspaceFolder}/test",
+			"${workspaceFolder}/app"
+		]
+	}
+}