diff --git a/hsl_subset/hsl_ma48/hsl_ma48r.f90 b/hsl_subset/hsl_ma48/hsl_ma48r.f90 index ea9f4bf..aa4d8a3 100644 --- a/hsl_subset/hsl_ma48/hsl_ma48r.f90 +++ b/hsl_subset/hsl_ma48/hsl_ma48r.f90 @@ -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 @@ -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 @@ -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 @@ -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 diff --git a/hsl_subset/hsl_ma86/hsl_ma86r.f90 b/hsl_subset/hsl_ma86/hsl_ma86r.f90 index 8e8cabb..f708aa3 100644 --- a/hsl_subset/hsl_ma86/hsl_ma86r.f90 +++ b/hsl_subset/hsl_ma86/hsl_ma86r.f90 @@ -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 diff --git a/hsl_subset/hsl_ma87/hsl_ma87r.f90 b/hsl_subset/hsl_ma87/hsl_ma87r.f90 index 9b1f8a9..b3753f2 100644 --- a/hsl_subset/hsl_ma87/hsl_ma87r.f90 +++ b/hsl_subset/hsl_ma87/hsl_ma87r.f90 @@ -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 diff --git a/hsl_subset/hsl_ma97/hsl_ma97r.f90 b/hsl_subset/hsl_ma97/hsl_ma97r.f90 index a70d673..955ac80 100644 --- a/hsl_subset/hsl_ma97/hsl_ma97r.f90 +++ b/hsl_subset/hsl_ma97/hsl_ma97r.f90 @@ -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 @@ -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. @@ -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. @@ -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 diff --git a/hsl_subset/hsl_mc69/hsl_mc69r.f90 b/hsl_subset/hsl_mc69/hsl_mc69r.f90 index 3a21c15..8d711c8 100644 --- a/hsl_subset/hsl_mc69/hsl_mc69r.f90 +++ b/hsl_subset/hsl_mc69/hsl_mc69r.f90 @@ -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 diff --git a/hsl_subset/hsl_mi35/hsl_mi35r.f90 b/hsl_subset/hsl_mi35/hsl_mi35r.f90 index bf810df..11476ab 100644 --- a/hsl_subset/hsl_mi35/hsl_mi35r.f90 +++ b/hsl_subset/hsl_mi35/hsl_mi35r.f90 @@ -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