Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
18 changes: 12 additions & 6 deletions hsl_subset/hsl_ma48/hsl_ma48r.f90
Original file line number Diff line number Diff line change
Expand Up @@ -51,17 +51,17 @@ module hsl_ma48_real
end interface

type ma48_factors
private
integer(ip_), allocatable :: keep(:)
integer(ip_), allocatable :: irn(:)
integer(ip_), allocatable :: jcn(:)
integer(long_), allocatable :: keep(:)
integer(long_), allocatable :: irn(:)
integer(long_), allocatable :: jcn(:)
real(rp_), allocatable :: val(:)
integer(ip_) :: m ! Number of rows in matrix
integer(ip_) :: n ! Number of columns in matrix
integer(ip_) :: lareq ! Size for further factorization
integer(long_) :: lareq ! Size for further factorization
integer(long_) :: lirnreq
integer(ip_) :: partial ! Number of columns kept to end for partial
! factorization
integer(ip_) :: ndrop ! Number of entries dropped from data structure
integer(long_) :: ndrop ! Number of entries dropped from data structure
integer(ip_) :: first ! Flag to indicate whether it is first call to
! factorize after analyse (set to 1 in analyse).
end type ma48_factors
Expand All @@ -74,6 +74,9 @@ module hsl_ma48_real
real(rp_) :: drop ! Drop tolerance
real(rp_) :: tolerance ! anything less than this is considered zero
real(rp_) :: cgce ! Ratio for required reduction using IR
real(rp_) :: reduce
integer(ip_) :: la
integer(ip_) :: maxla
integer(ip_) :: lp ! Unit for error messages
integer(ip_) :: wp ! Unit for warning messages
integer(ip_) :: mp ! Unit for monitor output
Expand All @@ -97,9 +100,11 @@ module hsl_ma48_real
integer(ip_) :: more = 0 ! More information on failure
integer(long_) :: lena_analyse = 0! Size for analysis (main arrays)
integer(long_) :: lenj_analyse = 0! Size for analysis (integer aux array)
integer(long_) :: len_analyse = 0
!! For the moment leni_factorize = lena_factorize because of BTF structure
integer(long_) :: lena_factorize = 0 ! Size for factorize (real array)
integer(long_) :: leni_factorize = 0 ! Size for factorize (integer array)
integer(long_) :: len_factorize = 0
integer(ip_) :: ncmpa = 0 ! Number of compresses in analyse
integer(ip_) :: rank = 0 ! Estimated rank
integer(long_) :: drop = 0 ! Number of entries dropped
Expand All @@ -120,6 +125,7 @@ module hsl_ma48_real
!! For the moment leni_factorize = lena_factorize because of BTF structure
integer(long_) :: lena_factorize = 0 ! Size for factorize (real array)
integer(long_) :: leni_factorize = 0 ! Size for factorize (integer array)
integer(long_) :: len_factorize = 0
integer(long_) :: drop = 0 ! Number of entries dropped
integer(ip_) :: rank = 0 ! Estimated rank
integer(ip_) :: stat = 0 ! STAT value after allocate failure
Expand Down
34 changes: 19 additions & 15 deletions hsl_subset/hsl_ma86/hsl_ma86r.f90
Original file line number Diff line number Diff line change
Expand Up @@ -256,32 +256,36 @@ module hsl_ma86_real
integer(ip_) :: num_delay = 0 ! Number of delayed pivots
integer(long_) :: num_factor = 0_long_ ! Number of entries in the factor.
integer(long_) :: num_flops = 0_long_ ! Number of flops for factor.
integer(ip_) :: num_neg = 0 ! Number of negative pivots
integer(ip_) :: num_nodes = 0 ! Number of nodes
! integer(ip_) :: num_sup = 0 ! Number of supervariables
integer(ip_) :: num_two = 0 ! Number of 2x2 pivots
integer(ip_) :: num_neg = 0 ! Number of negative pivots
integer(ip_) :: num_nothresh = 0 ! Number of pivots not satisfying u
integer(ip_) :: num_perturbed = 0 ! Number of perturbed pivots
integer(ip_) :: num_two = 0 ! Number of 2x2 pivots
integer(ip_) :: pool_size = pool_default ! Maximum size of task pool used
integer(ip_) :: stat = 0 ! STAT value on error return -1.
real(rp_) :: usmall = zero ! smallest threshold parameter used
end type MA86_info

type lmap_type
integer(long_) :: len_map
integer(long_), allocatable :: map(:,:)
end type lmap_type

type ma86_keep
type(zd11_type) :: a ! Holds lower and upper triangular parts of A
type(block_type), dimension(:), allocatable :: blocks ! block info
integer(ip_), dimension(:), allocatable :: flag_array ! allocated to
! have size equal to the number of threads. For each thread, holds
! error flag
integer(long_) :: final_blk = 0 ! Number of blocks. Used for destroying
! locks in finalise
type(ma86_info) :: info ! Holds copy of info
integer(ip_) :: maxmn ! holds largest block dimension
integer(ip_) :: n ! Order of the system.
type(node_type), dimension(:), allocatable :: nodes ! nodal info
integer(ip_) :: nbcol = 0 ! number of block columns in L
private
type(block_type), dimension(:), allocatable :: blocks
integer(ip_), dimension(:), allocatable :: flag_array
integer(long_) :: final_blk = 0
type(ma86_info) :: info
integer(ip_) :: maxm
integer(ip_) :: maxn
integer(ip_) :: n
type(node_type), dimension(:), allocatable :: nodes
integer(ip_) :: nbcol = 0
type(lfactor), dimension(:), allocatable :: lfact
! holds block cols of L
type(lmap_type), dimension(:), allocatable :: lmap
real(rp_), dimension(:), allocatable :: scaling
end type ma86_keep

type dagtask
Expand Down
2 changes: 1 addition & 1 deletion hsl_subset/hsl_ma87/hsl_ma87r.f90
Original file line number Diff line number Diff line change
Expand Up @@ -226,7 +226,7 @@ module hsl_ma87_real
end type MA87_info

type ma87_keep
type(zd11_type) :: a ! Holds lower and upper triangular parts of A
private
type(block_type), dimension(:), allocatable :: blocks ! block info
integer(ip_), dimension(:), allocatable :: flag_array ! allocated to
! have size equal to the number of threads. For each thread, holds
Expand Down
58 changes: 54 additions & 4 deletions hsl_subset/hsl_ma97/hsl_ma97r.f90
Original file line number Diff line number Diff line change
Expand Up @@ -90,7 +90,6 @@ module hsl_ma97_real

type MA97_control ! The scalar control of this type controls the action
logical(lp_) :: action = .true. ! pos_def = .false. only.
real(rp_) :: consist_tol = epsilon(one)
integer(long_) :: factor_min = 20000000
integer(ip_) :: nemin = nemin_default
real(rp_) :: multiplier = 1.1
Expand All @@ -107,6 +106,7 @@ module hsl_ma97_real
integer(ip_) :: unit_warning = 6 ! unit number for warning messages
integer(long_) :: min_subtree_work = 1e5 ! Minimum amount of work
integer(ip_) :: min_ldsrk_work = 1e4 ! Minimum amount of work to aim
real(rp_) :: consist_tol = epsilon(one)
end type MA97_control

type MA97_info ! The scalar info of this type returns information to user.
Expand All @@ -119,6 +119,7 @@ module hsl_ma97_real
integer(ip_) :: matrix_missing_diag = 0 ! Number of missing diag. entries
integer(ip_) :: maxdepth = 0 ! Maximum depth of the tree.
integer(ip_) :: maxfront = 0 ! Maximum front size.
integer(ip_) :: maxsupernode = 0 ! max no. columns in a supernode
integer(long_) :: num_factor = 0_long_ ! Number of entries in the factor.
integer(long_) :: num_flops = 0_long_ ! Number of flops to calculate L.
integer(ip_) :: num_delay = 0 ! Number of delayed eliminations.
Expand All @@ -129,13 +130,62 @@ module hsl_ma97_real
integer(ip_) :: stat = 0 ! STAT value (when available).
end type MA97_info

type MA97_akeep ! proper version has many componets!
type smalloc_type
end type smalloc_type

type node_type
end type node_type

type MA97_akeep
private
logical(lp_) :: check
integer(ip_) :: flag
integer(ip_) :: maxmn
integer(ip_) :: n
integer(ip_) :: ne
integer(long_) :: nfactor
integer(ip_) :: nnodes = -1
integer(ip_) :: num_two
integer(ip_), dimension(:), allocatable :: child_ptr
integer(ip_), dimension(:), allocatable :: child_list
integer(ip_), dimension(:), allocatable :: invp
integer(ip_), dimension(:), allocatable :: level
integer(ip_), dimension(:,:), allocatable :: nlist
integer(ip_), dimension(:), allocatable :: nptr
integer(ip_), dimension(:), allocatable :: rlist
integer(long_), dimension(:), allocatable :: rptr
integer(ip_), dimension(:), allocatable :: sparent
integer(ip_), dimension(:), allocatable :: sptr
integer(long_), dimension(:), allocatable :: subtree_work
integer(ip_), allocatable :: ptr(:)
integer(ip_), allocatable :: row(:)
integer(ip_) :: lmap
integer(ip_), allocatable :: map(:)
integer(ip_) :: matrix_dup
integer(ip_) :: matrix_outrange
integer(ip_) :: matrix_missing_diag
integer(ip_) :: maxdepth
integer(long_) :: num_flops
integer(ip_) :: num_sup
integer(ip_) :: ordering
real(rp_), dimension(:), allocatable :: scaling
end type MA97_akeep

type MA97_fkeep ! proper version has many componets!
integer(ip_) :: n
type MA97_fkeep
private
integer(ip_) :: flag
real(rp_), dimension(:), allocatable :: scaling
type(node_type), dimension(:), allocatable :: nodes
type(smalloc_type), pointer :: alloc=>null()
logical(lp_) :: pos_def
integer(ip_) :: matrix_rank
integer(ip_) :: maxfront
integer(ip_) :: maxsupernode
integer(ip_) :: num_delay
integer(long_) :: num_factor
integer(long_) :: num_flops
integer(ip_) :: num_neg
integer(ip_) :: num_two
end type MA97_fkeep

contains
Expand Down
74 changes: 72 additions & 2 deletions hsl_subset/hsl_mc69/hsl_mc69r.f90
Original file line number Diff line number Diff line change
Expand Up @@ -3,8 +3,78 @@
#include "hsl_subset.h"

MODULE hsl_mc69_real
use hsl_kinds_real, only: ip_, lp_, rp_
implicit none

private
public :: HSL_MATRIX_UNDEFINED, &
HSL_MATRIX_REAL_RECT, HSL_MATRIX_CPLX_RECT, &
HSL_MATRIX_REAL_UNSYM, HSL_MATRIX_CPLX_UNSYM, &
HSL_MATRIX_REAL_SYM_PSDEF, HSL_MATRIX_CPLX_HERM_PSDEF, &
HSL_MATRIX_REAL_SYM_INDEF, HSL_MATRIX_CPLX_HERM_INDEF, &
HSL_MATRIX_CPLX_SYM, &
HSL_MATRIX_REAL_SKEW, HSL_MATRIX_CPLX_SKEW
public :: mc69_coord_convert, mc69_set_values
LOGICAL, PUBLIC, PROTECTED :: mc69_available = .FALSE.

integer(ip_), parameter :: HSL_MATRIX_UNDEFINED = 0
integer(ip_), parameter :: HSL_MATRIX_REAL_RECT = 1
integer(ip_), parameter :: HSL_MATRIX_REAL_UNSYM = 2
integer(ip_), parameter :: HSL_MATRIX_REAL_SYM_PSDEF = 3
integer(ip_), parameter :: HSL_MATRIX_REAL_SYM_INDEF = 4
integer(ip_), parameter :: HSL_MATRIX_REAL_SKEW = 6
integer(ip_), parameter :: HSL_MATRIX_CPLX_RECT = -1
integer(ip_), parameter :: HSL_MATRIX_CPLX_UNSYM = -2
integer(ip_), parameter :: HSL_MATRIX_CPLX_HERM_PSDEF= -3
integer(ip_), parameter :: HSL_MATRIX_CPLX_HERM_INDEF= -4
integer(ip_), parameter :: HSL_MATRIX_CPLX_SYM = -5
integer(ip_), parameter :: HSL_MATRIX_CPLX_SKEW = -6

interface mc69_coord_convert
module procedure mc69_coord_convert_real
end interface mc69_coord_convert

interface mc69_set_values
module procedure mc69_set_values_real
end interface mc69_set_values

CONTAINS
SUBROUTINE mc69r( )
END SUBROUTINE mc69r

subroutine mc69_coord_convert_real(matrix_type, m, n, ne, row, col, &
ptr_out, row_out, flag, val_in, val_out, lmap, map, lp, noor, ndup)
integer(ip_), intent(in) :: matrix_type
integer(ip_), intent(in) :: m
integer(ip_), intent(in) :: n
integer(ip_), intent(in) :: ne
integer(ip_), intent(in) :: row(ne)
integer(ip_), intent(in) :: col(ne)
integer(ip_), intent(out) :: ptr_out(n+1)
integer(ip_), allocatable, intent(out) :: row_out(:)
integer(ip_), intent(out) :: flag
real(rp_), optional, intent(in) :: val_in(*)
real(rp_), optional, allocatable :: val_out(:)
integer(ip_), optional, intent(out) :: lmap
integer(ip_), optional, allocatable :: map(:)
integer(ip_), optional, intent(in) :: lp
integer(ip_), optional, intent(out) :: noor
integer(ip_), optional, intent(out) :: ndup

! Dummy subroutine available with GALAHAD

flag = -1
end subroutine mc69_coord_convert_real

subroutine mc69_set_values_real(matrix_type, lmap, map, val, ne, val_out)
integer(ip_), intent(in) :: matrix_type
integer(ip_), intent(in) :: lmap
integer(ip_), intent(in) :: map(lmap)
real(rp_), intent(in) :: val(*)
integer(ip_), intent(in) :: ne
real(rp_), intent(out) :: val_out(ne)

! Dummy subroutine available with GALAHAD

val_out(1:ne) = 0.0_rp_
end subroutine mc69_set_values_real

END MODULE hsl_mc69_real
1 change: 1 addition & 0 deletions hsl_subset/hsl_mi35/hsl_mi35r.f90
Original file line number Diff line number Diff line change
Expand Up @@ -49,6 +49,7 @@ module hsl_mi35_real
real(rp_) :: tau2 = 0.0001_rp_
integer(ip_) :: unit_error = 6
integer(ip_) :: unit_warning = 6
real(rp_) :: weight_tol
end type mi35_control

type mi35_info
Expand Down
Loading