From ce5ae54003d1254e8ea7c1623fa94917d7dbeccc Mon Sep 17 00:00:00 2001 From: Jens Saak Date: Fri, 22 Sep 2023 18:30:59 +0200 Subject: [PATCH] release 3.0 updates --- CHANGELOG.md | 98 +- CITATION.cff | 45 +- CITATION.md | 14 +- CODE | 8 +- CODE_OF_CONDUCT.md | 1 - CONTRIBUTING.md | 56 +- CONTRIBUTORS.md | 195 +- COPYING | 2 +- DEMOS/Bilinear/bilinear_BT_rail.m | 121 +- DEMOS/DAE1/LQR_DAE1.m | 87 +- DEMOS/DAE1/bt_mor_DAE1_tol.m | 129 +- DEMOS/DAE2/IRKA_mor_Stokes.m | 68 +- DEMOS/DAE2/LQR_DAE2.m | 150 +- DEMOS/DAE2/bt_mor_DAE2.m | 217 +- DEMOS/DAE2/private/closed_step.m | 93 +- DEMOS/DAE2/private/impeuler.m | 48 +- DEMOS/DAE2/private/impeuler_closed.m | 60 +- DEMOS/DAE2/private/open_step.m | 85 +- DEMOS/DAE2/private/smoother.m | 11 +- DEMOS/DAE2_SO/LQR_DAE2_SO.m | 163 +- DEMOS/DAE3_SO/BT_DAE3_SO.m | 241 +- DEMOS/DAE3_SO/LQR_DAE3_SO.m | 120 +- DEMOS/DAE3_SO/runme_BT_DAE3_SO.m | 20 +- DEMOS/FDM/IRKA_FDM.m | 32 +- DEMOS/FDM/KSM_FDM.m | 171 ++ DEMOS/FDM/LQGBT_mor_FDM.m | 97 +- DEMOS/FDM/LQG_FDM_unstable_nwt.m | 111 +- DEMOS/FDM/LQG_FDM_unstable_radi.m | 435 ++-- DEMOS/FDM/bt_mor_FDM_tol.m | 75 +- DEMOS/FDM/lqgbt_mor_FDM.m | 186 -- DEMOS/LTV/LQR_LTV_smallscale_BDF.m | 70 +- DEMOS/LTV/LQR_LTV_smallscale_splitting.m | 62 +- DEMOS/Logger/logging.m | 108 + DEMOS/RI/DEMO_RI_GE_DAE2.m | 86 +- DEMOS/RI/DEMO_RI_GE_T_N.m | 64 +- DEMOS/RI/DEMO_RI_T_HYBRID.m | 254 +- DEMOS/Rail/ARE_rail.m | 341 +++ DEMOS/Rail/HINFR_rail.m | 51 +- DEMOS/Rail/IRKA_rail.m | 62 +- DEMOS/Rail/KSM_Rail.m | 220 ++ DEMOS/Rail/LQR_rail.m | 212 -- DEMOS/Rail/LQR_rail_BDF.m | 48 +- DEMOS/Rail/LQR_rail_Rosenbrock.m | 37 +- DEMOS/Rail/LQR_rail_splitting.m | 26 +- DEMOS/Rail/Lyapunov_rail_LDL_ADI.m | 121 +- DEMOS/Rail/bt_mor_rail_tol.m | 127 +- DEMOS/TripleChain/BT_TripleChain.m | 143 +- DEMOS/TripleChain/BT_sym_TripleChain.m | 136 +- DEMOS/TripleChain/IRKA_TripleChain.m | 137 + DEMOS/TripleChain/LQR_TripleChain.m | 204 +- .../private/square_root_method_SO.m | 23 +- DEMOS/models/BIPS/mess_get_BIPS.m | 92 +- .../Data_Rail/ODE_unit_matrices_20209.mat | Bin 5497336 -> 5497336 bytes .../Data_Rail/ODE_unit_matrices_5177.mat | Bin 1409880 -> 1409880 bytes .../Data_Rail/ODE_unit_matrices_79841.mat | Bin 21710136 -> 21710136 bytes .../models/Data_Rail/mess_get_bilinear_rail.m | 12 +- DEMOS/models/Data_Rail/mess_get_linear_rail.m | 13 +- .../models/Data_Rail/private/mess_load_rail.m | 52 +- DEMOS/models/FDM_2D/fdm_2d_matrix.m | 114 +- DEMOS/models/FDM_2D/fdm_2d_vector.m | 29 +- DEMOS/models/FDM_2D/miss_hit.cfg | 1 + DEMOS/models/NSE/mess_get_NSE.m | 41 +- DEMOS/models/README.md | 2 +- .../SingleChainMSD/SingleChainMSDgenMEK.m | 26 +- .../models/TripleChain/example_from_Saak09.m | 38 +- DEMOS/models/TripleChain/genMEK.m | 26 +- DEMOS/models/TripleChain/triplechain_MSD.m | 71 +- DEMOS/models/ms_ind3_by_t_stykel/miss_hit.cfg | 1 + DEMOS/models/ms_ind3_by_t_stykel/msd_ind3.m | 143 +- DEMOS/models/stokes/miss_hit.cfg | 1 + DEMOS/models/stokes/stokes_ind2.m | 801 +++--- DEPENDENCIES.md | 12 +- INSTALL.md | 2 +- ISSUES.md | 12 +- README.md | 24 +- doc/GettingStarted.mlx | Bin 4905 -> 6319 bytes doc/mess.m | 143 +- doc/mess_usfs.m | 14 +- helpers/care_nwt_fac.m | 86 +- helpers/lyap2solve.m | 59 +- helpers/lyap_sgn_fac.m | 78 +- helpers/mess_LDL_mul_D.m | 58 +- helpers/mess_accumulateK.m | 184 -- helpers/mess_column_compression.m | 37 +- helpers/mess_dense_nm.m | 147 +- .../mess_galerkin_projection_acceleration.m | 471 ---- helpers/mess_h2_rom_change.m | 50 - helpers/mess_make_proper.m | 34 +- helpers/mess_mgs.m | 102 - helpers/mess_reset.m | 4 +- helpers/mess_solve_projected_eqn.m | 685 +++++ helpers/mess_solve_shifted_system.m | 67 - helpers/mess_solve_shifted_system_BDF.m | 77 - .../mess_solve_shifted_system_Rosenbrock.m | 96 - helpers/mess_string.m | 47 + helpers/mess_symmetrize.m | 18 + helpers/mess_version.m | 43 + helpers/mess_websave.m | 16 + logger/mess_assert.m | 23 + logger/mess_err.m | 67 + logger/mess_fprintf.m | 53 + logger/mess_log_codes.m | 118 + logger/mess_log_finalize.m | 19 + logger/mess_log_initialize.m | 70 + logger/mess_log_matrix.m | 35 + logger/mess_log_plot.m | 57 + logger/mess_warn.m | 104 + logger/private/cleantex.m | 25 + logger/private/interactiveStack.m | 31 + logger/private/log_checkopts.m | 42 + logger/private/log_config.m | 18 + logger/private/log_formatter.m | 106 + logger/private/stackToString.m | 14 + logger/private/write_log_footer.m | 35 + logger/private/write_log_header.m | 29 + logger/resources/log.html.templ | 6 + logger/resources/log.md.templ | 0 logger/resources/log.tex.templ | 9 + mat-eqn-solvers/mess_KSM.m | 381 +++ mat-eqn-solvers/mess_bdf_dre.m | 363 +-- mat-eqn-solvers/mess_care.m | 79 +- mat-eqn-solvers/mess_lradi.m | 434 +-- mat-eqn-solvers/mess_lrnm.m | 988 +++---- mat-eqn-solvers/mess_lrradi.m | 2315 +++++++++-------- mat-eqn-solvers/mess_lrri.m | 378 +-- mat-eqn-solvers/mess_lyap.m | 78 +- mat-eqn-solvers/mess_lyapunov_bilinear.m | 188 +- mat-eqn-solvers/mess_rosenbrock_dre.m | 259 +- mat-eqn-solvers/mess_splitting_dre.m | 473 ++-- mat-eqn-solvers/mess_sylvester_sparse_dense.m | 275 ++ mat-eqn-solvers/private/IQ.m | 316 +-- mat-eqn-solvers/private/KSM_compute_res.m | 96 + mat-eqn-solvers/private/KSM_compute_shifts.m | 188 ++ mat-eqn-solvers/private/KSM_getT.m | 155 ++ mat-eqn-solvers/private/KSM_mgs.m | 126 + mat-eqn-solvers/private/KSM_space_expansion.m | 205 ++ mat-eqn-solvers/private/adaptive_SDIRK43.m | 79 +- mat-eqn-solvers/private/change_timestep.m | 15 - .../private/clenshawcurtis_parameters.m | 18 +- .../private/compute_additive_coefficients.m | 30 +- .../private/compute_quadrature_weights.m | 55 +- .../private}/exact_line_search.m | 93 +- .../private/exact_quadrature_parameters.m | 120 +- mat-eqn-solvers/private/expF.m | 16 +- mat-eqn-solvers/private/expG.m | 42 +- .../private/gauss_quadrature_parameters.m | 13 +- mat-eqn-solvers/private/mess_accumulateK.m | 210 ++ mat-eqn-solvers/private/mess_exp_action.m | 128 +- .../private/mess_solve_shifted_system.m | 94 + .../private/outerfrobnormdiff_LDLT.m | 49 +- .../private}/prepare_next_adi_iteration.m | 59 +- mat-eqn-solvers/private/reuseIQ.m | 15 - mess_path.m | 43 +- mor/mess_Frobenius_TF_error_plot.m | 107 +- mor/mess_balanced_truncation.m | 431 +-- mor/mess_balanced_truncation_bilinear.m | 95 +- mor/mess_sigma_plot.m | 335 +-- mor/mess_square_root_method.m | 73 +- mor/mess_tangential_irka.m | 299 ++- mor/mess_tf_plot.m | 440 ++++ mor/private/get_initial_subspace.m | 20 +- mor/private/mess_h2_rom_change.m | 54 + norms/mess_res2_norms.m | 226 +- norms/private/lyapunov.m | 35 +- norms/private/lyapunov_QB.m | 23 +- norms/private/riccati.m | 123 +- norms/riccati_LR.m | 61 +- private/genpath_exclude.m | 186 +- shifts/dn.m | 68 +- shifts/ellip.m | 75 +- shifts/mess_arn.m | 250 +- shifts/mess_get_projection_shifts.m | 145 +- shifts/mess_get_ritz_vals.m | 107 +- shifts/mess_lrradi_get_shifts.m | 254 +- ...ss_lrradi_get_shifts_hamOpti_generalized.m | 964 +++---- shifts/mess_mnmx.m | 49 +- shifts/mess_para.m | 181 +- shifts/mess_projection_shifts.m | 87 +- shifts/mess_s.m | 30 +- shifts/mess_wachspress.m | 78 +- shifts/mess_wachspress_n.m | 67 +- usfs/dae_1/eval_matrix_functions_dae_1.m | 29 +- usfs/dae_1/get_ritz_vals_dae_1.m | 45 +- usfs/dae_1/init_dae_1.m | 298 ++- usfs/dae_1/init_res_dae_1.m | 49 +- usfs/dae_1/mess_usfs_dae_1.m | 18 +- usfs/dae_1/mul_A_dae_1.m | 75 +- usfs/dae_1/mul_ApE_dae_1.m | 189 +- usfs/dae_1/mul_ApE_post_dae_1.m | 6 +- usfs/dae_1/mul_ApE_pre_dae_1.m | 6 +- usfs/dae_1/mul_E_dae_1.m | 59 +- usfs/dae_1/private/fake_E.m | 9 - usfs/dae_1/private/fake_E_clean.m | 6 - usfs/dae_1/private/fake_E_clean_dae_1.m | 16 + usfs/dae_1/private/fake_E_dae_1.m | 23 + usfs/dae_1/size_dae_1.m | 14 +- usfs/dae_1/sol_A_dae_1.m | 90 +- usfs/dae_1/sol_ApE_dae_1.m | 122 +- usfs/dae_1/sol_ApE_post_dae_1.m | 6 +- usfs/dae_1/sol_ApE_pre_dae_1.m | 6 +- usfs/dae_1/sol_E_dae_1.m | 71 +- usfs/dae_1_so/get_ritz_vals_dae_1_so.m | 53 +- usfs/dae_1_so/init_dae_1_so.m | 156 +- usfs/dae_1_so/init_res_dae_1_so.m | 50 +- usfs/dae_1_so/mess_usfs_dae_1_so.m | 19 +- usfs/dae_1_so/mul_A_dae_1_so.m | 90 +- usfs/dae_1_so/mul_ApE_dae_1_so.m | 147 +- usfs/dae_1_so/mul_E_dae_1_so.m | 83 +- usfs/dae_1_so/size_dae_1_so.m | 16 +- usfs/dae_1_so/sol_A_dae_1_so.m | 62 +- usfs/dae_1_so/sol_ApE_dae_1_so.m | 165 +- usfs/dae_1_so/sol_E_dae_1_so.m | 67 +- usfs/dae_2/get_ritz_vals_dae_2.m | 66 +- usfs/dae_2/init_dae_2.m | 145 +- usfs/dae_2/init_res_dae_2.m | 64 +- usfs/dae_2/init_res_post_dae_2.m | 8 +- usfs/dae_2/init_res_pre_dae_2.m | 8 +- usfs/dae_2/mess_usfs_dae_2.m | 6 +- usfs/dae_2/mul_A_dae_2.m | 84 +- usfs/dae_2/mul_A_post_dae_2.m | 8 +- usfs/dae_2/mul_A_pre_dae_2.m | 9 +- usfs/dae_2/mul_ApE_dae_2.m | 96 +- usfs/dae_2/mul_E_dae_2.m | 118 +- usfs/dae_2/mul_E_post_dae_2.m | 26 +- usfs/dae_2/mul_E_pre_dae_2.m | 48 +- usfs/dae_2/private/mul_Pi.m | 75 +- usfs/dae_2/private/mul_Pi_post.m | 12 +- usfs/dae_2/private/mul_Pi_pre.m | 14 +- usfs/dae_2/size_dae_2.m | 13 +- usfs/dae_2/sol_A_dae_2.m | 86 +- usfs/dae_2/sol_ApE_dae_2.m | 218 +- usfs/dae_2/sol_E_dae_2.m | 78 +- usfs/dae_2/sol_E_post_dae_2.m | 24 +- usfs/dae_2/sol_E_pre_dae_2.m | 43 +- usfs/dae_2_so/get_ritz_vals_dae_2_so.m | 75 +- usfs/dae_2_so/init_dae_2_so.m | 125 +- usfs/dae_2_so/init_res_dae_2_so.m | 74 +- usfs/dae_2_so/mul_A_dae_2_so.m | 92 +- usfs/dae_2_so/mul_ApE_dae_2_so.m | 284 +- usfs/dae_2_so/mul_E_dae_2_so.m | 94 +- usfs/dae_2_so/size_dae_2_so.m | 7 +- usfs/dae_2_so/sol_A_dae_2_so.m | 116 +- usfs/dae_2_so/sol_ApE_dae_2_so.m | 218 +- usfs/dae_2_so/sol_E_dae_2_so.m | 71 +- usfs/dae_3_so/get_ritz_vals_dae_3_so.m | 59 +- usfs/dae_3_so/init_dae_3_so.m | 122 +- usfs/dae_3_so/init_res_dae_3_so.m | 71 +- usfs/dae_3_so/mul_A_dae_3_so.m | 91 +- usfs/dae_3_so/mul_ApE_dae_3_so.m | 280 +- usfs/dae_3_so/mul_E_dae_3_so.m | 96 +- usfs/dae_3_so/size_dae_3_so.m | 7 +- usfs/dae_3_so/sol_A_dae_3_so.m | 116 +- usfs/dae_3_so/sol_ApE_dae_3_so.m | 284 +- usfs/dae_3_so/sol_E_dae_3_so.m | 71 +- usfs/default/eval_matrix_functions_default.m | 13 +- usfs/default/init_default.m | 168 +- usfs/default/init_res_default.m | 31 +- usfs/default/mess_usfs_default.m | 2 +- usfs/default/mul_A_default.m | 97 +- usfs/default/mul_ApE_default.m | 284 +- usfs/default/mul_ApE_post_default.m | 14 - usfs/default/mul_ApE_pre_default.m | 15 - usfs/default/mul_E_default.m | 62 +- usfs/default/mul_N_default.m | 44 +- usfs/default/mul_N_post_default.m | 15 +- usfs/default/mul_N_pre_default.m | 29 +- usfs/default/private/fake_E_clean.m | 15 - usfs/default/private/fake_E_clean_default.m | 15 + .../private/{fake_E.m => fake_E_default.m} | 8 +- usfs/default/size_default.m | 9 +- usfs/default/sol_A_default.m | 97 +- usfs/default/sol_ApE_default.m | 124 +- usfs/default/sol_ApE_post_default.m | 6 +- usfs/default/sol_ApE_pre_default.m | 6 +- usfs/default/sol_E_default.m | 56 +- usfs/default_iter/init_default_iter.m | 326 +++ usfs/default_iter/init_res_default_iter.m | 56 + usfs/default_iter/mess_usfs_default_iter.m | 68 + usfs/default_iter/mul_A_default_iter.m | 110 + usfs/default_iter/mul_ApE_default_iter.m | 284 ++ usfs/default_iter/mul_E_default_iter.m | 114 + usfs/default_iter/size_default_iter.m | 30 + usfs/default_iter/sol_A_default_iter.m | 250 ++ usfs/default_iter/sol_ApE_default_iter.m | 272 ++ usfs/default_iter/sol_ApE_post_default_iter.m | 13 + usfs/default_iter/sol_ApE_pre_default_iter.m | 80 + usfs/default_iter/sol_E_default_iter.m | 231 ++ usfs/mess_do_nothing.m | 5 +- usfs/mess_wrap_mechss.m | 86 +- usfs/mess_wrap_sparss.m | 33 +- usfs/operatormanager.m | 86 +- usfs/so_1/get_ritz_vals_so_1.m | 38 +- usfs/so_1/init_res_so_1.m | 31 +- usfs/so_1/init_so_1.m | 102 +- usfs/so_1/mess_usfs_so_1.m | 4 +- usfs/so_1/mul_A_so_1.m | 65 +- usfs/so_1/mul_ApE_so_1.m | 68 +- usfs/so_1/mul_E_so_1.m | 63 +- usfs/so_1/size_so_1.m | 12 +- usfs/so_1/sol_A_so_1.m | 64 +- usfs/so_1/sol_ApE_so_1.m | 54 +- usfs/so_1/sol_E_so_1.m | 59 +- usfs/so_2/get_ritz_vals_so_2.m | 38 +- usfs/so_2/init_res_so_2.m | 31 +- usfs/so_2/init_so_2.m | 106 +- usfs/so_2/mess_usfs_so_2.m | 2 +- usfs/so_2/mul_A_so_2.m | 56 +- usfs/so_2/mul_ApE_so_2.m | 80 +- usfs/so_2/mul_E_so_2.m | 61 +- usfs/so_2/size_so_2.m | 12 +- usfs/so_2/sol_A_so_2.m | 56 +- usfs/so_2/sol_ApE_so_2.m | 83 +- usfs/so_2/sol_E_so_2.m | 66 +- usfs/so_iter/init_res_so_iter.m | 56 + usfs/so_iter/init_so_iter.m | 398 +++ usfs/so_iter/mess_usfs_so_iter.m | 96 + usfs/so_iter/mul_A_so_iter.m | 117 + usfs/so_iter/mul_ApE_so_iter.m | 145 ++ usfs/so_iter/mul_E_so_iter.m | 116 + usfs/so_iter/size_so_iter.m | 30 + usfs/so_iter/sol_A_so_iter.m | 248 ++ usfs/so_iter/sol_ApE_post_so_iter.m | 13 + usfs/so_iter/sol_ApE_pre_so_iter.m | 92 + usfs/so_iter/sol_ApE_so_iter.m | 271 ++ usfs/so_iter/sol_E_so_iter.m | 231 ++ .../README_state_space_transformed_default.md | 16 - ..._ss_post_state_space_transformed_default.m | 17 +- ...o_ss_pre_state_space_transformed_default.m | 16 +- ...ss_to_ss_state_space_transformed_default.m | 140 +- ...init_res_state_space_transformed_default.m | 42 +- .../init_state_space_transformed_default.m | 55 +- ...ess_usfs_state_space_transformed_default.m | 2 +- ...l_A_post_state_space_transformed_default.m | 17 +- ...ul_A_pre_state_space_transformed_default.m | 16 +- .../mul_A_state_space_transformed_default.m | 143 +- ...ApE_post_state_space_transformed_default.m | 11 +- ..._ApE_pre_state_space_transformed_default.m | 16 +- .../mul_ApE_state_space_transformed_default.m | 205 +- .../mul_E_state_space_transformed_default.m | 103 +- .../private/LU_A.m | 24 + .../private/LU_A_clean.m | 25 + .../private/LU_E.m | 43 + .../private/LU_E_clean.m | 28 + .../size_state_space_transformed_default.m | 11 +- ...l_A_post_state_space_transformed_default.m | 18 +- ...ol_A_pre_state_space_transformed_default.m | 17 +- .../sol_A_state_space_transformed_default.m | 153 +- ...ApE_post_state_space_transformed_default.m | 25 +- ..._ApE_pre_state_space_transformed_default.m | 16 +- .../sol_ApE_state_space_transformed_default.m | 228 +- ...l_E_post_state_space_transformed_default.m | 43 - ...ol_E_pre_state_space_transformed_default.m | 43 - .../sol_E_state_space_transformed_default.m | 107 +- ...dss_post_state_space_transformed_default.m | 17 +- ..._dss_pre_state_space_transformed_default.m | 16 +- ...s_to_dss_state_space_transformed_default.m | 133 +- 356 files changed, 22720 insertions(+), 14591 deletions(-) create mode 100644 DEMOS/FDM/KSM_FDM.m delete mode 100644 DEMOS/FDM/lqgbt_mor_FDM.m create mode 100644 DEMOS/Logger/logging.m create mode 100644 DEMOS/Rail/ARE_rail.m create mode 100644 DEMOS/Rail/KSM_Rail.m delete mode 100644 DEMOS/Rail/LQR_rail.m create mode 100644 DEMOS/TripleChain/IRKA_TripleChain.m create mode 100644 DEMOS/models/FDM_2D/miss_hit.cfg create mode 100644 DEMOS/models/ms_ind3_by_t_stykel/miss_hit.cfg create mode 100644 DEMOS/models/stokes/miss_hit.cfg delete mode 100644 helpers/mess_accumulateK.m delete mode 100644 helpers/mess_galerkin_projection_acceleration.m delete mode 100644 helpers/mess_h2_rom_change.m delete mode 100644 helpers/mess_mgs.m create mode 100644 helpers/mess_solve_projected_eqn.m delete mode 100644 helpers/mess_solve_shifted_system.m delete mode 100644 helpers/mess_solve_shifted_system_BDF.m delete mode 100644 helpers/mess_solve_shifted_system_Rosenbrock.m create mode 100644 helpers/mess_string.m create mode 100644 helpers/mess_symmetrize.m create mode 100644 helpers/mess_version.m create mode 100644 helpers/mess_websave.m create mode 100644 logger/mess_assert.m create mode 100644 logger/mess_err.m create mode 100644 logger/mess_fprintf.m create mode 100644 logger/mess_log_codes.m create mode 100644 logger/mess_log_finalize.m create mode 100644 logger/mess_log_initialize.m create mode 100644 logger/mess_log_matrix.m create mode 100644 logger/mess_log_plot.m create mode 100644 logger/mess_warn.m create mode 100644 logger/private/cleantex.m create mode 100644 logger/private/interactiveStack.m create mode 100644 logger/private/log_checkopts.m create mode 100644 logger/private/log_config.m create mode 100644 logger/private/log_formatter.m create mode 100644 logger/private/stackToString.m create mode 100644 logger/private/write_log_footer.m create mode 100644 logger/private/write_log_header.m create mode 100644 logger/resources/log.html.templ create mode 100644 logger/resources/log.md.templ create mode 100644 logger/resources/log.tex.templ create mode 100644 mat-eqn-solvers/mess_KSM.m create mode 100644 mat-eqn-solvers/mess_sylvester_sparse_dense.m create mode 100644 mat-eqn-solvers/private/KSM_compute_res.m create mode 100644 mat-eqn-solvers/private/KSM_compute_shifts.m create mode 100644 mat-eqn-solvers/private/KSM_getT.m create mode 100644 mat-eqn-solvers/private/KSM_mgs.m create mode 100644 mat-eqn-solvers/private/KSM_space_expansion.m delete mode 100644 mat-eqn-solvers/private/change_timestep.m rename {helpers => mat-eqn-solvers/private}/exact_line_search.m (68%) create mode 100644 mat-eqn-solvers/private/mess_accumulateK.m create mode 100644 mat-eqn-solvers/private/mess_solve_shifted_system.m rename {helpers => mat-eqn-solvers/private}/prepare_next_adi_iteration.m (54%) delete mode 100644 mat-eqn-solvers/private/reuseIQ.m create mode 100644 mor/mess_tf_plot.m create mode 100644 mor/private/mess_h2_rom_change.m delete mode 100644 usfs/dae_1/private/fake_E.m delete mode 100644 usfs/dae_1/private/fake_E_clean.m create mode 100644 usfs/dae_1/private/fake_E_clean_dae_1.m create mode 100644 usfs/dae_1/private/fake_E_dae_1.m delete mode 100644 usfs/default/mul_ApE_post_default.m delete mode 100644 usfs/default/mul_ApE_pre_default.m delete mode 100644 usfs/default/private/fake_E_clean.m create mode 100644 usfs/default/private/fake_E_clean_default.m rename usfs/default/private/{fake_E.m => fake_E_default.m} (53%) create mode 100644 usfs/default_iter/init_default_iter.m create mode 100644 usfs/default_iter/init_res_default_iter.m create mode 100644 usfs/default_iter/mess_usfs_default_iter.m create mode 100644 usfs/default_iter/mul_A_default_iter.m create mode 100644 usfs/default_iter/mul_ApE_default_iter.m create mode 100644 usfs/default_iter/mul_E_default_iter.m create mode 100644 usfs/default_iter/size_default_iter.m create mode 100644 usfs/default_iter/sol_A_default_iter.m create mode 100644 usfs/default_iter/sol_ApE_default_iter.m create mode 100644 usfs/default_iter/sol_ApE_post_default_iter.m create mode 100644 usfs/default_iter/sol_ApE_pre_default_iter.m create mode 100644 usfs/default_iter/sol_E_default_iter.m create mode 100644 usfs/so_iter/init_res_so_iter.m create mode 100644 usfs/so_iter/init_so_iter.m create mode 100644 usfs/so_iter/mess_usfs_so_iter.m create mode 100644 usfs/so_iter/mul_A_so_iter.m create mode 100644 usfs/so_iter/mul_ApE_so_iter.m create mode 100644 usfs/so_iter/mul_E_so_iter.m create mode 100644 usfs/so_iter/size_so_iter.m create mode 100644 usfs/so_iter/sol_A_so_iter.m create mode 100644 usfs/so_iter/sol_ApE_post_so_iter.m create mode 100644 usfs/so_iter/sol_ApE_pre_so_iter.m create mode 100644 usfs/so_iter/sol_ApE_so_iter.m create mode 100644 usfs/so_iter/sol_E_so_iter.m delete mode 100644 usfs/state_space_transformed_default/README_state_space_transformed_default.md create mode 100644 usfs/state_space_transformed_default/private/LU_A.m create mode 100644 usfs/state_space_transformed_default/private/LU_A_clean.m create mode 100644 usfs/state_space_transformed_default/private/LU_E.m create mode 100644 usfs/state_space_transformed_default/private/LU_E_clean.m delete mode 100644 usfs/state_space_transformed_default/sol_E_post_state_space_transformed_default.m delete mode 100644 usfs/state_space_transformed_default/sol_E_pre_state_space_transformed_default.m diff --git a/CHANGELOG.md b/CHANGELOG.md index 3653f4c..adaa807 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,58 @@ # CHANGELOG +## version 3.0 + +### Added + +- Sparse-dense Sylvester solver, see `mess_sylvester_sparse_dense`. +- Krylov subspace projection methods for Lyapunov equations and AREs + using extended and rational Krylov subspaces, see `mess_KSM`, as + well as demonstration examples in `KSM_FDM`, `KSM_Rail`. +- A new logging system allowing to print messages to both console + and files, and switch between various output file format. See `mess_log_*`. +- `mess_tf_plot` as unified backend for `mess_sigma_plot`, + `mess_Frobenius_TF_errorplot` +- `mess_version` a function to get the current version of M-M.E.S.S. + +### Changed + +- `mess_galerkin_projection_acceleration` has been replaced by + `mess_solve_projected_eqn`, which now covers both the acceleration + case and the case of projected equations in the context of `mess_KSM`. +- `eqn.st` and `eqn.nd` from DAE usfs are now unified and called + `eqn.manifold_dim` everywhere. +- the LDL^T ADI for Lyapunov now expects W T W^T rather than + G S G^T as the constant term. Consequently, `eqn.S` and `eqn.G` are + now called `eqn.T` and `eqn.W`. +- missing demonstration models are now loaded from the web on user + request. The first run with a model may, thus, need to be + interactive to confirm the download request. +- usfs have been optimized further to not use unnecessary hidden data. +- `mess_lrnm`, and `mess_lrradi` now require `eqn.R` and `eqn.Q` to be + set in LDL^T mode. +- `operatormanager` now has a mandatory pass-through argument `opts` + for correct logging. + +### Fixed + +- many functions did not warn users about non-convergence +- minor bugs in DRE methods were addressed +- `get_ritz_vals` usfs and `mess_para` behavior has been unified +- removed dead code in `mess_lrnm` +- `lyap` in Octave and MATLAB had different behavior which is now + properly wrapped to give consistent results +- BDF methods of higher order now use lower order methods with smaller + step sizes for a successive wind-up procedure to guarantee the + expected order of convergence. +- exact line search in `mess_lrnm` now uses a more expensive, yet far + more numerically stable way to compute the relevant norms. + +### Deprecated + +- all functions in the `mor`folder are not going to be maintained in + future releases in favor of using M-M.E.S.S. as the sparse solver + backend for MORLAB in their version 6.0 and newer. + ## version 2.2 ### Added @@ -107,8 +160,8 @@ non-existent ones with a general `mess_do_nothing` function - renamed `opts.bdf.stage` to `opts.bdf.step`. - CI testing - - demos serve as system tests - - additional unit tests for the smaller building blocks and backend routines + - demos serve as system tests + - additional unit tests for the smaller building blocks and backend routines ### Changed @@ -116,21 +169,21 @@ - updated minimum required/recommended Matlab and Octave versions (see `DEPENDENCIES.md`) - unified function interfaces for top level calls -- unified handling of low rank updated operators. Now always A+UV' is +- unified handling of low-rank updated operators. Now always A+UV' is used. (Note the sign of the update and the transposition in V) - major updates in the MOR routines - some restructuring in the opts structure. - - `opts.adi.shifts` has moved to `opts.shifts` such that also RADI - can use it independent of ADI - - `opts.norm` now determines the norm for all methods rather than + - `opts.adi.shifts` has moved to `opts.shifts` such that also RADI + can use it independent of ADI + - `opts.norm` now determines the norm for all methods rather than having to consistently specify the same norm in each substructure - - initial feedbacks for the Riccati solvers are now stored in the - `opts` structure for the method rather than `eqn` + - initial feedbacks for the Riccati solvers are now stored in the + `opts` structure for the method rather than `eqn` - The projection shift routine uses the flag `opts.shifts.implicitVtAV`. Default is `true`. If set to `false` A*V is computed explicitly. - redesign of the demos - - turned scripts into actual demo functions - - new demos for indefinite AREs and H-infinity control + - turned scripts into actual demo functions + - new demos for indefinite AREs and H-infinity control ### Fixed @@ -149,24 +202,26 @@ - Minor consistency and bug fixes and improved integrity of metafiles. - CI testing - - demos serve as system tests - - additional unit tests for the smaller building blocks and backend routines + - demos serve as system tests + - additional unit tests for the smaller building blocks and backend routines ## version 1.0 Compared to the predecessor LyaPack a couple of things have changed. - The user supplied functions are now managed by an operator manager -- The low rank ADI now has: - - optimized treatment of E matrices in generalized equations - - more choices for shift selection, including completely automatic - generation of shifts - - improved stopping criteria based on low rank factors of the current residual - - automatic generation of real low rank factors also for complex shifts +- The low-rank ADI now has: + - optimized treatment of E matrices in generalized equations + - more choices for shift selection, including completely automatic + generation of shifts + - improved stopping criteria based on low-rank factors of the + current residual + - automatic generation of real low-rank factors also for complex shifts - The Newton-Kleinman iteration features: - - optimized treatment of E matrices in generalized equations - - improved stopping criteria based on low rank factors of the current residual - - inexact Newton, line search and Galerkin projection acceleration + - optimized treatment of E matrices in generalized equations + - improved stopping criteria based on low-rank factors of the + current residual + - inexact Newton, line search and Galerkin projection acceleration - Examples have been extended - The Riccati iteration for H-infinity Riccati equations was added - DSPMR has not yet been ported to the new infrastructure @@ -174,4 +229,3 @@ Compared to the predecessor LyaPack a couple of things have changed. none-DAE systems. Still, DAE versions are included in the corresponding DEMOS. - A tangential IRKA implementation for non-DAE systems was added - diff --git a/CITATION.cff b/CITATION.cff index 8aaf491..b0e7f54 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -1,33 +1,20 @@ # YAML 1.2 --- abstract: | - "M-M.E.S.S. provides low-rank solvers for large-scale symmetric matrix equations - with sparse or sparse + low rank coefficients. The main focus is on - differential and algebraic Riccati equations appearing in control and model - order reduction, as well as algebraic Lyapunov equations for, e.g., balanced - truncation. - - The underlying dynamical system may be of first or second order and - structured proper differential algebraic equations (DAEs) that allow for - implicit index reduction are also supported. - - The solvers philosophy is to always work on the implicitly linearized (for - second order systems) and/or implicitly projected (in the DAE case) matrix - equations. That means the implicit Lyapunov or Riccati equation is always of - the form known for a standard first order ODE, that may have a non identity - but invertible E matrix. - - Further, M-M.E.S.S. provides functions for Balanced Truncation and - (tangential) iterative rational Krylov algorithm (IRKA) for model order - reduction (MOR) of first order state space systems and some examples - demonstrate the use of the algorithms in MOR of second order systems and DAEs. - - In close relation to the predecessor LyaPack, we use user supplied functions - (usfs) that implement the actions of the system matrices E and A in - multiplication and (shifted) solves. We provide those functions for - standard state space systems, second order systems, structured DAEs of - index 1 and 2, as well as second order DAEs of index 1, 2 and 3. For more - information on usfs see help mess_usfs." + "M-M.E.S.S. The M-M.E.S.S. toolbox provides solvers for large-scale, + sparse, symmetric linear and quadratic matrix equations. These can be + algebraic and differential equations, and the solvers are in their core + all based on the low-rank ADI method.  M-M.E.S.S. can be seen as the + successor to the LyaPack toolbox with an improved formulation of the ADI, + that now properly supports generalized state-space systems, but also + special structured DAEs. It features additional solvers for differential + equations, improved shift parameter computation and a guarantee to compute + real low-rank factorization, but follows the same general philosophy of + user supplied functions that the LyaPack toolbox used. + + Additionally, from version 3.0 on, also the first non-symmetric equations + are supported, and Krylov subpace projection methods for symmetric + algebraic matrix equations exist." authors: - affiliation: "Max Planck Institute for Dynamics of Complex Technical Systems" @@ -45,9 +32,9 @@ authors: given-names: Peter orcid: "https://orcid.org/0000-0003-3362-4103" cff-version: "1.2.0" -doi: "10.5281/zenodo.5938237" +doi: "10.5281/zenodo.7701424" license: "BSD 2-Clause" message: "If you use this software, please cite it using these metadata." title: "M-M.E.S.S. -- Matrix Equations Sparse Solvers for MATLAB and Octave" -version: "2.2" +version: "3.0" ... diff --git a/CITATION.md b/CITATION.md index 82ae2ad..fb00874 100644 --- a/CITATION.md +++ b/CITATION.md @@ -11,20 +11,20 @@ below. ## DOI -The DOI for version 2.2 is -[10.5281/zenodo.5938237](http://doi.org/10.5281/zenodo.5938237) +The DOI for version 3.0 is +[10.5281/zenodo.7701424](http://doi.org/10.5281/zenodo.7701424) ## BibTeX ``` -@Misc{SaaKB21-mmess-2.2, +@Misc{SaaKB21-mmess-3.0, author = {Saak, J. and K\"{o}hler, M. and Benner, P.}, - title = {{M-M.E.S.S.}-2.2 -- The Matrix Equations Sparse Solvers + title = {{M-M.E.S.S.}-3.0 -- The Matrix Equations Sparse Solvers library}, - month = feb, - year = 2022, + month = aug, + year = 2023, note = {see also:\url{https://www.mpi-magdeburg.mpg.de/projects/mess}}, - doi = {10.5281/zenodo.5938237}, + doi = {10.5281/zenodo.7701424}, key = {MMESS} } diff --git a/CODE b/CODE index d9dd058..8550f03 100644 --- a/CODE +++ b/CODE @@ -1,8 +1,8 @@ name: Matrix Equations Sparse Solvers (for Matlab and Octave) shortname: M-M.E.S.S. -version: 2.2 -release-date: 2022-02-02 -id: 10.5281/zenodo.5938237 +version: 3.0 +release-date: 2023-XX-XX +id: 10.5281/zenodo.7701424 id-type: doi authors: MESS developer community copyright holders: Jens Saak, Martin Köhler, Peter Benner @@ -17,4 +17,4 @@ languages: Matlab dependencies: GNU Octave >= 5.1, MATLAB >= 2014a systems: Linux, Windows, MacOS website: https://gitlab.mpi-magdeburg.mpg.de/mess/mmess-releases -keywords: symmetric matrix equations, LR-ADI, Newton Kleinman, BDF methods, Rosenbrock methods, splitting methods, Riccati iteration, balanced trunation, IRKA +keywords: symmetric matrix equations, LR-ADI, Newton Kleinman, BDF methods, Rosenbrock methods, splitting methods, Riccati iteration, balanced trunation, IRKA, EKSM, RKSM diff --git a/CODE_OF_CONDUCT.md b/CODE_OF_CONDUCT.md index c6e690b..12e9a27 100644 --- a/CODE_OF_CONDUCT.md +++ b/CODE_OF_CONDUCT.md @@ -128,4 +128,3 @@ For answers to common questions about this code of conduct, see the FAQ at [https://www.contributor-covenant.org/faq](https://www.contributor-covenant.org/faq). Translations are available at [https://www.contributor-covenant.org/translations](https://www.contributor-covenant.org/translations). - diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index ec34a45..85ff1b8 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -3,7 +3,7 @@ Please note that this project is released with a Contributor [Code of Conduct](CODE_OF_CONDUCT.md). By participating in this project you agree to abide by its terms. Note further, that we follow -[![Contributor Covenant](https://img.shields.io/badge/Contributor%20Covenant-v2.0%20adopted-ff69b4.svg)](code_of_conduct.md) +[![Contributor Covenant](https://img.shields.io/badge/Contributor%20Covenant-v2.0%20adopted-ff69b4.svg)](CODE_OF_CONDUCT.md) and would like to emphasize the following additional examples of unacceptable behavior: @@ -22,7 +22,7 @@ GIT history. ## Attribution -When you have contributed code to M-M.E.S.S. you and the content of +When you have contributed code to M-M.E.S.S., you and the content of your contribution will be mentioned in the project's [contributors file](CONTRIBUTORS.md). Contributions are grouped by release, so if you have contributed code to multiple releases, you will be mentioned @@ -44,15 +44,15 @@ guidelines below: **Naming of functions:** * to avoid shadowing of functions from other toolboxes/packages or - the MATLAB core, all M-M.E.S.S. solver functions start with `mess_` + the MATLAB/Octave core, all M-M.E.S.S. solver functions start with `mess_` * demonstration routines can have names deviating from the above - principle but should be descriptive enough such that a basic idea + principle, but should be descriptive enough such that a basic idea of their contents is evident. * user supplied functions need to have a special naming scheme - described in the documentation or found in the `operatormanager` + described in the documentation and found in the `operatormanager` function inside the `usfs` folder * Routines that do not obey the above have to be put into a - `private` folder. + `private` folder, or embedded into their calling functions source file. **Code Style:** @@ -78,8 +78,8 @@ guidelines below: MATLAB's `lyap` and thus intended for matrices. * For the same abstraction reason, in core solvers, all operations with the system matrices have to be implemented via the `usfs` - system and access to `eqn.A_` or `eqn.E_` is prohibited. (see `help - mess_usfs` for details on the `usfs` system and philosophy) + system and access to, e.g., `eqn.A_` or `eqn.E_` is prohibited. + (see `help mess_usfs` for details on the `usfs` system and philosophy) * The options structure `opts` should contain a separate substructure for each algorithm/solver-function and options are only allowed on the top level when they are absolutely necessary @@ -89,7 +89,7 @@ guidelines below: the shape of the factorization computed, or the norm that should consistently be used for measuring progress are allowed on the top level. -* Avoid code duplication. If code blocks or variations thereof need to +* Avoid code duplication. If code blocks, or variations thereof, need to be repeated, consider to put them into a function and call it where necessary. If a helper function lacks functionality consider extending rather than doubling it. @@ -97,6 +97,24 @@ guidelines below: `% comment` rather than `%comment`. * We use blanks around operators and after commas in argument lists, e.g. `y = a * x + b;` and not `y=a*x+b;` +* Transposes, denoted by `'`, only occur on capital letters. + (this is currently required by our spellcheckers and may be dropped + in the future) + +**Warnings, Errors and Logging:** + +* We provide or own logging mechanisms. We, therefore, do not call + `error`, or `warning` directly, but via `mess_err` and `mess_warn` + found in the `logger` folder. +* `mess_log_matrix` additionally allows to write matrices to `.mat` + files. +* `mess_log_plot` can store the figures in image files. +* All M-M.E.S.S. code must use these and demonstration examples have + to initialize and finalize the logger via `mess_log_initialize`, + `mess_log_finalize`. +* It is mandatory to use `mess_fprintf` rather than `fprintf` or + `disp`. +* CI tests in `_tests` can be an exception from this rule. ## Maintainability @@ -108,25 +126,31 @@ follow these guidelines: * Work on a single issue per merge request or branch. * branch and merge often, since long living branches tend to become messy to handle and synchronize with the master. -* Try to 'rebase' your work onto the master before merging or - requesting a merge, if possible +* Try to 'rebase' your work onto the main branch before merging or + requesting a merge, if possible. ## Test Framework We use an extensive test system on our continuous integration (CI) server to ensure that new features do not break old functionality and all features work in both MATLAB and GNU Octave, both with and without -toolboxes/packages installed. Currently CI time is limited to 2 hours +toolboxes/packages installed. Currently CI time is limited to 6 hours and all tests should be finished in that time. -We distinguish between so called unit tests and system tests. Here, -unit tests are testing the smallest possible building blocks. As a +We distinguish between so called unit tests, system tests, and extended tests. +Here, unit tests are testing the smallest possible building blocks. As a rule of thumb, a routine that does not call external functions, or only private functions is a candidate for a unit test. Larger routines that run a hierarchy of other stuff, such as our demonstrator functions in the `DEMOS` folder should be used to perform -the much bigger system tests. +the bigger system tests. + +If runtimes become an issue, consider moving system tests to the extended +tests category. While unit and system tests are executed on every push that +affects them and included in our weekly pipelines, extended tests +(that run exceptionally long) are executed only in our monthly extended +pipelines. * All files in `DEMOS` should be accompanied by a system test calling them on an, ideally, small example. (See comment about the @@ -134,4 +158,4 @@ the much bigger system tests. * All `usfs` sets should be checked by unit tests. Use non-symmetric systems and system matrices where possible! * Consider to provide a unit test for every helper routine in your - method. + code. diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index 963f3b9..44e5a09 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -11,130 +11,181 @@ - Jens Saak [ORCID:0000-0001-5567-9637](https://orcid.org/0000-0001-5567-9637) - Martin Köhler [ORCID:0000-0003-2338-9904](https://orcid.org/0000-0003-2338-9904) +## Version 3.0 + +- Quirin Aumann [ORCID:0000-0001-7942-5703](https://orcid.org/0000-0001-7942-5703) + - extended IRKA tests. + - logger fixes. +- Björn Baran [ORCID:0000-0001-6570-3653](https://orcid.org/0000-0001-6570-3653) + - fixes and improvements in DRE methods, +- Christian Himpe [ORCID:0000-0003-2194-6754](https://orcid.org/0000-0003-2194-6754) + - code review + - documentation fixes + - release testing +- Martin Köhler [ORCID:0000-0003-2338-9904](https://orcid.org/0000-0003-2338-9904) + - code review +- Davide Palitta [ORCID:0000-0002-6987-4430](https://orcid.org/0000-0002-6987-4430) + - Prototype KSM for LEs and AREs. +- Jens Saak [ORCID:0000-0001-5567-9637](https://orcid.org/0000-0001-5567-9637) + - Revised sparse-dense Sylvester solvers and extended test routine. + - Testing, revision and optimization of the KSM codes. + - Testing, revision and optimization of the logger. + - Testing and revision of the iterative usfs. + - restructured CI setup. + - Revision of MOR methods and analysis functions. + - code style and quality improvements. + - automated style checker. + - documentation updates. + - release management. + - updated MOR functions + (unified interface, stability updates, merged backends) + - reduced code duplication + - revised error codes + - `mess_para` issue fixes + - experimental `default_iter` and `so_iter` usfs; supervision and + testing + - revised demonstration examples and benchmark model fetching. +- Steffen Werner [ORCID:0000-0003-1667-4862](https://orcid.org/0000-0003-1667-4862) + - LDL_T KSM. + - code reviews. + +### Student Assistants and Interns + +- Sebastian Bresch + - Sparse-dense Sylvester solvers and basic test routine. +- Ronald Mendez + - basic support for iterative linear solver support, via + `default_iter` and `so_iter`usfs. +- Adrian Schulze + - new logger framework + - automated spellchecking + - extended code style CI testing + - code style improvements + ## Version 2.2 - Quirin Aumann[ORCID:0000-0001-7942-5703](https://orcid.org/0000-0001-7942-5703) - - bug and documentation fixes in IRKA - - release testing + - bug and documentation fixes in IRKA + - release testing - Christian Himpe [ORCID:0000-0003-2194-6754](https://orcid.org/0000-0003-2194-6754) - - code review - - documentation fixes - - release testing + - code review + - documentation fixes + - release testing - Jens Saak [ORCID:0000-0001-5567-9637](https://orcid.org/0000-0001-5567-9637) - - improved MOR functions, - - larger Rail examples (for both the linear and bilinear cases), - - BIPS example fixes, - - Documentation updates, - - release testing, - - code review + - improved MOR functions, + - larger Rail examples (for both the linear and bilinear cases), + - BIPS example fixes, + - Documentation updates, + - release testing, + - code review - Tony Stillfjord [ORCID:0000-0001-6123-4271](https://orcid.org/0000-0001-6123-4271) - - splitting scheme for DREs related improvements. + - splitting scheme for DREs related improvements. - Steffen Werner [ORCID:0000-0003-1667-4862](https://orcid.org/0000-0003-1667-4862) - - code review + - code review ### Student Assistants and Interns - Adrian Schulze - - Spellchecker for comments, strings and MD-files, for both CLI and CI + - Spellchecker for comments, strings and MD-files, for both CLI and CI ## Version 2.1 - Björn Baran [ORCID:0000-0001-6570-3653](https://orcid.org/0000-0001-6570-3653) - - fixes and improvements in DRE methods, - - Newton and ADI + - fixes and improvements in DRE methods, + - Newton and ADI - Christian Bertram [ORCID:0000-0002-9227-4580](https://orcid.org/0000-0002-9227-4580) - - performance improvement in RADI + - performance improvement in RADI - Christian Himpe [ORCID:0000-0003-2194-6754](https://orcid.org/0000-0003-2194-6754) - - code review - - documentation fixes - - release testing + - code review + - documentation fixes + - release testing - Jens Saak [ORCID:0000-0001-5567-9637](https://orcid.org/0000-0001-5567-9637) - - improved documentation, - - improved user feedback, - - bug fixes, - - improved CI setup, - - improved MOR functions, - - rewritten `dae_1_so` usfs, - - refactored rail demo model, - - bilinear BT demo and performance optimization, - - automated packaging. + - improved documentation, + - improved user feedback, + - bug fixes, + - improved CI setup, + - improved MOR functions, + - rewritten `dae_1_so` usfs, + - refactored rail demo model, + - bilinear BT demo and performance optimization, + - automated packaging. - Tony Stillfjord [ORCID:0000-0001-6123-4271](https://orcid.org/0000-0001-6123-4271) - - minor update in splitting schemes for DREs. + - minor update in splitting schemes for DREs. - Steffen Werner [ORCID:0000-0003-1667-4862](https://orcid.org/0000-0003-1667-4862) - - LDL^T RADI, - - fixed and new demo for unstable Riccati equations, - - fixed initial solution bugs in RADI, - - changed `mess_care` backend to RADI. + - LDL^T RADI, + - fixed and new demo for unstable Riccati equations, + - fixed initial solution bugs in RADI, + - changed `mess_care` backend to RADI. ### Student Assistants and Interns - Sebastian Bresch - - low-rank "bilinear Lyapunov" aka "Lyapunov plus positive" equation - solver, - - basic sparss and mechss support, - - new usfs CI test framework. + - low-rank "bilinear Lyapunov" aka "Lyapunov plus positive" equation + solver, + - basic sparss and mechss support, + - new usfs CI test framework. - Adrian Schulze - - code coverage report generation, - - improved runtime reporting, - - automatic packaging system. + - code coverage report generation, + - improved runtime reporting, + - automatic packaging system. ## Version 2.0.1 - Björn Baran [ORCID:0000-0001-6570-3653](https://orcid.org/0000-0001-6570-3653) - - DRE method fixes. + - DRE method fixes. - Christian Himpe [ORCID:0000-0003-2194-6754](https://orcid.org/0000-0003-2194-6754) - - code review and documentation fixes. + - code review and documentation fixes. - Jens Saak [ORCID:0000-0001-5567-9637](https://orcid.org/0000-0001-5567-9637) - - improved MOR functions, - - partial release automation. + - improved MOR functions, + - partial release automation. - Steffen Werner [ORCID:0000-0003-1667-4862](https://orcid.org/0000-0003-1667-4862) - - bug fix for DAE_1 usfs. + - bug fix for DAE_1 usfs. ## Version 2.0 - Björn Baran [ORCID:0000-0001-6570-3653](https://orcid.org/0000-0001-6570-3653) - - BDF methods for non-autonomous DREs, - - system tests. + - BDF methods for non-autonomous DREs, + - system tests. - Patrick Kuerschner [ORCID:0000-0002-6114-8821](https://orcid.org/0000-0002-6114-8821) - - RADI. + - RADI. - Jens Saak [ORCID:0000-0001-5567-9637](https://orcid.org/0000-0001-5567-9637) - - improved MOR functions, - - test framework, - - unit and system tests, - - code and toolbox restructuring. + - improved MOR functions, + - test framework, + - unit and system tests, + - code and toolbox restructuring. - Tony Stillfjord [ORCID:0000-0001-6123-4271](https://orcid.org/0000-0001-6123-4271) - - splitting schemes for DREs. + - splitting schemes for DREs. - Steffen Werner [ORCID:0000-0003-1667-4862](https://orcid.org/0000-0003-1667-4862) - - RADI, - - improved Operator Manager, - - improved Riccati iteration. + - RADI, + - improved Operator Manager, + - improved Riccati iteration. ## Version 1.0 & 1.0.1 ### Student Assistants and Interns - Björn Baran [ORCID:0000-0001-6570-3653](https://orcid.org/0000-0001-6570-3653) - - LDL^T based Algorithms and Differential Equations. + - LDL^T based Algorithms and Differential Equations. - Maximilian Behr [ORCID:0000-0001-8519-1632](https://orcid.org/0000-0001-8519-1632) - - Operator Manager, - - DAE function handles. + - Operator Manager, + - DAE function handles. - Manuela Hund [ORCID:0000-0003-2888-3717](https://orcid.org/0000-0003-2888-3717) - - Documentation. + - Documentation. - Steffen Werner [ORCID:0000-0003-1667-4862](https://orcid.org/0000-0003-1667-4862) - - Riccati Iteration. + - Riccati Iteration. ### Indirect Contributions - Patrick Kürschner [ORCID:0000-0002-6114-8821](https://orcid.org/0000-0002-6114-8821) - - experimental prototype codes for: - - adaptive shifts, - - residual factor based algorithms, - - non-symmetric equations, - - RADI. + - experimental prototype codes for: + - adaptive shifts, + - residual factor based algorithms, + - non-symmetric equations, + - RADI. - Norman Lang [ORCID:0000-0002-9074-0103](https://orcid.org/0000-0002-9074-0103) - - experimental prototype codes for: - - LDL^T based algorithms, - - Differential Lyapunov and Riccati equations. + - experimental prototype codes for: + - LDL^T based algorithms, + - Differential Lyapunov and Riccati equations. - Heiko Weichelt [ORCID:0000-0002-9074-0103](https://orcid.org/0000-0002-9074-0103) - - experimental prototype codes for: - - inexact Newton with line-search + - experimental prototype codes for: + - inexact Newton with line-search diff --git a/COPYING b/COPYING index 7fa5d5d..b76cecb 100644 --- a/COPYING +++ b/COPYING @@ -1,4 +1,4 @@ -Copyright 2009-2022 Jens Saak, Martin Köhler, Peter Benner, and others +Copyright 2009-2023 Jens Saak, Martin Köhler, Peter Benner, and others Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are diff --git a/DEMOS/Bilinear/bilinear_BT_rail.m b/DEMOS/Bilinear/bilinear_BT_rail.m index 2ba29da..0b8999f 100644 --- a/DEMOS/Bilinear/bilinear_BT_rail.m +++ b/DEMOS/Bilinear/bilinear_BT_rail.m @@ -13,15 +13,7 @@ function bilinear_BT_rail(refinements) % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. -% All rights reserved. -% License: BSD 2-Clause License (see COPYING) -% - -% -% This file is part of the M-M.E.S.S. project -% (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % @@ -32,14 +24,15 @@ function bilinear_BT_rail(refinements) if exist('OCTAVE_VERSION', 'builtin') && ... (not(exist('verLessThan', 'file')) || verLessThan('octave', '5.2')) - disp('This demo needs at least octave 5.2 with ode15s support.'); + mess_fprintf(struct, ... + 'This demo needs at least octave 5.2 with ode15s support.'); return end %% Set the input argument, if it is not given. if nargin < 1 - refinements=3; + refinements = 2; end %% Fetch model data @@ -50,7 +43,7 @@ function bilinear_BT_rail(refinements) % Set tolerances and iteration limit for the Lyapunov-plus-positive solver opts.blyap.res_tol = 1e-6; -opts.blyap.rel_diff_tol = 1e-6 ; +opts.blyap.rel_diff_tol = 1e-6; opts.blyap.maxiter = 10; % Set options for the ADI-based inner Lyapunov solver @@ -70,22 +63,22 @@ function bilinear_BT_rail(refinements) % Set mess_res2_norm options opts.resopts.res.maxiter = 10; opts.resopts.res.tol = 1e-6; -opts.resopts.res.orth = 0; +opts.resopts.res.orth = false; -opts.fopts.LDL_T = 0; +opts.fopts.LDL_T = false; opts.fopts.norm = 'fro'; opts.srm.tol = 1e-10; opts.srm.info = 1; %% choose USFS set -oper = operatormanager('default'); +[oper, opts] = operatormanager(opts, 'default'); %% Perform system reduction -[ROM, ~, eqn, opts, oper]= mess_balanced_truncation_bilinear(eqn, opts ,oper); -ROM.haveE = 0; +[ROM, ~, eqn, opts, oper] = mess_balanced_truncation_bilinear(eqn, opts, oper); +ROM.haveE = false; % only needed for function bilinear systems to run for both FOM and ROM: -ROM.A_=ROM.A; -ROM.N_=ROM.N; +ROM.A_ = ROM.A; +ROM.N_ = ROM.N; %% Evaluation of reduction results % Set ode45 parameters @@ -94,80 +87,82 @@ function bilinear_BT_rail(refinements) tvals = t0:1:tf; % Start ode45 for original and reduced order systems -u = ones(size(eqn.B,2),1); -x0 = zeros(size(eqn.A_,1),1); -options=odeset(... - 'RelTol', 1e-6, ... - 'Mass', eqn.E_, ... - 'MStateDependence', 'none',... - 'MassSingular', 'no'); +u = ones(size(eqn.B, 2), 1); +x0 = zeros(size(eqn.A_, 1), 1); +options = odeset( ... + 'RelTol', 1e-6, ... + 'Mass', eqn.E_, ... + 'MStateDependence', 'none', ... + 'MassSingular', 'no'); [~, x] = ... - ode15s(@(t,x)bilinear_system(t,x, u, eqn, opts, oper), tvals, x0, options); + ode15s(@(t, x)bilinear_system(t, x, u, eqn, opts, oper), ... + tvals, x0, options); -options=odeset('RelTol', 1e-6); -u = ones(size(ROM.B,2),1); -x0 = zeros(1,size(ROM.A,1)); -[~,x_r] = ... - ode15s(@(t,x)bilinear_system(t, x, u, ROM, opts, oper), tvals, x0, options); +options = odeset('RelTol', 1e-6); +u = ones(size(ROM.B, 2), 1); +x0 = zeros(1, size(ROM.A, 1)); +[~, x_r] = ... + ode15s(@(t, x)bilinear_system(t, x, u, ROM, opts, oper), ... + tvals, x0, options); % Calculate and plot system outputs -y = eqn.C*x'; -y_r = ROM.C*x_r'; +y = eqn.C * x'; +y_r = ROM.C * x_r'; y = y'; y_r = y_r'; leg_comp = {'FOM out 1', 'FOM out 2', 'FOM out 3', 'FOM out 4', 'FOM out 5', ... - 'FOM out 6', 'ROM out 1', 'ROM out 2', 'ROM out 3', 'ROM out 4',... - 'ROM out 5', 'ROM out 6'}; + 'FOM out 6', 'ROM out 1', 'ROM out 2', 'ROM out 3', 'ROM out 4', ... + 'ROM out 5', 'ROM out 6'}; leg_err = {'out 1', 'out 2', 'out 3', 'out 4', 'out 5', 'out 6'}; -figure() -plot(tvals, y, '-', 'LineWidth', 3) -hold on -plot(tvals, y_r, '--', 'LineWidth', 3) -xlabel('time [s]') -ylabel('magnitude') -legend(leg_comp, 'Location','northeastoutside') -title('FOM (solid) versus ROM (dashed) outputs') -hold off +figure(); +plot(tvals, y, '-', 'LineWidth', 3); +hold on; +plot(tvals, y_r, '--', 'LineWidth', 3); +xlabel('time [s]'); +ylabel('magnitude'); +legend(leg_comp, 'Location', 'northeastoutside'); +title('FOM (solid) versus ROM (dashed) outputs'); +hold off; % Evaluate absolute error -absErr = abs(y-y_r); +absErr = abs(y - y_r); % and corresponding relative error relErr = abs(absErr ./ y); % plot relative error -figure() +figure(); semilogy(tvals, relErr, 'LineWidth', 3); -xlabel('time [s]') -ylabel('magnitude') -legend(leg_err, 'Location','northeastoutside') -title('pointwise relative output errors') +xlabel('time [s]'); +ylabel('magnitude'); +legend(leg_err, 'Location', 'northeastoutside'); +title('pointwise relative output errors'); % Check the relative error for i = 60:67 test_condition = relErr(i) < 1e-2; - if test_condition == 0 - error('limit for relative Error exceeded') + if not(test_condition) + mess_err(opts, 'relative_error', 'limit for relative Error exceeded'); end end -fprintf('Everything looks good!\n') +mess_fprintf(opts, 'Everything looks good!\n'); end %% helper function for the ode integrator -function f = bilinear_system(~, x ,u ,eqn, opts, oper) +function f = bilinear_system(~, x, u, eqn, opts, oper) - f = eqn.A_*x + eqn.B*u; +f = eqn.A_ * x + eqn.B * u; - [eqn, opts, oper] = oper.mul_N_pre(eqn, opts, oper); - numberOf_N_matrices = length(eqn.N_); +[eqn, opts, oper] = oper.mul_N_pre(eqn, opts, oper); +numberOf_N_matrices = length(eqn.N_); - for currentN_k = 1:numberOf_N_matrices - f = f + oper.mul_N(eqn, opts, 'N', x, 'N', currentN_k)*u(currentN_k); - end +for currentN_k = 1:numberOf_N_matrices + f = f + oper.mul_N(eqn, opts, 'N', x, 'N', currentN_k) * u(currentN_k); +end - [~, ~, ~] = oper.mul_N_post(eqn, opts, oper); +[~, ~, ~] = oper.mul_N_post(eqn, opts, oper); -end \ No newline at end of file +end diff --git a/DEMOS/DAE1/LQR_DAE1.m b/DEMOS/DAE1/LQR_DAE1.m index 2dc9de7..a6a91e4 100644 --- a/DEMOS/DAE1/LQR_DAE1.m +++ b/DEMOS/DAE1/LQR_DAE1.m @@ -10,31 +10,34 @@ function LQR_DAE1(istest) % interactive demo) % % References: -%[1] F. Freitas, J. Rommes, N. Martins, Gramian-based reduction method -% applied to large sparse power system descriptor models, IEEE Trans. -% Power Syst. 23 (3) (2008) 1258–1270. doi:10.1109/TPWRS.2008.926693 +% [1] F. Freitas, J. Rommes, N. Martins, Gramian-based reduction method +% applied to large sparse power system descriptor models, IEEE Transactions +% on Power Systems 23 (3) (2008) 1258–1270. doi:10.1109/TPWRS.2008.926693 % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % %% -if nargin<1, istest=0; end +if nargin < 1 + istest = false; +end %% % set operation -oper = operatormanager('dae_1'); +opts = struct(); +[oper, opts] = operatormanager(opts, 'dae_1'); %% Problem data eqn = mess_get_BIPS(7); %% Turn off close to singular warnings % (this model is really badly conditioned) -orig_warnstate = warning('OFF','MATLAB:nearlySingularMatrix'); +orig_warnstate = warning('OFF', 'MATLAB:nearlySingularMatrix'); %% opts.norm = 'fro'; @@ -44,15 +47,15 @@ function LQR_DAE1(istest) opts.adi.res_tol = 1e-12; opts.adi.rel_diff_tol = 1e-16; opts.adi.info = 0; -opts.adi.projection.freq=0; +opts.adi.projection.freq = 0; -eqn.type='N'; +eqn.type = 'N'; %% -opts.shifts.num_desired=25; -opts.shifts.num_Ritz=50; -opts.shifts.num_hRitz=25; +opts.shifts.num_desired = 25; +opts.shifts.num_Ritz = 50; +opts.shifts.num_hRitz = 25; opts.shifts.method = 'projection'; -opts.shifts.num_desired= 9; +opts.shifts.num_desired = 9; %% % Newton tolerances and maximum iteration number @@ -60,75 +63,79 @@ function LQR_DAE1(istest) opts.nm.res_tol = 1e-10; opts.nm.rel_diff_tol = 1e-16; opts.nm.info = 1; -opts.nm.linesearch = 1; -opts.nm.accumulateRes = 1; +opts.nm.linesearch = true; +opts.nm.accumulateRes = true; %% t_mess_lrnm = tic; outnm = mess_lrnm(eqn, opts, oper); t_elapsed1 = toc(t_mess_lrnm); -fprintf(1,'mess_lrnm took %6.2f seconds \n',t_elapsed1); +mess_fprintf(opts, 'mess_lrnm took %6.2f seconds \n', t_elapsed1); if istest - if min(outnm.res)>=opts.nm.res_tol - error('MESS:TEST:accuracy','unexpectedly inaccurate result in LRNM'); + if min(outnm.res) >= opts.nm.res_tol + mess_err(opts, 'TEST:accuracy', ... + 'unexpectedly inaccurate result in LRNM'); end else figure(); - semilogy(outnm.res,'LineWidth',3); + semilogy(outnm.res, 'LineWidth', 3); title('0 = C^T C + A^T X E + E^T X A -E^T X BB^T X E'); xlabel('number of iterations'); ylabel('normalized residual norm'); pause(1); end -disp('size outnm.Z:'); -disp(size(outnm.Z)); +[mZ, nZ] = size(outnm.Z); +mess_fprintf(opts, 'size outnm.Z: %d x %d\n', mZ, nZ); %% Lets try RADI opts.norm = 2; % RADI-MESS settings -opts.shifts.history = opts.shifts.num_desired*size(eqn.C,1); +opts.shifts.history = opts.shifts.num_desired * size(eqn.C, 1); opts.shifts.method = 'gen-ham-opti'; opts.shifts.naive_update_mode = false; % .. Suggest false (smart update is faster; convergence is the same). -opts.radi.compute_sol_fac = 1; -opts.radi.get_ZZt = 1; -opts.radi.compute_res = 0; -opts.radi.maxiter = 500; -opts.radi.res_tol = opts.nm.res_tol; -opts.radi.rel_diff_tol = 0; -opts.radi.info = 1; +opts.radi.compute_sol_fac = true; +opts.radi.get_ZZt = true; +opts.radi.compute_res = false; +opts.radi.maxiter = 500; +opts.radi.res_tol = opts.nm.res_tol; +opts.radi.rel_diff_tol = 0; +opts.radi.info = 1; t_mess_lrradi = tic; -outradi = mess_lrradi( eqn, opts, oper ); +outradi = mess_lrradi(eqn, opts, oper); t_elapsed2 = toc(t_mess_lrradi); -fprintf(1,'mess_lrradi took %6.2f seconds \n', t_elapsed2); +mess_fprintf(opts, 'mess_lrradi took %6.2f seconds \n', t_elapsed2); if istest - if min(outradi.res)>=opts.radi.res_tol - error('MESS:TEST:accuracy','unexpectedly inaccurate result in RADI'); + if min(outradi.res) >= opts.radi.res_tol + mess_err(opts, 'TEST:accuracy', ... + 'unexpectedly inaccurate result in RADI'); end else figure(); - semilogy(outradi.res,'LineWidth',3); + semilogy(outradi.res, 'LineWidth', 3); title('0 = C^T C + A^T X E + E^T X A - E^T X BB^T X E'); xlabel('number of iterations'); ylabel('normalized residual norm'); end -disp('size outradi.Z:'); -disp(size(outradi.Z)); +[mZ, nZ] = size(outradi.Z); +mess_fprintf(opts, 'size outradi.Z: %d x %d\n', mZ, nZ); %% compare if not(istest) figure(); - ls_nm=[outnm.adi.niter]; - ls_radi=1:outradi.niter; + ls_nm = [outnm.adi.niter]; + ls_radi = 1:outradi.niter; - semilogy(cumsum(ls_nm),outnm.res,'k--',ls_radi,outradi.res,'b-','LineWidth',3); + semilogy(cumsum(ls_nm), outnm.res, 'k--', ... + ls_radi, outradi.res, 'b-', ... + 'LineWidth', 3); title('0 = C^T C + A^T X E + E^T X A -E^T X BB^T X E'); xlabel('number of solves with A + p * E'); ylabel('normalized residual norm'); - legend('LR-NM','RADI'); + legend('LR-NM', 'RADI'); end %% reset warning state diff --git a/DEMOS/DAE1/bt_mor_DAE1_tol.m b/DEMOS/DAE1/bt_mor_DAE1_tol.m index 3548b9b..6e43ed9 100644 --- a/DEMOS/DAE1/bt_mor_DAE1_tol.m +++ b/DEMOS/DAE1/bt_mor_DAE1_tol.m @@ -5,154 +5,165 @@ function bt_mor_DAE1_tol(k, istest) % % Input: % k select model (allowed values 1,..5, 7, .., 13, default 7) -% note that BIPS model 6 is not stable. +% note that BIPS model 6 is not stable. % istest decides whether the function runs as an interactive demo or a % continuous integration test. (optional; defaults to 0, i.e. % interactive demo) % % References: -%[1] F. Freitas, J. Rommes, N. Martins, Gramian-based reduction method -% applied to large sparse power system descriptor models, IEEE Trans. -% Power Syst. 23 (3) (2008) 1258–1270. doi:10.1109/TPWRS.2008.926693 +% [1] F. Freitas, J. Rommes, N. Martins, Gramian-based reduction method +% applied to large sparse power system descriptor models, IEEE Transactions +% on Power Systems 23 (3) (2008) 1258–1270. doi:10.1109/TPWRS.2008.926693 % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - +opts = struct; %% -if nargin < 1, k = 7; end -if nargin < 2, istest = 0; end +if nargin < 1 + k = 7; +end +if nargin < 2 + istest = false; +end %% % set operation manager for the Gramian computations -oper = operatormanager('dae_1'); +[oper, opts] = operatormanager(opts, 'dae_1'); %% Read problem data if k == 6 - warning('MESS:illegal_input', ... - ['The Juba5723 model is not stable and thus not supported. ',... - 'Using BIPS bips98_606 instead.']); + mess_warn(opts, 'illegal_input', ... + ['The Juba5723 model is not stable and thus not supported. ', ... + 'Using BIPS bips98_606 instead.']); k = 7; end eqn = mess_get_BIPS(k); %% Turn off close to singular warnings % (this model is really badly conditioned) -orig_warnstate = warning('OFF','MATLAB:nearlySingularMatrix'); +orig_warnstate = warning('OFF', 'MATLAB:nearlySingularMatrix'); %% % ADI tolerances and maximum iteration number -opts.adi.maxiter = 300; -opts.adi.res_tol = 1e-10; -opts.adi.rel_diff_tol = 1e-16; -opts.adi.info = 1; +opts.adi.maxiter = 300; +opts.adi.res_tol = 1e-10; +opts.adi.rel_diff_tol = 1e-16; +opts.adi.info = 1; opts.norm = 'fro'; %% opts.shifts.method = 'projection'; -opts.shifts.num_desired= 20; +opts.shifts.num_desired = 20; %% -eqn.type='N'; +eqn.type = 'N'; t_mess_lradi = tic; outB = mess_lradi(eqn, opts, oper); t_elapsed1 = toc(t_mess_lradi); -fprintf(1,'mess_lradi took %6.2f seconds \n', t_elapsed1); +mess_fprintf(opts, 'mess_lradi took %6.2f seconds \n', t_elapsed1); if istest - if min(outB.res)>=opts.adi.res_tol - error('MESS:TEST:accuracy','unexpectedly inaccurate result'); + if min(outB.res) >= opts.adi.res_tol + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result'); end else figure; - semilogy(outB.res,'LineWidth',3); + semilogy(outB.res, 'LineWidth', 3); title('0 = BB^T + A X E^T + E X A^T'); xlabel('number of iterations'); ylabel('normalized residual norm'); end -disp('size outB.Z:'); -disp(size(outB.Z)); +[mZ, nZ] = size(outB.Z); +mess_fprintf(opts, 'size outB.Z: %d x %d\n', mZ, nZ); %% -eqn.type='T'; +eqn.type = 'T'; t_mess_lradi = tic; -outC = mess_lradi(eqn, opts, oper); -t_elapsed2 = toc(t_mess_lradi); -fprintf(1,'mess_lradi took %6.2f seconds \n', t_elapsed2); +outC = mess_lradi(eqn, opts, oper); +t_elapsed2 = toc(t_mess_lradi); + +mess_fprintf(opts, 'mess_lradi took %6.2f seconds \n', t_elapsed2); if istest - if min(outC.res)>=opts.adi.res_tol - error('MESS:TEST:accuracy','unexpectedly inaccurate result'); + if min(outC.res) >= opts.adi.res_tol + mess_err(opts, 'TEST:accuracy', ... + 'unexpectedly inaccurate result'); end else figure; - semilogy(outC.res,'LineWidth',3); + semilogy(outC.res, 'LineWidth', 3); title('0 = C^T C + A^T X E + E^T X A'); xlabel('number of iterations'); ylabel('normalized residual norm'); pause(1); end -disp('size outC.Z:'); -disp(size(outC.Z)); +[mZ, nZ] = size(outC.Z); +mess_fprintf(opts, 'size outC.Z: %d x %d\n', mZ, nZ); %% Compute reduced system matrices % Perform Square Root Method (SRM) % BT tolerance and maximum order for the ROM -opts.srm.tol=1e-3; -opts.srm.max_ord=250; +opts.srm.tol = 1e-3; +opts.srm.max_ord = 250; % SRM verbosity if istest - opts.srm.info=1; + opts.srm.info = 1; else - opts.srm.info=2; + opts.srm.info = 2; end % The actual SRM -[TL,TR,hsv] = mess_square_root_method(eqn,opts,oper,outB.Z,outC.Z); +[TL, TR, hsv] = mess_square_root_method(eqn, opts, oper, outB.Z, outC.Z); % compute ROM matrices -B1 = TL'*(eqn.A_(1:eqn.st,1:eqn.st))*TR; -B2 = TL'*(eqn.A_(1:eqn.st,eqn.st+1:end)); -A1 = eqn.A_(eqn.st+1:end,1:eqn.st)*TR; - -ROM.A = B1 - B2*(eqn.A_(eqn.st+1:end,eqn.st+1:end)\A1); -ROM.B = TL'*eqn.B(1:eqn.st,:) - ... - B2*(eqn.A_(eqn.st+1:end,eqn.st+1:end)\eqn.B(eqn.st+1:end,:)); -ROM.C = eqn.C(:,1:eqn.st)*TR - ... - eqn.C(:,eqn.st+1:end)*(eqn.A_(eqn.st+1:end,eqn.st+1:end)\A1); -ROM.D = -eqn.C(:,eqn.st+1:end)*(eqn.A_(eqn.st+1:end,eqn.st+1:end)\... - eqn.B(eqn.st+1:end,:)); +n = size(eqn.A_, 1); +one = 1:eqn.manifold_dim; +two = (eqn.manifold_dim + 1):n; + +B1 = TL' * (eqn.A_(one, one) * TR); +B2 = TL' * (eqn.A_(one, two)); +A1 = eqn.A_(two, one) * TR; + +ROM.A = B1 - B2 * (eqn.A_(two, two) \ A1); +ROM.B = TL' * eqn.B(one, :) - B2 * (eqn.A_(two, two) \ eqn.B(two, :)); +ROM.C = eqn.C(:, one) * TR - eqn.C(:, two) * (eqn.A_(two, two) \ A1); +ROM.D = -eqn.C(:, two) * (eqn.A_(two, two) \ eqn.B(two, :)); ROM.E = eye(size(ROM.A)); + %% Evaluate the ROM quality % while the Gramians are computed on the hidden manifold, we need to do the % frequency domain computations without (implicitly) using the Schur % complement (due to the construction of the function handles) -oper = operatormanager('default'); +[oper, opts] = operatormanager(opts, 'default'); if istest - opts.sigma.info=0; + opts.tf_plot.info = 0; else - opts.sigma.info=2; + opts.tf_plot.info = 2; end -opts.sigma.fmin=-3; -opts.sigma.fmax=4; +opts.tf_plot.fmin = -3; +opts.tf_plot.fmax = 4; + +opts.tf_plot.type = 'sigma'; -out = mess_sigma_plot(eqn, opts, oper, ROM); err = out.err; +out = mess_tf_plot(eqn, opts, oper, ROM); +err = out.err; if istest - if max(err)>5e-3 - error('MESS:TEST:accuracy','unexpectedly inaccurate result'); + if max(err) > 5e-3 + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result'); end else figure; - semilogy(hsv,'LineWidth',3); + semilogy(hsv, 'LineWidth', 3); title('Computed Hankel singular values'); xlabel('index'); ylabel('magnitude'); diff --git a/DEMOS/DAE2/IRKA_mor_Stokes.m b/DEMOS/DAE2/IRKA_mor_Stokes.m index 5edf655..7873245 100644 --- a/DEMOS/DAE2/IRKA_mor_Stokes.m +++ b/DEMOS/DAE2/IRKA_mor_Stokes.m @@ -9,9 +9,9 @@ function IRKA_mor_Stokes(istest) % % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % @@ -19,12 +19,14 @@ function IRKA_mor_Stokes(istest) %% IRKA tolerance and maximum iteration number opts.irka.maxiter = 150; opts.irka.r = 30; -opts.irka.flipeig = 0; +opts.irka.flipeig = false; opts.irka.h2_tol = 1e-6; opts.irka.init = 'logspace'; -if nargin < 1, istest = 0; end +if nargin < 1 + istest = false; +end if istest opts.irka.info = 1; @@ -32,7 +34,7 @@ function IRKA_mor_Stokes(istest) opts.irka.info = 2; end -oper = operatormanager('dae_2'); +[oper, opts] = operatormanager(opts, 'dae_2'); %% Problem data nin = 5; @@ -40,20 +42,20 @@ function IRKA_mor_Stokes(istest) nx = 10; ny = 10; [eqn.E_, eqn.A_, eqn.Borig, eqn.Corig] = ... - stokes_ind2(nin, nout, nx, ny); + stokes_ind2(nin, nout, nx, ny, opts); n = size(eqn.E_, 1); -eqn.haveE = 1; -st=trace(eqn.E_); % Stokes is FDM discretized, so so this is - % the dimension of the velocity space -eqn.st = st; -eqn.B = eqn.Borig(1:st, :); -eqn.C = eqn.Corig(:, 1:st); +eqn.haveE = true; +n_ode = trace(eqn.E_); % Stokes is FDM discretized, so so this is +% the dimension of the velocity space +eqn.manifold_dim = n_ode; +eqn.B = eqn.Borig(1:n_ode, :); +eqn.C = eqn.Corig(:, 1:n_ode); %% Compute reduced system matrices t_mess_tangential_irka = tic; -[ROM.E, ROM.A, ROM.B, ROM.C, ~, ~, ~, ~, W] = ... +[ROM.E, ROM.A, ROM.B, ROM.C, ~, outinfo] = ... mess_tangential_irka(eqn, opts, oper); t_elapsed1 = toc(t_mess_tangential_irka); -fprintf(1,'mess_tangential_irka took %6.2f seconds \n', t_elapsed1); +mess_fprintf(opts, 'mess_tangential_irka took %6.2f seconds \n\n', t_elapsed1); %% t_eval_ROM = tic; @@ -65,48 +67,56 @@ function IRKA_mor_Stokes(istest) % 'default' usfs for unstructured computation: eqn.B = eqn.Borig; eqn.C = eqn.Corig; -oper = operatormanager('default'); +[oper, opts] = operatormanager(opts, 'default'); if istest - opts.sigma.info = 0; + opts.tf_plot.info = 0; else - opts.sigma.info = 2; + opts.tf_plot.info = 2; end -opts.sigma.fmin = -3; -opts.sigma.fmax = 4; +opts.tf_plot.fmin = -3; +opts.tf_plot.fmax = 4; + +opts.tf_plot.type = 'sigma'; + +% We want to have the frequencies depicted in Hertz and values in decibels +opts.tf_plot.Hz = true; +opts.tf_plot.db = true; -out = mess_sigma_plot(eqn, opts, oper, ROM); +out = mess_tf_plot(eqn, opts, oper, ROM); t_elapsed2 = toc(t_eval_ROM); -fprintf(1,'evaluation of ROM matrices took %6.2f seconds \n' , t_elapsed2); +mess_fprintf(opts, ... + 'evaluation of ROM matrices took %6.2f seconds \n', t_elapsed2); %% maerr = max(abs(out.err)); mrerr = max(abs(out.relerr)); -if istest && (maerr>1e-6 || mrerr>1e-4) - error('MESS:TEST:accuracy',['unexpectedly inaccurate result.\n' ... - 'max. abs err: %e (allowed 1e-6)\n' ... - 'max rel err: %e (allowed 1e-4)'], maerr, mrerr); +if istest && (maerr > 1e-6 || mrerr > 1e-4) + mess_err(opts, 'TEST:accuracy', ['unexpectedly inaccurate result.\n' ... + 'max. abs err: %e (allowed 1e-6)\n' ... + 'max rel err: %e (allowed 1e-4)'], ... + maerr, mrerr); end %% problem = 'Stokes'; fprintf(['\nComputing open loop step response of original and ', ... - 'reduced-order systems and time domain MOR errors\n']); + 'reduced-order systems and time domain MOR errors\n']); open_step(eqn, ROM.A, ROM.B, ROM.C, problem, istest); %% fprintf('\nComputing ROM based feedback\n'); if exist('care', 'file') - [~, ~, Kr] = care(ROM.A, ROM.B, ROM.C'*ROM.C, eye(size(ROM.B, 2))); + [~, ~, Kr] = care(ROM.A, ROM.B, ROM.C' * ROM.C, eye(size(ROM.B, 2))); else Y = care_nwt_fac([], ROM.A, ROM.B, ROM.C, 1e-12, 50); Kr = (Y * ROM.B)' * Y; end -K = [Kr * W' * eqn.E_(1:st, 1:st), zeros(size(Kr, 1), n-st)]; +K = [Kr * outinfo.TL' * eqn.E_(1:n_ode, 1:n_ode), zeros(size(Kr, 1), n - n_ode)]; %% fprintf(['\nComputing closed loop step response of original and ', ... - 'reduced-order systems and time domain MOR errors\n']); + 'reduced-order systems and time domain MOR errors\n']); closed_step(eqn, ROM.A, ROM.B, ROM.C, problem, K, Kr, istest); diff --git a/DEMOS/DAE2/LQR_DAE2.m b/DEMOS/DAE2/LQR_DAE2.m index b410126..3098747 100644 --- a/DEMOS/DAE2/LQR_DAE2.m +++ b/DEMOS/DAE2/LQR_DAE2.m @@ -24,19 +24,28 @@ function LQR_DAE2(problem, level, re, istest) % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % %% Set operations -oper = operatormanager('dae_2'); +opts = struct(); +[oper, opts] = operatormanager(opts, 'dae_2'); %% Problem data -if nargin<1, problem='stokes'; end -if nargin<2, level=1; end -if nargin<3, re=500; end -if nargin<4, istest=0; end +if nargin < 1 + problem = 'stokes'; +end +if nargin < 2 + level = 1; +end +if nargin < 3 + re = 500; +end +if nargin < 4 + istest = false; +end switch lower(problem) case 'stokes' @@ -44,74 +53,81 @@ function LQR_DAE2(problem, level, re, istest) nout = 5; nx = 10; ny = 10; - [eqn.E_,eqn.A_,eqn.B,eqn.C]=stokes_ind2(nin,nout,nx,ny); - eqn.haveE=1; - st=trace(eqn.E_); % Stokes is FDM discretized, so so this is + [eqn.E_, eqn.A_, eqn.B, eqn.C] = ... + stokes_ind2(nin, nout, nx, ny, opts); + eqn.haveE = true; + n_ode = trace(eqn.E_); % Stokes is FDM discretized, so so this is % the dimension of the velocity space - eqn.st=st; - eqn.B=eqn.B(1:st,:); - eqn.C=eqn.C(:,1:st); + eqn.manifold_dim = n_ode; + eqn.B = eqn.B(1:n_ode, :); + eqn.C = eqn.C(:, 1:n_ode); case 'nse' [eqn, K0, ~] = mess_get_NSE(re, level); opts.nm.K0 = K0; opts.radi.K0 = K0; otherwise - error('input ''problem'' must be either ''NSE'' or ''Stokes'''); + mess_err(opts, 'illegal_input', ... + 'input ''problem'' must be either ''NSE'' or ''Stokes'''); end %% % First we run the Newton-ADI Method opts.norm = 2; % ADI tolerances and maximum iteration number -opts.adi.maxiter = 300; -opts.adi.res_tol = 1e-12; -opts.adi.rel_diff_tol = 1e-16; -opts.adi.info = 1; -opts.adi.LDL_T=0; -eqn.type='T'; +opts.adi.maxiter = 300; +opts.adi.res_tol = 1e-12; +opts.adi.rel_diff_tol = 1e-16; +opts.adi.info = 1; +opts.adi.LDL_T = false; +eqn.type = 'T'; + %% -n=size(eqn.A_, 1); -opts.shifts.num_desired=5;%*nout; -opts.shifts.num_Ritz=50; -opts.shifts.num_hRitz=25; -opts.shifts.method = 'projection'; -opts.shifts.b0=ones(n,1); +n = size(eqn.A_, 1); +opts.shifts.num_desired = 5; % *nout; +opts.shifts.num_Ritz = 50; +opts.shifts.num_hRitz = 25; +opts.shifts.method = 'projection'; +opts.shifts.b0 = ones(n, 1); + %% % Newton tolerances and maximum iteration number -opts.nm.maxiter = 20; -opts.nm.res_tol = 1e-10; -opts.nm.rel_diff_tol = 1e-16; -opts.nm.info = 1; -opts.nm.projection.freq=0; -opts.nm.projection.ortho=1; -%opts.nm.projection.meth='care_nwt_fac'; -opts.nm.res=struct('maxiter',10,'tol',1e-6,'orth',0); -opts.nm.linesearch = 1; -opts.nm.inexact = 'superlinear'; -opts.nm.tau = 0.1; -opts.nm.accumulateRes = 1; +opts.nm.maxiter = 20; +opts.nm.res_tol = 1e-10; +opts.nm.rel_diff_tol = 1e-16; +opts.nm.info = 1; +opts.nm.projection.freq = 0; +opts.nm.projection.ortho = true; +% in case you want to e.g. specify the factored Newton solver for +% the projected equations uncomment the following +% opts.nm.projection.meth = 'care_nwt_fac'; +opts.nm.res = struct('maxiter', 10, ... + 'tol', 1e-6, ... + 'orth', 0); +opts.nm.linesearch = true; +opts.nm.inexact = 'superlinear'; +opts.nm.tau = 0.1; +opts.nm.accumulateRes = true; %% use low-rank Newton-Kleinman-ADI t_mess_lrnm = tic; outnm = mess_lrnm(eqn, opts, oper); -t_elapsed1 =toc(t_mess_lrnm); -fprintf(1,'mess_lrnm took %6.2f seconds \n' , t_elapsed1); +t_elapsed1 = toc(t_mess_lrnm); +mess_fprintf(opts, 'mess_lrnm took %6.2f seconds \n\n', t_elapsed1); if not(istest) figure(1); - disp(outnm.res); - semilogy(outnm.res,'LineWidth',3); + semilogy(outnm.res, 'LineWidth', 3); title('0 = C^T C + A^T X E + E^T X A - E^T X BB^T X E'); xlabel('number of newton iterations'); ylabel('normalized residual norm'); pause(1); end -disp('size outnm.Z:'); -disp(size(outnm.Z)); +[mZ, nZ] = size(outnm.Z); +mess_fprintf(opts, 'size outnm.Z: %d x %d\n\n', mZ, nZ); %% Lets try the RADI method and compare -opts.norm = 2; +opts.norm = 2; % RADI-MESS settings -opts.shifts.history = opts.shifts.num_desired*size(eqn.C,1); +opts.shifts.history = opts.shifts.num_desired * size(eqn.C, 1); opts.shifts.num_desired = opts.shifts.num_desired; % choose either of the three shift methods, here @@ -119,23 +135,25 @@ function LQR_DAE2(problem, level, re, istest) % opts.shifts.method = 'heur'; % opts.shifts.method = 'projection'; -opts.shifts.naive_update_mode = false; % .. Suggest false (smart update is faster; convergence is the same). -opts.shifts.info = 0; -opts.radi.compute_sol_fac = 1; % Turned on for numerical stability reasons. -opts.radi.get_ZZt = 0; -opts.radi.maxiter = opts.adi.maxiter; -opts.radi.res_tol = opts.nm.res_tol; -opts.radi.rel_diff_tol = 0; -opts.radi.info = 1; - +opts.shifts.naive_update_mode = false; % .. Suggest false +% (smart update is faster; +% convergence is the same). +opts.shifts.info = 0; +opts.radi.compute_sol_fac = true; % Turned on for numerical stability reasons. +opts.radi.get_ZZt = false; +opts.radi.maxiter = opts.adi.maxiter; +opts.radi.res_tol = opts.nm.res_tol; +opts.radi.rel_diff_tol = 0; +opts.radi.info = 1; t_mess_lrradi = tic; outradi = mess_lrradi(eqn, opts, oper); t_elapsed2 = toc(t_mess_lrradi); -fprintf(1,'mess_lrradi took %6.2f seconds \n' ,t_elapsed2); +mess_fprintf(opts, 'mess_lrradi took %6.2f seconds \n', t_elapsed2); + if not(istest) figure(); - semilogy(outradi.res,'LineWidth',3); + semilogy(outradi.res, 'LineWidth', 3); title('0 = C^TC + A^T X E + E^T X A - E^T X BB^T X E'); xlabel('number of iterations'); ylabel('normalized residual norm'); @@ -143,16 +161,24 @@ function LQR_DAE2(problem, level, re, istest) %% compare if istest - if min(outnm.res)>=opts.nm.res_tol, error('MESS:TEST:accuracy','unexpectedly inaccurate result'); end - if min(outradi.res)>=opts.radi.res_tol, error('MESS:TEST:accuracy','unexpectedly inaccurate result'); end + if min(outnm.res) >= opts.nm.res_tol + mess_err(opts, 'TEST:accuracy', ... + 'unexpectedly inaccurate result'); + end + if min(outradi.res) >= opts.radi.res_tol + mess_err(opts, 'TEST:accuracy', ... + 'unexpectedly inaccurate result'); + end else figure(); - ls_nm=[outnm.adi.niter]; - ls_radi=1:outradi.niter; + ls_nm = [outnm.adi.niter]; + ls_radi = 1:outradi.niter; - semilogy(cumsum(ls_nm),outnm.res,'k--',ls_radi,outradi.res,'b-','LineWidth',3); + semilogy(cumsum(ls_nm), outnm.res, 'k--', ... + ls_radi, outradi.res, 'b-', ... + 'LineWidth', 3); title('0 = C^T C + A^T X E + E^T X A - E^T X BB^T X E'); xlabel('number of solves with A+p*M'); ylabel('normalized residual norm'); - legend('LR-NM','RADI'); + legend('LR-NM', 'RADI'); end diff --git a/DEMOS/DAE2/bt_mor_DAE2.m b/DEMOS/DAE2/bt_mor_DAE2.m index 367fb2d..e836a62 100644 --- a/DEMOS/DAE2/bt_mor_DAE2.m +++ b/DEMOS/DAE2/bt_mor_DAE2.m @@ -28,142 +28,157 @@ function bt_mor_DAE2(problem, level, re, istest) % https://doi.org/10.3934/naco.2016.6.1 % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % %% ADI tolerance and maximum iteration number -opts.adi.maxiter = 350; -opts.adi.res_tol = sqrt(eps); +opts.adi.maxiter = 350; +opts.adi.res_tol = sqrt(eps); opts.adi.rel_diff_tol = 1e-16; -opts.adi.info = 1; -opts.shifts.info = 1; -opts.norm = 'fro'; +opts.adi.info = 1; +opts.shifts.info = 1; +opts.norm = 'fro'; -oper = operatormanager('dae_2'); +[oper, opts] = operatormanager(opts, 'dae_2'); %% Problem data -if nargin<1, problem='stokes'; end -if nargin<2, level=1; end -if nargin<3, re=500; end -if nargin<4, istest=0; end +if nargin < 1 + problem = 'stokes'; +end +if nargin < 2 + level = 1; +end +if nargin < 3 + re = 500; +end +if nargin < 4 + istest = false; +end problem = lower(problem); switch problem case 'stokes' - nin = 5; + nin = 5; nout = 5; - nx = 10; - ny = 10; - [eqn.E_,eqn.A_,eqn.Borig,eqn.Corig]=stokes_ind2(nin,nout,nx,ny); - n=size(eqn.E_,1); - eqn.haveE=1; - st=trace(eqn.E_); % Stokes is FDM discretized, so so this is - % the dimension of the velocity space - eqn.st=st; - eqn.B=eqn.Borig(1:st,:); - eqn.C=eqn.Corig(:,1:st); + nx = 10; + ny = 10; + [eqn.E_, eqn.A_, eqn.Borig, eqn.Corig] = ... + stokes_ind2(nin, nout, nx, ny, opts); + n = size(eqn.E_, 1); + eqn.haveE = true; + n_ode = trace(eqn.E_); % Stokes is FDM discretized, so so this is + % the dimension of the velocity space + eqn.manifold_dim = n_ode; + eqn.B = eqn.Borig(1:n_ode, :); + eqn.C = eqn.Corig(:, 1:n_ode); case 'nse' - [eqn, K0primal, K0dual] = mess_get_NSE( re, level); - st=eqn.st; - n=size(eqn.E_,1); + [eqn, K0primal, K0dual] = mess_get_NSE(re, level); + n_ode = eqn.manifold_dim; + n = size(eqn.E_, 1); otherwise - error('input ''problem'' must be either ''NSE'' or ''Stokes'''); + mess_err(opts, ... + 'illegal_input', ... + 'input ''problem'' must be either ''NSE'' or ''Stokes'''); end %% -eqn.type='N'; +eqn.type = 'N'; % Activate stabilizing (Bernoulli) feedback -if strcmp(problem,'nse') - eqn.V=-K0primal'; - eqn.U = eqn.B; - eqn.haveUV=1; +if strcmp(problem, 'nse') + eqn.V = -K0primal'; + eqn.U = eqn.B; + eqn.haveUV = true; end +opts.shifts.num_desired = 6; +opts.shifts.num_Ritz = 40; +opts.shifts.num_hRitz = 40; +opts.shifts.method = 'projection'; -opts.shifts.num_desired=6; -opts.shifts.num_Ritz=40; -opts.shifts.num_hRitz=40; -opts.shifts.method='projection'; - -opts.shifts.b0=ones(size(eqn.A_,1),1); +opts.shifts.b0 = ones(size(eqn.A_, 1), 1); t_mess_lradi = tic; -outB = mess_lradi(eqn,opts,oper); +outB = mess_lradi(eqn, opts, oper); t_elapsed1 = toc(t_mess_lradi); -fprintf(1,'mess_lradi took %6.2f seconds \n',t_elapsed1); +mess_fprintf(opts, ... + 'mess_lradi took %6.2f seconds \n', ... + t_elapsed1); if not(istest) - figure(); - semilogy(outB.res,'LineWidth',3); + figure('Name', 'Residual history (controllability)'); + semilogy(outB.res, 'LineWidth', 3); title('A X E^T + E X A^T = -BB^T'); xlabel('number of iterations'); ylabel('normalized residual norm'); pause(1); end -disp('size outB.Z:'); -disp(size(outB.Z)); +[mZ, nZ] = size(outB.Z); +mess_fprintf(opts, 'size outB.Z: %d x %d\n\n', mZ, nZ); %% eqn.type = 'T'; % Activate stabilizing (Bernoulli) feedback (for the dual system) -if strcmp(problem,'nse') - eqn.U=-K0dual'; - eqn.V = eqn.C'; - eqn.haveUV=1; +if strcmp(problem, 'nse') + eqn.U = -K0dual'; + eqn.V = eqn.C'; + eqn.haveUV = true; end +opts.shifts.num_desired = 6; +opts.shifts.num_Ritz = 40; +opts.shifts.num_hRitz = 40; +opts.shifts.method = 'projection'; -opts.shifts.num_desired=6; -opts.shifts.num_Ritz=40; -opts.shifts.num_hRitz=40; -opts.shifts.method='projection'; - -opts.shifts.b0=ones(size(eqn.A_,1),1); +opts.shifts.b0 = ones(size(eqn.A_, 1), 1); t_mess_lradi = tic; outC = mess_lradi(eqn, opts, oper); t_elapsed2 = toc(t_mess_lradi); -fprintf(1,'mess_lradi took %6.2f seconds \n',t_elapsed2); +mess_fprintf(opts, ... + 'mess_lradi took %6.2f seconds \n', ... + t_elapsed2); if not(istest) - figure(); - semilogy(outC.res,'LineWidth',3); + figure('Name', 'Residual history (observability)'); + semilogy(outC.res, 'LineWidth', 3); title('A^T X E + E^T X A = -C^T C'); xlabel('number of iterations'); ylabel('normalized residual norm'); pause(1); end -disp('size outC.Z:'); -disp(size(outC.Z)); +[mZ, nZ] = size(outC.Z); +mess_fprintf(opts, 'size outC.Z: %d x %d\n\n', mZ, nZ); %% Compute reduced system matrices % Perform Square Root Method (SRM) % BT tolerance and maximum order for the ROM -t_SRM = tic; -opts.srm.tol=1e-5; -opts.srm.max_ord=250; +t_SRM = tic; +opts.srm.tol = 1e-5; +opts.srm.max_ord = 250; % SRM verbosity if istest - opts.srm.info=1; + opts.srm.info = 1; else - opts.srm.info=2; + opts.srm.info = 2; end -%The actual SRM -[TL,TR,hsv] = mess_square_root_method(eqn,opts,oper,outB.Z,outC.Z); +% The actual SRM +[TL, TR, hsv] = mess_square_root_method(eqn, opts, oper, outB.Z, outC.Z); %% -ROM.A = TL'*(eqn.A_(1:st,1:st)*TR); -ROM.B = TL'*eqn.B(1:st,:); -ROM.C = eqn.C(:,1:st)*TR; +ROM.A = TL' * (eqn.A_(1:n_ode, 1:n_ode) * TR); +ROM.B = TL' * eqn.B(1:n_ode, :); +ROM.C = eqn.C(:, 1:n_ode) * TR; t_elapsed3 = toc(t_SRM); -fprintf(1,'computation of reduced system matrices took %6.2f seconds \n',t_elapsed3); +mess_fprintf(opts, ... + 'computation of reduced system matrices took %6.2f seconds \n', ... + t_elapsed3); %% t_eval_ROM = tic; @@ -174,54 +189,62 @@ function bt_mor_DAE2(problem, level, re, istest) % 'default' usfs for unstructured computation: switch lower(problem) case 'stokes' - eqn.B=eqn.Borig; - eqn.C=eqn.Corig; + eqn.B = eqn.Borig; + eqn.C = eqn.Corig; case 'nse' - n = size(eqn.A_,1); - eqn.B(st+1:n,:) = zeros(n-st,size(eqn.B,2)); - eqn.C(:,st+1:n) = zeros(size(eqn.C,1),n-st); + n = size(eqn.A_, 1); + eqn.B(n_ode + 1:n, :) = zeros(n - n_ode, size(eqn.B, 2)); + eqn.C(:, n_ode + 1:n) = zeros(size(eqn.C, 1), n - n_ode); end -oper = operatormanager('default'); +[oper, opts] = operatormanager(opts, 'default'); if istest - opts.sigma.info=0; + opts.tf_plot.info = 0; else - opts.sigma.info=2; + opts.tf_plot.info = 2; end -opts.sigma.fmin=-3; -opts.sigma.fmax=4; +opts.tf_plot.fmin = -3; +opts.tf_plot.fmax = 4; -out = mess_sigma_plot(eqn, opts, oper, ROM); err = out.err; +opts.tf_plot.type = 'sigma'; + +out = mess_tf_plot(eqn, opts, oper, ROM); +err = out.err; t_elapsed4 = toc(t_eval_ROM); -fprintf(1,'evaluation of rom quality took %6.2f seconds \n' ,t_elapsed4); +mess_fprintf(opts, ... + 'evaluation of rom quality took %6.2f seconds \n', ... + t_elapsed4); %% if istest - if max(err)>=opts.srm.tol, error('MESS:TEST:accuracy','unexpectedly inaccurate result'); end + if max(err) >= opts.srm.tol + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result'); + end else - figure; - semilogy(hsv,'LineWidth',3); + figure('Name', 'Computed Hankel singular values'); + semilogy(hsv, 'LineWidth', 3); title('Computed Hankel singular values'); xlabel('index'); ylabel('magnitude'); end %% -fprintf(['\nComputing open loop step response of original and reduced order ' ... - 'systems and time domain MOR errors\n']); -open_step(eqn,ROM.A,ROM.B,ROM.C,problem,istest); +mess_fprintf(opts, ... + ['\nComputing open loop step response of original and reduced ' ... + 'order systems and time domain MOR errors\n']); +open_step(eqn, ROM.A, ROM.B, ROM.C, problem, istest); %% -fprintf('\nComputing ROM based feedback\n'); +mess_fprintf(opts, '\nComputing ROM based feedback\n'); if exist('care', 'file') - [~,~,Kr]=care(ROM.A,ROM.B,ROM.C'*ROM.C,eye(size(ROM.B,2))); + [~, ~, Kr] = care(ROM.A, ROM.B, ROM.C' * ROM.C, eye(size(ROM.B, 2))); else - Y = care_nwt_fac([],ROM.A,ROM.B,ROM.C,1e-12,50); - Kr = (Y*ROM.B)'*Y; + Y = care_nwt_fac([], ROM.A, ROM.B, ROM.C, 1e-12, 50); + Kr = (Y * ROM.B)' * Y; end -K=[Kr*TL'*eqn.E_(1:st,1:st),zeros(size(Kr,1),n-st)]; +K = [Kr * TL' * eqn.E_(1:n_ode, 1:n_ode), zeros(size(Kr, 1), n - n_ode)]; %% -fprintf(['\nComputing closed loop step response of original and reduced order ' ... - 'systems and time domain MOR errors\n']); -closed_step(eqn,ROM.A,ROM.B,ROM.C,problem,K,Kr,istest); - +mess_fprintf(opts, ... + ['\nComputing closed loop step response of original and ' ... + 'reduced order systems and time domain MOR errors\n']); +closed_step(eqn, ROM.A, ROM.B, ROM.C, problem, K, Kr, istest); diff --git a/DEMOS/DAE2/private/closed_step.m b/DEMOS/DAE2/private/closed_step.m index fcfc97e..5f7d373 100644 --- a/DEMOS/DAE2/private/closed_step.m +++ b/DEMOS/DAE2/private/closed_step.m @@ -1,4 +1,4 @@ -function closed_step(eqn,Ar,Br,Cr,problem,K,Kr,istest) +function closed_step(eqn, Ar, Br, Cr, problem, K, Kr, istest) % Simple validation of the DAE2 MESS closed loop example via a basic % step response computation % @@ -16,92 +16,97 @@ function closed_step(eqn,Ar,Br,Cr,problem,K,Kr,istest) % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % -x0=zeros(size(eqn.A_,1),1); -xr0=zeros(size(Ar,1),1); +x0 = zeros(size(eqn.A_, 1), 1); +xr0 = zeros(size(Ar, 1), 1); +opts = struct; -alpha=1; -tau=1e-2; -tmin=0; -tmax=50; -T=tmin:tau:tmax; -ntau=floor((tmax-tmin)/tau); -taurange=1:floor(ntau/500):ntau; +alpha = 1; +tau = 1e-2; +tmin = 0; +tmax = 50; +T = tmin:tau:tmax; +ntau = floor((tmax - tmin) / tau); +taurange = 1:floor(ntau / 500):ntau; %% t_impeuler_closed = tic; -[y,yr] = impeuler_closed(eqn.E_,eqn.A_,eqn.B,eqn.C,eye(size(Ar)),Ar,Br,... - Cr,K,Kr,tau,tmin,tmax,x0,xr0,alpha); +[y, yr] = impeuler_closed(eqn.E_, eqn.A_, eqn.B, eqn.C, eye(size(Ar)), Ar, Br, ... + Cr, K, Kr, tau, tmin, tmax, x0, xr0, alpha); t_elapsed = toc(t_impeuler_closed); -fprintf(1,'implicit euler took %6.2f seconds \n', t_elapsed); +fprintf(1, 'implicit euler took %6.2f seconds \n', t_elapsed); %% -abserr=abs(y-yr); -relerr=abs(abserr./y); +abserr = abs(y - yr); +relerr = abs(abserr ./ y); %% if istest maerr = max(abserr); - if maerr>=1e-6 - error('MESS:TEST:accuracy',['unexpectedly inaccurate result ' ... - 'in closed loop simulation. Maximum ' ... - 'absolute error %e > 1e-6'], maerr); + if maerr >= 1e-6 + mess_err(opts, 'TEST:accuracy', ['unexpectedly inaccurate result ' ... + 'in closed loop simulation. Maximum ' ... + 'absolute error %e > 1e-6'], maerr); end else - colors=['y','m','c','r','g','b','k']; + colors = ['y', 'm', 'c', 'r', 'g', 'b', 'k']; figure(); hold on; - for j=1:size(eqn.C,1) - plot(T(taurange),y(j,taurange),colors(j),'LineWidth',3); - plot(T(taurange),yr(j,taurange),strcat(colors(j),'--'),'LineWidth',3); + for j = 1:size(eqn.C, 1) + plot(T(taurange), y(j, taurange), colors(j), 'LineWidth', 3); + plot(T(taurange), yr(j, taurange), strcat(colors(j), '--'), 'LineWidth', 3); end xlabel('time'); ylabel('magnitude of outputs'); title('step response'); - if strcmp(problem,'NSE') - legend('out1','out1 red','out2','out2 red','out3','out3 red',... - 'out4','out4 red','out5','out5 red','out6','out6 red',... - 'out7','out7 red','Location','EastOutside'); + if strcmp(problem, 'NSE') + legend('out1', 'out1 red', 'out2', 'out2 red', 'out3', 'out3 red', ... + 'out4', 'out4 red', 'out5', 'out5 red', 'out6', 'out6 red', ... + 'out7', 'out7 red', 'Location', 'EastOutside'); else - legend('out1','out1 red','out2','out2 red','out3','out3 red',... - 'out4','out4 red','out5','out5 red','Location','EastOutside'); + legend('out1', 'out1 red', 'out2', 'out2 red', 'out3', 'out3 red', ... + 'out4', 'out4 red', 'out5', 'out5 red', 'Location', 'EastOutside'); end hold off; %% figure(); - for j=1:size(eqn.C,1) - semilogy(T(taurange),abserr(j,taurange),colors(j),'LineWidth',3); - if 1==j, hold on; end + for j = 1:size(eqn.C, 1) + semilogy(T(taurange), abserr(j, taurange), colors(j), 'LineWidth', 3); + if 1 == j + hold on; + end end xlabel('time'); ylabel('magnitude'); title('absolute error'); - if strcmp(problem,'NSE') - legend('out1','out2','out3','out4','out5','out6','out7',... - 'Location','EastOutside'); + if strcmp(problem, 'NSE') + legend('out1', 'out2', 'out3', 'out4', 'out5', 'out6', 'out7', ... + 'Location', 'EastOutside'); else - legend('out1','out2','out3','out4','out5','Location','EastOutside'); + legend('out1', 'out2', 'out3', 'out4', 'out5', 'Location', 'EastOutside'); end hold off; figure(); - for j=1:size(eqn.C,1) - semilogy(T(taurange),relerr(j,taurange),colors(j),'LineWidth',3); - if 1==j, hold on; end + for j = 1:size(eqn.C, 1) + semilogy(T(taurange), relerr(j, taurange), colors(j), 'LineWidth', 3); + if 1 == j + hold on; + end end xlabel('time'); ylabel('magnitude'); title('relative error'); - if strcmp(problem,'NSE') - legend('out1','out2','out3','out4','out5','out6','out7',... - 'Location','EastOutside'); + if strcmp(problem, 'NSE') + legend('out1', 'out2', 'out3', 'out4', 'out5', 'out6', 'out7', ... + 'Location', 'EastOutside'); else - legend('out1','out2','out3','out4','out5','Location','EastOutside'); + legend('out1', 'out2', 'out3', 'out4', 'out5', 'Location', 'EastOutside'); end hold off; end diff --git a/DEMOS/DAE2/private/impeuler.m b/DEMOS/DAE2/private/impeuler.m index 02b5f3e..8b544bc 100644 --- a/DEMOS/DAE2/private/impeuler.m +++ b/DEMOS/DAE2/private/impeuler.m @@ -1,4 +1,4 @@ -function [y,yr] = impeuler(E,A,B,C,Er,Ar,Br,Cr,tau,tmin,tmax,x0,xr0,alpha) +function [y, yr] = impeuler(E, A, B, C, Er, Ar, Br, Cr, tau, tmin, tmax, x0, xr0, alpha) % Simple implicit Euler implementation for validation of the DAE2 % MESS open loop example via a basic step response computation % @@ -17,39 +17,37 @@ % y,yr outputs of the full and reduced systems in [tmin,tmax] % - % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % +opts = struct; +[L, U, P, Q] = lu(E - tau * A); +[Lr, Ur, Pr] = lu(Er - tau * Ar); - [L,U,P,Q] = lu(E-tau*A); - [Lr,Ur,Pr] = lu(Er-tau*Ar); - - ntau=ceil((tmax-tmin)/tau); - y=zeros(size(C,1),ntau); - yr=y; - for i=1:ntau - if not(mod(i,ceil(ntau/10))) - fprintf('\r Implicit Euler step %d / %d',i,ntau); +ntau = ceil((tmax - tmin) / tau); +y = zeros(size(C, 1), ntau); +yr = y; +for i = 1:ntau + if not(mod(i, ceil(ntau / 10))) + mess_fprintf(opts, '\r Implicit Euler step %d / %d', i, ntau); end - if i<(0.1*ntau) - x=Q*(U\(L\(P*(E*x0)))); - xr=Ur\(Lr\(Pr*(Er*xr0))); + if i < (0.1 * ntau) + x = Q * (U \ (L \ (P * (E * x0)))); + xr = Ur \ (Lr \ (Pr * (Er * xr0))); else - salpha=smoother(alpha,i,ntau); - x=Q*(U\(L\(P*(E*x0+(salpha*tau)*sum(B,2))))); - xr=Ur\(Lr\(Pr*(Er*xr0+(salpha*tau)*sum(Br,2)))); + salpha = smoother(alpha, i, ntau); + x = Q * (U \ (L \ (P * (E * x0 + (salpha * tau) * sum(B, 2))))); + xr = Ur \ (Lr \ (Pr * (Er * xr0 + (salpha * tau) * sum(Br, 2)))); end - y(:,i)=C*x; - yr(:,i)=Cr*xr; - x0=x; - xr0=xr; - end - fprintf('\n\n'); + y(:, i) = C * x; + yr(:, i) = Cr * xr; + x0 = x; + xr0 = xr; +end +mess_fprintf(opts, '\n\n'); end - diff --git a/DEMOS/DAE2/private/impeuler_closed.m b/DEMOS/DAE2/private/impeuler_closed.m index c580c77..daea868 100644 --- a/DEMOS/DAE2/private/impeuler_closed.m +++ b/DEMOS/DAE2/private/impeuler_closed.m @@ -1,4 +1,4 @@ -function [y,yr] = impeuler_closed(E,A,B,C,Er,Ar,Br,Cr,K,Kr,tau,tmin,tmax,x0,xr0,alpha) +function [y, yr] = impeuler_closed(E, A, B, C, Er, Ar, Br, Cr, K, Kr, tau, tmin, tmax, x0, xr0, alpha) % Simple implicit Euler implementation for validation of the DAE2 % MESS closed loop example via a basic step response computation % @@ -18,43 +18,43 @@ % y,yr outputs of the full and reduced systems in [tmin,tmax] % - % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % +opts = struct; +[L, U, P, Q] = lu(E - tau * A); +[Lr, Ur, Pr] = lu(Er - tau * (Ar - Br * Kr)); - [L,U,P,Q] = lu(E-tau*A); - [Lr,Ur,Pr] = lu(Er-tau*(Ar-Br*Kr)); - - ntau=ceil((tmax-tmin)/tau); - y=zeros(size(C,1),ntau); - yr=y; - AinvtB=Q*(U\(L\(P*(tau*B)))); - tK=(eye(size(K,1))+K*AinvtB)\K; - for i=1:ntau - if not(mod(i,ceil(ntau/10))), fprintf('\r Implicit Euler step %d / %d',i,ntau); end - if i<(0.1*ntau) - Ex=E*x0; - AinvEx=Q*(U\(L\(P*Ex))); - x=AinvEx-AinvtB*(tK*AinvEx); - xr=Ur\(Lr\(Pr*(Er*xr0))); +ntau = ceil((tmax - tmin) / tau); +y = zeros(size(C, 1), ntau); +yr = y; +AinvtB = Q * (U \ (L \ (P * (tau * B)))); +tK = (eye(size(K, 1)) + K * AinvtB) \ K; +for i = 1:ntau + if not(mod(i, ceil(ntau / 10))) + mess_fprintf(opts, '\r Implicit Euler step %d / %d', i, ntau); + end + if i < (0.1 * ntau) + Ex = E * x0; + AinvEx = Q * (U \ (L \ (P * Ex))); + x = AinvEx - AinvtB * (tK * AinvEx); + xr = Ur \ (Lr \ (Pr * (Er * xr0))); else - salpha=smoother(alpha,i,ntau); - Ex=E*x0+(salpha*tau)*sum(B,2); - AinvEx=Q*(U\(L\(P*Ex))); - x=AinvEx-AinvtB*(tK*AinvEx); - xr=Ur\(Lr\(Pr*(Er*xr0+(salpha*tau)*sum(Br,2)))); + salpha = smoother(alpha, i, ntau); + Ex = E * x0 + (salpha * tau) * sum(B, 2); + AinvEx = Q * (U \ (L \ (P * Ex))); + x = AinvEx - AinvtB * (tK * AinvEx); + xr = Ur \ (Lr \ (Pr * (Er * xr0 + (salpha * tau) * sum(Br, 2)))); end - y(:,i)=C*x; - yr(:,i)=Cr*xr; - x0=x; - xr0=xr; - end - fprintf('\n\n'); + y(:, i) = C * x; + yr(:, i) = Cr * xr; + x0 = x; + xr0 = xr; +end +mess_fprintf(opts, '\n\n'); end - diff --git a/DEMOS/DAE2/private/open_step.m b/DEMOS/DAE2/private/open_step.m index 963ec07..50b554a 100644 --- a/DEMOS/DAE2/private/open_step.m +++ b/DEMOS/DAE2/private/open_step.m @@ -1,4 +1,4 @@ -function open_step(eqn,Ar,Br,Cr,problem,istest) +function open_step(eqn, Ar, Br, Cr, problem, istest) % Simple validation of the DAE2 MESS open loop example via a basic % step response computation % @@ -15,72 +15,75 @@ function open_step(eqn,Ar,Br,Cr,problem,istest) % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % -x0=zeros(size(eqn.A_,1),1); -xr0=zeros(size(Ar,1),1); +x0 = zeros(size(eqn.A_, 1), 1); +xr0 = zeros(size(Ar, 1), 1); -alpha=1; -tau=1e-2; -tmin=0; -tmax=50; -T=tmin:tau:tmax; -ntau=floor((tmax-tmin)/tau); -taurange=1:floor(ntau/500):ntau; +alpha = 1; +tau = 1e-2; +tmin = 0; +tmax = 50; +T = tmin:tau:tmax; +ntau = floor((tmax - tmin) / tau); +taurange = 1:floor(ntau / 500):ntau; +opts = struct; %% t_impeuler = tic; -[y,yr] = impeuler(eqn.E_,eqn.A_,eqn.B,eqn.C,eye(size(Ar)),Ar,Br,Cr,tau,... - tmin,tmax,x0,xr0,alpha); +[y, yr] = impeuler(eqn.E_, eqn.A_, eqn.B, eqn.C, eye(size(Ar)), Ar, Br, Cr, tau, ... + tmin, tmax, x0, xr0, alpha); t_elapsed = toc(t_impeuler); -fprintf(1,'implicit euler took %6.2f seconds \n' ,t_elapsed); +fprintf('implicit euler took %6.2f seconds \n', t_elapsed); %% -abserr=abs(y-yr); -relerr=abs(abserr./y); +abserr = abs(y - yr); +relerr = abs(abserr ./ y); %% if istest maerr = max(abserr); - if maerr>=1e-6 - error('MESS:TEST:accuracy',['unexpectedly inaccurate result ' ... - 'in open loop simulation. Maximum ' ... - 'absolute error %e > 1e-6'], maerr); + if maerr >= 1e-6 + mess_err(opts, 'TEST:accuracy', ['unexpectedly inaccurate result ' ... + 'in open loop simulation. Maximum ' ... + 'absolute error %e > 1e-6'], maerr); end else - colors=['y','m','c','r','g','b','k']; + colors = ['y', 'm', 'c', 'r', 'g', 'b', 'k']; figure(10); hold on; - for j=1:size(eqn.C,1) - plot(T(taurange),y(j,taurange),colors(j),'LineWidth',3); - plot(T(taurange),yr(j,taurange),strcat(colors(j),'--'),'LineWidth',3); + for j = 1:size(eqn.C, 1) + plot(T(taurange), y(j, taurange), colors(j), 'LineWidth', 3); + plot(T(taurange), yr(j, taurange), strcat(colors(j), '--'), 'LineWidth', 3); end xlabel('time'); ylabel('magnitude of outputs'); title('step response'); - legend('out1','out1 red','out2','out2 red','out3','out3 red',... - 'out4','out4 red','out5','out5 red','Location','EastOutside'); + legend('out1', 'out1 red', 'out2', 'out2 red', 'out3', 'out3 red', ... + 'out4', 'out4 red', 'out5', 'out5 red', 'Location', 'EastOutside'); hold off; figure(10); %% figure(11); - for j=1:size(eqn.C,1) - semilogy(T(taurange),abserr(j,taurange),colors(j),'LineWidth',3); - if 1==j, hold on; end + for j = 1:size(eqn.C, 1) + semilogy(T(taurange), abserr(j, taurange), colors(j), 'LineWidth', 3); + if 1 == j + hold on; + end end xlabel('time'); ylabel('magnitude'); title('absolute error'); - if strcmp(problem,'NSE') - legend('out1','out2','out3','out4','out5','out6','out7',... - 'Location','EastOutside'); + if strcmp(problem, 'NSE') + legend('out1', 'out2', 'out3', 'out4', 'out5', 'out6', 'out7', ... + 'Location', 'EastOutside'); else - legend('out1','out2','out3','out4','out5','Location','EastOutside'); + legend('out1', 'out2', 'out3', 'out4', 'out5', 'Location', 'EastOutside'); end hold off; @@ -88,18 +91,20 @@ function open_step(eqn,Ar,Br,Cr,problem,istest) figure(12); - for j=1:size(eqn.C,1) - semilogy(T(taurange),relerr(j,taurange),colors(j),'LineWidth',3); - if 1==j, hold on; end + for j = 1:size(eqn.C, 1) + semilogy(T(taurange), relerr(j, taurange), colors(j), 'LineWidth', 3); + if 1 == j + hold on; + end end xlabel('time'); ylabel('magnitude'); title('relative error'); - if strcmp(problem,'NSE') - legend('out1','out2','out3','out4','out5','out6','out7',... - 'Location','EastOutside'); + if strcmp(problem, 'NSE') + legend('out1', 'out2', 'out3', 'out4', 'out5', 'out6', 'out7', ... + 'Location', 'EastOutside'); else - legend('out1','out2','out3','out4','out5','Location','EastOutside'); + legend('out1', 'out2', 'out3', 'out4', 'out5', 'Location', 'EastOutside'); end hold off; end diff --git a/DEMOS/DAE2/private/smoother.m b/DEMOS/DAE2/private/smoother.m index f7399bc..e4b96c7 100644 --- a/DEMOS/DAE2/private/smoother.m +++ b/DEMOS/DAE2/private/smoother.m @@ -1,17 +1,16 @@ -function alpha = smoother(alpha,i,ntau) +function alpha = smoother(alpha, i, ntau) % Smoother for implicit euler % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % +if i < (0.2 * ntau) - if i < (0.2*ntau) - - alpha = sin( (10.0*pi * (i - 0.1*ntau) / ntau) - 0.5*pi) * alpha; - end + alpha = sin((10.0 * pi * (i - 0.1 * ntau) / ntau) - 0.5 * pi) * alpha; +end end diff --git a/DEMOS/DAE2_SO/LQR_DAE2_SO.m b/DEMOS/DAE2_SO/LQR_DAE2_SO.m index a3e4808..bae307c 100644 --- a/DEMOS/DAE2_SO/LQR_DAE2_SO.m +++ b/DEMOS/DAE2_SO/LQR_DAE2_SO.m @@ -6,25 +6,25 @@ function LQR_DAE2_SO(istest) % % Input: % istest decides whether the function runs as an interactive demo or a -% continuous integration test. (optional; defaults to 0, i.e. -% interactive demo) +% continuous integration test. +% (optional; defaults to 0, i.e. interactive demo) % % References -% [1] N. Truhar, K. Veselić, An efficient method for estimating the -% optimal dampers’ viscosity for linear vibrating systems using -% Lyapunov equation, SIAM J. Matrix Anal. Appl. 31 (1) (2009) 18–39. +% [1] N. Truhar, K. Veselić, An efficient method for estimating the +% optimal dampers viscosity for linear vibrating systems using +% Lyapunov equation, SIAM J. Matrix Anal. Appl. 31 (1) (2009) 18--39. % https://doi.org/10.1137/070683052 % % [2] P. Benner, J. Saak, Efficient Balancing based MOR for Second Order % Systems Arising in Control of Machine Tools, in: I. Troch, % F. Breitenecker (Eds.), Proceedings of the MathMod 2009, no. 35 in % ARGESIM-Reports, Vienna Univ. of Technology, ARGE Simulation News, -% Vienna, Austria, 2009, pp. 1232–1243, https://doi.org/10.11128/arep.35 +% Vienna, Austria, 2009, pp. 1232--1243, https://doi.org/10.11128/arep.35 % % [3] P. Benner, P. Kürschner, J. Saak, Improved second-order balanced % truncation for symmetric systems, IFAC Proceedings Volumes (7th % Vienna International Conference on Mathematical Modelling) 45 (2) -% (2012) 758–762. https://doi.org/10.3182/20120215-3-AT-3016.00134 +% (2012) 758--762. https://doi.org/10.3182/20120215-3-AT-3016.00134 % % [4] M. M. Uddin, Computational methods for model reduction of large-scale % sparse structured descriptor systems, Dissertation, @@ -34,47 +34,59 @@ function LQR_DAE2_SO(istest) % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% -if nargin<1, istest=0; end +if nargin < 1 + istest = false; +end %% set operation -oper = operatormanager('dae_2_so'); +opts = struct(); +[oper, opts] = operatormanager(opts, 'dae_2_so'); %% load problem data % generate problem -nv = 500; np=10; nin=2; nout=3; p=0.2; -alpha = 0.1; beta = 0.1; v = 5; - -[M, D, K]=triplechain_MSD(nv,alpha,beta,v); -nv=size(M,1); -G = zeros(nv,np); -while rank(full(G))~=np, G = sprand(np,nv,p);end -eqn.M_=M; -eqn.E_=-D; -eqn.K_=-K; -eqn.G_=G; -eqn.haveE=1; +nv = 500; +np = 10; +nin = 2; +nout = 3; +p = 0.2; +alpha = 0.1; +beta = 0.1; +v = 5; + +[M, D, K] = triplechain_MSD(nv, alpha, beta, v); + +nv = size(M, 1); +G = zeros(nv, np); +while not(rank(full(G)) == np) + G = sprand(np, nv, p); +end + +eqn.M_ = M; +eqn.E_ = -D; +eqn.K_ = -K; +eqn.G_ = G; +eqn.haveE = true; eqn.alpha = -0.02; -eqn.B = [zeros(nv, nin);rand(nv,nin)]; -eqn.C = [zeros(nout,nv),rand(nout,nv)]; +eqn.B = [zeros(nv, nin); rand(nv, nin)]; +eqn.C = [zeros(nout, nv), rand(nout, nv)]; eqn.type = 'N'; %% condition numbers of generated input data -fprintf('Condition numbers of the generated input data\n'); -As = full([zeros(nv,nv),eye(nv,nv),zeros(nv,np); ... - K, D, G';... - G,zeros(np,nv), zeros(np,np)]); +mess_fprintf(opts, 'Condition numbers of the generated input data\n'); +As = full([zeros(nv, nv), eye(nv, nv), zeros(nv, np); ... + K, D, G'; ... + G, zeros(np, nv), zeros(np, np)]); -fprintf('cond(M)=%e\n',condest(eqn.M_)); -fprintf('cond(D)=%e\n',condest(eqn.E_)); -fprintf('cond(K)=%e\n',condest(eqn.K_)); -fprintf('cond(A)=%e\n\n',condest(As)); +mess_fprintf(opts, 'cond(M)=%e\n', condest(eqn.M_)); +mess_fprintf(opts, 'cond(D)=%e\n', condest(eqn.E_)); +mess_fprintf(opts, 'cond(K)=%e\n', condest(eqn.K_)); +mess_fprintf(opts, 'cond(A)=%e\n\n', condest(As)); %% options opts.norm = 'fro'; @@ -84,23 +96,25 @@ function LQR_DAE2_SO(istest) opts.adi.res_tol = 1e-15; opts.adi.rel_diff_tol = 1e-16; opts.adi.info = 0; -opts.shifts.num_desired=25; -opts.shifts.num_Ritz=50; -opts.shifts.num_hRitz=25; -opts.shifts.b0=ones(2*nv+np,1); +opts.shifts.num_desired = 25; +opts.shifts.num_Ritz = 50; +opts.shifts.num_hRitz = 25; +opts.shifts.b0 = ones(2 * nv + np, 1); opts.shifts.method = 'projection'; -opts.shifts.num_desired=6; +opts.shifts.num_desired = 6; % Newton options and maximum iteration number opts.nm.maxiter = 20; opts.nm.res_tol = 1e-10; opts.nm.rel_diff_tol = 1e-16; opts.nm.info = 1; -opts.nm.accumulateRes = 0; -opts.nm.linesearch = 1; -opts.nm.projection.freq=0; -opts.nm.projection.ortho=1; -opts.nm.res=struct('maxiter',10,'tol',1e-6,'orth',0); +opts.nm.accumulateRes = false; +opts.nm.linesearch = true; +opts.nm.projection.freq = 0; +opts.nm.projection.ortho = true; +opts.nm.res = struct('maxiter', 10, ... + 'tol', 1e-6, ... + 'orth', 0); %% % the actual Newton call @@ -108,71 +122,72 @@ function LQR_DAE2_SO(istest) t_mess_lrnm = tic; outnm = mess_lrnm(eqn, opts, oper); t_elapsed1 = toc(t_mess_lrnm); -fprintf(1,'mess_lrnm took %6.2f seconds ',t_elapsed1); +mess_fprintf(opts, 'mess_lrnm took %6.2f seconds \n', t_elapsed1); if istest - if min(outnm.res)>=opts.nm.res_tol - error('MESS:TEST:accuracy','unexpectedly inaccurate result'); + if min(outnm.res) >= opts.nm.res_tol + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result'); end else - figure(1); - semilogy(outnm.res,'LineWidth',3); + figure(); + semilogy(outnm.res, 'LineWidth', 3); title('0 = C^TC + A^T X E + E^T X A -E^T X BB^T X M'); xlabel('number of iterations'); ylabel('normalized residual norm'); pause(1); end - -disp('outnm.Z:'); -disp(size(outnm.Z)); +[mZ, nZ] = size(outnm.Z); +mess_fprintf(opts, 'outnm.Z: %d x%d\n', mZ, nZ); %% Lets try the RADI method and compare -opts.norm = 2; +opts.norm = 2; % RADI-MESS settings -opts.shifts.history = opts.shifts.num_desired*size(eqn.C,1); +opts.shifts.history = opts.shifts.num_desired * size(eqn.C, 1); opts.shifts.num_desired = 5; % choose either of the three shift methods, here -%opts.shifts.method = 'gen-ham-opti'; -%opts.shifts.method = 'heur'; +% opts.shifts.method = 'gen-ham-opti'; +% opts.shifts.method = 'heur'; opts.shifts.method = 'projection'; opts.shifts.naive_update_mode = false; % .. Suggest false (smart update is faster; convergence is the same). -opts.radi.compute_sol_fac = 1; -opts.radi.maxiter = opts.nm.maxiter * opts.adi.maxiter; -opts.radi.get_ZZt = 1; -opts.radi.res_tol = opts.nm.res_tol; -opts.radi.rel_diff_tol = 0; -opts.radi.info = 1; +opts.radi.compute_sol_fac = true; +opts.radi.maxiter = opts.nm.maxiter * opts.adi.maxiter; +opts.radi.get_ZZt = true; +opts.radi.res_tol = opts.nm.res_tol; +opts.radi.rel_diff_tol = 0; +opts.radi.info = 1; t_mess_lrradi = tic; outradi = mess_lrradi(eqn, opts, oper); t_elapsed2 = toc(t_mess_lrradi); -fprintf(1,'mess_lrradi took %6.2f seconds ' ,t_elapsed2); +mess_fprintf(opts, 'mess_lrradi took %6.2f seconds \n', t_elapsed2); if istest - if min(outradi.res)>=opts.radi.res_tol - error('MESS:TEST:accuracy','unexpectedly inaccurate result'); + if min(outradi.res) >= opts.radi.res_tol + mess_err(opts, 'TEST:accuracy', ... + 'unexpectedly inaccurate result'); end else - figure(2); - semilogy(outradi.res,'LineWidth',3); + figure(); + semilogy(outradi.res, 'LineWidth', 3); title('0 = C^T C + A^T X E + E^T X A -E^T X BB^T X E'); xlabel('number of iterations'); ylabel('normalized residual norm'); end - -disp('outradi.Z:'); -disp(size(outradi.Z)); +[mZ, nZ] = size(outradi.Z); +mess_fprintf(opts, 'outradi.Z: %d x %d\n', mZ, nZ); %% compare if not(istest) - figure(3); - ls_nm=cumsum([outnm.adi.niter]); - ls_radi=1:outradi.niter; + figure(); + ls_nm = cumsum([outnm.adi.niter]); + ls_radi = 1:outradi.niter; - semilogy(ls_nm,outnm.res,'k--',ls_radi,outradi.res,'b-','LineWidth',3); + semilogy(ls_nm, outnm.res, 'k--', ... + ls_radi, outradi.res, 'b-', ... + 'LineWidth', 3); title('0 = C^T C + A^T X E + E^T X A -E^T X BB^T X E'); xlabel('number of solves with A + p * E'); ylabel('normalized residual norm'); - legend('LR-NM','RADI'); + legend('LR-NM', 'RADI'); end diff --git a/DEMOS/DAE3_SO/BT_DAE3_SO.m b/DEMOS/DAE3_SO/BT_DAE3_SO.m index 79caaa0..ea76df4 100644 --- a/DEMOS/DAE3_SO/BT_DAE3_SO.m +++ b/DEMOS/DAE3_SO/BT_DAE3_SO.m @@ -54,17 +54,16 @@ function BT_DAE3_SO(model, tol, max_ord, maxiter, istest) % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% Input checks -narginchk(0,5); +narginchk(0, 5); if nargin < 1 - model='Stykel_small'; + model = 'Stykel_small'; end if nargin < 2 @@ -80,104 +79,122 @@ function BT_DAE3_SO(model, tol, max_ord, maxiter, istest) end if nargin < 5 - istest = 0; + istest = false; end %% set operation manager for the structured computations of Gramians -oper = operatormanager('dae_3_so'); - +opts = struct(); +[oper, opts] = operatormanager(opts, 'dae_3_so'); %% load problem data switch lower(model) - case {'stykel_small','stykel_large'} - if strcmp(model,'stykel_small') - sys = load(sprintf('%s/../models/ms_ind3_by_t_stykel/g600.mat',... - fileparts(mfilename('fullpath')))); + case {'stykel_small', 'stykel_large'} + if strcmp(model, 'stykel_small') + sys = load(sprintf('%s/../models/ms_ind3_by_t_stykel/g600.mat', ... + fileparts(mfilename('fullpath')))); else - sys = load(sprintf('%s/../models/ms_ind3_by_t_stykel/g6000.mat',... - fileparts(mfilename('fullpath')))); + sys = load(sprintf('%s/../models/ms_ind3_by_t_stykel/g6000.mat', ... + fileparts(mfilename('fullpath')))); end - eqn.M_=sys.M; - eqn.E_=sys.D; - eqn.K_=sys.K; - eqn.G_=sys.G; - eqn.haveE=1; + eqn.M_ = sys.M; + eqn.E_ = sys.D; + eqn.K_ = sys.K; + eqn.G_ = sys.G; + eqn.haveE = true; eqn.alpha = -0.02; - nv = size(eqn.M_,1); - np = size(eqn.G_,1); - eqn.B = full(sys.B(1:2*nv,:)); - eqn.C = full(sys.C(:,1:2*nv)); + nv = size(eqn.M_, 1); + np = size(eqn.G_, 1); + eqn.B = full(sys.B(1:2 * nv, :)); + eqn.C = full(sys.C(:, 1:2 * nv)); clear E A B C M D K G; case 'tv2' - n1=151; % make sure it is odd! - alpha=0.01; - v=5e0; + n1 = 151; % make sure it is odd! + alpha = 0.01; + v = 5e0; - [eqn.M_,eqn.E_,eqn.K_]=triplechain_MSD(n1,alpha,alpha,v); + [eqn.M_, eqn.E_, eqn.K_] = triplechain_MSD(n1, alpha, alpha, v); eqn.E_ = -eqn.E_; eqn.K_ = -eqn.K_; - eqn.G_ = sparse(3,3*n1+1); - n12=ceil(n1/2); % n1 is odd so this is the index of - % the center of the string - eqn.G_(1,1)=-1; eqn.G_(1,n12)=2; eqn.G_(1,n1)=-1; - eqn.G_(2,n1+1)=-1; eqn.G_(2,n1+n12)=2; eqn.G_(2,2*n1)=-1; - eqn.G_(3,2*n1+1)=-1; eqn.G_(3,2*n1+n12)=2; eqn.G_(3,3*n1)=-1; + eqn.G_ = sparse(3, 3 * n1 + 1); + n12 = ceil(n1 / 2); % n1 is odd so this is the index of + % the center of the string + eqn.G_(1, 1) = -1; + eqn.G_(1, n12) = 2; + eqn.G_(1, n1) = -1; + eqn.G_(2, n1 + 1) = -1; + eqn.G_(2, n1 + n12) = 2; + eqn.G_(2, 2 * n1) = -1; + eqn.G_(3, 2 * n1 + 1) = -1; + eqn.G_(3, 2 * n1 + n12) = 2; + eqn.G_(3, 3 * n1) = -1; - nv = size(eqn.M_,1); - np = size(eqn.G_,1); - eqn.B=zeros(6*n1+2,3); - eqn.B(3*n1+6,1)=1; - eqn.B(5*n1+n12+6,2)=1; - eqn.B(end-6,3)=1; - eqn.C=zeros(3,6*n1+2); - eqn.C(1,3*n1+1)=1; - eqn.C(2,2*n1)=1; - eqn.C(3,2*n1+floor(n12/2))=1; - eqn.haveE=1; + nv = size(eqn.M_, 1); + np = size(eqn.G_, 1); + eqn.B = zeros(6 * n1 + 2, 3); + eqn.B(3 * n1 + 6, 1) = 1; + eqn.B(5 * n1 + n12 + 6, 2) = 1; + eqn.B(end - 6, 3) = 1; + eqn.C = zeros(3, 6 * n1 + 2); + eqn.C(1, 3 * n1 + 1) = 1; + eqn.C(2, 2 * n1) = 1; + eqn.C(3, 2 * n1 + floor(n12 / 2)) = 1; + eqn.haveE = true; eqn.alpha = -0.02; case 'tv' - n1=151; % make sure it is odd! - alpha=0.01; - v=5e0; + n1 = 151; % make sure it is odd! + alpha = 0.01; + v = 5e0; - [eqn.M_,eqn.E_,eqn.K_]=triplechain_MSD(n1,alpha,alpha,v); + [eqn.M_, eqn.E_, eqn.K_] = triplechain_MSD(n1, alpha, alpha, v); eqn.E_ = -eqn.E_; eqn.K_ = -eqn.K_; - eqn.G_ = sparse(3,3*n1+1); - n12=ceil(n1/2); % n1 is odd so this is the index of - % the center of the string - eqn.G_(1,1)=1/3; eqn.G_(1,n12)=1/3; eqn.G_(1,n1)=1/3; - eqn.G_(2,n1+1)=1/3; eqn.G_(2,n1+n12)=1/3; eqn.G_(2,2*n1)=1/3; - eqn.G_(3,2*n1+1)=1/3; eqn.G_(3,2*n1+n12)=1/3; eqn.G_(3,3*n1)=1/3; + eqn.G_ = sparse(3, 3 * n1 + 1); + n12 = ceil(n1 / 2); % n1 is odd so this is the index of + % the center of the string + eqn.G_(1, 1) = 1 / 3; + eqn.G_(1, n12) = 1 / 3; + eqn.G_(1, n1) = 1 / 3; + eqn.G_(2, n1 + 1) = 1 / 3; + eqn.G_(2, n1 + n12) = 1 / 3; + eqn.G_(2, 2 * n1) = 1 / 3; + eqn.G_(3, 2 * n1 + 1) = 1 / 3; + eqn.G_(3, 2 * n1 + n12) = 1 / 3; + eqn.G_(3, 3 * n1) = 1 / 3; - nv = size(eqn.M_,1); - np = size(eqn.G_,1); - eqn.B=[zeros(3*n1+1,1);ones(3*n1+1,1)]; - eqn.C=[ones(3*n1+1,1);zeros(3*n1+1,1)]'; - eqn.haveE=1; + nv = size(eqn.M_, 1); + np = size(eqn.G_, 1); + eqn.B = [zeros(3 * n1 + 1, 1); ones(3 * n1 + 1, 1)]; + eqn.C = [ones(3 * n1 + 1, 1); zeros(3 * n1 + 1, 1)]'; + eqn.haveE = true; eqn.alpha = -0.02; - case 'truhar_veselic' - n1=1500; % make sure it is even! - alpha=0.01; - v=5e0; + case 'truhar_veselic' + n1 = 1500; % make sure it is even! + alpha = 0.01; + v = 5e0; - [eqn.M_,eqn.E_,eqn.K_]=triplechain_MSD(n1,alpha,alpha,v); + [eqn.M_, eqn.E_, eqn.K_] = triplechain_MSD(n1, alpha, alpha, v); eqn.E_ = -eqn.E_; eqn.K_ = -eqn.K_; - eqn.G_ = sparse(6,3*n1+1); - eqn.G_(1,1)=1; eqn.G_(1,n1/2)=-1; - eqn.G_(2,n1/2+1)=1;eqn.G_(2,n1)=-1; - eqn.G_(3,n1+1)=1;eqn.G_(3,n1+n1/2)=-1; - eqn.G_(4,n1+n1/2+1)=1;eqn.G_(4,2*n1)=-1; - eqn.G_(5,2*n1+1)=1;eqn.G_(5,2*n1+n1/2)=-1; - eqn.G_(6,2*n1+n1/2+1)=1;eqn.G_(6,3*n1)=-1; - nv = size(eqn.M_,1); - np = size(eqn.G_,1); - eqn.B=[zeros(3*n1+1,1);ones(3*n1+1,1)]; - eqn.C=[ones(3*n1+1,1);zeros(3*n1+1,1)]'; - eqn.haveE=1; + eqn.G_ = sparse(6, 3 * n1 + 1); + eqn.G_(1, 1) = 1; + eqn.G_(1, n1 / 2) = -1; + eqn.G_(2, n1 / 2 + 1) = 1; + eqn.G_(2, n1) = -1; + eqn.G_(3, n1 + 1) = 1; + eqn.G_(3, n1 + n1 / 2) = -1; + eqn.G_(4, n1 + n1 / 2 + 1) = 1; + eqn.G_(4, 2 * n1) = -1; + eqn.G_(5, 2 * n1 + 1) = 1; + eqn.G_(5, 2 * n1 + n1 / 2) = -1; + eqn.G_(6, 2 * n1 + n1 / 2 + 1) = 1; + eqn.G_(6, 3 * n1) = -1; + nv = size(eqn.M_, 1); + np = size(eqn.G_, 1); + eqn.B = [zeros(3 * n1 + 1, 1); ones(3 * n1 + 1, 1)]; + eqn.C = [ones(3 * n1 + 1, 1); zeros(3 * n1 + 1, 1)]'; + eqn.haveE = true; eqn.alpha = -0.02; otherwise - fprintf('unknown model requested!\n'); + mess_err(opts, 'unknown model requested!\n'); return end %% options @@ -186,18 +203,18 @@ function BT_DAE3_SO(model, tol, max_ord, maxiter, istest) opts.adi.res_tol = 1e-10; opts.adi.rel_diff_tol = 1e-11; opts.norm = 'fro'; -opts.shifts.method='projection'; -opts.shifts.num_desired=25; +opts.shifts.method = 'projection'; +opts.shifts.num_desired = 25; %% LRADI for the two Gramian factors % controllability Gramian eqn.type = 'T'; opts.adi.info = 1; -t_mess_lradi1 =tic; -[p, ~, eqn, opts, oper] = mess_para(eqn, opts, oper); +t_mess_lradi1 = tic; +[p, ~, eqn, opts, oper] = mess_para(eqn, opts, oper); % use an additional alpha-shift to improve convergence and ROM quality for % the triple chain model -if strcmp(model,'Truhar_Veselic')||strcmp(model,'TV')||strcmp(model,'TV2') +if strcmp(model, 'Truhar_Veselic') || strcmp(model, 'TV') || strcmp(model, 'TV2') opts.shifts.p = p - 0.5; else opts.shifts.p = p; @@ -206,20 +223,20 @@ function BT_DAE3_SO(model, tol, max_ord, maxiter, istest) outC = mess_lradi(eqn, opts, oper); t_elapsed1 = toc(t_mess_lradi1); -fprintf(1,'mess_lradi took %6.2f seconds \n', t_elapsed1); +mess_fprintf(opts, 'mess_lradi took %6.2f seconds \n\n', t_elapsed1); % observability Gramian eqn.type = 'N'; t_mess_lradi2 = tic; outB = mess_lradi(eqn, opts, oper); t_elapsed2 = toc(t_mess_lradi2); -fprintf(1,'mess_lradi took %6.2f seconds \n' , t_elapsed2); +mess_fprintf(opts, 'mess_lradi took %6.2f seconds \n', t_elapsed2); %% Reduced Order Model computation via square root method (SRM) fprintf('\nComputing reduced order model via square root method\n\n'); -opts.srm.tol=tol; -opts.srm.max_ord=max_ord; -opts.srm.info=1; +opts.srm.tol = tol; +opts.srm.max_ord = max_ord; +opts.srm.info = 1; t_SRM_ROM = tic; [TL, TR] = mess_square_root_method(eqn, opts, oper, outB.Z, outC.Z); @@ -229,51 +246,55 @@ function BT_DAE3_SO(model, tol, max_ord, maxiter, istest) ROM.C = eqn.C * TR; ROM.E = eye(size(ROM.A)); t_elapsed3 = toc(t_SRM_ROM); -fprintf(1,'ROM matrices computation took %6.2f seconds \n' , t_elapsed3); +mess_fprintf(opts, 'ROM matrices computation took %6.2f seconds \n\n', ... + t_elapsed3); %% Frequency-domain evaluation of the (transfer function of the) % ROM and comparison to the original model. % -% We feed the mess_sigma_plot with usfs that do not exploit the DAE structure: +% We feed the mess_tf_plot with usfs that do not exploit the DAE structure: t_FD_eval = tic; -opts.sigma.nsample = 200; +opts.tf_plot.nsample = 200; if istest - opts.sigma.info = 0; + opts.tf_plot.info = 0; else - opts.sigma.info = 2; + opts.tf_plot.info = 2; end -if strcmp(model,'TV2') - opts.sigma.fmin=-2; - opts.sigma.fmax=1; +if strcmp(model, 'TV2') + opts.tf_plot.fmin = -2; + opts.tf_plot.fmax = 1; else - opts.sigma.fmin=-4; - opts.sigma.fmax=4; + opts.tf_plot.fmin = -4; + opts.tf_plot.fmax = 4; end -NG = sparse(np,nv); -NS = sparse(np,np); +opts.tf_plot.type = 'sigma'; + +NG = sparse(np, nv); +NS = sparse(np, np); eqnu.M_ = [eqn.M_ NG'; NG NS]; eqnu.E_ = [-eqn.E_ NG'; NG NS]; -eqnu.K_ = [-eqn.K_ -eqn.G_';-eqn.G_ NS]; -eqnu.C = [zeros(size(eqn.C,1),np+nv), eqn.C(:,1:nv), zeros(size(eqn.C,1),np)]; -eqnu.B = [eqn.B(nv+1:2*nv,:);zeros(2*np+nv,size(eqn.B,2))]; -eqnu.haveE = 1; +eqnu.K_ = [-eqn.K_ -eqn.G_'; -eqn.G_ NS]; +eqnu.C = [zeros(size(eqn.C, 1), np + nv), eqn.C(:, 1:nv), zeros(size(eqn.C, 1), np)]; +eqnu.B = [eqn.B(nv + 1:2 * nv, :); zeros(2 * np + nv, size(eqn.B, 2))]; +eqnu.haveE = true; -operu = operatormanager('so_1'); +[operu, opts] = operatormanager(opts, 'so_1'); -out = mess_sigma_plot(eqnu, opts, operu, ROM); err = out.err; +out = mess_tf_plot(eqnu, opts, operu, ROM); +err = out.err; t_elapsed4 = toc(t_FD_eval); -fprintf(1,'frequency-domain evaluation took %6.2f \n' , t_elapsed4); +mess_fprintf(opts, 'frequency-domain evaluation took %6.2f \n\n', t_elapsed4); %% final accuracy test used in the continuous integration system or % plot of the computed if istest % the errors are not always perfect in this example, but let's see - % wether they are "good enough"... - if (max(err) > (50*tol)) - error('MESS:TEST:accuracy', ['unexpectedly inaccurate result ' ... - 'for %s %g %d %d (%g)'], model, tol, ... - max_ord, maxiter,max(err)); + % whether they are "good enough"... + if max(err) > (50 * tol) + mess_err(opts, 'TEST:accuracy', ... + 'unexpectedly inaccurate result for %s %g %d %d (%g)', ... + model, tol, max_ord, maxiter, max(err)); end end diff --git a/DEMOS/DAE3_SO/LQR_DAE3_SO.m b/DEMOS/DAE3_SO/LQR_DAE3_SO.m index 6eeef35..8ba8cff 100644 --- a/DEMOS/DAE3_SO/LQR_DAE3_SO.m +++ b/DEMOS/DAE3_SO/LQR_DAE3_SO.m @@ -1,4 +1,4 @@ -function LQR_DAE3_SO(model,istest) +function LQR_DAE3_SO(model, istest) % Computes a Riccati feedback control for the constrained vibrating model % from [1] % @@ -27,45 +27,46 @@ function LQR_DAE3_SO(model,istest) % Berlin/Heidelberg, 2005. https://doi.org/10.1007/3-540-27909-1_3 % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % %% -narginchk(0,2); +narginchk(0, 2); -if (nargin < 1) +if nargin < 1 model = 'Stykel_small'; end -if ( nargin < 2 ) - istest = 0; +if nargin < 2 + istest = false; end %% set operation -oper = operatormanager('dae_3_so'); +opts = struct(); +[oper, opts] = operatormanager(opts, 'dae_3_so'); %% load problem data switch lower(model) case 'stykel_small' - sys = load(sprintf('%s/../models/ms_ind3_by_t_stykel/g600.mat',... - fileparts(mfilename('fullpath')))); + sys = load(sprintf('%s/../models/ms_ind3_by_t_stykel/g600.mat', ... + fileparts(mfilename('fullpath')))); case 'stykel_large' - sys = load(sprintf('%s/../models/ms_ind3_by_t_stykel/g6000.mat',... - fileparts(mfilename('fullpath')))); + sys = load(sprintf('%s/../models/ms_ind3_by_t_stykel/g6000.mat', ... + fileparts(mfilename('fullpath')))); end -eqn.M_=sys.M; -eqn.E_=sys.D; -eqn.K_=sys.K; -eqn.G_=sys.G; -eqn.haveE=1; +eqn.M_ = sys.M; +eqn.E_ = sys.D; +eqn.K_ = sys.K; +eqn.G_ = sys.G; +eqn.haveE = true; eqn.alpha = -0.02; -nv = size(eqn.M_,1); -np = size(eqn.G_,1); -eqn.B = sys.B(1:2*nv,:); -eqn.C = sys.C(:,1:2*nv); +nv = size(eqn.M_, 1); +np = size(eqn.G_, 1); +eqn.B = sys.B(1:2 * nv, :); +eqn.C = sys.C(:, 1:2 * nv); eqn.type = 'T'; %% @@ -77,21 +78,21 @@ function LQR_DAE3_SO(model,istest) opts.adi.res_tol = 1e-15; opts.adi.rel_diff_tol = 1e-16; opts.adi.info = 0; -opts.shifts.num_desired=25; -opts.shifts.num_Ritz=50; -opts.shifts.num_hRitz=25; -opts.shifts.b0=ones(2*nv+np,1); +opts.shifts.num_desired = 25; +opts.shifts.num_Ritz = 50; +opts.shifts.num_hRitz = 25; +opts.shifts.b0 = ones(2 * nv + np, 1); % Newton options and maximum iteration number opts.nm.maxiter = 20; opts.nm.res_tol = 1e-10; opts.nm.rel_diff_tol = 1e-16; opts.nm.info = 1; -opts.nm.accumulateRes = 0; -opts.nm.linesearch = 1; -opts.nm.projection.freq=0; -opts.nm.projection.ortho=1; -opts.nm.res=struct('maxiter',10,'tol',1e-6,'orth',0); +opts.nm.accumulateRes = false; +opts.nm.linesearch = true; +opts.nm.projection.freq = 0; +opts.nm.projection.ortho = true; +opts.nm.res = struct('maxiter', 10, 'tol', 1e-6, 'orth', 0); %% The actual Newton call eqn.type = 'T'; @@ -99,41 +100,44 @@ function LQR_DAE3_SO(model,istest) t_mess_lrnm = tic; outnm = mess_lrnm(eqn, opts, oper); t_elapsed1 = toc(t_mess_lrnm); -fprintf(1,'mess_lrnm took %6.2f seconds \n',t_elapsed1); +mess_fprintf(opts, 'mess_lrnm took %6.2f seconds \n', t_elapsed1); if istest - if min(outnm.res)>=opts.nm.res_tol - error('MESS:TEST:accuracy','unexpectedly inaccurate result'); + if min(outnm.res) >= opts.nm.res_tol + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result'); end else figure(1); - semilogy(outnm.res,'LineWidth',3); + semilogy(outnm.res, 'LineWidth', 3); title('0= C^T C + A^T X E + E^T X A -E^T X BB^T X E'); xlabel('number of iterations'); ylabel('normalized residual norm'); pause(1); end -fprintf('2-Norm of the resulting feedback matrix: %g\n', norm(outnm.Z,2)); +mess_fprintf(opts, '2-Norm of the resulting feedback matrix: %g\n', ... + norm(outnm.Z, 2)); -disp('size outnm.Z:'); -disp(size(outnm.Z)); +mess_fprintf(opts, 'size outnm.Z: %d x %d\n\n', ... + size(outnm.Z, 1), size(outnm.Z, 2)); %% Lets try the RADI method and compare % RADI-MESS settings -opts.shifts.history = opts.shifts.num_desired*size(eqn.C,1); -opts.shifts.num_desired=25; -opts.shifts.num_Ritz=50; -opts.shifts.num_hRitz=25; -opts.shifts.b0=ones(2*nv+np,1); +opts.shifts.history = opts.shifts.num_desired * size(eqn.C, 1); +opts.shifts.num_desired = 25; +opts.shifts.num_Ritz = 50; +opts.shifts.num_hRitz = 25; +opts.shifts.b0 = ones(2 * nv + np, 1); % choose either of the three shift methods, here -%opts.shifts.method = 'gen-ham-opti'; +% opts.shifts.method = 'gen-ham-opti'; opts.shifts.method = 'heur'; -%opts.shifts.method = 'projection'; +% opts.shifts.method = 'projection'; -opts.shifts.naive_update_mode = false; % .. Suggest false (smart update is faster; convergence is the same). -opts.radi.compute_sol_fac = 1; -opts.radi.get_ZZt = 1; +opts.shifts.naive_update_mode = false; % .. Suggest false +% (smart update is faster; +% convergence is the same). +opts.radi.compute_sol_fac = true; +opts.radi.get_ZZt = true; opts.radi.maxiter = opts.adi.maxiter; opts.norm = 2; opts.radi.res_tol = opts.nm.res_tol; @@ -143,32 +147,34 @@ function LQR_DAE3_SO(model,istest) t_mess_lrradi = tic; outradi = mess_lrradi(eqn, opts, oper); t_elapsed2 = toc(t_mess_lrradi); -fprintf(1,'mess_lrradi took %6.2f seconds \n' , t_elapsed2); +mess_fprintf(opts, 'mess_lrradi took %6.2f seconds \n', t_elapsed2); if istest - if min(outradi.res)>=opts.radi.res_tol - error('MESS:TEST:accuracy','unexpectedly inaccurate result'); + if min(outradi.res) >= opts.radi.res_tol + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result'); end else figure(2); - semilogy(outradi.res,'LineWidth',3); + semilogy(outradi.res, 'LineWidth', 3); title('0= C^T C + A^T X E + E^T X A -E^T X BB^T X E'); xlabel('number of iterations'); ylabel('normalized residual norm'); end -disp('size outradi.Z:'); -disp(size(outradi.Z)); +mess_fprintf(opts, 'size outradi.Z: %d x %d\n', ... + size(outradi.Z, 1), size(outradi.Z, 2)); %% compare if not(istest) figure(3); - ls_nm=cumsum([outnm.adi.niter]); - ls_radi=1:outradi.niter; + ls_nm = cumsum([outnm.adi.niter]); + ls_radi = 1:outradi.niter; - semilogy(ls_nm,outnm.res,'k--',ls_radi,outradi.res,'b-','LineWidth',3); + semilogy(ls_nm, outnm.res, 'k--', ... + ls_radi, outradi.res, 'b-', ... + 'LineWidth', 3); title('0= C^TC + A^T X E + E^T X A - E^T X BB^T X E'); xlabel('number of solves with A+p*M'); ylabel('normalized residual norm'); - legend('LR-NM','RADI'); + legend('LR-NM', 'RADI'); end diff --git a/DEMOS/DAE3_SO/runme_BT_DAE3_SO.m b/DEMOS/DAE3_SO/runme_BT_DAE3_SO.m index 705c0f8..f541a21 100644 --- a/DEMOS/DAE3_SO/runme_BT_DAE3_SO.m +++ b/DEMOS/DAE3_SO/runme_BT_DAE3_SO.m @@ -9,21 +9,21 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % -model={{'Stykel_large', 1e-4, 200, 500}, ... - {'Truhar_Veselic', 1e-4, 250, 300}, ... - {'TV2', 1e-3, 300, 300},... - {'TV2', 1e-3, 300, 500}... - }; +model = {{'Stykel_large', 1e-4, 200, 500}, ... + {'Truhar_Veselic', 1e-4, 250, 300}, ... + {'TV2', 1e-3, 300, 300}, ... + {'TV2', 1e-3, 300, 500} ... + }; l = length(model); -for i=1:l - BT_DAE3_SO(model{i}{1},model{i}{2},model{i}{3},model{i}{4}) - if (i opts.KSM.res_tol || nrm > opts.KSM.res_tol + mess_err(opts, 'failure', 'test failed'); + end +end diff --git a/DEMOS/FDM/LQGBT_mor_FDM.m b/DEMOS/FDM/LQGBT_mor_FDM.m index 07e129c..9e746ee 100644 --- a/DEMOS/FDM/LQGBT_mor_FDM.m +++ b/DEMOS/FDM/LQGBT_mor_FDM.m @@ -1,4 +1,4 @@ -function [Ar, Br, Cr] = LQGBT_mor_FDM(tol,max_ord,n0,istest) +function [Ar, Br, Cr] = LQGBT_mor_FDM(tol, max_ord, n0, istest) % LQGBT_MOR_FDM computes a reduced order model via the linear quadratic % Gaussian balanced truncation [1] for a finite difference discretized % convection diffusion model on the unit square described in [2]. @@ -35,41 +35,42 @@ % % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % %% -narginchk(0,4); +narginchk(0, 4); %% % LQGBT Tolerance and maximum order of the ROM. -if nargin<1 +if nargin < 1 tol = 1e-6; end -if nargin<2 +if nargin < 2 max_ord = 250; end -if nargin<3 +if nargin < 3 n0 = 60; % n0 = number of grid points in either space direction; - % n = n0^2 is the problem dimension! - % (Change n0 to generate problems of different size.) + % n = n0^2 is the problem dimension! + % (Change n0 to generate problems of different size.) end -if nargin<4 - istest=0; +if nargin < 4 + istest = false; end % Problem data -eqn.A_ = fdm_2d_matrix(n0,'10*x','100*y','0'); -eqn.B = fdm_2d_vector(n0,'.1=opts.nm.res_tol - error('MESS:TEST:accuracy','unexpectedly inaccurate result'); + if min(outC.res) >= opts.nm.res_tol + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result'); end else figure(1); - semilogy(outC.res,'LineWidth',3); + semilogy(outC.res, 'LineWidth', 3); title('A X + X A^T - X C^T C X + BB^T = 0'); xlabel('number of iterations'); ylabel('normalized residual norm'); pause(1); end - %% % Solve the regulator Riccati equation. % A'*X + X*A - X*B*B'*X + C'*C = 0 @@ -132,55 +132,56 @@ eqn.type = 'T'; outB = mess_lrnm(eqn, opts, oper); t_elapsed2 = toc(t_mess_lrnm); -fprintf(1,'mess_lrnm took %6.2f seconds \n' ,t_elapsed2); +mess_fprintf(opts, 'mess_lrnm took %6.2f seconds \n', t_elapsed2); if istest - if min(outB.res)>=opts.nm.res_tol - error('MESS:TEST:accuracy','unexpectedly inaccurate result'); + if min(outB.res) >= opts.nm.res_tol + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result'); end else figure(2); - semilogy(outB.res,'LineWidth',3); + semilogy(outB.res, 'LineWidth', 3); title('A^T X + X A - X BB^T X + C^T C = 0'); xlabel('number of iterations'); ylabel('normalized residual norm'); pause(1); end - %% % % Model reduction by square root method. -opts.srm.tol=tol; +opts.srm.tol = tol; opts.srm.max_ord = max_ord; -opts.srm.info=1; -[TL, TR, ~, eqn, opts, ~] = mess_square_root_method(eqn,opts,oper,... - outB.Z,outC.Z); +opts.srm.info = 1; +[TL, TR, ~, eqn, opts, ~] = mess_square_root_method(eqn, opts, oper, ... + outB.Z, outC.Z); -Ar = TR'*(eqn.A_*TL); -Br = TR'*eqn.B; -Cr = eqn.C*TL; +Ar = TR' * (eqn.A_ * TL); +Br = TR' * eqn.B; +Cr = eqn.C * TL; -opts.sigma.nsample = 200; % 200 frequency samples -opts.sigma.fmin = -2; % min. frequency 1e-3 -opts.sigma.fmax = 6; % max. frequency 1e4 +opts.tf_plot.nsample = 200; % 200 frequency samples +opts.tf_plot.fmin = -2; % min. frequency 1e-3 +opts.tf_plot.fmax = 6; % max. frequency 1e4 if istest - opts.sigma.info=1; % no output + opts.tf_plot.info = 1; % no output else - opts.sigma.info = 2; % show messages and plots + opts.tf_plot.info = 2; % show messages and plots end +opts.tf_plot.type = 'sigma'; + ROM.A = Ar; ROM.B = Br; ROM.C = Cr; -ROM.E = eye(size(ROM.A,1)); +ROM.E = eye(size(ROM.A, 1)); -out = mess_sigma_plot(eqn, opts, oper, ROM); err = out.err; +out = mess_tf_plot(eqn, opts, oper, ROM); +err = out.err; %% % Report. - if istest - if max(err)>=tol - error('MESS:TEST:accuracy','unexpectedly inaccurate result'); + if max(err) >= tol + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result'); end end diff --git a/DEMOS/FDM/LQG_FDM_unstable_nwt.m b/DEMOS/FDM/LQG_FDM_unstable_nwt.m index bdb3c49..d4c37ac 100644 --- a/DEMOS/FDM/LQG_FDM_unstable_nwt.m +++ b/DEMOS/FDM/LQG_FDM_unstable_nwt.m @@ -22,19 +22,23 @@ function LQG_FDM_unstable_nwt(n0, n_unstable, istest) % % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - -narginchk(0,3); -if nargin<1, n0 = 30; end -if nargin<2, n_unstable = 5; end -if nargin<3, istest = 0; end - +narginchk(0, 3); +if nargin < 1 + n0 = 30; +end +if nargin < 2 + n_unstable = 5; +end +if nargin < 3 + istest = false; +end %% construct unstable matrix % Generate the stable part. @@ -57,98 +61,93 @@ function LQG_FDM_unstable_nwt(n0, n_unstable, istest) % eigenvalues of the system are mirrored into the left open half-plane. Y = eye(n_unstable); -Bt = B(n_stable+1:n, : ); % Part of B acting on unstable part. +Bt = B(n_stable + 1:n, :); % Part of B acting on unstable part. Vl = [zeros(n_unstable, n_stable), eye(n_unstable)]; KB0 = Bt' * Y * Vl; -if exist('lyap','file') % Solve Lyapunov equation. +if exist('lyap', 'file') % Solve Lyapunov equation. Au = lyap(Y, -Bt * Bt'); else Au = lyap2solve(Y, -Bt * Bt'); end -KC0 = C(:, n_stable+1:n) * Y * Vl; +KC0 = C(:, n_stable + 1:n) * Y * Vl; % The full A is constructed via additive decomposition (block diagonal). -eqn.A_ = blkdiag(A0,Au); +eqn.A_ = blkdiag(A0, Au); eqn.B = B; eqn.C = C; -eqn.haveE = 0; +eqn.haveE = false; % set operation -oper = operatormanager('default'); - +opts = struct(); +[oper, opts] = operatormanager(opts, 'default'); %% global options opts.norm = 'fro'; - %% ADI tolerances and maximum iteration number opts.adi.maxiter = 200; opts.adi.res_tol = 1e-10; opts.adi.rel_diff_tol = 1e-16; opts.adi.info = 0; -opts.adi.accumulateDeltaK = 1; -opts.adi.accumulateK = 0; -opts.adi.compute_sol_fac = 1; - +opts.adi.accumulateDeltaK = true; +opts.adi.accumulateK = false; +opts.adi.compute_sol_fac = true; %% shift parameters via projection opts.shifts.num_desired = 5; opts.shifts.method = 'projection'; - %% Newton tolerances and maximum iteration number opts.nm.maxiter = 15; opts.nm.res_tol = 1e-8; opts.nm.rel_diff_tol = 1e-16; opts.nm.info = 1; -opts.nm.linesearch = 1; -opts.nm.accumulateRes = 1; -opts.nm.res = struct('maxiter',10,'tol',1e-6,'orth',0); - +opts.nm.linesearch = true; +opts.nm.accumulateRes = true; +opts.nm.res = struct('maxiter', 10, 'tol', 1e-6, 'orth', 0); %% for shift banned eigenvalues opts.shifts.banned = -eig(Au); opts.shifts.banned_tol = 1e-6; - %% Solve regulator Riccati equation. fprintf('Solve regulator Riccati equation\n'); fprintf('--------------------------------\n'); eqn.type = 'T'; -opts.LDL_T = 0; +opts.LDL_T = false; opts.nm.K0 = KB0; time_nwt_reguator = tic; -[outReg, eqn, opts, oper]=mess_lrnm(eqn, opts, oper); +[outReg, eqn, opts, oper] = mess_lrnm(eqn, opts, oper); t_elapsed1 = toc(time_nwt_reguator); % Size of solution factor. fprintf('\nSize outReg.Z: %d x %d\n', ... - size(outReg.Z, 1), size(outReg.Z, 2)); + size(outReg.Z, 1), size(outReg.Z, 2)); % Check residuals. res0 = norm(eqn.C * eqn.C'); res1 = mess_res2_norms(outReg.Z, 'riccati', ... - eqn, opts, oper, opts.nm, []) / res0; -res2 = abs(eigs(@(x) eqn.A_' * (outReg.Z * ((outReg.Z' * x))) ... - + (outReg.Z * ((outReg.Z' * (eqn.A_ * x)))) ... - + eqn.C' * (eqn.C * x) - outReg.K' * (outReg.K * x), ... - n, 1, 'LM')) / res0; + eqn, opts, oper, opts.nm, []) / res0; +res2 = abs(eigs(@(x) eqn.A_' * (outReg.Z * (outReg.Z' * x)) + ... + (outReg.Z * (outReg.Z' * (eqn.A_ * x))) + ... + eqn.C' * (eqn.C * x) - outReg.K' * (outReg.K * x), ... + n, 1, 'LM')) / res0; fprintf('solving the regulator Riccati equation took %6.2f seconds \n', ... - t_elapsed1); + t_elapsed1); fprintf(['Residual computation -- Newton: %e | ' ... - 'mess_res2_norms: %e | eigs: %e \n'], ... - outReg.res(end), res1, res2); + 'mess_res2_norms: %e | eigs: %e \n'], ... + outReg.res(end), res1, res2); % Print convergence behavior. if istest if min(outReg.res) >= opts.nm.res_tol - error('MESS:TEST:accuracy', 'unexpectedly inaccurate result'); + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result'); end else figure(1); - semilogy(outReg.res,'LineWidth', 3); + semilogy(outReg.res, 'LineWidth', 3); title('0 = C^T C + A^T X + X A - X BB^T X'); xlabel('number of iteration steps'); ylabel('normalized residual norm'); @@ -157,52 +156,52 @@ function LQG_FDM_unstable_nwt(n0, n_unstable, istest) fprintf('\n'); - %% Solve filter Riccati equation. fprintf('Solve filter Riccati equation\n'); fprintf('-----------------------------\n'); eqn.type = 'N'; -opts.LDL_T = 1; +opts.LDL_T = true; opts.nm.K0 = KC0; % Some additional scaling for non-trivial LDL' term. -eqn.S = diag(1:n_unstable); +eqn.T = diag(1:n_unstable); eqn.B = eqn.B * diag(1 ./ sqrt(1:n_unstable)); time_nwt_filter = tic; -[outFil, eqn, opts, oper]=mess_lrnm(eqn, opts, oper); +[outFil, eqn, opts, oper] = mess_lrnm(eqn, opts, oper); t_elapsed2 = toc(time_nwt_filter); % Size of solution factor. fprintf('\nSize outFil.Z: %d x %d\n', ... - size(outFil.Z, 1), size(outFil.Z, 2)); + size(outFil.Z, 1), size(outFil.Z, 2)); % Check residuals. -res0 = norm((eqn.B * eqn.S) * eqn.B'); -eqn.S_diag = diag(eqn.S); +res0 = norm((eqn.B * eqn.T) * eqn.B'); + res3 = mess_res2_norms(outFil.Z, 'riccati', ... - eqn, opts, oper, opts.nm, outFil.D) / res0; + eqn, opts, oper, opts.nm, outFil.D) / res0; ZD = outFil.Z * outFil.D; -res4 = abs(eigs(@(x) eqn.A_ * (ZD * ((outFil.Z' * x))) ... - + (ZD * ((outFil.Z' * (eqn.A_' * x)))) ... - + eqn.B * (eqn.S * (eqn.B' * x)) - (outFil.K)' * ((outFil.K) * x), ... - n, 1, 'LM')) / res0; +res4 = abs(eigs(@(x) eqn.A_ * (ZD * (outFil.Z' * x)) + ... + (ZD * (outFil.Z' * (eqn.A_' * x))) + ... + eqn.B * (eqn.T * (eqn.B' * x)) - ... + (outFil.K)' * ((outFil.K) * x), ... + n, 1, 'LM')) / res0; fprintf('solving the filter Riccati equation took %6.2f seconds \n', ... - t_elapsed2); + t_elapsed2); fprintf(['Residual computations -- Newton: %e | ' ... - 'mess_res2_norms: %e | eigs: %e \n'], ... - outFil.res(end), res3, res4); + 'mess_res2_norms: %e | eigs: %e \n'], ... + outFil.res(end), res3, res4); % Print convergence behavior. if istest if min(outFil.res) >= opts.nm.res_tol - error('MESS:TEST:accuracy', 'unexpectedly inaccurate result'); + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result'); end else figure(2); - semilogy(outFil.res,'LineWidth', 3); + semilogy(outFil.res, 'LineWidth', 3); title('0 = B S B^T + A Y + Y A^T - Y C^T C Y'); xlabel('number of iterations'); ylabel('normalized residual norm'); diff --git a/DEMOS/FDM/LQG_FDM_unstable_radi.m b/DEMOS/FDM/LQG_FDM_unstable_radi.m index 28a0c76..c85fb1e 100644 --- a/DEMOS/FDM/LQG_FDM_unstable_radi.m +++ b/DEMOS/FDM/LQG_FDM_unstable_radi.m @@ -1,216 +1,219 @@ -function LQG_FDM_unstable_radi(n0, n_unstable, istest) -% Computes stabilizing and detecting solutions of the regulator and filter -% Riccati equations via the RADI, respectively. The solution of the -% regulator equation is approximated via a ZZ' factorization, and for the -% filter equation an LDL' approximation is used. -% Note: The LDL' case is only used for demonstration, but with no -% underlying necessity here. -% -% Inputs: -% -% n0 n0^2 gives the dimension of the original model, i.e. n0 is -% the number of degrees of freedom, i.e. grid points, per -% spatial direction -% (optional; defaults to 30) -% -% n_unstable number of unstable eigenvalues by construction -% (optional; defaults to 5) -% -% istest flag to determine whether this demo runs as a CI test or -% interactive demo -% (optional, defaults to 0, i.e. interactive demo) -% - -% -% This file is part of the M-M.E.S.S. project -% (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. -% All rights reserved. -% License: BSD 2-Clause License (see COPYING) -% - -narginchk(0,3); -if nargin<1, n0 = 30; end -if nargin<2, n_unstable = 5; end -if nargin<3, istest = 0; end - - -%% construct unstable matrix -% Generate the stable part. -A0 = fdm_2d_matrix(n0, '10*x', '1000*y', '0'); -n_stable = size(A0, 1); -n = n_stable + n_unstable; -B = [eye(n_stable, n_unstable); diag(1:n_unstable)]; - -C = [transpose(B); zeros(2, n)]; -C(n_unstable + 1, n_unstable + 1) = 1; -C(n_unstable + 2, n_unstable + 2) = 1; - -% The instability is added by fixing the solution Y of the partial -% stabilization problem via Bernoulli and solving the resulting Lyapunov -% equation for the unstable matrix Au: -% -% Au'*Y + Y*Au - Y*Bt*Bt'*Y = 0. -% -% The resulting stabilizing feedback is defined such that the unstable -% eigenvalues of the system are mirrored into the left open half-plane. - -Y = eye(n_unstable); -Bt = B(n_stable+1:n, : ); % Part of B acting on unstable part. -Vl = [zeros(n_stable, n_unstable); eye(n_unstable)]; -if exist('lyap','file') % Solve Lyapunov equation. - Au = lyap(Y, -Bt * Bt'); -else - Au = lyap2solve(Y, (-Bt * Bt')'); -end - -ZB0 = Vl; -YB0 = Y \ eye(n_unstable); -WB0 = C'; - -ZC0 = ZB0; -YC0 = YB0; -WC0 = B; - -% The full A is constructed via additive decomposition (block-diagonal). -eqn.A_ = blkdiag(A0,Au); -eqn.B = B; -eqn.C = C; -eqn.haveE = 0; - -% set operation -oper = operatormanager('default'); - - -%% global options -opts.norm = 'fro'; - - -%% RADI parameters -opts.shifts.naive_update_mode = 0; -opts.radi.compute_sol_fac = 1; -opts.radi.compute_res = 0; -opts.radi.get_ZZt = 1; -opts.radi.maxiter = 200; -opts.radi.res_tol = 1.0e-10; -opts.radi.rel_diff_tol = 1.0e-16; -opts.radi.info = 1; - -% Only for mess_res2_norms (not needed in RADI): -opts.radi.res = struct('maxiter', 10, 'tol', 1.0e-06, 'orth', 0); - - -%% shift parameters via projection -opts.shifts.num_desired = 5; -opts.shifts.method = 'projection'; - - -%% for shift banned eigenvalues -opts.shifts.banned = -eig(Au); -opts.shifts.banned_tol = 1e-6; - - -%% Solve regulator Riccati equation. -fprintf('Solve regulator Riccati equation\n'); -fprintf('--------------------------------\n'); -eqn.type = 'T'; -opts.LDL_T = 0; -opts.radi.Z0 = ZB0; -opts.radi.Y0 = YB0; -opts.radi.W0 = WB0; - -time_radi_regulator = tic; -[outReg, eqn, opts, oper] = mess_lrradi(eqn, opts, oper); -t_elapsed1 = toc(time_radi_regulator); - -% Size of solution factor. -fprintf('\nSize outReg.Z: %d x %d\n', ... - size(outReg.Z, 1), size(outReg.Z, 2)); - -% Check residuals. -res0 = norm(eqn.C * eqn.C'); -res1 = mess_res2_norms(outReg.Z, 'riccati', ... - eqn, opts, oper, opts.radi, []) / res0; -res2 = abs(eigs(@(x) eqn.A_' * (outReg.Z * ((outReg.Z' * x))) ... - + (outReg.Z * ((outReg.Z' * (eqn.A_ * x)))) ... - + eqn.C' * (eqn.C * x) - outReg.K' * (outReg.K * x), ... - n, 1, 'LM')) / res0; - -fprintf('solving the regulator Riccati equation took %6.2f seconds \n', ... - t_elapsed1); -fprintf(['Residual computation -- RADI: %e | ' ... - 'mess_res2_norms: %e | eigs: %e \n'], ... - outReg.res(end), res1, res2); - -% Print convergence behavior. -if istest - if min(outReg.res) >= opts.radi.res_tol - error('MESS:TEST:accuracy', 'unexpectedly inaccurate result'); - end -else - figure(1); - semilogy(outReg.res,'LineWidth', 3); - title('0 = C^T C + A^T X + X A - X B B^T X'); - xlabel('number of iteration steps'); - ylabel('normalized residual norm'); - pause(1); -end - -fprintf('\n'); - - -%% Solve filter Riccati equation. -fprintf('Solve filter Riccati equation\n'); -fprintf('-----------------------------\n'); - -eqn.type = 'N'; -opts.LDL_T = 1; -opts.radi.Z0 = ZC0; -opts.radi.Y0 = YC0; - -% Some additional scaling for non-trivial LDL' term. -eqn.S = diag(1:n_unstable); -eqn.B = eqn.B * diag(1 ./ sqrt(1:n_unstable)); - -% Set corresponding residual. -opts.radi.W0 = WC0 * diag(1 ./ sqrt(1:n_unstable)); -opts.radi.S0 = diag(1:n_unstable); - -time_radi_filter = tic; -[outFil, eqn, opts, oper] = mess_lrradi(eqn, opts, oper); -t_elapsed2 = toc(time_radi_filter); - -% Size of solution factor. -fprintf('\nSize outFil.Z: %d x %d\n', ... - size(outFil.Z, 1), size(outFil.Z, 2)); - -% Check residuals. -res0 = norm((eqn.B * eqn.S) * eqn.B'); -eqn.S_diag = diag(eqn.S); -res3 = mess_res2_norms(outFil.Z, 'riccati', ... - eqn, opts, oper, opts.radi, outFil.D) / res0; -ZD = outFil.Z * outFil.D; -res4 = abs(eigs(@(x) eqn.A_ * (ZD * ((outFil.Z' * x))) ... - + (ZD * ((outFil.Z' * (eqn.A_' * x)))) ... - + eqn.B * (eqn.S * (eqn.B' * x)) - (outFil.K)' * ((outFil.K) * x), ... - n, 1, 'LM')) / res0; - -fprintf('solving the filter Riccati equation took %6.2f seconds \n', ... - t_elapsed2); -fprintf(['Residual computations -- RADI: %e | ' ... - 'mess_res2_norms: %e | eigs: %e \n'], ... - outFil.res(end), res3, res4); - -% Print convergence behavior. -if istest - if min(outFil.res) >= opts.radi.res_tol - error('MESS:TEST:accuracy', 'unexpectedly inaccurate result'); - end -else - figure(2); - semilogy(outFil.res,'LineWidth', 3); - title('0 = B S B^T + A Y + Y A^T - Y C^T C Y'); - xlabel('number of iterations'); - ylabel('normalized residual norm'); - pause(1); -end +function LQG_FDM_unstable_radi(n0, n_unstable, istest) +% Computes stabilizing and detecting solutions of the regulator and filter +% Riccati equations via the RADI, respectively. The solution of the +% regulator equation is approximated via a ZZ' factorization, and for the +% filter equation an LDL' approximation is used. +% Note: The LDL' case is only used for demonstration, but with no +% underlying necessity here. +% +% Inputs: +% +% n0 n0^2 gives the dimension of the original model, i.e. n0 is +% the number of degrees of freedom, i.e. grid points, per +% spatial direction +% (optional; defaults to 30) +% +% n_unstable number of unstable eigenvalues by construction +% (optional; defaults to 5) +% +% istest flag to determine whether this demo runs as a CI test or +% interactive demo +% (optional, defaults to 0, i.e. interactive demo) +% + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +narginchk(0, 3); +if nargin < 1 + n0 = 30; +end +if nargin < 2 + n_unstable = 5; +end +if nargin < 3 + istest = false; +end + +%% construct unstable matrix +% Generate the stable part. +A0 = fdm_2d_matrix(n0, '10*x', '1000*y', '0'); +n_stable = size(A0, 1); +n = n_stable + n_unstable; +B = [eye(n_stable, n_unstable); diag(1:n_unstable)]; + +C = [transpose(B); zeros(2, n)]; +C(n_unstable + 1, n_unstable + 1) = 1; +C(n_unstable + 2, n_unstable + 2) = 1; + +% The instability is added by fixing the solution Y of the partial +% stabilization problem via Bernoulli and solving the resulting Lyapunov +% equation for the unstable matrix Au: +% +% Au'*Y + Y*Au - Y*Bt*Bt'*Y = 0. +% +% The resulting stabilizing feedback is defined such that the unstable +% eigenvalues of the system are mirrored into the left open half-plane. + +Y = eye(n_unstable); +Bt = B(n_stable + 1:n, :); % Part of B acting on unstable part. +Vl = [zeros(n_stable, n_unstable); eye(n_unstable)]; +if exist('lyap', 'file') % Solve Lyapunov equation. + Au = lyap(Y, -Bt * Bt'); +else + Au = lyap2solve(Y, (-Bt * Bt')'); +end + +ZB0 = Vl; +YB0 = Y \ eye(n_unstable); +WB0 = C'; + +ZC0 = ZB0; +YC0 = YB0; +WC0 = B; + +% The full A is constructed via additive decomposition (block-diagonal). +eqn.A_ = blkdiag(A0, Au); +eqn.B = B; +eqn.C = C; +eqn.haveE = false; + +% set operation +opts = struct(); +[oper, opts] = operatormanager(opts, 'default'); + +%% global options +opts.norm = 'fro'; + +%% RADI parameters +opts.shifts.naive_update_mode = false; +opts.radi.compute_sol_fac = true; +opts.radi.compute_res = false; +opts.radi.get_ZZt = true; +opts.radi.maxiter = 200; +opts.radi.res_tol = 1.0e-10; +opts.radi.rel_diff_tol = 1.0e-16; +opts.radi.info = 1; + +% Only for mess_res2_norms (not needed in RADI): +opts.radi.res = struct('maxiter', 10, ... + 'tol', 1.0e-06, ... + 'orth', 0); + +%% shift parameters via projection +opts.shifts.num_desired = 5; +opts.shifts.method = 'projection'; + +%% for shift banned eigenvalues +opts.shifts.banned = -eig(Au); +opts.shifts.banned_tol = 1e-6; + +%% Solve regulator Riccati equation. +fprintf('Solve regulator Riccati equation\n'); +fprintf('--------------------------------\n'); +eqn.type = 'T'; +opts.LDL_T = false; +opts.radi.Z0 = ZB0; +opts.radi.Y0 = YB0; +opts.radi.W0 = WB0; + +time_radi_regulator = tic; +[outReg, eqn, opts, oper] = mess_lrradi(eqn, opts, oper); +t_elapsed1 = toc(time_radi_regulator); + +% Size of solution factor. +fprintf('\nSize outReg.Z: %d x %d\n', ... + size(outReg.Z, 1), size(outReg.Z, 2)); + +% Check residuals. +res0 = norm(eqn.C * eqn.C'); +res1 = mess_res2_norms(outReg.Z, 'riccati', ... + eqn, opts, oper, opts.radi, []) / res0; +res2 = abs(eigs(@(x) eqn.A_' * (outReg.Z * (outReg.Z' * x)) + ... + (outReg.Z * (outReg.Z' * (eqn.A_ * x))) + ... + eqn.C' * (eqn.C * x) - outReg.K' * (outReg.K * x), ... + n, 1, 'LM')) / res0; + +fprintf('solving the regulator Riccati equation took %6.2f seconds \n', ... + t_elapsed1); +fprintf(['Residual computation -- RADI: %e | ' ... + 'mess_res2_norms: %e | eigs: %e \n'], ... + outReg.res(end), res1, res2); + +% Print convergence behavior. +if istest + if min(outReg.res) >= opts.radi.res_tol + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result'); + end +else + figure(1); + semilogy(outReg.res, 'LineWidth', 3); + title('0 = C^T C + A^T X + X A - X B B^T X'); + xlabel('number of iteration steps'); + ylabel('normalized residual norm'); + pause(1); +end + +fprintf('\n'); + +%% Solve filter Riccati equation. +fprintf('Solve filter Riccati equation\n'); +fprintf('-----------------------------\n'); + +eqn.type = 'N'; +opts.LDL_T = true; +opts.radi.Z0 = ZC0; +opts.radi.Y0 = YC0; + +% Some additional scaling for non-trivial LDL' term. +eqn.B = eqn.B * diag(1 ./ sqrt(1:n_unstable)); +eqn.R = diag(1:n_unstable); +eqn.Q = eye(size(eqn.C, 1)); +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Set corresponding residual. +opts.radi.W0 = WC0 * diag(1 ./ sqrt(1:n_unstable)); +opts.radi.T0 = diag(1:n_unstable); + +time_radi_filter = tic; +[outFil, eqn, opts, oper] = mess_lrradi(eqn, opts, oper); +t_elapsed2 = toc(time_radi_filter); + +% Size of solution factor. +fprintf('\nSize outFil.Z: %d x %d\n', ... + size(outFil.Z, 1), size(outFil.Z, 2)); + +% Check residuals. +res0 = norm((eqn.B * eqn.R) * eqn.B'); + +res3 = mess_res2_norms(outFil.Z, 'riccati', ... + eqn, opts, oper, opts.radi, outFil.D) / res0; +ZD = outFil.Z * outFil.D; +res4 = abs(eigs(@(x) eqn.A_ * (ZD * (outFil.Z' * x)) + ... + (ZD * (outFil.Z' * (eqn.A_' * x))) + ... + eqn.B * (eqn.R * (eqn.B' * x)) - (outFil.K)' * ... + ((outFil.K) * x), n, 1, 'LM')) / res0; + +fprintf('solving the filter Riccati equation took %6.2f seconds \n', ... + t_elapsed2); +fprintf(['Residual computations -- RADI: %e | ' ... + 'mess_res2_norms: %e | eigs: %e \n'], ... + outFil.res(end), res3, res4); + +% Print convergence behavior. +if istest + if min(outFil.res) >= opts.radi.res_tol + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result'); + end +else + figure(2); + semilogy(outFil.res, 'LineWidth', 3); + title('0 = B S B^T + A Y + Y A^T - Y C^T C Y'); + xlabel('number of iterations'); + ylabel('normalized residual norm'); + pause(1); +end diff --git a/DEMOS/FDM/bt_mor_FDM_tol.m b/DEMOS/FDM/bt_mor_FDM_tol.m index 78a3afc..0db95f2 100644 --- a/DEMOS/FDM/bt_mor_FDM_tol.m +++ b/DEMOS/FDM/bt_mor_FDM_tol.m @@ -43,7 +43,7 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % @@ -51,10 +51,18 @@ %% narginchk(0, 4); % BT tolerance and maximum order for the ROM -if nargin < 1, tol = 1e-6; end -if nargin < 2, n0 = 50; end -if nargin < 3, shifts = 'heur'; end -if nargin < 4, istest = 0; end +if nargin < 1 + tol = 1e-6; +end +if nargin < 2 + n0 = 50; +end +if nargin < 3 + shifts = 'heur'; +end +if nargin < 4 + istest = false; +end % ADI tolerance and maximum iteration number opts.adi.maxiter = 100; @@ -65,17 +73,17 @@ %% % operations -oper = operatormanager('default'); +[oper, opts] = operatormanager(opts, 'default'); % Problem data -eqn.A_ = fdm_2d_matrix(n0, '10*x','100*y','0'); +eqn.A_ = fdm_2d_matrix(n0, '10*x', '100*y', '0'); eqn.B = fdm_2d_vector(n0, '.1=opts.adi.res_tol - error('MESS:TEST:accuracy','unexpectedly inaccurate result'); + if min(outB.res) >= opts.adi.res_tol + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result'); end else figure(1); - semilogy(outB.res,'LineWidth',3); + semilogy(outB.res, 'LineWidth', 3); title('A X + X A^T = -BB^T'); xlabel('number of iterations'); ylabel('normalized residual norm'); pause(1); end - -disp('size outB.Z:'); -disp(size(outB.Z)); +[mZ, nZ] = size(outB.Z); +mess_fprintf(opts, 'size outB.Z:%d x %d\n\n', mZ, nZ); %% % observability @@ -132,11 +139,11 @@ t_mess_lradi = tic; outC = mess_lradi(eqn, opts, oper); t_elapsed2 = toc(t_mess_lradi); -fprintf(1, 'mess_lradi took %6.2f seconds \n', t_elapsed2); +mess_fprintf(opts, 'mess_lradi took %6.2f seconds \n', t_elapsed2); if istest if min(outC.res) >= opts.adi.res_tol - error('MESS:TEST:accuracy', 'unexpectedly inaccurate result'); + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result'); end else figure(2); @@ -146,38 +153,40 @@ ylabel('normalized residual norm'); pause(1); end -disp('size outC.Z:'); -disp(size(outC.Z)); +[mZ, nZ] = size(outC.Z); +mess_fprintf(opts, 'size outC.Z:%d x %d\n\n', mZ, nZ); %% opts.srm.tol = tol; opts.srm.info = 1; -[TL, TR, HSV, eqn, opts, ~] = mess_square_root_method(eqn, opts, oper,... - outB.Z, outC.Z); +[TL, TR, HSV, eqn, opts, ~] = mess_square_root_method(eqn, opts, oper, ... + outB.Z, outC.Z); Ar = TL' * (eqn.A_ * TR); Br = TL' * eqn.B; Cr = eqn.C * TR; -opts.sigma.nsample = 200; % 200 frequency samples -opts.sigma.fmin = -3; % min. frequency 1e-3 -opts.sigma.fmax = 4; % max. frequency 1e4 +opts.tf_plot.nsample = 200; % 200 frequency samples +opts.tf_plot.fmin = -3; % min. frequency 1e-3 +opts.tf_plot.fmax = 4; % max. frequency 1e4 if istest - opts.sigma.info = 1; % no output + opts.tf_plot.info = 1; % no output else - opts.sigma.info = 2; % show messages and plots + opts.tf_plot.info = 2; % show messages and plots end +opts.tf_plot.type = 'sigma'; + ROM.A = Ar; ROM.B = Br; ROM.C = Cr; -ROM.E = eye(size(ROM.A,1)); +ROM.E = eye(size(ROM.A, 1)); -out = mess_sigma_plot(eqn, opts, oper, ROM); +out = mess_tf_plot(eqn, opts, oper, ROM); err = out.err; if istest - if max(err)>tol - error('MESS:TEST:accuracy', 'unexpectedly inaccurate result'); + if max(err) > tol + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result'); end else figure; diff --git a/DEMOS/FDM/lqgbt_mor_FDM.m b/DEMOS/FDM/lqgbt_mor_FDM.m deleted file mode 100644 index 101d2a9..0000000 --- a/DEMOS/FDM/lqgbt_mor_FDM.m +++ /dev/null @@ -1,186 +0,0 @@ -function [Ar, Br, Cr] = lqgbt_mor_FDM(tol,max_ord,n0,istest) -% LQGBT_MOR_FDM computes a reduced order model via the lienar quadratic -% Gaussian balanced truncation [1] for a finite difference discretized -% convection diffusion model on the unit square described in [2]. -% -% Usage: -% [Ar, Br, Cr] = lqgbt_mor_FDM(tol,max_ord,n0,test) -% -% Inputs -% -% tol truncation tolerance for the LQG characteristic values -% -% max_ord maximum allowed order for the reuced order model -% -% n0 n0^2 gives the dimension of the original model, i.e. n0 is -% the number of degrees of freedom per spatial direction -% -% istest flag to determine whether this demo runs as a CI test or -% interactive demo -% (optional, defaults to 0, i.e. interactive demo) -% -% Outputs -% -% Ar, Br, Cr the reduced orde system matrices. -% -% References -% [1] D. Mustafa, K. Glover, Controller design by H∞ -balanced truncation, -% IEEE Trans. Autom. Control 36 (6) (1991) 668–682. -% https://doi.org/10.1109/9.86941 -% -% [2] T. Penzl, Lyapack Users Guide, Tech. Rep. SFB393/00-33, -% Sonderforschungsbereich 393 Numerische Simulation auf massiv -% parallelen Rechnern, TU Chemnitz, 09107 Chemnitz, Germany, -% available from http://www.tu-chemnitz.de/sfb393/sfb00pr.html (2000). -% - -% -% This file is part of the M-M.E.S.S. project -% (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2021 Jens Saak, Martin Koehler, Peter Benner and others. -% All rights reserved. -% License: BSD 2-Clause License (see COPYING) -% - -%% -narginchk(0,4); -%% -% LQGBT Tolerance and maximum order of the ROM. -if nargin<1 - tol = 1e-6; -end -if nargin<2 - max_ord = 250; -end -if nargin<3 - n0 = 60; % n0 = number of grid points in either space direction; - % n = n0^2 is the problem dimension! - % (Change n0 to generate problems of different size.) -end -if nargin<4 - istest=0; -end -% Problem data - -eqn.A_ = fdm_2d_matrix(n0,'10*x','100*y','0'); -eqn.B = fdm_2d_vector(n0,'.1=opts.nm.res_tol - error('MESS:TEST:accuracy','unexpectedly inaccurate result'); - end -else - figure(1); - semilogy(outC.res,'linewidth',3); - title('AX + XA^T - XC^TCX + BB^T = 0'); - xlabel('number of iterations'); - ylabel('normalized residual norm'); - pause(1); -end - - -%% -% Solve the regulator Riccati equation. -% A'*X + X*A - X*B*B'*X + C'*C = 0 -t_mess_lrnm = tic; -eqn.type = 'T'; -outB = mess_lrnm(eqn, opts, oper); -t_elapsed2 = toc(t_mess_lrnm); -fprintf(1,'mess_lrnm took %6.2f seconds \n' ,t_elapsed2); - -if istest - if min(outB.res)>=opts.nm.res_tol - error('MESS:TEST:accuracy','unexpectedly inaccurate result'); - end -else - figure(2); - semilogy(outB.res,'linewidth',3); - title('A^TX + XA - XBB^TX + C^TC = 0'); - xlabel('number of iterations'); - ylabel('normalized residual norm'); - pause(1); -end - - -%% -% % Model reduction by square root method. -opts.srm.tol=tol; -opts.srm.max_ord = max_ord; -opts.srm.info=1; -[TL, TR, ~, eqn, opts, ~] = mess_square_root_method(eqn,opts,oper,... - outB.Z,outC.Z); - -Ar = TR'*(eqn.A_*TL); -Br = TR'*eqn.B; -Cr = eqn.C*TL; - -opts.sigma.nsample = 200; % 200 frequency samples -opts.sigma.fmin = -2; % min. frequency 1e-3 -opts.sigma.fmax = 6; % max. frequency 1e4 -if istest - opts.sigma.info=1; % no output -else - opts.sigma.info = 2; % show messages and plots -end -ROM.A = Ar; -ROM.B = Br; -ROM.C = Cr; -ROM.E = eye(size(ROM.A,1)); - -out = mess_sigma_plot(eqn, opts, oper, ROM); err = out.err; - -%% -% Report. - - -if istest - if max(err)>=tol - error('MESS:TEST:accuracy','unexpectedly inaccurate result'); - end -end diff --git a/DEMOS/LTV/LQR_LTV_smallscale_BDF.m b/DEMOS/LTV/LQR_LTV_smallscale_BDF.m index 303214c..59d56ac 100644 --- a/DEMOS/LTV/LQR_LTV_smallscale_BDF.m +++ b/DEMOS/LTV/LQR_LTV_smallscale_BDF.m @@ -14,11 +14,10 @@ % interactive demo % (optional, defaults to 0, i.e. interactive demo) - % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % @@ -27,7 +26,7 @@ k = 2; end if nargin < 2 - istest = 0; + istest = false; end Nx = 10; @@ -35,13 +34,13 @@ % Finite-difference approximation of Laplacian on [0,1]^2 with Dirichlet % boundary conditions -xx = linspace(0,1, Nx+2); -x = xx(2:end-1); -dx = 1/(Nx+1); +xx = linspace(0, 1, Nx + 2); +x = xx(2:end - 1); +dx = 1 / (Nx + 1); ev = ones(Nx, 1); -A_1D = 1/dx^2*spdiags([ev, -2*ev, ev], -1:1, Nx, Nx); +A_1D = 1 / dx^2 * spdiags([ev, -2 * ev, ev], -1:1, Nx, Nx); -[X, Y] = meshgrid(x,x); +[X, Y] = meshgrid(x, x); I_1D = eye(Nx, Nx); A_2D = kron(A_1D, I_1D) + kron(I_1D, A_1D); M = speye(Nx2, Nx2); % mass matrix = I in this case @@ -50,16 +49,18 @@ Nb = 3; B = zeros(Nx2, Nb); for j = 1:Nb - B(:, j) = reshape((X > j/4) & (X < j/4 + 1/8) & (Y > j/4) & (Y < j/4 + 1/8), Nx2, 1); + B(:, j) = reshape((X > j / 4) & (X < j / 4 + 1 / 8) & ... + (Y > j / 4) & (Y < j / 4 + 1 / 8), ... + Nx2, 1); end % 1 output, average of all states -C = 1/Nx2 * ones(1, Nx2); +C = 1 / Nx2 * ones(1, Nx2); % Time dependency through factors -alpha = @(t) 1 + 10*sin(2*pi*t); % A -mu = @(t) 2 + 7.1*sin(2*pi*t); % M -dmu = @(t) 7.1*2*pi*cos(2*pi*t); % dM/dt +alpha = @(t) 1 + 10 * sin(2 * pi * t); % A +mu = @(t) 2 + 7.1 * sin(2 * pi * t); % M +dmu = @(t) 7.1 * 2 * pi * cos(2 * pi * t); % dM/dt Beta = @(t) 3 + cos(t); % B Gamma = @(t) 1 - min(t, 1); % C @@ -82,7 +83,7 @@ eqn.B_time = Bt; eqn.C_time = Ct; -eqn.haveE = 1; +eqn.haveE = true; eqn.type = 'T'; @@ -91,20 +92,18 @@ eqn.L0 = L0; eqn.D0 = eye(size(L0, 2)); -eqn.LTV = 1; % Specify that this is a time-varying problem +eqn.LTV = true; % Specify that this is a time-varying problem % Time interval [0, 0.1] and 100 time steps t0 = 0; tend = 0.1; Nt = 1000; - % Set up and initialize operator -oper = operatormanager('default'); - opts = struct; -[eqn, opts, oper] = oper.eval_matrix_functions(eqn, opts, oper, tend); +[oper, opts] = operatormanager(opts, 'default'); +[eqn, opts, oper] = oper.eval_matrix_functions(eqn, opts, oper, tend); %% General BDF parameters @@ -116,14 +115,14 @@ opts.adi.res_tol = 1e-14; opts.adi.rel_diff_tol = 1e-16; opts.adi.info = 0; -opts.adi.compute_sol_fac = 1; +opts.adi.compute_sol_fac = true; opts.cc_info = 0; %% -%Heuristic shift parameters via basic Arnoldi -opts.shifts.num_desired=7; -opts.shifts.num_Ritz=50; -opts.shifts.num_hRitz=25; +% Heuristic shift parameters via basic Arnoldi +opts.shifts.num_desired = 7; +opts.shifts.num_Ritz = 50; +opts.shifts.num_hRitz = 25; opts.shifts.method = 'heur'; % opts.shifts.b0=ones(n,1); @@ -135,39 +134,38 @@ opts.nm.rel_diff_tol = 1e-16; opts.nm.info = 0; opts.norm = 'fro'; -opts.nm.accumulateRes = 1; -opts.nm.linesearch = 1; +opts.nm.accumulateRes = true; +opts.nm.linesearch = true; %% % BDF parameters -opts.bdf.time_steps = linspace(t0, tend, Nt+1); +opts.bdf.time_steps = linspace(t0, tend, Nt + 1); opts.bdf.step = k; opts.bdf.info = 1; opts.bdf.save_solution = 1; opts.bdf.startup_iter = 7; - %% Compute the approximation t_mess_bdf_dre = tic; -[out, ~,opts, ~] = mess_bdf_dre(eqn,opts,oper); +[out, ~, opts, ~] = mess_bdf_dre(eqn, opts, oper); t_elapsed = toc(t_mess_bdf_dre); -fprintf(1,'mess_bdf_dre took %6.2f seconds \n', t_elapsed); +mess_fprintf(opts, 'mess_bdf_dre took %6.2f seconds \n', t_elapsed); %% if not(istest) t = opts.bdf.time_steps; - y = zeros(1,length(out.Ks)); - for i=1:length(out.Ks) - y(i) = out.Ks{i}(1,1); + y = zeros(1, length(out.Ks)); + for i = 1:length(out.Ks) + y(i) = out.Ks{i}(1, 1); end figure; - plot(t, y,'LineWidth',3); + plot(t, y, 'LineWidth', 3); title('evolution of component (1,1) of the optimal feedback'); else if abs(norm(out.Ds{1}) / 6.079051242083189e-05 - 1) >= 1e-10 - error('MESS:TEST:accuracy','unexpectedly inaccurate result'); - end + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result'); + end end diff --git a/DEMOS/LTV/LQR_LTV_smallscale_splitting.m b/DEMOS/LTV/LQR_LTV_smallscale_splitting.m index 72c5817..b055464 100644 --- a/DEMOS/LTV/LQR_LTV_smallscale_splitting.m +++ b/DEMOS/LTV/LQR_LTV_smallscale_splitting.m @@ -31,20 +31,18 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - - if nargin < 1 method.order = 2; method.additive = false; method.symmetric = false; end if nargin < 2 - istest = 0; + istest = false; end Nx = 10; @@ -52,13 +50,13 @@ % Finite-difference approximation of Laplacian on [0,1]^2 with Dirichlet % boundary conditions -xx = linspace(0,1, Nx+2); -x = xx(2:end-1); -dx = 1/(Nx+1); +xx = linspace(0, 1, Nx + 2); +x = xx(2:end - 1); +dx = 1 / (Nx + 1); e = ones(Nx, 1); -A_1D = 1/dx^2*spdiags([e, -2*e, e], -1:1, Nx, Nx); +A_1D = 1 / dx^2 * spdiags([e, -2 * e, e], -1:1, Nx, Nx); -[X, Y] = meshgrid(x,x); +[X, Y] = meshgrid(x, x); I_1D = eye(Nx, Nx); A_2D = kron(A_1D, I_1D) + kron(I_1D, A_1D); M = speye(Nx2, Nx2); % mass matrix = I in this case @@ -67,16 +65,18 @@ Nb = 3; B = zeros(Nx2, Nb); for j = 1:Nb - B(:, j) = reshape((X > j/4) & (X < j/4 + 1/8) & (Y > j/4) & (Y < j/4 + 1/8), Nx2, 1); + B(:, j) = reshape((X > j / 4) & (X < j / 4 + 1 / 8) & ... + (Y > j / 4) & (Y < j / 4 + 1 / 8), ... + Nx2, 1); end % 1 output, average of all states -C = 1/Nx2 * ones(1, Nx2); +C = 1 / Nx2 * ones(1, Nx2); % Time dependency through factors -alpha = @(t) 1 + 10*sin(2*pi*t); % A -mu = @(t) 2 + 7.1*sin(2*pi*t); % M -dmu = @(t) 7.1*2*pi*cos(2*pi*t); % dM/dt +alpha = @(t) 1 + 10 * sin(2 * pi * t); % A +mu = @(t) 2 + 7.1 * sin(2 * pi * t); % M +dmu = @(t) 7.1 * 2 * pi * cos(2 * pi * t); % dM/dt Beta = @(t) 3 + cos(t); % B Gamma = @(t) 1 - min(t, 1); % C @@ -99,7 +99,7 @@ eqn.B_time = Bt; eqn.C_time = Ct; -eqn.haveE = 1; +eqn.haveE = true; eqn.type = 'T'; @@ -110,10 +110,10 @@ % R^{-1}, inverse of weighting factor for input in cost functional eqn.Rinv = 1; +opts = struct(); +[oper, opts] = operatormanager(opts, 'default'); -oper = operatormanager('default'); - -eqn.LTV = 1; % Specify that this is a time-varying problem +eqn.LTV = true; % Specify that this is a time-varying problem % Time interval [0, 0.1] and 100 time steps t0 = 0; @@ -121,49 +121,47 @@ Nt = 100; %% General splitting parameters -opts.splitting.time_steps = linspace(t0, tend, Nt+1); +opts.splitting.time_steps = linspace(t0, tend, Nt + 1); opts.splitting.order = method.order; opts.splitting.additive = method.additive; opts.splitting.symmetric = method.symmetric; opts.splitting.info = 2; -opts.splitting.intermediates = 1; +opts.splitting.intermediates = true; opts.splitting.trunc_tol = eps; % Quadrature (for integral terms) parameters opts.splitting.quadrature.type = 'adaptive'; -opts.splitting.quadrature.tol=1e-8 ; - +opts.splitting.quadrature.tol = 1e-8; %% Matrix exponential actions opts.exp_action.method = 'LTV'; opts.exp_action.tol = 1e-8; - %% Compute the approximation t_mess_splitting_dre = tic; -[out, ~,opts, ~] = mess_splitting_dre(eqn,opts,oper); +[out, ~, opts, ~] = mess_splitting_dre(eqn, opts, oper); t_elapsed = toc(t_mess_splitting_dre); -fprintf(1,'mess_splitting_dre took %6.2f seconds \n', t_elapsed); +mess_fprintf(opts, 'mess_splitting_dre took %6.2f seconds \n', t_elapsed); %% if not(istest) t = opts.splitting.time_steps; figure; - plot(t, out.ms,'LineWidth',3); + plot(t, out.ms, 'LineWidth', 3); title('Ranks of approximations over time'); - y = zeros(1,length(out.Ks)); - for i=1:length(out.Ks) - y(i) = out.Ks{i}(1,1); + y = zeros(1, length(out.Ks)); + for i = 1:length(out.Ks) + y(i) = out.Ks{i}(1, 1); end figure; - plot(t, y,'LineWidth',3); + plot(t, y, 'LineWidth', 3); title('evolution of component (1,1) of the optimal feedback'); else if abs(norm(out.Ds{1}) / 6.078945091766749e-05 - 1) >= 1e-10 - error('MESS:TEST:accuracy','unexpectedly inaccurate result'); - end + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result'); + end end diff --git a/DEMOS/Logger/logging.m b/DEMOS/Logger/logging.m new file mode 100644 index 0000000..8063a55 --- /dev/null +++ b/DEMOS/Logger/logging.m @@ -0,0 +1,108 @@ +function logging(setup, is_test) +% Demo for logging functions of M-M.E.S.S. + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +% set the options for the logger in the opts.logger struct +% figureformat sets the format of the graphs/figures that will be used +% (eps, png, svg) +opts.logger.figureformat = 'png'; + +% format sets the format of the document that will be generated +% (html, md, tex) +opts.logger.format = 'md'; + +% out sets the output: +% 'file' redirect output to file, +% 'console' print to the matlab console as usual +% 'both' print as usual but duplicate the output into the file +opts.logger.out = 'file'; + +% fetch the above from 'setup' input argument in case this is executed +% as a unit test +if nargin > 0 + opts.logger.format = setup{1}; + opts.logger.out = setup{2}; + opts.logger.figureformat = setup{3}; + opts = mess_log_initialize(opts, ... + [setup{3} '-' setup{1} '-' setup{2}]); +end + +if nargin < 2 + is_test = false; +end + +if not(is_test) + % initialize the logging mechanisms by giving it a name + % this needs to be written to the opts struct and called after the + % setting of the logger options + opts = mess_log_initialize(opts, 'demo_log'); +end + +%% mess_fprintf works like the regular fprintf, but will print to the output +% set in opts.logger.out +mess_fprintf(opts, ... + '============ %s =============\n', ... + opts.logger.basename); + +mess_fprintf(opts, ... + '%s %s\n', ... + opts.logger.format, opts.logger.out); + +% print some numbers +for j = 1:10 + mess_fprintf(opts, 'test: %2d\n', j); +end + +%% mess_warn is used to issue warnings, the warning codes are restricted to +% a set that can be found in mess_log_codes.m +mess_warn(opts, ... + 'illegal_input', ... + 'this warning was triggered by incorrect inputs'); + +%% logging plots +% plot a quadratic +x = linspace(-5, 5); +y = x.^2; +f = figure(); +plot(x, y); +xlabel('x axis'); +ylabel('y axis'); +title('demo figure'); + +% mess_log_plot will print the given figure in the format set in +% opts.logger.figureformat. the file will be called NAME.{figureformat} +% if NAME is not given, the figure's number is used. +NAME = 'demo'; +mess_log_plot(opts, f, NAME); +close(f); + +%% log a matrix +m = sprand(10, 10, 0.1); +% mess_log_matrix saves the given variable to a .mat file +mess_log_matrix(opts, m); + +if is_test + try + %% mess_err throws an error, logs to the output set in opts.logger.out + % and properly closes the file if necessary. + mess_err(opts, ... + 'missing_feature', ... + 'this error was triggered by a missing feature'); + catch + + end + +else + %% mess_log_finalize needs to be called at the end of every logged + % computation, it finishes up the logging process. + % note that this is also automatically called in mess_err, should the + % computation end due to an error + mess_log_finalize(opts); +end diff --git a/DEMOS/RI/DEMO_RI_GE_DAE2.m b/DEMOS/RI/DEMO_RI_GE_DAE2.m index f5c9a28..2235444 100644 --- a/DEMOS/RI/DEMO_RI_GE_DAE2.m +++ b/DEMOS/RI/DEMO_RI_GE_DAE2.m @@ -11,15 +11,17 @@ function DEMO_RI_GE_DAE2(istest) % % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % %% -if nargin<1, istest=0; end +if nargin < 1 + istest = false; +end %% Construction of system data. if exist('OCTAVE_VERSION', 'builtin') @@ -62,17 +64,19 @@ function DEMO_RI_GE_DAE2(istest) eqn.A_ = sparse([A, J'; J, zeros(100)]); eqn.E_ = sparse(blkdiag(M, zeros(100))); -st = 500; -eqn.st = 500; +eqn.manifold_dim = 500; +one = 1:eqn.manifold_dim; +two = eqn.manifold_dim + 1:size(eqn.A_, 1); gam = 5; -eqn.B1 = 1/gam * eqn.B1; +eqn.B1 = 1 / gam * eqn.B1; eqn.type = 'T'; -eqn.haveE = 1; +eqn.haveE = true; %% Set operator. -oper = operatormanager('dae_2'); +opts = struct(); +[oper, opts] = operatormanager(opts, 'dae_2'); %% Construction of options struct. % ADI settings. @@ -80,9 +84,9 @@ function DEMO_RI_GE_DAE2(istest) opts.adi.res_tol = 1.0e-14; opts.adi.rel_diff_tol = 0; opts.adi.info = 1; -opts.adi.compute_sol_fac = 1; -opts.adi.accumulateK = 0; -opts.adi.accumulateDeltaK = 0; +opts.adi.compute_sol_fac = true; +opts.adi.accumulateK = false; +opts.adi.accumulateDeltaK = false; % Shift options. opts.shifts.num_desired = 5; @@ -93,15 +97,15 @@ function DEMO_RI_GE_DAE2(istest) opts.nm.res_tol = 1.0e-12; opts.nm.rel_diff_tol = 1.0e-12; opts.nm.info = 1; -opts.nm.linesearch = 0; -opts.nm.accumulateRes = 1; +opts.nm.linesearch = false; +opts.nm.accumulateRes = true; % NM projection settings. opts.nm.projection = []; opts.nm.projection.freq = 0; opts.nm.res.maxiter = 10; opts.nm.res.tol = 1.0e-06; -opts.nm.res.orth = 1; +opts.nm.res.orth = true; % RI settings. opts.ri.riccati_solver = 'newton'; @@ -118,12 +122,12 @@ function DEMO_RI_GE_DAE2(istest) t_mess_lrri = tic; [outnm, eqn, opts, oper] = mess_lrri(eqn, opts, oper); t_elapsed1 = toc(t_mess_lrri); -fprintf(1,'mess_lrri took %6.2f seconds \n' , t_elapsed1); +mess_fprintf(opts, 'mess_lrri took %6.2f seconds \n', t_elapsed1); %% Setup RADI structure. opts.radi.maxiter = opts.adi.maxiter; opts.radi.res_tol = opts.nm.res_tol; opts.radi.rel_diff_tol = 1.0e-16; -opts.radi.info = 1; +opts.radi.info = 1; opts.ri.riccati_solver = 'radi'; @@ -131,20 +135,20 @@ function DEMO_RI_GE_DAE2(istest) t_mess_lrri = tic; [out, eqn, opts, ~] = mess_lrri(eqn, opts, oper); t_elapsed2 = toc(t_mess_lrri); -fprintf(1,'mess_lrri took %6.2f seconds \n',t_elapsed2); +mess_fprintf(opts, 'mess_lrri took %6.2f seconds \n', t_elapsed2); %% Test of the solution. % Partitioning of the system. -A = eqn.A_(1:st,1:st); -J = eqn.A_(1:st,st+1:end); -G = eqn.A_(st+1:end,1:st); -E = eqn.E_(1:st,1:st); +A = eqn.A_(one, one); +J = eqn.A_(one, two); +G = eqn.A_(two, one); +E = eqn.E_(one, one); B1 = eqn.B1; B2 = eqn.B2; C1 = eqn.C1; % Compute projection matrices (not recommended for large-scale case). -Pi_l = eye(st) - J*((G*(E\J))\(G/E)); -Pi_r = eye(st) - (E\J)*((G*(E\J))\G); +Pi_l = eye(eqn.manifold_dim) - J * ((G * (E \ J)) \ (G / E)); +Pi_r = eye(eqn.manifold_dim) - (E \ J) * ((G * (E \ J)) \ G); % Explicit projection. A_p = Pi_l * A * Pi_r; @@ -154,25 +158,27 @@ function DEMO_RI_GE_DAE2(istest) B2_p = Pi_l * B2; % Compute the actual errors. -abserrnm = norm(A_p' * (outnm.Z * outnm.Z') * M_p ... - + M_p' * (outnm.Z * outnm.Z') * A_p ... - + M_p' * (outnm.Z * outnm.Z') * (B1_p * B1_p' ... - - B2_p * B2_p') * (outnm.Z * outnm.Z') * M_p + C1_p' * C1_p, 2); +abserrnm = norm(A_p' * (outnm.Z * outnm.Z') * M_p + ... + M_p' * (outnm.Z * outnm.Z') * A_p + ... + M_p' * (outnm.Z * outnm.Z') * ... + (B1_p * B1_p' - B2_p * B2_p') * (outnm.Z * outnm.Z') * ... + M_p + C1_p' * C1_p, 2); relerrnm = abserrnm / norm(C1_p * C1_p', 2); -fprintf(1, '\nNewton -> set tolerance vs. real residual: %e | %e\n', ... - opts.ri.res_tol, relerrnm); - -abserrradi = norm(A_p' * (out.Z * out.Z') * M_p ... - + M_p' * (out.Z * out.Z') * A_p ... - + M_p' * (out.Z * out.Z') * (B1_p * B1_p' ... - - B2_p * B2_p') * (out.Z * out.Z') * M_p + C1_p' * C1_p, 2); +mess_fprintf(opts, '\nNewton -> set tolerance vs. real residual: %e | %e\n', ... + opts.ri.res_tol, relerrnm); + +abserrradi = norm(A_p' * (out.Z * out.Z') * M_p + ... + M_p' * (out.Z * out.Z') * A_p + ... + M_p' * (out.Z * out.Z') * ... + (B1_p * B1_p' - B2_p * B2_p') * (out.Z * out.Z') * M_p + ... + C1_p' * C1_p, 2); relerrradi = abserrradi / norm(C1_p * C1_p', 2); -fprintf(1, 'RADI -> set tolerance vs. real residual: %e | %e\n', ... - opts.ri.res_tol, relerrradi); +mess_fprintf(opts, 'RADI -> set tolerance vs. real residual: %e | %e\n', ... + opts.ri.res_tol, relerrradi); if istest - assert(relerrnm < opts.ri.res_tol, ... - 'MESS:TEST:accuracy','unexpectedly inaccurate result'); - assert(relerrradi < opts.ri.res_tol, ... - 'MESS:TEST:accuracy','unexpectedly inaccurate result'); + mess_assert(opts, relerrnm < opts.ri.res_tol, ... + 'TEST:accuracy', 'unexpectedly inaccurate result'); + mess_assert(opts, relerrradi < opts.ri.res_tol, ... + 'TEST:accuracy', 'unexpectedly inaccurate result'); end diff --git a/DEMOS/RI/DEMO_RI_GE_T_N.m b/DEMOS/RI/DEMO_RI_GE_T_N.m index ca222c7..4d64dee 100644 --- a/DEMOS/RI/DEMO_RI_GE_T_N.m +++ b/DEMOS/RI/DEMO_RI_GE_T_N.m @@ -13,13 +13,15 @@ function DEMO_RI_GE_T_N(istest) % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % %% -if nargin<1, istest=0; end +if nargin < 1 + istest = false; +end %% Construction of system data. if exist('OCTAVE_VERSION', 'builtin') @@ -56,12 +58,13 @@ function DEMO_RI_GE_T_N(istest) C1 = rand(3, 500); end -eqn.haveE = 1; +eqn.haveE = true; gam = 5; % Scaling term for disturbances. %% Set operator. -oper = operatormanager('default'); +opts = struct(); +[oper, opts] = operatormanager(opts, 'default'); %% Construction of options struct. % RADI settings. @@ -90,41 +93,48 @@ function DEMO_RI_GE_T_N(istest) %% Solve the control equation. t_solve_eqn = tic; eqn.type = 'T'; -eqn.B1 = 1/gam * B1; +eqn.B1 = 1 / gam * B1; eqn.C1 = C1; [outControl, eqn, opts, oper] = mess_lrri(eqn, opts, oper); t_elapsed1 = toc(t_solve_eqn); -fprintf(1,'solving the control equation took %6.2f seconds \n' ,t_elapsed1); +mess_fprintf(opts, ... + 'solving the control equation took %6.2f seconds \n', t_elapsed1); %% Solve the filter equation. t_solve_eqn = tic; eqn.type = 'N'; eqn.B1 = B1; -eqn.C1 = 1/gam * C1; +eqn.C1 = 1 / gam * C1; [outFilter, eqn, opts, ~] = mess_lrri(eqn, opts, oper); t_elapsed2 = toc(t_solve_eqn); -fprintf(1,'solving the filter equation took %6.2f seconds \n' , t_elapsed2); +mess_fprintf(opts, ... + 'solving the filter equation took %6.2f seconds \n', t_elapsed2); %% Compute real residuals. -absControl = norm(eqn.A_' * (outControl.Z * outControl.Z') * eqn.E_ ... - + eqn.E_' * (outControl.Z * outControl.Z') * eqn.A_ ... - + eqn.E_' * (outControl.Z * outControl.Z') * (1/gam^2 * (B1 * B1') ... - - eqn.B2 * eqn.B2') * (outControl.Z * outControl.Z') * eqn.E_ ... - + C1' * C1, 2); +absControl = norm(eqn.A_' * (outControl.Z * outControl.Z') * eqn.E_ + ... + eqn.E_' * (outControl.Z * outControl.Z') * eqn.A_ + ... + eqn.E_' * (outControl.Z * outControl.Z') * ... + (1 / gam^2 * (B1 * B1') - eqn.B2 * eqn.B2') * ... + (outControl.Z * outControl.Z') * eqn.E_ + ... + C1' * C1, 2); relControl = absControl / norm(C1 * C1', 2); -fprintf(1, '\nControl -> set tolerance vs. real residual: %e | %e\n', ... - opts.ri.res_tol, relControl); - -absFilter = norm(eqn.A_ * (outFilter.Z * outFilter.Z') * eqn.E_' ... - + eqn.E_ * (outFilter.Z * outFilter.Z') * eqn.A_' ... - + eqn.E_ * (outFilter.Z * outFilter.Z') * (1/gam^2 * (C1' * C1) ... - - eqn.C2' * eqn.C2) * (outFilter.Z * outFilter.Z') * eqn.E_' ... - + B1 * B1', 2); +mess_fprintf(opts, ... + '\nControl -> set tolerance vs. real residual: %e | %e\n', ... + opts.ri.res_tol, relControl); + +absFilter = norm(eqn.A_ * (outFilter.Z * outFilter.Z') * eqn.E_' + ... + eqn.E_ * (outFilter.Z * outFilter.Z') * eqn.A_' + ... + eqn.E_ * (outFilter.Z * outFilter.Z') * ... + (1 / gam^2 * (C1' * C1) - eqn.C2' * eqn.C2) * ... + (outFilter.Z * outFilter.Z') * eqn.E_' + ... + B1 * B1', 2); relFilter = absFilter / norm(B1' * B1, 2); -fprintf(1, 'Filter -> set tolerance vs. real residual: %e | %e\n', ... - opts.ri.res_tol, relFilter); +mess_fprintf(opts, 'Filter -> set tolerance vs. real residual: %e | %e\n', ... + opts.ri.res_tol, relFilter); +% safety factor mostly used for Octave +safety = 10; if istest - assert(relControl < opts.ri.res_tol, ... - 'MESS:TEST:accuracy','unexpectedly inaccurate result'); - assert(relFilter < opts.ri.res_tol, ... - 'MESS:TEST:accuracy','unexpectedly inaccurate result'); + mess_assert(opts, relControl < opts.ri.res_tol * safety, ... + 'TEST:accuracy', 'unexpectedly inaccurate result'); + mess_assert(opts, relFilter < opts.ri.res_tol * safety, ... + 'TEST:accuracy', 'unexpectedly inaccurate result'); end diff --git a/DEMOS/RI/DEMO_RI_T_HYBRID.m b/DEMOS/RI/DEMO_RI_T_HYBRID.m index a7ad905..14b69f8 100644 --- a/DEMOS/RI/DEMO_RI_T_HYBRID.m +++ b/DEMOS/RI/DEMO_RI_T_HYBRID.m @@ -1,125 +1,129 @@ -function DEMO_RI_T_HYBRID(istest) -% Computes the solution of the Hinf Riccati equation for a random generated -% generalized system. The computations are done using the Newton method for -% the LQG step and afterwards the RADI. Afterwards, the real residual -% norm is shown and compared to the set tolerance. -% -% Input: -% istest decides whether the function runs as an interactive demo or a -% continuous integration test. (optional; defaults to 0, i.e. -% interactive demo) -% - -% -% This file is part of the M-M.E.S.S. project -% (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. -% All rights reserved. -% License: BSD 2-Clause License (see COPYING) -% - -%% -if nargin<1, istest=0; end - -%% Construction of system data. -if exist('OCTAVE_VERSION', 'builtin') - rand('seed', 1.0); %#ok - eqn.A_ = rand(500) - 250 * eye(500); - - rand('seed', 2.0); %#ok - eqn.B2 = rand(500, 2); - rand('seed', 3.0); %#ok - B1 = rand(500, 2); - - rand('seed', 4.0); %#ok - eqn.C2 = rand(3, 500); - rand('seed', 5.0); %#ok - C1 = rand(3, 500); -else - rng(1.0); - eqn.A_ = rand(500) - 250 * eye(500); - - rng(2.0); - eqn.B2 = rand(500, 2); - rng(3.0); - B1 = rand(500, 2); - - rng(4.0); - eqn.C2 = rand(3, 500); - rng(5.0); - C1 = rand(3, 500); -end - -gam = 5; % Scaling term for disturbances. - -%% Set operator. -oper = operatormanager('default'); - -%% Construction of options struct. -% ADI settings. -opts.adi.maxiter = 200; -opts.adi.res_tol = 1.0e-12; -opts.adi.rel_diff_tol = 0; -opts.adi.info = 1; -opts.adi.compute_sol_fac = 1; -opts.adi.accumulateK = 0; -opts.adi.accumulateDeltaK = 0; - -% Shift options. -opts.shifts.num_desired = 5; -opts.shifts.method = 'projection'; - -% % NM settings. -opts.nm.maxiter = 50; -opts.nm.res_tol = 1.0e-10; -opts.nm.rel_diff_tol = 1.0e-12; -opts.nm.info = 1; -opts.nm.linesearch = 0; -opts.nm.accumulateRes = 1; - -% NM projection settings. -opts.nm.projection = []; -opts.nm.projection.freq = 0; -opts.nm.res.maxiter = 10; -opts.nm.res.tol = 1.0e-06; -opts.nm.res.orth = 1; - -% RADI settings. -opts.radi.maxiter = opts.adi.maxiter; -opts.radi.res_tol = opts.nm.res_tol; -opts.radi.rel_diff_tol = 1.0e-16; -opts.radi.info = 1; - -% RI settings. -opts.ri.riccati_solver = 'radi'; -opts.ri.lqg_solver = 'newton'; -opts.ri.maxiter = 10; -opts.ri.res_tol = 1.0e-10; -opts.ri.rel_diff_tol = 1.0e-16; -opts.ri.compres_tol = 1.0e-16; -opts.ri.info = 1; - -% global options -opts.norm = 2; - -% %% Call Riccati iteration with Newton solver. -t_RI_call = tic; -eqn.type = 'T'; -eqn.B1 = 1/gam * B1; -eqn.C1 = C1; -[out, eqn, opts, ~] = mess_lrri(eqn, opts, oper); -t_elapsed = toc(t_RI_call); -fprintf(1,'mess_lrri took %6.2f seconds \n' , t_elapsed); - -%% Compute real residuals. -abserr = norm(eqn.A_' * (out.Z * out.Z') + (out.Z * out.Z') * eqn.A_ ... - + (out.Z * out.Z') * (1/gam^2 * (B1 * B1') ... - - eqn.B2 * eqn.B2') * (out.Z * out.Z') + C1' * C1, 2); -relerr = abserr / norm(C1 * C1', 2); -fprintf(1, '\nset tolerance vs. real residual: %e | %e\n', ... - opts.ri.res_tol, relerr); - -if istest - assert(relerr < opts.ri.res_tol, ... - 'MESS:TEST:accuracy','unexpectedly inaccurate result'); -end +function DEMO_RI_T_HYBRID(istest) +% Computes the solution of the Hinf Riccati equation for a random generated +% generalized system. The computations are done using the Newton method for +% the LQG step and afterwards the RADI. Afterwards, the real residual +% norm is shown and compared to the set tolerance. +% +% Input: +% istest decides whether the function runs as an interactive demo or a +% continuous integration test. (optional; defaults to 0, i.e. +% interactive demo) +% + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +%% +if nargin < 1 + istest = false; +end + +%% Construction of system data. +if exist('OCTAVE_VERSION', 'builtin') + rand('seed', 1.0); %#ok + eqn.A_ = rand(500) - 250 * eye(500); + + rand('seed', 2.0); %#ok + eqn.B2 = rand(500, 2); + rand('seed', 3.0); %#ok + B1 = rand(500, 2); + + rand('seed', 4.0); %#ok + eqn.C2 = rand(3, 500); + rand('seed', 5.0); %#ok + C1 = rand(3, 500); +else + rng(1.0); + eqn.A_ = rand(500) - 250 * eye(500); + + rng(2.0); + eqn.B2 = rand(500, 2); + rng(3.0); + B1 = rand(500, 2); + + rng(4.0); + eqn.C2 = rand(3, 500); + rng(5.0); + C1 = rand(3, 500); +end + +gam = 5; % Scaling term for disturbances. + +%% Set operator. +opts = struct(); +[oper, opts] = operatormanager(opts, 'default'); + +%% Construction of options struct. +% ADI settings. +opts.adi.maxiter = 200; +opts.adi.res_tol = 1.0e-12; +opts.adi.rel_diff_tol = 0; +opts.adi.info = 1; +opts.adi.compute_sol_fac = true; +opts.adi.accumulateK = false; +opts.adi.accumulateDeltaK = false; + +% Shift options. +opts.shifts.num_desired = 5; +opts.shifts.method = 'projection'; + +% % NM settings. +opts.nm.maxiter = 50; +opts.nm.res_tol = 1.0e-10; +opts.nm.rel_diff_tol = 1.0e-12; +opts.nm.info = 1; +opts.nm.linesearch = false; +opts.nm.accumulateRes = true; + +% NM projection settings. +opts.nm.projection = []; +opts.nm.projection.freq = 0; +opts.nm.res.maxiter = 10; +opts.nm.res.tol = 1.0e-06; +opts.nm.res.orth = true; + +% RADI settings. +opts.radi.maxiter = opts.adi.maxiter; +opts.radi.res_tol = opts.nm.res_tol; +opts.radi.rel_diff_tol = 1.0e-16; +opts.radi.info = 1; + +% RI settings. +opts.ri.riccati_solver = 'radi'; +opts.ri.lqg_solver = 'newton'; +opts.ri.maxiter = 10; +opts.ri.res_tol = 1.0e-10; +opts.ri.rel_diff_tol = 1.0e-16; +opts.ri.compres_tol = 1.0e-16; +opts.ri.info = 1; + +% global options +opts.norm = 2; + +% %% Call Riccati iteration with Newton solver. +t_RI_call = tic; +eqn.type = 'T'; +eqn.B1 = 1 / gam * B1; +eqn.C1 = C1; +[out, eqn, opts, ~] = mess_lrri(eqn, opts, oper); +t_elapsed = toc(t_RI_call); +mess_fprintf(opts, 'mess_lrri took %6.2f seconds \n', t_elapsed); + +%% Compute real residuals. +abserr = norm(eqn.A_' * (out.Z * out.Z') + (out.Z * out.Z') * eqn.A_ + ... + (out.Z * out.Z') * (1 / gam^2 * (B1 * B1') - ... + eqn.B2 * eqn.B2') * ... + (out.Z * out.Z') + C1' * C1, 2); +relerr = abserr / norm(C1 * C1', 2); +mess_fprintf(opts, '\nset tolerance vs. real residual: %e | %e\n', ... + opts.ri.res_tol, relerr); + +if istest + mess_assert(opts, relerr < opts.ri.res_tol, ... + 'TEST:accuracy', 'unexpectedly inaccurate result'); +end diff --git a/DEMOS/Rail/ARE_rail.m b/DEMOS/Rail/ARE_rail.m new file mode 100644 index 0000000..8e7567f --- /dev/null +++ b/DEMOS/Rail/ARE_rail.m @@ -0,0 +1,341 @@ +function ARE_rail(k, shifts, inexact, Galerkin, type, istest) +% Computes the optimal feedback via the low-rank Newton-ADI [1] and RADI +% [2] methods for the selective cooling of Steel profiles application +% described in [3,4,5]. +% +% Usage: ARE_Rail(k,shifts,inexact,Galerkin,istest) +% +% Inputs: +% +% k refinement level of the model to use +% (0 - 5, i.e. 109 - 79841 Dofs) +% (optional, defaults to 2, i.e. 1357 Dofs) +% +% shifts ADI shift selection strategy. Possible values: +% 'heur' Penzl's heuristic shifts +% 'Wachspress' Wachspress shifts, optimally solving the dense +% shift selection problem. +% (optional, defaults to 'heur') +% +% inexact use inexact Newton method +% (optional, defaults to 0, i.e. false) +% +% Galerkin activate Galerkin projection acceleration in Newton method. +% This supersedes inexact Newton selection, i.e, disables it in +% case both are on. +% (optional, defaults to 0, i.e. no Galerkin acceleration) +% +% type selector for the type of equation solved: +% 'LQR' classic LQR ARE with Q=I, R=I and opts.LDL_T=false +% 'Hinf' robust control type ARE with Q=I, +% R=diag([1,1,1,1,-4,-4,-4]) and opts.LDL_T=true +% 'BR' ARE with Q=I and R=-0.2401 I and opts.LDL_T=true as +% appearing in bounded real balanced truncation +% (optional, defaults to 'LQR') +% +% istest flag to determine whether this demo runs as a CI test or +% interactive demo +% (optional, defaults to 0, i.e. interactive demo) +% +% References: +% [1] P. Benner, J.-R. Li, T. Penzl, Numerical solution of large-scale +% Lyapunov equations, Riccati equations, and linear-quadratic optimal +% control problems, Numer. Lin. Alg. Appl. 15 (9) (2008) 755–777. +% https://doi.org/10.1002/nla.622 +% +% [2] P. Benner, Z. Bujanović, P. Kürschner, J. Saak, RADI: A low-rank +% ADI-type algorithm for large scale algebraic Riccati equations, +% Numer. Math. 138 (2) (2018) 301–330. +% https://doi.org/10.1007/s00211-017-0907-5 +% +% [3] J. Saak, Effiziente numerische Lösung eines +% Optimalsteuerungsproblems für die Abkühlung von Stahlprofilen, +% Diplomarbeit, Fachbereich 3/Mathematik und Informatik, Universität +% Bremen, D-28334 Bremen (Sep. 2003). +% https://doi.org/10.5281/zenodo.1187040 +% +% [4] P. Benner, J. Saak, A semi-discretized heat transfer model for +% optimal cooling of steel profiles, in: P. Benner, V. Mehrmann, D. +% Sorensen (Eds.), Dimension Reduction of Large-Scale Systems, Vol. 45 +% of Lecture Notes in Computational Science and Engineering, +% Springer-Verlag, Berlin/Heidelberg, Germany, 2005, pp. 353–356. +% https://doi.org/10.1007/3-540-27909-1_19 +% +% [5] J. Saak, Efficient numerical solution of large scale algebraic matrix +% equations in PDE control and model order reduction, Dissertation, +% Technische Universität Chemnitz, Chemnitz, Germany (Jul. 2009). +% URL http://nbn-resolving.de/urn:nbn:de:bsz:ch1-200901642 +% + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +%% +narginchk(0, 6); +if nargin < 1 + k = 2; +end +if nargin < 2 + shifts = 'heur'; +end +if nargin < 3 + inexact = false; +end +if nargin < 4 + Galerkin = false; +end +if nargin < 5 + istest = false; +end +if nargin < 6 + type = 'LQR'; +end + +%% set operation +[oper, opts] = operatormanager(struct(), 'default'); +%% Problem data + +eqn = mess_get_linear_rail(k); +switch type + case 'LQR' + opts.LDL_T = false; + eqn.R = eye(size(eqn.B, 2)); % only used in here + + case 'Hinf' + opts.LDL_T = true; + eqn.Q = eye(size(eqn.C, 1)); + eqn.R = diag([1, 1, 1, 1, -4, -4, -4]); + + case 'BR' + opts.LDL_T = true; + eqn.Q = eye(size(eqn.C, 1)); + eqn.R = -0.2401 * eye(size(eqn.B, 2)); + +end + +if opts.LDL_T + mytitle = '0 = C^T Q C + A^T X E + E^T X A - E^T X B R^{-1} B^T X E'; +else + mytitle = '0 = C^T C + A^T X E + E^T X A - E^T X BB^T X E'; +end + +%% +% First we run the Newton-ADI Method + +% ADI tolerances and maximum iteration number +opts.adi.maxiter = 100; +opts.adi.res_tol = 1e-14; +opts.adi.rel_diff_tol = 1e-16; +opts.adi.info = 0; + +eqn.type = 'T'; + +%% +% Heuristic shift parameters via basic Arnoldi +opts.shifts.num_desired = 25; +opts.shifts.num_Ritz = 50; +opts.shifts.num_hRitz = 25; +n = oper.size(eqn, opts); +opts.shifts.b0 = ones(n, 1); +switch lower(shifts) + + case 'heur' + opts.shifts.method = 'heur'; + + case 'wachspress' + opts.shifts.method = 'wachspress'; + opts.shifts.wachspress = 'T'; + + case 'projection' + opts.shifts.method = 'projection'; +end +%% +% Newton tolerances and maximum iteration number +opts.nm.maxiter = 20; +opts.nm.res_tol = 1e-12; +opts.nm.rel_diff_tol = 1e-16; +if istest + opts.nm.info = 0; +else + opts.nm.info = 1; +end + +opts.nm.accumulateRes = true; +opts.norm = 'fro'; + +if Galerkin + opts.nm.linesearch = false; + opts.nm.inexact = false; + opts.nm.projection.freq = 2; + opts.nm.projection.ortho = true; +elseif inexact + opts.nm.linesearch = true; + opts.nm.inexact = 'quadratic'; + opts.nm.projection.freq = 0; + opts.nm.projection.ortho = false; +else + opts.nm.linesearch = false; + opts.nm.inexact = false; + opts.nm.projection.freq = 0; + opts.nm.projection.ortho = false; +end +opts.nm.res = struct('maxiter', 10, 'tol', 1e-6, 'orth', 0); +%% +t_mess_lrnm = tic; +outnm = mess_lrnm(eqn, opts, oper); +t_elapsed1 = toc(t_mess_lrnm); +if not(istest) + mess_fprintf(opts, 'mess_lrnm took %6.2f seconds \n', t_elapsed1); +end + +if istest + if min(outnm.res) >= opts.nm.res_tol + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result'); + end +else + figure(1); + semilogy(outnm.res, 'LineWidth', 3); + title(mytitle); + xlabel('number of iterations'); + ylabel('normalized residual norm'); + pause(1); + mess_fprintf(opts, 'size outnm.Z: %d x %d\n\n', ... + size(outnm.Z, 1), size(outnm.Z, 2)); +end + +%% +% Lets try the RADI method and compare + +% RADI-MESS settings +opts.shifts.history = opts.shifts.num_desired * size(eqn.C, 1); +opts.shifts.num_desired = opts.shifts.num_desired; + +% choose either of the three shift methods, here +opts.shifts.method = 'gen-ham-opti'; +% opts.shifts.method = 'heur'; +% opts.shifts.method = 'projection'; + +opts.shifts.naive_update_mode = false; % .. Suggest false +% (smart update is faster; +% convergence is the same). +opts.radi.compute_sol_fac = true; +opts.radi.get_ZZt = true; +opts.radi.maxiter = opts.adi.maxiter; +opts.norm = 2; +opts.radi.res_tol = opts.nm.res_tol; +opts.radi.rel_diff_tol = 0; +if istest + opts.radi.info = 0; +else + opts.radi.info = 1; +end + +t_mess_lrradi = tic; +outradi = mess_lrradi(eqn, opts, oper); +t_elapsed2 = toc(t_mess_lrradi); + +if not(istest) + mess_fprintf(opts, 'mess_lrradi took %6.2f seconds \n', t_elapsed2); +end + +if istest + if min(outnm.res) >= opts.nm.res_tol + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result'); + end +else + figure(2); + semilogy(outradi.res, 'LineWidth', 3); + title(mytitle); + xlabel('number of iterations'); + ylabel('normalized residual norm'); + mess_fprintf(opts, 'size outradi.Z: %d x %d\n\n', ... + size(outradi.Z, 1), size(outradi.Z, 2)); +end + +%% compare +if not(istest) + figure(3); + ls_nm = [outnm.adi.niter]; + ls_radi = 1:outradi.niter; + + semilogy(cumsum(ls_nm), outnm.res, 'k--', ... + ls_radi, outradi.res, 'b-', ... + 'LineWidth', 3); + + title(mytitle); + xlabel('number of solves with A+p*M'); + ylabel('normalized residual norm'); + legend('LR-NM', 'RADI'); +end + +if opts.LDL_T + [ZN, DN] = mess_column_compression(outnm.Z, 'N', outnm.D, eps, not(istest)); + ZN = ZN * diag(sqrt(diag(DN))); + + [ZR, DR] = mess_column_compression(outradi.Z, 'N', outradi.D, eps, ... + not(istest)); + ZR = ZR * diag(sqrt(diag(DR))); + +else + ZN = outnm.Z; + ZR = outradi.Z; +end + +D = blkdiag(eye(size(ZN, 2)), -eye(size(ZR, 2))); + +Z = [ZN ZR]; +f = @(x) (Z * (D * (Z' * x))); + +if k < 4 + if exist('icare', 'file') + X = icare(full(eqn.A_), eqn.B, eqn.C' * eqn.C, eqn.R, [], full(eqn.E_), []); + elseif exist('care', 'file') + X = care(full(eqn.A_), eqn.B, eqn.C' * eqn.C, eqn.R, [], full(eqn.E_)); + else + X = ZN * ZN'; + end + + relerr = norm(ZN * ZN' - ZR * ZR') / norm(ZN * ZN'); + relerr(2) = max(abs(eigs(f, size(Z, 1)))) / norm(ZN' * ZN); + relerr(3) = norm(X - ZN * ZN') / norm(X); + relerr(4) = norm(X - ZR * ZR') / norm(X); +else + + relerr = max(abs(eigs(f, size(Z, 1)))) / norm(ZN' * ZN); + +end + +if istest + if any(relerr(1:2) > 1e-6) + % for large examples relerr computations appear to become unstable, + % hence the comparably large tolerance + mess_fprintf(opts, '%s %g %g %g %g\n', type, relerr); + mess_err(opts, 'TEST:accuracy', ... + 'Newton and RADI solution approximations deviate too much.'); + + end +else + if k < 4 + mess_fprintf(opts, ... + ['relative deviation of the two solution ', ... + 'approximations:\n%g (dense 2 norm) ', ... + '%g (low-rank approx 2-norm)\n'], ... + relerr(1), relerr(2)); + if exist('icare', 'file') || exist('care', 'file') + mess_fprintf(opts, ... + ['relative deviation of the two solution ', ... + 'approximations from (i)care''s solution:\n', ... + '%g (NM) %g (RADI)\n'], ... + relerr(3), relerr(4)); + end + else + mess_fprintf(opts, ['relative deviation of the two solution ', ... + 'approximations: % g\n'], ... + relerr); + end +end diff --git a/DEMOS/Rail/HINFR_rail.m b/DEMOS/Rail/HINFR_rail.m index 7d777c9..338648f 100644 --- a/DEMOS/Rail/HINFR_rail.m +++ b/DEMOS/Rail/HINFR_rail.m @@ -34,7 +34,7 @@ function HINFR_rail(k, istest) % [4] P. Benner, J. Saak, A semi-discretized heat transfer model for % optimal cooling of steel profiles, in: P. Benner, V. Mehrmann, D. % Sorensen (Eds.), Dimension Reduction of Large-Scale Systems, Vol. 45 -% of Lect. Notes Comput. Sci. Eng., Springer-Verlag, Berlin/Heidelberg, +% of Lecture Notes in Computational Science and Engineering, Springer-Verlag, Berlin/Heidelberg, % Germany, 2005, pp. 353–356. https://doi.org/10.1007/3-540-27909-1_19 % % [5] J. Saak, Efficient numerical solution of large scale algebraic matrix @@ -44,21 +44,25 @@ function HINFR_rail(k, istest) % % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% -narginchk(0,2); -if nargin<1, k=2; end -if nargin<2, istest=0; end +narginchk(0, 2); +if nargin < 1 + k = 2; +end +if nargin < 2 + istest = false; +end %% set operation -oper = operatormanager('default'); +opts = struct(); +[oper, opts] = operatormanager(opts, 'default'); %% Problem data eqn = mess_get_linear_rail(k); @@ -66,9 +70,8 @@ function HINFR_rail(k, istest) eqn.B1 = eqn.B; eqn.B2 = eqn.B; eqn.C1 = eqn.C; -eqn = rmfield(eqn,'B'); -eqn = rmfield(eqn,'C'); - +eqn = rmfield(eqn, 'B'); +eqn = rmfield(eqn, 'C'); %% Optional parameters. opts.norm = 2; @@ -77,13 +80,13 @@ function HINFR_rail(k, istest) opts.shifts.num_desired = 5; % choose either of the three shift methods, here opts.shifts.method = 'gen-ham-opti'; -%opts.shifts.method = 'heur'; -%opts.shifts.method = 'projection'; +% opts.shifts.method = 'heur'; +% opts.shifts.method = 'projection'; % RADI settings opts.shifts.naive_update_mode = false; % .. Suggest false (smart update is faster; convergence is the same). -opts.radi.compute_sol_fac = 1; -opts.radi.get_ZZt = 1; +opts.radi.compute_sol_fac = true; +opts.radi.get_ZZt = true; opts.radi.maxiter = 200; opts.radi.res_tol = 1.0e-10; opts.radi.rel_diff_tol = 1.0e-16; @@ -100,22 +103,24 @@ function HINFR_rail(k, istest) %% Solve the equation. eqn.type = 'T'; gam = 10; -eqn.B1 = 1/gam * eqn.B1; +eqn.B1 = 1 / gam * eqn.B1; t_mess_lrri = tic; out = mess_lrri(eqn, opts, oper); t_elapsed = toc(t_mess_lrri); -fprintf(1,'mess_lrri took %6.2f seconds \n' , t_elapsed ); +mess_fprintf(opts, 'mess_lrri took %6.2f seconds \n', t_elapsed); %% Residual behavior. if istest if min(out.res) >= opts.ri.res_tol - error('MESS:TEST:accuracy','unexpectedly inaccurate result'); - end + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result'); + end else figure(1); - semilogy(out.res,'LineWidth',3); + semilogy(out.res, 'LineWidth', 3); hold on; - for i = 1:length(out.radi), semilogy(out.radi(i).res,'LineWidth',3); end + for i = 1:length(out.radi) + semilogy(out.radi(i).res, 'LineWidth', 3); + end hold off; title(['0= C_1^T C_1 + A^T X E + E^T X A + E^T X (\gamma^{-2}B_1 ' ... 'B_1^T - B_2 B_2^T) X E']); @@ -123,5 +128,5 @@ function HINFR_rail(k, istest) ylabel('normalized residual norm'); legend('Riccati Iteration', 'RADI (step 1)', 'RADI (step 2)'); end -disp('size out.Z:'); -disp(size(out.Z)); +mess_fprintf(opts, 'size out.Z: %d x %d\n', ... + size(out.Z, 1), size(out.Z, 2)); diff --git a/DEMOS/Rail/IRKA_rail.m b/DEMOS/Rail/IRKA_rail.m index 333df1c..146a0cf 100644 --- a/DEMOS/Rail/IRKA_rail.m +++ b/DEMOS/Rail/IRKA_rail.m @@ -1,4 +1,4 @@ -function [Er,Ar,Br,Cr] = IRKA_rail(k,r,istest) +function [Er, Ar, Br, Cr] = IRKA_rail(k, r, istest) % Computes a locally H2-optimal reduced order model of order r for % the selective cooling of Steel profiles application described in % [1,2,3] via the tangential IRKA method. @@ -28,7 +28,7 @@ % [2] P. Benner, J. Saak, A semi-discretized heat transfer model for % optimal cooling of steel profiles, in: P. Benner, V. Mehrmann, D. % Sorensen (Eds.), Dimension Reduction of Large-Scale Systems, Vol. 45 -% of Lect. Notes Comput. Sci. Eng., Springer-Verlag, Berlin/Heidelberg, +% of Lecture Notes in Computational Science and Engineering, Springer-Verlag, Berlin/Heidelberg, % Germany, 2005, pp. 353–356. https://doi.org/10.1007/3-540-27909-1_19 % % [3] J. Saak, Efficient numerical solution of large scale algebraic matrix @@ -42,62 +42,72 @@ % https://doi.org/10.1137/060666123 % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % %% Load matrix data -if nargin<1 - k=2; +if nargin < 1 + k = 2; end eqn = mess_get_linear_rail(k); %% register corresponding usfs -oper = operatormanager('default'); +opts = struct(); +[oper, opts] = operatormanager(opts, 'default'); %% collect IRKA parameters -if nargin<2 +if nargin < 2 + opts.irka.r = 20; + else + opts.irka.r = r; + end if nargin < 3 - istest = 0; + istest = false; end -opts.irka.maxiter =100; + +opts.irka.maxiter = 100; opts.irka.shift_tol = 1e-3; -opts.irka.h2_tol = 1e-6; +opts.irka.h2_tol = 1e-6; + if istest + opts.irka.info = 1; + else + opts.irka.info = 3; + end + opts.irka.init = 'logspace'; %% Run IRKA -[Er,Ar,Br,Cr] = mess_tangential_irka(eqn, opts, oper); +[Er, Ar, Br, Cr, ~, outinfo] = mess_tangential_irka(eqn, opts, oper); -if istest - [~, ID] = lastwarn; - lastwarn(''); - if strcmp(ID,'MESS:IRKA:convergence') - error('IRKA converged unexpectedly slow'); - end +if istest && isequal(outinfo.term_flag, 'maxiter') + mess_err(opts, 'convergence', 'IRKA converged unexpectedly slow'); end +%% In case this is a CI test and the sparss class is available (recent MATLAB) +% try the same again with that. +if istest && exist('sparss', 'class') -if exist('sparss','class') sys = sparss(eqn.A_, eqn.B, eqn.C, [], eqn.E_); - [Er,Ar,Br,Cr] = mess_tangential_irka(sys,opts); - if istest - [~, ID] = lastwarn; - lastwarn(''); - if strcmp(ID,'MESS:IRKA:convergence') - error('IRKA converged unexpectedly slow'); - end + + [Er, Ar, Br, Cr, ~, outinfo] = mess_tangential_irka(sys, opts); + + if istest && isequal(outinfo.term_flag, 'maxiter') + + mess_err(opts, 'convergence', 'IRKA converged unexpectedly slow'); + end end diff --git a/DEMOS/Rail/KSM_Rail.m b/DEMOS/Rail/KSM_Rail.m new file mode 100644 index 0000000..d51025f --- /dev/null +++ b/DEMOS/Rail/KSM_Rail.m @@ -0,0 +1,220 @@ +function KSM_Rail(k, type, transformed, eqtype, SISO, space, istest) +% KSM_RAIL solves Lyapunov or Riccati equations for the revised +% Oberwolfach steel profile benchmark problem. +% +% INPUTS: +% k refinement level for the rail data. See +% mess_get_linear_rail for allowed values. +% (optional, default: 1) +% +% type selects Lyapunov ('LE') or Riccati ('CARE') equation +% +% transformed number of degrees of freedom per spatial +% direction, i.e. problem size is n^2 +% (optional, default: 50) +% +% eqntype selects primal ('N') or dual ('T') equation +% (optional, default: 'N') +% +% space the type of Krylov subspace to use. +% 'EK' extended Krylov +% 'RK' rational Krylov +% (optional, default: 'RK') +% +% istest only used on our continuous integration +% infrastructure. Adds another accuracy check when true. +% (optional, default: 'false') +% +% OUTPUTS: none +% + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +if nargin < 7 + istest = false; +end + +if nargin < 6 + space = 'EK'; +end + +if nargin < 1 + k = 1; +end +% fetch rail model of appropriate size +eqn = mess_get_linear_rail(k); +eqn.haveE = true; + +if nargin < 5 + SISO = false; +end +% For the SISO test pick one column of B and one row of C +if SISO + eqn.B = sum(eqn.B, 2); + eqn.C = sum(eqn.C, 1); +end + +%% +if nargin < 3 + transformed = false; +end +if transformed + % Note that this is for demonstration purposes only and should never be + % done explicitly, otherwise. + eqn.A_ = eqn.E_ \ eqn.A_; + eqn.B = eqn.E_ \ eqn.B; + eqn.haveE = false; + eqn.E_ = speye(size(eqn.A_, 1)); +end + +%% +% set operation +% the Krylov projection method require E = I so we currently make +% them require the state_space_transformed_default usfs, which +% work on a transformed version of the system without forming the +% transformed matrices. +opts = struct(); +[oper, opts] = operatormanager(opts, 'state_space_transformed_default'); + +%% +if nargin < 4 + eqtype = 'N'; +end +eqn.type = eqtype; +opts.KSM.maxiter = 100; +opts.KSM.res_tol = 1e-6; +opts.KSM.comp_res = 1; +opts.KSM.space = space; +switch space + case 'RK' + opts.KSM.type_shifts = 'real'; +end + +if nargin < 2 + type = 'CARE'; +elseif strcmp(type, 'LE') && strcmp(type, 'CARE') + mess_err(opts, 'illegal_input', ... + 'type must be either ''LE'' or ''CARE'''); +end +opts.KSM.type_eqn = type; +opts.KSM.CARE_shifts = 'Ritz'; +opts.KSM.symmetric = true; +opts.KSM.trunc_tol = 1e-17; +opts.KSM.trunc_info = 1; +opts.KSM.explicit_proj = false; + +opts.KSM.info = 1; + +opts.norm = 'fro'; + +mess_fprintf(opts, '\n'); +mess_fprintf(opts, 'Computing solution factors\n'); + +t_KSM = tic; +[out, eqn, opts, ~] = mess_KSM(eqn, opts, oper); +toc(t_KSM); +%% +% this shouldn't be computed for large problems +if k > 4 + return +end + +X = out.Z * out.D * out.Z'; +mess_fprintf(opts, '\n'); % \n at the beginning of a string breaks +% spellchecking + +mess_fprintf(opts, ... + ['The final internal and real normalized residual norms ', ... + 'after %d iterations are:\n'], out.niter); + +if strcmp(eqn.type, 'T') + if strcmp(opts.KSM.type_eqn, 'CARE') + mess_fprintf(opts, '\n'); + nrm = norm(eqn.A_' * X + ... + X * eqn.A_ - ... + (X * eqn.B) * (eqn.B' * X) + ... + eqn.C' * eqn.C, 'fro') / ... + norm(eqn.C' * eqn.C, 'fro'); + mess_fprintf(opts, ['CARE Frobenius norm: %10g (real) \t %10g ', ... + '(internal)\n'], ... + nrm, out.res(end)); + + gnrm = norm(eqn.A_' * X * eqn.E_ + ... + eqn.E_' * X * eqn.A_ - ... + eqn.E_' * (X * eqn.B) * (eqn.B' * X) * eqn.E_ + ... + eqn.C' * eqn.C, 'fro') / ... + norm(eqn.C' * eqn.C, 'fro'); + mess_fprintf(opts, ['gCARE Frobenius norm: %10g (real) \t %10g ', ... + '(internal)\n'], ... + gnrm, out.res(end)); + else + mess_fprintf(opts, '\n'); + nrm = norm(eqn.A_' * X + X * eqn.A_ + eqn.C' * eqn.C, 'fro') / ... + norm(eqn.C' * eqn.C, 'fro'); + mess_fprintf(opts, ['LE Frobenius norm: %10g (real) \t %10g ', ... + '(internal)\n'], ... + nrm, out.res(end)); + + gnrm = norm(eqn.A_' * X * eqn.E_ + ... + eqn.E_' * X * eqn.A_ + ... + eqn.C' * eqn.C, 'fro') / ... + norm(eqn.C' * eqn.C, 'fro'); + mess_fprintf(opts, ['gLE Frobenius norm: %10g (real) \t %10g ', ... + '(internal)\n'], ... + gnrm, out.res(end)); + end +else + if strcmp(opts.KSM.type_eqn, 'CARE') + mess_fprintf(opts, '\n'); + nrm = norm(eqn.A_ * X + ... + X * eqn.A_' - ... + (X * eqn.C') * (eqn.C * X) + ... + eqn.B * eqn.B', 'fro') / ... + norm(eqn.B * eqn.B', 'fro'); + mess_fprintf(opts, ['CARE Frobenius norm: %10g (real) \t %10g ', ... + '(internal)\n'], ... + nrm, out.res(end)); + + gnrm = norm(eqn.A_ * X * eqn.E_' + ... + eqn.E_ * X * eqn.A_' - ... + eqn.E_ * (X * eqn.C') * (eqn.C * X) * eqn.E_' + ... + eqn.B * eqn.B', 'fro') / ... + norm(eqn.B * eqn.B', 'fro'); + mess_fprintf(opts, ['gCARE Frobenius norm: %10g (real) \t %10g ', ... + '(internal)\n'], ... + gnrm, out.res(end)); + else + mess_fprintf(opts, '\n'); + nrm = norm(eqn.A_ * X + X * eqn.A_' + eqn.B * eqn.B', 'fro') / ... + norm(eqn.B * eqn.B', 'fro'); + mess_fprintf(opts, ['LE Frobenius norm: %10g (real) \t %10g ' ... + '(internal)\n'], ... + nrm, out.res(end)); + + gnrm = norm(eqn.A_ * X * eqn.E_' + ... + eqn.E_ * X * eqn.A_' + ... + eqn.B * eqn.B', 'fro') / ... + norm(eqn.B * eqn.B', 'fro'); + mess_fprintf(opts, ... + 'gLE Frobenius norm: %10g (real) \t %10g (internal)\n', ... + gnrm, out.res(end)); + end +end + +if istest + if not(transformed) + if (abs(gnrm - out.res(end)) / gnrm) > 1e-4 + mess_err(opts, 'failure', 'test failed'); + end + else + if (abs(nrm - out.res(end)) / nrm) > 1e-4 + mess_err(opts, 'failure', 'test failed'); + end + end +end diff --git a/DEMOS/Rail/LQR_rail.m b/DEMOS/Rail/LQR_rail.m deleted file mode 100644 index 4c31d10..0000000 --- a/DEMOS/Rail/LQR_rail.m +++ /dev/null @@ -1,212 +0,0 @@ -function LQR_rail(k,shifts,inexact,Galerkin,istest) -% Computes the optimal feedback via the low-rank Newton-ADI [1] and RADI -% [2] methods for the selective cooling of Steel profiles application -% described in [3,4,5]. -% -% Usage: LQR_Rail(k,shifts,inexact,Galerkin,istest) -% -% Inputs: -% -% k refinement level of the model to use -% (0 - 5, i.e. 109 - 79841 Dofs) -% (optional, defaults to 2, i.e. 1357 Dofs) -% -% shifts ADI shift selection strategy. Possible values: -% 'heur' Penzl's heuristic shifts -% 'Wachspress' Wachspress shifts, optimally solving the dense -% shift selection problem. -% (optional, defaults to 'heur') -% -% inexact use inexact Newton method -% (optional, defaults to 0, i.e. false) -% -% Galerkin activate Galerkin projection acceleration in Newton method. -% This supersedes inexact Newton selection, i.e, disables it in -% case both are on. -% (optional, defaults to 0, i.e. no Galerkin acceleration) -% -% istest flag to determine whether this demo runs as a CI test or -% interactive demo -% (optional, defaults to 0, i.e. interactive demo) -% -% References: -% [1] P. Benner, J.-R. Li, T. Penzl, Numerical solution of large-scale -% Lyapunov equations, Riccati equations, and linear-quadratic optimal -% control problems, Numer. Lin. Alg. Appl. 15 (9) (2008) 755–777. -% https://doi.org/10.1002/nla.622 -% -% [2] P. Benner, Z. Bujanović, P. Kürschner, J. Saak, RADI: A low-rank -% ADI-type algorithm for large scale algebraic Riccati equations, -% Numer. Math. 138 (2) (2018) 301–330. -% https://doi.org/10.1007/s00211-017-0907-5 -% -% [3] J. Saak, Effiziente numerische Lösung eines -% Optimalsteuerungsproblems für die Abkühlung von Stahlprofilen, -% Diplomarbeit, Fachbereich 3/Mathematik und Informatik, Universität -% Bremen, D-28334 Bremen (Sep. 2003). -% https://doi.org/10.5281/zenodo.1187040 -% -% [4] P. Benner, J. Saak, A semi-discretized heat transfer model for -% optimal cooling of steel profiles, in: P. Benner, V. Mehrmann, D. -% Sorensen (Eds.), Dimension Reduction of Large-Scale Systems, Vol. 45 -% of Lect. Notes Comput. Sci. Eng., Springer-Verlag, Berlin/Heidelberg, -% Germany, 2005, pp. 353–356. https://doi.org/10.1007/3-540-27909-1_19 -% -% [5] J. Saak, Efficient numerical solution of large scale algebraic matrix -% equations in PDE control and model order reduction, Dissertation, -% Technische Universität Chemnitz, Chemnitz, Germany (Jul. 2009). -% URL http://nbn-resolving.de/urn:nbn:de:bsz:ch1-200901642 -% - -% -% This file is part of the M-M.E.S.S. project -% (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. -% All rights reserved. -% License: BSD 2-Clause License (see COPYING) -% - - -%% -narginchk(0,5); -if nargin<1, k=2; end -if nargin<2, shifts='heur'; end -if nargin<3, inexact=0; end -if nargin<4, Galerkin=0; end -if nargin<5, istest=0; end - -%% set operation -oper = operatormanager('default'); -%% Problem data - -eqn=mess_get_linear_rail(k); -%% -% First we run the Newton-ADI Method - - -% ADI tolerances and maximum iteration number -opts.adi.maxiter = 100; -opts.adi.res_tol = 1e-14; -opts.adi.rel_diff_tol = 1e-16; -opts.adi.info = 1; - -eqn.type = 'T'; - - -%% -%Heuristic shift parameters via basic Arnoldi -opts.shifts.num_desired=25; -opts.shifts.num_Ritz=50; -opts.shifts.num_hRitz=25; -n=oper.size(eqn, opts); -opts.shifts.b0=ones(n,1); -switch lower(shifts) - - case 'heur' - opts.shifts.method = 'heur'; - - case 'wachspress' - opts.shifts.method = 'wachspress'; - opts.shifts.wachspress = 'T'; -end -%% -% Newton tolerances and maximum iteration number -opts.nm.maxiter = 8; -opts.nm.res_tol = 1e-10; -opts.nm.rel_diff_tol = 1e-16; -opts.nm.info = 1; -opts.nm.accumulateRes = 1; -opts.norm = 'fro'; - -if Galerkin - opts.nm.linesearch = 0; - opts.nm.inexact = 0; - opts.nm.projection.freq=2; - opts.nm.projection.ortho=1; -elseif inexact - opts.nm.linesearch = 1; - opts.nm.inexact = 'quadratic'; - opts.nm.projection.freq=0; - opts.nm.projection.ortho=0; -else - opts.nm.linesearch = 0; - opts.nm.inexact = 0; - opts.nm.projection.freq=0; - opts.nm.projection.ortho=0; -end -opts.nm.res=struct('maxiter',10,'tol',1e-6,'orth',0); -%% -t_mess_lrnm = tic; -outnm = mess_lrnm(eqn, opts, oper); -t_elapsed1 = toc(t_mess_lrnm); -fprintf(1,'mess_lrnm took %6.2f seconds \n' , t_elapsed1); - -if istest - if min(outnm.res)>=opts.nm.res_tol - error('MESS:TEST:accuracy','unexpectedly inaccurate result'); - end -else - figure(1); - disp(outnm.res); - semilogy(outnm.res,'LineWidth',3); - title('0= C^TC + A^T X M + M^TXA -M^TXBB^T X M'); - xlabel('number of iterations'); - ylabel('normalized residual norm'); - pause(1); -end - -disp('size outnm.Z:'); -disp(size(outnm.Z)); - -%% -% Lets try the RADI method and compare - -% RADI-MESS settings -opts.shifts.history = opts.shifts.num_desired*size(eqn.C,1); -opts.shifts.num_desired = opts.shifts.num_desired; - -% choose either of the three shift methods, here -opts.shifts.method = 'gen-ham-opti'; -%opts.shifts.method = 'heur'; -%opts.shifts.method = 'projection'; - -opts.shifts.naive_update_mode = false; % .. Suggest false (smart update is faster; convergence is the same). -opts.radi.compute_sol_fac = 1; -opts.radi.get_ZZt = 1; -opts.radi.maxiter = opts.adi.maxiter; -opts.norm = 2; -opts.radi.res_tol = opts.nm.res_tol; -opts.radi.rel_diff_tol = 0; -opts.radi.info = 1; - -t_mess_lrradi = tic; -outradi = mess_lrradi(eqn, opts, oper); -t_elapsed2 = toc(t_mess_lrradi); -fprintf(1,'mess_lrradi took %6.2f seconds \n', t_elapsed2); - -if istest - if min(outnm.res)>=opts.nm.res_tol - error('MESS:TEST:accuracy','unexpectedly inaccurate result'); - end -else - figure(2); - semilogy(outradi.res,'LineWidth',3); - title('0= C^TC + A^T X M + M^TXA -M^TXBB^T X M'); - xlabel('number of iterations'); - ylabel('normalized residual norm'); -end -disp('size outradi.Z:'); -disp(size(outradi.Z)); - -%% compare -if not(istest) - figure(3); - ls_nm=[outnm.adi.niter]; - ls_radi=1:outradi.niter; - - semilogy(cumsum(ls_nm),outnm.res,'k--',ls_radi,outradi.res,'b-','LineWidth',3); - title('0= C^TC + A^T X M + M^TXA -M^TXBB^T X M'); - xlabel('number of solves with A+p*M'); - ylabel('normalized residual norm'); - legend('LR-NM','RADI'); -end diff --git a/DEMOS/Rail/LQR_rail_BDF.m b/DEMOS/Rail/LQR_rail_BDF.m index 6075029..e214e21 100644 --- a/DEMOS/Rail/LQR_rail_BDF.m +++ b/DEMOS/Rail/LQR_rail_BDF.m @@ -31,7 +31,7 @@ function LQR_rail_BDF(k) % [4] P. Benner, J. Saak, A semi-discretized heat transfer model for % optimal cooling of steel profiles, in: P. Benner, V. Mehrmann, D. % Sorensen (Eds.), Dimension Reduction of Large-Scale Systems, Vol. 45 -% of Lect. Notes Comput. Sci. Eng., Springer-Verlag, Berlin/Heidelberg, +% of Lecture Notes in Computational Science and Engineering, Springer-Verlag, Berlin/Heidelberg, % Germany, 2005, pp. 353356. https://doi.org/10.1007/3-540-27909-1_19 % % [5] J. Saak, Efficient numerical solution of large scale algebraic matrix @@ -43,20 +43,23 @@ function LQR_rail_BDF(k) % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % %% -narginchk(0,1); -if nargin<1, k = 2; end +narginchk(0, 1); +if nargin < 1 + k = 2; +end %% % set operation -oper = operatormanager('default'); +opts = struct(); +[oper, opts] = operatormanager(opts, 'default'); % Problem data -eqn=mess_get_linear_rail(1); +eqn = mess_get_linear_rail(1); %% opts.norm = 'fro'; @@ -65,21 +68,20 @@ function LQR_rail_BDF(k) opts.adi.res_tol = 1e-14; opts.adi.rel_diff_tol = 1e-16; opts.adi.info = 0; -opts.adi.compute_sol_fac = 1; +opts.adi.compute_sol_fac = true; opts.cc_info = 0; eqn.type = 'T'; - %% -%Heuristic shift parameters via basic Arnoldi -n=oper.size(eqn, opts); -opts.shifts.num_desired=7; -opts.shifts.num_Ritz=50; -opts.shifts.num_hRitz=25; +% Heuristic shift parameters via basic Arnoldi +n = oper.size(eqn, opts); +opts.shifts.num_desired = 7; +opts.shifts.num_Ritz = 50; +opts.shifts.num_hRitz = 25; opts.shifts.method = 'heur'; -opts.shifts.b0=ones(n,1); +opts.shifts.b0 = ones(n, 1); %% % Newton tolerances and maximum iteration number opts.nm.maxiter = 8; @@ -87,28 +89,28 @@ function LQR_rail_BDF(k) opts.nm.rel_diff_tol = 1e-16; opts.nm.info = 0; opts.norm = 'fro'; -opts.nm.accumulateRes = 1; -opts.nm.linesearch = 1; +opts.nm.accumulateRes = true; +opts.nm.linesearch = true; %% % BDF parameters -opts.bdf.time_steps = 0 : 50: 4500; +opts.bdf.time_steps = 0:50:4500; opts.bdf.step = k; opts.bdf.info = 1; opts.bdf.save_solution = 0; opts.bdf.startup_iter = 7; %% t_mess_bdf_dre = tic; -[out_bdf]=mess_bdf_dre(eqn,opts,oper); +[out_bdf] = mess_bdf_dre(eqn, opts, oper); t_elapsed = toc(t_mess_bdf_dre); -fprintf(1,'mess_bdf_dre took %6.2f seconds \n' , t_elapsed); +mess_fprintf(opts, 'mess_bdf_dre took %6.2f seconds \n', t_elapsed); %% -y = zeros(1,length(out_bdf.Ks)); -for i=1:length(out_bdf.Ks) - y(i) = out_bdf.Ks{i}(1,77); +y = zeros(1, length(out_bdf.Ks)); +for i = 1:length(out_bdf.Ks) + y(i) = out_bdf.Ks{i}(1, 77); end x = opts.bdf.time_steps; figure(1); -plot(x,y,'LineWidth',3); +plot(x, y, 'LineWidth', 3); title('evolution of component (1,77) of the optimal feedback'); diff --git a/DEMOS/Rail/LQR_rail_Rosenbrock.m b/DEMOS/Rail/LQR_rail_Rosenbrock.m index fe5e3a7..f1d36f7 100644 --- a/DEMOS/Rail/LQR_rail_Rosenbrock.m +++ b/DEMOS/Rail/LQR_rail_Rosenbrock.m @@ -31,7 +31,7 @@ function LQR_rail_Rosenbrock(k) % [4] P. Benner, J. Saak, A semi-discretized heat transfer model for % optimal cooling of steel profiles, in: P. Benner, V. Mehrmann, D. % Sorensen (Eds.), Dimension Reduction of Large-Scale Systems, Vol. 45 -% of Lect. Notes Comput. Sci. Eng., Springer-Verlag, Berlin/Heidelberg, +% of Lecture Notes in Computational Science and Engineering, Springer-Verlag, Berlin/Heidelberg, % Germany, 2005, pp. 353–356. https://doi.org/10.1007/3-540-27909-1_19 % % [5] J. Saak, Efficient numerical solution of large scale algebraic matrix @@ -43,16 +43,19 @@ function LQR_rail_Rosenbrock(k) % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % -narginchk(0,1); -if nargin<1, k=2; end +narginchk(0, 1); +if nargin < 1 + k = 2; +end %% % set operation -oper = operatormanager('default'); +opts = struct(); +[oper, opts] = operatormanager(opts, 'default'); % Problem data eqn = mess_get_linear_rail(0); @@ -63,35 +66,35 @@ function LQR_rail_Rosenbrock(k) opts.adi.res_tol = 1e-14; opts.adi.rel_diff_tol = 1e-16; opts.adi.info = 0; -opts.adi.compute_sol_fac = 1; -opts.adi.accumulateK = 1; +opts.adi.compute_sol_fac = true; +opts.adi.accumulateK = true; eqn.type = 'T'; %% -%Heuristic shift parameters via projection -opts.shifts.num_desired=7; +% Heuristic shift parameters via projection +opts.shifts.num_desired = 7; opts.shifts.method = 'projection'; %% % Rosenbrock parameters -opts.rosenbrock.time_steps = 0 : 50 : 4500; +opts.rosenbrock.time_steps = 0:50:4500; opts.rosenbrock.stage = k; opts.rosenbrock.info = 1; opts.rosenbrock.gamma = 1 + 1 / sqrt(2); -opts.rosenbrock.save_solution = 0; +opts.rosenbrock.save_solution = false; %% t_mess_rosenbrock_dre = tic; -[out_ros]=mess_rosenbrock_dre(eqn,opts,oper); +[out_ros] = mess_rosenbrock_dre(eqn, opts, oper); t_elapsed = toc(t_mess_rosenbrock_dre); -fprintf(1,'mess_rosenbrock_dre took %6.2f seconds \n',t_elapsed); +mess_fprintf(opts, 'mess_rosenbrock_dre took %6.2f seconds \n', t_elapsed); -y = zeros(1,length(out_ros.Ks)); -for i=1:length(out_ros.Ks) - y(i) = out_ros.Ks{i}(1,77); +y = zeros(1, length(out_ros.Ks)); +for i = 1:length(out_ros.Ks) + y(i) = out_ros.Ks{i}(1, 77); end x = opts.rosenbrock.time_steps; figure(1); -plot(x,y,'LineWidth',3); +plot(x, y, 'LineWidth', 3); title('evolution of component (1,77) of the optimal feedback'); xlabel('time'); ylabel('magnitude'); diff --git a/DEMOS/Rail/LQR_rail_splitting.m b/DEMOS/Rail/LQR_rail_splitting.m index 9e5d900..1db53db 100644 --- a/DEMOS/Rail/LQR_rail_splitting.m +++ b/DEMOS/Rail/LQR_rail_splitting.m @@ -1,4 +1,4 @@ -function out = LQR_rail_splitting(k, exp_action, method,istest) +function out = LQR_rail_splitting(k, exp_action, method, istest) % Computes the optimal feedback via low-rank splitting schemes [1, 2] for % the selective cooling of Steel profiles application described in [3,4,5]. @@ -41,7 +41,7 @@ % [4] P. Benner, J. Saak, A semi-discretized heat transfer model for % optimal cooling of steel profiles, in: P. Benner, V. Mehrmann, D. % Sorensen (Eds.), Dimension Reduction of Large-Scale Systems, Vol. 45 -% of Lect. Notes Comput. Sci. Eng., Springer-Verlag, Berlin/Heidelberg, +% of Lecture Notes in Computational Science and Engineering, Springer-Verlag, Berlin/Heidelberg, % Germany, 2005, pp. 353-356. https://doi.org/10.1007/3-540-27909-1_19 % % [5] J. Saak, Efficient numerical solution of large scale algebraic matrix @@ -53,12 +53,11 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - if nargin < 1 k = 2; end @@ -72,11 +71,12 @@ method.symmetric = false; end if nargin < 4 - istest = 0; + istest = false; end %% Equation parameters % Default (E, A, B, C) system -oper = operatormanager('default'); +opts = struct(); +[oper, opts] = operatormanager(opts, 'default'); eqn = mess_get_linear_rail(k); eqn.Rinv = 1; @@ -86,19 +86,19 @@ eqn.L0 = rand(size(eqn.A_, 1), 1); eqn.D0 = 1; - %% General splitting parameters -opts.splitting.time_steps = 0 : 50 : 4500; +opts.splitting.time_steps = 0:50:4500; opts.splitting.order = method.order; opts.splitting.additive = method.additive; opts.splitting.symmetric = method.symmetric; opts.splitting.info = 2; -opts.splitting.intermediates = 1; +opts.splitting.intermediates = true; opts.splitting.trunc_tol = 1e-10; % Quadrature (for integral term) parameters -opts.splitting.quadrature.type = 'adaptive'; -opts.splitting.quadrature.tol = 1e-4 ; +opts.splitting.quadrature.type = 'clenshawcurtis'; +opts.splitting.quadrature.order = 8; +opts.splitting.quadrature.tol = 1e-4; %% Matrix exponential action parameters opts.exp_action = exp_action; @@ -107,12 +107,12 @@ t_mess_splitting_dre = tic; [out, ~, opts, ~] = mess_splitting_dre(eqn, opts, oper); t_elapsed = toc(t_mess_splitting_dre); -fprintf(1,'mess_splitting_dre took %6.2f seconds \n',t_elapsed); +mess_fprintf(opts, 'mess_splitting_dre took %6.2f seconds \n', t_elapsed); %% if not(istest) t = opts.splitting.time_steps; figure; - plot(t, out.ms,'LineWidth',3); + plot(t, out.ms, 'LineWidth', 3); title('Ranks of approximations over time'); end diff --git a/DEMOS/Rail/Lyapunov_rail_LDL_ADI.m b/DEMOS/Rail/Lyapunov_rail_LDL_ADI.m index addaa0b..c2515e8 100644 --- a/DEMOS/Rail/Lyapunov_rail_LDL_ADI.m +++ b/DEMOS/Rail/Lyapunov_rail_LDL_ADI.m @@ -1,4 +1,4 @@ -function Lyapunov_rail_LDL_ADI(k,shifts,implicit,istest) +function Lyapunov_rail_LDL_ADI(k, shifts, implicit, istest) % Computes the solution of the generalized Lyapunov equation via the % low-rank ADI iteration in both ZZ^T [1,2] and LDL^T[3] formulation for the % selective cooling of Steel profiles application described in [4,5,6]. @@ -51,8 +51,8 @@ function Lyapunov_rail_LDL_ADI(k,shifts,implicit,istest) % [5] P. Benner, J. Saak, A semi-discretized heat transfer model for % optimal cooling of steel profiles, in: P. Benner, V. Mehrmann, D. % Sorensen (Eds.), Dimension Reduction of Large-Scale Systems, Vol. 45 -% of Lect. Notes Comput. Sci. Eng., Springer-Verlag, Berlin/Heidelberg, -% Germany, 2005, pp. 353–356. +% of Lecture Notes in Computational Science and Engineering, +% Springer-Verlag, Berlin/Heidelberg, Germany, 2005, pp. 353–356. % https://doi.org/10.1007/3-540-27909-1_19 % % [6] J. Saak, Efficient numerical solution of large scale algebraic matrix @@ -68,122 +68,135 @@ function Lyapunov_rail_LDL_ADI(k,shifts,implicit,istest) % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % %% -narginchk(0,4); -if nargin<1, k=2; end -if nargin<2, shifts='wachspress'; end -if nargin<3, implicit=0; end -if nargin<4, istest=0; end +narginchk(0, 4); +if nargin < 1 + k = 2; +end +if nargin < 2 + shifts = 'wachspress'; +end +if nargin < 3 + implicit = 0; +end +if nargin < 4 + istest = false; +end %% % set operation -oper = operatormanager('default'); +opts = struct(); +[oper, opts] = operatormanager(opts, 'default'); % Problem data eqn = mess_get_linear_rail(k); %% % ADI tolerances and maximum iteration number -opts.adi.maxiter = 100; -opts.adi.res_tol = 1e-12; +opts.adi.maxiter = 100; +opts.adi.res_tol = 1e-12; opts.adi.rel_diff_tol = 1e-16; -opts.adi.info = 1; +opts.adi.info = 1; eqn.type = 'T'; - %% -%Heuristic shift parameters via basic Arnoldi -n=oper.size(eqn, opts); -opts.shifts.num_Ritz=50; -opts.shifts.num_hRitz=25; +% Heuristic shift parameters via basic Arnoldi +n = oper.size(eqn, opts); +opts.shifts.num_Ritz = 50; +opts.shifts.num_hRitz = 25; opts.shifts.num_desired = 6; -opts.shifts.b0=ones(n,1); +opts.shifts.b0 = ones(n, 1); switch lower(shifts) case 'heur' - opts.shifts.method = 'heur'; + opts.shifts.method = 'heur'; case 'wachspress' - opts.shifts.method = 'wachspress'; - opts.shifts.wachspress = 'T'; + opts.shifts.method = 'wachspress'; + opts.shifts.wachspress = 'T'; case 'projection' - opts.shifts.method = 'projection'; + opts.shifts.method = 'projection'; opts.shifts.implicitVtAV = implicit; end opts.norm = 'fro'; %% -fprintf('########################\n'); -fprintf('# ADI with ZZ^T: \n'); -fprintf('########################\n'); +mess_fprintf(opts, '########################\n'); +mess_fprintf(opts, '# ADI with ZZ^T: \n'); +mess_fprintf(opts, '########################\n'); t_mess_lradi = tic; out = mess_lradi(eqn, opts, oper); t_elapsed1 = toc(t_mess_lradi); -fprintf(1,'mess_lradi took %6.2f seconds \n',t_elapsed1); +mess_fprintf(opts, 'mess_lradi took %6.2f seconds \n', t_elapsed1); if istest - if min(out.res)>=opts.adi.res_tol - error('MESS:TEST:accuracy','unexpectedly inaccurate result'); - end + if min(out.res) >= opts.adi.res_tol + mess_err(opts, 'TEST:accuracy', ... + 'unexpectedly inaccurate result'); + end else figure(1); - semilogy(out.res,'LineWidth',3); + semilogy(out.res, 'LineWidth', 3); xlabel('number of iterations'); ylabel('normalized residual norm'); pause(1); end -disp('size out.Z:'); -disp(size(out.Z)); +[mZ, nZ] = size(out.Z); +mess_fprintf(opts, 'size out.Z: %d x %d\n\n', mZ, nZ); %% Set LDL fields -opts.LDL_T = 1; -eqn.S = diag([4,4,9,9,16,16]); -eqn.G = eqn.C' * diag([4,4,9,9,16,16].^(-0.5)); +opts.LDL_T = true; +eqn.T = diag([4, 4, 9, 9, 16, 16]); +eqn.W = eqn.C' * diag([4, 4, 9, 9, 16, 16].^(-0.5)); %% -fprintf('########################\n'); -fprintf('# ADI with LDL^T: \n'); -fprintf('########################\n'); +mess_fprintf(opts, '########################\n'); +mess_fprintf(opts, '# ADI with LDL^T: \n'); +mess_fprintf(opts, '########################\n'); t_mess_lradi = tic; out1 = mess_lradi(eqn, opts, oper); t_elapsed2 = toc(t_mess_lradi); -fprintf(1,'mess_lradi took %6.2f seconds \n',t_elapsed2); +mess_fprintf(opts, 'mess_lradi took %6.2f seconds \n', t_elapsed2); if istest - if min(out.res)>=opts.adi.res_tol - error('MESS:TEST:accuracy','unexpectedly inaccurate result'); - end + if min(out.res) >= opts.adi.res_tol + mess_err(opts, 'TEST:accuracy', ... + 'unexpectedly inaccurate result'); + end else figure(2); - semilogy(out1.res,'LineWidth',3); + semilogy(out1.res, 'LineWidth', 3); xlabel('number of iterations'); ylabel('normalized residual norm'); pause(1); end -disp('size out1.Z:'); -disp(size(out1.Z)); +[mZ, nZ] = size(out1.Z); +mess_fprintf(opts, 'size out1.Z: %d x %d\n\n', mZ, nZ); %% Difference of Lyapunov solutions -if k<3 +if k < 3 % This is mainly for consistency checking on our continuous % integration tests. % NEVER FORM SUCH DYADIC PRODUCTS IN PRODUCTION CODE!!! - err = norm(out.Z * out.Z' - out1.Z * out1.D * out1.Z') /... + err = norm(out.Z * out.Z' - out1.Z * out1.D * out1.Z') / ... norm(out.Z * out.Z'); - fprintf(['Relative difference between solution with and without ' ... - 'LDL^T: \t %g\n'], err); - if err>1e-11 + mess_fprintf(opts, ... + ['Relative difference between solution with and without ' ... + 'LDL^T: \t %g\n'], ... + err); + if err > 1e-11 if implicit shifts = [shifts '(implicit)']; end - error('MESS:TEST:accuracy',... - ['unexpectedly inaccurate result relative difference',... - ' %e > 1e-12 in case %s'],err,shifts); + mess_err(opts, 'TEST:accuracy', ... + ['unexpectedly inaccurate result relative difference', ... + ' %e > 1e-12 in case %s'], ... + err, shifts); end end diff --git a/DEMOS/Rail/bt_mor_rail_tol.m b/DEMOS/Rail/bt_mor_rail_tol.m index 9efad57..05cd0fd 100644 --- a/DEMOS/Rail/bt_mor_rail_tol.m +++ b/DEMOS/Rail/bt_mor_rail_tol.m @@ -1,7 +1,8 @@ -function [Ar, Br, Cr] = bt_mor_rail_tol(k,tol,shifts,istest) -% bt_mor_FDM_tol computes a reduced order model via the standard Lyapunov -% balanced truncation (see e.g. [1]) for a finite difference discretized -% convection diffusion model on the unit square described in [2]. +function [Ar, Br, Cr] = bt_mor_rail_tol(k, tol, shifts, istest) +% bt_mor_rail_tol computes a reduced order model via the standard Lyapunov +% balanced truncation (see e.g. [1]) for a finite element discretized +% heat conduction model on a rail profile cross-section described +% in [2, 3, 4]. % % Usage: % [Ar, Br, Cr] = bt_mor_rail_tol(k,tol,max_ord,n0,test) @@ -19,6 +20,7 @@ % 'heur' : Penzl heuristic shifts % 'projection' : projection shifts using the last columns % of the solution factor +% 'wachspress' : optimal Wachspress parameters % (optional, defaults to 'heur') % % istest flag to determine whether this demo runs as a CI test or @@ -43,8 +45,9 @@ % [3] P. Benner, J. Saak, A semi-discretized heat transfer model for % optimal cooling of steel profiles, in: P. Benner, V. Mehrmann, D. % Sorensen (Eds.), Dimension Reduction of Large-Scale Systems, Vol. 45 -% of Lect. Notes Comput. Sci. Eng., Springer-Verlag, Berlin/Heidelberg, -% Germany, 2005, pp. 353–356. https://doi.org/10.1007/3-540-27909-1_19 +% of Lecture Notes in Computational Science and Engineering, +% Springer-Verlag, Berlin/Heidelberg, Germany, 2005, pp. 353–356. +% https://doi.org/10.1007/3-540-27909-1_19 % % [4] J. Saak, Efficient numerical solution of large scale algebraic matrix % equations in PDE control and model order reduction, Dissertation, @@ -56,129 +59,141 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % -narginchk(0,4); +narginchk(0, 4); % BT tolerance and maximum order for the ROM -if nargin<1, k=3; end -if nargin<2, tol=1e-5; end -if nargin<3, shifts='heur'; end -if nargin<4, istest=0; end - +if nargin < 1 + k = 2; +end +if nargin < 2 + tol = 1e-5; +end +if nargin < 3 + shifts = 'heur'; +end +if nargin < 4 + istest = false; +end % ADI tolerance and maximum iteration number -opts.adi.maxiter = 100; % maximum iteration number +opts.adi.maxiter = 150; % maximum iteration number opts.adi.res_tol = 1e-10; % residual norm tolerance opts.adi.rel_diff_tol = 1e-16; % relative change norm tolerance opts.adi.info = 1; % turn output on opts.norm = 'fro'; % Frobenius norm for stopping criteria -oper = operatormanager('default'); +[oper, opts] = operatormanager(opts, 'default'); %% Problem data eqn = mess_get_linear_rail(k); % load system matrices n = oper.size(eqn, opts); % number of equations %% Shift Parameters -opts.shifts.num_desired=25; % number of parameters for - % 'heur' and 'wachspress' +opts.shifts.num_desired = 25; % number of parameters for +% 'heur' and 'wachspress' switch lower(shifts) case 'heur' - opts.shifts.method = 'heur'; - opts.shifts.num_Ritz=50; % number Arnoldi steps with F - opts.shifts.num_hRitz=25; % Arnoldi steps with inv(F) - opts.shifts.b0=ones(n,1); % initial guess for Arnoldi + opts.shifts.method = 'heur'; + opts.shifts.num_Ritz = 50; % number Arnoldi steps with F + opts.shifts.num_hRitz = 25; % Arnoldi steps with inv(F) + opts.shifts.b0 = ones(n, 1); % initial guess for Arnoldi case 'wachspress' - opts.shifts.method = 'wachspress'; + opts.shifts.method = 'wachspress'; + opts.shifts.num_Ritz = 50; % number Arnoldi steps with F + opts.shifts.num_hRitz = 25; % Arnoldi steps with inv(F) opts.shifts.wachspress = 'T'; case 'projection' - opts.shifts.method = 'projection'; + opts.shifts.method = 'projection'; end %% Compute low-rank factor of Controllability Gramian -eqn.type='N'; % Lyapunov eq. for Controllability Gram. +eqn.type = 'N'; % Lyapunov eq. for Controllability Gram. t_mess_lradi = tic; outB = mess_lradi(eqn, opts, oper); % run ADI iteration t_elapsed1 = toc(t_mess_lradi); -fprintf(1,'mess_lradi took %6.2f seconds \n',t_elapsed1); +mess_fprintf(opts, 'mess_lradi took %6.2f seconds \n', t_elapsed1); % residual norm plot if istest - if min(outB.res)>=opts.adi.res_tol - error('MESS:TEST:accuracy','unexpectedly inaccurate result'); + if min(outB.res) >= opts.adi.res_tol + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result'); end else figure(1); - semilogy(outB.res,'LineWidth',3); + semilogy(outB.res, 'LineWidth', 3); title('A X E^T + E X A^T = -BB^T'); xlabel('number of iterations'); ylabel('normalized residual norm'); pause(1); end -disp('size outB.Z:'); -disp(size(outB.Z)); +[mZ, nZ] = size(outB.Z); +mess_fprintf(opts, 'size outB.Z: %d x %d\n\n', mZ, nZ); %% Compute low-rank factor of Observability Gramian eqn.type = 'T'; % Lyapunov eq. for Observability Gram. t_mess_lradi = tic; outC = mess_lradi(eqn, opts, oper); % run ADI iteration t_elapsed2 = toc(t_mess_lradi); -fprintf(1,'mess_lradi took %6.2f seconds \n',t_elapsed2); +mess_fprintf(opts, 'mess_lradi took %6.2f seconds \n', t_elapsed2); % residual norm plot if istest - if min(outC.res)>=opts.adi.res_tol - error('MESS:TEST:accuracy','unexpectedly inaccurate result'); + if min(outC.res) >= opts.adi.res_tol + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result'); end else figure(2); - semilogy(outC.res,'LineWidth',3); + semilogy(outC.res, 'LineWidth', 3); title('A^T X E + E^T X A = -C^T C'); xlabel('number of iterations'); ylabel('normalized residual norm'); pause(1); end -disp('size outC.Z:'); -disp(size(outC.Z)); +[mZ, nZ] = size(outC.Z); +mess_fprintf(opts, 'size outC.Z: %d x %d\n\n', mZ, nZ); %% Compute reduced system matrices % Perform Square Root Method -opts.srm.tol=tol; -opts.srm.max_ord=n; -opts.srm.info=2; -[TL,TR,HSV] = mess_square_root_method(eqn,opts,oper,outB.Z,outC.Z); +opts.srm.tol = tol; +opts.srm.max_ord = n; +opts.srm.info = 2; +[TL, TR, HSV] = mess_square_root_method(eqn, opts, oper, outB.Z, outC.Z); %% compute ROM matrices -Ar = TL'*oper.mul_A(eqn, opts, 'N', TR, 'N'); -Br = TL'*eqn.B; -Cr = eqn.C*TR; -Er = eye(size(Ar,1)); +Ar = TL' * oper.mul_A(eqn, opts, 'N', TR, 'N'); +Br = TL' * eqn.B; +Cr = eqn.C * TR; +Er = eye(size(Ar, 1)); %% Plots -ROM.A=Ar; -ROM.E=Er; -ROM.B=Br; -ROM.C=Cr; +ROM.A = Ar; +ROM.E = Er; +ROM.B = Br; +ROM.C = Cr; if istest - opts.sigma.info=0; + opts.tf_plot.info = 0; else - opts.sigma.info=2; + opts.tf_plot.info = 2; end -opts.sigma.fmin=-6; -opts.sigma.fmax=4; +opts.tf_plot.type = 'sigma'; + +opts.tf_plot.fmin = -6; +opts.tf_plot.fmax = 4; -out = mess_sigma_plot(eqn, opts, oper, ROM); err = out.err; +out = mess_tf_plot(eqn, opts, oper, ROM); +err = out.err; if istest - if max(err)>tol - error('MESS:TEST:accuracy','unexpectedly inaccurate result'); + if max(err) > tol + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result'); end else figure; - semilogy(HSV,'LineWidth',3); + semilogy(HSV, 'LineWidth', 3); title('Computed Hankel singular values'); xlabel('index'); ylabel('magnitude'); diff --git a/DEMOS/TripleChain/BT_TripleChain.m b/DEMOS/TripleChain/BT_TripleChain.m index c87d057..fe14eff 100644 --- a/DEMOS/TripleChain/BT_TripleChain.m +++ b/DEMOS/TripleChain/BT_TripleChain.m @@ -37,39 +37,44 @@ function BT_TripleChain(variant, istest) % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % %% -narginchk(0,2) +narginchk(0, 2); -if nargin==0, variant = 'FO'; end -if nargin<2, istest=0; end +if nargin == 0 + variant = 'FO'; +end +if nargin < 2 + istest = false; +end format long e; %% set operation -oper = operatormanager('so_1'); +opts = struct(); +[oper, opts] = operatormanager(opts, 'so_1'); %% Initialize problem data -n1=500; -alpha=.002; -Beta=alpha; -v=5; +n1 = 500; +alpha = .002; +Beta = alpha; +v = 5; -[eqn.M_,eqn.E_,eqn.K_]=triplechain_MSD(n1,alpha,Beta,v); +[eqn.M_, eqn.E_, eqn.K_] = triplechain_MSD(n1, alpha, Beta, v); -s = size(eqn.K_,1); -O = zeros(s,1); +s = size(eqn.K_, 1); +O = zeros(s, 1); Cv = O'; -Cp = ones(1,size(eqn.K_,1)); -B = ones(size(eqn.K_,1),1); +Cp = ones(1, size(eqn.K_, 1)); +B = ones(size(eqn.K_, 1), 1); eqn.B = [O; B]; eqn.C = [Cp, Cv]; -eqn.haveE=1; +eqn.haveE = true; %% % ADI tolerances and maximum iteration number @@ -79,17 +84,16 @@ function BT_TripleChain(variant, istest) opts.norm = 'fro'; opts.adi.info = 1; -opts.adi.accumulateK = 0; -opts.adi.accumulateDeltaK = 0; -opts.adi.compute_sol_fac = 1; +opts.adi.accumulateK = false; +opts.adi.accumulateDeltaK = false; +opts.adi.compute_sol_fac = true; opts.norm = 'fro'; - %% -%Heuristic shift parameters via projection -opts.shifts.num_desired=5; +% Heuristic shift parameters via projection +opts.shifts.num_desired = 5; -opts.shifts.info=0; +opts.shifts.info = 0; opts.shifts.method = 'projection'; %% % Compute controllability Gramian factor @@ -97,48 +101,45 @@ function BT_TripleChain(variant, istest) t_mess_lradi = tic; outB = mess_lradi(eqn, opts, oper); t_elapsed1 = toc(t_mess_lradi); -fprintf(1,'mess_lradi took %6.2f seconds \n',t_elapsed1); +mess_fprintf(opts, 'mess_lradi took %6.2f seconds \n', t_elapsed1); if istest - if min(outB.res)>=1e-1 - error('MESS:TEST:accuracy','unexpectedly inaccurate result'); - end + if min(outB.res) >= 1e-1 + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result'); + end else figure(1); - semilogy(outB.res,'LineWidth',3); + semilogy(outB.res, 'LineWidth', 3); title('0= A X E^T + E X A^T - BB^T'); xlabel('number of iterations'); ylabel('normalized residual norm'); pause(1); end - -disp('size outB.Z:'); -disp(size(outB.Z)); +[mZ, nZ] = size(outB.Z); +mess_fprintf(opts, 'size outB.Z: %d x %d\n\n', mZ, nZ); %% % Compute observability Gramian factor eqn.type = 'T'; -t_mess_lradi =tic; +t_mess_lradi = tic; outC = mess_lradi(eqn, opts, oper); t_elapsed2 = toc(t_mess_lradi); -fprintf(1,'mess_lradi took %6.2f seconds \n' ,t_elapsed2); - +mess_fprintf(opts, 'mess_lradi took %6.2f seconds \n', t_elapsed2); if istest - if min(outC.res)>=1e-1 - error('MESS:TEST:accuracy','unexpectedly inaccurate result'); - end + if min(outC.res) >= 1e-1 + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result'); + end else figure(2); - semilogy(outC.res,'LineWidth',3); + semilogy(outC.res, 'LineWidth', 3); title('0 = A^T X E + E^T X A - C^T C'); xlabel('number of iterations'); ylabel('normalized residual norm'); pause(1); end -disp('size outC.Z:'); -disp(size(outC.Z)); - +[mZ, nZ] = size(outC.Z); +mess_fprintf(opts, 'size outC.Z: %d x %d\n\n', mZ, nZ); switch upper(variant) case 'FO' @@ -148,54 +149,58 @@ function BT_TripleChain(variant, istest) opts.srm.tol = eps; opts.srm.info = 1; - [TL,TR] = mess_square_root_method(eqn,opts,oper,outB.Z,outC.Z); + [TL, TR] = mess_square_root_method(eqn, opts, oper, outB.Z, outC.Z); - ROM.E = eye(size(TL,2)); - ROM.A = TL'*oper.mul_A(eqn, opts, 'N', TR, 'N'); - ROM.B = TL'*eqn.B; - ROM.C = eqn.C*TR; + ROM.E = eye(size(TL, 2)); + ROM.A = TL' * oper.mul_A(eqn, opts, 'N', TR, 'N'); + ROM.B = TL' * eqn.B; + ROM.C = eqn.C * TR; ROM.D = []; case 'VV' - U = outB.Z(1:s,:); - V = outC.Z(1:s,:); + U = outB.Z(1:s, :); + V = outC.Z(1:s, :); case 'PP' - U = outB.Z(s+1:end,:); - V = outC.Z(s+1:end,:); + U = outB.Z(s + 1:end, :); + V = outC.Z(s + 1:end, :); case 'PV' - U = outB.Z(s+1:end,:); - V = outC.Z(1:s,:); + U = outB.Z(s + 1:end, :); + V = outC.Z(1:s, :); case 'VP' - U = outB.Z(1:s,:); - V = outC.Z(s+1:end,:); + U = outB.Z(1:s, :); + V = outC.Z(s + 1:end, :); end -if not(strcmp(variant,'FO')) +if not(strcmp(variant, 'FO')) max_ord = 75; tol = eps; inform = 1; - [TL,TR] = square_root_method_SO(eqn.M_, max_ord, tol, inform, U, V); + [TL, TR] = square_root_method_SO(eqn.M_, max_ord, tol, inform, U, V); - ROM.M = eye(size(TL,2)); - ROM.E = TL'*(eqn.E_*TR); - ROM.K = TL'*(eqn.K_*TR); - ROM.B = TL'*B; - ROM.Cv = Cv*TR; - ROM.Cp = Cp*TR; + ROM.M = eye(size(TL, 2)); + ROM.E = TL' * (eqn.E_ * TR); + ROM.K = TL' * (eqn.K_ * TR); + ROM.B = TL' * B; + ROM.Cv = Cv * TR; + ROM.Cp = Cp * TR; end %% % plot results -opts.sigma.fmin = 1e-4; -opts.sigma.fmax = 1e0; -opts.sigma.nsample = 400; +opts.tf_plot.fmin = 1e-4; +opts.tf_plot.fmax = 1e0; +opts.tf_plot.nsample = 400; if istest - opts.sigma.info = 1; + opts.tf_plot.info = 1; else - opts.sigma.info = 2; + opts.tf_plot.info = 2; end -out = mess_sigma_plot(eqn, opts, oper, ROM); err = out.err; + +opts.tf_plot.type = 'sigma'; + +out = mess_tf_plot(eqn, opts, oper, ROM); +err = out.err; if istest if max(err) > 1000 - error('MESS:TEST:accuracy','unexpectedly inaccurate result %g',max(err)); + mess_err(opts, 'TEST:accuracy', ... + 'unexpectedly inaccurate result %g', max(err)); end end - diff --git a/DEMOS/TripleChain/BT_sym_TripleChain.m b/DEMOS/TripleChain/BT_sym_TripleChain.m index 405b1de..9e669fc 100644 --- a/DEMOS/TripleChain/BT_sym_TripleChain.m +++ b/DEMOS/TripleChain/BT_sym_TripleChain.m @@ -1,4 +1,4 @@ -function BT_sym_TripleChain(variant,istest) +function BT_sym_TripleChain(variant, istest) % % Computes a reduced order model (ROM) for the triple chain example of % Truhar and Veselic [1] via Balanced truncation, e.g. [2], exploiting @@ -41,87 +41,88 @@ function BT_sym_TripleChain(variant,istest) % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% -narginchk(0,2); +narginchk(0, 2); -if nargin==0 +if nargin == 0 variant = 'FO'; end -if nargin<2 - istest=0; +if nargin < 2 + istest = false; end format long e; % set operation -oper = operatormanager('so_2'); +opts = struct(); +[oper, opts] = operatormanager(opts, 'so_2'); % Problem data -n1=500; -alpha=.002; -Beta=alpha; -v=5; +n1 = 500; +alpha = 0.002; +Beta = alpha; +v = 5; -[eqn.M_,eqn.E_,eqn.K_]=triplechain_MSD(n1,alpha,Beta,v); +[eqn.M_, eqn.E_, eqn.K_] = ... + triplechain_MSD(n1, alpha, Beta, v); -s = size(eqn.K_,1); +s = size(eqn.K_, 1); -B = ones(s,1); -O = zeros(s,1); -Cp = ones(1,s); +B = ones(s, 1); +O = zeros(s, 1); +Cp = ones(1, s); Cv = O'; eqn.B = [B; O]; eqn.C = [Cp, Cv]; -eqn.haveE=1; +eqn.haveE = true; %% % ADI tolerances and maximum iteration number opts.adi.maxiter = 300; opts.adi.res_tol = 1e-10; -opts.norm = 'fro'; +opts.norm = 'fro'; -%opts.adi.rel_diff_tol = 1e-16; -opts.adi.rel_diff_tol = 0; -opts.adi.info = 1; -%opts.adi.accumulateK = 0; -%opts.adi.accumulateDeltaK = 0; -opts.adi.compute_sol_fac = 1; +% opts.adi.rel_diff_tol = 1e-16; +opts.adi.rel_diff_tol = 0; +opts.adi.info = 1; +% opts.adi.accumulateK = false; +% opts.adi.accumulateDeltaK = false; +opts.adi.compute_sol_fac = true; eqn.type = 'N'; %% -%Heuristic shift parameters via projection -opts.shifts.num_desired=5; +% Heuristic shift parameters via projection +opts.shifts.num_desired = 5; -opts.shifts.info=0; -opts.shifts.method = 'projection'; +opts.shifts.info = 0; +opts.shifts.method = 'projection'; %% % Compute Gramian Factor (one is enough, since the Gramians are equal) t_mess_lradi = tic; outB = mess_lradi(eqn, opts, oper); t_elapsed = toc(t_mess_lradi); -fprintf(1,'mess_lradi took %6.2f seconds \n',t_elapsed); +mess_fprintf(opts, 'mess_lradi took %6.2f seconds \n', t_elapsed); if istest - if min(outB.res)>=1e-1 - error('MESS:TEST:accuracy','unexpectedly inaccurate result'); - end + if min(outB.res) >= 1e-1 + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result'); + end else figure(1); - semilogy(outB.res,'LineWidth',3); - title('0 = A X ^T + E X A^T - BB^T'); + semilogy(outB.res, 'LineWidth', 3); + title('0 = A X ^T + E X A^T - BB^T'); xlabel('number of iterations'); ylabel('normalized residual norm'); pause(1); end -disp('size outB.Z:'); -disp(size(outB.Z)); +[mZ, nZ] = size(outB.Z); +mess_fprintf(opts, 'size outB.Z: %d x %d\n\n', mZ, nZ); %% switch upper(variant) @@ -132,54 +133,57 @@ function BT_sym_TripleChain(variant,istest) opts.srm.tol = eps; opts.srm.info = 1; - [TL,TR] = mess_square_root_method(eqn,opts,oper,outB.Z,outB.Z); + [TL, TR] = mess_square_root_method(eqn, opts, oper, outB.Z, outB.Z); - ROM.E = eye(size(TL,2)); - ROM.A = TL'*oper.mul_A(eqn, opts, 'N', TR, 'N'); - ROM.B = TL'*eqn.B; - ROM.C = eqn.C*TR; + ROM.E = eye(size(TL, 2)); + ROM.A = TL' * oper.mul_A(eqn, opts, 'N', TR, 'N'); + ROM.B = TL' * eqn.B; + ROM.C = eqn.C * TR; ROM.D = []; case 'VV' - U = outB.Z(1:s,:); - V = outB.Z(1:s,:); + U = outB.Z(1:s, :); + V = outB.Z(1:s, :); case 'PP' - U = outB.Z(s+1:end,:); - V = outB.Z(s+1:end,:); + U = outB.Z(s + 1:end, :); + V = outB.Z(s + 1:end, :); case 'PV' - U = outB.Z(s+1:end,:); - V = outB.Z(1:s,:); + U = outB.Z(s + 1:end, :); + V = outB.Z(1:s, :); case 'VP' - U = outB.Z(1:s,:); - V = outB.Z(s+1:end,:); + U = outB.Z(1:s, :); + V = outB.Z(s + 1:end, :); end -if not(strcmp(variant,'FO')) +if not(strcmp(variant, 'FO')) max_ord = 75; tol = eps; inform = 1; - [TL,TR] = square_root_method_SO(eqn.M_, max_ord, tol, inform, U, V); + [TL, TR] = square_root_method_SO(eqn.M_, max_ord, tol, inform, U, V); - ROM.M = eye(size(TL,2)); - ROM.E = TL'*(eqn.E_*TR); - ROM.K = TL'*(eqn.K_*TR); - ROM.B = TL'*B; - ROM.Cv = Cv*TR; - ROM.Cp = Cp*TR; + ROM.M = eye(size(TL, 2)); + ROM.E = TL' * (eqn.E_ * TR); + ROM.K = TL' * (eqn.K_ * TR); + ROM.B = TL' * B; + ROM.Cv = Cv * TR; + ROM.Cp = Cp * TR; end %% % plot results -opts.sigma.fmin = 1e-4; -opts.sigma.fmax = 1e0; -opts.sigma.nsample = 200; +opts.tf_plot.fmin = 1e-4; +opts.tf_plot.fmax = 1e0; +opts.tf_plot.nsample = 200; if istest - opts.sigma.info = 1; + opts.tf_plot.info = 1; else - opts.sigma.info = 2; + opts.tf_plot.info = 2; end -out = mess_sigma_plot(eqn, opts, oper, ROM); err = out.err; + +opts.tf_plot.type = 'sigma'; + +out = mess_tf_plot(eqn, opts, oper, ROM); +err = out.err; if istest if max(err) > 1000 - error('MESS:TEST:accuracy','unexpectedly inaccurate result %g', max(err)); + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result %g', max(err)); end end - diff --git a/DEMOS/TripleChain/IRKA_TripleChain.m b/DEMOS/TripleChain/IRKA_TripleChain.m new file mode 100644 index 0000000..f024f8d --- /dev/null +++ b/DEMOS/TripleChain/IRKA_TripleChain.m @@ -0,0 +1,137 @@ +function IRKA_TripleChain(n1, usfs, istest) +% IRKA_TripleChain computes first order IRKA based ROM for the triple chain +% +% Usage: IRKA_TripleChain(n1, oper, istest) +% +% Inputs: +% +% n1 length of a single chain in the model +% (optional; defaults to 1000) +% +% usfs the set of user supplied functions to use, or the indication to +% call IRKA with matrices. +% possible values: 'so_1', 'so_2', 'default', 'matrices' +% (optional; defaults to 'so_1') +% +% istest flag to determine whether this demo runs as a CI test or +% interactive demo +% (optional, defaults to 0, i.e. interactive demo) +% + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +%% +narginchk(0, 3); +if nargin < 1 + n1 = 1000; +end +if nargin < 2 + usfs = 'so_1'; +end +if nargin < 3 + istest = 0; +end +%% +% set usfs, unless we want to use the matrices +opts = struct(); +if strcmp(usfs, 'matrices') + [oper, opts] = operatormanager(opts, 'so_2'); +else + [oper, opts] = operatormanager(opts, usfs); +end + +% Problem data +alpha = .002; +Beta = .002; +v = 5; + +matrices = false; +switch usfs + case 'so_1' + [eqn.M_, eqn.E_, eqn.K_] = ... + triplechain_MSD(n1, alpha, Beta, v); + s = size(eqn.K_, 1); + eqn.B = [zeros(s, 1); ones(s, 1)]; + eqn.C = [ones(1, s) zeros(1, s)]; + case 'so_2' + [eqn.M_, eqn.E_, eqn.K_] = ... + triplechain_MSD(n1, alpha, Beta, v); + s = size(eqn.K_, 1); + eqn.B = [ones(s, 1); zeros(s, 1)]; + eqn.C = eqn.B'; + case 'default' + [M_, E_, K_] = triplechain_MSD(n1, alpha, Beta, v); + s = size(K_, 1); + eqn.A_ = [sparse(s, s), -K_; -K_, -E_]; + eqn.E_ = [-K_, sparse(s, s); sparse(s, s), M_]; + eqn.B = [zeros(s, 1); ones(s, 1)]; + eqn.C = [ones(1, s) zeros(1, s)]; + clear M_ E_ K_ s; + case 'matrices' + % setup matrices for the IRKA call + [M, E, K] = triplechain_MSD(n1, alpha, Beta, v); + s = size(K, 1); + B = ones(s, 1); + Cp = B'; + Cv = zeros(1, s); + % We will need eqn for tf_plot below + eqn = struct('M_', M, 'E_', E, 'K_', K, ... + 'B', [B; zeros(s, 1)], ... + 'C', [Cp Cv]); + matrices = true; +end +eqn.haveE = 1; +%% +opts.irka = struct('r', 30, ... + 'maxiter', 100, ... + 'shift_tol', 1e-3, ... + 'h2_tol', 1e-8, ... + 'num_prev_shifts', 5, ... + 'num_prev_roms', 5, ... + 'flipeig', false, ... + 'init', 'subspace'); + +%% +if matrices + [Er, Ar, Br, Cr, Dr, outinfo] = ... + mess_tangential_irka(M, E, K, B, Cp, Cv, [], opts); +else + [Er, Ar, Br, Cr, Dr, outinfo] = ... + mess_tangential_irka(eqn, opts, oper); +end +ROM.E = Er; +ROM.A = Ar; +ROM.B = Br; +ROM.C = Cr; +ROM.D = Dr; + +opts.tf_plot.nsample = 400; % 400 frequency samples +opts.tf_plot.fmin = -4; % min. frequency 1e-3 +opts.tf_plot.fmax = 0; % max. frequency 1e4 +if istest + opts.tf_plot.info = 0; +else + opts.tf_plot.info = 3; +end +opts.tf_plot.type = 'sigma'; + +[out, ~, opts, ~] = mess_tf_plot(eqn, opts, oper, ROM); + +if istest + if isequal(outinfo.term_flag, 'maxiter') + mess_err(opts, 'TEST:accuracy', ... + 'terminated with maximum number of iterations'); + end + if any(out.relerr > 1) + mess_err(opts, 'TEST:accuracy', ... + 'unexpectedly inaccurate results'); + + end +end +end diff --git a/DEMOS/TripleChain/LQR_TripleChain.m b/DEMOS/TripleChain/LQR_TripleChain.m index 3e563dc..c3759fc 100644 --- a/DEMOS/TripleChain/LQR_TripleChain.m +++ b/DEMOS/TripleChain/LQR_TripleChain.m @@ -44,174 +44,186 @@ function LQR_TripleChain(n1, usfs, shifts, istest) % Vienna, Austria, 2009, pp. 1232–1243, iSBN/ISSN:978-3-901608-35-3 % % [4] P. Benner, P. Kürschner, J. Saak, An improved numerical method for -% balanced truncation for symmetric second order systems, Math. Comput. -% Model. Dyn. Syst. 19 (6) (2013) 593–615. +% balanced truncation for symmetric second order systems, +% Mathematical and Computer Modelling of Dynamical Systems 19 (6) +% (2013) 593–615. % https://doi.org/10.1080/13873954.2013.794363 % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % %% -narginchk(0,4); -if nargin<1, n1=1000; end -if nargin<2, usfs='so_1'; end -if nargin<3, shifts='projection'; end -if nargin<4, istest=0; end +narginchk(0, 4); +if nargin < 1 + n1 = 1000; +end +if nargin < 2 + usfs = 'so_1'; +end +if nargin < 3 + shifts = 'projection'; +end +if nargin < 4 + istest = false; +end %% % set operation -oper = operatormanager(usfs); +opts = struct(); +[oper, opts] = operatormanager(opts, usfs); % Problem data -alpha=2; -Beta=5; -v=5; +alpha = 2; +Beta = 5; +v = 5; switch usfs case 'so_1' - [eqn.M_,eqn.E_,eqn.K_]=triplechain_MSD(n1,alpha,Beta,v); - s = size(eqn.K_,1); - eqn.B = [zeros(s,1); ones(size(eqn.K_,1),1)]; - eqn.C = [ones(1,size(eqn.K_,1)) zeros(1, s)]; + [eqn.M_, eqn.E_, eqn.K_] = ... + triplechain_MSD(n1, alpha, Beta, v); + s = size(eqn.K_, 1); + eqn.B = [zeros(s, 1); ones(size(eqn.K_, 1), 1)]; + eqn.C = [ones(1, size(eqn.K_, 1)) zeros(1, s)]; case 'so_2' - [eqn.M_,eqn.E_,eqn.K_]=triplechain_MSD(n1,alpha,Beta,v); - s = size(eqn.K_,1); - eqn.B = [ ones(size(eqn.K_,1),1); zeros(s,1)]; + [eqn.M_, eqn.E_, eqn.K_] = ... + triplechain_MSD(n1, alpha, Beta, v); + s = size(eqn.K_, 1); + eqn.B = [ones(size(eqn.K_, 1), 1); zeros(s, 1)]; eqn.C = eqn.B'; case 'default' - [M_,E_,K_]=triplechain_MSD(n1,alpha,Beta,v); - s = size(K_,1); - eqn.A_ = [sparse(s,s),-K_;-K_,-E_]; - eqn.E_ = [-K_,sparse(s,s);sparse(s,s),M_]; - eqn.B = [zeros(s,1); ones(size(K_,1),1)]; - eqn.C = [ones(1,size(K_,1)) zeros(1, s)]; + [M_, E_, K_] = triplechain_MSD(n1, alpha, Beta, v); + s = size(K_, 1); + eqn.A_ = [sparse(s, s), -K_; -K_, -E_]; + eqn.E_ = [-K_, sparse(s, s); sparse(s, s), M_]; + eqn.B = [zeros(s, 1); ones(size(K_, 1), 1)]; + eqn.C = [ones(1, size(K_, 1)) zeros(1, s)]; clear M_ E_ K_ s; end -eqn.haveE=1; - +eqn.haveE = true; %% % ADI tolerances and maximum iteration number -opts.adi.maxiter = 200; -opts.adi.res_tol = 1e-10; -opts.adi.rel_diff_tol = 0; -opts.adi.info = 0; -opts.adi.accumulateK = 1; -opts.adi.accumulateDeltaK = 0; -opts.adi.compute_sol_fac = 1; +opts.adi.maxiter = 200; +opts.adi.res_tol = 1e-10; +opts.adi.rel_diff_tol = 0; +opts.adi.info = 0; +opts.adi.accumulateK = true; +opts.adi.accumulateDeltaK = false; +opts.adi.compute_sol_fac = true; eqn.type = 'T'; %% -%Heuristic shift parameters via basic Arnoldi -n=oper.size(eqn, opts); +% Heuristic shift parameters via basic Arnoldi +n = oper.size(eqn, opts); switch shifts case 'heur' - opts.shifts.num_desired=25; - opts.shifts.num_Ritz=50; - opts.shifts.num_hRitz=25; + opts.shifts.num_desired = 25; + opts.shifts.num_Ritz = 50; + opts.shifts.num_hRitz = 25; - opts.shifts.info=0; - opts.shifts.method = 'heur'; - opts.shifts.b0=ones(n,1); + opts.shifts.info = 0; + opts.shifts.method = 'heur'; + opts.shifts.b0 = ones(n, 1); case 'projection' - opts.shifts.num_desired=6; - opts.shifts.method = 'projection'; - n=oper.size(eqn, opts); - opts.shifts.b0=ones(n,1); + opts.shifts.num_desired = 6; + opts.shifts.method = 'projection'; + n = oper.size(eqn, opts); + opts.shifts.b0 = ones(n, 1); end opts.shifts.truncate = 1e6; % remove all shifts larger than 1e6 or smaller - % than 1e-6 in absolute value in order to avoid - % loosing information about M or K in the - % shifted coefficients (p^2*M-pD+K) +% than 1e-6 in absolute value in order to avoid +% loosing information about M or K in the +% shifted coefficients (p^2*M-pD+K) %% % Newton tolerances and maximum iteration number -opts.nm.maxiter = 25; -opts.nm.res_tol = 1e-10; -opts.nm.rel_diff_tol = 1e-16; -opts.nm.info = 1; -opts.nm.accumulateRes = 1; -opts.nm.linesearch = 1; -opts.nm.inexact = 'quadratic'; -opts.nm.tau = 0.1; -opts.norm = 'fro'; +opts.nm.maxiter = 25; +opts.nm.res_tol = 1e-10; +opts.nm.rel_diff_tol = 1e-16; +opts.nm.info = 1; +opts.nm.accumulateRes = true; +opts.nm.linesearch = true; +opts.nm.inexact = 'quadratic'; +opts.nm.tau = 0.1; +opts.norm = 'fro'; + %% -t_mess_lrnm =tic; +t_mess_lrnm = tic; outnm = mess_lrnm(eqn, opts, oper); t_elapsed1 = toc(t_mess_lrnm); -fprintf(1,'mess_lrnm took %6.2f seconds \n' , t_elapsed1); +mess_fprintf(opts, 'mess_lrnm took %6.2f seconds \n', t_elapsed1); if istest - if min(outnm.res)>=opts.nm.res_tol - error('MESS:TEST:accuracy','unexpectedly inaccurate result'); - end + if min(outnm.res) >= opts.nm.res_tol + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result'); + end else figure(1); - disp(outnm.res); - semilogy(outnm.res,'LineWidth',3); + semilogy(outnm.res, 'LineWidth', 3); title('0= C^TC + A^T X E + E^T X A -E^T X BB^T X M'); xlabel('number of iterations'); ylabel('normalized residual norm'); pause(1); end -disp('size outnm.Z:'); -disp(size(outnm.Z)); - +[mZ, nZ] = size(outnm.Z); +mess_fprintf(opts, 'size outnm.Z: %d x %d\n\n', mZ, nZ); %% Lets try the RADI method and compare % RADI-MESS settings -opts.shifts.history = opts.shifts.num_desired*size(eqn.C,1); +opts.shifts.history = opts.shifts.num_desired * size(eqn.C, 1); opts.shifts.method = 'projection'; - % .. Suggest false (smart update is faster; convergence is the same). -opts.shifts.naive_update_mode = false; -opts.radi.compute_sol_fac = 1; -opts.radi.get_ZZt = 1; -opts.radi.maxiter = opts.adi.maxiter; -opts.norm = 2; -opts.radi.res_tol = opts.nm.res_tol; -opts.radi.rel_diff_tol = 0; -opts.radi.info = 1; - -t_mess_lrradi =tic; +opts.shifts.naive_update_mode = false; +opts.radi.compute_sol_fac = true; +opts.radi.get_ZZt = true; +opts.radi.maxiter = opts.adi.maxiter; +opts.norm = 2; +opts.radi.res_tol = opts.nm.res_tol; +opts.radi.rel_diff_tol = 0; +opts.radi.info = 1; + +t_mess_lrradi = tic; outradi = mess_lrradi(eqn, opts, oper); t_elapsed2 = toc(t_mess_lrradi); -fprintf(1,'mess_lrradi took %6.2f seconds \n',t_elapsed2); +mess_fprintf(opts, 'mess_lrradi took %6.2f seconds \n', t_elapsed2); if istest - if min(outradi.res)>=opts.radi.res_tol - error('MESS:TEST:accuracy','unexpectedly inaccurate result'); - end + if min(outradi.res) >= opts.radi.res_tol + mess_err(opts, 'TEST:accuracy', 'unexpectedly inaccurate result'); + end else figure(2); - semilogy(outradi.res,'LineWidth',3); + semilogy(outradi.res, 'LineWidth', 3); title('0= C^T C + A^T X E + E^T X A -E^T X BB^T X E'); xlabel('number of iterations'); ylabel('normalized residual norm'); end -disp('size outradi.Z:'); -disp(size(outradi.Z)); +[mZ, nZ] = size(outradi.Z); +mess_fprintf(opts, 'size outradi.Z: %d x %d\n\n', mZ, nZ); %% compare if istest - nrm = norm(outnm.K-outradi.K,'fro'); - nrmNM=norm(outnm.K,'fro'); - if nrm/nrmNM >= 1e-9 - error('MESS:TEST:accuracy',... - 'unexpectedly inaccurate result: ||K_NM - K_RADI||_F / ||K_NM||_F=%g',nrm/nrmNM); + nrm = norm(outnm.K - outradi.K, 'fro'); + nrmNM = norm(outnm.K, 'fro'); + if nrm / nrmNM >= 1e-9 + mess_err(opts, 'TEST:accuracy', ... + 'unexpectedly inaccurate result: ', ... + '||K_NM - K_RADI||_F / ||K_NM||_F=%g', nrm / nrmNM); end else figure(3); - ls_nm=[outnm.adi.niter]; - ls_radi=1:outradi.niter; + ls_nm = [outnm.adi.niter]; + ls_radi = 1:outradi.niter; - semilogy(cumsum(ls_nm),outnm.res,'k--',ls_radi,outradi.res,'b-','LineWidth',3); + semilogy(cumsum(ls_nm), outnm.res, 'k--', ... + ls_radi, outradi.res, 'b-', ... + 'LineWidth', 3); title('0= C^T C + A^T X E + E^T X A - E^T X BB^T X E'); xlabel('number of solves with A+p*E'); ylabel('normalized residual norm'); - legend('LR-NM','RADI'); + legend('LR-NM', 'RADI'); end diff --git a/DEMOS/TripleChain/private/square_root_method_SO.m b/DEMOS/TripleChain/private/square_root_method_SO.m index 27d4130..14c79cf 100644 --- a/DEMOS/TripleChain/private/square_root_method_SO.m +++ b/DEMOS/TripleChain/private/square_root_method_SO.m @@ -1,4 +1,4 @@ -function [TL,TR] = square_root_method_SO(M, max_ord, tol, inform, U,V) +function [TL, TR] = square_root_method_SO(M, max_ord, tol, inform, U, V) % Square root method for the computation of the transformation matrices to % balance and reduce second order systems % @@ -22,15 +22,15 @@ % % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % -[U0, S0, V0] = svd(V'*M*U, 0); - +[U0, S0, V0] = svd(V' * M * U, 0); +opts = struct; s0 = diag(S0); ks = length(s0); @@ -39,18 +39,17 @@ k0 = k0 + 1; end - r = min([max_ord k0]); if inform > 0 - fprintf(1, ['reduced system order: %d ',... - '(max possible/allowed: %d/%d)\n\n'], r, ks, max_ord); + mess_fprintf(opts, ['reduced system order: %d ', ... + '(max possible/allowed: %d/%d)\n\n'], r, ks, max_ord); end sigma_r = diag(S0(1:r, 1:r)); -VB = U * V0(:,1:r); -VC = V * U0(:,1:r); +VB = U * V0(:, 1:r); +VC = V * U0(:, 1:r); -TR = VB * diag(ones(r,1) ./ sqrt(sigma_r)); -TL = VC * diag(ones(r,1) ./ sqrt(sigma_r)); +TR = VB * diag(ones(r, 1) ./ sqrt(sigma_r)); +TL = VC * diag(ones(r, 1) ./ sqrt(sigma_r)); end diff --git a/DEMOS/models/BIPS/mess_get_BIPS.m b/DEMOS/models/BIPS/mess_get_BIPS.m index a18d4ff..381b72b 100644 --- a/DEMOS/models/BIPS/mess_get_BIPS.m +++ b/DEMOS/models/BIPS/mess_get_BIPS.m @@ -1,4 +1,4 @@ -function eqn = mess_get_BIPS(model, alpha) +function eqn = mess_get_BIPS(model, alpha, opts) %% Load the power systems example data and download it first, % if it has not yet been downloaded. % Examples taken from https://sites.google.com/site/rommes/software @@ -10,13 +10,13 @@ % model BIPS model selection (integer, default: 7) % name size inputs outputs % 1 BIPS/97 13251 1 1 -% 2 BIPS/1997 13250 1 1 -% 3 BIPS/97 13309 8 8 -% 4 BIPS/97 13251 28 28 -% 5 BIPS/97 13250 46 46 -% 6 Juba5723 40337 2 1 +% 2 BIPS/1997 13250 1 1 +% 3 BIPS/97 13309 8 8 +% 4 BIPS/97 13251 28 28 +% 5 BIPS/97 13250 46 46 +% 6 Juba5723 40337 2 1 % 7 bips98_606 7135 4 4 -% 8 bips98_1142 9735 4 4 +% 8 bips98_1142 9735 4 4 % 9 bips98_1450 11305 4 4 % 10 bips07_1693 13275 4 4 % 11 bips07_1998 15066 4 4 @@ -25,54 +25,63 @@ % alpha positive and real alpha in the alpha shift strategy % suggested by Rommes and coauthors in [1]. % (optional, default: 0.05) +% opts M.E.S.S. options for the logger +% % % Output: -% eqn equation structure for use with 'dae_2' usfs. +% eqn equation structure for use with 'dae_1' usfs. % % References: % [1] F. Freitas, J. Rommes, N. Martins, Gramian-based reduction method -% applied to large sparse power system descriptor models, IEEE Trans. -% Power Syst. 23 (3) (2008) 1258–1270. doi:10.1109/TPWRS.2008.926693 +% applied to large sparse power system descriptor models, IEEE Transactions +% on Power Systems 23 (3) (2008) 1258–1270. doi:10.1109/TPWRS.2008.926693 % % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % +if nargin < 1 + model = 7; +end if nargin < 2 alpha = 0.05; end -filenames={... - 'siso_ww_vref_6405.mat',... - 'siso_xingo_afonso_itaipu.mat',... - 'mimo8x8_system.mat',... - 'mimo28x28_system.mat',... - 'mimo46x46_system.mat',... - 'juba40k.mat',... - 'bips98_606.mat',... - 'bips98_1142.mat',... - 'bips98_1450.mat',... - 'bips07_1693.mat',... - 'bips07_1998.mat',... - 'bips07_2476.mat',... - 'bips07_3078.mat' - }; +if nargin < 3 + opts = struct(); +end + +filenames = { ... + 'siso_ww_vref_6405.mat', ... + 'siso_xingo_afonso_itaipu.mat', ... + 'mimo8x8_system.mat', ... + 'mimo28x28_system.mat', ... + 'mimo46x46_system.mat', ... + 'juba40k.mat', ... + 'bips98_606.mat', ... + 'bips98_1142.mat', ... + 'bips98_1450.mat', ... + 'bips07_1693.mat', ... + 'bips07_1998.mat', ... + 'bips07_2476.mat', ... + 'bips07_3078.mat' + }; base_file = filenames{model}; full_file = [fileparts(mfilename('fullpath')), filesep, base_file]; try Bips = load(full_file); catch - fprintf(['The file %s, is used for the first time.',... - 'It is available as a separate download.\n\n'], base_file); + mess_fprintf(opts, ['The file %s, is used for the first time.', ... + 'It is available as a separate download.\n\n'], base_file); - reply = input('Do you want to download it now? Y/N [Y]:','s'); + reply = input('Do you want to download it now? Y/N [Y]:', 's'); if isempty(reply) reply = 'Y'; @@ -82,31 +91,28 @@ case 'Y' url = 'https://csc.mpi-magdeburg.mpg.de/'; folder = 'mpcsc/software/mess/mmess/models/BIPS/'; - if exist('websave','file') - websave(full_file, [url, folder, base_file]); - else - urlwrite([url, folder, base_file], full_file); %#ok - end + mess_websave(full_file, [url, folder, base_file]); + case 'N' - error('The download is required.'); + mess_err(opts, 'check_data', 'The download is required.'); otherwise - error('Please answer Y or N.'); + mess_err(opts, 'illegal_input', 'Please answer Y or N.'); end Bips = load(full_file); end p = find(diag(Bips.E)); np = find(diag(Bips.E) == 0); -pp = [p;np]; +pp = [p; np]; if alpha == 0 eqn.A_ = Bips.A(pp, pp); else - eqn.A_ = Bips.A(pp, pp)-alpha*Bips.E(pp,pp); + eqn.A_ = Bips.A(pp, pp) - alpha * Bips.E(pp, pp); end eqn.E_ = Bips.E(pp, pp); switch model case {7, 8, 9, 10, 11, 12, 13} eqn.B = Bips.b(pp, :); - eqn.C = Bips.c( : , pp); + eqn.C = Bips.c(:, pp); case {1, 3, 4} eqn.B = Bips.b(pp, :); eqn.C = Bips.c(pp, :)'; @@ -116,7 +122,7 @@ case 6 eqn.B = Bips.B(pp, :); eqn.C = Bips.C(:, pp); - disp('Attention: This model is not stable!') + mess_fprintf(opts, 'Attention: This model is not stable!'); end -eqn.st = length(p); -eqn.haveE = 1; +eqn.manifold_dim = length(p); +eqn.haveE = true; diff --git a/DEMOS/models/Data_Rail/ODE_unit_matrices_20209.mat b/DEMOS/models/Data_Rail/ODE_unit_matrices_20209.mat index b5b90c2f509653b22405039758ad6f7405522ac8..94484257aa878b824fe7992ab304842c242ec1f3 100644 GIT binary patch delta 293 zcmWN=w^73Y06@{hB$F}GWRZgjmJkSwXfh^;6=>;PalfGWJsp!U0LK8#z!omy-M!lP zPp0<&JMqv;YqwwRaki>6Don)k58l+L0q*=1kBCXOU?b0Eg z(k0!JlOE}nKIxYM8I-&X$*_#bsEoz^x+{yhX53j#} D)@pH5 diff --git a/DEMOS/models/Data_Rail/ODE_unit_matrices_5177.mat b/DEMOS/models/Data_Rail/ODE_unit_matrices_5177.mat index 2579aaaff3807569a62d60c0423272222d93643b..c8d330868c5b7c824d9112ee6564c78e2b094b3c 100644 GIT binary patch delta 105 zcmV~$ISRr+06^Qo~q^+ zuFXBFO?Pi^N(yi35#_+C?2OyU{(n&f?7wIb9q)fU?59ukrq_^~uzEY5W(q9J1Kp7;1 zWrz%wVKQ7s$VeF_qh*YgONA6=tW?T4sgi0LFB7CjCdwq4EK_8vOq1y{LuN{?%#ztM zN9M{rsgwD#o~$n$$cD0!Y%H6|rm{dblg(ud*;2NWtz{e8R<@JvWe3?&c9NZC7ui)7 z%5Ji|>>+!~Ub46BBm2rC*-!SD1LQzCNDh{IIYbVX!{l%|LXMQ9B<)AbF>Y;-mdH{$MNXAva+;hj%jFC?Q_hmJ*mBzFZ&|%0+UqTq2jsWpcS( zAy>*(a<#0KYvfwFPOg_5!?vpigzdRrh z%0u$7JR*Ay3Lv^0Yi7&&qT1yu2VU%1iRHydtm4Yx26hA#ciCvR2-fcjR4p zPu`agWSx8{AIZn^iF_)b$>;Kgd?{ba*Yb^gE8ofY@`L;+KgrMXi~K6T$?x)q{3(CQ z-|~lqTXd2C;d9;X@Q5vnHb+n1L(JtCYhv*ocqH}bKuF);ZqI>j+ zp3y6MN1x~$h3FUkV?YdyK`}Un#LyTP!(&8@j8QQ<#zc8kL@~xjWsHlesE+Y5A!=e` jOp3`dC8ox-m>x4?X4J;4m>qLsZp@3ik~PdPSzY@-if!u4 delta 1112 zcmWO2WqTC_0EXdfG^2a;p&QN_8!;M2i`d=R0S2~@iu$OaC?@H(<}F%Sn7?3gp;TEYm1?SsHN|3~vRGMMxqj8UswGI7)RX$sKpILT zX)H~osgz4IX)Z0KrL>aP(ni`!J83T+q@#3_3h69eq^oq3?$SegNPOWi#1awva7lE7@AMk!@u=*?aFlk?b!A$boW@ES7`i5IIy1lf&f*IZ}?2v>z?U$g#3Sj+5i% z1W`_uljLMsD$C>)IaQX+X>z)(kTc{=IZMu#bL3oEDd)-ga)DeZ7snl| zTq#${)v`*ik!$5Txn6FN8)dcJBsa?~a;w}Xx62)Jr`#oXOP$;!_sSZ%Pu9x)@_;-j z56Q#wh&(Ef$>Z{bJSk7f)AEcwE6>UE@`Ai5FUiaDio7bX$?NilyeV(VI(b{(k$2@i zd0#$|_41*7Bp=Hs@~M0#pUW5WrFfYVKj=y(IlEic{GdW(IQ$#t7siyA - end - + + mess_websave(full_file, [url, folder, base_file]); + case 'N' - % we can not continue without the file. - error('The download is required.'); - + % we can not continue without the file. + mess_err(opts, 'check_data', 'The download is required.'); + otherwise - % illegal user input. - error('Please answer Y or N.'); + % illegal user input. + mess_err(opts, 'illegal_input', 'Please answer Y or N.'); end - + % OK, we should have the file now, let finally retry to load it. data = load(full_file); - -end end +end diff --git a/DEMOS/models/FDM_2D/fdm_2d_matrix.m b/DEMOS/models/FDM_2D/fdm_2d_matrix.m index 30198f8..908e1f5 100644 --- a/DEMOS/models/FDM_2D/fdm_2d_matrix.m +++ b/DEMOS/models/FDM_2D/fdm_2d_matrix.m @@ -1,4 +1,4 @@ -function [A, name] = fdm_2d_matrix(n0,fx_str,fy_str,g_str) +function [A, name] = fdm_2d_matrix(n0, fx_str, fy_str, g_str) % % Generates the stiffness matrix A for the finite difference % discretization (equidistant grid) of the PDE @@ -35,76 +35,76 @@ % LYAPACK 1.0 (Thilo Penzl, May 1999) % Input data not completely checked! - +opts = struct; na = nargin; -if na~=4 - error('Wrong number of input parameters.'); +if not(na == 4) + mess_err(opts, 'inputs', 'Wrong number of input parameters.'); end -name = ['FDM-2D: fx=',fx_str,'; fy=',fy_str,'; g=',g_str]; +name = ['FDM-2D: fx=', fx_str, '; fy=', fy_str, '; g=', g_str]; -n2 = n0*n0; +n2 = n0 * n0; -h = 1.0/(n0+1); +h = 1.0 / (n0 + 1); -h2 = h*h; +h2 = h * h; -t1 = 4.0/h2; -t2 = -1.0/h2; -t3 = 1.0/(2.0*h); +t1 = 4.0 / h2; +t2 = -1.0 / h2; +t3 = 1.0 / (2.0 * h); -len = 5*n2-4*n0; -I = zeros(len,1); -J = zeros(len,1); -S = zeros(len,1); +len = 5 * n2 - 4 * n0; +I = zeros(len, 1); +J = zeros(len, 1); +S = zeros(len, 1); ptr = 0; % Pointer i = 0; % Row Number for iy = 1:n0 - y = iy*h; %#ok used as part of fy_str - for ix = 1:n0 - x = ix*h; %#ok used as part of fx_str - - i = i+1; - fxv = eval(fx_str); - fyv = eval(fy_str); - gv = eval(g_str); - - if iy>1 - ptr = ptr+1; % A(i,i-n) - I(ptr) = i; - J(ptr) = i-n0; - S(ptr) = t2-fyv*t3; - end - - if ix>1 - ptr = ptr+1; % A(i,i-1) - I(ptr) = i; - J(ptr) = i-1; - S(ptr) = t2-fxv*t3; - end + y = iy * h; %#ok used as part of fy_str + for ix = 1:n0 + x = ix * h; %#ok used as part of fx_str + + i = i + 1; + fxv = eval(fx_str); + fyv = eval(fy_str); + gv = eval(g_str); + + if iy > 1 + ptr = ptr + 1; % A(i,i-n) + I(ptr) = i; + J(ptr) = i - n0; + S(ptr) = t2 - fyv * t3; + end + + if ix > 1 + ptr = ptr + 1; % A(i,i-1) + I(ptr) = i; + J(ptr) = i - 1; + S(ptr) = t2 - fxv * t3; + end + + ptr = ptr + 1; % A(i,i) + I(ptr) = i; + J(ptr) = i; + S(ptr) = t1 + gv; + + if ix < n0 + ptr = ptr + 1; % A(i,i+1) + I(ptr) = i; + J(ptr) = i + 1; + S(ptr) = t2 + fxv * t3; + end + + if iy < n0 + ptr = ptr + 1; % A(i,i+n0) + I(ptr) = i; + J(ptr) = i + n0; + S(ptr) = t2 + fyv * t3; + end - ptr = ptr+1; % A(i,i) - I(ptr) = i; - J(ptr) = i; - S(ptr) = t1+gv; - - if ix potentially used as part of f_str - for ix = 1:n0 - x = ix*h;%#ok potentially used as part of f_str - i = i+1; - v(i) = eval(f_str); - end + y = iy * h; %#ok potentially used as part of f_str + for ix = 1:n0 + x = ix * h; %#ok potentially used as part of f_str + i = i + 1; + v(i) = eval(f_str); + end end - - - diff --git a/DEMOS/models/FDM_2D/miss_hit.cfg b/DEMOS/models/FDM_2D/miss_hit.cfg new file mode 100644 index 0000000..57be691 --- /dev/null +++ b/DEMOS/models/FDM_2D/miss_hit.cfg @@ -0,0 +1 @@ +suppress_rule: "copyright_notice" \ No newline at end of file diff --git a/DEMOS/models/NSE/mess_get_NSE.m b/DEMOS/models/NSE/mess_get_NSE.m index 7df62bf..eabe9ce 100644 --- a/DEMOS/models/NSE/mess_get_NSE.m +++ b/DEMOS/models/NSE/mess_get_NSE.m @@ -20,27 +20,28 @@ % K0d initial stabilizing feedback for the dual system % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - +opts = struct; switch Re - case {300,400,500} + case {300, 400, 500} otherwise - error('parameter ''Re'' must be 300, 400, or 500.'); + mess_err(opts, 'illegal_input', ... + 'parameter ''Re'' must be 300, 400, or 500.'); end base_file = sprintf('mat_nse_re_%i.mat', Re); full_file = [fileparts(mfilename('fullpath')), filesep, base_file]; try - load(full_file,'mat'); + load(full_file, 'mat'); catch - fprintf(['The file mat_nse_re_%i.mat, is used for the first time.',... - 'It is available as a separate download (270MB).\n\n'], Re); + mess_fprintf(opts, ['The file mat_nse_re_%i.mat, is used for the first time.', ... + 'It is available as a separate download (270MB).\n\n'], Re); - reply = input('Do you want to download it now? Y/N [Y]:','s'); + reply = input('Do you want to download it now? Y/N [Y]:', 's'); if isempty(reply) reply = 'Y'; end @@ -48,29 +49,27 @@ case 'Y' url = 'https://csc.mpi-magdeburg.mpg.de/'; folder = 'mpcsc/software/mess/mmess/models/NSE/'; - if exist('websave','file') - websave(full_file, [url, folder, base_file]); - else - urlwrite([url, folder, base_file], full_file); %#ok - end + mess_websave(full_file, [url, folder, base_file]); + case 'N' - error(['The download is required for NSE example. ',... - 'Consider switching to the simple Stokes model.']); + mess_err(opts, 'check_data', ... + ['The download is required for NSE example. ', ... + 'Consider switching to the simple Stokes model.']); otherwise - error('Please answer Y or N.'); + mess_err(opts, 'illegal_input', 'Please answer Y or N.'); end - load(full_file,'mat'); + load(full_file, 'mat'); end eqn.A_ = mat.mat_v.fullA{level}; eqn.E_ = mat.mat_v.E{level}; -eqn.haveE = 1; +eqn.haveE = true; eqn.B = mat.mat_v.B{level}; eqn.C = mat.mat_v.C{level}; -eqn.st = mat.mat_mg.nv(level); +eqn.manifold_dim = mat.mat_mg.nv(level); K0p = mat.mat_v.Feed_0{level}'; K0d = mat.mat_v.Feed_1{level}'; if Re == 500 K0d = K0d'; -end \ No newline at end of file +end diff --git a/DEMOS/models/README.md b/DEMOS/models/README.md index 9b0e0e2..8063353 100644 --- a/DEMOS/models/README.md +++ b/DEMOS/models/README.md @@ -17,7 +17,7 @@ systems used in the demonstration examples. **SingleChainMSD** A simple scalable mass spring damper system -**TripleCchain** +**TripleChain** The Truhar/Veselic model made from three coupled mass-spring-damper chains. Size, i.e. masses per chain, and damper viscosity, as well as parameters in the Rayleigh damping used here can be set by the diff --git a/DEMOS/models/SingleChainMSD/SingleChainMSDgenMEK.m b/DEMOS/models/SingleChainMSD/SingleChainMSDgenMEK.m index 8e81e81..9430424 100644 --- a/DEMOS/models/SingleChainMSD/SingleChainMSDgenMEK.m +++ b/DEMOS/models/SingleChainMSD/SingleChainMSDgenMEK.m @@ -1,4 +1,4 @@ -function [M,E,K]=SingleChainMSDgenMEK(n) +function [M, E, K] = SingleChainMSDgenMEK(n) % [M,E,K]=genMEK(n) % % Generate system matrices of a mass-spring-damper-system @@ -23,24 +23,24 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % -M=spdiags(rand(n,1),0,n,n); -while (any(diag(M)==0)) - M=spdiags(rand(n,1),0,n,n); +M = spdiags(rand(n, 1), 0, n, n); +while any(diag(M) == 0) + M = spdiags(rand(n, 1), 0, n, n); end -E=spdiags(1e-2*rand(n,1),0,n,n); -while (any(diag(E)<=0)) - E=spdiags(rand(n,1),0,n,n); +E = spdiags(1e-2 * rand(n, 1), 0, n, n); +while any(diag(E) <= 0) + E = spdiags(rand(n, 1), 0, n, n); end -%x=rand(n,1); -x=ones(n,1); -y=[x(1:n-1)+x(2:n); x(n)]; -z=[x(n); x(1:n-1)]; +% x=rand(n,1); +x = ones(n, 1); +y = [x(1:n - 1) + x(2:n); x(n)]; +z = [x(n); x(1:n - 1)]; -K= spdiags( [-x y -z], -1:1,n,n); \ No newline at end of file +K = spdiags([-x y -z], -1:1, n, n); diff --git a/DEMOS/models/TripleChain/example_from_Saak09.m b/DEMOS/models/TripleChain/example_from_Saak09.m index 08fb189..03bd86f 100644 --- a/DEMOS/models/TripleChain/example_from_Saak09.m +++ b/DEMOS/models/TripleChain/example_from_Saak09.m @@ -15,40 +15,40 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % %% -n1=150; -alpha=0.01; -beta=alpha; -v=5e0; +opts = struct; +n1 = 150; +alpha = 0.01; +beta = alpha; +v = 5e0; %% -[M,E,K]=triplechain_MSD(n1,alpha,beta,v); -B=ones(3*n1+1,1); -Cp=B'; -Cv=zeros(size(Cp)); - +[M, E, K] = triplechain_MSD(n1, alpha, beta, v); +B = ones(3 * n1 + 1, 1); +Cp = B'; +Cv = zeros(size(Cp)); %% -nsample=200; -w=logspace(-4,2,nsample); +nsample = 200; +w = logspace(-4, 2, nsample); -tro=zeros(1,nsample); +tro = zeros(1, nsample); fprintf(['Computing TFMs of original systems and ' ... - 'MOR errors\n']) + 'MOR errors\n']); %% -for k=1:nsample - fprintf('\r Step %3d / %3d',k,nsample) - Go = (Cp + 1i*w(k)*Cv)/(-w(k)*w(k)*M + 1i*w(k)*D + K) * B; +for k = 1:nsample + mess_fprintf(opts, '\r Step %3d / %3d', k, nsample); + Go = (Cp + 1i * w(k) * Cv) / (-w(k) * w(k) * M + 1i * w(k) * D + K) * B; tro(k) = max(svds(Go)); end -fprintf('\n\n'); -figure(1) +mess_fprintf(opts, '\n\n'); +figure(1); loglog(w, tro, 'LineWidth', 3); xlabel('\omega'); ylabel('\sigma_{max}(G(j\omega))'); diff --git a/DEMOS/models/TripleChain/genMEK.m b/DEMOS/models/TripleChain/genMEK.m index ae266a4..2f1ab80 100644 --- a/DEMOS/models/TripleChain/genMEK.m +++ b/DEMOS/models/TripleChain/genMEK.m @@ -1,4 +1,4 @@ -function [M,E,K]=genMEK(n) +function [M, E, K] = genMEK(n) % [M,E,K]=genMEK(n) % % Generate system matrices of a mass-spring-damper-system @@ -24,24 +24,24 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % -M=spdiags(rand(n,1),0,n,n); -while (any(diag(M)==0)) - M=spdiags(rand(n,1),0,n,n); +M = spdiags(rand(n, 1), 0, n, n); +while any(diag(M) == 0) + M = spdiags(rand(n, 1), 0, n, n); end -E=spdiags(1e-2*rand(n,1),0,n,n); -while (any(diag(E)<=0)) - E=spdiags(rand(n,1),0,n,n); +E = spdiags(1e-2 * rand(n, 1), 0, n, n); +while any(diag(E) <= 0) + E = spdiags(rand(n, 1), 0, n, n); end -%x=rand(n,1); -x=ones(n,1); -y=[x(1:n-1)+x(2:n); x(n)]; -z=[x(n); x(1:n-1)]; +% x=rand(n,1); +x = ones(n, 1); +y = [x(1:n - 1) + x(2:n); x(n)]; +z = [x(n); x(1:n - 1)]; -K= spdiags( [-x y -z], -1:1,n,n); \ No newline at end of file +K = spdiags([-x y -z], -1:1, n, n); diff --git a/DEMOS/models/TripleChain/triplechain_MSD.m b/DEMOS/models/TripleChain/triplechain_MSD.m index efcf79d..56081a8 100644 --- a/DEMOS/models/TripleChain/triplechain_MSD.m +++ b/DEMOS/models/TripleChain/triplechain_MSD.m @@ -26,55 +26,52 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % +m1 = 1; +m2 = 2; +m3 = 3; +m0 = 10; +k1 = 10; +k2 = 20; +k3 = 1; +k0 = 50; -m1=1; -m2=2; -m3=3; -m0=10; - -k1=10; -k2=20; -k3=1; -k0=50; - -if nargin<2 - alpha=.002; - beta=alpha; - v=5e0; +if nargin < 2 + alpha = .002; + beta = alpha; + v = 5e0; end -M=spdiags([m1*ones(1,n1) m2*ones(1,n1) m3*ones(1,n1) m0]',0,3*n1+1,3*n1+1); -e=ones(n1,1); -K1=spdiags([-e 2*e -e],-1:1,n1,n1); - +M = spdiags([m1 * ones(1, n1) m2 * ones(1, n1) m3 * ones(1, n1) m0]', 0, 3 * n1 + 1, 3 * n1 + 1); +e = ones(n1, 1); +K1 = spdiags([-e 2 * e -e], -1:1, n1, n1); -K=sparse(3*n1+1,3*n1+1); -K(1:n1,1:n1)=k1*K1; -K(n1+1:2*n1,n1+1:2*n1)=k2*K1; -K(2*n1+1:3*n1,2*n1+1:3*n1)=k3*K1; +K = sparse(3 * n1 + 1, 3 * n1 + 1); +K(1:n1, 1:n1) = k1 * K1; +K(n1 + 1:2 * n1, n1 + 1:2 * n1) = k2 * K1; +K(2 * n1 + 1:3 * n1, 2 * n1 + 1:3 * n1) = k3 * K1; -K(1:n1,end)=-[sparse(1,n1-1) k1]'; -K(n1+1:2*n1,end)=-[sparse(1,n1-1) k2]'; -K(2*n1+1:3*n1,end)=-[sparse(1,n1-1) k3]'; +K(1:n1, end) = -[sparse(1, n1 - 1) k1]'; +K(n1 + 1:2 * n1, end) = -[sparse(1, n1 - 1) k2]'; +K(2 * n1 + 1:3 * n1, end) = -[sparse(1, n1 - 1) k3]'; -K(end,1:n1)=-[sparse(1,n1-1) k1]; -K(end,n1+1:2*n1)=-[sparse(1,n1-1) k2]; -K(end,2*n1+1:3*n1)=-[sparse(1,n1-1) k3]; -K(3*n1+1, 3*n1+1)=k1+k2+k3+k0; +K(end, 1:n1) = -[sparse(1, n1 - 1) k1]; +K(end, n1 + 1:2 * n1) = -[sparse(1, n1 - 1) k2]; +K(end, 2 * n1 + 1:3 * n1) = -[sparse(1, n1 - 1) k3]; +K(3 * n1 + 1, 3 * n1 + 1) = k1 + k2 + k3 + k0; -%fractional damping is used in [1] but needs full matrices due to the sqrtm -%SM=spdiags([sqrt(m1)*ones(1,n1) sqrt(m2)*ones(1,n1) sqrt(m3)*ones(1,n1)... +% fractional damping is used in [1] but needs full matrices due to the sqrtm +% SM=spdiags([sqrt(m1)*ones(1,n1) sqrt(m2)*ones(1,n1) sqrt(m3)*ones(1,n1)... % sqrt(m0)]',0,3*n1+1,3*n1+1); -%E=.02*(2*SM*sqrtm((SM\K)/SM)*SM); +% E=.02*(2*SM*sqrtm((SM\K)/SM)*SM); % here we want internal damping based on sparse matrices via Rayleigh damping: -E=alpha*M+beta*K; -E(1,1)=E(1,1)+v; -E(n1,n1)=E(n1,n1)+v; -E(2*n1+1,2*n1+1)=E(2*n1+1,2*n1+1)+v; \ No newline at end of file +E = alpha * M + beta * K; +E(1, 1) = E(1, 1) + v; +E(n1, n1) = E(n1, n1) + v; +E(2 * n1 + 1, 2 * n1 + 1) = E(2 * n1 + 1, 2 * n1 + 1) + v; diff --git a/DEMOS/models/ms_ind3_by_t_stykel/miss_hit.cfg b/DEMOS/models/ms_ind3_by_t_stykel/miss_hit.cfg new file mode 100644 index 0000000..57be691 --- /dev/null +++ b/DEMOS/models/ms_ind3_by_t_stykel/miss_hit.cfg @@ -0,0 +1 @@ +suppress_rule: "copyright_notice" \ No newline at end of file diff --git a/DEMOS/models/ms_ind3_by_t_stykel/msd_ind3.m b/DEMOS/models/ms_ind3_by_t_stykel/msd_ind3.m index ee4fad5..c5c2ad9 100644 --- a/DEMOS/models/ms_ind3_by_t_stykel/msd_ind3.m +++ b/DEMOS/models/ms_ind3_by_t_stykel/msd_ind3.m @@ -1,4 +1,4 @@ -function [E, A, B, C, M, D, K, G, Pl, Pr] = msd_ind3(g, mas, k1, k2, d1, d2) +function [E, A, B, C, M, D, K, G, Pl, Pr] = msd_ind3(g, mas, k1, k2, d1, d2, opts) % % Damped mass-spring system with a holonomic constraint % @@ -78,88 +78,117 @@ % % ---------------------------------------------------------------------- % T.Stykel, TU Berlin, 9.06.2006 +if nargin < 7 + opts = struct(); +end -n = 2*g+1; % state space dimension +n = 2 * g + 1; % state space dimension % Input parameters are not completely checked -if size(mas,1) < size(mas,2), mas = mas'; end -if size(k1,1) < size(k1,2), k1 = k1'; end -if size(k2,1) < size(k2,2), k2 = k2'; end -if size(d1,1) < size(d1,2), d1 = d1'; end -if size(d2,1) < size(d2,2), d2 = d2'; end +if size(mas, 1) < size(mas, 2) + mas = mas'; +end +if size(k1, 1) < size(k1, 2) + k1 = k1'; +end +if size(k2, 1) < size(k2, 2) + k2 = k2'; +end +if size(d1, 1) < size(d1, 2) + d1 = d1'; +end +if size(d2, 1) < size(d2, 2) + d2 = d2'; +end % Example from [1] -if isempty(mas), mas = 100*ones(g,1); end -if isempty(k1), k1 = 2*ones(g-1,1); end -if isempty(k2), k2 = 2*ones(g,1); k2(1) = 4; k2(g) = 4; end -if isempty(d1), d1 = 5*ones(g-1,1); end -if isempty(d2), d2 = 5*ones(g,1); d2(1) = 10;d2(g) = 10;end +if isempty(mas) + mas = 100 * ones(g, 1); +end +if isempty(k1) + k1 = 2 * ones(g - 1, 1); +end +if isempty(k2) + k2 = 2 * ones(g, 1); + k2(1) = 4; + k2(g) = 4; +end +if isempty(d1) + d1 = 5 * ones(g - 1, 1); +end +if isempty(d2) + d2 = 5 * ones(g, 1); + d2(1) = 10; + d2(g) = 10; +end % matrix M -M = spdiags(mas,0,g,g); +M = spdiags(mas, 0, g, g); % matrix K -K = spdiags(k1,-1,g,g); -K=K+K'-spdiags([0; k1]+k2+[k1; 0],0,g,g); +K = spdiags(k1, -1, g, g); +K = K + K' - spdiags([0; k1] + k2 + [k1; 0], 0, g, g); % matrix D -D = spdiags(d1,-1,g,g); -D = D+D'-spdiags([0; d1]+d2+[d1; 0],0,g,g); +D = spdiags(d1, -1, g, g); +D = D + D' - spdiags([0; d1] + d2 + [d1; 0], 0, g, g); % matrix G -G = zeros(1,g); -G(1)=1; -G(end)=-1; +G = zeros(1, g); +G(1) = 1; +G(end) = -1; % matrix E -E=sparse(n,n); -E(1:g,1:g)=speye(g); -E(g+1:2*g,g+1:2*g) = M; +E = sparse(n, n); +E(1:g, 1:g) = speye(g); +E(g + 1:2 * g, g + 1:2 * g) = M; % matrix A -A=sparse(n,n); -A(1:g,g+1:2*g)=speye(g); -A(g+1:2*g,1:g)=K; -A(g+1:2*g,g+1:2*g)=D; -A(2*g+1:end,1:g)=G; -A(g+1:2*g,2*g+1:end)=-G'; +A = sparse(n, n); +A(1:g, g + 1:2 * g) = speye(g); +A(g + 1:2 * g, 1:g) = K; +A(g + 1:2 * g, g + 1:2 * g) = D; +A(2 * g + 1:end, 1:g) = G; +A(g + 1:2 * g, 2 * g + 1:end) = -G'; % matrix B -B=sparse(n,1); -B(g+1,1)=1; +B = sparse(n, 1); +B(g + 1, 1) = 1; % matrix C -C=sparse(3,n); -C(1,1)=1; -C(2,2)=1; -C(3,g-1)=1; +C = sparse(3, n); +C(1, 1) = 1; +C(2, 2) = 1; +C(3, g - 1) = 1; -m=size(B,2); p=size(C,1); -disp('Problem dimensions:'); +m = size(B, 2); +p = size(C, 1); +mess_fprintf(opts, 'Problem dimensions:'); % nf and ninf are the dimensions of the deflating subspaces of s*E-A % corresponding to the finite and infinite eigenvalues, n=nf+ninf -disp(['n = ',int2str(n),', nf = ', int2str(n-3), ', ninf = ', int2str(3)]); -disp(['m = ',int2str(m),', p = ',int2str(p)]); +mess_fprintf(opts, ['n = ', int2str(n), ', nf = ', int2str(n - 3), ', ninf = ', int2str(3)]); +mess_fprintf(opts, ['m = ', int2str(m), ', p = ', int2str(p)]); -iM=spdiags(1./mas,0,g,g); %speye(g)/mas; -G=sparse(1,g); -G(1,1)=1; G(1,g)=-1; -GG=iM*G'/(G*iM*G'); -Pi=speye(g)-GG*G; +iM = spdiags(1 ./ mas, 0, g, g); % speye(g)/mas; +G = sparse(1, g); +G(1, 1) = 1; +G(1, g) = -1; +GG = iM * G' / (G * iM * G'); +Pi = speye(g) - GG * G; % projector Pl -Pl = sparse(n,n); -Pl(1:g,1:g) = Pi; -Pl(1:g,2*g+1:2*g+1) = -Pi*iM*D*GG; -Pl(g+1:2*g,1:g) = -M*Pi*iM*D*(GG*G); -Pl(g+1:2*g,g+1:2*g) = M*Pi*iM; -Pl(g+1:2*g,2*g+1) = -M*Pi*iM*(K+D*Pi*iM*D)*GG; +Pl = sparse(n, n); +Pl(1:g, 1:g) = Pi; +Pl(1:g, 2 * g + 1:2 * g + 1) = -Pi * iM * D * GG; +Pl(g + 1:2 * g, 1:g) = -M * Pi * iM * D * (GG * G); +Pl(g + 1:2 * g, g + 1:2 * g) = M * Pi * iM; +Pl(g + 1:2 * g, 2 * g + 1) = -M * Pi * iM * (K + D * Pi * iM * D) * GG; % projector Pr -Pr = sparse(n,n); -Pr(1:g,1:g) = Pi; -Pr(g+1:2*g,1:g) = -Pi*iM*D*GG*G; -Pr(g+1:2*g,g+1:2*g) = Pi; -GG = G/(G*iM*G'); -Pr(2*g+1,1:g) = GG*iM*(K*Pi-D*Pi*iM*D*iM*G'*GG); -Pr(2*g+1,g+1:2*g) = GG*iM*D*Pi; \ No newline at end of file +Pr = sparse(n, n); +Pr(1:g, 1:g) = Pi; +Pr(g + 1:2 * g, 1:g) = -Pi * iM * D * GG * G; +Pr(g + 1:2 * g, g + 1:2 * g) = Pi; +GG = G / (G * iM * G'); +Pr(2 * g + 1, 1:g) = GG * iM * (K * Pi - D * Pi * iM * D * iM * G' * GG); +Pr(2 * g + 1, g + 1:2 * g) = GG * iM * D * Pi; diff --git a/DEMOS/models/stokes/miss_hit.cfg b/DEMOS/models/stokes/miss_hit.cfg new file mode 100644 index 0000000..57be691 --- /dev/null +++ b/DEMOS/models/stokes/miss_hit.cfg @@ -0,0 +1 @@ +suppress_rule: "copyright_notice" \ No newline at end of file diff --git a/DEMOS/models/stokes/stokes_ind2.m b/DEMOS/models/stokes/stokes_ind2.m index 44b9f13..0a94442 100644 --- a/DEMOS/models/stokes/stokes_ind2.m +++ b/DEMOS/models/stokes/stokes_ind2.m @@ -1,4 +1,4 @@ -function [ E, A, B, C, nf ] = stokes_ind2(m, q, nx, ny) +function [E, A, B, C, nf] = stokes_ind2(m, q, nx, ny, opts) % % Semidiscretized 2D Stokes equation: % @@ -19,6 +19,7 @@ % q number of outputs % nx number of grid points in the x-direction ( nx>1 ) % ny the number of grid points in the y-direction ( ny>1 ) +% opts mess options (required for logger functions) % % OUTPUT: % E real n-by-n sparse matrix with @@ -39,10 +40,9 @@ % M.Schmidt, TU Berlin, 31.05.2007 % T.Stykel, TU Berlin, 24.11.2007 - global OmegaIn OmegaOut mu_choice nu_choice -%---------------------------------------------------------- +% ---------------------------------------------------------- % parameters % geometry: rectangular domain @@ -50,155 +50,148 @@ Length2 = 1; % geometry: rectangular control and observability subdomains -OmegaIn = [0.1,0.9,0.1,0.3]; -OmegaOut = [0.4,0.6,0.4,0.9]; +OmegaIn = [0.1, 0.9, 0.1, 0.3]; +OmegaOut = [0.4, 0.6, 0.4, 0.9]; % choose input and output basis functions mu_choice = 1; % see bfnc_mu.m for meaning of 1 nu_choice = 1; -%----------------------------------------------------------- +% ----------------------------------------------------------- % initialization % some often used variables... -h1 = Length1/nx; -h2 = Length2/ny; -x1 = linspace(h1/2,Length1-h1/2,nx); -x1e1 = linspace(h1,Length1-h1,nx-1); -x2 = linspace(h2/2,Length2-h2/2,ny); -x2e2 = linspace(h2,Length2-h2,ny-1); - -nv1 = (nx-1)*ny; -nv2 = (ny-1)*nx; -nv = nv1+nv2; -np = nx*ny; -nf = (nx-1)*(ny-1); +h1 = Length1 / nx; +h2 = Length2 / ny; +x1 = linspace(h1 / 2, Length1 - h1 / 2, nx); +x1e1 = linspace(h1, Length1 - h1, nx - 1); +x2 = linspace(h2 / 2, Length2 - h2 / 2, ny); +x2e2 = linspace(h2, Length2 - h2, ny - 1); + +nv1 = (nx - 1) * ny; +nv2 = (ny - 1) * nx; + +np = nx * ny; +nf = (nx - 1) * (ny - 1); % preallocate matrices -L1 = sparse(nv1,nv1); -G1 = sparse(nv1,np); -B1 = sparse(nv1,m); -C1 = sparse(q,nv1); -D1 = sparse(np,nv1); - -L2 = sparse(nv2,nv2); -G2 = sparse(nv2,np); -B2 = sparse(nv2,m); -C2 = sparse(q,nv2); -D2 = sparse(np,nv2); - -fprintf(1,'degrees of freedom: \n'); -fprintf(1,'------------------------------\n'); -fprintf(1,' total :%6.0f\n',nv1+nv2+np); -fprintf(1,' velocity :%6.0f\n',nv1+nv2); -fprintf(1,' pressure :%6.0f\n',np); -fprintf(1,' n_finite :%6.0f\n',nf); -fprintf(1,'------------------------------\n'); - -info.domain = [0,Length1,0,Length2]; -info.FVMdisc = [nx,ny] ; +L1 = sparse(nv1, nv1); +G1 = sparse(nv1, np); + +L2 = sparse(nv2, nv2); +G2 = sparse(nv2, np); + +mess_fprintf(opts, 'degrees of freedom: \n'); +mess_fprintf(opts, '------------------------------\n'); +mess_fprintf(opts, ' total :%6.0f\n', nv1 + nv2 + np); +mess_fprintf(opts, ' velocity :%6.0f\n', nv1 + nv2); +mess_fprintf(opts, ' pressure :%6.0f\n', np); +mess_fprintf(opts, ' n_finite :%6.0f\n', nf); +mess_fprintf(opts, '------------------------------\n'); + +info.domain = [0, Length1, 0, Length2]; +info.FVMdisc = [nx, ny]; info.OmegaIn = OmegaIn; info.OmegaOut = OmegaOut; -info.Ndof.total = nv1+nv2+np; +info.Ndof.total = nv1 + nv2 + np; info.Ndof.v1 = nv1; info.Ndof.v2 = nv2; info.Ndof.pres = np; info.Ndof.nf = nf; -%------------------------------------------------------------ +% ------------------------------------------------------------ % build FVM matrices -disp('Generating FVM matrices...'); +mess_fprintf(opts, 'Generating FVM matrices...\n'); % matrices divided by (h1*h2) in order to have mass matrix=identity % Matrix L1 -disp(' -> Laplacians...'); -auxM = sparse(nx-1,nx-1); -auxM = auxM - 2* speye(nx-1) + sparse(diag(ones(nx-2,1),1)); -auxM = auxM + sparse(diag(ones(nx-2,1),-1)); -L1 = L1 + 1/(h1*h1) * kron(speye(ny),auxM); +mess_fprintf(opts, ' -> Laplacians...\n'); +auxM = sparse(nx - 1, nx - 1); +auxM = auxM - 2 * speye(nx - 1) + sparse(diag(ones(nx - 2, 1), 1)); +auxM = auxM + sparse(diag(ones(nx - 2, 1), -1)); +L1 = L1 + 1 / (h1 * h1) * kron(speye(ny), auxM); clear auxM; % Matrix L2 -auxM = sparse(ny-1,ny-1); -auxM = auxM - 2* speye(ny-1) + sparse(diag(ones(ny-2,1),1)); -auxM = auxM + sparse(diag(ones(ny-2,1),-1)); -L2 = L2 + 1/(h2*h2) * kron(auxM,eye(nx)); +auxM = sparse(ny - 1, ny - 1); +auxM = auxM - 2 * speye(ny - 1) + sparse(diag(ones(ny - 2, 1), 1)); +auxM = auxM + sparse(diag(ones(ny - 2, 1), -1)); +L2 = L2 + 1 / (h2 * h2) * kron(auxM, eye(nx)); clear auxM; % Matrices G1 and D1 -disp(' -> gradient and divergence operator...'); -auxM = sparse(nx-1,nx); -nVec = sparse(nx-1,1); -auxM = auxM + [nVec,speye(nx-1)] - [speye(nx-1),nVec]; -G1 = G1 + 1/h1 * kron(speye(ny),auxM); +mess_fprintf(opts, ' -> gradient and divergence operator...\n'); +auxM = sparse(nx - 1, nx); +nVec = sparse(nx - 1, 1); +auxM = auxM + [nVec, speye(nx - 1)] - [speye(nx - 1), nVec]; +G1 = G1 + 1 / h1 * kron(speye(ny), auxM); D1 = -G1'; clear auxM; % Matrices G2 and D2 -auxM = sparse(ny-1,ny); -nVec = sparse(ny-1,1); -auxM = auxM + [nVec,speye(ny-1)] - [speye(ny-1),nVec]; -G2 = G2 + 1/h2 * kron(auxM,eye(nx)); +auxM = sparse(ny - 1, ny); +nVec = sparse(ny - 1, 1); +auxM = auxM + [nVec, speye(ny - 1)] - [speye(ny - 1), nVec]; +G2 = G2 + 1 / h2 * kron(auxM, eye(nx)); D2 = -G2'; clear auxM; % B1 and v1 velocity nodes -disp(' -> B1, C1 and v1 velocity nodes...'); -B1=sparse(nv1,m); -C1=sparse(q,nv1); -for i2=1:ny, +mess_fprintf(opts, ' -> B1, C1 and v1 velocity nodes...\n'); +B1 = sparse(nv1, m); +C1 = sparse(q, nv1); +for i2 = 1:ny xx1 = x1e1; - xx2 = x2(i2)*ones(1,nx-1); - v1x1((i2-1)*(nx-1)+1:i2*(nx-1),1)=xx1; - v1x2((i2-1)*(nx-1)+1:i2*(nx-1),1)=xx2; - for k=1:m, - B1((i2-1)*(nx-1)+1:i2*(nx-1),k)=vecBmu1(xx1,xx2,k)'; - end; - for l=1:q, - C1(l,(i2-1)*(nx-1)+1:i2*(nx-1))=h1*h2*vecCstarnu1(xx1,xx2,l); - end; -end; + xx2 = x2(i2) * ones(1, nx - 1); + v1x1((i2 - 1) * (nx - 1) + 1:i2 * (nx - 1), 1) = xx1; + v1x2((i2 - 1) * (nx - 1) + 1:i2 * (nx - 1), 1) = xx2; + for k = 1:m + B1((i2 - 1) * (nx - 1) + 1:i2 * (nx - 1), k) = ... + vecBmu1(xx1, xx2, k, opts)'; + end + for l = 1:q + C1(l, (i2 - 1) * (nx - 1) + 1:i2 * (nx - 1)) = ... + h1 * h2 * vecCstarnu1(xx1, xx2, l, opts); + end +end % B2 and v2 velocity nodes -disp(' -> B2, C2 and v2 velocity nodes...'); -B2=sparse(nv2,m); -C2=sparse(q,nv2); -for i2=1:ny-1, +mess_fprintf(opts, ' -> B2, C2 and v2 velocity nodes...\n'); +B2 = sparse(nv2, m); +C2 = sparse(q, nv2); +for i2 = 1:ny - 1 xx1 = x1; - xx2 = x2e2(i2)*ones(1,nx); - v2x1(1,(i2-1)*nx+1:i2*nx)=xx1; - v2x2(1,(i2-1)*nx+1:i2*nx)=xx2; - for k=1:m, - B2((i2-1)*nx+1:i2*nx,k)=vecBmu2(xx1,xx2,k)'; - end; - for l=1:q, - C2(l,(i2-1)*nx+1:i2*nx)=h1*h2*vecCstarnu2(xx1,xx2,l); - end; -end; - -%----------------------------------------------------- + xx2 = x2e2(i2) * ones(1, nx); + v2x1(1, (i2 - 1) * nx + 1:i2 * nx) = xx1; + v2x2(1, (i2 - 1) * nx + 1:i2 * nx) = xx2; + for k = 1:m + B2((i2 - 1) * nx + 1:i2 * nx, k) = vecBmu2(xx1, xx2, k, opts)'; + end + for l = 1:q + C2(l, (i2 - 1) * nx + 1:i2 * nx) = ... + h1 * h2 * vecCstarnu2(xx1, xx2, l, opts); + end +end + +% ----------------------------------------------------- % extract DAE -disp('Setting up system matrices ...'); -E = sparse(nv1+nv2+np-1,nv1+nv2+np-1); -A = sparse(nv1+nv2+np-1,nv1+nv2+np-1); -B = sparse(nv1+nv2+np-1,m); -C = sparse(q,nv1+nv2+np-1); -v1xx = [v1x1;v1x2]; -v2xx = [v2x1;v2x2]; -info = info; - -%E(1:nv1+nv2,1:nv1+nv2) = speye(nv1+nv2); -for j=1:nv1+nv2 - E(j,j)=1; +mess_fprintf(opts, 'Setting up system matrices ...\n'); +E = sparse(nv1 + nv2 + np - 1, nv1 + nv2 + np - 1); +B = sparse(nv1 + nv2 + np - 1, m); +C = sparse(q, nv1 + nv2 + np - 1); + +% E(1:nv1+nv2,1:nv1+nv2) = speye(nv1+nv2); +for j = 1:nv1 + nv2 + E(j, j) = 1; end -A = [L1 sparse(nv1,nv2) -G1(:,1:np-1); - sparse(nv2,nv1) L2 -G2(:,1:np-1); - D1(1:np-1,:) D2(1:np-1,:) sparse(np-1,np-1)]; +A = [L1 sparse(nv1, nv2) -G1(:, 1:np - 1) + sparse(nv2, nv1) L2 -G2(:, 1:np - 1) + D1(1:np - 1, :) D2(1:np - 1, :) sparse(np - 1, np - 1)]; -B(1:nv1+nv2,:) = [B1;B2]; -C(:,1:nv1+nv2) = [C1,C2]; +B(1:nv1 + nv2, :) = [B1; B2]; +C(:, 1:nv1 + nv2) = [C1, C2]; % % projectors Pl and Pr % A12=[-G1(:,1:np-1); -G2(:,1:np-1)]; @@ -209,8 +202,8 @@ clear L1 L2 G1 G2 D1 D2; -%------------------------------------------------------- -function [out,info]=Bmu(x1,x2,bfi,t); +% ------------------------------------------------------- +function [out, info] = Bmu(opts, x1, x2, bfi, t) % Bmu(x1,x2,bfi) % % Version 1.2, last change: 25-07-06 @@ -219,101 +212,113 @@ % % out = Bmu(x1,x2,bfi,t) -global controlChoice OmegaIn; +global controlChoice OmegaIn % specify default input function for the case nargin==3 -defaultInputName ='u'; +defaultInputName = 'u'; % specify support rectangle -if isempty('OmegaIn'), error('Bmu.m requires global "OmegaIn"'); end; - dc1 = (OmegaIn(2)-OmegaIn(1))/2; - xc1 = OmegaIn(1)+dc1; - dc2 = (OmegaIn(4)-OmegaIn(3))/2; - xc2 = OmegaIn(3)+dc2; +if isempty('OmegaIn') + mess_err(opts, 'inputs', 'Bmu.m requires global "OmegaIn"'); +end +dc1 = (OmegaIn(2) - OmegaIn(1)) / 2; +xc1 = OmegaIn(1) + dc1; +dc2 = (OmegaIn(4) - OmegaIn(3)) / 2; +xc2 = OmegaIn(3) + dc2; info.Omega_c = OmegaIn; -if size(x1,1)>1, x1=x1'; end; -if size(x2,1)>1, x2=x2'; end; +if size(x1, 1) > 1 + x1 = x1'; +end +if size(x2, 1) > 1 + x2 = x2'; +end % preallocate output -out=zeros(size(x1)); +out = zeros(size(x1)); % find points in \Omega_c -PInd=intersect(find(x1>xc1-dc1 & x1xc2-dc2 & x2 xc1 - dc1 & x1 < xc1 + dc1), ... + find(x2 > xc2 - dc2 & x2 < xc2 + dc2)); % theta(x1) -theta =(x1(PInd)-xc1)/(2*dc1)+0.5; %x1 -->theta \in [0,1] -x2tilde =(x2(PInd)-xc2)/(2*dc2)+0.5; %x2 -->x2tilde \in [0,1] +theta = (x1(PInd) - xc1) / (2 * dc1) + 0.5; % x1 -->theta \in [0,1] +x2tilde = (x2(PInd) - xc2) / (2 * dc2) + 0.5; % x2 -->x2tilde \in [0,1] % calculate Bmu switch nargin - case 3, % Bmu as initial value or observation weight with mu-basis funtion - bfi=bfi(1); - out(PInd)=bfnc_mu(theta,bfi).*w_c(x2tilde); + case 4 % Bmu as initial value or observation weight with mu-basis function + bfi = bfi(1); + out(PInd) = bfnc_mu(theta, bfi) .* w_c(x2tilde); % specify support of Bmu - [forget,mu_info]=bfnc_mu(0,bfi); - info.suppBmu =[ (mu_info.suppstart-0.5)*2*dc1+xc1 (mu_info.suppend-0.5)*2*dc1+xc1 xc2-dc2 xc2+dc2]; - case 4, %control right hand sight for control function u(theta,t) - t=t(1); + [~, mu_info] = bfnc_mu(0, bfi); + info.suppBmu = [(mu_info.suppstart - 0.5) * 2 * dc1 + ... + xc1 (mu_info.suppend - 0.5) * 2 * dc1 + ... + xc1 xc2 - dc2 xc2 + dc2]; + case 5 % control right hand sight for control function u(theta,t) + t = t(1); % specify control input function - if exist('controlChoice'), + if exist('controlChoice') inputName = controlChoice; - if isempty(controlChoice); - warning(['default input used: "',defaultInputName,'.m"']); - inputName=defaultInputName;end; - else, - inputName =defaultInputName; - end; + if isempty(controlChoice) + warning(['default input used: "', defaultInputName, '.m"']); + inputName = defaultInputName; + end + else + inputName = defaultInputName; + end % u(theta,t) has dimensions length(theta) x length(t) - out(PInd)=feval(inputName,theta,t)'.*w_c(x2tilde); + out(PInd) = feval(inputName, theta, t)' .* w_c(x2tilde); otherwise - error('not right choice of input arguments!'); -end; + mess_err(opts, 'inputs', 'not right choice of input arguments!'); +end -%------------------ +% ------------------ % weighting function w_c:[0,1] --> R -function out=w_c(x2); +function out = w_c(x2) global Wn -Wn=[1]; -out=zeros(size(x2)); -for n=1:length(Wn), - out=out+sin(n*pi*x2); -end; - -%--------------------------------------------------------- -function [out,info]=vecBmu1(x1,x2,bfi); - -bfi=bfi(1); %necessary since size(bfi)=size(x1); -out=zeros(size(x1)); - -switch nargin, - case 3, - if mod(bfi,2)==1, - [out,info]=Bmu(x1,x2,(bfi+1)/2); - end; - otherwise, - error('false number of input arguments'); -end; -out=100*out; - -%--------------------------------------------------------- -function [out,info]=vecBmu2(x1,x2,bfi); - -bfi=bfi(1);%necessary since size(bfi)=size(x1); -out=zeros(size(x1)); - -switch nargin, - case 3, - if mod(bfi,2)==0, - [out,info]=Bmu(x1,x2,bfi/2); - end; - otherwise, - error('false number of input arguments'); -end; -out=100*out; - -%-------------------------------------------------------- -function [out,mu_info]=bfnc_mu(x,bfi,lcomb) +Wn = 1; +out = zeros(size(x2)); +for n = 1:length(Wn) + out = out + sin(n * pi * x2); +end + +% --------------------------------------------------------- +function [out, info] = vecBmu1(x1, x2, bfi, opts) + +bfi = bfi(1); % necessary since size(bfi)=size(x1); +out = zeros(size(x1)); + +switch nargin + case 4 + if mod(bfi, 2) == 1 + [out, info] = Bmu(opts, x1, x2, (bfi + 1) / 2); + end + otherwise + mess_err(opts, 'inputs', ... + 'false number of input arguments'); +end +out = 100 * out; + +% --------------------------------------------------------- +function [out, info] = vecBmu2(x1, x2, bfi, opts) + +bfi = bfi(1); % necessary since size(bfi)=size(x1); +out = zeros(size(x1)); + +switch nargin + case 4 + if mod(bfi, 2) == 0 + [out, info] = Bmu(opts, x1, x2, bfi / 2); + end + otherwise + mess_err(opts, 'inputs', ... + 'false number of input arguments'); +end +out = 100 * out; + +% -------------------------------------------------------- +function [out, mu_info] = bfnc_mu(x, bfi, lcomb) % [out,mu_info]=inpbasis(x,bfi) % creates continuous basis functions \mu_i of \tilde U % output is always row vector @@ -334,38 +339,40 @@ % mu_info.h1l - grid fineness on this level global mu_choice pmax +opts = struct; -%disp('bnfc_mu'); - -if nargin<2, error('not enough input arguments'); end; -if isempty(mu_choice), error('mu_choice must be globally defined');end; - +if nargin < 2 + mess_err(opts, 'inputs', 'not enough input arguments'); +end +if isempty(mu_choice) + mess_err(opts, 'inputs', 'mu_choice must be globally defined'); +end -if nargin==2, - switch mu_choice, - case 2, %linear hat functions in H_0^1: hierarchical +if nargin == 2 + switch mu_choice + case 2 % linear hat functions in H_0^1: hierarchical % find level and levelindex - lvl =length(dec2bin(bfi))-1; - lvlind =bfi-2^lvl; + lvl = length(dec2bin(bfi)) - 1; + lvlind = bfi - 2^lvl; % scale and shift reference function - out=PSI2(2^lvl*x-lvlind*ones(size(x))); + out = PSI2(2^lvl * x - lvlind * ones(size(x))); % give information on basis function - mu_info.suppstart = lvlind/2^lvl; - mu_info.node = (lvlind+0.5)/2^lvl; - mu_info.suppend = (lvlind+1)/2^lvl; - %mu_info.bflevels = 0; + mu_info.suppstart = lvlind / 2^lvl; + mu_info.node = (lvlind + 0.5) / 2^lvl; + mu_info.suppend = (lvlind + 1) / 2^lvl; + % mu_info.bflevels = 0; mu_info.bfi_lvl = lvl; mu_info.bfi_lvlind = lvlind; - mu_info.h = 1/2^(lvl+1); - case 1, %linear hat functions in L^2: hierarchical - if bfi<=2, %two additional basis functions w.r.t. case 1 - if bfi==1, - out=ones(size(x))-x; - mu_info.node=0; - else %bfi==2 - out=x; - mu_info.node=1; - end; + mu_info.h = 1 / 2^(lvl + 1); + case 1 % linear hat functions in L^2: hierarchical + if bfi <= 2 % two additional basis functions w.r.t. case 1 + if bfi == 1 + out = ones(size(x)) - x; + mu_info.node = 0; + else % bfi==2 + out = x; + mu_info.node = 1; + end % give information on basis function mu_info.suppstart = 0; mu_info.suppend = 1; @@ -373,72 +380,79 @@ mu_info.bfi_lvl = -1; mu_info.bfi_lvlind = bfi; mu_info.h = 1; - else, % as in case 1 with shifted bfi - bfi=bfi-2; + else % as in case 1 with shifted bfi + bfi = bfi - 2; % find level and levelindex - lvl =length(dec2bin(bfi))-1; - lvlind =bfi-2^lvl; + lvl = length(dec2bin(bfi)) - 1; + lvlind = bfi - 2^lvl; % scale and shift reference function - out=PSI2(2^lvl*x-lvlind*ones(size(x))); + out = PSI2(2^lvl * x - lvlind * ones(size(x))); % give information on basis function - mu_info.suppstart = lvlind/2^lvl; - mu_info.node = (lvlind+0.5)/2^lvl; - mu_info.suppend = (lvlind+1)/2^lvl; - %mu_info.bflevels = 0; + mu_info.suppstart = lvlind / 2^lvl; + mu_info.node = (lvlind + 0.5) / 2^lvl; + mu_info.suppend = (lvlind + 1) / 2^lvl; + % mu_info.bflevels = 0; mu_info.bfi_lvl = lvl; mu_info.bfi_lvlind = lvlind; - mu_info.h = 1/2^(lvl+1); - end; - case 3, - if isempty(pmax), error('global variable pmax not defined...');end; - h=1/(pmax-1); - out=PSI2(x/(2*h)-(bfi-2)/2); - mu_info.suppstart = max(0,(bfi-2)*h); - mu_info.node = (bfi-1)*h; - mu_info.suppend = min(1,bfi*h); - mu_info.h =h; - case 4, - error('not yet implemented'); - case 5, - if mod(bfi,2)==1, %impair bfi --> cosinus (cos(0) is first basis function!) - if floor(bfi/2)==0, - out=ones(size(x)); - else, - out=sqrt(2)*cos(2*floor(bfi/2)*pi*x); - end; - else, %pair bfi --> sinus - out=sqrt(2)*sin(2*bfi/2*pi*x); + mu_info.h = 1 / 2^(lvl + 1); + end + case 3 + if isempty(pmax) + mess_err(opts, 'inputs', ... + 'global variable pmax not defined...'); + end + h = 1 / (pmax - 1); + out = PSI2(x / (2 * h) - (bfi - 2) / 2); + mu_info.suppstart = max(0, (bfi - 2) * h); + mu_info.node = (bfi - 1) * h; + mu_info.suppend = min(1, bfi * h); + mu_info.h = h; + case 4 + mess_err(opts, 'notimplemented', 'not yet implemented'); + case 5 + if mod(bfi, 2) == 1 % impair bfi --> cosinus + % (cos(0) is first basis function!) + if floor(bfi / 2) == 0 + out = ones(size(x)); + else + out = sqrt(2) * cos(2 * floor(bfi / 2) * pi * x); + end + else % pair bfi --> sinus + out = sqrt(2) * sin(2 * bfi / 2 * pi * x); end mu_info.suppstart = 0; mu_info.node = []; mu_info.suppend = 1; - case 6, %FOR COMPARISON WITH EXACT KERNEL (HOM. DIRICHLET ON [0,1]^2) - out=sqrt(2)*sin(bfi*pi*x); + case 6 % FOR COMPARISON WITH EXACT KERNEL (HOM. DIRICHLET ON [0,1]^2) + out = sqrt(2) * sin(bfi * pi * x); mu_info.suppstart = 0; mu_info.node = []; mu_info.suppend = 1; otherwise - error('Basis or method choice invalid'); - end; -else, % LINEAR COMBINATION lcomb + mess_err(opts, 'illegal_input', ... + 'Basis or method choice invalid'); + end +else % LINEAR COMBINATION lcomb out = zeros(size(x)); mu_info.suppstart = 1; mu_info.node = []; mu_info.suppend = 0; - for n=1:length(lcomb), - [out_temp,info] = bfnc_mu(x,n); - out = out+lcomb(n)*out_temp; - mu_info.suppstart = min(mu_info.suppstart,info.suppstart); - mu_info.suppend = max(mu_info.suppend,info.suppend); - end; -end; + for n = 1:length(lcomb) + [out_temp, info] = bfnc_mu(x, n); + out = out + lcomb(n) * out_temp; + mu_info.suppstart = min(mu_info.suppstart, info.suppstart); + mu_info.suppend = max(mu_info.suppend, info.suppend); + end +end -if size(out,1)>1, out=out'; end; +if size(out, 1) > 1 + out = out'; +end -%-------------------------------------------------------- -function [out,nu_info]=bfnc_nu(x,bfi,lcomb) +% -------------------------------------------------------- +function [out, nu_info] = bfnc_nu(x, bfi, lcomb) global nu_choice @@ -458,96 +472,101 @@ % nu_info.bfi_lvl - level of specific basis function bfi % nu_info.bfi_lvlind - index on this level % nu_info.h1l - grid fineness on this level +opts = struct; +if nargin < 2 + mess_err(opts, 'inputs', 'not enough input arguments'); +end +if isempty(nu_choice) + mess_err(opts, 'inputs', 'nu_choice must be globally defined'); +end -if nargin<2, error('not enough input arguments'); end; -if isempty(nu_choice), error('nu_choice must be globally defined');end; - -if nargin==2, -switch nu_choice, - case 2, %linear hat functions in H_0^1: hierarchical - % find level and levelindex - lvl =length(dec2bin(bfi))-1; - lvlind =bfi-2^lvl; - % scale and shift reference function - out=PSI2(2^lvl*x-lvlind*ones(size(x))); - % give information on basis function - nu_info.suppstart = lvlind/2^lvl; - nu_info.node = (lvlind+0.5)/2^lvl; - nu_info.suppend = (lvlind+1)/2^lvl; - %nu_info.bflevels = 0; - nu_info.bfi_lvl = lvl; - nu_info.bfi_lvlind = lvlind; - nu_info.h = 1/2^(lvl+1); - case 1, %linear hat functions in L^2: hierarchical - if bfi<=2, %two additional basis functions w.r.t. case 1 - if bfi==1, - out=ones(size(x))-x; - mu_info.node=0; - else %bfi==2 - out=x; - nu_info.node=1; - end; - % give information on basis function - nu_info.suppstart = 0; - nu_info.suppend = 1; - nu_info.bfi_lvl = -1; - nu_info.bfi_lvlind = bfi; - nu_info.h = 1; - else, % as in case 1 with shifted bfi - bfi=bfi-2; +if nargin == 2 + switch nu_choice + case 2 % linear hat functions in H_0^1: hierarchical % find level and levelindex - lvl =length(dec2bin(bfi))-1; - lvlind =bfi-2^lvl; + lvl = length(dec2bin(bfi)) - 1; + lvlind = bfi - 2^lvl; % scale and shift reference function - out=PSI2(2^lvl*x-lvlind*ones(size(x))); + out = PSI2(2^lvl * x - lvlind * ones(size(x))); % give information on basis function - nu_info.suppstart = lvlind/2^lvl; - nu_info.node = (lvlind+0.5)/2^lvl; - nu_info.suppend = (lvlind+1)/2^lvl; - %nu_info.bflevels = 0; + nu_info.suppstart = lvlind / 2^lvl; + nu_info.node = (lvlind + 0.5) / 2^lvl; + nu_info.suppend = (lvlind + 1) / 2^lvl; + % nu_info.bflevels = 0; nu_info.bfi_lvl = lvl; nu_info.bfi_lvlind = lvlind; - nu_info.h = 1/2^(lvl+1); - end; - case 3, - error('not yet implemented'); - case 4, - error('not yet implemented'); - case 5, - if mod(bfi,2)==1, %impair bfi --> cosinus (cos(0) is first basis function!) - out=0.5*cos(2*floor(bfi/2)*pi*x); - else, %pair bfi --> sinus - out=0.5*sin(2*bfi/2*pi*x); - end - nu_info.suppstart = 0; - nu_info.suppend = 1; - otherwise - error('Basis or method choice invalid'); -end; -else, - out=zeros(size(x)); - nu_info.suppstart=1; - nu_info.suppend =0; - for n=1:length(lcomb), - [out_temp,info]=bfnc_nu(x,n); - out=out+lcomb(n)*out_temp; - nu_info.suppstart=min(nu_info.suppstart,info.suppstart); - nu_info.suppend =max(nu_info.suppend,info.suppend); - end; -end; - -%--------------------- + nu_info.h = 1 / 2^(lvl + 1); + case 1 % linear hat functions in L^2: hierarchical + if bfi <= 2 % two additional basis functions w.r.t. case 1 + if bfi == 1 + out = ones(size(x)) - x; + mu_info.node = 0; + else % bfi==2 + out = x; + nu_info.node = 1; + end + % give information on basis function + nu_info.suppstart = 0; + nu_info.suppend = 1; + nu_info.bfi_lvl = -1; + nu_info.bfi_lvlind = bfi; + nu_info.h = 1; + else % as in case 1 with shifted bfi + bfi = bfi - 2; + % find level and levelindex + lvl = length(dec2bin(bfi)) - 1; + lvlind = bfi - 2^lvl; + % scale and shift reference function + out = PSI2(2^lvl * x - lvlind * ones(size(x))); + % give information on basis function + nu_info.suppstart = lvlind / 2^lvl; + nu_info.node = (lvlind + 0.5) / 2^lvl; + nu_info.suppend = (lvlind + 1) / 2^lvl; + % nu_info.bflevels = 0; + nu_info.bfi_lvl = lvl; + nu_info.bfi_lvlind = lvlind; + nu_info.h = 1 / 2^(lvl + 1); + end + case 3 + mess_err(opts, 'notimplemented', 'not yet implemented'); + case 4 + mess_err(opts, 'notimplemented', 'not yet implemented'); + case 5 + if mod(bfi, 2) == 1 % impair bfi --> cosinus + % (cos(0) is first basis function!) + out = 0.5 * cos(2 * floor(bfi / 2) * pi * x); + else % pair bfi --> sinus + out = 0.5 * sin(2 * bfi / 2 * pi * x); + end + nu_info.suppstart = 0; + nu_info.suppend = 1; + otherwise + mess_err(opts, 'illegal_input', 'Basis or method choice invalid'); + end +else + out = zeros(size(x)); + nu_info.suppstart = 1; + nu_info.suppend = 0; + for n = 1:length(lcomb) + [out_temp, info] = bfnc_nu(x, n); + out = out + lcomb(n) * out_temp; + nu_info.suppstart = min(nu_info.suppstart, info.suppstart); + nu_info.suppend = max(nu_info.suppend, info.suppend); + end +end + +% --------------------- % linear hat function with support [0,1] -function out=PSI2(t); -ind_p1=find(t>=0&t<0.5); -ind_m1=find(t>=0.5&t<1); -out=zeros(size(t)); -out(ind_p1)=t(ind_p1)*2; -out(ind_m1)=2-t(ind_m1)*2; - -%------------------------------------------------------- -function [out,info]=Cstarnu(x1,x2,bfi); +function out = PSI2(t) +ind_p1 = find(t >= 0 & t < 0.5); +ind_m1 = find(t >= 0.5 & t < 1); +out = zeros(size(t)); +out(ind_p1) = t(ind_p1) * 2; +out(ind_m1) = 2 - t(ind_m1) * 2; + +% ------------------------------------------------------- +function [out, info] = Cstarnu(x1, x2, bfi, opts) % % Version 1.2, last change: 25-07-06 % Michael Schmidt, TU Berlin, Inst. f. Mathematik, @@ -555,70 +574,74 @@ % initialization global OmegaOut -bfi =bfi(1); -xi_of ='x2'; -out =zeros(size(x1)); +bfi = bfi(1); +xi_of = 'x2'; +out = zeros(size(x1)); % specify support rectangle -if isempty('OmegaOut'), error('Cstarnu.m requires global "OmegaOut"'); end; -dm1=(OmegaOut(2)-OmegaOut(1))/2; -xm1=OmegaOut(1)+dm1; -dm2=(OmegaOut(4)-OmegaOut(3))/2; -xm2=OmegaOut(3)+dm2; -info.Omega_m =OmegaOut; +if isempty('OmegaOut') + mess_err(opts, 'inputs', ... + 'Cstarnu.m requires global "OmegaOut"'); +end +dm1 = (OmegaOut(2) - OmegaOut(1)) / 2; +xm1 = OmegaOut(1) + dm1; +dm2 = (OmegaOut(4) - OmegaOut(3)) / 2; +xm2 = OmegaOut(3) + dm2; +info.Omega_m = OmegaOut; switch xi_of - case 'x1', + case 'x1' % find points in \Omega_m and assign value there - fInd=intersect(find(x1>xm1-dm1 & x1xm2-dm2 & x2 xm1 - dm1 & x1 < xm1 + dm1), ... + find(x2 > xm2 - dm2 & x2 < xm2 + dm2)); - xi =(x1(fInd)-xm1)/(2*dm1)+0.5; - out(fInd) =bfnc_nu(xi,bfi)/(2*dm2*2*dm1); + xi = (x1(fInd) - xm1) / (2 * dm1) + 0.5; + out(fInd) = bfnc_nu(xi, bfi) / (2 * dm2 * 2 * dm1); % specify support of Cstarnu - [forget,nu_info] =bfnc_nu(0,bfi); - info.suppCstarnu =[(nu_info.suppstart-0.5)*2*dm1+xm1... - (nu_info.suppend-0.5)*2*dm1+xm1... - xm2-dm2 xm2+dm2]; - case 'x2', + [~, nu_info] = bfnc_nu(0, bfi); + info.suppCstarnu = [(nu_info.suppstart - 0.5) * 2 * dm1 + xm1... + (nu_info.suppend - 0.5) * 2 * dm1 + xm1... + xm2 - dm2 xm2 + dm2]; + case 'x2' % find points in \Omega_m and assign value there - fInd=intersect(find(x1>xm1-dm1 & x1xm2-dm2 & x2 xm1 - dm1 & x1 < xm1 + dm1), ... + find(x2 > xm2 - dm2 & x2 < xm2 + dm2)); - xi =(x2(fInd)-xm2)/(2*dm2)+0.5; - out(fInd) =bfnc_nu(xi,bfi)/(2*dm2*2*dm1); + xi = (x2(fInd) - xm2) / (2 * dm2) + 0.5; + out(fInd) = bfnc_nu(xi, bfi) / (2 * dm2 * 2 * dm1); % specify support of Cstarnu - [forget,nu_info] =bfnc_nu(0,bfi); - info.suppCstarnu =[xm1-dm1 xm1+dm1... - (nu_info.suppstart-0.5)*2*dm2+xm2... - (nu_info.suppend-0.5)*2*dm2+xm2]; -end; - -%----------------------------------------------------- -function [out,info]=vecCstarnu1(x1,x2,bfi); - -bfi=bfi(1); -out=zeros(size(x1)); -switch nargin, - case 3, - if mod(bfi,2)==1, - [out,info]=Cstarnu(x1,x2,(bfi+1)/2); - end; - otherwise, - error('false number of input arguments'); -end; - -%----------------------------------------------------- -function [out,info]=vecCstarnu2(x1,x2,bfi); - -bfi=bfi(1); -out=zeros(size(x1)); -switch nargin, - case 3, - if mod(bfi,2)==0, - [out,info]=Cstarnu(x1,x2,bfi/2); - % disp(['calling Cstarnu ',numstr(bfi/2)]); - end; - otherwise, - error('false number of input arguments'); -end; \ No newline at end of file + [~, nu_info] = bfnc_nu(0, bfi); + info.suppCstarnu = [xm1 - dm1 xm1 + dm1... + (nu_info.suppstart - 0.5) * 2 * dm2 + xm2... + (nu_info.suppend - 0.5) * 2 * dm2 + xm2]; +end + +% ----------------------------------------------------- +function [out, info] = vecCstarnu1(x1, x2, bfi, opts) + +bfi = bfi(1); +out = zeros(size(x1)); +switch nargin + case 4 + if mod(bfi, 2) == 1 + [out, info] = Cstarnu(x1, x2, (bfi + 1) / 2); + end + otherwise + mess_err(opts, 'inputs', 'false number of input arguments'); +end + +% ----------------------------------------------------- +function [out, info] = vecCstarnu2(x1, x2, bfi, opts) + +bfi = bfi(1); +out = zeros(size(x1)); +switch nargin + case 4 + if mod(bfi, 2) == 0 + [out, info] = Cstarnu(x1, x2, bfi / 2); + end + otherwise + mess_err(opts, 'inputs', 'false number of input arguments'); +end diff --git a/DEPENDENCIES.md b/DEPENDENCIES.md index a976d7e..027b01f 100644 --- a/DEPENDENCIES.md +++ b/DEPENDENCIES.md @@ -1,4 +1,4 @@ -# Dependencies of M-M.E.S.S. 2.2 +# Dependencies of M-M.E.S.S. 3.0 ## Basic requirements @@ -20,6 +20,10 @@ spparms('usema57', 0); to fix this, or upgrade to at least R2017b update 5. +The `mess_get_*` model (down)loader functions require at least R2019b, +since MATLAB ships its own SSL certificates and those are outdated in +the older versions. + MATLAB R2021a has proven to be up to 20% faster than predecessors in our continuous integration tests. So upgrading is highly recommended. @@ -30,7 +34,7 @@ with proper support for non-trivial mass matrices. We highly recommend Octave 5.2 and above with proper SUNDIALS support compiled in. Octave 6.2.0 based on OpenBLAS has shown to be competitive with MATLAB -in recent releases for our continuous integration tests. +versions released around the same time for our continuous integration tests. The splitting schemes further need Octave to be compiled with FFTW support. @@ -40,9 +44,9 @@ The splitting schemes further need Octave to be compiled with FFTW support. Control package in Octave. More precisely, whenever projected Lyapunov or Riccati equations are solved, we use `lyap`, `care` or `icare` if available, but fallbacks exist in case any of those is not found. -(affected files: helpers/mess_galerkin_projection_acceleration.m) +(affected files: `helpers/mess_solve_projected_eqn.m`) 2.) Factorizations of symmetric and (semi)definite projected solutions in the context of 1.) can benefit from the file *cholp.m* from the **Test Matrix Computation Toolbox** by Nicholas J. Higham. -(affected files: helpers/mess_galerkin_projection_acceleration.m) +(affected files: `helpers/mess_solve_projected_eqn.m`) diff --git a/INSTALL.md b/INSTALL.md index 5b5744e..bbe91e9 100644 --- a/INSTALL.md +++ b/INSTALL.md @@ -39,7 +39,7 @@ recommend removing it first. This is the Octave package file intended for use with the Octave package manager pkg. On the Octave prompt, change to the folder where -the download is located and run `pkg install mess-2.2.tar.gz`. +the download is located and run `pkg install mess-3.0.tar.gz`. Since this package depends on the `control` package for the solution of small dense Lyapunov and Riccati equations, make sure to have that diff --git a/ISSUES.md b/ISSUES.md index 4027b07..38f6ccd 100644 --- a/ISSUES.md +++ b/ISSUES.md @@ -7,7 +7,7 @@ toolbox. Otherwise conflicts are almost guaranteed. * The octave dense Riccati solvers can not handle indefinite right-hand-sides. These can occur in the - `mess_galerkin_projection_acceleration` routine. + `mess_solve_projected_eqn` routine. * The `mess_care` has been observed to work less accurate in octave, when octave is compiled with GCC before version 5. That means, on RHEL/CentOS/ScientificLinux 6/7, Ubuntu 14.04, SLES 11/12 @@ -30,8 +30,18 @@ * `mess_splitting_dre` works for the LTV case only if `A(t)*A(s)=A(s)*A(t)`. This is not checked in the code and has to be ensured by the user. +* BDF solvers can currently not be used with line-search activated in + the inner Newton-Kleinman solves. +* `mess_lrnm`in LDL_T mode with line-search is sometimes unstable in Octave. * `mess_tangential_irka` was observed to converge exceptionally slow using MATLAB R2019b on certain Intel Sandy bridge processors. +* `mess_lrradi` can crash in rare cases inside + `mess_RADI_get_shifts_hamOpti_generalized`, probably due to an + economy size QR with incompatible dimensions. +* `mess_res2_norms` was observed to be less accurate + using MATLAB R2019b on certain Intel Westmere processors. +* `exp_action` in the splitting methods does not work with its + 'Krylov' method when `dae_2` usfs are used. ## Compatibility with other Software diff --git a/README.md b/README.md index de0eedb..fdaa983 100644 --- a/README.md +++ b/README.md @@ -1,12 +1,12 @@ # M-M.E.S.S. - The Matrix Equation Sparse Solver Library for MATLAB and Octave M-M.E.S.S. provides low-rank solvers for large-scale symmetric matrix -equations with sparse or sparse + low rank coefficients. The main +equations with sparse or sparse + low-rank coefficients. The main focus is on differential and algebraic Riccati equations appearing in control and model order reduction, as well as algebraic Lyapunov equations for, e.g., balanced truncation. -The underlying dynamical system may be of first or second order and +The underlying dynamical system may be of first or second order, and structured proper differential algebraic equations (DAEs) that allow for implicit index reduction are also supported. @@ -31,7 +31,7 @@ standard state space systems, second order systems, structured DAEs of index 1 and 2, as well as second order DAEs of index 1, 2 and 3. For more information on usfs see `help mess_usfs`. -Copyright 2009-2022 +Copyright 2009-2023 by Jens Saak, Martin Koehler, Peter Benner (MPI Magdeburg) The software uses a BSD 2-Clause license. See [LICENSE.md](LICENSE.md) @@ -99,14 +99,18 @@ See [CITATION.md](CITATION.md) for details about citing the software. BT of bilinear systems. - **2022 M-M.E.S.S.-2.2** fixes several smaller bugs and adds improvements to code style and performance, and improves documentation +- **M-M.E.S.S.-3.0** adds + - Krylov-projection-based solvers + - sparse-dense Sylvester equations ## Roadmap -- **M-M.E.S.S.-3.0** - - bilinear control problems - - Krylov-projection-based solvers - - sparse-dense Sylvester equations -- **M-M.E.S.S.-4.0** - - sparse Sylvester equations - - non-symmetric AREs +- **M-M.E.S.S.-3.x** + - bilinear control problems + - DAE usfs restructuring + - consistency and efficiency improvements + - code refactoring to avoid code duplication +- **M-M.E.S.S.-4.0** + - sparse Sylvester equations + - non-symmetric AREs diff --git a/doc/GettingStarted.mlx b/doc/GettingStarted.mlx index abfe37f68525abf4dfee4b2fe620c478e742533a..cd52abf5eea2ef1c3bf2e7974b89f39401a290dc 100644 GIT binary patch delta 4642 zcmY*d1yIyov|myrb}2!+Qz>bXSR|IEK{_O50SW2;OE&^br%1PSNrQmI(j|>Z3a+%& z^ZRDrd-I(;b7s!(oO5UHopXM3?WB{o zPuT6Ps=9ZQoLmBGxu z(wk$n&HLHxSM&4Es+LV5&|p;ZWyp7!B*7lV@JxRkv|Q?@n`dMu`!YQwl^|OZmC_Wh z#)LIibos6?Zkr-9QJ|AIHf-k9;H80ew3auWrDaHMTcl(D+wPc2aVKD_$cAj)9fvBB zHF#(`fJm!q$EwDxH6tp@hEpzn8DrBTlXC7jv}J6up_@UFKz8|;4A%6!6J6TeUkltk z(#iGHQylQk=jxtHf`*9>e%_$&P-rmW@JZQQ6=hgadGIvjQAhGy!!34Gz@}=VRop-0HH*RmI03p?y;4K0vgR%gz2D*A@A5pZDMc z+QPyMPlR$#(LvNt$yrVhILv}_TR^67uQBN<-gkBc*S=-wA88VI*LJ<|7;|iC>8$C(m#S@~Y)F6d#GORKYbuiUm$w!JuGe1jgT&@WJf{yzRHhqF9kPb{Xv_$4IRn>)w^%k`lQ zvpFP#>AY|KU8njb9cCo4cFfZ+^<*D}Y^g?H#P@^X9*j(BIjFp!ncR>Oiw0W4dXwK z)J;9TWy05Ic&%#h_wuN)GtFGQs9rvro{NIQC!;%{OClj8oOY-GgtoSBOTW@wE;4+| zBVJ3O?$I_ebXeLbvP-bQQOIeUHSn~F^&U~n<*^Pt(9R4=!Z0cty=EABxV!QFho1G~ z$ILkn%$JHIu{~_VH~f+>u!{-yQYN+;>Cv`QB6(0BXZUGD`uH2SY3Y^kRKW))k{4vS z{7b@94!bTaXlQKNw#n-#2{pWBPWH)Bn+;kj5*9aRU2g@uN}k{hJUA48NBfa(uIi(< z@$X?k`#QbwN4>P7?4|uZYc%2Jw*u5MBGw7zP+BZAZxOnYG`?2=Xg!#I4LGs zID?$Jxfo6UhrC(kvu^fsGJTc~KChk~{9MJ4XFmb5)vGEUMTN*cG+s$>xD|8>L@6gq z=pNr=WZ}il8FC-Z{#L{Gt!B-vplaWgOUebNp3(Qa)#I@F;$({GFMC({TdyBb|3HYT zrsT#L3&7kaHLiq$N+)z~MCe#G@5J0id=gNK-Y?Gjy z!T8JPEGIE68LlORkq~pw@wf17Zx?ClRjM#l0b1ajIMFM0^oil6zvqoEXM<;bdv*SV| z&KlsJW-COzbj&CDpo9;Ci(>YsQ6&H``Cc)ZY(#((o2G;i0fo-#LZ|4RPAUbm`+l`_ zP~Gov#qZv$^IrMK8-jLC{d-?R+-WGJO8&5d;rVaj#8<)^I4C*It`6e6O-jVoV zle6#7_}o7D`bo&`guJFGF@muV`edXry6{1LRyj2hXE}-Tcf8D~A#6sb1ynKZm{vEL z@$t#5On!06E#lRWtR#L9!ks$C#)O+Z-y9YH(V}A}YA$9Hp)AW@ z5s?O5hIxz{If@%xbpNn6FkJ%uAvqPe$2nx?Z9_{>#r~wGwK;{l3Nr^0lV}dCVAwd6 z3qF!4*v|z|SJAgk0V|o>d1IrClq1gho0b#u1^9blyVg0$9;|K@g@ee18&@tNsyZev zYQQ~Th}?dhbs4&H#T@p~=Zn&*w9&@(65O|nk=;E`Oc}C3Wy7!}ZUpd+^R1aU3#BF{ z1+cD3R)=w`Qh9l^>x>g#?NMwJOGed5oXs$ESd@7bEslcnN;qDD*7$lp4Ayy?a-S1z z6RRY0bWe)3=qMffwIr*f9vj~}_jlR?>uWgIqLPq2ps(~Ju(&6&e8=Yt`&t4s-CX35 zMU&w^+vyaY*s;$!1pJ*fsW_3-x^^(eK|$AHhYGp7{t{j+8XQ~Pu@`hFx|}nL-o=Sw z5f26>DU(?Yx^q`$R+*aEgEcM+Gu!Ih=kIF=e*qouyUaFgN{0MRsuv5M_S1iH)wtN3 zuf`Ie$I{1DBcH{&B!N=RXq9(((BEp|)*L)(CLfo+x_!701H8NBt9EN+ZsS|gQ(2OE zP2ZO2x4w!RST#J{Wqwu?h4|1^;$9!6EswD}cLES1ou#hAUk3BFF{XC6&{!yO%%Rh ztJeo_6P7vJ0OVqUjqU@&ELr8r0|80JLjl_r8I@?*9{TrOT0Df_p?P?R_lWgK6v$Vh0eT61rTbdwJj>I~2}!C2ZAsS~>;!n9`#s$(Rvd-PQ4xNw!d4Z>$CYNbC~w%+FCLrV|1 zYZ%T-^OfHPV4dq>Dg;uqTOYkV=&e@Cg@`QI_U{r8{$%>fiP+nV)0rU(=L~vDvYyLa zut<*vvOgs9qNHAuSfp1017k+@>njPo~p6N3qJGxY~#hSsloEB|}2jR!+ZO6XXDp^Sf%4%qDtwXyqN;Nxm~I?Dk{dht*I zKL{#Baa^jXGp&*`EoLD@tVV09hygPxRG^N|ms+FR{e4+2lad)9?6o0IE%14ffbda_ zJ7BxB;uG4ZcxSho&GpY-9n7gKR^>d2Eu^pdfR>VR%fM!; zXI(z*YF<$ z>1+1i_{qP#V!I5~eWL=$jE1XF5q|NV{E5+U*%11Nq0S_;Ij_OnF^SFOY*uV$ZTLEHDr9j_b418;Bs*kqVG;EXw!a+e+{&A)e=D95lp ziWR(@iz!pux;cQ1i%rDYDd{}%q}Fc)7Cj2SiIzJFicClhfD6j6zXc#-Lz>LXb1anv zgip`r#6L|Fbo~4?9u7UdiGJcap?CP*@LYN)AWw8Ib7l0WuYoPQiLL4r0*$+$_s%{O z)V;}#zh4b{iFUKcx*e2URp!w3K)fGoPv~8|hg>HF3Z1RziAAef-9Ek@Z1k;O0JMy2 z?PzT)uR9%~J9mi}db{^LH^;ur*K>Nm@cX!E{9cF+K2tj*9L+r^R8g-d7gHfgW0Nz( z&s5la`g_VJ-vUnkI;ijIRLF+VC~1UY@dFk_`Xg{Xy!wW1SbJStPd>E{Z@cS*q1bpY za%3dwbx%cCq{%JG?>c5fxJl{=Hee%OLU~V$QqB0lyL0;c)n=~=JLjmlBM5GiF>;zL zUP1&yX{8gZt75t?fm}Y@Uk+4+j}tnA#O|`tLtTckqZ43RJaYC>qz-5a3(vobgsWP( zfq>Y1Hj;dvdg%e)=QsTWvsYMtYD*7bCb>4&KJjudu0c@@SVKdDAT0!fkAV@L^G?;7 zLvun}b~A}xhRN=5U6ZF@159=g`v1Zq&_9AXwIZykkX3}7fR;)hKk;A}eAq9m&{XoF zf1c5z@dKPcU{+Shf^wY_6wXpse{|(gqS!ndBXMf ztL19OBsyOto|rU$W)OObfPfV$+Q`GBdV1^W2o3mp6rhE4WW{pE$3%S#Q9PVSNwT}d zPPi2@O0>=U`62? zO^f(jd_Dw3uQlse^62;R;SB0Q0jl~af@__dyVJ{OQo^Z!e(7Rrn$pjz8m!YVapEl; zTb6w1X$KH8}NbUkF}7&mi^tL>Cwjw}K1JoB#G3FLEEk52%Yng89i;uO4ZfPo-k>DD%){5uhI{50sGd zPJcx2sBA~ZeDmt!Kzix)5ybJddmfy;yL#t1Y5MiN=?rq6j3=X&YeIrKD1c+*_fxgN zFX92V+a7%;Sn5rNTtp_FrUjU;6u{Ah{#ez|S+h4QH{%s-^5UWkVEtKQ(AX4FB_g#-tRO+PHGg)Ephk__RB2SJ z)NCng@6}qbcYWXa&iU@Ycbs$Y^W1ZvTYalcf>ck5h1ZpvH#oT3uh9VjJz@aB6#xL> zgFtyBoNv1Nxdiz<^hL=$@$vo&_wk!*;5yHF;9nJikj{Ir-w5K?Cv-lZ&Ude))t8a^ zlqUX?%itNe&@s+G z-EM#5OAK2rt^AJKQSnvuE;(XpAT2@9b7~A z|JX081nU%v#LN!?EO<|?YlmcGlS(zjgd$vkmA!pWMWthj*Y%WTRes_S$D%=lJy_HS zrWY|zwHx!oDzDr%c#+EV_l&x<%9)tNzzDATLX4VTo4SIbM#qm`=^v*{stE{8QF_?m zTS{d2_Cr`hjAYQHQtN{nuZ-IYrB8qz;iA{VOnGeGuAfQWF~JBEx#ySy^Y+soNj0TP z3ba7p_;Vrc{ksc~6K5)2lCPv(cf{I^?M&;W5ScSw{%Y7GJ|dBcWs*#fn*GL!nAUz~Z$PuiRyOHj|(3BTj>Zb&nVn-+=)7^Kr$p%)Ypc&uP;)zNh2 zIK{MxQ`e&alZL^zV2k-kwyoElGbf#_zK()|7tf#Uj}$iH=9oM`ueSabM)^$od5Tmj zl(DhA(zh^O9uBRKY++PDjP!BlGRhTJji4GMtz`x#w7weyG-vX4CdlCIBUP z1t;dmH{hU6y2e0TUu)Yl*si&&Bx=OA6ZGRK+93W;zSn})Y&~_|y?QipdssgAW~6N} z7t!^L{#ZR5ug_bUEDp2mn9=)V)#BSm!MU~Sa8RGPQyRXE0;yJH!hk(2ag@k{g(!BS zU`6Y%dqOX^|Bm5H<{S5Am;2@=hVa%sD`@kLeoy9IQHz)Z`Fy9 z)T@7ezDA9)seE8V;j>;E9Cjk}@P%bQ!dmiHum61x*V7$RO*YSC`;DsW!*Gq7jM>k8 zlLKQD=#sL9Y+78sO(_;bVr9SHMOc)_#1VH@47X@a$%6nd}(CY9O)~ zqt|5XiR)by@Fk6buM~QOrT;x_V`&GJ($>h`cciNpD!q!H-1;>s)f*MJ2NhWI&e$nb zkUv#SkayHvN9VF}?-gJZdaGX9^J{RX9p!}1@8X7MVpB>w6eZzD-&#~_G#kavUqB({{BAG%S_K*PvnZ%YC}kep1lhGS`z9f&hhvzDTAI+)?&U9N( z@Dh>O;9O5}cH3xJG=lnXdefv&Z9=c9=;mw2d4mp##<3d9!`>6}mc$U}*^n>44SNZd zkq+6THYLg%49Rl~67I;D5gaIeToGDb#&7OJa)yw)#K0Ehy6ELo-n+jnzA}ApB?n_; zvO>+@X{34FGIOj>*4Pfkj-|jIU@XQ#p$u4HXE`OT@mgR2$_e1k*eXn}WG4|ZUNS_i)xmINzih$k=CHQ9NnqyB*DQ^8NtWzl zS`E!kI?JEOIJE%0o%L}gxpCETdYFbzzK=|Q@zZlp-4DZfc8xoQKg&ktL^LNz4r4Y8Yf6H0|d`VG)z$mqe*z9H71a2shgkTFX_(x$c5G2 zvQx>f@0OXGooRzEJmNh=fVpo8=3>Y@Fx-K$*iLo+_vMD&H{{@q^@KW#Ri zD07R4FEM!4ail5NirY=pr_`oC0b*4T4s12Y4Mu*_;Pk@-70fynuE}qU=Bvo z;rF0GA&BqpA@hlv0=A_Kii@G{HtO6**$XamZN_3p8ZPfksms^U2&STRu#Fj3@9)Rc(;GL)5A~keaXM;$YASiV?}1yny7V1;Sbt@ z4?qXf(m+?yu4yY}R0f=c&=Vaw1_c-U8e-l%V{_|8n4-=rKPy^$_E9VS^Nn|kmijcL zCedZ6*uzu_^GJ6k4$+$dW_0-ke?8NFiPA={>_Dt<*z6?*Q!5znhgJxoy3-67m0SYZbIE`A8zxjg6&;AEY7$S{bCu0WFyeB5rRn1XIag3Q5&-I zSoxtLjpv`3<(0aJW}>nt5u);jD6i+m(+-HN30p2?MlVTL;PKNqh*n#whNcQ!5-!Y!|&&SjwQvY%d1zx+0m#8 zAiY)isYyhRh8T~BZYj+J|AQ*%5>}wirk)gS&M$6)Iy(gGV9+hg@$3RNfO&!Uv4T!H zKw8XMDWZk#ZSu!V-!YDtxG7F74WHoK5Fj$OU)lmOE8-eG8W@szYFWz{QG{OLloQzBbn?xJUH6Q8p zS^i=2H^*Y$GqDE$Dm!g_ zVg^$O{i~#+W1qGzq7uS#6RRgt^#c{Ru5TonL{R_cKMkfb{gNg9VFsjKO;epTa4!4oO#5}N%;aqh~?I$TxBAB s;?}2JWhOl3Wd2nzhqye< tol) - warning('CARE_NWT_FAC: no convergence in %d iterations\n', maxsteps); +if (iter == maxsteps) && (nres / max(1, Xnorm) > tol) + mess_warn(opts, 'CARE_NWT_FAC', ... + 'no convergence in %d iterations\n', maxsteps); end diff --git a/helpers/lyap2solve.m b/helpers/lyap2solve.m index 7486b6c..081c8c2 100644 --- a/helpers/lyap2solve.m +++ b/helpers/lyap2solve.m @@ -1,4 +1,4 @@ -function X = lyap2solve(A,B) +function X = lyap2solve(A, B) % Solve Lyapunov equation AX+XA^T+B=0 via Zhou and Sorensen 2-solve % method % @@ -14,61 +14,66 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % +m = size(A, 1); +n = size(B, 2); -m = size(A,1); -n = size(B,2); - -[Q,R] = schur(A); +[Q, R] = schur(A); idx = m:-1:1; -Q2 = Q(:,idx); -R2 = R(idx,idx)'; +Q2 = Q(:, idx); +R2 = R(idx, idx)'; -B = Q'*B*Q2; +B = Q' * B * Q2; -Rsq = R*R; +Rsq = R * R; Id = speye(m); k = 1; X = zeros(size(A)); -while k < (n+1) +tol = 10 * eps; + +while k < (n + 1) - if k==n || ... - (k1 - b = -B(:,k) - X(:,1:k-1)*R2(1:k-1,k); + if k > 1 + b = -B(:, k) - X(:, 1:k - 1) * R2(1:k - 1, k); else - b = -B(:,k); + b = -B(:, k); end - X(:,k) = (R+R2(k,k)*Id)\b; + X(:, k) = (R + R2(k, k) * Id) \ b; k = k + 1; else - r11 = R2(k,k); r12 = R2(k,k+1); - r21 = R2(k+1,k); r22 = R2(k+1,k+1); + r11 = R2(k, k); + r12 = R2(k, k + 1); + r21 = R2(k + 1, k); + r22 = R2(k + 1, k + 1); - if k>1 - b = -B(:,k:k+1) - X(:,1:k-1)*R2(1:k-1,k:k+1); + if k > 1 + b = -B(:, k:k + 1) - X(:, 1:k - 1) * R2(1:k - 1, k:k + 1); else - b = -B(:,k:k+1); + b = -B(:, k:k + 1); end - b = [R*b(:,1)+r22*b(:,1)-r21*b(:,2), R*b(:,2)+r11*b(:,2)-r12*b(:,1)]; + b = [R * b(:, 1) + r22 * b(:, 1) - r21 * b(:, 2), ... + R * b(:, 2) + r11 * b(:, 2) - r12 * b(:, 1)]; - X(:,k:k+1) = (Rsq+(r11+r22)*R + (r11*r22-r12*r21)*Id)\b; + X(:, k:k + 1) = (Rsq + (r11 + r22) * R + ... + (r11 * r22 - r12 * r21) * Id) \ b; k = k + 2; end end -X = Q*X*Q2'; - +X = mess_symmetrize(Q * X * Q2'); diff --git a/helpers/lyap_sgn_fac.m b/helpers/lyap_sgn_fac.m index 2130ed7..610fc67 100644 --- a/helpers/lyap_sgn_fac.m +++ b/helpers/lyap_sgn_fac.m @@ -1,5 +1,5 @@ -function [R,iter] = lyap_sgn_fac(A,C,E) -%LYAP_SGN_FAC +function [R, iter] = lyap_sgn_fac(A, C, E) +% LYAP_SGN_FAC % % Solve the stable Lyapunov equation % @@ -30,82 +30,88 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % +opts = struct; - -n = size(A,1); +n = size(A, 1); R = C; if (nargin < 3) || isempty(E) - desc = 0; + desc = false; E = eye(n); Enrm = 1; + else - desc = 1; - Enrm = norm(E,'fro'); + desc = true; + Enrm = norm(E, 'fro'); + end -Err = norm(A + E,'fro'); +maxstep = 100; -% the following are parameters that could be used as input arguments in a pro version -maxstep = 50; -onemore = 0; -tol = sqrt(n*eps)*Enrm; -rtol = 1e-8; +Err = norm(A + E, 'fro'); + +extra_steps = 0; +tol = sqrt(n * eps) * Enrm; +rtol = 1e-10; % further variables for convergence check iter = 0; convergence = Err <= tol; -In = eye(size(A,1)); +In = eye(size(A, 1)); -while (iter < maxstep) && ((not(convergence)) || (convergence && (onemore < 2))) +while (iter < maxstep) && ... + (not(convergence) || (convergence && (extra_steps < 2))) - [AL,AU,p] = lu(A,'vector'); + [AL, AU, p] = lu(A, 'vector'); p(p) = 1:length(p); - AL = AL( p , : ); + AL = AL(p, :); - Y = AU\(AL\In); + Y = AU \ (AL \ In); if desc - YE = Y*E; - Y = E*YE; + YE = Y * E; + Y = E * YE; end if Err > 0.1 - d = sqrt(norm(A,'fro')/norm(Y,'fro')); + d = sqrt(norm(A, 'fro') / norm(Y, 'fro')); else d = 1; end - A = (A/d + d*Y)/2; + A = (A / d + d * Y) / 2; if desc - R = [R; d*R*YE]/sqrt(2.0*d); + R = [R; d * R * YE] / sqrt(2.0 * d); else - R = [R; d*R*Y]/sqrt(2.0*d); + R = [R; d * R * Y] / sqrt(2.0 * d); end - [~,R,p] = qr(full(R),0); - r = sum(abs(diag(R)) > rtol*abs(R(1,1))); - rc = size(R,2); - q = zeros(1,rc); - for k=1:rc - q(k) = find(p==k); + [~, R, p] = qr(full(R), 0); + r = sum(abs(diag(R)) > rtol * abs(R(1, 1))); + rc = size(R, 2); + q = zeros(1, rc); + for k = 1:rc + q(k) = find(p == k); end - R = R(1:r,q); + R = R(1:r, q); - Err = norm(A + E,'fro'); + Err = norm(A + E, 'fro'); iter = iter + 1; convergence = Err <= tol; - if convergence, onemore = onemore + 1; end + if convergence + extra_steps = extra_steps + 1; + end end -R = (R/E)/sqrt(2.0); +R = (R / E) / sqrt(2.0); if (iter == maxstep) && (Err > tol) - warning('MESS:lyap_sgn_fac: No convergence in %d iterations.\n', maxstep); + mess_warn(opts, 'lyap_sgn_fac', ... + ' No convergence in %d iterations.\n', maxstep); end diff --git a/helpers/mess_LDL_mul_D.m b/helpers/mess_LDL_mul_D.m index 491d91e..afe62f9 100644 --- a/helpers/mess_LDL_mul_D.m +++ b/helpers/mess_LDL_mul_D.m @@ -1,17 +1,17 @@ -function Y = mess_LDL_mul_D(eqn,D,X) +function Y = mess_LDL_mul_D(eqn, D, X) % % Computes Y = D * X % % Here D is the center matrix in the LDL' representation. It can be given % either as the full D matrix such that D * X can be computed directly, or % implicitly stored, e.g., as a vector D such that the actual D matrix is -% kron(diag(D), eqn.S). The later is done, e.g, in the LDL' formulation of +% kron(diag(D), eqn.T). The later is done, e.g, in the LDL' formulation of % the low-rank ADI, while in differential Riccati solvers we typically have -% a small D matrix such that the actual D is kron(D,eqn.S) +% a small D matrix such that the actual D is kron(D,eqn.T) % % In the latter cases we exploit % -% kron(F,eqn.S)*vec(Z) = vec(eqn.S * Z * F') +% kron(F,eqn.T)*vec(Z) = vec(eqn.T * Z * F') % % where F is either diag(D) or D, which can be efficiently expressed using % reshape. @@ -19,37 +19,49 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - % Do a consistency check on the inputs (no full check is performed though) -ns = size( eqn.S_diag, 1 ); - -if isvector(D), D = diag(D); end +if isvector(D) + D = diag(D); +end -nd = size(D,1); +nd = size(D, 1); [mx, nx] = size(X); -if (mx ~= nd) && (mx ~= ns*nd) % TODO This could be an assert? - error(['MESS:mess_LDL_mul_D:The number of rows in X must be either equal to ' ... - 'the number of columns in D or the product of the numbers ' ... - 'of columns in D and eqn.S']); -end +opts = struct; + +if mx == nd + % D is the full D matrix in the LDL^T decomposition + Y = D * X; + +else + % the full D is actually kron(diag(D),eqn.T) + ns = size(eqn.T, 1); + + if not(mx == nd) && not(mx == ns * nd) % TODO This could be an assert? + mess_err(opts, 'error_arguments', ... + ['The number of rows in X must be either equal to ' ... + 'the number of columns in D or the product of the numbers ' ... + 'of columns in D and eqn.T']); + end + % We use that + % kron(A, B) * vec(X) = vec(B * X * A') + % + % i.e., we turn each column in X into an ns by nd matrix + X = reshape(X, ns, nd, nx); -if mx == (ns*nd) % the full D is actually kron(diag(D),eqn.S) - % turn each column in X into an ns by nd matrix - X = reshape(X,ns,nd,nx); % allocate Y as a same size 3d array Y = zeros(size(X)); - for k=1:nx - Y(:,:,k) =diag(eqn.S_diag)*(X(:,:,k)*D'); + for k = 1:nx + Y(:, :, k) = eqn.T * (X(:, :, k) * D'); end + % turn the matrified result into columns again. - Y = reshape(Y,mx,nx); -else % D is the full D matrix in the LDL^T decomposition - Y = D * X; + Y = reshape(Y, mx, nx); + end diff --git a/helpers/mess_accumulateK.m b/helpers/mess_accumulateK.m deleted file mode 100644 index f3e7402..0000000 --- a/helpers/mess_accumulateK.m +++ /dev/null @@ -1,184 +0,0 @@ -function [ out, eqn, opts, oper ]=mess_accumulateK(eqn, opts, oper, out, pc, V1, V2) -% Updates out.Knew and out.DeltaK -% -% K = E' ZZ' B if eqn.type == 'N' -% K = E ZZ' C' if eqn.type == 'T' -% -% -% Input: -% eqn structure containing equation data -% -% opts structure containing parameters for the algorithm -% -% oper contains function handles with operations for A and E -% -% out contains Knew and DeltaK -% -% pc contains shift parameter p -% -% V1 contains solution of shifted system or Z if pc is empty -% -% V2 contains solution of shifted system -% -% Output: -% out contains Knew and DeltaK -% -% eqn structure containing equation data -% -% opts structure containing parameters for the algorithm -% -% oper contains function handles with operations for A and E - -% -% This file is part of the M-M.E.S.S. project -% (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. -% All rights reserved. -% License: BSD 2-Clause License (see COPYING) -% - - -%% Check input - -%% Initialize data -if not(isreal(pc)) && nargin ~= 7 - error('MESS:control_data', 'If the shift is complex, V1 and V2 are required'); -end - -%% preprocess multiplication with E -[eqn, opts, oper] = oper.mul_E_pre(eqn, opts, oper); - -%% update K and DeltaK -if isempty(pc) - if eqn.haveE - if opts.LDL_T - % no separate BDF case; the computed K is not the - % feedback matrix for the ARE resulting in a time - % step of the BDF method but the feedback matrix of - % the original DRE; that is why tau and beta do not - % appear in K, e.g. as factor of B; for residual - % computations of the ARE tau and beta need to be - % taken into account. - if eqn.type == 'T' - out.Knew = oper.mul_E(eqn, opts,eqn.type,V1 ... - *(out.D * (V1'*eqn.B)),'N'); - else - out.Knew = oper.mul_E(eqn, opts,eqn.type,V1 ... - *(out.D * (eqn.C * V1)'),'N'); - end - else - if eqn.type == 'T' - out.Knew = oper.mul_E(eqn, opts,eqn.type,V1*(V1'*eqn.B),'N'); - else - out.Knew = oper.mul_E(eqn, opts,eqn.type,V1*(eqn.C * V1)','N'); - end - end - else - if opts.LDL_T - if eqn.type == 'T' - out.Knew=V1*(out.D*(V1'*eqn.B)); - else - out.Knew=V1*(out.D*(eqn.C * V1)'); - end - else - if eqn.type == 'T' - out.Knew=V1*(V1'*eqn.B); - else - out.Knew=V1*(eqn.C*V1)'; - end - end - end -else - if opts.adi.accumulateK || opts.adi.accumulateDeltaK - if isreal(pc) - if eqn.haveE - if eqn.type == 'T' - if opts.LDL_T - % no separate BDF case; the computed K is not the - % feedback matrix for the ARE resulting in a time - % step of the BDF method but the feedback matrix of - % the original DRE; that is why tau and beta do not - % appear in K, e.g. as factor of B; for residual - % computations of the ARE tau and beta need to be - % taken into account. - K_update = oper.mul_E(eqn, opts,eqn.type,V1,'N')*... - ((2*(-pc) * diag(eqn.S_diag))*(V1'*eqn.B)); - else - K_update = oper.mul_E(eqn, opts,eqn.type,V1,'N')*... - ((2*(-pc))*(V1'*eqn.B)); - end - else - if opts.LDL_T - K_update = oper.mul_E(eqn, opts,eqn.type,V1,'N')*... - ((2*(-pc) * diag(eqn.S_diag))*(eqn.C * V1)'); - else - K_update = oper.mul_E(eqn, opts,eqn.type,V1,'N')*... - ((2*(-pc))*(eqn.C * V1)'); - end - end - else - if eqn.type == 'T' - if opts.LDL_T - K_update = V1*((2*(-pc) * diag(eqn.S_diag))*(V1'*eqn.B)); - else - K_update = V1*((2*(-pc))*(V1'*eqn.B)); - end - else - if opts.LDL_T - K_update = V1*((2*(-pc) * diag(eqn.S_diag))*(eqn.C*V1)'); - else - K_update = V1*((2*(-pc))*(eqn.C*V1)'); - end - end - end - else - if eqn.haveE - if eqn.type == 'T' - if opts.LDL_T - K_update=oper.mul_E(eqn, opts,eqn.type,V1,'N')*... - (diag(eqn.S_diag) * (V1'*eqn.B))... - +(oper.mul_E(eqn, opts,eqn.type,V2,'N'))*... - (diag(eqn.S_diag) * (V2'*eqn.B)); - else - K_update=oper.mul_E(eqn, opts,eqn.type,V1,'N')*(V1'*eqn.B)... - +(oper.mul_E(eqn, opts,eqn.type,V2,'N'))*(V2'*eqn.B); - end - else - if opts.LDL_T - K_update=oper.mul_E(eqn, opts,eqn.type,V1,'N')*... - (diag(eqn.S_diag) * (eqn.C * V1)')... - +(oper.mul_E(eqn, opts,eqn.type,V2,'N'))*... - (diag(eqn.S_diag) * (eqn.C * V2)'); - else - K_update=oper.mul_E(eqn, opts,eqn.type,V1,'N')*(eqn.C * V1)'... - +(oper.mul_E(eqn, opts,eqn.type,V2,'N'))*(eqn.C * V2)'; - end - end - else - if eqn.type == 'T' - if opts.LDL_T - K_update=V1*(diag(eqn.S_diag) * (V1'*eqn.B))... - +V2*(diag(eqn.S_diag) * (V2'*eqn.B)); - else - K_update=V1*(V1'*eqn.B)+V2*(V2'*eqn.B); - end - else - if opts.LDL_T - K_update=V1*(diag(eqn.S_diag) * (eqn.C * V1)')... - +V2*(diag(eqn.S_diag) * (eqn.C * V2)'); - else - K_update=V1*(eqn.C * V1)'+V2*(eqn.C * V2)'; - end - end - end - end - if opts.adi.accumulateK - out.Knew=out.Knew+K_update; - end - if opts.adi.accumulateDeltaK - out.DeltaK=out.DeltaK+K_update; - end - end -end -%% postprocess multiplication with E -[eqn, opts, oper] = oper.mul_E_post(eqn, opts, oper); diff --git a/helpers/mess_column_compression.m b/helpers/mess_column_compression.m index 9f549cf..2a6609a 100644 --- a/helpers/mess_column_compression.m +++ b/helpers/mess_column_compression.m @@ -1,5 +1,5 @@ function [Z, D] = mess_column_compression(Z, opZ, D, tol, info) -% Computes a compressed representation of Z (and D). +% Computes a compressed representation of Z (and D). % % [Z, D] = mess_column_compression(Z, opZ, D, tol, info) % @@ -23,27 +23,27 @@ % (optional, default 0) % % Output -% Z compressed low rank factor -% D compressed low rank factor, empty if D was empty +% Z compressed low-rank factor +% D compressed low-rank factor, empty if D was empty % on input % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% Check and assign input arguments +opts = struct; if issparse(Z) % This is just a safety measure that is hopefully never executed Z = full(Z); - warning('MESS:dense',... - ['Converting low rank factor to dense format. ' ... - 'This should never be necessary.']'); + mess_warn(opts, 'dense', ... + ['Converting low-rank factor to dense format. ' ... + 'This should never be necessary.']); end if nargin < 2 @@ -57,10 +57,13 @@ end if (nargin >= 3) && not(isempty(D)) - assert((norm(D - D', 'fro') < eps) && ... - isequal(size(D), [m m]), ... - 'MESS:data', ... - 'The D factor has to be symmetric of size %d.', m); + symmD = norm(D - D.', 'fro'); + d = size(D); + mess_assert(opts, (symmD < eps) && isequal(d, [m m]), ... + 'data', ... + ['The D factor has to be symmetric of size %d, ', ... + 'found size = %d and norm(D - D'') = %e'], ... + m, d(1), symmD); else D = []; end @@ -85,7 +88,7 @@ Z = U * L(:, 1:l); if info - fprintf(1, 'cc: %d -> %d (tol: %e)\n', m, size(Z, 2), tol); + mess_fprintf(opts, 'cc: %d -> %d (tol: %e)\n', m, size(Z, 2), tol); end else % Z'*Z case. @@ -97,7 +100,7 @@ Z = L(1:l, :) * V'; if info - fprintf(1, 'cc: %d -> %d (tol: %e)\n', m, size(Z, 1), tol); + mess_fprintf(opts, 'cc: %d -> %d (tol: %e)\n', m, size(Z, 1), tol); end end else @@ -113,7 +116,7 @@ D = diag(S(r)); if info - fprintf(1, 'cc: %d -> %d (tol: %e)\n', m, size(Z, 2), tol); + mess_fprintf(opts, 'cc: %d -> %d (tol: %e)\n', m, size(Z, 2), tol); end else % Z'*D*Z case. @@ -127,7 +130,7 @@ D = diag(S(r)); if info - fprintf(1, 'cc: %d -> %d (tol: %e)\n', m, size(Z, 1), tol); + mess_fprintf(opts, 'cc: %d -> %d (tol: %e)\n', m, size(Z, 1), tol); end end end diff --git a/helpers/mess_dense_nm.m b/helpers/mess_dense_nm.m index 2ec756c..ec56ba6 100644 --- a/helpers/mess_dense_nm.m +++ b/helpers/mess_dense_nm.m @@ -1,129 +1,162 @@ -function X = mess_dense_nm(A,B,C,E,X0,S) +function X = mess_dense_nm(opts, A, B, C, E, X0, Q, R) % naive Newton Kleinman iteration for the ARE % -% A'*X*E+E'*X*A+C'*S*C-E'*X*B*B'*X*E = 0 +% A'*X*E + E'*X*A + C'*Q*C - E'*X*B*R\B'*X*E = 0 % % Inputs: % -% A,B,C,E,S Coefficients in the above equation -% X0 initial guess for the solution +% opts options structure needed for the logger +% A, B, C, E, Q, R Coefficients in the above equation +% X0 initial guess for the solution % % Outputs: -% X Solution +% X Solution % % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - -% check for available Lyapunov solver +%% +% check for and select available Lyapunov solver if exist('lyap', 'file') - meth='lyap'; + meth = 'lyap'; + +elseif exist('lyap2solve', 'file') + % Again shipped with our code so actually unlikely to be unavailable. + meth = 'lyap2solve'; + elseif exist('lyap_sgn_fac', 'file') % This should always be available since we ship it. - % The following are only her n case someone deletes the sign solver - meth='lyap_sgn_fac'; + % The following are only here in case someone deletes the sign solver + meth = 'lyap_sgn_fac'; + elseif exist('lyapchol', 'file') % In case lyap is not available it is rather unlikely that this will be % there. Still someone might have their own implementation... - meth='lyapchol'; -elseif exist('lyap2solve', 'file') - % Again shipped with our code so actually unlikely to be unavailable. - meth='lyap2solve'; + meth = 'lyapchol'; + else - error('MESS:missing_solver',... - 'mess_dense_nm was unable to find Lyapunov solver'); + mess_err(opts, 'missing_solver', ... + 'mess_dense_nm was unable to find Lyapunov solver'); + end -tol = 1e-12; -maxiter = 50; -if (nargin == 6) && not(isempty(S)) - if not(issymmetric(S)) - error('MESS:data', 'S must be symmetric'); +%% +% prepare data for the constant term +if (nargin > 6) && not(isempty(Q)) + if not(issymmetric(Q)) + mess_err(opts, 'check_data', 'Q must be symmetric'); end - % S must be symmetric pos. semidef. for lyapchol or lyap_sgn_fac + + % Q must be symmetric pos. semidef. for lyapchol or lyap_sgn_fac if strcmp(meth, 'lyapchol') || strcmp(meth, 'lyap_sgn_fac') - [U,S_diag] = eig(S); - if any(diag(S_diag)<0) - meth='lyap2solve'; + [U, S_Q] = eig(Q); + if any(diag(S_Q) < 0) + meth = 'lyap2solve'; end end - G = C' * S * C; + G = C' * Q * C; switch meth case 'lyap' G = (G + G') / 2; % make sure it's symmetric for e.g. lyap + case {'lyapchol', 'lyap_sgn_fac'} - C = sqrt(S_diag) * U' * C; % C'*C = G + C = sqrt(S_Q) * U' * C; % C'*C = G + case 'lyap2solve' - if (nargin<4) || isempty(E) - GE = C' * S * C; + if (nargin < 4) || isempty(E) + GE = C' * Q * C; + else - CE = C/E; - GE = CE'* S * CE; + CE = C / E; + GE = CE' * Q * CE; + end end + else + G = C' * C; switch meth case 'lyap' G = (G + G') / 2; % make sure it's symmetric for e.g. lyap + case 'lyap2solve' - if (nargin<4) || isempty(E) + if (nargin < 5) || isempty(E) GE = C' * C; + else - CE = C/E; + CE = C / E; GE = CE' * CE; + end end -end +end res0 = norm(G); -if (nargin<4) || isempty(E) - E = eye(size(A,1)); +%% +% prepare center matrix in the quadratic term +if (nargin < 5) || isempty(E) + E = eye(size(A, 1)); +end +if (nargin > 7) && not(isempty(R)) + if not(issymmetric(R)) + mess_err(opts, 'check_data', 'R must be symmetric'); + end + F = B * (R \ B'); +else + F = B * B'; + R = eye(size(B, 2)); end -F = B*B'; +%% Main Newton loop +tol = 1e-14; +maxiter = 50; -for k=1:maxiter - if k>1 || ( (nargin==5) && not(isempty(X0)) ) - K = B'*X0*E; +for k = 1:maxiter + if k > 1 || ((nargin > 5) && not(isempty(X0))) + K = R \ (B' * X0 * E); else K = zeros(size(B')); X0 = zeros(size(A)); end switch meth case 'lyap' - X = lyap(A'-K'*B',G+K'*K,[],E'); + RHS = G + K' * R * K; + RHS = .5 * (RHS + RHS'); + X = lyap(A' - K' * B', RHS, [], E'); case 'lyapchol' - XC=lyapchol(A'-K'*B',[C',K'],E'); - X = XC'*XC; + XC = lyapchol(A' - K' * B', [C', K' * sqrtm(R)], E'); + X = XC' * XC; case 'lyap_sgn_fac' - XC=lyap_sgn_fac(A - B*K,[C; K],E); - X = XC'*XC; + XC = lyap_sgn_fac(A - B * K, [C; K], E); + X = XC' * XC; case 'lyap2solve' - KE = K/E; - X=lyap2solve(((A-B*K)/E)',GE+KE'*KE); + KE = K / E; + X = lyap2solve(((A - B * K) / E)', GE + KE' * R * KE); end - XE = X*E; - res = norm(A'*XE+XE'*A-XE'*F*XE+G); - rc = norm(X-X0)/norm(X); - if (rceps*s(1), 1, 'last' ); - Z=Z*U(:,1:sk)*diag(1./sqrt(s(1:sk))); -end - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Solve the projected Matrix equation -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -switch type - case 'LE' - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - % The Lyapunov equation case - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - lyapunov = 1; - B=Z'*eqn.G; - if bdf || rosenbrock - A = oper.mul_ApE(eqn, fopts,eqn.type,pc,eqn.type,Z,'N'); - if bdf - A = (fopts.bdf.tau * fopts.bdf.beta) * A; - if eqn.haveUV - if eqn.type=='T' - A = A + eqn.V * (eqn.U' * Z); - else - A = A + eqn.U * (eqn.V' * Z); - end - end - else % rosenbrock - if fopts.rosenbrock.stage == 2 - A = (fopts.rosenbrock.tau * fopts.rosenbrock.gamma) * A; - end - if eqn.haveUV - if eqn.type=='T' - A = A + eqn.V * (eqn.U' * Z); - else - A = A + eqn.U * (eqn.V' * Z); - end - end - end - else - A = oper.mul_A( eqn, fopts, eqn.type, Z, 'N' ); - if eqn.haveUV - if eqn.type=='T' - A = A + eqn.V * (eqn.U' * Z); - else - A = A + eqn.U * (eqn.V' * Z); - end - end - end - A = Z' * A; - if eqn.haveE - E = Z'*(oper.mul_E(eqn, fopts,eqn.type,Z,'N')); - else - E = []; - end - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - % Choose solver for the small equation - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - switch opts.projection.meth - case 'lyapchol' - % in LDL_T with S neg. EV sqrt(S_diag) will be complex - if fopts.LDL_T - B = B * U * sqrt(S); - if eqn.haveE - XC = lyapchol(A,B,E); - else - XC = lyapchol(A,B); - end - [~,S,XC] = svd(XC,'econ'); - XC = XC'; - D = S.^2; - S = 1; - else - if eqn.haveE - XC=lyapchol(A,B,E); - else - XC=lyapchol(A,B); - end - end - factorize=0; - - case 'lyap_sgn_fac' - if fopts.LDL_T - B = B * U * sqrt(S); - XC = lyap_sgn_fac(A',B',E'); - [~,S,XC] = svd(XC,'econ'); - XC = XC'; - D = S.^2; - S = 1; - else - XC = lyap_sgn_fac(A',B',E'); - end - factorize=0; - - case {'lyap','lyapunov'} - if fopts.LDL_T - B = B*U*S*U'*B'; - B = (B + B') / 2; % make sure it's symmetric for lyap - if eqn.haveE - X = lyap(A,B,[],E); - else - X = lyap(A,B); - end - else - if eqn.haveE - X = lyap(A,B*B',[],E); - else - X = lyap(A,B*B'); - end - end - - case 'lyap2solve' - if eqn.haveE - EB = E\B; - if fopts.LDL_T - X = lyap2solve(E\A,EB*U*S*U'*EB'); - else - X = lyap2solve(E\A,EB*EB'); - end - else - if fopts.LDL_T - X = lyap2solve(A,B*U*S*U'*B'); - else - X = lyap2solve(A,B*B'); - end - end - end - case 'CARE' - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - % The Riccati equation case - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - lyapunov = 0; - if eqn.type=='T' - opAE = 'N'; - if bdf - B=Z'*eqn.B * sqrt(fopts.bdf.tau * fopts.bdf.beta); - else - B=Z'*eqn.B; - end - C=eqn.C*Z; - else - opAE = 'T'; - if bdf - B=Z'*eqn.C' * sqrt(fopts.bdf.tau * fopts.bdf.beta); - else - B=Z'*eqn.C'; - end - C=eqn.B'*Z; - end - if bdf - A = (fopts.bdf.tau * fopts.bdf.beta) * (Z' ... - * oper.mul_ApE(eqn, fopts,opAE,pc,opAE,Z,'N')); - else - A = oper.mul_A( eqn, fopts, opAE, Z, 'N' ); - if eqn.haveUV && eqn.sizeUV1 - if eqn.type=='T' - A = A + eqn.U(:, 1:eqn.sizeUV1) ... - * (eqn.V(:, 1:eqn.sizeUV1)' * Z); - else - A = A + eqn.V(:, 1:eqn.sizeUV1) ... - * (eqn.U(:, 1:eqn.sizeUV1)' * Z); - end - end - A = Z' * A; - end - if eqn.haveE - E = Z'*(oper.mul_E(eqn, fopts,opAE,Z,'N')); - else - E = []; - end - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - % Choose solver for the small equation - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - switch opts.projection.meth - case {'care', 'riccati'} - if exist('icare','file') - warning('MESS:care',['It seems that icare() is ' ... - 'available on your system. ' ... - 'We recommend using icare() ' ... - 'over using care() following the ' ... - 'recommendation by TMW.']) - end - - if fopts.LDL_T - X=care(A,B,C'*eqn.S*C,eye(size(B,2)),[],E); - else - X=care(A,B,C'*C,eye(size(B,2)),[],E); - end - - case {'icare'} - if fopts.LDL_T - X=icare(A,B,C'*eqn.S*C,eye(size(B,2)),[],E); - else - X=icare(A,B,C'*C,eye(size(B,2)),[],E); - end - - case 'care_nwt_fac' - if fopts.LDL_T - C = sqrt(S) * U' * C; - end - if not(isempty(E)) - XC = care_nwt_fac([],A/E,B,C/E,1e-12,50); - else - XC = care_nwt_fac([],A,B,C,1e-12,50); - end - if fopts.LDL_T - [~,S,XC] = svd(XC,'econ'); - XC = XC'; - D = S.^2; - S = 1; - end - factorize=0; - - case 'mess_dense_nm' - if fopts.LDL_T - X=mess_dense_nm(A,B,C,E, [], eqn.S); - else - X=mess_dense_nm(A,B,C,E); - end - end -end - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% If the projected solution was not already computed in factored form -% compute a symmetric factorization now and update the large factor -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if factorize - if fopts.LDL_T - [V, D] = eig(X); - Z = Z * V; - S = 1; - elseif (exist('cholp','file')) - [XC,P,I]=cholp(X); - XC=XC*P'; - if I && lyapunov - warning('MESS:proj_sol_semidef',... - 'The solution of the projected equation was semidefinite.'); - end - else - [~,S,V]=svd(X); - s=diag(S); - r=find(s>s(1)*eps); - XC=diag(sqrt(s(r)))*V(:,r)'; - end -end -if exist('XC','var'), Z = Z * XC'; end diff --git a/helpers/mess_h2_rom_change.m b/helpers/mess_h2_rom_change.m deleted file mode 100644 index 96a9ef4..0000000 --- a/helpers/mess_h2_rom_change.m +++ /dev/null @@ -1,50 +0,0 @@ -function [romchg] = mess_h2_rom_change(E1,A1,B1,C1,E2,A2,B2,C2,rel) -% [romchg] = mess_h2_rom_change(E1,A1,B1,C1,E2,A2,B2,C2,rel) -% -% computes the (relative) difference of two stable systems in the H2 norm. -% -% Inputs: -% E1,A1,B1,C1,E2,A2,B2,C2 The system matrices (E1,E2 invertible) -% rel indicator whether the relative or absolute norm -% is desired. -% -% Output: -% romchg the computed H2-norm difference -% - -% -% This file is part of the M-M.E.S.S. project -% (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. -% All rights reserved. -% License: BSD 2-Clause License (see COPYING) -% - -if nargin<8, error('to few inputs'); end -if nargin<9, rel=0; end - -E = blkdiag(E1,E2); -A = blkdiag(A1,A2); -B = [B1; B2]; -C = [C1, -C2]; - -if exist('lyap','file') - X = lyap(A,B*B',[],E); - -else - B = E\B; - X = lyap2solve(E\A,B*B'); -end -nrm = sqrt(trace(C*(X*C'))); -if rel - if exist('lyap','file') - X1 = lyap(A1,B1*B1',[],E1); - else - B1 = E1\B1; - X1 = lyap2solve(E1\A1,B1*B1'); - end - nrm1 = sqrt(trace(C1*(X1*C1'))); -else - nrm1 = 1.0; -end -romchg = nrm/nrm1; diff --git a/helpers/mess_make_proper.m b/helpers/mess_make_proper.m index c338886..22042a0 100644 --- a/helpers/mess_make_proper.m +++ b/helpers/mess_make_proper.m @@ -1,4 +1,4 @@ -function [ y, perm ] = mess_make_proper( x ) +function [y, perm] = mess_make_proper(x) % MESS_MAKE_PROPER ensures the input vector to be a proper set of shifts % % [ y, perm ] = mess_make_proper( x ) @@ -22,40 +22,46 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % +opts = struct; +if isempty(x) + y = x; + return +end -if isempty(x), y=x; return; end - -[m,n] = size(x); +[m, n] = size(x); -if m < n, x = x'; end +if m < n + x = x'; +end -idro = find(imag(x)==0.0); +idro = find(imag(x) == 0.0); idco = find(imag(x)); xr = x(idro); xc = x(idco); k = length(xc); -if rem(k,2)~=0, error('odd number of complex shifts detected'); end +if not(rem(k, 2) == 0) + mess_err(opts, 'error_arguments', 'odd number of complex shifts detected'); +end % Sort real shifts -[xr,idr] = sort(xr); +[xr, idr] = sort(xr); % Sort complex shifts w.r.t. real part -[~,idcr] = sort(real(xc)); +[~, idcr] = sort(real(xc)); xc = xc(idcr); % Complex conjugated pairs ensured -xc(2:2:k,:) = conj(xc(1:2:k,:)); +xc(2:2:k, :) = conj(xc(1:2:k, :)); % Sort complex shifts w.r.t. real part -[~, idcr2]=sort(real(xc)); +[~, idcr2] = sort(real(xc)); xc = xc(idcr2); y = [xr; xc]; -perm = [idro(idr);idco(idcr(idcr2))]; +perm = [idro(idr); idco(idcr(idcr2))]; end - diff --git a/helpers/mess_mgs.m b/helpers/mess_mgs.m deleted file mode 100644 index ec2f27c..0000000 --- a/helpers/mess_mgs.m +++ /dev/null @@ -1,102 +0,0 @@ -function [Q, R] = mess_mgs(A,E) -% -% function [Q, R] = mess_mgs(A,E); -% -% modified Gram-Schmidt orthogonalization of the columns of -% A. The columns of A are assumed to be linearly independent. -% -% [Q, R] = mgs(A) returns a matrix Q with orthonormal columns -% and an invertible upper triangular matrix R so that A = Q*R. -% If only orthogonalization is wanted, the accumulation of R can be -% avoided by omitting the output parameter: -% Q = mgs(A) -% -% [Q, R] = mgs(A,E) performs the orthonormalization in the E scalar -% product, i.e., E needs to be symmetric positive definite. -% - -% -% This file is part of the M-M.E.S.S. project -% (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. -% All rights reserved. -% License: BSD 2-Clause License (see COPYING) -% - -if not(isnumeric(A)) || not(ismatrix(A)) - error('MESS:error_arguments','A has to be a matrix'); -end - -if (nargin == 2) - - if not(isnumeric(E)) || not(ismatrix(E)) - error('MESS:error_arguments','E has to be a matrix'); - end - - if size(A, 1) ~= size(E, 2) - error('MESS:error_arguments','number of columns of E differs with number of rows of A'); - end - - if any(any(E'-E)) - error('MGS:input matrix E needs to be selfadjoint'); - end -else - E = 1; -end - -[m,n] = size(A); - -R = zeros(n,n); -Q = zeros(m,n); - -for k=1:n - if nargout == 2 - - R(k,k) = Enorm(E,A(:,k)); - - Q(:,k) = A(:,k)/R(k,k); - - for l=k+1:n - - R(k,l) = Edot(Q(:,k)',A(:,l)); - - A(:,l) = A(:,l)-Q(:,k)*R(k,l); - end - else - - R = Enorm(E,A(:,k)); - - Q(:,k) = A(:,k)/R; - - for l=k+1:n - - R = Edot(Q(:,k)',A(:,l)); - - A(:,l) = A(:,l)-Q(:,k)*R; - end - end -end -end - -function mm = Edot(E,x,y) - - if isscalar(E) && (E == 1) - - mm = x * y; - else - - mm = x * (E*y); - end -end - -function nrm = Enorm(E,x) - - if isscalar(E) && (E == 1) - - nrm = norm(x); - else - - nrm = sqrt(x'*(E*x)); - end -end - diff --git a/helpers/mess_reset.m b/helpers/mess_reset.m index 225d97b..dd25da7 100644 --- a/helpers/mess_reset.m +++ b/helpers/mess_reset.m @@ -7,7 +7,7 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % @@ -20,4 +20,4 @@ clearvars; end -clc; \ No newline at end of file +clc; diff --git a/helpers/mess_solve_projected_eqn.m b/helpers/mess_solve_projected_eqn.m new file mode 100644 index 0000000..d143b11 --- /dev/null +++ b/helpers/mess_solve_projected_eqn.m @@ -0,0 +1,685 @@ +function [eqn, opts, oper] = ... + mess_solve_projected_eqn(eqn, opts, oper, framework, type) +% function [out, eqn, opts, oper] = +% mess_solve_projected_eqn(eqn, opts, oper, framework, type) +% +% Function that solves small-scale projected Lyapunov and Riccati +% equations, either projected to the solution span (Galerkin projection +% acceleration (GPA), e.g. in LRNM) or the Krylov basis in KSM. +% +% Input and output: +% +% type possible values: 'LE','CARE' +% determines whether a Lyapunov ('LE') or a +% Riccati ('CARE') equation should be +% projected +% +% eqn structure with data for A, E, W +% in the equation determined by type +% +% oper structure contains function handles for +% operations with A, E +% +% framework possible values: 'KSM','GPA' +% KSM: the projected equation involved in the +% Krylov method is solved +% GPA: the Galerkin acceleration scheme is +% applied +% +% opts options structure that needs to contain one +% of the following members +% +% opts.adi options structure for ADI method +% +% opts.nm options structure for Newton method +% +% opts.KSM options structure for Krylov method +% +% +% xopts opts.adi, opts.nm or opts.KSM depending on +% 'type' above. We expect a substructure called +% 'projection' in xopts that has entries: +% +% ortho possible values: false, true +% implicit (false) or explicit (true) +% orthogonalization of Z in LRNM +% i.e., explicit orthogonalization via orth(). +% (optional, default: true, +% ignored in framework KSM) +% +% meth method for solving projected Lyapunov or +% Riccati equation. Depending on 'type' possible +% values are: 'lyapchol', 'lyap_sgn_fac', 'lyap', +% 'lyapunov', 'lyap2solve', 'icare', 'care', +% 'care_nwt_fac', 'mess_dense_nm' +% (optional, default: best available solver for the +% type depending on the presence of the control +% toolbox/package and version of Matlab/Octave used.) +% Remark: some solver are disallowed/excluded when +% opts.LDL_T is 'true'. +% +% Output: +% +% (KSM) +% opts.KSM.compute_struct.Y solution of the projected equation +% +% (GPA) +% xopts.projection.Z +% xopts.projection.D Updated solution factors after prolongation written +% into the correct substructure xopts represents +% +% +% uses operatorfunctions mul_A, mul_E, mul_ApE + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +%% Check Inputs +if not(isfield(opts, 'LDL_T')) || isempty(opts.LDL_T) + opts.LDL_T = false; +end + +switch framework + case 'GPA' + + switch type + + case {'LE'} + + xopts = opts.adi; + + case {'CARE'} + + xopts = opts.nm; + + otherwise + + mess_err(opts, 'GP_type', ... + ['type has to be ''LE'' or ''CARE'' in Galerkin '... + 'projection acceleration.']); + end + + case 'KSM' + + xopts = opts.KSM; + + otherwise + mess_err(opts, 'GP_framework', ... + ['unknown framework requested. Must be either', ... + ' ''GPA'' or ''KSM''.']); +end + +% check for process required parameters in xopts +if not(isfield(xopts, 'projection')) || ... + not(isfield(xopts.projection, 'ortho')) || ... + not(islogical(xopts.projection.ortho)) % last one covers non-empty + + switch framework + case 'GPA' % we want to orthogonalize the factor columns + + xopts.projection.ortho = true; + + case 'KSM' % orthogonalization is part of the basis generation + + xopts.projection.ortho = false; + end +end + +% if opts.projection.meth is not set, or the user did not specify an actual +% solver method but an equation let us set a default solver +if not(isfield(xopts.projection, 'meth')) || ... + isempty(xopts.projection.meth) || ... + isequal(xopts.projection.meth, 'lyapunov') || ... + isequal(xopts.projection.meth, 'riccati') + + switch type + case 'LE' + xopts.projection.meth = find_recommended_CALE_solver(opts.LDL_T); + case 'CARE' + xopts.projection.meth = find_recommended_CARE_solver(); + end +end + +% now we check if the requested routines are actually available and set a +% fallback if not. +if not(exist(xopts.projection.meth, 'file')) + meth_non_ex = xopts.projection.meth; + switch type + case 'LE' + xopts.projection.meth = find_recommended_CALE_solver(opts.LDL_T); + case 'CARE' + xopts.projection.meth = find_recommended_CARE_solver(); + end + + mess_warn(opts, 'missing_solver', ... + ['mess_solve_projected_eqn was unable to find'... + ' solver ''%s'', switched to ''%s'''], meth_non_ex, ... + xopts.projection.meth); +end + +% In the LDL_T case the core matrix may be indefinite and ZZ^T factored dense +% solvers may fail, or use complex data that we carefully avoid otherwise, so we +% disallow them +if opts.LDL_T && ... + (isequal(xopts.projection.meth, 'care_nwt_fac') || ... + isequal(xopts.projection.meth, 'lyap_sgn_fac') || ... + isequal(xopts.projection.meth, 'lyapchol')) + + mess_err(opts, 'illegal_input', ... + ['We do not allow ZZ^T factored dense solver in LDL_T mode,'... + 'as ''D'' may be indefinite.']); + +end + +%% Set small matrices + +switch framework + case 'KSM' + % prepare the coefficients of the projected equation + beta = opts.KSM.compute_struct.beta; + it = opts.KSM.compute_struct.it; + A = opts.KSM.compute_struct.T; + if strcmp('EK', opts.KSM.space) + p = size(beta, 2) / 2; + A = A(1:2 * p * it, 1:2 * p * it); + B = eye(size(A, 2), p) * beta(1:p, 1:p) * ... + diag(sqrt(diag(eqn.T))); + elseif strcmp('RK', opts.KSM.space) + p = size(beta, 2); + A = A(1:p * it, 1:p * it); + B = eye(size(A, 2), p) * beta(1:p, 1:p) * ... + diag(sqrt(diag(eqn.T))); + S = 1.0; % actually eye(size(B, 2)); but scalar is cheaper + U = 1.0; % actually eye(size(B, 2)); but scalar is cheaper + + end + + if strcmp(type, 'CARE') + A = A'; + C = B'; + S = 1.0; % actually eye(size(C, 1)); but scalar is cheaper + U = 1.0; % actually eye(size(C, 1)); but scalar is cheaper + B = opts.KSM.compute_struct.Bm; + if strcmp('EK', opts.KSM.space) + B = B(1:2 * p * it, :); + elseif strcmp('RK', opts.KSM.space) + B = B(1:p * it, :); + end + R = eye(size(B, 2)); + end + if exist('OCTAVE_VERSION', 'builtin') + E = eye(size(A)); + else + E = []; + end + + case 'GPA' + if not(xopts.projection.ortho) + mess_warn(opts, 'accuracy', ... + ['Galerkin projection acceleration without ', ... + 'orthogonalization of the projection basis ', ... + 'is dangerous. Only use this when you know that ', ... + 'orthogonalization happened outside already.']); + end + [A, B, C, E, Z, S, U, R, lyapunov] = ... + GPA_projected_matrices(eqn, opts, oper, xopts, type); +end + +%% Here comes the actual solution process for the projected matrix equation +factorize = true; +switch type + case 'LE' + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + % Choose solver for the small equation + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + switch xopts.projection.meth + case 'lyapchol' + if opts.LDL_T + B = B * U * sqrt(S); + if isempty(E) + XC = lyapchol(A, B); + else + XC = lyapchol(A, B, E); + end + [~, S, XC] = svd(XC, 'econ'); + XC = XC'; + xopts.projection.D = S.^2; + else + if isempty(E) + XC = lyapchol(A, B); + else + XC = lyapchol(A, B, E); + end + end + factorize = false; + + case 'lyap_sgn_fac' + if opts.LDL_T + B = B * U * sqrt(S); + XC = lyap_sgn_fac(A', B', E'); + [~, S, XC] = svd(XC, 'econ'); + XC = XC'; + xopts.projection.D = S.^2; + else + XC = lyap_sgn_fac(A', B', E'); + XC = XC'; + end + factorize = false; + + case {'lyap'} + if opts.LDL_T + B = B * U * S * U' * B'; + B = (B + B') / 2; % make sure it's symmetric for lyap + if isempty(E) + X = lyap(A, B); + else + X = lyap(A, B, [], E); + end + else + if isempty(E) + X = lyap(A, B * B'); + else + X = lyap(A, B * B', [], E); + end + end + + case 'lyap2solve' + if eqn.haveE && not(isempty(E)) + EB = E \ B; + if opts.LDL_T + X = lyap2solve(E \ A, EB * U * S * U' * EB'); + else + X = lyap2solve(E \ A, EB * EB'); + end + else + if opts.LDL_T + X = lyap2solve(A, B * U * S * U' * B'); + else + X = lyap2solve(A, B * B'); + end + + end + end + + case 'CARE' + switch xopts.projection.meth + case {'care'} + if opts.LDL_T + G = C' * S * C; + else + G = C' * C; + S = []; + end + if isempty(E) + X = care(A, B, G, R); + res = norm(A' * X + X * A - ... + (X * B) * (R \ (B' * X)) + G, 'fro'); + else + X = care(A, B, G, R, [], E); + res = norm(A' * X * E + E' * X * A - ... + E' * (X * B) * (R \ (B' * X)) * E + G, 'fro'); + end + if res / norm(G, 'fro') >= 1e-12 + X = mess_dense_nm(opts, A, B, C, E, X, S, R); + end + case {'icare'} + if opts.LDL_T + G = C' * S * C; + else + G = C' * C; + S = []; + end + if isempty(E) + X = icare(A, B, G, R); + res = norm(A' * X + X * A - ... + (X * B) * (R \ (B' * X)) + G, 'fro'); + else + X = icare(A, B, G, R, [], E); + res = norm(A' * X * E + E' * X * A - ... + E' * (X * B) * (R \ (B' * X)) * E + G, 'fro'); + end + if res / norm(G, 'fro') >= 1e-12 + X = mess_dense_nm(opts, A, B, C, E, X, S, R); + end + case 'care_nwt_fac' + if opts.LDL_T + C = sqrt(S) * U' * C; + end + if not(isempty(E)) + XC = care_nwt_fac([], A / E, B, C / E, 1e-10, 100); + X = XC' * XC; + if norm(A' * X * E + E' * X * A - ... + (E' * (X * B)) * (B' * X) * E + ... + C' * S * C, 'fro') / ... + norm(C' * S * C, 'fro') >= 1e-12 + X = mess_dense_nm(opts, A, B, C, [], X, S, R); + end + else + XC = care_nwt_fac([], A, B, C, 1e-10, 100); + X = XC' * XC; + if norm(A' * X + X * A - ... + (X * B) * (B' * X) + ... + C' * S * C, 'fro') / ... + norm(C' * C, 'fro') >= 1e-12 + X = mess_dense_nm(opts, A, B, C, [], X, S, R); + end + end + if opts.LDL_T + [~, S, XC] = svd(XC, 'econ'); + XC = XC'; + opts.projection.D = diag(S).^2; + XC = XC'; + else + clear XC; + end + factorize = false; + + case 'mess_dense_nm' + if opts.LDL_T + X = mess_dense_nm(opts, A, B, C, E, [], S, R); + else + X = mess_dense_nm(opts, A, B, C, E); + end + end + +end +%% Post processing +% For KSM we actually want the full solution matrix, while for GPA need some +% factored form of it. +switch framework + + case 'KSM' + if exist('XC', 'var') + if opts.LDL_T + X = XC * xopts.projection.D * XC'; + else + X = XC * XC'; + end + end + opts.KSM.compute_struct.Y = X; + + case 'GPA' + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + % If the projected solution was not already computed in factored + % form compute a symmetric factorization now and update the large + % factor + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + if factorize + if opts.LDL_T + + xopts.projection.D = X; + xopts.projection.Z = Z; + + elseif exist('cholp', 'file') + [XC, P, I] = cholp(X); + XC = P * XC'; + + if I && lyapunov + mess_warn(opts, 'proj_sol_semidef', ... + ['The solution of the projected ', ... + 'equation was semidefinite.']); + end + else + [~, S, V] = svd(X); + s = diag(S); + r = find(s > s(1) * eps); + xopts.projection.XC = diag(sqrt(s(r))) * V(:, r)'; + end + end + + if exist('XC', 'var') + xopts.projection.Z = Z * XC; + end + +end + +%% Finally we need to write the results to the correct substructure +switch framework + case 'GPA' + + switch type + + case {'LE'} + + opts.adi.projection = xopts.projection; + + case {'CARE'} + + opts.nm.projection = xopts.projection; + + otherwise + + mess_err(opts, 'GP_type', ... + ['type has to be ''LE'' or ''CARE'' in Galerkin '... + 'projection acceleration.']); + end + + case 'KSM' + + opts.KSM.projection = xopts.projection; + +end + +end % of main function + +%% Local helper functions +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% find the recommended solver for the continuous ALE +function out = find_recommended_CALE_solver(LDL_T) +if exist('lyap', 'file') + out = 'lyap'; +elseif LDL_T && exist('lyap2solve', 'file') + out = 'lyap2solve'; +elseif exist('lyap_sgn_fac', 'file') + out = 'lyap_sgn_fac'; +end +end + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% find the recommended solver for continuous ARE +function out = find_recommended_CARE_solver() + +if exist('icare', 'file') + out = 'icare'; +elseif exist('care', 'file') + out = 'care'; +elseif exist('mess_dense_nm', 'file') + out = 'mess_dense_nm'; +end +end + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% compute projected coefficient matrices +function [A, B, C, E, Z, S, U, R, lyapunov] = ... + GPA_projected_matrices(eqn, opts, oper, xopts, type) + +if not(isfield(opts, 'rosenbrock')) + opts.rosenbrock = []; +end +if isstruct(opts.rosenbrock) && isfield(opts.rosenbrock, 'tau') + rosenbrock = 1; + if opts.rosenbrock.stage == 1 + pc = -1 / (2 * opts.rosenbrock.tau); + else % stage 2 + pc = -1 / (2 * opts.rosenbrock.tau * opts.rosenbrock.gamma); + end +else + rosenbrock = 0; +end +if not(isfield(opts, 'bdf')) + opts.bdf = []; +end +if isstruct(opts.bdf) && isfield(opts.bdf, 'tau') && ... + isfield(opts.bdf, 'beta') + bdf = 1; + pc = -1 / (2 * opts.bdf.tau * opts.bdf.beta); +else + bdf = 0; +end + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Compute projector matrix +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if opts.LDL_T + [Z, ~] = ... + mess_column_compression(xopts.projection.Z, 'N', ... + xopts.projection.D, eps, 0); + + switch type + case 'LE' + + U = 1; + S = eqn.T; + + case 'CARE' + + if eqn.type == 'T' + [U, S] = eig(eqn.Q); + R = eqn.R; + else + [U, S] = eig(eqn.R); + R = eqn.Q; + end + + end + +else + + [nZ, mZ] = size(xopts.projection.Z); + + if eqn.type == 'T' + R = eye(size(eqn.B, 2)); + else + R = eye(size(eqn.C, 1)); + end + + if xopts.projection.ortho || mZ > nZ + + Z = orth(xopts.projection.Z); + U = 1.0; + S = 1.0; + + else + + Z = xopts.projection.Z; + [U, S, ~] = svd(full(Z' * Z)); + s = diag(S); + sk = find(s > eps * s(1), 1, 'last'); + Z = Z * U(:, 1:sk) * diag(1 ./ sqrt(s(1:sk))); + + end + +end + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Compute Coefficient matrices +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +switch type + case 'LE' + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + % The Lyapunov equation case + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + lyapunov = true; + C = []; + R = []; + B = Z' * eqn.W; + if bdf || rosenbrock + A = oper.mul_ApE(eqn, opts, eqn.type, ... + pc, eqn.type, Z, 'N'); + if bdf + A = (opts.bdf.tau * opts.bdf.beta) * A; + if eqn.haveUV + if eqn.type == 'T' + A = A + eqn.V * (eqn.U' * Z); + else + A = A + eqn.U * (eqn.V' * Z); + end + end + else % rosenbrock + if opts.rosenbrock.stage == 2 + A = (opts.rosenbrock.tau * opts.rosenbrock.gamma) * A; + end + if eqn.haveUV + if eqn.type == 'T' + A = A + eqn.V * (eqn.U' * Z); + else + A = A + eqn.U * (eqn.V' * Z); + end + end + end + else + A = oper.mul_A(eqn, opts, eqn.type, Z, 'N'); + if eqn.haveUV + if eqn.type == 'T' + A = A + eqn.V * (eqn.U' * Z); + else + A = A + eqn.U * (eqn.V' * Z); + end + end + end + A = Z' * A; + if eqn.haveE + E = Z' * oper.mul_E(eqn, opts, eqn.type, Z, 'N'); + else + if exist('OCTAVE_VERSION', 'builtin') + E = eye(size(A)); + else + E = []; + end + end + + case 'CARE' + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + % The Riccati equation case + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + lyapunov = false; + if eqn.type == 'T' + opAE = 'N'; + if bdf + B = Z' * eqn.B * sqrt(opts.bdf.tau * opts.bdf.beta); + else + B = Z' * eqn.B; + end + C = U' * eqn.C * Z; + else + opAE = 'T'; + if bdf + B = Z' * eqn.C' * sqrt(opts.bdf.tau * opts.bdf.beta); + else + B = Z' * eqn.C'; + end + C = U' * eqn.B' * Z; + end + if bdf + A = (opts.bdf.tau * opts.bdf.beta) * ... + (Z' * oper.mul_ApE(eqn, opts, opAE, pc, opAE, Z, 'N')); + else + A = oper.mul_A(eqn, opts, opAE, Z, 'N'); + if eqn.haveUV && eqn.sizeUV1 + one = 1:eqn.sizeUV1; + if eqn.type == 'T' + A = A + eqn.U(:, one) * (eqn.V(:, one)' * Z); + else + A = A + eqn.V(:, one) * (eqn.U(:, one)' * Z); + end + end + A = Z' * A; + end + if eqn.haveE + E = Z' * oper.mul_E(eqn, opts, opAE, Z, 'N'); + else + if exist('OCTAVE_VERSION', 'builtin') + E = eye(size(A)); + else + E = []; + end + end +end + +end diff --git a/helpers/mess_solve_shifted_system.m b/helpers/mess_solve_shifted_system.m deleted file mode 100644 index 9db3821..0000000 --- a/helpers/mess_solve_shifted_system.m +++ /dev/null @@ -1,67 +0,0 @@ -function [V, eqn, opts, oper] = ... - mess_solve_shifted_system(eqn, opts, oper, pc, W) -% Solves (à + p*E)V = W for V, à = A or à = A - UV^T -% -% Solves (à + p*E)V = W for V, à = A or à = A - UV^T if eqn.type == 'N' -% Solves (à + p*E)^T*V = W for V, à = A or à = A - UV^T if eqn.type == 'T' -% -% -% Input: -% eqn structure containing equation data -% -% opts structure containing parameters for the algorithm -% -% oper contains function handles with operations for A and E -% -% pc contains shift parameter p -% -% W contains right hand side -% -% Output: -% V solution of the shifted system -% -% eqn structure containing equation data -% -% opts structure containing parameters for the algorithm -% -% oper contains function handles with operations for A and E - -% -% This file is part of the M-M.E.S.S. project -% (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. -% All rights reserved. -% License: BSD 2-Clause License (see COPYING) -% - - -%% Check input - -%% Initialize data -k = size(W, 2); -if eqn.haveUV - m = size(eqn.U, 2); -end - -%% preprocess shifted solver -[eqn, opts, oper] = oper.sol_ApE_pre(eqn, opts, oper); - -%% solve shifted system -if eqn.haveUV %Perform Sherman-Morrison-Woodbury-trick - if eqn.type == 'T' - V = oper.sol_ApE(eqn, opts, eqn.type, pc, eqn.type, [W eqn.V], 'N'); - SMW = V(:, k + 1 : end); - V = V(:, 1 : k); - V = V - SMW * ((eye(m) + eqn.U' * SMW) \ (eqn.U' * V)); - else - V = oper.sol_ApE(eqn, opts, eqn.type, pc, eqn.type, [W eqn.U], 'N'); - SMW = V(:, k + 1 : end); - V = V(:, 1 : k); - V = V - SMW * ((eye(m) + eqn.V' * SMW) \ (eqn.V' * V)); - end -else - V = oper.sol_ApE(eqn, opts, eqn.type, pc, eqn.type, W, 'N'); -end - -%% postprocess shifted solver -[eqn, opts, oper] = oper.sol_ApE_post(eqn, opts, oper); diff --git a/helpers/mess_solve_shifted_system_BDF.m b/helpers/mess_solve_shifted_system_BDF.m deleted file mode 100644 index 49fce5e..0000000 --- a/helpers/mess_solve_shifted_system_BDF.m +++ /dev/null @@ -1,77 +0,0 @@ -function [ V, eqn, opts, oper ]=mess_solve_shifted_system_BDF(eqn, opts, oper, pc, W) -% Solves (à + p*E)V = W for V, à = tau*beta*A - 0.5*E -% or à = tau*beta*A - 0.5*E - UV^T (BDF scheme) -% -% Solves (à + p*E)V = W for V, à = tau*beta*A - 0.5*E -% or à = tau*beta*A - 0.5*E - UV^T if eqn.type == 'N' -% Solves (à + p*E)^T*V = W for V, à = tau*beta*A - 0.5*E -% or à = tau*beta*A - 0.5*E - UV^T if eqn.type == 'T' -% (BDF scheme) -% -% -% Input: -% eqn structure containing equation data -% -% opts structure containing parameters for the algorithm -% -% oper contains function handles with operations for A and E -% -% pc contains shift parameter p -% -% W contains right hand side -% -% Output: -% V solution of the shifted system -% -% eqn structure containing equation data -% -% opts structure containing parameters for the algorithm -% -% oper contains function handles with operations for A and E - -% -% This file is part of the M-M.E.S.S. project -% (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. -% All rights reserved. -% License: BSD 2-Clause License (see COPYING) -% - - -%% Check input - -%% Initialize data -k = size(W, 2); -if eqn.haveUV - m = size(eqn.U, 2); -end - -%% Manipulate shift for BDF scheme -pc = (pc - 0.5) / (opts.bdf.tau * opts.bdf.beta); - -%% preprocess shifted solver -[eqn, opts, oper] = oper.sol_ApE_pre(eqn, opts, oper); - -%% solve shifted system -if eqn.haveUV %Perform Sherman-Morrison-Woodbury-trick - if eqn.type == 'T' - V = oper.sol_ApE(eqn, opts,eqn.type,pc,eqn.type,... - [W eqn.V] / (opts.bdf.tau * opts.bdf.beta),'N'); - SMW = V(:,k+1:end); - V=V(:,1:k); - V=V-SMW*((eye(m)+eqn.U'*SMW)\(eqn.U'*V)); - else - V = oper.sol_ApE(eqn, opts,eqn.type,pc,eqn.type,... - [W eqn.U] / (opts.bdf.tau * opts.bdf.beta),'N'); - SMW = V(:,k+1:end); - V=V(:,1:k); - V=V-SMW*((eye(m)+eqn.V'*SMW)\(eqn.V'*V)); - - end -else - V = oper.sol_ApE(eqn, opts,eqn.type,pc,eqn.type,... - W / (opts.bdf.tau * opts.bdf.beta),'N'); -end - -%% postprocess shifted solver -[eqn, opts, oper] = oper.sol_ApE_post(eqn, opts, oper); diff --git a/helpers/mess_solve_shifted_system_Rosenbrock.m b/helpers/mess_solve_shifted_system_Rosenbrock.m deleted file mode 100644 index aecd874..0000000 --- a/helpers/mess_solve_shifted_system_Rosenbrock.m +++ /dev/null @@ -1,96 +0,0 @@ -function [ V, eqn, opts, oper ]=mess_solve_shifted_system_Rosenbrock(eqn, opts, oper, pc, W) -% Solves (à + p*E)V = W for V, à = A - 1/(2*tau)*E - UV^T -% (Rosenbrock Scheme) -% -% Solves (à + p*E)V = W for V, à = A - 1/(2*tau)*E - UV^T if eqn.type == 'N' -% Solves (à + p*E)^T*V = W for V, à = A - 1/(2*tau)*E - UV^T if eqn.type == 'T' -% (Rosenbrock Scheme) -% -% -% Input: -% eqn structure containing equation data -% -% opts structure containing parameters for the algorithm -% -% oper contains function handles with operations for A and E -% -% pc contains shift parameter p -% -% W contains right hand side -% -% Output: -% V solution of the shifted system -% -% eqn structure containing equation data -% -% opts structure containing parameters for the algorithm -% -% oper contains function handles with operations for A and E - -% -% This file is part of the M-M.E.S.S. project -% (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. -% All rights reserved. -% License: BSD 2-Clause License (see COPYING) -% - - -%% Check input - -%% Initialize data -k = size(W, 2); -if eqn.haveUV - m = size(eqn.U, 2); -end - -%% Manipulate shift for Rosenbrock scheme -if opts.rosenbrock.stage == 1 - pc = pc - 1 / (opts.rosenbrock.tau * 2); -else % p = 2 - taugamma = (opts.rosenbrock.tau * opts.rosenbrock.gamma); - pc = (pc - 0.5) / taugamma; -end - -%% preprocess shifted solver -[eqn, opts, oper] = oper.sol_ApE_pre(eqn, opts, oper); - -%% solve shifted system -if opts.rosenbrock.stage == 1 % 1st order Rosenbrock - if eqn.haveUV %Perform Sherman-Morrison-Woodbury-trick - if eqn.type == 'T' - V = oper.sol_ApE(eqn, opts,eqn.type,pc,eqn.type,[W eqn.V],'N'); - SMW = V(:,k+1:end); - V=V(:,1:k); - V=V-SMW*((eye(m)+eqn.U'*SMW)\(eqn.U'*V)); - else - V = oper.sol_ApE(eqn, opts,eqn.type,pc,eqn.type,[W eqn.U],'N'); - SMW = V(:,k+1:end); - V=V(:,1:k); - V=V-SMW*((eye(m)+eqn.V'*SMW)\(eqn.V'*V)); - - end - else - V = oper.sol_ApE(eqn, opts,eqn.type,pc,eqn.type,W,'N'); - end -else % p = 2, 2nd order Rosenbrock - if eqn.haveUV %Perform Sherman-Morrison-Woodbury-trick - if eqn.type == 'T' - V = oper.sol_ApE(eqn, opts,eqn.type,pc,eqn.type,[W eqn.V] / taugamma,'N'); - SMW = V(:,k+1:end); - V=V(:,1:k); - V=V-SMW*((eye(m)+eqn.U'*SMW)\(eqn.U'*V)); - else - V = oper.sol_ApE(eqn, opts,eqn.type,pc,eqn.type,[W eqn.U] / taugamma,'N'); - SMW = V(:,k+1:end); - V=V(:,1:k); - V=V-SMW*((eye(m)+eqn.V'*SMW)\(eqn.V'*V)); - - end - else - V = oper.sol_ApE(eqn, opts,eqn.type,pc,eqn.type, W / taugamma,'N'); - end -end - -%% postprocess shifted solver -[eqn, opts, oper] = oper.sol_ApE_post(eqn, opts, oper); diff --git a/helpers/mess_string.m b/helpers/mess_string.m new file mode 100644 index 0000000..f210e9b --- /dev/null +++ b/helpers/mess_string.m @@ -0,0 +1,47 @@ +function out = mess_string(in) +% function out = mess_string(in) +% +% converts input into a string, or array of strings if it was an array or +% cell itself +% +% mess_string falls back to string if that exists and passed input strings +% directly to the output. +% +% This is mostly intended to add the string function to octave, where it +% does not exist (yet). +% + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +out = ''; +if isa(in, 'char') + out = in; +elseif exist('string', 'file') + out = string(in); +elseif isa(in, 'cell') + for sub = in + out = [out, mess_string(sub)]; %#ok + end +elseif isa(in, 'double') || isa(in, 'single') + for i = 1:length(in) + out = sprintf('%s, %g', out, in); + end +elseif isa(in, 'int8') || isa(in, 'int16') || isa(in, 'int32') || ... + isa(in, 'int64') || isa(in, 'uint8') || isa(in, 'uint16') || ... + isa(in, 'uint32') || isa(in, 'uint64') + for i = 1:length(in) + out = sprintf('%s, %d', in); + end +elseif isa(in, 'logical') + Logicals = {'False', 'True'}; + out = Logicals{in(1) + 1}; + for i = 2:length(in) + out = [out Logicals(in(i) + 1)]; %#ok + end +end diff --git a/helpers/mess_symmetrize.m b/helpers/mess_symmetrize.m new file mode 100644 index 0000000..f1d96d0 --- /dev/null +++ b/helpers/mess_symmetrize.m @@ -0,0 +1,18 @@ +function [A] = mess_symmetrize(A) +% MESS_SYMMETRIZE makes sure the matrix A is numerically symmetric +% +% Input / Output +% +% A a theoretically symmetric matrix that may be numerically unsymmetric +% and is symmetrized, i.e. numerically symmetric on output. + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +A = 0.5 * (A + A'); +end diff --git a/helpers/mess_version.m b/helpers/mess_version.m new file mode 100644 index 0000000..8bc2d36 --- /dev/null +++ b/helpers/mess_version.m @@ -0,0 +1,43 @@ +function [ver, opts] = mess_version(opts, quiet) +% MESS_VERSION prints a short version message and returns the version +% number as a string +% +% Input +% +% opts options structure containing the logger data for correct +% printing of the message +% (optional, defaults to empty struct, i.e. printing only to +% the console) +% quiet switch printing of message of when set to 'quiet' +% (optional, default is printing enabled) +% +% Output +% +% ver the numeric version as a string +% opts the options structure +% + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +ver = '3.0'; + +if nargin < 2 || not(strcmp(quiet, 'quiet')) + if nargin < 1 || isempty(opts) + opts = mess_log_initialize(struct()); + else + if not(isfield(opts, 'log')) + mess_log_initialize(opts); + end + end + + mess_fprintf(opts, '\n'); + mess_fprintf(opts, 'This is M-M.E.S.S. version %s\n\n', ver); +end + +end diff --git a/helpers/mess_websave.m b/helpers/mess_websave.m new file mode 100644 index 0000000..7707873 --- /dev/null +++ b/helpers/mess_websave.m @@ -0,0 +1,16 @@ +function mess_websave(filename, downloadurl) +%%% mess_websave is a websave wrapper that falls back to urlwrite +% on older MATLAB and OCTAVE where websave is not available. + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% +if exist('websave', 'file') + websave(filename, downloadurl); +else + urlwrite(downloadurl, filename); %#ok +end diff --git a/logger/mess_assert.m b/logger/mess_assert.m new file mode 100644 index 0000000..2614ddb --- /dev/null +++ b/logger/mess_assert.m @@ -0,0 +1,23 @@ +function opts = mess_assert(opts, condition, reason, message, varargin) +%% assert wrapper for additional output streams +% opts the opts struct containing a logger field. +% condition condition to assert +% reason the error code to throw if the assertion fails, +% restricted to the ones in mess_codes +% message the error message, describing the error in finer detail +% varargin message can take sprintf-like arguments, these are the +% arguments to sprintf(message,varargin) + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +if not(condition) + mess_err(opts, reason, message, varargin); +end + +end diff --git a/logger/mess_err.m b/logger/mess_err.m new file mode 100644 index 0000000..5901b8e --- /dev/null +++ b/logger/mess_err.m @@ -0,0 +1,67 @@ +function opts = mess_err(opts, reason, message, varargin) +%% error wrapper for additional output streams +% opts the opts struct containing a logger field. +% reason the error code, restricted to the ones in mess_codes +% message the error message, describing the error in finer detail +% varargin message can take sprintf-like arguments, these are the +% arguments to sprintf(message,varargin) + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% +if not(size(message, 1) == 1) + message = message'; + mess_warn(opts, 'warning_arguments', 'message should not be transposed'); +end +% check for presence of opts.logger +opts = log_checkopts(opts); + +% varargin is not empty, replace placeholders in message +if not(isempty(varargin)) + message = sprintf(message, varargin{1:end}); +end + +codes = mess_log_codes('error'); +if not(sum(ismember(codes, reason) > 0)) + warning('MESS:error_arguments', 'error code is not valid'); + return +end + +db = dbstack(); + +MessageToPrint = log_formatter(opts, reason, message, 'err'); + +switch opts.logger.out + case 'console' + % nothing to do. the actual error is handled below. + + case 'file' + fprintf(opts.logger.file, [MessageToPrint, '\n']); + mess_log_finalize(opts); + + case 'both' + fprintf(opts.logger.file, [MessageToPrint, '\n']); + opts = mess_log_finalize(opts); + + otherwise + error(MESS:illegal_log_location, ... + 'Requested unsupported log location'); + +end + +% the program should halt under any circumstances when an error is thrown, +% otherwise this would not qualify as an error + +% make MATLAB throw the error three levels above this file, +% this way not every error is thrown in mess_err +errorStruct.message = char(message); +errorStruct.identifier = char(strcat('MESS:', reason)); +errorStruct.stack = db(2:end); +% throw the error +error(errorStruct); + +end diff --git a/logger/mess_fprintf.m b/logger/mess_fprintf.m new file mode 100644 index 0000000..7d30deb --- /dev/null +++ b/logger/mess_fprintf.m @@ -0,0 +1,53 @@ +function mess_fprintf(opts, message, varargin) +%% prints the message to the output(s) specified in opts +% opts the opts struct containing a logger field. +% message the message, can contain format specifying placeholders +% varargin sprintf-like arguments to 'message' + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +% check for presence of opts.logger +opts = log_checkopts(opts); +if not(size(message, 1) == 1) + message = message'; + mess_warn(opts, 'warning_arguments', 'message should not be transposed'); +end +% varargin is not empty, replace placeholders in message +if not(isempty(varargin)) + if strcmp(opts.logger.format, 'md') + message = strrep(message, '\n', ' \n'); + end + message = sprintf(message, varargin{1:end}); +end + +MessageToPrint = log_formatter(opts, [], message, 'log'); + +switch opts.logger.out + case 'console' + fprintf(message); + + case 'file' + if strcmp(opts.logger.format, 'md') + fprintf(opts.logger.file, MessageToPrint); + else + fprintf(opts.logger.file, [MessageToPrint, '\n']); + end + case 'both' + if strcmp(opts.logger.format, 'md') + fprintf(opts.logger.file, MessageToPrint); + else + fprintf(opts.logger.file, [MessageToPrint, '\n']); + end + fprintf(message); + + otherwise + error(MESS:illegal_log_location, ... + 'Requested unsupported log location'); + +end diff --git a/logger/mess_log_codes.m b/logger/mess_log_codes.m new file mode 100644 index 0000000..c0fc2ec --- /dev/null +++ b/logger/mess_log_codes.m @@ -0,0 +1,118 @@ +function codes = mess_log_codes(type) +%% returns the allowed ErrId/WarnId-values for the M-M.E.S.S-Project +% +% Input: +% +% type determines the ID types to return: +% 'error' return only error IDs +% 'err' as above +% 'warning' return only warning IDs +% 'warn' as above +% 'all' return all valid IDs +% (optional, defaults to 'all') + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +if nargin < 1 + type = 'all'; +end + +errors = { ... + 'GP_missing_solver', ... + 'GP_type', ... + 'SMW', ... + 'TEST:accuracy', ... + 'check_data', ... + 'complex_shifts', ... + 'control_data', ... + 'convergence', ... + 'data', ... + 'equation_data', ... + 'equation_type', ... + 'error_arguments', ... + 'error_usage', ... + 'exact_line_search', ... + 'failure', ... + 'framework', ... + 'get_initial_subspace', ... + 'illegal_input', ... + 'inaccurate_result', ... + 'inexact', ... + 'info', ... + 'inputs', ... + 'lrnm', ... + 'mess_para', ... + 'missing_feature', ... + 'missing_solver', ... + 'notimplemented', ... + 'outer_tol', ... + 'relative_error', ... + 'riccati', ... + 'shift_method', ... + 'shifts', ... + 'shifts_improper', ... + 'type', ... + 'unstable' + }; + +warnings = { ... + 'BT', ... + 'CARE_NWT_FAC', ... + 'GP_missing_solver', ... + 'OFF|ON', ... + 'antistable_ritz', ... + 'b0', ... + 'care', ... + 'check_data', ... + 'compute_sol_fac', ... + 'control_data', ... + 'convergence', ... + 'dense', ... + 'denseNM_convergence', ... + 'equation_type', ... + 'error_norms', ... + 'exact_line_search', ... + 'exp_action', ... + 'failure', ... + 'galerkin_projection_acceleration', ... + 'ignored', ... + 'illegal_input', ... + 'implicitVtAV', ... + 'inaccurate result', ... + 'invalid_parameter_fallback', ... + 'lrnm', ... + 'lyap_sgn_fac', ... + 'maxiter', ... + 'mess_para', ... + 'missing_solver', ... + 'not_implemented', ... + 'off', ... + 'on', ... + 'proj_sol_semidef', ... + 'projection_shifts', ... + 'unstable', ... + 'usfs_iter', ... + 'warning_arguments' + }; + +switch lower(type) + case {'err', 'error'} + codes = errors; + + case {'warn', 'warning'} + codes = warnings; + + case 'all' + codes = unique(union(errors, warnings)); + + otherwise + error('invalid input ''%s''', type); +end + +end diff --git a/logger/mess_log_finalize.m b/logger/mess_log_finalize.m new file mode 100644 index 0000000..1df7246 --- /dev/null +++ b/logger/mess_log_finalize.m @@ -0,0 +1,19 @@ +function opts = mess_log_finalize(opts) +%% finalizes the logging, renders pdf in some cases +% opts the opts struct containing a logger field. + +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) + +opts = log_checkopts(opts); + +if strcmp(opts.logger.out, 'console') + return +end +write_log_footer(opts); + +fclose(opts.logger.file); +opts.logger = rmfield(opts.logger, 'file'); diff --git a/logger/mess_log_initialize.m b/logger/mess_log_initialize.m new file mode 100644 index 0000000..bb414c0 --- /dev/null +++ b/logger/mess_log_initialize.m @@ -0,0 +1,70 @@ +function opts = mess_log_initialize(opts, name) +%% initializes the logging mechanisms +% +% opts the opts struct containing a logger field. +% +% name the working title of this computation, used as the basename +% for the log-file. +% (optional, defaults to name of the calling function) +% +% returns: the updated opts struct + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) + +if not(isfield(opts, 'logger')) || not(isfield(opts.logger, 'out')) + opts = log_checkopts(opts); +end + +if not(strcmp(opts.logger.out, 'console')) + if exist('name', 'var') + opts.logger.basename = name; + else + ST = dbstack; + if length(ST) > 1 + opts.logger.basename = ST(2).name; + name = ST(2).name; + else + name = 'interactive'; + end + end + + % create the ./mess_log folder, if not present + logpath = pwd; + [~, ~, ~, timeformat] = log_config; + if exist('OCTAVE_VERSION', 'builtin') + timestamp = datestr(now(), timeformat); + else + timestamp = char(datetime('now', 'Format', timeformat)); + end + logdir = ['mess_log-', name, '-', timestamp]; + + [SUCCESS, MESSAGE, ~] = mkdir(logpath, logdir); + if not(SUCCESS) + error('MESS:logger_init', ... + 'Could not create M.E.S.S. log directory .\n Reason given: %s', ... + MESSAGE); + end + + % opts must be complete before this is called + opts = log_checkopts(opts); + + opts.logger.messlogdir = [logpath, filesep, logdir]; + filename = [opts.logger.basename, '.', opts.logger.format]; + + [opts.logger.file, errmsg] = ... + fopen([opts.logger.messlogdir, filesep, filename], 'w+'); + + if opts.logger.file < 0 + error('MESS:logger_init', ... + 'Could not create M.E.S.S. log file.\n Reason given: %s', ... + errmsg); + end + + write_log_header(opts); + +end diff --git a/logger/mess_log_matrix.m b/logger/mess_log_matrix.m new file mode 100644 index 0000000..dd7b57c --- /dev/null +++ b/logger/mess_log_matrix.m @@ -0,0 +1,35 @@ +function mess_log_matrix(opts, varargin) +%% logging matrices into files +% opts the opts struct containing a logger field. +% varargin data that should be logged, can be multiple variables + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +opts = log_checkopts(opts); +if nargin + % A matrix is logged. + for i = 1:length(varargin) + filename = [opts.logger.messlogdir, filesep, ... + inputname(i + 1), '.mat']; + assign(inputname(i + 1), varargin(i)); + save(filename, inputname(i + 1)); + if isfield(opts, 'logger') && isfield(opts.logger, 'out') && ... + not(strcmp(opts.logger.out, 'console')) + mess_fprintf(opts, ... + '%s was logged to %s \n', ... + inputname(i + 1), ... + filename); + end + end +end +end + +function assign(VarName, VarValue) +assignin('caller', VarName, VarValue); +end diff --git a/logger/mess_log_plot.m b/logger/mess_log_plot.m new file mode 100644 index 0000000..9d3cfe1 --- /dev/null +++ b/logger/mess_log_plot.m @@ -0,0 +1,57 @@ +function mess_log_plot(opts, figure, figurename) +%% logging for figures into files as well as embedding into text files +% opts the opts struct containing a logger field. +% figure figure handle to the figure +% figurename string naming the figure + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +if nargin < 3 + % octave compatibility + if not(exist('OCTAVE_VERSION', 'builtin')) + figurename = strcat('figure', string(figure.Number), '.png'); + else + figurename = strcat('figure', num2str(figure), '.png'); + end +end +supported_formats = {'png', 'eps', 'svg'}; + +opts = log_checkopts(opts); + +if isfield(opts.logger, 'figureformat') && ... + ismember(opts.logger.figureformat, supported_formats) + + type = opts.logger.figureformat; +else + type = 'png'; +end + +if not(strcmp(opts.logger.out, 'console')) + full_figurename = [opts.logger.messlogdir, filesep, figurename]; + saveas(figure, full_figurename, type); + saveas(figure, full_figurename, 'png'); + + switch opts.logger.format + case 'md' + fprintf(opts.logger.file, ... + '![%s](%s) \n', ... + figurename, ... + [full_figurename, '.', type]); + case 'tex' + fprintf(opts.logger.file, ... + '\\includegraphics{%s} \\\\ \n', ... + [figurename, '.', type]); + case 'html' + fprintf(opts.logger.file, ... + '
', ... + [full_figurename, '.', type]); + otherwise + % error treating + end +end diff --git a/logger/mess_warn.m b/logger/mess_warn.m new file mode 100644 index 0000000..cd82aa7 --- /dev/null +++ b/logger/mess_warn.m @@ -0,0 +1,104 @@ +function mess_warn(opts, reason, message, varargin) +%% warnings with additional output streams +% opts the opts struct containing a logger field. +% reason the warning code, restricted to the ones in mess_codes +% message the warning message, describing the warning in finer +% detail +% varargin message can take sprintf-like arguments, these are the +% arguments to sprintf(message,varargin) + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +% check for presence of opts.logger +opts = log_checkopts(opts); +% check for special case where warnings are turned on/off +% mess_warn(opts, 'OFF|ON', 'warning') + +% check message dimensions +if not(size(message, 1) == 1) + message = message'; + mess_warn(opts, 'warning_arguments', 'message should not be transposed'); +end +disabled = warning('query'); +disabledWarnings = struct2cell(disabled); +disabledWarnings = disabledWarnings(1, :); +if ismember(['MESS:' reason], disabledWarnings) + return +end +if strcmpi(reason, 'ON') || strcmpi(reason, 'OFF') + warning(reason, message); + if not(strcmp(opts.logger.out, 'console')) + warning('MESS:notimplemented', ... + 'warnings cannot be altered for file logging'); + end + return +end + +% varargin is not empty, replace placeholders in message +if not(isempty(varargin)) + message = sprintf(message, varargin{1:end}); +end +codes = mess_log_codes('warning'); + +if not(sum(ismember(codes, reason) > 0)) + warning('MESS:error_arguments', ... + ' %s is not a valid code', reason); + return +end + +file = []; +line = []; + +db = dbstack(1); +if not(isempty(db)) + file = db(1).file; + line = db(1).line; +end + +MessageToPrint = log_formatter(opts, reason, message, 'warn'); + +% disable backtrace because that would show this file as a source, that's +% sort of wrong though. +warnstate = warning('off', 'backtrace'); + +switch opts.logger.out + case 'file' + + fprintf(opts.logger.file, [MessageToPrint, '\n']); + case 'both' + fprintf(opts.logger.file, [MessageToPrint, '\n']); + if not(isempty(file)) + warning(['MESS:' reason], ... + [message, '\n> in ', file, ' L', int2str(line)]); + trace = interactiveStack(dbstack); + for i = length(trace):-1:1 + fprintf(1, trace{i}); + end + else % this is when mess_warn is called interactively + warning(['MESS:' reason], message); + end + + case 'console' + if not(isempty(file)) + warning(['MESS:' reason], message); + % print backtrace with opentoline refs + trace = interactiveStack(dbstack); + for i = length(trace):-1:1 + fprintf(1, trace{i}); + end + else + warning(['MESS:' reason], message); + end + + otherwise + error(MESS:illegal_log_location, ... + 'Requested unsupported log location'); +end +% re-enable backtrace, so other stuff does not break +warning(warnstate); diff --git a/logger/private/cleantex.m b/logger/private/cleantex.m new file mode 100644 index 0000000..fb985a8 --- /dev/null +++ b/logger/private/cleantex.m @@ -0,0 +1,25 @@ +function string = cleantex(input_string, backslashonly) %#ok +%% sanitizes input_string and escapes problematic characters with respect to TeX +% +% +% input_string String with potentially un-escaped characters +% +% string Escaped String for usage in TeX +% + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% +if nargin < 2 + input_string = strrep(input_string, '\n', '\newline{}'); + input_string = strrep(input_string, '_', '\_'); + input_string = strrep(input_string, '\', '\\'); + string = input_string; +else + input_string = strrep(input_string, '\', '\\'); + string = input_string; +end diff --git a/logger/private/interactiveStack.m b/logger/private/interactiveStack.m new file mode 100644 index 0000000..8f719c8 --- /dev/null +++ b/logger/private/interactiveStack.m @@ -0,0 +1,31 @@ +function StackString = interactiveStack(stack) +% creates a backtrace from a dbstack with opentoline ref links of the +% backtrace + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +if length(stack) <= 2 + arrow = '>'; +else + arrow = '\x21b3'; +end +if exist('OCTAVE_VERSION', 'builtin') + % octave does not support opentoline + for i = 2:length(stack) + StackString{i - 1} = sprintf('%s In %s (line %s)\n', ... + '>', stack(i).name, ... + int2str(stack(i).line)); %#ok<*AGROW> + end +else + for i = 2:length(stack) + StackString{i - 1} = sprintf('%s[\b In %s (line %s)]\b\n', ... + arrow, cleantex(which(stack(i).file), true), int2str(stack(i).line), ... + stack(i).name, int2str(stack(i).line)); + end +end diff --git a/logger/private/log_checkopts.m b/logger/private/log_checkopts.m new file mode 100644 index 0000000..a61fc29 --- /dev/null +++ b/logger/private/log_checkopts.m @@ -0,0 +1,42 @@ +function opts = log_checkopts(opts) +%% The opts will be checked for completeness, if opts is (partially) +% missing, it will be filled with the default values from "log_config" +% +% opts potentially incomplete options struct, concerning the +% opts.logger part +% +% +% opts logging-wise complete options struct. + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +% default options can be configured in log_config.m +[out, format, figureformat, timeformat] = log_config(); + +% checking opts, and defaulting to console logging +if not(isfield(opts, 'logger')) + opts.logger = struct(); +end +if not(isfield(opts.logger, 'out')) + opts.logger.out = out; +end +% in case someone forgot the format, default to md +if not(isfield(opts.logger, 'format')) + opts.logger.format = format; +end +if not(isfield(opts.logger, 'figureformat')) + opts.logger.figureformat = figureformat; +end +if not(isfield(opts.logger, 'basename')) + if exist('OCTAVE_VERSION', 'builtin') + opts.logger.basename = datestr(now(), timeformat); + else + opts.logger.basename = char(datetime('now', 'Format', timeformat)); + end +end diff --git a/logger/private/log_config.m b/logger/private/log_config.m new file mode 100644 index 0000000..0b7a77e --- /dev/null +++ b/logger/private/log_config.m @@ -0,0 +1,18 @@ +function [out, format, figureformat, timeformat] = log_config +%% For every routine that does not get the 'opts' struct, these values will +% be used as a default fallback to ensure the logger does not crash. + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +% these are the logging controls for every routine that does not get the +% 'opts' argument. +out = 'console'; +format = 'md'; +figureformat = 'png'; +timeformat = 'yyyy-MM-dd-HH-mm-ss'; diff --git a/logger/private/log_formatter.m b/logger/private/log_formatter.m new file mode 100644 index 0000000..15745ab --- /dev/null +++ b/logger/private/log_formatter.m @@ -0,0 +1,106 @@ +function formatted_Message = log_formatter(opts, reason, message, level) +%% formats the reason and message according to the opts and the level +% opts the options struct +% reason the reason the exception was thrown +% message further explanation on the error +% level corresponds to the calling function; +% 'log' fprintf +% 'warn' warn +% 'err' error +% +% formatted_Message combined reason & message according to opts & level + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +stack = dbstack; +% stack(1) is this, +% stack(2) is mess_err/mess_warn +% stack(3) is whatever calls mess_err/mess_warn +if length(stack) > 2 + line = stack(3).line; + file = stack(3).file; +else + line = 0; + file = 'command-line'; +end + +delim1 = ''; +delim2 = ''; +IDstring = 'MESS:'; +mark = '>'; + +switch opts.logger.format + case 'tex' + newline = '\\newline{}'; + mark = '$>$'; + file = strrep(file, '_', '\\_'); + switch level + case 'warn' + delim1 = '\\textcolor{orange}{'; + delim2 = '}'; + keyword = '-Warning: '; + case 'err' + delim1 = '\\textcolor{red}{'; + delim2 = '}'; + keyword = '-Error: '; + end + + % the reason mostly contains stuff like + % to escape this properly to latex this needs to become + % because fprintf will choke otherwise + if not(isempty(reason)) + reason = cleantex(reason); + end + + message = cleantex(message); + case 'md' + newline = ''; + switch level + case 'warn' + delim1 = '*'; + delim2 = '*'; + keyword = '-Warning: '; + case 'err' + delim1 = '***'; + delim2 = '***'; + keyword = '-Error: '; + end + message = strrep(message, '\n', newline); + case 'html' + newline = '
'; + switch level + case 'warn' + delim1 = '

'; + delim2 = '

'; + keyword = '-Warning: '; + case 'err' + delim1 = '

'; + delim2 = '

'; + keyword = '-Error: '; + end + message = strrep(message, '\n', newline); +end +if not(isempty(reason)) + reason = [reason, keyword]; + if strcmp(opts.logger.format, 'md') + formatted_Message = ... + [delim1, IDstring, reason, message, newline, mark, ' in ', ... + file, ' L', int2str(line), delim2, newline]; + else + formatted_Message = ... + [delim1, ' ', IDstring, reason, message, newline, mark, ' in ', ... + file, ' L', int2str(line), delim2, newline]; + end +else % 'log' level case + if strcmp(opts.logger.format, 'md') + formatted_Message = message; + else + formatted_Message = [message, newline]; + end +end diff --git a/logger/private/stackToString.m b/logger/private/stackToString.m new file mode 100644 index 0000000..4c06969 --- /dev/null +++ b/logger/private/stackToString.m @@ -0,0 +1,14 @@ +function StackString = stackToString(stack) +% creates a compact backtrace from a dbstack + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% +StackString = ''; +for i = 2:length(stack) + StackString = strcat(StackString, '>>', stack(i).file, '(', int2str(stack(i).line), ')'); +end diff --git a/logger/private/write_log_footer.m b/logger/private/write_log_footer.m new file mode 100644 index 0000000..63f0d47 --- /dev/null +++ b/logger/private/write_log_footer.m @@ -0,0 +1,35 @@ +function write_log_footer(opts) +%% writes the matching file header for the specified format +% format specifies which header is to be returned +% +% header the first lines to print into the file for -logging + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% +file = ['log.' lower(opts.logger.format) '.templ']; + +% find the templates +messpath = fileparts(which('mess_path.m')); +template = [messpath filesep 'logger' filesep 'resources' filesep file]; +founddiv = false; +fid = fopen(template); +tline = fgetl(fid); +if strcmp(tline, '======HEADER ABOVE, FOOTER BELOW, DO NOT MODIFY THIS LINE======') + founddiv = true; +end +while ischar(tline) + if founddiv + fprintf(opts.logger.file, '%s\n', tline); + end + + if strcmp(tline, '======HEADER ABOVE, FOOTER BELOW, DO NOT MODIFY THIS LINE======') && not(founddiv) + founddiv = true; + end + tline = fgetl(fid); +end +fclose(fid); diff --git a/logger/private/write_log_header.m b/logger/private/write_log_header.m new file mode 100644 index 0000000..15ddcd5 --- /dev/null +++ b/logger/private/write_log_header.m @@ -0,0 +1,29 @@ +function write_log_header(opts) +%% writes the matching file header for the specified format +% format specifies which header is to be returned +% +% header the first lines to print into the file for -logging + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +file = ['log.' lower(opts.logger.format) '.templ']; + +% find the templates +messpath = fileparts(which('mess_path.m')); +template = [messpath filesep 'logger' filesep 'resources' filesep file]; +fid = fopen(template); +tline = fgetl(fid); +while ischar(tline) + fprintf(opts.logger.file, '%s\n', tline); + tline = fgetl(fid); + if strcmp(tline, '======HEADER ABOVE, FOOTER BELOW, DO NOT MODIFY THIS LINE======') + break + end +end +fclose(fid); diff --git a/logger/resources/log.html.templ b/logger/resources/log.html.templ new file mode 100644 index 0000000..64afaad --- /dev/null +++ b/logger/resources/log.html.templ @@ -0,0 +1,6 @@ + + + +======HEADER ABOVE, FOOTER BELOW, DO NOT MODIFY THIS LINE====== + + diff --git a/logger/resources/log.md.templ b/logger/resources/log.md.templ new file mode 100644 index 0000000..e69de29 diff --git a/logger/resources/log.tex.templ b/logger/resources/log.tex.templ new file mode 100644 index 0000000..2e44271 --- /dev/null +++ b/logger/resources/log.tex.templ @@ -0,0 +1,9 @@ +\documentclass[a4paper]{report} +\usepackage{xcolor} +\usepackage{graphicx} +\usepackage{epstopdf} +\epstopdfsetup{update} + +\begin{document} +======HEADER ABOVE, FOOTER BELOW, DO NOT MODIFY THIS LINE====== +\end{document} diff --git a/mat-eqn-solvers/mess_KSM.m b/mat-eqn-solvers/mess_KSM.m new file mode 100644 index 0000000..e7fb156 --- /dev/null +++ b/mat-eqn-solvers/mess_KSM.m @@ -0,0 +1,381 @@ +function [out, eqn, opts, oper] = mess_KSM(eqn, opts, oper) +% function [out, eqn, opts, oper] = mess_KSM(eqn, opts, oper) +% Solve continuous-time Lyapunov equations with sparse coefficients +% +% eqn.type = 'N' -> A*Z*Z'*E' + E*Z*Z'*A' + B*B' = 0 (N) +% eqn.type = 'T' -> A'*Z*Z'*E + E'*Z*Z'*A + C'*C = 0 (T) +% +% or continuous time algebraic Riccati equation +% +% eqn.type = 'N' -> A*X*E' + E*X*A' - E*X*C'*C*X*E' + B*B' = 0 (N) +% eqn.type = 'T' -> A'*X*E + E'*X*A - E'*X*B*B'*X*E + C'*C = 0 (T) +% +% by th extended and rational Krylov subspace method. +% +% Input & Output +% eqn struct contains data for equations +% +% opts struct contains parameters for the algorithm +% +% oper struct contains function handles for operations +% with A and E +% +% Output +% out struct contains the low-rank factor of the solution (and other +% info) +% +% Input fields in struct eqn: +% +% eqn.B dense (n x q) matrix B +% +% eqn.C dense (p x n) matrix C +% +% +% eqn.type possible values: 'N', 'T' +% determining whether (N) or (T) is solved +% (optional, default 'N') +% +% eqn.haveE possible values: false, true +% if haveE = false: matrix E is assumed to be the identity +% (optional) +% +% Depending on the operator chosen by the operatormanager, additional +% fields may be needed. For the "default", e.g., eqn.A_ and eqn.E_ hold +% the A and E matrices. For the second order types these are given +% implicitly by the M, D, K matrices stored in eqn.M_, eqn.E_ and eqn.K_, +% respectively. +% +% Input fields in struct opts: +% opts.KSM.space possible values: +% 'EK': the extended Krylov subspace method is applied +% 'RK': the rational Krylov subspace method is applied +% +% opts.KSM.type_eq possible values: +% "LE": if we are solving a Lyapunov +% equation +% "CARE": if we are solving an algebraic +% Riccati equation +% +% opts.KSM.symmetric possible values +% 1: if A is symmetric +% any other value if A is nonsymmetric +% REMARK: full orthogonalization is always +% performed to improve stability +% +% opts.KSM.maxiter maximum number of iteration allowed +% +% opts.KSM.res_tol threshold for the relative residual norm. +% If res < opts.tol * norm(rhs) we stop the algorithm +% +% opts.KSM.trunc_tol possible values: scalar > 0 +% tolerance for rank truncation of the +% low-rank solutions (aka column compression) +% (optional, default: eps*n) +% +% opts.KSM.trunc_info possible values: 0, 1 +% verbose mode for column compression +% (optional, default: 0) +% +% Output fields in struct out: +% +% out.Z, out.D the approximate solution is represented as +% out.Z*out.D*out.Z' +% where out.Z is n-by-t, t< 0 % tolerance for LDL_T column compression % (optional, default: eps*n) % -% opts.bdf.trunc_info possible values: 0, 1, false, true +% opts.bdf.trunc_info possible values: 0, 1 % verbose mode for column compression % (optional, default: 0) % @@ -111,24 +119,25 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Check for BDF Control structure in options %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if not(isfield(opts,'bdf')) || not(isstruct(opts.bdf)) - error('MESS:control_data','BDF control structure opts.bdf missing.'); +if not(isfield(opts, 'bdf')) || not(isstruct(opts.bdf)) + mess_err(opts, 'control_data', ... + 'BDF control structure opts.bdf missing.'); end % Single fields are checked below or inside mess_lradi -if not(isfield(opts.bdf,'time_steps')) || not(isnumeric(opts.bdf.time_steps)) ... - || isscalar(opts.bdf.time_steps) - error('MESS:control_data','opts.bdf.time_steps is missing.'); +if not(isfield(opts.bdf, 'time_steps')) || ... + not(isnumeric(opts.bdf.time_steps)) || ... + isscalar(opts.bdf.time_steps) + mess_err(opts, 'control_data', 'opts.bdf.time_steps is missing.'); end opts.t0 = opts.bdf.time_steps(1); @@ -136,37 +145,46 @@ tend = opts.bdf.time_steps(end); opts.bdf.tau = t1 - opts.t0; tau_original = opts.bdf.tau; -eq_err = norm(opts.bdf.time_steps - linspace(opts.t0, tend, length(opts.bdf.time_steps))); +eq_err = norm(opts.bdf.time_steps - ... + linspace(opts.t0, tend, length(opts.bdf.time_steps))); if eq_err > (eps * length(opts.bdf.time_steps)) - error('MESS:control_data', ... - 'opts.bdf.time_steps has to contain equidistant time steps.'); + mess_err(opts, 'control_data', ... + 'opts.bdf.time_steps has to contain equidistant time steps.'); end -if not(isfield(opts.bdf,'step')), opts.bdf.step = 1; end +if not(isfield(opts.bdf, 'step')) + opts.bdf.step = 1; +end if rem(opts.bdf.step, 1) || (opts.bdf.step < 1) || (opts.bdf.step > 4) - error('MESS:control_data','opts.bdf.step has an invalid value.'); + mess_err(opts, 'control_data', 'opts.bdf.step has an invalid value.'); end -if not(isfield(opts.bdf,'info')), opts.bdf.info = 0; end +if not(isfield(opts.bdf, 'info')) + opts.bdf.info = 0; +end -if not(isfield(opts.bdf,'trunc_tol')) +if not(isfield(opts.bdf, 'trunc_tol')) opts.bdf.trunc_tol = eps * oper.size(eqn, opts); end -if not(isfield(opts.bdf, 'trunc_info')), opts.bdf.trunc_info = 0; end +if not(isfield(opts.bdf, 'trunc_info')) + opts.bdf.trunc_info = 0; +end -if not(isfield(opts.bdf,'save_solution')), opts.bdf.save_solution = 0; end +if not(isfield(opts.bdf, 'save_solution')) + opts.bdf.save_solution = 0; +end if opts.bdf.step > 2 - if not(isfield(opts.bdf,'startup_iter') ) + if not(isfield(opts.bdf, 'startup_iter')) opts.bdf.startup_iter = 8; end if rem(opts.bdf.startup_iter, 1) - error('MESS:control_data',... - 'opts.bdf.startup_iter has an invalid value.'); + mess_err(opts, 'control_data', ... + 'opts.bdf.startup_iter has an invalid value.'); end end @@ -174,15 +192,16 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Check for Newton control structure in options %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if not(isfield(opts,'nm')) || not(isstruct(opts.nm)) - error('MESS:control_data','Newton control structure opts.nm missing.'); +if not(isfield(opts, 'nm')) || not(isstruct(opts.nm)) + mess_err(opts, 'control_data', ... + 'Newton control structure opts.nm missing.'); end -if isfield(opts.nm,'res_tol') && isnumeric(opts.nm.res_tol) +if isfield(opts.nm, 'res_tol') && isnumeric(opts.nm.res_tol) out.res = []; end -if isfield(opts.nm,'rel_diff_tol') && isnumeric(opts.nm.rel_diff_tol) +if isfield(opts.nm, 'rel_diff_tol') && isnumeric(opts.nm.rel_diff_tol) out.rc = []; end @@ -190,41 +209,46 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Check for ADI control structure in options %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if not(isfield(opts,'adi')) || not(isstruct(opts.adi)) - error('MESS:control_data','ADI control structure opts.adi missing.'); +if not(isfield(opts, 'adi')) || not(isstruct(opts.adi)) + mess_err(opts, 'control_data', ... + 'ADI control structure opts.adi missing.'); end -if not(isfield(opts.adi,'compute_sol_fac')) || ... - not(isnumeric(opts.adi.compute_sol_fac)) || ... +if not(isfield(opts.adi, 'compute_sol_fac')) || ... + not(islogical(opts.adi.compute_sol_fac)) || ... not(opts.adi.compute_sol_fac) - warning('MESS:compute_sol_fac', ... - 'Missing or Corrupted compute_sol_fac field. Switching to default.'); - opts.adi.compute_sol_fac = 1; + mess_warn(opts, 'compute_sol_fac', ... + ['Missing or Corrupted compute_sol_fac field. ', ... + 'Switching to default.']); + opts.adi.compute_sol_fac = true; end %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Check for shift computation control structure in options %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if not(isfield(opts,'shifts')) || not(isstruct(opts.shifts)) - error('MESS:control_data','shifts control structure opts.shifts missing.'); +if not(isfield(opts, 'shifts')) || not(isstruct(opts.shifts)) + mess_err(opts, 'control_data', ... + 'shifts control structure opts.shifts missing.'); end -if not(isfield(opts.shifts,'implicitVtAV')) +if not(isfield(opts.shifts, 'implicitVtAV')) opts.shifts.implicitVtAV = true; end if not(isnumeric(opts.shifts.implicitVtAV)) && ... not(islogical(opts.shifts.implicitVtAV)) - warning('MESS:implicitVtAV', ... - 'Missing or Corrupted implicitVtAV field. Switching to default (true).'); + mess_warn(opts, 'implicitVtAV', ... + ['Missing or Corrupted implicitVtAV field. ', ... + 'Switching to default (true).']); opts.shifts.implicitVtAV = true; end if not(opts.shifts.implicitVtAV) - warning('MESS:implicitVtAV', ... - 'implicitVtAV must be true for mess_bdf_dre. Switching to default (true).'); + mess_warn(opts, 'implicitVtAV', ... + ['implicitVtAV must be true for mess_bdf_dre. ', ... + 'Switching to default (true).']); opts.shifts.implicitVtAV = true; end @@ -232,69 +256,71 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Check system data %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if not(isfield(eqn, 'LTV')), eqn.LTV = 0; end +if not(isfield(eqn, 'LTV')) + eqn.LTV = false; +end -if isfield(opts,'LDL_T') && (opts.LDL_T == 0) - warning('MESS:control_data',['The BDF code does only support ' ... - 'LDL_T solutions.\n Setting opts.LDL_T=1']); +if isfield(opts, 'LDL_T') && not(opts.LDL_T) + mess_warn(opts, 'control_data', ... + ['The BDF code does only support ' ... + 'LDL_T solutions.\n Setting opts.LDL_T = true']); end -opts.LDL_T = 1; +opts.LDL_T = true; -if not(isfield(eqn,'type')) - eqn.type='N'; - warning('MESS:control_data',['Unable to determine type of equation.'... - 'Falling back to type ''N''']); +if not(isfield(eqn, 'type')) + eqn.type = 'N'; + mess_warn(opts, 'control_data', ... + ['Unable to determine type of equation.'... + 'Falling back to type ''N''']); -elseif not(eqn.type=='N') && not(eqn.type=='T') - error('MESS:equation_type','Equation type must be either ''T'' or ''N'''); +elseif not(eqn.type == 'N') && not(eqn.type == 'T') + mess_err(opts, 'equation_type', ... + 'Equation type must be either ''T'' or ''N'''); end -[result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A','E'); - if eqn.LTV if isfield(oper, 'eval_matrix_functions') - [eqn, opts, oper] = oper.eval_matrix_functions(eqn, opts, oper, ... - opts.bdf.time_steps(end)); + [eqn, opts, oper] = ... + oper.eval_matrix_functions(eqn, opts, oper, ... + opts.bdf.time_steps(end)); else - error('MESS:missing_feature', ['The function eval_matrix_functions is ', ... - 'required for LTV problems, but it has ', ... - 'not yet been implemented for this set ', ... - 'of USFS functions']); + mess_err(opts, 'missing_feature', ... + ['The function eval_matrix_functions is ', ... + 'required for LTV problems, but it has ', ... + 'not yet been implemented for this set ', ... + 'of USFS functions']); end end +[result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A', 'E'); + if not(isfield(eqn, 'C')) || not(isnumeric(eqn.C)) - error('MESS:control_data', 'eqn.C is not defined or corrupted'); + mess_err(opts, 'control_data', 'eqn.C is not defined or corrupted'); end if not(isfield(eqn, 'B')) || not(isnumeric(eqn.B)) - error('MESS:control_data', 'eqn.B is not defined or corrupted'); + mess_err(opts, 'control_data', 'eqn.B is not defined or corrupted'); end if not(isfield(eqn, 'L0')) || not(isnumeric(eqn.L0)) - warning('MESS:control_data', ... - ['Initial condition factor L0 is not defined or corrupted.',... - ' Setting it to the zero vector.']); + mess_warn(opts, 'control_data', ... + ['Initial condition factor L0 is not defined or ', ... + 'corrupted. Setting it to the zero vector.']); n = oper.size(eqn, opts); - eqn.L0 = zeros(n,1); + eqn.L0 = zeros(n, 1); end if not(isfield(eqn, 'D0')) || not(isnumeric(eqn.D0)) - warning('MESS:control_data', ... - ['Initial condition factor D0 is not defined or corrupted.',... - ' Setting it to the identity matrix.']); + mess_warn(opts, 'control_data', ... + ['Initial condition factor D0 is not defined or ', ... + 'corrupted. Setting it to the identity matrix.']); eqn.D0 = eye(size(eqn.L0, 2)); end if not(result) - error('MESS:control_data','system data is not completely defined or corrupted'); -end - -if eqn.type == 'T' - q = size(eqn.C, 1); -else - q = size(eqn.B, 2); + mess_err(opts, 'control_data', ... + 'system data is not completely defined or corrupted'); end %% @@ -316,9 +342,9 @@ alpha = zeros(6, 6); alpha(1, 1) = -1; -alpha(1 : 2, 2) = [-4. / 3.; 1. / 3.]; -alpha(1 : 3, 3) = [-18. / 11.; 9. / 11.; -2. / 11.]; -alpha(1 : 4, 4) = [-48. / 25.; 36. / 25.; -16. / 25.; 3. / 25.]; +alpha(1:2, 2) = [-4. / 3.; 1. / 3.]; +alpha(1:3, 3) = [-18. / 11.; 9. / 11.; -2. / 11.]; +alpha(1:4, 4) = [-48. / 25.; 36. / 25.; -16. / 25.; 3. / 25.]; beta = [1; 2 / 3; 6 / 11; 12 / 25; 60 / 137; 60 / 147]; opts.bdf.beta = beta(opts.bdf.step); step = opts.bdf.step; @@ -339,8 +365,9 @@ times_extra(1) = times(1); % copy endtime times_extra(2) = times(1) - tau_small; % one BDF 1 step times_extra(3:end) = times(1) - ... - tau_small * 2.^(1:opts.bdf.startup_iter + 1); % BDF 2 steps - times = [times_extra, times(4 : end)]; + tau_small * 2.^(1:opts.bdf.startup_iter + 1); + % BDF 2 steps + times = [times_extra, times(4:end)]; extra_steps = length(times_extra); elseif step == 4 @@ -353,25 +380,38 @@ times_extra(2) = times(1) - tau_small; % one BDF 1 step times_extra(3) = times(1) - 2 * tau_small; % one BDF 2 step % BDF 3 steps - times_extra(4 : 2 : end) = times(1) - tau_small * ... + times_extra(4:2:end) = times(1) - tau_small * ... (2.^(1:opts.bdf.startup_iter + 1) + 2.^(0:opts.bdf.startup_iter)); - times_extra(5 : 2 : end) = times(1) - tau_small * ... + times_extra(5:2:end) = times(1) - tau_small * ... (2.^(2:opts.bdf.startup_iter + 2)); - times = [times_extra, times(1) - 3 * tau_original, times(5 : end)]; + times = [times_extra, times(1) - 3 * tau_original, times(5:end)]; extra_steps = length(times_extra) + 1; end L = eqn.L0; -D = eye(size(L, 2)); +D = eqn.D0; if eqn.type == 'T' - K0 = oper.mul_E(eqn, opts, eqn.type, (L * (L' * eqn.B)), 'N'); + if eqn.haveE + K0 = oper.mul_E(eqn, opts, eqn.type, L * (D * (L' * eqn.B)), 'N'); + else + K0 = L * (D * (L' * eqn.B)); + end else - K0 = oper.mul_E(eqn, opts, eqn.type, (L * (L' * eqn.C')), 'N'); + if eqn.haveE + K0 = oper.mul_E(eqn, opts, eqn.type, L * (D * (L' * eqn.C')), 'N'); + else + K0 = L * (D * (L' * eqn.C')); + end end L_lengths = zeros(opts.bdf.step, 1); Ds = {}; -Iq = eye(q); + +if eqn.type == 'T' + Q = eqn.Q; +else + R = eqn.R; +end if opts.bdf.save_solution out.Ls = {L}; % L of step 0 @@ -382,9 +422,6 @@ out.Ks = {K0'}; % K of step 0 -% FIXME: dead code -% end -% out.Ks = zeros(p,oper.size(eqn)); % K of step 0 if eqn.type == 'T' C = eqn.C; else @@ -394,7 +431,11 @@ ETL = []; if not(eqn.LTV) - ETL_0 = oper.mul_E(eqn, opts, eqn.type, L, 'N'); + if eqn.haveE + ETL_0 = oper.mul_E(eqn, opts, eqn.type, L, 'N'); + else + ETL_0 = L; + end end Ds_0 = D; @@ -403,7 +444,7 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Start iteration %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -for k = 2 : length(times) +for k = 2:length(times) t = times(k); %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -432,83 +473,82 @@ B = eqn.B; end end - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - % Set order and beta - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% opts.bdf.step = min(step, j - 1); % FIXME: dead code %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % update E' * L %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - if abs(tau_old - opts.bdf.tau) > (1e+4 * eps) % FIXME: add comment for magic number + if abs(tau_old - opts.bdf.tau) > (1e+4 * eps) + % FIXME: add comment for magic number % in startup phase to initialize L with correct order, tau was % doubled from last time step to this, remove intermediate step if step == 3 if eqn.LTV || opts.bdf.save_solution - out.Ls = [out.Ls(1 : end - 2), out.Ls(end)]; + out.Ls = [out.Ls(1:end - 2), out.Ls(end)]; if opts.bdf.save_solution - out.Ds = [out.Ds(1 : end - 2), out.Ds(end)]; + out.Ds = [out.Ds(1:end - 2), out.Ds(end)]; end end if not(eqn.LTV) - ETL( : , 1 : L_lengths(1)) = []; + ETL(:, 1:L_lengths(1)) = []; end L_lengths(1) = L_lengths(2); L_lengths(2) = 0; - out.Ks = [out.Ks(1 : end - 2), out.Ks(end)]; - Ds = [Ds(1 : end - 2), Ds(end)]; + out.Ks = [out.Ks(1:end - 2), out.Ks(end)]; + Ds = [Ds(1:end - 2), Ds(end)]; if isfield(out, 'res') - out.res = [out.res(1 : end - 2), out.res(end)]; + out.res = [out.res(1:end - 2), out.res(end)]; end if isfield(out, 'rc') - out.rc = [out.rc(1 : end - 2), out.rc(end)]; + out.rc = [out.rc(1:end - 2), out.rc(end)]; end elseif step == 4 if eqn.LTV || opts.bdf.save_solution - out.Ls = [out.Ls(1 : end - 4), out.Ls(end - 2), out.Ls(end)]; + out.Ls = [out.Ls(1:end - 4), ... + out.Ls(end - 2), ... + out.Ls(end)]; if opts.bdf.save_solution - out.Ds = [out.Ds(1 : end - 4), out.Ds(end - 2), out.Ds(end)]; + out.Ds = [out.Ds(1:end - 4), ... + out.Ds(end - 2), ... + out.Ds(end)]; end end if not(eqn.LTV) - ETL( : , sum(L_lengths(1:2)) + 1 : sum(L_lengths(1:3))) = []; - ETL( : , 1 : L_lengths(1)) = []; + ETL(:, sum(L_lengths(1:2)) + 1:sum(L_lengths(1:3))) = []; + ETL(:, 1:L_lengths(1)) = []; ETL = [ETL, ETL_0]; %#ok -% L_lengths(4) = size(ETL_0, 2); % FIXME: dead code end Ds = [Ds, {Ds_0}]; %#ok L_lengths = [L_lengths([2, 4]); 0; 0]; - out.Ks = [out.Ks(1 : end - 4), out.Ks(end - 2), out.Ks(end)]; - Ds = [Ds(1 : end - 4), Ds(end - 2), Ds(end)]; + out.Ks = [out.Ks(1:end - 4), out.Ks(end - 2), out.Ks(end)]; + Ds = [Ds(1:end - 4), Ds(end - 2), Ds(end)]; if isfield(out, 'res') - out.res = [out.res(1 : end - 4), out.res(end - 2), out.res(end)]; + out.res = [out.res(1:end - 4), ... + out.res(end - 2), ... + out.res(end)]; end if isfield(out, 'rc') - out.rc = [out.rc(1 : end - 4), out.rc(end - 2), out.rc(end)]; + out.rc = [out.rc(1:end - 4), ... + out.rc(end - 2), ... + out.rc(end)]; end end -% FIXME: dead code -% elseif step == 4 && opts.bdf.step == step - 1 && j > 4 ...X -% && not(eqn.LTV) -% ETL_0 = ETL( : , end - L_lengths(opts.bdf.step) + 1 : end); -% Ds_0 = Ds{end}; end - % if not(isempty(L)) % FIXME: dead code + if eqn.LTV - for s = 2 : opts.bdf.step + for s = 2:opts.bdf.step L = [L, out.Ls{s}]; %#ok end @@ -516,11 +556,19 @@ end if isempty(ETL) - ETL = oper.mul_E(eqn, opts, eqn.type, L, 'N'); + if eqn.haveE + ETL = oper.mul_E(eqn, opts, eqn.type, L, 'N'); + else + ETL = L; + end else - ETL = [oper.mul_E(eqn, opts, eqn.type, L, 'N'), ... - ETL( : , 1 : end - L_lengths(opts.bdf.step))]; - L_lengths(2 : step) = L_lengths(1 : end - 1); + if eqn.haveE + ETL = [oper.mul_E(eqn, opts, eqn.type, L, 'N'), ... + ETL(:, 1:end - L_lengths(opts.bdf.step))]; + else + ETL = [L, ETL(:, 1:end - L_lengths(opts.bdf.step))]; + end + L_lengths(2:step) = L_lengths(1:end - 1); end L_lengths(1) = size(L, 2); @@ -531,43 +579,37 @@ alphaDs = -alpha(1, opts.bdf.step) * D; - for l = 2 : opts.bdf.step + for l = 2:opts.bdf.step if size(Ds, 2) >= l - 1 - alphaDs = blkdiag(alphaDs, -alpha(l, opts.bdf.step) * Ds{l - 1}); + alphaDs = blkdiag(alphaDs, ... + -alpha(l, opts.bdf.step) * Ds{l - 1}); end end if size(Ds, 2) == opts.bdf.step - Ds = {D, Ds{1 : end - 1}}; + Ds = {D, Ds{1:end - 1}}; else Ds = [{D}, Ds]; %#ok end %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - % update C/B and S + % update and compress the right hand side of the ARE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% if eqn.type == 'T' eqn.C = [C; ETL']; + eqn.Q = blkdiag(opts.bdf.tau * opts.bdf.beta * Q, alphaDs); + [eqn.C, eqn.Q] = mess_column_compression(eqn.C, 'T', eqn.Q, ... + opts.bdf.trunc_tol, ... + opts.bdf.trunc_info); else eqn.B = [B, ETL]; - end - - eqn.S = blkdiag(opts.bdf.tau * opts.bdf.beta * Iq, alphaDs); - - %% - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - % perform column compression - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - if eqn.type == 'T' - [eqn.C, eqn.S] = mess_column_compression(eqn.C, 'T', eqn.S, ... - opts.bdf.trunc_tol, opts.bdf.trunc_info); - else - [eqn.B, eqn.S] = mess_column_compression(eqn.B, 'N', eqn.S, ... - opts.bdf.trunc_tol, opts.bdf.trunc_info); + eqn.R = blkdiag(opts.bdf.tau * opts.bdf.beta * R, alphaDs); + [eqn.B, eqn.R] = mess_column_compression(eqn.B, 'N', eqn.R, ... + opts.bdf.trunc_tol, ... + opts.bdf.trunc_info); end %% @@ -582,7 +624,8 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% [L, D] = mess_column_compression(nmout.Z, 'N', nmout.D, ... - opts.bdf.trunc_tol, opts.bdf.trunc_info); + opts.bdf.trunc_tol, ... + opts.bdf.trunc_info); %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -590,9 +633,9 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% if opts.bdf.info - fprintf('BDF step %4d s\n', t); - fprintf('\t Newton steps: %2d \n', nmout.niter); - fprintf('\t Rank %d\n', size(Ds{1},1)); + mess_fprintf(opts, 'BDF step %4d s\n', t); + mess_fprintf(opts, '\t Newton steps: %2d \n', nmout.niter); + mess_fprintf(opts, '\t Rank %d\n', size(Ds{1}, 1)); end if opts.bdf.save_solution @@ -604,11 +647,11 @@ out.Ks = [{nmout.K}, out.Ks]; - if isfield(opts.nm,'res_tol') && isnumeric(opts.nm.res_tol) + if isfield(opts.nm, 'res_tol') && isnumeric(opts.nm.res_tol) out.res = [nmout.res(end), out.res]; end - if isfield(opts.nm,'rel_diff_tol') && isnumeric(opts.nm.rel_diff_tol) + if isfield(opts.nm, 'rel_diff_tol') && isnumeric(opts.nm.rel_diff_tol) out.rc = [nmout.rc(end), out.rc]; end end diff --git a/mat-eqn-solvers/mess_care.m b/mat-eqn-solvers/mess_care.m index 4de74b7..ba2ad20 100644 --- a/mat-eqn-solvers/mess_care.m +++ b/mat-eqn-solvers/mess_care.m @@ -25,28 +25,28 @@ % [Z, ~] = mess_care(A, B, C, [], E) % % -% [Z, D, K] = mess_care(A, B, C, S) solves the Riccati matrix equation +% [Z, D, K] = mess_care(A, B, C, Q) solves the Riccati matrix equation % in ZDZ^T formulation: % -% A'*Z*D*Z' + Z*D*Z'*A - Z*D*Z'*B*B'*Z*D*Z' + C'*S*C = 0 +% A'*Z*D*Z' + Z*D*Z'*A - Z*D*Z'*B*B'*Z*D*Z' + C'*Q*C = 0 % % K is the feedback matrix K = B'*Z*D*Z' % To omit the computation of Z and D use: -% K = mess_care(A, B, C, S) +% K = mess_care(A, B, C, Q) % To get only the solution factors Z and D as output use: -% [Z, D] = mess_care(A, B, C, S) +% [Z, D] = mess_care(A, B, C, Q) % % -% [Z, D, K] = mess_care(A, B, C, S, E) solves the generalized Riccati +% [Z, D, K] = mess_care(A, B, C, Q, E) solves the generalized Riccati % equation in ZDZ^T formulation: % -% A'*Z*D*Z'*E + E'*Z*D*Z'*A - E'*Z*D*Z'*B*B'*Z*D*Z'*E + C'*S*C = 0 +% A'*Z*D*Z'*E + E'*Z*D*Z'*A - E'*Z*D*Z'*B*B'*Z*D*Z'*E + C'*Q*C = 0 % % K is the feedback matrix K = B'*Z*D*Z'*E % To omit the computation of Z and D use: -% K = mess_care(A, B, C, S, E) +% K = mess_care(A, B, C, Q, E) % To get only the solution factor Z as output use: -% [Z, D] = mess_care(A, B, C, S, E) +% [Z, D] = mess_care(A, B, C, Q, E) % % If S is empty, matrices A,B and E can be given as Z = mess_lyap(sys) % with sys = sparss(A, B , C_ ,D , E) a continuous-time first-order sparse @@ -59,14 +59,14 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% Usfs -oper = operatormanager('default'); +opts = struct; +[oper, opts] = operatormanager(opts, 'default'); %% Options ni = nargin; @@ -74,47 +74,48 @@ %% Equation type if (ni == 1) && isa(varargin{1}, 'sparss') - [eqn, oper] = mess_wrap_sparss(varargin{1}); + [eqn, opts, oper] = mess_wrap_sparss(varargin{1}, opts); eqn.type = 'T'; - if(exist('eqn.D', 'var')) - warning('MESS:ignored',... - 'D is supposed to be empty. Data is ignored.'); + if exist('eqn.D', 'var') + mess_warn(opts, 'ignored', ... + 'D is supposed to be empty. Data is ignored.'); end - S = []; + Q = []; else eqn.type = 'T'; if ni < 4 - S = []; + Q = []; else - S = varargin{4}; + Q = varargin{4}; end - if isempty(S) % Z*Z' case. + if isempty(Q) % Z*Z' case. eqn.A_ = varargin{1}; eqn.B = varargin{2}; eqn.C = varargin{3}; if ni == 3 - eqn.haveE = 0; + eqn.haveE = false; elseif ni == 5 - eqn.haveE = 1; + eqn.haveE = true; eqn.E_ = varargin{5}; else - error('MESS:notimplemented', 'Wrong number of input arguments'); + mess_err(opts, 'notimplemented', 'Wrong number of input arguments'); end else % Z*D*Z' case. - opts.LDL_T = 1; + opts.LDL_T = true; eqn.A_ = varargin{1}; eqn.B = varargin{2}; eqn.C = varargin{3}; - eqn.S = varargin{4}; + eqn.Q = varargin{4}; + eqn.R = eye(size(eqn.B, 2)); if ni == 4 - eqn.haveE = 0; + eqn.haveE = false; elseif ni == 5 - eqn.haveE = 1; + eqn.haveE = true; eqn.E_ = varargin{5}; else - error('MESS:notimplemented', 'Feature not yet implemented!'); + mess_err(opts, 'notimplemented', 'Feature not yet implemented!'); end end end @@ -143,26 +144,26 @@ case 1 % Compute only K. - opts.radi.compute_sol_fac = 0; - opts.radi.get_ZZt = 0; + opts.radi.compute_sol_fac = false; + opts.radi.get_ZZt = false; case 2 % Compute K and Z in Z*Z' format. - opts.radi.compute_sol_fac = 1; - opts.radi.get_ZZt = 1; + opts.radi.compute_sol_fac = true; + opts.radi.get_ZZt = true; otherwise % Compute K, Z and D in Z*D*Z' format. - opts.radi.compute_sol_fac = 1; - opts.radi.get_ZZt = 0; + opts.radi.compute_sol_fac = true; + opts.radi.get_ZZt = false; end %% Solve Equation out = mess_lrradi(eqn, opts, oper); if out.res(end) > opts.radi.res_tol - warning('MESS:convergence', ... - ['Convergence of solution only up to relative residual of %e!\n' ... - 'Check mess_lrnm and mess_lrradi for customizable solvers.'], ... - out.res(end)); + mess_warn(opts, 'convergence', ... + ['Convergence of solution only up to relative residual of %e!\n' ... + 'Check mess_lrnm and mess_lrradi for customizable solvers.'], ... + out.res(end)); end %% Prepare output @@ -170,10 +171,10 @@ Z = out.Z; end -if (not(isempty(S))) && (no >= 2) % Z*D*Z' case. +if (not(isempty(Q))) && (no >= 2) % Z*D*Z' case. D = out.D; if no == 3 - K = out.K; + K = out.K; end elseif no == 2 % Z*Z' case and K. D = out.K; diff --git a/mat-eqn-solvers/mess_lradi.m b/mat-eqn-solvers/mess_lradi.m index 97381fe..325a43c 100644 --- a/mat-eqn-solvers/mess_lradi.m +++ b/mat-eqn-solvers/mess_lradi.m @@ -33,11 +33,11 @@ % % eqn.C dense (m2 x n) matrix C % -% eqn.G dense (n x m1) matrix G +% eqn.W dense (n x m1) matrix W % if present it is used instead of B, or C' as RHS % (required for LDL^T formulation otherwise optional) % -% eqn.S dense (m1 x m1) matrix (N) or (m2 x m2) matrix (T) +% eqn.T dense (m1 x m1) matrix (N) or (m2 x m2) matrix (T) % expected to be symmetric % (required for LDL^T formulation) % @@ -51,17 +51,17 @@ % determining whether (N) or (T) is solved % (optional, default fallback: 'N') % -% eqn.haveE possible values: 0, 1, false, true -% if haveE = 0: matrix E is assumed to be the identity -% (optional, default: 0) +% eqn.haveE possible values: false, true +% if haveE = false: matrix E is assumed to be the identity +% (optional, default: false) % -% eqn.haveUV possible values: 0, 1, false, true -% if haveUV = 1: U = [U1, U2] and V = [V1, V2] +% eqn.haveUV possible values: false, true +% if haveUV = true: U = [U1, U2] and V = [V1, V2] % if K or DeltaK are accumulated during the iteration they % use only U2 and V2. U1 and V1 can be used for an external % rank-k update of the operator. % The size of U1 and V1 can be given via eqn.sizeUV1. -% (optional, default: 0 if no U and V are given) +% (optional, default: false if no U and V are given) % % eqn.sizeUV1 possible values: nonnegative integer % if a stabilizing feedback is given via U = [U1, U2] and @@ -81,10 +81,10 @@ % compute residual and relative change norms % (optional, default: 'fro') % -% opts.LDL_T possible values: 0, 1, false, true +% opts.LDL_T possible values: false, true % use LDL^T formulation for the RHS and % solution -% (optional, default: 0) +% (optional, default: false) % % opts.adi.maxiter possible values: integer > 0 % maximum iteration number @@ -103,33 +103,33 @@ % change is not evaluated % (optional, default: 0) % -% opts.adi.info possible values: 0, 1, false, true +% opts.adi.info possible values: 0, 1 % turn on (1) or off (0) the status output in % every iteration step % (optional, default: 0) % -% opts.adi.compute_sol_fac possible values: 0, 1, false, true +% opts.adi.compute_sol_fac possible values: false, true % turn on (1) or off (0) the computation of % the factored solution; turn off if only the % feedback matrix K is of interest -% (optional, default: 1) +% (optional, default: true) % -% opts.adi.accumulateK possible values: 0, 1, false, true +% opts.adi.accumulateK possible values: false, true % accumulate the feedback matrix K during the % iteration -% (optional, default: 0) +% (optional, default: false) % -% opts.adi.accumulateDeltaK possible values: 0, 1, false, true +% opts.adi.accumulateDeltaK possible values: false, true % accumulate the update DeltaK of the % feedback matrix K during the iteration -% (optional, default: 0) +% (optional, default: false) % % opts.shifts.p array with ADI shifts % complex shifts are possible % (optional if opts.shifts.method = % 'projection') % -% opts.shifts.info possible values: 0, 1, false, true +% opts.shifts.info possible values: 0, 1 % turn output of used shifts before the first % iteration step on (1) or off (0) % (optional, default: 0) @@ -154,21 +154,18 @@ % eqn.type = 'N' -> K = C ZZ' E % eqn.type = 'T' -> K = B' ZZ' E % -% For LDL^T formulation use opts.LDL_T = 1: -% A*L*D*L'*E' + E*L*D*L'*A' + G*S*G' = 0 -% RHS has form G * S * G' +% For LDL^T formulation use opts.LDL_T = true: +% A*L*D*L'*E' + E*L*D*L'*A' + W*T*W' = 0 +% RHS has form W * T * W' % Solution has form L * D * L' % L is stored in Z if computed (opts.adi.compute_sol_fac) -% G (eqn.G) and S (eqn.S) need to be given +% W (eqn.W) and T (eqn.T) need to be given % % Output fields in struct out: -% out.Z low rank solution factor -% -% out.S vector with diagonal elements of diagonalized -% eqn.S = U * out.S * U'; U is multiplied to the RHS +% out.Z low-rank solution factor % % out.D solution factor for LDL^T formulation -% (opts.LDL_T = 1) +% (opts.LDL_T = true) % % out.res array of relative residual norms % @@ -176,13 +173,13 @@ % % out.niter number of ADI iterations % -% out.res_fact low rank residual factor W +% out.res_fact low-rank residual factor W % % out.Riccati_res outer Riccati residual norm for Newton iteration -% (opts.nm.accumulateRes = 1) +% (opts.nm.accumulateRes = true) % % out.linesearch flag to trigger line search in Newton iteration -% (opts.adi.inexact ~= 0) +% (opts.adi.inexact nonzero) % % out.restart flag to trigger complete restart of Newton % iteration because of divergence @@ -195,22 +192,22 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check field opts.adi if not(isfield(opts, 'adi')) || not(isstruct(opts.adi)) - error('MESS:control_data', ['No adi control data found in options', ... - 'structure.']); + mess_err(opts, 'control_data', ... + 'No adi control data found in options structure.'); end %% check field opts.shifts if not(isfield(opts, 'shifts')) || not(isstruct(opts.adi)) - warning('MESS:control_data', ['No shift computation control data ', ... - 'found in options structure.']); + mess_warn(opts, 'control_data', ... + ['No shift computation control data ', ... + 'found in options structure.']); opts.shifts.info = 0; end @@ -222,8 +219,8 @@ opts.adi.info = 0; else if not(isnumeric(opts.adi.info)) && not(islogical(opts.adi.info)) - error('MESS:info', ... - 'opts.adi.info parameter must be logical or numeric.'); + mess_err(opts, 'info', ... + 'opts.adi.info parameter must be logical or numeric.'); end end @@ -231,8 +228,8 @@ opts.shifts.info = 0; else if not(isnumeric(opts.shifts.info)) && not(islogical(opts.shifts.info)) - error('MESS:info', ... - 'opts.shifts.info parameter must be logical or numeric.'); + mess_err(opts, 'info', ... + 'opts.shifts.info parameter must be logical or numeric.'); end end @@ -241,17 +238,17 @@ % Check stopping parameters %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% if not(isfield(opts.adi, 'maxiter')) || not(isnumeric(opts.adi.maxiter)) - warning('MESS:control_data', ... - ['Missing or Corrupted opts.adi.maxiter field. ', ... - 'Switching to default: 100']); + mess_warn(opts, 'control_data', ... + ['Missing or Corrupted opts.adi.maxiter field. ', ... + 'Switching to default: 100']); opts.adi.maxiter = 100; end if not(isfield(opts.adi, 'rel_diff_tol')) || ... not(isnumeric(opts.adi.rel_diff_tol)) - warning('MESS:control_data', ... - ['Missing or Corrupted opts.adi.rel_diff_tol field. ', ... - 'Switching to default: 0']); + mess_warn(opts, 'control_data', ... + ['Missing or Corrupted opts.adi.rel_diff_tol field. ', ... + 'Switching to default: 0']); opts.adi.rel_diff_tol = 0; end @@ -260,34 +257,36 @@ end if not(isfield(opts.adi, 'res_tol')) || not(isnumeric(opts.adi.res_tol)) - warning('MESS:control_data', ... - ['Missing or Corrupted opts.adi.res_tol field. ', ... - 'Switching to default: 0']); + mess_warn(opts, 'control_data', ... + ['Missing or Corrupted opts.adi.res_tol field. ', ... + 'Switching to default: 0']); opts.adi.res_tol = 0; end if not(isfield(opts, 'norm')) || ... (not(strcmp(opts.norm, 'fro')) && ... - (not(isnumeric(opts.norm)) || opts.norm ~= 2)) + (not(isnumeric(opts.norm)) || not(opts.norm == 2))) - warning('MESS:control_data', ... - ['Missing or Corrupted opts.norm field. ', ... - 'Switching to default: ''fro''']); + mess_warn(opts, 'control_data', ... + ['Missing or Corrupted opts.norm field. ', ... + 'Switching to default: ''fro''']); opts.norm = 'fro'; end -if not(isfield(opts.adi, 'inexact')), opts.adi.inexact = 0; end +if not(isfield(opts.adi, 'inexact')) + opts.adi.inexact = false; +end if opts.adi.inexact if not(opts.adi.res_tol) % res_tol is needed opts.adi.res_tol = 1e-16; - opts.adi.accumulateDeltaK = 1; + opts.adi.accumulateDeltaK = true; end if not(isfield(opts.adi, 'outer_tol')) - error('MESS:outer_tol', ... - 'For inexact ADI opts.adi.outer_tol is needed.'); + mess_err(opts, 'outer_tol', ... + 'For inexact ADI opts.adi.outer_tol is needed.'); end end @@ -297,36 +296,39 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% if not(isfield(eqn, 'type')) eqn.type = 'N'; - warning('MESS:control_data', ['Unable to determine type of ', ... - 'equation. Falling back to type ''N''']); -elseif (eqn.type ~= 'N') && (eqn.type ~= 'T') - error('MESS:equation_type', ... - 'Equation type must be either ''T'' or ''N'''); + mess_warn(opts, 'control_data', ... + ['Unable to determine type of ', ... + 'equation. Falling back to type ''N''']); +elseif not(eqn.type == 'N') && not(eqn.type == 'T') + mess_err(opts, 'equation_type', ... + 'Equation type must be either ''T'' or ''N'''); end -%set flag 0 if E does not exist +% set flag 0 if E does not exist if not(isfield(eqn, 'haveE')) - eqn.haveE = 0; - warning('MESS:control_data', ... - ['Missing or Corrupted eqn.haveE field.', ... - 'Switching to default: 0']); + eqn.haveE = false; + mess_warn(opts, 'control_data', ... + ['Missing or Corrupted eqn.haveE field.', ... + 'Switching to default: 0']); end [result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A', 'E'); if not(result) - error('MESS:control_data', ... - 'system data is not completely defined or corrupted'); + mess_err(opts, 'control_data', ... + 'system data is not completely defined or corrupted'); end if eqn.type == 'N' && ... (isfield(opts.adi, 'accumulateDeltaK') && opts.adi.accumulateDeltaK) if not(isfield(eqn, 'B')) || not(isnumeric(eqn.B)) - error('MESS:control_data', 'eqn.B is not defined or corrupted'); + mess_err(opts, 'control_data', ... + 'eqn.B is not defined or corrupted'); end if not(isfield(eqn, 'C')) || not(isnumeric(eqn.C)) - error('MESS:control_data', 'eqn.C is not defined or corrupted'); + mess_err(opts, 'control_data', ... + 'eqn.C is not defined or corrupted'); end m = size(eqn.C, 1); @@ -335,11 +337,13 @@ if eqn.type == 'T' && ... (isfield(opts.adi, 'accumulateDeltaK') && opts.adi.accumulateDeltaK) if not(isfield(eqn, 'C')) || not(isnumeric(eqn.C)) - error('MESS:control_data', 'eqn.C is not defined or corrupted'); + mess_err(opts, 'control_data', ... + 'eqn.C is not defined or corrupted'); end if not(isfield(eqn, 'B')) || not(isnumeric(eqn.B)) - error('MESS:control_data', 'eqn.B is not defined or corrupted'); + mess_err(opts, 'control_data', ... + 'eqn.B is not defined or corrupted'); end m = size(eqn.B, 2); @@ -347,81 +351,83 @@ % make sure the first right hand side is dense so that the resulting factor % is densely stored. -if isfield(eqn, 'G') && issparse(eqn.G), eqn.G = full(eqn.G); end -if isfield(eqn, 'B') && issparse(eqn.B), eqn.B = full(eqn.B); end -if isfield(eqn, 'C') && issparse(eqn.C), eqn.C = full(eqn.C); end -if isfield(eqn, 'U') && issparse(eqn.U), eqn.U = full(eqn.U); end -if isfield(eqn, 'V') && issparse(eqn.V), eqn.V = full(eqn.V); end +if isfield(eqn, 'W') && issparse(eqn.W) + eqn.W = full(eqn.W); +end +if isfield(eqn, 'B') && issparse(eqn.B) + eqn.B = full(eqn.B); +end +if isfield(eqn, 'C') && issparse(eqn.C) + eqn.C = full(eqn.C); +end +if isfield(eqn, 'U') && issparse(eqn.U) + eqn.U = full(eqn.U); +end +if isfield(eqn, 'V') && issparse(eqn.V) + eqn.V = full(eqn.V); +end % check whether LDL^T formulation should be used -if not(isfield(opts, 'LDL_T')), opts.LDL_T = 0; end +if not(isfield(opts, 'LDL_T')) + opts.LDL_T = false; +end -% check for or set proper right hand side in eqn.G +% check for or set proper right hand side in eqn.W if opts.LDL_T - % RHS has form G * S * G' - % Solution has form L * D * L' with D Kronecker product of out.D and S + % RHS has form W * TS * W' + % Solution has form L * D * L' % D is not computed explicitly % L is stored in Z if computed (opts.adi.compute_sol_fac) - % G (eqn.G) and S (eqn.S) need to be given - if not(isfield(eqn, 'G')) || not(isnumeric(eqn.G)) - error('MESS:control_data', 'eqn.G is not defined or corrupted'); + % W (eqn.W) and T (eqn.T) need to be given + if not(isfield(eqn, 'W')) || not(isnumeric(eqn.W)) + mess_err(opts, 'control_data', ... + 'eqn.W is not defined or corrupted'); end - if not(isfield(eqn, 'S')) || not(isnumeric(eqn.S)) - error('MESS:control_data', 'eqn.S is not defined or corrupted'); + if not(isfield(eqn, 'T')) || not(isnumeric(eqn.T)) + mess_err(opts, 'control_data', ... + 'eqn.T is not defined or corrupted'); end % init solution factor D out.D = zeros(opts.adi.maxiter, opts.adi.maxiter); - if isfield(eqn, 'S_diag') - diagonalized_RHS = 0; - elseif isdiag(eqn.S) %%% enq.S can be a vector from lrnm and then - % U is unknown - eqn.S_diag = diag(eqn.S); - diagonalized_RHS = 0; - else - % diagonalze S and use U to transform the initial RHS later - [eqn.U_diag, eqn.S_diag] = eig(eqn.S); - eqn.S_diag = diag(eqn.S_diag); - diagonalized_RHS = 1; - eqn.diagonalized_RHS = 1; - end else - diagonalized_RHS = 0; - if not(isfield(eqn, 'G')) + + if not(isfield(eqn, 'W')) if eqn.type == 'N' - eqn.G = eqn.B; + eqn.W = eqn.B; else - eqn.G = eqn.C'; + eqn.W = eqn.C'; end end + end %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Check for shifts and their properness %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -init_shifts = 0; +init_shifts = false; if not(isfield(opts, 'shifts')) || not(isstruct(opts.shifts)) - error('MESS:control_data', ... - 'shift parameter control structure missing.'); + mess_err(opts, 'control_data', ... + 'shift parameter control structure missing.'); end if isfield(opts.shifts, 'method') && ... strcmp(opts.shifts.method, 'projection') - opts.adi.compute_sol_fac = 1; + opts.adi.compute_sol_fac = true; opts.shifts.used_shifts = []; if not(isfield(opts.shifts, 'p')) - init_shifts = 1; + init_shifts = true; end if not(isfield(opts.shifts, 'num_desired')) if opts.LDL_T - opts.shifts.num_desired = max(5, size(eqn.G, 2)); + opts.shifts.num_desired = max(5, size(eqn.W, 2)); elseif eqn.type == 'N' opts.shifts.num_desired = max(5, size(eqn.B, 2)); else @@ -430,17 +436,19 @@ end else if not(isfield(opts.shifts, 'p')) - init_shifts = 1; + init_shifts = true; else - illegal_shifts = 0; + illegal_shifts = false; % Check if all shifts are in the open left half plane - if any(not((real(opts.shifts.p)) < 0)), illegal_shifts = 1; end + if any(not((real(opts.shifts.p)) < 0)) + illegal_shifts = true; + end % Check if complex pairs of shifts are properly ordered. k = 1; while k <= length(opts.shifts.p) - if not((isreal(opts.shifts.p(k)))) - if (opts.shifts.p(k+1) ~= conj(opts.shifts.p(k))) + if not(isreal(opts.shifts.p(k))) + if not(opts.shifts.p(k + 1) == conj(opts.shifts.p(k))) illegal_shifts = 1; end k = k + 1; @@ -448,8 +456,8 @@ k = k + 1; end if illegal_shifts - error('MESS:shifts_improper', ... - 'Improper shift vector detected!'); + mess_err(opts, 'shifts_improper', ... + 'Improper shift vector detected!'); end end end @@ -459,34 +467,38 @@ % Check for feedback and shift matrices appearing inside % Newton, BDF and Rosenbrock type methods %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if not(isfield(opts, 'rosenbrock')), opts.rosenbrock = []; end +mode = 'default'; % unless corresponding substructures for BDF +% and Rosenbrock exist, we expect to run plain +% ADI or low-rank updated ADI in Newton +if not(isfield(opts, 'rosenbrock')) + opts.rosenbrock = []; +end if isstruct(opts.rosenbrock) && isfield(opts.rosenbrock, 'tau') - rosenbrock = 1; -else - rosenbrock = 0; + mode = 'Rosenbrock'; end -if not(isfield(opts, 'bdf')), opts.bdf = []; end +if not(isfield(opts, 'bdf')) + opts.bdf = []; +end if isstruct(opts.bdf) && isfield(opts.bdf, 'tau') && isfield(opts.bdf, 'beta') - bdf = 1; -else - bdf = 0; + mode = 'BDF'; end % Check for rank-k update of the operator. if not(isfield(eqn, 'U')) || isempty(eqn.U) || ... not(isfield(eqn, 'V')) || isempty(eqn.V) - eqn.haveUV = 0; + eqn.haveUV = false; else if isnumeric(eqn.U) && isnumeric(eqn.V) && ... - size(eqn.U, 1) == size(eqn.V, 1) && size(eqn.U, 2) == size(eqn.V, 2) - eqn.haveUV = 1; + size(eqn.U, 1) == size(eqn.V, 1) && ... + size(eqn.U, 2) == size(eqn.V, 2) + eqn.haveUV = true; else - error('MESS:control_data', ... - ['Inappropriate data of low rank updated operator ', ... - '(eqn.U and eqn.V)']); + mess_err(opts, 'control_data', ... + ['Inappropriate data of low-rank updated operator ', ... + '(eqn.U and eqn.V)']); end end @@ -495,17 +507,18 @@ if not(isfield(eqn, 'sizeUV1')) || isempty(eqn.sizeUV1) eqn.sizeUV1 = size(eqn.U, 2); else - assert(isnumeric(eqn.sizeUV1) && (eqn.sizeUV1 <= size(eqn.U, 2)), ... - 'MESS:control_data', ... - ['Inappropriate size of low rank updated operator ', ... - '(eqn.U and eqn.V)']); + mess_assert(opts, isnumeric(eqn.sizeUV1) && ... + (eqn.sizeUV1 <= size(eqn.U, 2)), ... + 'control_data', ... + ['Inappropriate size of low-rank updated operator ', ... + '(eqn.U and eqn.V)']); end else eqn.sizeUV1 = 0; end % Get sizes of right hand side -k = size(eqn.G, 2); +k = size(eqn.W, 2); %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -521,7 +534,7 @@ out.Knew = zeros([size(eqn.C, 2), size(eqn.C, 1)]); end else - opts.adi.accumulateK = 0; + opts.adi.accumulateK = false; end if isfield(opts.adi, 'accumulateDeltaK') && opts.adi.accumulateDeltaK @@ -531,7 +544,7 @@ out.DeltaK = -eqn.V; elseif eqn.haveUV && (size(eqn.V, 2) > m) % eqn.V is given and K is in the second part. - out.DeltaK = -eqn.V(:, end-m+1:end); + out.DeltaK = -eqn.V(:, end - m + 1:end); else % K = [] out.DeltaK = zeros(size(eqn.B)); @@ -542,18 +555,18 @@ out.DeltaK = -eqn.U; elseif eqn.haveUV && (size(eqn.U, 2) > m) % eqn.U is given and K is in the second part. - out.DeltaK = -eqn.U(:, end-m+1:end); + out.DeltaK = -eqn.U(:, end - m + 1:end); else % K = [] out.DeltaK = zeros([size(eqn.C, 2), size(eqn.C, 1)]); end end else - opts.adi.accumulateDeltaK = 0; + opts.adi.accumulateDeltaK = false; end if not(isfield(opts.adi, 'compute_sol_fac')) - opts.adi.compute_sol_fac = 1; + opts.adi.compute_sol_fac = true; end %% @@ -567,14 +580,16 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Initialize required usf for multiplication with E %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if eqn.haveE, [eqn, opts, oper] = oper.mul_E_pre(eqn, opts, oper); end +if eqn.haveE + [eqn, opts, oper] = oper.mul_E_pre(eqn, opts, oper); +end %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Initialize data %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% if opts.adi.compute_sol_fac - Z = zeros(size(eqn.G, 1), opts.adi.maxiter*k); + Z = zeros(size(eqn.W, 1), opts.adi.maxiter * k); else Z = []; end @@ -592,16 +607,11 @@ end [eqn, opts, oper] = oper.init_res_pre(eqn, opts, oper); -% in the LDL_T case we may have diagonalized the kernel matrix of the RHS. -% If so, we need to initialize the residual with the updated G matrix -if diagonalized_RHS - [W, res0, eqn, opts, oper] = ... - oper.init_res(eqn, opts, oper, eqn.G*eqn.U_diag); +if opts.LDL_T + [W, res0, eqn, opts, oper] = oper.init_res(eqn, opts, oper, eqn.W, eqn.T); else - [W, res0, eqn, opts, oper] = ... - oper.init_res(eqn, opts, oper, eqn.G); + [W, res0, eqn, opts, oper] = oper.init_res(eqn, opts, oper, eqn.W); end - % Initialize shift vector in case of projection shifts and empty initial % shift vector if init_shifts @@ -613,12 +623,14 @@ l = length(opts.shifts.p); if opts.shifts.info - fprintf('ADI Shifts:\n'); - disp(opts.shifts.p); + mess_fprintf(opts, 'ADI Shifts:\n'); + for lp = 1:l + mess_fprintf(opts, '%10.6e\n', opts.shifts.p(lp)); + end end -out.linesearch = 0; -out.restart = 0; +out.linesearch = false; +out.restart = false; if isfield(opts, 'nm') && isfield(opts.nm, 'accumulateRes') && ... opts.nm.accumulateRes && isfield(opts.nm, 'res0') @@ -644,11 +656,15 @@ m_shift = 1; if strcmp(opts.shifts.method, 'projection') if opts.LDL_T - [opts, l] = mess_get_projection_shifts(eqn, opts, oper, ... - Z(:, 1:(m - 1)*k), W, out.D(1:m-1, 1:m-1)); + [opts, l] = ... + mess_get_projection_shifts(eqn, opts, oper, ... + Z(:, 1:(m - 1) * k), ... + W, ... + out.D(1:m - 1, 1:m - 1)); else - [opts, l] = mess_get_projection_shifts(eqn, opts, oper, ... - Z(:, 1:(m - 1)*k), W); + [opts, l] = ... + mess_get_projection_shifts(eqn, opts, oper, ... + Z(:, 1:(m - 1) * k), W); end end end @@ -658,35 +674,27 @@ pc = opts.shifts.p(m_shift); %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - % perform the actual step computations + % perform the actual step computations, i. e. shifted solve %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - if bdf - [V, eqn, opts, oper] = ... - mess_solve_shifted_system_BDF(eqn, opts, oper, pc, W); - elseif rosenbrock - [V, eqn, opts, oper] = ... - mess_solve_shifted_system_Rosenbrock(eqn, opts, oper, pc, W); - else - [V, eqn, opts, oper] = ... - mess_solve_shifted_system(eqn, opts, oper, pc, W); - end + [V, eqn, opts, oper] = ... + mess_solve_shifted_system(eqn, opts, oper, pc, W, mode); %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - % update low rank solution factor + % update low-rank solution factor %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% if isreal(pc) % just update the factor V = real(V); if opts.adi.compute_sol_fac if opts.LDL_T - Z(:, (m - 1)*k+1:m*k) = V; + Z(:, (m - 1) * k + 1:m * k) = V; out.D(m, m) = -2.0 * pc; else - Z(:, (m - 1)*k+1:m*k) = sqrt(-2.0*pc) * V; + Z(:, (m - 1) * k + 1:m * k) = sqrt(-2.0 * pc) * V; end end - % update low rank residual + % update low-rank residual if eqn.haveE EV = oper.mul_E(eqn, opts, eqn.type, V, 'N'); W = W - 2.0 * pc * EV; @@ -701,22 +709,22 @@ a = 2.0 * sqrt(-real(pc)); b = real(pc) / imag(pc); V1 = a * (real(V) + b * imag(V)); - V2 = (a * sqrt(b*b+1)) * imag(V); + V2 = (a * sqrt(b * b + 1)) * imag(V); if opts.adi.compute_sol_fac if opts.LDL_T - Z(:, (m - 1)*k+1:(m + 1)*k) = ... + Z(:, (m - 1) * k + 1:(m + 1) * k) = ... [(sqrt(2.0) / a) * V1, (sqrt(2.0) / a) * V2]; - out.D(m : m + 1, m : m + 1) = -2.0 * real(pc) * eye(2); + out.D(m:m + 1, m:m + 1) = -2.0 * real(pc) * eye(2); else - Z(:, (m - 1)*k+1:(m + 1)*k) = [V1, V2]; + Z(:, (m - 1) * k + 1:(m + 1) * k) = [V1, V2]; end end [out, eqn, opts, oper] = ... mess_accumulateK(eqn, opts, oper, out, pc, V1, V2); - % update low rank residual for double step + % update low-rank residual for double step if eqn.haveE EV = oper.mul_E(eqn, opts, eqn.type, V1, 'N'); W = W + a * EV; @@ -749,17 +757,17 @@ if opts.adi.res_tol if opts.LDL_T if opts.norm == 2 - res(m) = max(abs(eig(W'*W*diag(eqn.S_diag)))) / res0; + res(m) = max(abs(eig(W' * W * eqn.T))) / res0; elseif strcmp(opts.norm, 'fro') - res(m) = norm(eig(W'*W*diag(eqn.S_diag)), 'fro') / res0; + res(m) = norm(eig(W' * W * eqn.T), 'fro') / res0; end else - res(m) = norm(W'*W, opts.norm) / res0; + res(m) = norm(W' * W, opts.norm) / res0; end - if not(isempty(outer_res)) %riccati_LR does the LDL_T check itself. + if not(isempty(outer_res)) % riccati_LR does the LDL_T check itself. outer_res(m) = riccati_LR(W, out.DeltaK, opts, ... - diag(eqn.S_diag), []) / opts.nm.res0; + eqn.T, []) / opts.nm.res0; end end @@ -771,7 +779,7 @@ end nrmZ = nrmZ + nrmV; - rc(m) = sqrt(nrmV/nrmZ); + rc(m) = sqrt(nrmV / nrmZ); end %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -779,19 +787,24 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% if opts.adi.info if opts.adi.rel_diff_tol && opts.adi.res_tol - fprintf(1, ['ADI step: %4d normalized residual: %e ', ... - 'relative change in Z: %e\n'], m, res(m), rc(m)); + mess_fprintf(opts, ... + ['ADI step: %4d normalized residual: %e ', ... + 'relative change in Z: %e\n'], ... + m, res(m), rc(m)); elseif opts.adi.res_tol - fprintf(1, 'ADI step: %4d normalized residual: %e \n', ... - m, res(m)); + mess_fprintf(opts, ... + 'ADI step: %4d normalized residual: %e \n', ... + m, res(m)); elseif opts.adi.rel_diff_tol - fprintf(1, ['ADI step: %4d relative change ', ... - 'in Z: %e\n'], m, rc(m)); + mess_fprintf(opts, ... + ['ADI step: %4d relative change ', ... + 'in Z: %e\n'], ... + m, rc(m)); end if not(isempty(outer_res)) - fprintf(1, '\t\t normalized outer residual: %e\n', ... - outer_res(m)); + mess_fprintf(opts, '\t\t normalized outer residual: %e\n', ... + outer_res(m)); end end @@ -799,7 +812,7 @@ % Evaluate stopping criteria %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% [opts, out, stop] = prepare_next_adi_iteration(opts, out, res, ... - rc, outer_res, m); + rc, outer_res, m); if stop break @@ -813,7 +826,7 @@ % Print outer tolerance %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% if opts.adi.info && opts.adi.inexact - fprintf(1, '\n outer tolerance: %e\n', opts.adi.outer_tol); + mess_fprintf(opts, '\n outer tolerance: %e\n', opts.adi.outer_tol); end %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -822,36 +835,41 @@ out.niter = m - (m > opts.adi.maxiter); if opts.adi.compute_sol_fac - out.Z = Z(:, 1:out.niter*k); + out.Z = Z(:, 1:out.niter * k); if opts.LDL_T - out.D = kron(out.D(1:out.niter, 1:out.niter), diag(eqn.S_diag)); + out.D = kron(out.D(1:out.niter, 1:out.niter), eqn.T); end end -if opts.adi.res_tol, out.res = res(1:out.niter); end +if opts.adi.res_tol + out.res = res(1:out.niter); +end -if opts.adi.rel_diff_tol, out.rc = rc(1:out.niter); end +if opts.adi.rel_diff_tol + out.rc = rc(1:out.niter); +end out.res_fact = W; -if opts.LDL_T - out.S = eqn.S_diag; -end - if not(isempty(outer_res)) out.Riccati_res = outer_res(out.niter); end -if out.niter == opts.adi.maxiter - warning('MESS:ADI:convergence',... - ['LR-ADI reached maximum iteration number.',... - 'results may be inaccurate!']); +% warn the user if we have stopped before reaching the desired accuracy. +% note the >= as with a double step for complex shift pair we may actually +% reach maxiter+1. +if out.niter >= opts.adi.maxiter + mess_warn(opts, 'convergence', ... + ['LR-ADI reached maximum iteration number. ', ... + 'Results may be inaccurate!']); end %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Finalize required usf for multiplication with E %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if eqn.haveE, [eqn, opts, oper] = oper.mul_E_post(eqn, opts, oper); end +if eqn.haveE + [eqn, opts, oper] = oper.mul_E_post(eqn, opts, oper); +end [eqn, opts, oper] = oper.init_res_post(eqn, opts, oper); diff --git a/mat-eqn-solvers/mess_lrnm.m b/mat-eqn-solvers/mess_lrnm.m index 3aebd0c..bcc4bef 100644 --- a/mat-eqn-solvers/mess_lrnm.m +++ b/mat-eqn-solvers/mess_lrnm.m @@ -3,13 +3,25 @@ % % Solve continuous-time Riccati equations with sparse coefficients with % Newton's method (NM) -% eqn.type = 'N' -> A*Z*Z'*E' + E*Z*Z'*A' - E*Z*Z'*C'*C*Z*Z'*E' + B*B' = 0 (N) -% eqn.type = 'T' -> A'*Z*Z'*E + E'*Z*Z'*A - E'*Z*Z'*B*B'*Z*Z'*E + C'*C = 0 (T) +% +% eqn.type = 'N' +% A*X*E' + E*X*A' - E*X*C'*C*X*E' + B*B' = 0 +% or +% A*X*E' + E*X*A' - E*X*C'*Q\C*X*E' + B*R*B' = 0 +% +% eqn.type = 'T' +% A'*X*E + E'*X*A - E'*X*B*B'*X*E + C'*C = 0 +% or +% A'*X*E + E'*X*A - E'*X*B*R\B'*X*E + C'*Q*C = 0 % % % Matrix A can have the form A = à + U*V' if U (eqn.U) and V (eqn.V) are % provided U and V are dense (n x m3) matrices and should satisfy m3 << n % +% +% The solution is approximated as X = Z*Z', or if opts.LDL_T is true as +% X = L*D*L' +% % Input/Output % eqn struct contains data for equations % @@ -26,12 +38,10 @@ % % eqn.C dense (m2 x n) matrix C % -% eqn.G dense (n x m1) matrix G -% if present it is used instead of B as RHS -% (required for LDL^T formulation otherwise optional) +% eqn.R dense symmetric and invertible (m1 x m1) matrix +% (required for LDL^T formulation) % -% eqn.S dense (m1 x m1) matrix (N) or (m2 x m2) matrix (T) -% expected to be symmetric +% eqn.Q dense symmetric (m2 x m2) matrix % (required for LDL^T formulation) % % eqn.U dense (n x m3) matrix U @@ -40,21 +50,21 @@ % eqn.V dense (n x m3) matrix V % (required if eqn.U is present) % -% eqn.type possible values: 'N', 'T' +% eqn.type possible values: 'N', 'T' % determining whether (N) or (T) is solved % (optional) % -% eqn.haveE possible values: 0, 1, false, true -% if haveE = 0: matrix E in eqn.E_ is assumed to be identity +% eqn.haveE possible values: false, true +% if haveE == false: matrix E is assumed to be identity % (optional) % -% eqn.haveUV possible values: 0, 1, false, true -% if haveUV = 1: U = [U1, U2] and V = [V1, V2] +% eqn.haveUV possible values: false, true +% if haveUV = true: U = [U1, U2] and V = [V1, V2] % if K or DeltaK are accumulated during the iteration they % use only U2 and V2. U1 and V1 can be used for an external % rank-k update of the operator. % The size of U1 and V1 can be given via eqn.sizeUV1. -% (optional, default: 0) +% (optional, default: false) % % eqn.sizeUV1 possible values: nonnegative integer % if a stabilizing feedback is given via U = [U1, U2] and @@ -64,17 +74,17 @@ % % Depending on the operator chosen by the operatormanager, additional % fields may be needed. For the "default", e.g., eqn.A_ and eqn.E_ hold -% the A and E matrices. For the second order types these are given +% the A and E matrices. For the second order ode types these are given % implicitly by the M, D, K matrices stored in eqn.M_, eqn.E_ and eqn.K_, % respectively. % % Input fields in struct opts: -% opts.LDL_T possible values: 0, 1, false, true +% opts.LDL_T possible values: false, true % use LDL^T formulation for the RHS and % solution -% (optional, default: 0) +% (optional, default: false) % -% opts.norm possible values: 2, 'fro' +% opts.norm possible values: 2, 'fro' % use 2-norm (2) or Frobenius norm ('fro') to % compute residual and relative change norms % in case projection is used @@ -91,13 +101,13 @@ % maximum NM iteration number % (optional, default: 20) % -% opts.nm.res_tol possible values: scalar >= 0 +% opts.nm.res_tol possible values: scalar >= 0 % stopping tolerance for the relative NM % residual norm; if res_tol = 0 the relative % residual norm is not evaluated % (optional, default: 0) % -% opts.nm.rel_diff_tol possible values: scalar >= 0 +% opts.nm.rel_diff_tol possible values: scalar >= 0 % stopping tolerance for the relative % change of the NM solution Z; % if res_tol = 0 the relative @@ -109,27 +119,27 @@ % low-rank solutions (aka column compression) % (optional, default: eps*n) % -% opts.nm.trunc_info possible values: 0, 1, false, true +% opts.nm.trunc_info possible values: 0, 1 % verbose mode for column compression % (optional, default: 0) % -% opts.nm.info possible values: 0, 1, false, true +% opts.nm.info possible values: 0, 1 % turn on (1) or off (0) the status output in % every NM iteration step % (optional, default: 0) % -% opts.nm.accumulateRes possible values: 0, 1, false, true +% opts.nm.accumulateRes possible values: false, true % accumulate the relative NM residual norm % during the inner ADI iteration -% (optional, default: 0) +% (optional, default: false) % -% opts.nm.linesearch possible values: 0, 1, false, true -% if tuned of (0) NM makes full steps; if -% turned on (1) a step size 0<=lambda<=2 is +% opts.nm.linesearch possible values: false, true +% if turned of (false) NM makes full steps; if +% turned on (true) a step size 0<=lambda<=2 is % computed -% (optional, default: 0) +% (optional, default: false) % -% opts.nm.inexact possible values: 0, false, 'linear', +% opts.nm.inexact possible values: false, 'linear', % 'superlinear', 'quadratic' % the inner ADI uses an adaptive relative ADI % residual norm; with @@ -139,19 +149,19 @@ % 'linear': tau * ||R||, % 'superlinear': ||R|| / (j^3 + 1), % 'quadratic': tau / sqrt(||R||) -% (optional, default: 0) +% (optional, default: false) % -% opts.nm.store_solfac possible values: 0, 1, false, true -% if turned on (1) the solution factors +% opts.nm.store_solfac possible values: false, true +% if turned on (true) the solution factors % computed by the adi are stored in the % out.adi structure -% (optional, default 0) +% (optional, default false) % -% opts.nm.store_debug possible values: 0, 1, false, true -% if turned on (1) the residual factors and +% opts.nm.store_debug possible values: false, true +% if turned on (true) the residual factors and % feedback updates from the adi are stored % in the out.adi structure -% (optional, default 0) +% (optional, default false) % % opts.nm.tau possible values: scalar >= 0 % factor for inexact inner ADI iteration @@ -159,7 +169,7 @@ % (optional, default: 1) % % opts.nm.projection.freq possible values: integer >= 0 -% frequency of the usage of galerkin +% frequency of the usage of Galerkin % projection acceleration in NM % (optional, default: 0) % @@ -188,26 +198,29 @@ % and a 'MESS:control_data' warning is printed. to turn theses warnings off % use: warning('OFF', 'MESS:control_data') % -% For LDL^T formulation use opts.LDL_T = 1: -% RHS of Lyapunov Eq. has form G * S * G' +% For LDL^T formulation use opts.LDL_T = true: +% RHS of Lyapunov Eq. has form W * T * W' % Solution Lyapunov Eq. has form L * D * L' -% with D Kronecker product of adiout.D and S % L is stored in Z if computed (opts.adi.compute_sol_fac) -% S (eqn.S) needs to be given +% T (eqn.T in the ADI for the per Newton step Lyapunov equations) is built +% from Q and R. % % Output fields in struct out: -% out.Z low rank solution factor +% out.Z low-rank solution factor % % out.adi struct with the output of the all ADI iterations % % out.niter number of NM iterations % -% out.K feedback matrix -% (T): K = B' ZZ' E +% out.K feedback matrix +% (T): K = B' ZZ' E % (N): K = C ZZ' E +% or +% (T): K = R \ B' ZDZ' E +% (N): K = Q \ C ZDZ' E % % out.D solution factor for LDL^T formulation -% (opts.LDL_T = 1) +% (opts.LDL_T = true) % % out.res array of relative NM residual norms % @@ -229,168 +242,182 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Check for ADI Control structure in options %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if not(isfield(opts,'adi')) || not(isstruct(opts.adi)) - error('MESS:control_data','ADI control structure opts.ADI missing.'); +if not(isfield(opts, 'adi')) || not(isstruct(opts.adi)) + mess_err(opts, 'control_data', ... + 'ADI control structure opts.ADI missing.'); end % Single fields are checked below or inside mess_lradi -if not(isfield(opts.adi,'compute_sol_fac')), opts.adi.compute_sol_fac = 1; end -if not(isfield(opts.adi,'accumulateK')), opts.adi.accumulateK = 0; end -if not(isfield(opts.adi,'accumulateDeltaK')), opts.adi.accumulateDeltaK = 0; end +if not(isfield(opts.adi, 'compute_sol_fac')) + opts.adi.compute_sol_fac = true; +end +if not(isfield(opts.adi, 'accumulateK')) + opts.adi.accumulateK = false; +end +if not(isfield(opts.adi, 'accumulateDeltaK')) + opts.adi.accumulateDeltaK = false; +end + +if not(opts.adi.compute_sol_fac || opts.adi.accumulateK || ... + opts.adi.accumulateDeltaK) + mess_warn(opts, 'control_data', ... + ['Either opts.adi.accumulateK or opts.adi.compute_sol_fac or ', ... + 'opts.adi.accumulateDeltaK must be true. Switching to default', ... + 'opts.adi.accumulateDeltaK = true']); + opts.adi.accumulateDeltaK = true; +end + +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Initialize usfs +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if not(isfield(eqn, 'haveE')) + eqn.haveE = false; +end + +[result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A', 'E'); -if not(opts.adi.compute_sol_fac || opts.adi.accumulateK || opts.adi.accumulateDeltaK) - warning('MESS:control_data', ... - ['Either opts.adi.accumulateK or opts.adi.compute_sol_fac or ', ... - 'opts.adi.accumulateDeltaK must be 1. Switching to default', ... - 'opts.adi.accumulateDeltaK = 1']); - opts.adi.accumulateDeltaK = 1; +if not(result) + mess_err(opts, 'control_data', ... + 'system data is not completely defined or corrupted'); end +[eqn, opts, oper] = oper.mul_E_pre(eqn, opts, oper); + +[eqn, opts, oper] = oper.init_res_pre(eqn, opts, oper); + %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Check for shift parameter structure %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if not(isfield(opts,'shifts')) || not(isstruct(opts.shifts)) - warning('MESS:control_data',... - ['shift parameter control structure missing.', ... - 'Switching to default num_desired = 25, num_Ritz = 50, ' ... - 'num_hRitz = 25.']); +if not(isfield(opts, 'shifts')) || not(isstruct(opts.shifts)) + mess_warn(opts, 'control_data', ... + ['shift parameter control structure missing.', ... + 'Switching to default num_desired = 25, num_Ritz = 50, ' ... + 'num_hRitz = 25.']); opts.shifts.num_desired = 25; opts.shifts.num_Ritz = 50; opts.shifts.num_hRitz = 25; - opts.shifts.method='heur'; - opts.shifts.period=1; + opts.shifts.method = 'heur'; + opts.shifts.period = 1; else - if not(isfield(opts.shifts,'num_desired')) ||... + if not(isfield(opts.shifts, 'num_desired')) || ... not(isnumeric(opts.shifts.num_desired)) - warning('MESS:control_data', ... - ['Missing or Corrupted opts.shifts.num_desired field.', ... - 'Switching to default: 25']); + mess_warn(opts, 'control_data', ... + ['Missing or Corrupted opts.shifts.num_desired field.', ... + 'Switching to default: 25']); opts.shifts.num_desired = 25; end - if not(isfield(opts.shifts,'method')) + if not(isfield(opts.shifts, 'method')) opts.shifts.method = 'heur'; end - if (strcmp(opts.shifts.method,'heur') || ... - strcmp(opts.shifts.method,'wachspress')) && ... - (not(isfield(opts.shifts,'num_Ritz')) || ... + if (strcmp(opts.shifts.method, 'heur') || ... + strcmp(opts.shifts.method, 'wachspress')) && ... + (not(isfield(opts.shifts, 'num_Ritz')) || ... not(isnumeric(opts.shifts.num_Ritz))) - warning('MESS:control_data', ... - ['Missing or Corrupted opts.shifts.num_Ritz field.', ... - 'Switching to default: 50']); + mess_warn(opts, 'control_data', ... + ['Missing or Corrupted opts.shifts.num_Ritz field.', ... + 'Switching to default: 50']); opts.shifts.num_Ritz = 50; end - if (strcmp(opts.shifts.method,'heur') || ... - strcmp(opts.shifts.method,'wachspress')) && ... - (not(isfield(opts.shifts,'num_hRitz')) || ... + if (strcmp(opts.shifts.method, 'heur') || ... + strcmp(opts.shifts.method, 'wachspress')) && ... + (not(isfield(opts.shifts, 'num_hRitz')) || ... not(isnumeric(opts.shifts.num_hRitz))) - warning('MESS:control_data',... - ['Missing or Corrupted opts.shifts.num_hRitz field.', ... - 'Switching to default: 25']); + mess_warn(opts, 'control_data', ... + ['Missing or Corrupted opts.shifts.num_hRitz field.', ... + 'Switching to default: 25']); opts.shifts.num_hRitz = 25; end - if not(isfield(opts.shifts,'period')) + if not(isfield(opts.shifts, 'period')) opts.shifts.period = 1; end - if not(isfield(opts.shifts,'wachspress')) + if not(isfield(opts.shifts, 'wachspress')) opts.shifts.wachspress = 'T'; end end -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Check for projection triggers and residual control parameters -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -project = isfield(opts.nm,'projection') && ... - isfield(opts.nm.projection,'freq') && ... - isnumeric(opts.nm.projection.freq) && ... - opts.nm.projection.freq; - -if project - opts.adi.compute_sol_fac = 1; - opts.norm = 2; -end - -% we need to use iterative residual computation. Let's add the -% corresponding control structure in case it does not already exist. -if project && not(isfield(opts.nm,'res')) - warning('MESS:control_data', ... - 'Found empty residual control parameters. Falling back to defaults.'); - opts.nm.res = []; -end - %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Check for Newton control structure in options %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if not(isfield(opts,'nm')) || not(isstruct(opts.nm)) - error('MESS:control_data','Newton control structure opts.nm missing.'); +if not(isfield(opts, 'nm')) || not(isstruct(opts.nm)) + mess_err(opts, 'control_data', ... + 'Newton control structure opts.nm missing.'); else - if not(isfield(opts.nm,'maxiter')) || not(isnumeric(opts.nm.maxiter)) - warning('MESS:control_data', ... - 'Missing or corrupted ''maxiter'' field. Switching to default.'); + if not(isfield(opts.nm, 'maxiter')) || not(isnumeric(opts.nm.maxiter)) + mess_warn(opts, 'control_data', ... + ['Missing or corrupted ''maxiter'' field. ', ... + 'Switching to default.']); opts.nm.maxiter = 20; end - if not(isfield(opts.nm,'rel_diff_tol')) || not(isnumeric(opts.nm.rel_diff_tol)) - warning('MESS:control_data', ... - 'Missing or corrupted ''rel_diff_tol'' field. Switching to default.'); + if not(isfield(opts.nm, 'rel_diff_tol')) || ... + not(isnumeric(opts.nm.rel_diff_tol)) + mess_warn(opts, 'control_data', ... + ['Missing or corrupted ''rel_diff_tol'' field. ', ... + 'Switching to default.']); opts.nm.rel_diff_tol = 0; end - if not(isfield(opts.nm,'res_tol')) || not(isnumeric(opts.nm.res_tol)) - warning('MESS:control_data', ... - 'Missing or corrupted ''res_tol'' field. Switching to default.'); - opts.nm.res_tol = 0; + if not(isfield(opts.nm, 'res_tol')) || not(isnumeric(opts.nm.res_tol)) + mess_warn(opts, 'control_data', ... + ['Missing or corrupted ''res_tol'' field. ', ... + 'Switching to default.']); + opts.nm.res_tol = false; end - if not(isfield(opts.nm,'accumulateRes')) || not(isnumeric(opts.nm.accumulateRes)) - warning('MESS:control_data', ... - 'Missing or corrupted ''accumulateRes'' field. Switching to default.'); - opts.nm.accumulateRes = 0; + if not(isfield(opts.nm, 'accumulateRes')) || ... + not(islogical(opts.nm.accumulateRes)) + mess_warn(opts, 'control_data', ... + ['Missing or corrupted ''accumulateRes'' field. ', ... + 'Switching to default.']); + opts.nm.accumulateRes = false; end if opts.nm.accumulateRes % need DeltaK - opts.adi.accumulateDeltaK = 1; + opts.adi.accumulateDeltaK = true; end - if not(isfield(opts.nm, 'linesearch')) || not(isnumeric(opts.nm.linesearch)) - warning('MESS:control_data', ... - 'Missing or corrupted ''linesearch'' field. Switching to default.'); - opts.nm.linesearch = 0; + if not(isfield(opts.nm, 'linesearch')) || ... + not(islogical(opts.nm.linesearch)) + mess_warn(opts, 'control_data', ... + ['Missing or corrupted ''linesearch'' field. ', ... + 'Switching to default.']); + opts.nm.linesearch = false; end - if not(isfield(opts.nm, 'store_solfac')) || not(isnumeric(opts.nm.store_solfac)) - opts.nm.store_solfac = 0; + if not(isfield(opts.nm, 'store_solfac')) || ... + not(islogical(opts.nm.store_solfac)) + opts.nm.store_solfac = false; end if not(isfield(opts.nm, 'store_debug')) || ... - not(isnumeric(opts.nm.store_debug)) - opts.nm.store_debug = 0; + not(islogical(opts.nm.store_debug)) + opts.nm.store_debug = false; end if opts.nm.linesearch % need DeltaK - opts.adi.accumulateDeltaK = 1; + opts.adi.accumulateDeltaK = true; % need res_tol if not(opts.nm.res_tol) opts.nm.res_tol = 1e-16; @@ -398,202 +425,257 @@ alpha = 1e-4; end - if not(isfield(opts.nm,'inexact')), opts.nm.inexact = false; end + if not(isfield(opts.nm, 'inexact')) + opts.nm.inexact = false; + end if opts.nm.inexact - if not(isfield(opts.nm,'tau')), opts.nm.tau = 1; end - if not(isfield(opts.adi,'res_tol')), opts.adi.res_tol = 1e-16; end - opts.nm.accumulateRes = 1; + if not(isfield(opts.nm, 'tau')) + opts.nm.tau = 1; + end + if not(isfield(opts.adi, 'res_tol')) + opts.adi.res_tol = 1e-16; + end + opts.nm.accumulateRes = true; opts.adi.inexact = true; - opts.adi.accumulateDeltaK = 1; + opts.adi.accumulateDeltaK = true; else opts.adi.inexact = false; end if not(isfield(opts, 'norm')) || ... (not(strcmp(opts.norm, 'fro')) && ... - (not(isnumeric(opts.norm)) || opts.norm ~= 2)) + (not(isnumeric(opts.norm)) || not(opts.norm == 2))) - warning('MESS:control_data', ... - 'Missing or Corrupted norm field. Switching to default.'); + mess_warn(opts, 'control_data', ... + ['Missing or Corrupted norm field. ', ... + 'Switching to default.']); opts.norm = 'fro'; end - if not(isfield(opts.nm,'info')) || not(isnumeric(opts.nm.res_tol)) - warning('MESS:control_data',... - 'Missing or Corrupted info field. Switching to default.'); + if not(isfield(opts.nm, 'info')) || not(isnumeric(opts.nm.res_tol)) + mess_warn(opts, 'control_data', ... + ['Missing or Corrupted info field. ', ... + 'Switching to default.']); opts.nm.info = 0; end end -if not(isfield(opts.nm,'trunc_tol')) +if not(isfield(opts.nm, 'trunc_tol')) opts.nm.trunc_tol = eps * oper.size(eqn, opts); end -if not(isfield(opts.nm, 'trunc_info')), opts.nm.trunc_info = 0; end - +if not(isfield(opts.nm, 'trunc_info')) + opts.nm.trunc_info = 0; +end %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Initialize usfs +% Check for projection triggers and residual control parameters %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if not(isfield(eqn, 'haveE')), eqn.haveE = 0; end - -[result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A','E'); +project = isfield(opts.nm, 'projection') && ... + isfield(opts.nm.projection, 'freq') && ... + isnumeric(opts.nm.projection.freq) && ... + opts.nm.projection.freq; -if not(result) - error('MESS:control_data', ... - 'system data is not completely defined or corrupted'); +if project + opts.adi.compute_sol_fac = true; + opts.norm = 2; end -[eqn,opts,oper] = oper.mul_E_pre(eqn,opts,oper); - -[eqn, opts, oper] = oper.init_res_pre(eqn, opts, oper); +% we need to use iterative residual computation. Let's add the +% corresponding control structure in case it does not already exist. +if project && not(isfield(opts.nm, 'res')) + mess_warn(opts, 'control_data', ... + ['Found empty residual control parameters. ', ... + 'Falling back to defaults.']); + opts.nm.res = []; +end +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Check system data %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% if not(isfield(eqn, 'B')) || not(isnumeric(eqn.B)) - error('MESS:control_data', 'eqn.B is not defined or corrupted'); + mess_err(opts, 'control_data', 'eqn.B is not defined or corrupted'); end if not(isfield(eqn, 'C')) || not(isnumeric(eqn.C)) - error('MESS:control_data', 'eqn.C is not defined or corrupted'); + mess_err(opts, 'control_data', 'eqn.C is not defined or corrupted'); end % make sure the first right hand side is dense so that the resulting factor % is densely stored. -if issparse(eqn.C), eqn.C = full(eqn.C); end -if issparse(eqn.B), eqn.B = full(eqn.B); end +if issparse(eqn.C) + eqn.C = full(eqn.C); +end +if issparse(eqn.B) + eqn.B = full(eqn.B); +end if not(isfield(eqn, 'type')) eqn.type = 'N'; - warning('MESS:control_data',['Unable to determine type of equation.'... - 'Falling back to type ''N''']); -elseif (eqn.type ~= 'N') && (eqn.type ~= 'T') - error('MESS:equation_type', 'Equation type must be either ''T'' or ''N'''); + mess_warn(opts, 'control_data', ... + ['Unable to determine type of equation. '... + 'Falling back to type ''N''']); +elseif not(eqn.type == 'N') && not(eqn.type == 'T') + mess_err(opts, 'equation_type', ... + 'Equation type must be either ''T'' or ''N'''); end if eqn.type == 'T' - p = size(eqn.C,1); % number of outputs - m = size(eqn.B,2); % number of inputs + p = size(eqn.C, 1); % number of outputs + m = size(eqn.B, 2); % number of inputs else - m = size(eqn.C,1); % number of outputs - p = size(eqn.B,2); % number of inputs + m = size(eqn.C, 1); % number of outputs + p = size(eqn.B, 2); % number of inputs end % check whether LDL^T formulation should be used -if not(isfield(opts, 'LDL_T')), opts.LDL_T = 0; end +if not(isfield(opts, 'LDL_T')) + opts.LDL_T = false; +end % check for or set proper right hand side if opts.LDL_T - % RHS of Lyapunov Eq. has form G * S * G' + % RHS of inner Lyapunov Eq. has form G * S * G' % Solution Lyapunov Eq. has form L * D * L' % with D Kronecker product of adiout.D and S % D is not computed explicitly % L is stored in Z if computed (opts.adi.compute_sol_fac) - % S (eqn.S) need to be given - if not(isfield(eqn, 'S')) || not(isnumeric(eqn.S)) - error('MESS:control_data', 'eqn.S is not defined or corrupted'); - end - - if isdiag(eqn.S) - out.S = eqn.S; - eqn.S_diag = diag(eqn.S); - eqn.diagonalized_RHS = 0; - else - % diagonalze S and use U to transform the initial RHS later - [eqn.U_diag, eqn.S_diag] = eig(eqn.S); - eqn.S_diag = diag(eqn.S_diag); - eqn.diagonalized_RHS = 1; + % S (eqn.Q or inv(eqn.R)) need to be given + if not(isfield(eqn, 'Q')) || not(isnumeric(eqn.Q)) || ... + not(isfield(eqn, 'R')) || not(isnumeric(eqn.R)) + mess_err(opts, 'control_data', ... + 'eqn.Q or eqn.R is not defined or corrupted'); end if isfield(opts, 'bdf') && isstruct(opts.bdf) if not(isfield(opts.bdf, 'tau')) || not(isnumeric(opts.bdf.tau)) - error('MESS:control_data', 'opts.bdf.tau is not defined or corrupted'); + mess_err(opts, 'control_data', ... + 'opts.bdf.tau is not defined or corrupted'); end if not(isfield(opts.bdf, 'beta')) || not(isnumeric(opts.bdf.beta)) - error('MESS:control_data', 'opts.bdf.beta is not defined or corrupted'); + mess_err(opts, 'control_data', ... + 'opts.bdf.beta is not defined or corrupted'); end tau_beta = opts.bdf.tau * opts.bdf.beta; - bdf = 1; + bdf = true; else - bdf = 0; + bdf = false; tau_beta = 1; end else - bdf = 0; - eqn.diagonalized_RHS = 0; + bdf = false; + if not(isfield(eqn, 'Q')) || not(isnumeric(eqn.Q)) + eqn.Q = eye(size(eqn.C, 1)); + end + if not(isfield(eqn, 'R')) || not(isnumeric(eqn.R)) + eqn.R = eye(size(eqn.B, 2)); + end end +%% +% in order not to overwrite important equation data we send a copy to +% the inner iteration with the proper augmentation +adi_eqn = eqn; %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Rank-k update system data. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if not(isfield(eqn, 'haveUV')) || isempty(eqn.haveUV) || not(eqn.haveUV) - eqn.haveUV = 0; +% subroutines we call rely on haveUV being set, so we add it to both +if not(isfield(eqn, 'haveUV')) || isempty(eqn.haveUV) || ... + not(eqn.haveUV) + eqn.haveUV = false; eqn.sizeUV1 = 0; eqn.U = []; eqn.V = []; +end + +if not(isfield(adi_eqn, 'haveUV')) || isempty(adi_eqn.haveUV) || ... + not(adi_eqn.haveUV) + adi_eqn.haveUV = false; + adi_eqn.sizeUV1 = 0; + adi_eqn.U = []; + adi_eqn.V = []; else if opts.LDL_T - error('MESS:control_data', ... - ['LDL_T formulation is not compatible with ' ... - 'external eqn.haveUV option.']); + mess_err(opts, 'control_data', ... + ['LDL_T formulation is not compatible with ' ... + 'external eqn.haveUV option.']); end - if isnumeric(eqn.U) && isnumeric(eqn.V) && ... - (size(eqn.U, 1) == size(eqn.V, 1)) && (size(eqn.U, 2) == size(eqn.V, 2)) + if isnumeric(adi_eqn.U) && isnumeric(adi_eqn.V) && ... + (size(adi_eqn.U, 1) == size(adi_eqn.V, 1)) && ... + (size(adi_eqn.U, 2) == size(adi_eqn.V, 2)) - if issparse(eqn.V), eqn.V = full(eqn.V); end - if issparse(eqn.U), eqn.U = full(eqn.U); end + if issparse(adi_eqn.V) + adi_eqn.V = full(adi_eqn.V); + end + if issparse(adi_eqn.U) + adi_eqn.U = full(adi_eqn.U); + end else - error('MESS:control_data', ... - 'Inappropriate data of low rank updated operator (eqn.U and eqn.V)'); + mess_err(opts, 'control_data', ... + ['Inappropriate data of low-rank updated operator', ... + '(eqn.U and eqn.V)']); end end % Check for size of constant term in U and V. -if eqn.haveUV - if not(isfield(eqn, 'sizeUV1')) || isempty(eqn.sizeUV1) - eqn.sizeUV1 = size(eqn.U, 2); +if adi_eqn.haveUV + if not(isfield(adi_eqn, 'sizeUV1')) || isempty(adi_eqn.sizeUV1) + adi_eqn.sizeUV1 = size(adi_eqn.U, 2); else - assert(isnumeric(eqn.sizeUV1) && (eqn.sizeUV1 <= size(eqn.U, 2)), ... - 'MESS:control_data', ... - 'Inappropriate size of low rank updated operator (eqn.U and eqn.V)'); + mess_assert(opts, isnumeric(adi_eqn.sizeUV1) && ... + (adi_eqn.sizeUV1 <= size(adi_eqn.U, 2)), ... + 'control_data', ... + ['Inappropriate size of low-rank updated operator ', ... + '(eqn.U and eqn.V)']); end end +% The actual operations in the Lyapunov solver have two low-rank updates: +% +% * the one coming in from A = F + U * V' here +% * the one introduced by the Kleinman step using B (or C) and the +% feedback matrix +% +% We put both into extended U and V in the inner Lyapunov solver and for easier +% reading we introduce index vectors for those +UV_cols = 1:adi_eqn.sizeUV1; +feedb_cols = adi_eqn.sizeUV1 + 1:adi_eqn.sizeUV1 + m; + % Initialize storage for the computed feedback. if eqn.type == 'T' - eqn.U = [eqn.U(:, 1:eqn.sizeUV1), -eqn.B]; - eqn.V = [eqn.V(:, 1:eqn.sizeUV1), zeros(size(eqn.B))]; + adi_eqn.U = [adi_eqn.U(:, UV_cols), -eqn.B]; + adi_eqn.V = [adi_eqn.V(:, UV_cols), zeros(size(eqn.B))]; else - eqn.U = [eqn.U(:, 1:eqn.sizeUV1), zeros(size(eqn.C,2), size(eqn.C,1))]; - eqn.V = [eqn.V(:, 1:eqn.sizeUV1), -eqn.C']; + adi_eqn.U = [adi_eqn.U(:, UV_cols), zeros(size(eqn.C'))]; + adi_eqn.V = [adi_eqn.V(:, UV_cols), -eqn.C']; end -eqn.haveUV = 1; +adi_eqn.haveUV = true; %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Check if we have an initial stabilizing feedback. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if isfield(opts.nm,'K0') +if isfield(opts.nm, 'K0') if eqn.type == 'T' - eqn.V(:, eqn.sizeUV1+1:eqn.sizeUV1+m) = opts.nm.K0'; + adi_eqn.V(:, feedb_cols) = opts.nm.K0'; else - eqn.U(:, eqn.sizeUV1+1:eqn.sizeUV1+m) = opts.nm.K0'; + adi_eqn.U(:, feedb_cols) = opts.nm.K0'; end end if bdf if eqn.type == 'T' - eqn.U = (-opts.bdf.tau * opts.bdf.beta) * eqn.B; + adi_eqn.U = -tau_beta * eqn.B; else - eqn.V = (-opts.bdf.tau * opts.bdf.beta) * eqn.C'; + adi_eqn.V = -tau_beta * eqn.C'; end end @@ -608,55 +690,63 @@ % if changes are made here these have to be repeated at the restart part % from line search further below!!! if opts.nm.res_tol - res = zeros(opts.nm.maxiter,1); + res = zeros(opts.nm.maxiter, 1); else res = []; end if opts.nm.rel_diff_tol - rc = zeros(opts.nm.maxiter,1); + rc = zeros(opts.nm.maxiter, 1); else rc = []; end - -% in the LDL_T case we may have diagonalized the kernel matrix of the RHS. -% If so, we need to initialize the residual with the updated G matrix if eqn.type == 'T' - if eqn.diagonalized_RHS - eqn.G = eqn.C' * eqn.U_diag; - else - eqn.G = eqn.C'; + + adi_eqn.W = eqn.C'; + if opts.LDL_T + adi_eqn.T = adi_eqn.Q; end + else - if eqn.diagonalized_RHS - eqn.G = eqn.B * eqn.U_diag; - else - eqn.G = eqn.B; + + adi_eqn.W = eqn.B; + if opts.LDL_T + adi_eqn.T = adi_eqn.R; end + end -eqn.G = oper.init_res(eqn, opts, oper, eqn.G); +% init_res for projection of data. Actual residual computations follows below. +adi_eqn.W = oper.init_res(adi_eqn, opts, oper, adi_eqn.W); if opts.LDL_T - res0 = riccati_LR(eqn.G, [], opts, diag(eqn.S_diag), []); - S = eqn.S_diag; + + res0 = riccati_LR(adi_eqn.W, [], opts, adi_eqn.T, []); + if eqn.type == 'T' - eqn.S_diag = [eqn.S_diag; tau_beta * ones(size(eqn.V, 2), 1)]; + + adi_eqn.T = blkdiag(eqn.Q, tau_beta * eqn.R); + else - eqn.S_diag = [eqn.S_diag; tau_beta * ones(size(eqn.U, 2), 1)]; + + adi_eqn.T = blkdiag(eqn.R, tau_beta * eqn.Q); + end + else - res0 = norm(eqn.G'*eqn.G, opts.norm); - eqn.S_diag = []; + + res0 = norm(adi_eqn.W' * adi_eqn.W, opts.norm); + adi_eqn.T = []; + end opts.nm.res0 = res0; if eqn.type == 'T' - eqn.G = [eqn.G, eqn.V(:, eqn.sizeUV1+1:end)]; + adi_eqn.W = [adi_eqn.W, adi_eqn.V(:, feedb_cols)]; else - eqn.G = [eqn.G, eqn.U(:, eqn.sizeUV1+1:end)]; + adi_eqn.W = [adi_eqn.W, adi_eqn.U(:, feedb_cols)]; end if opts.adi.inexact @@ -676,32 +766,26 @@ end otherwise - error('MESS:inexact', ... - ['inexact must be 0, ''linear'', ''superlinear''', ... - ' or ''quadratic''']); + mess_err(opts, 'inexact', ... + ['inexact must be false, ''linear'', ''superlinear''', ... + ' or ''quadratic''']); end opts.adi.outer_tol = max(opts.adi.outer_tol, opts.adi.res_tol); end if opts.nm.linesearch - linesearch = 0; - W_old = eqn.G; -% if not(isfield(eqn,'K0')) % FIXME: dead code - DeltaK_old = []; -% else -% % DeltaK_old = -eqn.V( : , s + 1 : end); -% % careful with haveUV option! -% DeltaK_old = []; -% end + linesearch = false; + W_old = adi_eqn.W; + DeltaK_old = []; if opts.LDL_T - S_old = eqn.S_diag; + S_old = adi_eqn.T; end end -restarted = 0; +restarted = false; -already_restarted = 0; +already_restarted = false; % if changes are made here these have to be repeated at the restart part % from line search further below!!! @@ -713,52 +797,66 @@ while k <= opts.nm.maxiter - projected = 0; + projected = false; %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - % compute new ADI shifts + % compute new ADI shifts every "period" steps %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - if not(mod(k - 1,opts.shifts.period)) - opts.shifts.p = mess_para(eqn,opts,oper); + if not(mod(k - 1, opts.shifts.period)) + opts.shifts.p = mess_para(adi_eqn, opts, oper); end %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % perform the actual step computations %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - % form right hand side factor + % form right hand side factor appending the current feedback + % approximant to the factor of the constant term + % first p columns of G are always the same and were initialized above if eqn.type == 'T' - eqn.G(:, p+1:p+m) = eqn.V(:, end-m+1:end); + adi_eqn.W(:, p + 1:p + m) = adi_eqn.V(:, feedb_cols); else - eqn.G(:, p+1:p+m) = eqn.U(:, end-m+1:end); + adi_eqn.W(:, p + 1:p + m) = adi_eqn.U(:, feedb_cols); end if opts.LDL_T if eqn.type == 'T' - eqn.S_diag = [S; tau_beta * ones(size(eqn.V, 2), 1)]; + adi_eqn.T = blkdiag(eqn.Q, tau_beta * eqn.R); else - eqn.S_diag = [S; tau_beta * ones(size(eqn.U, 2), 1)]; + adi_eqn.T = blkdiag(eqn.R, tau_beta * eqn.Q); end end + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % solve the Lyapunov equation - [adiout, eqn, opts, oper] = mess_lradi(eqn, opts, oper); + [adiout, adi_eqn, opts, oper] = mess_lradi(adi_eqn, opts, oper); + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Store only necessary information about ADI iteration. tmp = adiout; if not(opts.nm.store_solfac) - if isfield(tmp, 'Z'), tmp = rmfield(tmp, 'Z'); end - if isfield(tmp, 'D'), tmp = rmfield(tmp, 'D'); end - if isfield(tmp, 'S'), tmp = rmfield(tmp, 'S'); end + if isfield(tmp, 'Z') + tmp = rmfield(tmp, 'Z'); + end + if isfield(tmp, 'D') + tmp = rmfield(tmp, 'D'); + end + end if not(opts.nm.store_debug) - if isfield(tmp, 'DeltaK'), tmp = rmfield(tmp, 'DeltaK'); end - if isfield(tmp, 'Knew'), tmp = rmfield(tmp, 'Knew'); end - if isfield(tmp, 'res_fact'), tmp = rmfield(tmp, 'res_fact'); end + if isfield(tmp, 'DeltaK') + tmp = rmfield(tmp, 'DeltaK'); + end + if isfield(tmp, 'Knew') + tmp = rmfield(tmp, 'Knew'); + end + if isfield(tmp, 'res_fact') + tmp = rmfield(tmp, 'res_fact'); + end end out.adi(k) = tmp; @@ -769,21 +867,23 @@ if adiout.restart && opts.nm.inexact(1) if already_restarted - error('MESS:lrnm', ... - 'Newton iteration with line search failed to converge.'); + mess_err(opts, 'lrnm', ... + ['Newton iteration with line search ', ... + 'failed to converge.']); else % restart Newton iteration - warning('MESS:lrnm', ... - ['Newton iteration needs to be restarted because ', ... - 'of divergence. Continuing with exact ADI iteration.']); + mess_warn(opts, 'lrnm', ... + ['Newton iteration needs to be restarted ', ... + 'because of divergence. ', ... + 'Continuing with exact ADI iteration.']); if opts.nm.res_tol - res = [res(1 : k - 1); zeros(opts.nm.maxiter,1)]; + res = [res(1:k - 1); zeros(opts.nm.maxiter, 1)]; else res = []; end if opts.nm.rel_diff_tol - rc = [rc(1 : k - 1); zeros(opts.nm.maxiter,1)]; + rc = [rc(1:k - 1); zeros(opts.nm.maxiter, 1)]; else rc = []; end @@ -792,61 +892,63 @@ % Reset U and V to initial state. if eqn.type == 'T' - eqn.U = [eqn.U(:, 1:eqn.sizeUV1), -eqn.B]; - eqn.V = [eqn.V(:, 1:eqn.sizeUV1), zeros(size(eqn.B))]; + adi_eqn.U = [adi_eqn.U(:, UV_cols), -adi_eqn.B]; + adi_eqn.V = [adi_eqn.V(:, UV_cols), zeros(size(adi_eqn.B))]; else - eqn.U = [eqn.U(:, 1:eqn.sizeUV1), ... - zeros(size(eqn.C,2), size(eqn.C,1))]; - eqn.V = [eqn.V(:, 1:eqn.sizeUV1), -eqn.C']; + adi_eqn.U = [adi_eqn.U(:, UV_cols), zeros(size(adi_eqn.C'))]; + adi_eqn.V = [eqn.V(:, UV_cols), -adi_eqn.C']; end - eqn.haveUV = 1; + adi_eqn.haveUV = true; - if isfield(opts.nm,'K0') + if isfield(opts.nm, 'K0') if eqn.type == 'T' - eqn.V(:, end-m+1:end) = opts.nm.K0'; + adi_eqn.V(:, feedb_cols) = opts.nm.K0'; else - eqn.U(:, end-m+1:end) = opts.nm.K0'; + adi_eqn.U(:, feedb_cols) = opts.nm.K0'; end end if bdf if eqn.type == 'T' - eqn.U = (-opts.bdf.tau * opts.bdf.beta) * eqn.B; + adi_eqn.U = -tau_beta * eqn.B; else - eqn.V = (-opts.bdf.tau * opts.bdf.beta) * eqn.C'; + adi_eqn.V = -tau_beta * eqn.C'; end end if eqn.type == 'T' - if eqn.diagonalized_RHS - eqn.G = eqn.C' * eqn.U_diag; - else - eqn.G = eqn.C'; + + adi_eqn.W = adi_eqn.C'; + if opts.LDL_T + adi_eqn.T = adi_eqn.Q; end else - if eqn.diagonalized_RHS - eqn.G = eqn.B * eqn.U_diag; - else - eqn.G = eqn.B; + + adi_eqn.W = adi_eqn.B; + if opts.LDL_T + adi_eqn.T = adi_eqn.R; end + end - eqn.G = oper.init_res(eqn, opts, oper, eqn.G); + % use init res for projection, no T required also in LDL_T mode + adi_eqn.W = oper.init_res(adi_eqn, opts, oper, adi_eqn.W); if opts.LDL_T - eqn.S_diag = S; - res0 = riccati_LR(eqn.G, [], opts, diag(eqn.S_diag), []); + if eqn.type == 'T' - eqn.S_diag = [eqn.S_diag;... - tau_beta * ones(size(eqn.V, 2), 1)]; + res0 = riccati_LR(adi_eqn.W, [], opts, adi_eqn.Q, []); + adi_eqn.T = blkdiag(eqn.Q, tau_beta * eqn.R); else - eqn.S_diag = [eqn.S_diag;... - tau_beta * ones(size(eqn.U, 2), 1)]; + res0 = riccati_LR(adi_eqn.W, [], opts, adi_eqn.R, []); + adi_eqn.T = blkdiag(eqn.R, tau_beta * eqn.Q); end + else - res0 = norm(eqn.G'*eqn.G, opts.norm); - eqn.S_diag = []; + + res0 = norm(adi_eqn.W' * adi_eqn.W, opts.norm); + end opts.nm.res0 = res0; @@ -854,26 +956,20 @@ opts.adi.inexact = false; if eqn.type == 'T' - eqn.G = [eqn.G, eqn.V(:, eqn.sizeUV1+1:end)]; + adi_eqn.W = [adi_eqn.W, adi_eqn.V(:, feedb_cols)]; else - eqn.G = [eqn.G, eqn.U(:, eqn.sizeUV1+1:end)]; + adi_eqn.W = [adi_eqn.W, adi_eqn.U(:, feedb_cols)]; end if opts.nm.linesearch - linesearch = 0; - W_old = eqn.G; -% if not(isfield(eqn,'K0')) % FIXME: dead code - DeltaK_old = []; -% else -% % DeltaK_old = -eqn.V( : , s + 1 : end); -% % careful with haveUV option! -% DeltaK_old = []; -% end + linesearch = false; + W_old = adi_eqn.W; + DeltaK_old = []; if opts.LDL_T - S_old = eqn.S_diag; + S_old = adi_eqn.T; end end - restarted = 1; + restarted = true; continue end end @@ -882,22 +978,28 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Perform projection update if desired %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - if project && not(mod(k,opts.nm.projection.freq)) && ... + if project && not(mod(k, opts.nm.projection.freq)) && ... not(opts.nm.accumulateRes && ... (adiout.Riccati_res < opts.nm.res_tol)) - projected = 1; + projected = true; - opts.nm.linesearch = 0; % no line search after projection + opts.nm.linesearch = false; % no line search after projection + opts.nm.projection.Z = adiout.Z; if opts.LDL_T - [adiout.Z, adiout.D, eqn.S_diag] = ... - mess_galerkin_projection_acceleration(adiout.Z, ... - 'CARE' ,eqn, oper, opts, adiout.D); - else - adiout.Z = mess_galerkin_projection_acceleration(adiout.Z, ... - 'CARE', eqn, oper, opts); + opts.nm.projection.D = adiout.D; + end + + [eqn, opts, oper] = ... + mess_solve_projected_eqn(eqn, opts, oper, 'GPA', 'CARE'); + + adiout.Z = opts.nm.projection.Z; + + if opts.LDL_T + adiout.D = opts.nm.projection.D; end + end %% @@ -909,13 +1011,13 @@ if not(opts.adi.accumulateDeltaK) || projected - [adiout, eqn, opts, oper ] = ... + [adiout, eqn, opts, oper] = ... mess_accumulateK(eqn, opts, oper, adiout, [], adiout.Z); else if eqn.type == 'T' - adiout.Knew = eqn.V(:, end-m+1:end) + adiout.DeltaK; + adiout.Knew = adi_eqn.V(:, feedb_cols) + adiout.DeltaK; else - adiout.Knew = eqn.U(:, end-m+1:end) + adiout.DeltaK; + adiout.Knew = adi_eqn.U(:, feedb_cols) + adiout.DeltaK; end end end @@ -924,29 +1026,31 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Compute stopping criteria %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - if opts.nm.res_tol||opts.nm.rel_diff_tol + if opts.nm.res_tol || opts.nm.rel_diff_tol if eqn.type == 'T' - V1 = adiout.Knew - eqn.V(:, end-m+1:end); + V1 = adiout.Knew - adi_eqn.V(:, feedb_cols); else - V1 = adiout.Knew - eqn.U(:, end-m+1:end); + V1 = adiout.Knew - adi_eqn.U(:, feedb_cols); end end if opts.nm.res_tol if projected if opts.LDL_T - res(k) = mess_res2_norms(adiout.Z,'riccati',eqn,opts,oper, ... - opts.nm, adiout.D)/res0; + res(k) = mess_res2_norms(adiout.Z, 'riccati', ... + eqn, opts, oper, ... + opts.nm, adiout.D) / res0; else - res(k) = mess_res2_norms(adiout.Z,'riccati',eqn,opts,oper, ... - opts.nm,[])/res0; + res(k) = mess_res2_norms(adiout.Z, 'riccati', ... + eqn, opts, oper, ... + opts.nm, []) / res0; end else if opts.nm.accumulateRes res(k) = adiout.Riccati_res; else - res(k) = riccati_LR(adiout.res_fact, V1, opts,... - diag(eqn.S_diag), [])/res0; + res(k) = riccati_LR(adiout.res_fact, V1, opts, ... + adi_eqn.T, []) / res0; end end end @@ -955,30 +1059,45 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Check whether line search is necessary %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - if ((k == 1) && (res(k) > 1)) || ((k > 1) && (res(k) > res(k - 1))) ... - || adiout.linesearch + if ((k == 1) && (res(k) > 1)) || ... + ((k > 1) && (res(k) > res(k - 1))) || ... + adiout.linesearch - linesearch = 1; + linesearch = true; % Compute Lambda if opts.LDL_T - lambda = exact_line_search(W_old, DeltaK_old, ... - adiout.res_fact, adiout.DeltaK, eqn.S_diag, S_old); + if eqn.type == 'T' + M = eqn.R; + else + M = eqn.Q; + end + lambda = exact_line_search(opts, ... + W_old, DeltaK_old, ... + adiout.res_fact, ... + adiout.DeltaK, ... + adi_eqn.T, ... + S_old, ... + M); else - lambda = exact_line_search(W_old, DeltaK_old, ... - adiout.res_fact, adiout.DeltaK, [], []); + lambda = exact_line_search(opts, W_old, DeltaK_old, ... + adiout.res_fact, ... + adiout.DeltaK, [], [], []); end if opts.nm.info - fprintf(['\n\t\t Using line search (res: %4d)\n',... - '\t\t lambda: %e\n'], res(k), lambda); + mess_fprintf(opts, ... + ['\n\t\t Using line search (res: %4d)\n', ... + '\t\t lambda: %e\n'], res(k), lambda); end % Update K if eqn.type == 'T' - adiout.Knew = eqn.V(:, end-m+1:end) + lambda * adiout.DeltaK; + adiout.Knew = adi_eqn.V(:, feedb_cols) + ... + lambda * adiout.DeltaK; else - adiout.Knew = eqn.U(:, end-m+1:end) + lambda * adiout.DeltaK; + adiout.Knew = adi_eqn.U(:, feedb_cols) + ... + lambda * adiout.DeltaK; end % Update DeltaK and W @@ -988,7 +1107,7 @@ adiout.res_fact = [sqrt(1 - lambda) * W_old, ... sqrt(lambda) * adiout.res_fact]; if opts.LDL_T - S_linesearch = [S_old; eqn.S_diag]; + S_linesearch = blkdiag(S_old, adi_eqn.T); S_K = []; end else @@ -999,50 +1118,58 @@ sqrt_lambda * DeltaK_old]; adiout.res_fact = [DeltaK_old, sqrt_lambda * W_old, ... lambda * DeltaK_new]; + if opts.LDL_T - if bdf - S_linesearch = [(opts.bdf.tau * opts.bdf.beta) ... - * ones(size(DeltaK_old, 2), 1); S_old; ... - (opts.bdf.tau * opts.bdf.beta) ... - * ones(size(DeltaK_new, 2), 1)]; - S_K = [S_old; eqn.S_diag; ... - (opts.bdf.tau * opts.bdf.beta) ... - * ones(size(DeltaK_old, 2), 1)]; + if eqn.type == 'N' + D_K = eqn.Q; else - S_linesearch = [ones(size(DeltaK_old, 2), 1); S_old; ... - ones(size(DeltaK_new, 2), 1)]; - S_K = [S_old; eqn.S_diag; ones(size(DeltaK_old, 2), 1)]; + D_K = eqn.R; end + + if bdf + D_K = tau_beta * D_K; + end + + S_linesearch = blkdiag(D_K, S_old, D_K); + S_K = blkdiag(S_old, adi_eqn.T, D_K); + end end if not(opts.LDL_T) - S_linesearch = eqn.S_diag; + S_linesearch = adi_eqn.T; S_K = []; end % Compute residual norm after line search res(k) = riccati_LR(adiout.res_fact, adiout.DeltaK, opts, ... - diag(S_linesearch), diag(S_K)) / res0; + S_linesearch, S_K) / res0; + if k == 1 + bound = (1 - lambda * alpha) * res0; + else + bound = (1 - lambda * alpha) * res(k - 1); + end - if not(restarted) && ... - (((k == 1) && (res(k) >= (1 - lambda * alpha))) || ... - ((k > 1) && (res(k) >= (1 - lambda * alpha) * res(k - 1)))) + if not(restarted) && (res(k) >= bound) % No sufficient decrease - warning('MESS:lrnm', ... - ['Newton iteration with line search has', ... - ' insufficient decrease. ']); + mess_warn(opts, 'lrnm', ... + ['Newton iteration with line search has', ... + ' insufficient decrease in iteration k = %d\n', ... + '(%g >= %g, LDL_T = %d, eqn.type = %s ', ... + 'inexact ADI = %s shifts = %s).'], ... + k, res(k), bound, opts.LDL_T, eqn.type, ... + mess_string(opts.adi.inexact), opts.shifts.method); + if opts.adi.inexact % switch to exact ADI iteration - warning('MESS:lrnm', ... - 'Switching to exact ADI iteration.'); - opts.adi.inexact = 0; + mess_warn(opts, 'lrnm', ... + 'Switching to exact ADI iteration.'); + opts.adi.inexact = false; else - % Newton iteration with line search failed to converge, stop - error('MESS:lrnm', ... - ['Newton iteration with line search failed ' ... - 'to converge.']); + mess_err(opts, 'lrnm', ... + ['Newton iteration with line search ' ... + 'failed to converge.']); end end end @@ -1054,28 +1181,25 @@ if opts.LDL_T if linesearch S_old = S_linesearch; - % be careful here, adiout.res_fact, adiout.DeltaK don't fit - % out.S anymore, till now they are not needed anywhere - % together after this point else - S_old = eqn.S_diag; + S_old = adi_eqn.T; end end - linesearch = 0; + linesearch = false; end if opts.nm.rel_diff_tol if opts.adi.accumulateDeltaK if projected if eqn.type == 'T' - adiout.DeltaK = adiout.Knew - eqn.V(:, end-m+1:end); + adiout.DeltaK = adiout.Knew - adi_eqn.V(:, feedb_cols); else - adiout.DeltaK = adiout.Knew - eqn.U(:, end-m+1:end); + adiout.DeltaK = adiout.Knew - adi_eqn.U(:, feedb_cols); end end - rc(k) = norm(adiout.DeltaK, opts.norm) ... - / norm(adiout.Knew, opts.norm); + rc(k) = norm(adiout.DeltaK, opts.norm) / ... + norm(adiout.Knew, opts.norm); else rc(k) = norm(V1, opts.norm); end @@ -1085,41 +1209,44 @@ % print status information %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% if opts.nm.info - if opts.nm.rel_diff_tol&&opts.nm.res_tol - fprintf(1,['\n NM step: %4d normalized residual: %e\n' ... - ' relative change in K: %e\n' ... - ' number of ADI steps: %d \n\n'], ... - k,res(k),rc(k),adiout.niter); + if opts.nm.rel_diff_tol && opts.nm.res_tol + mess_fprintf(opts, ... + ['\n NM step: %4d normalized residual: \t%e\n' ... + ' relative change in K: \t%e\n' ... + ' number of ADI steps: \t%d \n\n'], ... + k, res(k), rc(k), adiout.niter); elseif opts.nm.res_tol - fprintf(1,['\n NM step: %4d normalized residual: %e \n\n' ... - ' number of ADI steps: %d \n\n'], ... - k,res(k),adiout.niter); + mess_fprintf(opts, ... + ['\n NM step: %4d normalized residual: \t%e \n\n' ... + ' number of ADI steps: \t%d \n\n'], ... + k, res(k), adiout.niter); elseif opts.nm.rel_diff_tol - fprintf(1,['\n NM step: %4d relative change in K: %e\n\n' ... - ' number of ADI steps: %d \n\n'], ... - k,rc(k)); + mess_fprintf(opts, ... + ['\n NM step: %4d relative change in K: \t%e\n\n' ... + ' number of ADI steps: \t%d \n\n'], ... + k, rc(k)); end end if eqn.type == 'T' - eqn.V(:, end-m+1:end) = adiout.Knew; + adi_eqn.V(:, feedb_cols) = adiout.Knew; else - eqn.U(:, end-m+1:end) = adiout.Knew; + adi_eqn.U(:, feedb_cols) = adiout.Knew; end k = k + 1; if restarted - already_restarted = 1; - restarted = 0; + already_restarted = true; + restarted = false; end %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Evaluate stopping criteria %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - if (opts.nm.res_tol && (res(k-1) < opts.nm.res_tol)) || ... - (opts.nm.rel_diff_tol && (rc(k-1) < opts.nm.rel_diff_tol)) + if (opts.nm.res_tol && (res(k - 1) < opts.nm.res_tol)) || ... + (opts.nm.rel_diff_tol && (rc(k - 1) < opts.nm.rel_diff_tol)) break end @@ -1132,7 +1259,7 @@ case 'linear' opts.adi.inexact = res(k - 1) < opts.nm.tau * res(k - 2); case 'superlinear' - opts.adi.inexact = res(k - 1) < 1 / (k ^ 3 + 1) * res(k - 2); + opts.adi.inexact = res(k - 1) < 1 / (k^3 + 1) * res(k - 2); case 'quadratic' if res(k - 2) > 1 opts.adi.inexact = ... @@ -1144,7 +1271,8 @@ end if opts.adi.inexact - warning('MESS:lrnm','Turning inexact ADI iteration back on.'); + mess_warn(opts, 'lrnm', ... + 'Turning inexact ADI iteration back on.'); end end @@ -1153,12 +1281,12 @@ case 'linear' opts.adi.outer_tol = opts.nm.tau * res(k - 1); case 'superlinear' - opts.adi.outer_tol = 1 / (k ^ 3 + 1) * res(k - 1); + opts.adi.outer_tol = 1 / (k^3 + 1) * res(k - 1); case 'quadratic' if res(k - 1) > 1 opts.adi.outer_tol = opts.nm.tau / sqrt(res(k - 1)); else - opts.adi.outer_tol = opts.nm.tau * res(k - 1) * res(k - 1); + opts.adi.outer_tol = opts.nm.tau * res(k - 1)^2; end end opts.adi.outer_tol = max(opts.adi.outer_tol, opts.adi.res_tol); @@ -1172,24 +1300,29 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% out.niter = k - 1; if eqn.type == 'T' - out.K = eqn.V(:, end-m+1:end)'; + out.K = adi_eqn.V(:, feedb_cols)'; else - out.K = eqn.U(:, end-m+1:end)'; + out.K = adi_eqn.U(:, feedb_cols)'; end + if opts.LDL_T && isfield(adiout, 'Z') && not(isempty(adiout.Z)) out.D = adiout.D; out.Z = adiout.Z; else if isfield(adiout, 'Z') && not(isempty(adiout.Z)) out.Z = mess_column_compression(adiout.Z, 'N', [], ... - opts.nm.trunc_tol, opts.nm.trunc_info); + opts.nm.trunc_tol, ... + opts.nm.trunc_info); end end -eqn = rmfield(eqn, 'S_diag'); +if opts.nm.res_tol + out.res = res(1:out.niter); +end -if opts.nm.res_tol, out.res = res(1:out.niter); end -if opts.nm.rel_diff_tol, out.rc = rc(1:out.niter); end +if opts.nm.rel_diff_tol + out.rc = rc(1:out.niter); +end % Delete the res0 part from opts for later use of the struct. if isfield(opts.nm, 'res0') @@ -1200,37 +1333,16 @@ end if out.niter == opts.nm.maxiter - warning('MESS:NM:convergence', ... - ['LR-NM reached maximum iteration number.', ... - 'Results may be inaccurate!']); -end - -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Clean up -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if (size(eqn.V, 2) > eqn.sizeUV1) || (size(eqn.U, 2) > eqn.sizeUV1) - % Cut off the stabilizing feedback. - eqn.V = eqn.V(:, 1:eqn.sizeUV1); - eqn.U = eqn.U(:, 1:eqn.sizeUV1); + mess_warn(opts, 'convergence', ... + ['LR-NM reached maximum iteration number. ', ... + 'Results may be inaccurate!']); end -if isempty(eqn.V) || isempty(eqn.U) - % Enforce empty matrices and parameters. - eqn.U = []; - eqn.V = []; - eqn.haveUV = 0; - eqn.sizeUV1 = 0; -end - -% Delete overwritten right hand-side. -eqn = rmfield(eqn, 'G'); - %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % finalize usfs %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -[eqn,opts,oper] = oper.mul_E_post(eqn,opts,oper); +[eqn, opts, oper] = oper.mul_E_post(eqn, opts, oper); [eqn, opts, oper] = oper.init_res_post(eqn, opts, oper); diff --git a/mat-eqn-solvers/mess_lrradi.m b/mat-eqn-solvers/mess_lrradi.m index de7c8fc..8cc8461 100644 --- a/mat-eqn-solvers/mess_lrradi.m +++ b/mat-eqn-solvers/mess_lrradi.m @@ -1,1139 +1,1176 @@ -function [out, eqn, opts, oper] = mess_lrradi(eqn, opts, oper) -%% function [out, eqn, opts, oper] = mess_lrradi(eqn,opts, oper) -% -% Solve continuous-time Riccati equations with sparse coefficients with -% the RADI method [1]. With X = Z*inv(Y)*Z', -% eqn.type = 'N' -> A*X*E' + E*X*A' - E*X*C'*C*X*E' + B*B' = 0 (N) -% eqn.type = 'T' -> A'*X*E + E'*X*A - E'*X*B*B'*X*E + C'*C = 0 (T) -% -% Matrix A can have the form A = à + U*V' if U (eqn.U) and V (eqn.V) are -% provided U and V are dense (n x m3) matrices and should satisfy m3 << n -% -% Input/Output -% eqn struct contains data for equations -% -% opts struct contains parameters for the algorithm -% -% oper struct contains function handles for operation -% with A and E -% -% Output -% out struct containing solutions and output information -% -% Input fields in struct eqn: -% eqn.B dense (n x m1) matrix B -% -% eqn.C dense (m2 x n) matrix C -% -% eqn.S dense (m1 x m1) matrix (N) or (m2 x m2) matrix (T) -% expected to be symmetric -% (required for LDL^T formulation) -% -% eqn.U dense (n x m3) matrix U -% (optional, required if eqn.V is present) -% -% eqn.V dense (n x m3) matrix V -% (optional, required if eqn.U is present) -% -% eqn.type possible values: 'N', 'T' -% determining whether (N) or (T) is solved -% (optional, default 'N') -% -% eqn.haveE possible values: 0, 1, false, true -% if haveE = 0: matrix E in eqn.E_ is assumed to be identity -% (optional, default 0) -% -% eqn.haveUV possible values: 0, 1, false, true -% if haveUV = 1: U = [U1, U2] and V = [V1, V2] -% if K or DeltaK are accumulated during the iteration they -% use only U2 and V2. U1 and V1 can be used for an external -% rank-k update of the operator. -% The size of U1 and V1 can be given via eqn.sizeUV1. -% (optional, default: 0) -% -% eqn.sizeUV1 possible values: nonnegative integer -% if a stabilizing feedback is given via U = [U1, U2] and -% V = [V1, V2] in U2 or V2, eqn.widthU1 indicates how -% many beginning columns of U and V does not be -% (optional, default: size(eqn.U, 2)) -% -% Depending on the operator chosen by the operatormanager, additional -% fields may be needed. For the "default", e.g., eqn.A_ and eqn.E_ hold -% the A and E matrices. For the second order types these are given -% implicitly by the M, D, K matrices stored in eqn.M_, eqn.E_ and eqn.K_, -% respectively. -% -% Input fields in struct opts: -% opts.LDL_T possible values: 0, 1, false, true -% use LDL^T formulation for the RHS and -% solution -% (optional, default: 0) -% -% opts.norm possible values: 2, 'fro' -% use 2-norm (2) or Frobenius norm ('fro') to -% compute residual and relative change norms -% in case projection is used -% (opts.nm.projection.freq > 0) norm will -% automatically be set to 2 -% (optional, default: 'fro') -% -% opts.radi.Z0 possible values: dense (n x m4) matrix -% initial stabilizing solution factor -% X0 = Z0*inv(Y0)*Z0', this factor has to -% result in a positive semi-definite Riccati -% residual W0 -% (optional, default: zeros(n, m4)) -% -% opts.radi.Y0 possible values: dense (m4 x m4) matrix -% initial stabilizing solution factor -% X0 = Z0*inv(Y0)*Z0', this factor has to -% result in a positive semi-definite -% Riccati residual W0 -% (optional, default: eye(m4)) -% -% opts.radi.W0 possible values: dense (n x m5) matrix -% initial Riccati residual factor such that -% R(X0) = W0 * W0', if -% opts.radi.compute_res = 1, this factor is -% computed out of Z0 and Y0 -% Note: In case of Bernoulli stabilization -% the W0 is given by the right hand-side C' -% for 'T' and B for 'N' and is automatically -% set if opts.radi.compute_res = 0 -% (optional, default: C' for 'T' or B for -% 'N') -% -% opts.radi.S0 possible values: dense (m5 x m5) matrix -% initial Riccati residual factor such that -% R(X0) = W0 * S0 * W0', if -% opts.radi.compute_res = 1, this factor is -% computed out of Z0 and Y0 -% (required for LDL^T formulation if -% opts.radi.W0 was explicitly set) -% -% opts.radi.K0 possible values: dense 'T': (m1 x n) -% matrix, 'N': (m2 x n) matrix -% initial K (corresponding to Z0 and Y0) -% Note: If K0 is given without Z0, only the -% resulting stabilizing feedback is computed. -% Also it has to correspond to W0. -% (optional, default: E*Z0*inv(Y0)*Z0'*C' for -% 'N' or E'*Z0*inv(Y0)*Z0'*B for 'T') -% -% opts.radi.compute_sol_fac possible values: 0, 1, false, true -% turn on (1) or off (0) to compute the -% solution of the Riccati equation and use it -% internally for computations, or only -% the stabilizing feedback -% (optional, default: 1) -% -% opts.radi.get_ZZt possible values: 0, 1, false, true -% turn on (1) or off (0) to compute only -% the low-rank decomposition X = Z*Z' -% without the middle term Y -% (optional, default: 1) -% -% opts.radi.compute_res possible values: 0, 1, false, true -% turn on (1) or off (0) to compute the -% residual corresponding to the initial -% solution factors Z0, Y0, if 0 then the -% right hand-side is used as residual if -% there is no W0 -% (optional, default: 1) -% -% opts.radi.maxiter possible values: integer > 0 -% maximum RADI iteration number -% (optional, default: 100) -% -% opts.radi.res_tol possible values: scalar >= 0 -% stopping tolerance for the relative -% RADI residual norm; if res_tol = 0 the -% relative residual norm is not evaluated -% (optional, default: 0) -% -% opts.radi.rel_diff_tol possible values: scalar >= 0 -% stopping tolerance for the relative -% change of the RADI solution Z; -% if res_tol = 0 the relative -% change is not evaluated -% (optional, default: 0) -% -% opts.norm possible values: 2, 'fro' -% use 2-norm (2) or Frobenius norm ('fro') to -% compute residual and relative change norms; -% must be the same as opts.norm -% (optional, default: 'fro') -% -% opts.radi.info possible values: 0, 1, false, true -% turn on (1) or off (0) the status output in -% every RADI iteration step -% (optional, default: 0) -% -% opts.radi.trunc_tol possible values: scalar > 0 -% tolerance for rank truncation of the -% low-rank solutions (aka column compression) -% (optional, default: eps*n) -% -% opts.radi.trunc_info possible values: 0, 1, false, true -% verbose mode for column compression -% (optional, default: 0) -% -% opts.shifts.method possible values: -% 'precomputed', -% 'penzl','heur', (basic MMESS routine) -% 'projection' (basic MMESS routine) -% 'gen-ham-opti' (special for RADI) -% method for shift computation -% (optional, default: 'gen-ham-opti') -% -% opts.shifts.history possible values: integer * size(W0, 2) > 0 -% parameter for accumulating the history -% of shift computations -% (optional, default: 6 * columns of -% residual) -% -% opts.shifts.info possible values: 0, 1, false, true -% turn output of used shifts before the first -% iteration step on (1) or off (0) -% (optional, default: 0) -% -% -% If optional input arguments are missing they may be set to default values -% and a 'MESS:control_data' warning is printed. To turn warnings off use -% warning('OFF', 'MESS:control_data'). -% -% The feedback matrix K can be accumulated during the iteration: -% eqn.type = 'N' -> K = (E*X*C')' -% eqn.type = 'T' -> K = (E'*X*B)' -% -% -% Output fields in struct out: -% out.Z low rank solution factor, the solution is -% opts.radi.get_ZZt = 0: X = Z*inv(Y)*Z' -% opts.radi.get_ZZt = 1: X = Z*Z' -% (opts.radi.compute_sol_fac = 1 and not only initial K0) -% -% out.Y small square solution factor, the solution is -% opts.radi.get_ZZt = 0: X = Z*inv(Y)*Z' -% (opts.radi.compute_sol_fac = 1 and not only initial K0) -% -% out.D solution factor for LDL^T formulation, the solution is -% opts.LDL_T = 1: X = Z*D*Z' -% (opts.LDL_T = 1) -% -% out.K stabilizing Feedback matrix -% -% out.timesh time of the overall shift computation -% -% out.p used shifts -% -% out.niter number of RADI iterations -% -% out.res array of relative RADI residual norms -% (opts.radi.res_tol ~= 0) -% -% out.rc array of relative RADI change norms -% (opts.radi.rel_diff_tol ~= 0) -% -% out.res_fact final Riccati residual factor W of the iteration -% -% out.res0 norm of the normalization residual term -% -% -% uses operator functions init and mul_E, mul_E_pre, mul_E_post, -% mul_A, mul_A_pre, mul_A_post, init_res_pre, init_res, init_res_post, -% size directly and further indirectly -% -% References: -% [1] P. Benner, Z. Bujanović, P. Kürschner, J. Saak, RADI: A low-rank -% ADI-type algorithm for large scale algebraic Riccati equations, -% Numer. Math. 138 (2) (2018) 301–330. -% https://doi.org/10.1007/s00211-017-0907-5. -% -% See also mess_lrradi_get_shifts, operatormanager. - -% -% This file is part of the M-M.E.S.S. project -% (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. -% All rights reserved. -% License: BSD 2-Clause License (see COPYING) -% - -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Check system data -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if not(isfield(eqn, 'haveE')) - eqn.haveE = 0; -end - -[result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A', 'E'); -if not(result) - error('MESS:control_data', ... - 'system data is not completely defined or corrupted'); -end - -if not(isfield(eqn, 'B')) || not(isnumeric(eqn.B)) - error('MESS:control_data', 'eqn.B is not defined or corrupted'); -end - -if not(isfield(eqn, 'C')) || not(isnumeric(eqn.C)) - error('MESS:control_data', 'eqn.C is not defined or corrupted'); -end - -% Make sure the first right hand side is dense so that the resulting factor -% is densely stored. -if issparse(eqn.C) - eqn.C = full(eqn.C); -end - -if issparse(eqn.B) - eqn.B = full(eqn.B); -end - -if not(isfield(eqn, 'type')) - eqn.type = 'N'; - warning('MESS:control_data',['Unable to determine type of equation.'... - 'Falling back to type ''N''']); -elseif (eqn.type ~= 'N') && (eqn.type ~= 'T') - error('MESS:equation_type', ... - 'Equation type must be either ''T'' or ''N'''); -end - -if not(isfield(opts, 'LDL_T')), opts.LDL_T = 0; end - -if opts.LDL_T - if not(isfield(eqn, 'S')) || not(isnumeric(eqn.S)) - error('MESS:control_data', 'eqn.S is not defined or corrupted'); - end -end - -if eqn.type == 'T' - m = size(eqn.B, 2); %number of inputs - eqn.BB = eqn.B; %set quadratic term - eqn.CC = eqn.C'; %set right hand side -else - m = size(eqn.C, 1); %number of outputs - eqn.BB = eqn.C'; %set quadratic term - eqn.CC = eqn.B; %set right hand side -end - - -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Rank-k update system data. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if not(isfield(eqn, 'haveUV')) || isempty(eqn.haveUV) || not(eqn.haveUV) - eqn.haveUV = 0; - eqn.sizeUV1 = 0; - eqn.U = []; - eqn.V = []; -else - if opts.LDL_T - error('MESS:control_data', ... - ['LDL_T formulation is not compatible with ' ... - 'eqn.haveUV option.']); - end - - if isnumeric(eqn.U) && isnumeric(eqn.V) && ... - size(eqn.U, 1) == size(eqn.V, 1) && size(eqn.U, 2) == size(eqn.V, 2) - - if issparse(eqn.V), eqn.V = full(eqn.V); end - if issparse(eqn.U), eqn.U = full(eqn.U); end - else - error('MESS:control_data', ... - ['Inappropriate data of low rank updated operator ', ... - '(eqn.U and eqn.V)']); - end -end - -% Check for size of constant term in U and V. -if eqn.haveUV - if not(isfield(eqn, 'sizeUV1')) || isempty(eqn.sizeUV1) - eqn.sizeUV1 = size(eqn.U, 2); - else - assert(isnumeric(eqn.sizeUV1) && (eqn.sizeUV1 <= size(eqn.U, 2)), ... - 'MESS:control_data', ... - ['Inappropriate size of low rank updated operator ', ... - '(eqn.U and eqn.V)']); - end -end - -% Initialize storage for the computed feedback. -if eqn.type == 'T' - eqn.U = [eqn.U(:, 1:eqn.sizeUV1), -eqn.B]; - eqn.V = [eqn.V(:, 1:eqn.sizeUV1), zeros(size(eqn.B))]; -else - eqn.U = [eqn.U(:, 1:eqn.sizeUV1), zeros(size(eqn.C,2), size(eqn.C,1))]; - eqn.V = [eqn.V(:, 1:eqn.sizeUV1), -eqn.C']; -end - -eqn.haveUV = 1; - - -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Initialize required usf for multiplications -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if eqn.haveE - [eqn, opts, oper] = oper.mul_E_pre(eqn, opts, oper); -end - -[eqn, opts, oper] = oper.mul_A_pre(eqn, opts, oper); - -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Check for RADI Control structure in options -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if not(isfield(opts, 'radi')) || not(isstruct(opts.radi)) - error('MESS:control_data', ['No radi control data found in ', ... - 'options structure.']); -end - -% Check computation of Riccati solution. -if not(isfield(opts.radi, 'compute_sol_fac')) || ... - isempty(opts.radi.compute_sol_fac) - opts.radi.compute_sol_fac = 1; -end - -% Check format of output solution. -if not(isfield(opts.radi, 'get_ZZt')) || isempty(opts.radi.get_ZZt) - opts.radi.get_ZZt = 1; -end - -% Check for residual norm. -if not(isfield(opts, 'norm')) || (not(strcmp(opts.norm, 'fro')) && ... - (not(isnumeric(opts.norm)) || opts.norm ~= 2)) - warning('MESS:control_data', ... - ['Missing or Corrupted opts.norm field.', ... - 'Switching to default: ''fro''']); - opts.norm = 'fro'; -end - -if not(isfield(opts.radi,'trunc_tol')) - opts.radi.trunc_tol = eps * oper.size(eqn, opts); -end - -if not(isfield(opts.radi, 'trunc_info')), opts.radi.trunc_info = 0; end - - -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% List all currently unsupported options -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if isfield(opts, 'bdf') && not(isempty(opts.bdf)) - error( 'MESS:control_data', 'Options bdf not supported.'); -end - -if isfield(opts, 'rosenbrock') && not(isempty(opts.rosenbrock)) - error( 'MESS:control_data', 'Options rosenbrock not supported.'); -end - - -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Check for initial values -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Initialize projected residual factor in case of DAE -% oper.init_res assumes that opts.LDL_T is defined. -[eqn, opts, oper] = oper.init_res_pre(eqn, opts, oper); - -onlyK = 0; -hasZ0 = isfield(opts.radi, 'Z0') && not(isempty(opts.radi.Z0)); -hasY0 = isfield(opts.radi, 'Y0') && not(isempty(opts.radi.Y0)); -hasW0 = isfield(opts.radi, 'W0') && not(isempty(opts.radi.W0)); -hasS0 = isfield(opts.radi, 'S0') && not(isempty(opts.radi.S0)); -hasK0 = isfield(opts.radi, 'K0') && not(isempty(opts.radi.K0)); - -if hasZ0 - % Stabilizing initial solution. - Z = opts.radi.Z0; - nZ0 = size(Z, 2); - - % Initial middle term. - if hasY0 - Y = opts.radi.Y0; - else - Y = eye(size(Z, 2)); - end - - % Check for residual computation option. - if not(isfield(opts.radi, 'compute_res')) || isempty(opts.radi.compute_res) - warning('MESS:control_data', ... - ['Missing or Corrupted opts.radi.compute_res field.', ... - 'Switching to default: 1']); - opts.radi.compute_res = 1; - end - - % Initial residual. - if hasW0 - % Case: Initial residual is given. - W = opts.radi.W0; - if opts.LDL_T - assert(hasS0, ... - 'MESS:control_data', ... - 'Missing or corrupted opts.radi.S0 field.'); - if isdiag(opts.radi.S0) - eqn.S_diag = diag(opts.radi.S0); - else - [eqn.U_diag, eqn.S_diag] = eig(opts.radi.S0); - eqn.S_diag = diag(eqn.S_diag); - W = W * eqn.U_diag; - end - end - - [W, res0, eqn, opts, oper] = oper.init_res(eqn, opts, oper, W); - - elseif opts.radi.compute_res - % Case: Initial residual has to be computed. - AZ = oper.mul_A(eqn, opts, eqn.type, Z, 'N'); - - if eqn.haveE - EZ = oper.mul_E(eqn, opts, eqn.type, Z, 'N'); - else - EZ = Z; - end - - if eqn.sizeUV1 - if eqn.type == 'T' - UU = eqn.V(:, 1:eqn.sizeUV1); - VV = EZ * (Y \ (Z' * eqn.U(:, 1:eqn.sizeUV1))); - else - UU = eqn.U(:, 1:eqn.sizeUV1); - VV = EZ * (Y \ (Z' * eqn.V(:, 1:eqn.sizeUV1))); - end - UDV = [zeros(eqn.sizeUV1), eye(eqn.sizeUV1); ... - eye(eqn.sizeUV1), zeros(eqn.sizeUV1)]; - else - UU = []; - VV = []; - UDV = []; - end - - if opts.LDL_T - D0 = blkdiag([zeros(size(Y)), Y \ eye(size(Y)); ... - Y \ eye(size(Y)), zeros(size(Y))], ... - UDV, -eye(m), eqn.S); - else - D0 = blkdiag([zeros(size(Y)), Y \ eye(size(Y)); ... - Y \ eye(size(Y)), zeros(size(Y))], ... - UDV, -eye(m), eye(size(eqn.CC, 2))); - end - - [G, S] = mess_column_compression( ... - [AZ, EZ, UU, VV, EZ * (Y \ (Z' * eqn.BB)), eqn.CC], 'N', ... - D0, opts.radi.trunc_tol, opts.radi.trunc_info); - - if opts.LDL_T || not(all(diag(S) > 0)) - if not(opts.LDL_T) - warning('MESS:control_data', ... - ['The initial residual is indefinite, ' ... - 'change to LDL^T approach!']); - opts.LDL_T = 1; - end - - W = G; - eqn.S_diag = diag(S); - else - W = G * diag(sqrt(diag(S))); - end - - [W, res0, eqn, opts, oper] = oper.init_res(eqn, opts, oper, W); - else - % Case: Initial residual is given as right hand-side (Bernoulli). - W = eqn.CC; - if opts.LDL_T - if isdiag(eqn.S) - eqn.S_diag = diag(eqn.S); - else - [eqn.U_diag, eqn.S_diag] = eig(eqn.S); - eqn.S_diag = diag(eqn.S_diag); - W = W * eqn.U_diag; - end - end - - [W, res0, eqn, opts, oper] = oper.init_res(eqn, opts, oper, W); - end - - % Initial stabilizing feedback. - if eqn.type == 'T' - if isfield(opts.radi, 'K0') && not(isempty(opts.radi.K0)) - eqn.V(: , end-m+1:end) = opts.radi.K0'; - else - if eqn.haveE - eqn.V(: , end-m+1:end) = oper.mul_E(eqn, opts, 'T', Z, 'N') ... - * (Y \ (Z' * eqn.B)); - else - eqn.V(: , end-m+1:end) = Z * (Y \ (Z' * eqn.B)); - end - end - else - if isfield(opts.radi, 'K0') && not(isempty(opts.radi.K0)) - eqn.U(: , end-m+1:end) = opts.radi.K0'; - else - if eqn.haveE - eqn.U(: , end-m+1:end) = oper.mul_E(eqn, opts, 'N', Z, 'N') ... - * (Y \ (Z' * eqn.C')); - else - eqn.U(: , end-m+1:end) = Z * (Y \ (Z' * eqn.C')); - end - end - end -elseif hasK0 - % Stabilizing initial feedback. - if eqn.type == 'T' - eqn.V(: , end-m+1:end) = opts.radi.K0'; - else - eqn.U(: , end-m+1:end) = opts.radi.K0'; - end - - % Assign the corresponding residual. - if hasW0 - W = opts.radi.W0; - - if opts.LDL_T - assert(hasS0, ... - 'MESS:control_data', ... - 'Missing or corrupted opts.radi.S0 field.'); - if isdiag(opts.radi.S0) - eqn.S_diag = opts.radi.S0; - else - [eqn.U_diag, eqn.S_diag] = eig(opts.radi.S0); - eqn.S_diag = diag(eqn.S_diag); - W = W * eqn.U_diag; - end - end - else - W = eqn.CC; - - if opts.LDL_T - if isdiag(eqn.S) - eqn.S_diag = diag(eqn.S); - else - [eqn.U_diag, eqn.S_diag] = eig(eqn.S); - eqn.S_diag = diag(eqn.S_diag); - W = W * eqn.U_diag; - end - end - end - - [W, res0, eqn, opts, oper] = oper.init_res(eqn, opts, oper, W); - - % Other initial values. - Z = zeros(oper.size(eqn, opts), 0); - nZ0 = 0; - Y = []; - onlyK = 1; -else - % Start with zero initial solution. - Z = zeros(oper.size(eqn, opts), 0); - nZ0 = 0; - Y = []; - - W = eqn.CC; - if opts.LDL_T - if isdiag(eqn.S) - eqn.S_diag = diag(eqn.S); - else - [eqn.U_diag, eqn.S_diag] = eig(eqn.S); - eqn.S_diag = diag(eqn.S_diag); - W = W * eqn.U_diag; - end - end - - [W, res0, eqn, opts, oper] = oper.init_res(eqn, opts, oper, W); -end -p = size(W, 2); % size of residual factor. - - -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Check for shift parameter structure -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if not(isfield(opts, 'shifts')) || not(isstruct(opts.shifts)) - error('MESS:control_data', ... - 'shift parameter control structure missing.'); -end - -% Default shift method settings. -if not(isfield(opts, 'shifts')) || ... - not(isstruct(opts.shifts)) || ... - not(isfield(opts.shifts, 'method')) - - warning('MESS:control_data',... - ['shift parameter control structure missing.', ... - 'Switching to default: method = gen-ham-opti, history = 6.']); - - opts.shifts.method = 'gen-ham-opti'; -end - -% Check for shift history parameter. -if not(isfield(opts.shifts, 'history')) || isempty(opts.shifts.history) - opts.shifts.history = 6 * p; -end - -% Use heuristic penzl shifts routines from MMESS. -if strcmp(opts.shifts.method, 'penzl') || ... - strcmp(opts.shifts.method, 'heur') || ... - strcmp(opts.shifts.method, 'projection') - - if not(isfield(opts.shifts, 'num_desired')) - opts.shifts.num_desired = opts.shifts.history; - end - - if strcmp(opts.shifts.method, 'penzl') || ... - strcmp(opts.shifts.method, 'heur') - - if not(isfield(opts.shifts, 'num_Ritz')) - opts.shifts.num_Ritz = opts.shifts.history + 1; - end - - if not(isfield(opts.shifts,'num_hRitz')) - opts.shifts.num_hRitz = opts.shifts.history; - end - end -end - -% Use provided shifts. -if strcmp(opts.shifts.method, 'precomputed') - if not((isfield(opts.shifts, 'p')) && ... - isnumeric(opts.shifts.p) && ... - isvector(opts.shifts.p)) - - error('MESS:shifts', ... - 'Found empty shift vector. Please provide proper shifts.'); - else - illegal_shifts = 0; - - % Check if all shifts are in the open left half plane - if any(not(real(opts.shifts.p) < 0)) - illegal_shifts = 1; - end - - % Check if complex pairs of shifts are properly ordered. - k = 1; - while k <= length(opts.shifts.p) - if not(isreal(opts.shifts.p(k))) - if not(opts.shifts.p(k+1) == conj(opts.shifts.p(k))) - illegal_shifts = 1; - end - k = k+1; - end - k = k+1; - end - - if illegal_shifts - error('MESS:shifts_improper', 'Improper shift vector detected!'); - end - end -else - % If the shifts are not precomputed, let the shift array initially be - % empty. - opts.shifts.p = []; -end - - -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Check info parameter for output verbosity -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if not(isfield(opts.radi, 'info')) - opts.radi.info = 0; -else - if not(isnumeric(opts.radi.info)) && not(islogical( opts.radi.info )) - error('MESS:info', ... - 'opts.radi.info parameter must be logical or numeric.'); - end -end - -if not(isfield(opts.shifts, 'info')) - opts.shifts.info = 0; -else - if not(isnumeric(opts.shifts.info)) && not(islogical(opts.shifts.info)) - error('MESS:info', ... - 'opts.shifts.info parameter must be logical or numeric.'); - end -end - - -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Check stopping parameters -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if not(isfield(opts.radi, 'maxiter')) || not(isnumeric(opts.radi.maxiter)) - warning('MESS:control_data',... - ['Missing or Corrupted opts.radi.maxiter field.', ... - 'Switching to default: 100']); - opts.radi.maxiter = 100; -end - -if not(isfield(opts.radi,'rel_diff_tol')) || not(isnumeric(opts.radi.rel_diff_tol)) - warning('MESS:control_data',... - ['Missing or Corrupted opts.radi.rel_diff_tol field.', ... - 'Switching to default: 0']); - opts.radi.rel_diff_tol = 0; -end - -if opts.radi.rel_diff_tol - nrmZ = sum(sum(Z.^2)); -end - -if not(isfield(opts.radi, 'res_tol')) || not(isnumeric(opts.radi.res_tol)) - warning('MESS:control_data',... - ['Missing or Corrupted opts.radi.res_tol field.', ... - 'Switching to default: 0'] ); - opts.radi.res_tol = 0; -end - -% Check if the low-rank factor Z needs to be computed entirely. -maxcolZ = (opts.radi.maxiter + 1) * p + nZ0; -opts.radi.compute_sol_facpart = 0; - -if (strcmp(opts.shifts.method, 'gen-ham-opti') || ... - strcmp(opts.shifts.method, 'projection')) && ... - (opts.radi.compute_sol_fac == 0) - - opts.radi.compute_sol_facpart = 1; - maxcolZ = opts.shifts.history; -end - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% All checks done. Here comes the real work! -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Initialize data -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if opts.radi.res_tol - res = zeros(1, opts.radi.maxiter); -else - res = []; -end - -if opts.radi.rel_diff_tol - rc = zeros(1, opts.radi.maxiter); -else - rc = []; -end - -% Get relevant sizes of right hand side and shift vector. -nShifts = length(opts.shifts.p); - -if opts.shifts.info % print shifts - fprintf('RADI Shifts:\n'); - disp(opts.shifts.p); -end - -% Reset the timer. -out.timesh = 0; - -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Start iteration -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -k = 1; -k_shift = 1; - -while k < (opts.radi.maxiter + 1) - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - % check whether shifts need to be updated - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - if k_shift > nShifts - k_shift = 1; - tsh = tic; - - [eqn, opts, oper, nShifts] = mess_lrradi_get_shifts(eqn, opts, oper, ... - W, Z, Y); - - timesh = toc(tsh); - out.timesh = out.timesh + timesh; - - if opts.shifts.info % print shifts - fprintf('RADI Shifts:\n'); - disp(opts.shifts.p); - end - end - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - % get current shift - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - pc = opts.shifts.p( k_shift ); - out.p(k) = pc; - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - % perform the actual step computations - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - [V, eqn, opts, oper] = mess_solve_shifted_system(eqn, opts, oper, pc, W); - - if opts.LDL_T - V = V * diag(eqn.S_diag); - end - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - % update low rank solution factor - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - if isreal(pc) - % The shift pc is real. Only perform a single step of the method. - V = real(V); - VtB = V' * eqn.BB; - - if opts.LDL_T - Y_new = diag(eqn.S_diag); - else - Y_new = eye(p); - end - Y_new = Y_new + VtB * VtB'; - - if opts.radi.compute_sol_fac || opts.radi.compute_sol_facpart - % Only store part of Z used for shift generation. - nZ = size(Z, 2); - % Expand the Z matrix. - if opts.radi.compute_sol_facpart - ind = max(nZ-maxcolZ+p, 0)+1 : max(min(maxcolZ, nZ), 0); - Z(:, 1:min(maxcolZ, k*p + nZ0)) = [Z(:, ind), sqrt(-2.0*pc)*V]; - else - Z(:, nZ+1:nZ+p) = sqrt(-2.0*pc)*V; - end - - if opts.radi.compute_sol_fac, Y = blkdiag(Y, Y_new); end - end - - % Update the low-rank residual factor W. - VY_newi = -2.0 * pc * (V / Y_new); - if eqn.haveE - VY_newi = oper.mul_E(eqn, opts, eqn.type, VY_newi, 'N'); - end - W = W + VY_newi; - - % Update the K matrix. - if eqn.type == 'T' - eqn.V(:, end-m+1:end) = eqn.V(:, end-m+1:end) + VY_newi * VtB; - else - eqn.U( : , end-m+1:end) = eqn.U( : , end-m+1:end) + VY_newi * VtB; - end - else - % The shift pc is complex. - % Perform a double step with the known solution for the conjugate - % shift. - V1 = sqrt(-2.0*real(pc)) * real(V); - V2 = sqrt(-2.0*real(pc)) * imag(V); - - % Some auxiliary matrices. - Vr = V1' * eqn.BB; - Vi = V2' * eqn.BB; - - % Compute the new parts of low-rank approximate solution. - sr = real(pc); - si = imag(pc); - sa = abs(pc); - - AA = [-sr/sa * Vr - si/sa * Vi; si/sa * Vr - sr/sa * Vi]; - BB = [Vr; Vi]; - CC = [si/sa * eye(p); sr/sa * eye(p)]; - - if opts.LDL_T - Y_new = blkdiag(diag(eqn.S_diag), 1/2 * diag(eqn.S_diag)) ... - - 1/(4 * sr) * (AA * AA') ... - - 1/(4 * sr) * (BB * BB') ... - - 1/2 * (CC * (diag(eqn.S_diag) * CC')); - else - Y_new = blkdiag(eye(p), 1/2 * eye(p)) ... - - 1/(4 * sr) * (AA * AA') ... - - 1/(4 * sr) * (BB * BB') ... - - 1/2 * (CC * CC'); - end - - if opts.radi.compute_sol_fac || opts.radi.compute_sol_facpart - % Only store part of Z used for shift generation. - nZ = size(Z, 2); - % Expand the Z matrix. Z = [Z, V1, V2]; - if opts.radi.compute_sol_facpart - ind = max(nZ-maxcolZ+2*p, 0) + 1:max(min(maxcolZ, nZ), 0); - Z(:, 1:min( maxcolZ, (k+1)*p + nZ0)) = [Z(:, ind), V1, V2]; - else - Z(:, nZ+1:nZ+2*p) = [V1, V2]; - end - - if opts.radi.compute_sol_fac - Y = blkdiag(Y, Y_new); - end - end - - % Update the low-rank residual factor W. - VY_newi = [V1, V2] / Y_new; - if eqn.haveE - VY_newi = oper.mul_E(eqn, opts, eqn.type, VY_newi, 'N'); - end - - W = W + sqrt(-2.0 * sr) * VY_newi(:, 1:p); - - % Update the K matrix. - if eqn.type == 'T' - eqn.V(:, end-m+1:end) = eqn.V(:, end-m+1:end) + VY_newi * [Vr; Vi]; - else - eqn.U(:, end-m+1:end) = eqn.U(:, end-m+1:end) + VY_newi * [Vr; Vi]; - end - - % Forward the indices in the loop. - k = k + 1; - k_shift = k_shift + 1; - - if k > 2 - res(k - 1) = res(k - 2); - else - res(k - 1) = 1; - end - out.p(k) = conj(pc); - end - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - % Compute stopping criteria - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - if opts.radi.res_tol - % Low-rank residual norm computation. - if opts.LDL_T - res(k) = riccati_LR(W, [], opts, diag(eqn.S_diag), []) / res0; - else - res(k) = riccati_LR(W, [], opts, [], []) / res0; - end - end - - if opts.radi.rel_diff_tol - if isreal(pc) - nrmV = -2.0 * pc * sum(sum(V .^ 2)); - else - % Complex double step means 2 blocks added. - nrmV = sum(sum([V1, V2].^2 )); - end - nrmZ = nrmZ + nrmV; - rc(k) = sqrt(nrmV / nrmZ); - end - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - % print status information - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - if opts.radi.info - if opts.radi.rel_diff_tol && opts.radi.res_tol - fprintf(1, ... - ['RADI step: %4d pc: %e + %ei normalized residual: ' ... - '%e relative change in Z: %e\n'], ... - k, real(pc), imag(pc), res(k), rc(k)); - elseif opts.radi.res_tol - fprintf(1, 'RADI step: %4d normalized residual: %e\n', ... - k, res(k)); - elseif opts.radi.rel_diff_tol - fprintf(1, 'RADI step: %4d relative change in Z: %e\n', ... - k, rc(k)); - end - end - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - % Evaluate stopping criteria - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - if res(k) < opts.radi.res_tol - break; - end - - k = k + 1; - k_shift = k_shift + 1; -end - - -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Prepare output arguments -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -out.niter = k - (k > opts.radi.maxiter); - -if opts.radi.res_tol - out.res = res(1:out.niter); -end - -% warn the user if we have stopped before reaching the desired accuracy. -if (out.niter == opts.radi.maxiter) && ... - not(out.res(end) < opts.radi.res_tol) - - warning('MESS:RADI:convergence',... - ['LR-RADI was stopped by the maximum iteration count.',... - ' Results may be inaccurate.'] ); -end - -if opts.radi.rel_diff_tol - out.rc = rc(1:out.niter); -end - -out.res_fact = W; - -if eqn.type == 'T' - out.K = eqn.V(:, end-m+1:end)'; -else - out.K = eqn.U(:, end-m+1:end)'; -end - -if opts.radi.compute_sol_fac && not(onlyK) - - if opts.radi.get_ZZt && not(opts.LDL_T) - R = chol(Y); - out.Z = mess_column_compression(Z / R, 'N', [], opts.radi.trunc_tol, ... - opts.radi.trunc_info); - elseif opts.LDL_T - Yinv = Y \ eye(size(Y, 1)); - Yinv = 0.5 * (Yinv + Yinv'); - [out.Z, out.D] = mess_column_compression(Z, 'N', Yinv, ... - opts.radi.trunc_tol, ... - opts.radi.trunc_info); - out.Y = out.D \ eye(size(out.D, 1)); - else - out.Z = Z; - out.Y = Y; - end -end - -out.res0 = res0; - - -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Clean up -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if (size(eqn.V, 2) > eqn.sizeUV1) || (size(eqn.U, 2) > eqn.sizeUV1) - % Cut off the stabilizing feedback. - eqn.V = eqn.V(:, 1:eqn.sizeUV1); - eqn.U = eqn.U(:, 1:eqn.sizeUV1); -end - -if isempty(eqn.V) || isempty(eqn.U) - % Enforce empty matrices and parameters. - eqn.U = []; - eqn.V = []; - eqn.haveUV = 0; - eqn.sizeUV1 = 0; -end - -% Delete short cuts for right hand-side and quadratic term. -eqn = rmfield(eqn, 'BB'); -eqn = rmfield(eqn, 'CC'); - -if isfield(eqn, 'S_diag') - eqn = rmfield(eqn, 'S_diag'); -end - -if isfield(opts.shifts, 'tmp') - opts.shifts = rmfield(opts.shifts, 'tmp'); -end - - -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Finalize required usfs -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if eqn.haveE - [eqn, opts, oper] = oper.mul_E_post(eqn, opts, oper); -end - -[eqn, opts, oper] = oper.mul_A_post(eqn, opts, oper); -[eqn, opts, oper] = oper.init_res_post(eqn, opts, oper); +function [out, eqn, opts, oper] = mess_lrradi(eqn, opts, oper) +%% function [out, eqn, opts, oper] = mess_lrradi(eqn,opts, oper) +% +% Solve continuous-time Riccati equations with sparse coefficients with +% the RADI method [1]. With X = Z*inv(Y)*Z', +% +% eqn.type = 'N' +% A*X*E' + E*X*A' - E*X*C'*C*X*E' + B*B' = 0 +% or +% A*X*E' + E*X*A' - E*X*C'*Q\C*X*E' + B*R*B' = 0 +% +% eqn.type = 'T' +% A'*X*E + E'*X*A - E'*X*B*B'*X*E + C'*C = 0 +% or +% A'*X*E + E'*X*A - E'*X*B*R\B'*X*E + C'*Q*C = 0 +% +% Matrix A can have the form A = à + U*V' if U (eqn.U) and V (eqn.V) are +% provided U and V are dense (n x m3) matrices and should satisfy m3 << n +% +% Input/Output +% eqn struct contains data for equations +% +% opts struct contains parameters for the algorithm +% +% oper struct contains function handles for operation +% with A and E +% +% Output +% out struct containing solutions and output information +% +% Input fields in struct eqn: +% eqn.B dense (n x m1) matrix B +% +% eqn.C dense (m2 x n) matrix C +% +% eqn.R dense symmetric and invertible (m1 x m1) matrix +% (required for LDL^T formulation) +% +% eqn.Q dense symmetric (m2 x m2) matrix +% (required for LDL^T formulation) +% +% eqn.U dense (n x m3) matrix U +% (optional, required if eqn.V is present) +% +% eqn.V dense (n x m3) matrix V +% (optional, required if eqn.U is present) +% +% eqn.type possible values: 'N', 'T' +% determining whether (N) or (T) is solved +% (optional, default 'N') +% +% eqn.haveE possible values: false, true +% if haveE = false: matrix E in eqn.E_ is assumed to be identity +% (optional, default 0) +% +% eqn.haveUV possible values: false, true +% if haveUV = true: U = [U1, U2] and V = [V1, V2] +% if K or DeltaK are accumulated during the iteration they +% use only U2 and V2. U1 and V1 can be used for an external +% rank-k update of the operator. +% The size of U1 and V1 can be given via eqn.sizeUV1. +% (optional, default: false) +% +% eqn.sizeUV1 possible values: nonnegative integer +% if a stabilizing feedback is given via U = [U1, U2] and +% V = [V1, V2] in U2 or V2, eqn.widthU1 indicates how +% many beginning columns of U and V does not be +% (optional, default: size(eqn.U, 2)) +% +% Depending on the operator chosen by the operatormanager, additional +% fields may be needed. For the "default", e.g., eqn.A_ and eqn.E_ hold +% the A and E matrices. For the second order types these are given +% implicitly by the M, D, K matrices stored in eqn.M_, eqn.E_ and eqn.K_, +% respectively. +% +% Input fields in struct opts: +% opts.LDL_T possible values: false, true +% use LDL^T formulation for the RHS and +% solution +% (optional, default: false) +% +% opts.norm possible values: 2, 'fro' +% use 2-norm (2) or Frobenius norm ('fro') to +% compute residual and relative change norms +% in case projection is used +% (opts.nm.projection.freq > 0) norm will +% automatically be set to 2 +% (optional, default: 'fro') +% +% opts.radi.Z0 possible values: dense (n x m4) matrix +% initial stabilizing solution factor +% X0 = Z0*inv(Y0)*Z0', this factor has to +% result in a positive semi-definite Riccati +% residual W0 +% (optional, default: zeros(n, m4)) +% +% opts.radi.Y0 possible values: dense (m4 x m4) matrix +% initial stabilizing solution factor +% X0 = Z0*inv(Y0)*Z0', this factor has to +% result in a positive semi-definite +% Riccati residual W0 +% (optional, default: eye(m4)) +% +% opts.radi.W0 possible values: dense (n x m5) matrix +% initial Riccati residual factor such that +% R(X0) = W0 * W0', if +% opts.radi.compute_res = true, this factor is +% computed out of Z0 and Y0 +% Note: In case of Bernoulli stabilization +% the W0 is given by the right hand-side C' +% for 'T' and B for 'N' and is automatically +% set if opts.radi.compute_res = false +% (optional, default: C' for 'T' or B for +% 'N') +% +% opts.radi.T0 possible values: dense (m5 x m5) matrix +% initial Riccati residual factor such that +% R(X0) = W0 * T0 * W0', if +% opts.radi.compute_res = true, this factor is +% computed out of Z0 and Y0 +% (required for LDL^T formulation if +% opts.radi.W0 was explicitly set) +% +% opts.radi.K0 possible values: dense 'T': (m1 x n) +% matrix, 'N': (m2 x n) matrix +% initial K (corresponding to Z0 and Y0) +% Note: If K0 is given without Z0, only the +% resulting stabilizing feedback is computed. +% Also it has to correspond to W0. +% (optional, default: E*Z0*inv(Y0)*Z0'*C' for +% 'N' or E'*Z0*inv(Y0)*Z0'*B for 'T') +% +% opts.radi.compute_sol_fac possible values: false, true +% turn on (true) or off (false) to compute the +% solution of the Riccati equation and use it +% internally for computations, or only +% the stabilizing feedback +% (optional, default: true) +% +% opts.radi.get_ZZt possible values: false, true +% turn on (true) or off (false) to compute only +% the low-rank decomposition X = Z*Z' +% without the middle term Y +% (optional, default: true) +% +% opts.radi.compute_res possible values: false, true +% turn on (1) or off (0) to compute the +% residual corresponding to the initial +% solution factors Z0, Y0, if 0 then the +% right hand-side is used as residual if +% there is no W0 +% (optional, default: true) +% +% opts.radi.maxiter possible values: integer > 0 +% maximum RADI iteration number +% (optional, default: 100) +% +% opts.radi.res_tol possible values: scalar >= 0 +% stopping tolerance for the relative +% RADI residual norm; if res_tol = 0 the +% relative residual norm is not evaluated +% (optional, default: 0) +% +% opts.radi.rel_diff_tol possible values: scalar >= 0 +% stopping tolerance for the relative +% change of the RADI solution Z; +% if res_tol = 0 the relative +% change is not evaluated +% (optional, default: 0) +% +% opts.norm possible values: 2, 'fro' +% use 2-norm (2) or Frobenius norm ('fro') to +% compute residual and relative change norms; +% must be the same as opts.norm +% (optional, default: 'fro') +% +% opts.radi.info possible values: 0, 1 +% turn on (1) or off (0) the status output in +% every RADI iteration step +% (optional, default: 0) +% +% opts.radi.trunc_tol possible values: scalar > 0 +% tolerance for rank truncation of the +% low-rank solutions (aka column compression) +% (optional, default: eps*n) +% +% opts.radi.trunc_info possible values: 0, 1 +% verbose mode for column compression +% (optional, default: 0) +% +% opts.shifts.method possible values: +% 'precomputed', +% 'penzl','heur', (basic MMESS routine) +% 'projection' (basic MMESS routine) +% 'gen-ham-opti' (special for RADI) +% method for shift computation +% (optional, default: 'gen-ham-opti') +% +% opts.shifts.history possible values: integer * size(W0, 2) > 0 +% parameter for accumulating the history +% of shift computations +% (optional, default: 6 * columns of +% residual) +% +% opts.shifts.info possible values: 0, 1 +% turn output of used shifts before the first +% iteration step on (1) or off (0) +% (optional, default: 0) +% +% +% If optional input arguments are missing they may be set to default values +% and a 'MESS:control_data' warning is printed. To turn warnings off use +% warning('OFF', 'MESS:control_data'). +% +% The feedback matrix K can be accumulated during the iteration: +% eqn.type = 'N' -> K = (E*X*C')' or K = (E*X*C)'/Q +% eqn.type = 'T' -> K = (E'*X*B)' or K = (E'*X*B)'/R +% +% +% Output fields in struct out: +% out.Z low rank solution factor, the solution is +% opts.radi.get_ZZt = false: X = Z*inv(Y)*Z' +% opts.radi.get_ZZt = true: X = Z*Z' +% (opts.radi.compute_sol_fac = true and not only initial K0) +% +% out.Y small square solution factor, the solution is +% opts.radi.get_ZZt = false: X = Z*inv(Y)*Z' +% (opts.radi.compute_sol_fac = true and not only initial K0) +% +% out.D solution factor for LDL^T formulation, the solution is +% opts.LDL_T = true: X = Z*D*Z' +% (opts.LDL_T = true) +% +% out.K stabilizing Feedback matrix +% +% out.timesh time of the overall shift computation +% +% out.p used shifts +% +% out.niter number of RADI iterations +% +% out.res array of relative RADI residual norms +% (opts.radi.res_tol nonzero) +% +% out.rc array of relative RADI change norms +% (opts.radi.rel_diff_tol nonzero) +% +% out.res_fact final Riccati residual factor W of the iteration +% +% out.res0 norm of the normalization residual term +% +% +% uses operator functions init and mul_E, mul_E_pre, mul_E_post, +% mul_A, mul_A_pre, mul_A_post, init_res_pre, init_res, init_res_post, +% size directly and further indirectly +% +% References: +% [1] P. Benner, Z. Bujanović, P. Kürschner, J. Saak, RADI: A low-rank +% ADI-type algorithm for large scale algebraic Riccati equations, +% Numer. Math. 138 (2) (2018) 301–330. +% https://doi.org/10.1007/s00211-017-0907-5. +% +% See also mess_lrradi_get_shifts, operatormanager. + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Check system data +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if not(isfield(eqn, 'haveE')) + eqn.haveE = false; +end + +[result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A', 'E'); +if not(result) + mess_err(opts, 'control_data', ... + 'system data is not completely defined or corrupted'); +end + +if not(isfield(eqn, 'B')) || not(isnumeric(eqn.B)) + mess_err(opts, 'control_data', 'eqn.B is not defined or corrupted'); +end + +if not(isfield(eqn, 'C')) || not(isnumeric(eqn.C)) + mess_err(opts, 'control_data', 'eqn.C is not defined or corrupted'); +end + +% Make sure the first right hand side is dense so that the resulting factor +% is densely stored. +if issparse(eqn.C) + eqn.C = full(eqn.C); +end + +if issparse(eqn.B) + eqn.B = full(eqn.B); +end + +if not(isfield(eqn, 'type')) + eqn.type = 'N'; + mess_warn(opts, 'control_data', ... + ['Unable to determine type of equation.'... + 'Falling back to type ''N''']); +elseif not(eqn.type == 'N') && not(eqn.type == 'T') + mess_err(opts, 'equation_type', ... + 'Equation type must be either ''T'' or ''N'''); +end + +if not(isfield(opts, 'LDL_T')) + opts.LDL_T = false; +end + +if opts.LDL_T + if not(isfield(eqn, 'R')) || not(isnumeric(eqn.R)) || ... + not(isfield(eqn, 'Q')) || not(isnumeric(eqn.Q)) + mess_err(opts, 'control_data', ... + 'eqn.Q or eqn.R is undefined or corrupted'); + end +end + +if eqn.type == 'T' + m = size(eqn.B, 2); % number of inputs + eqn.BB = eqn.B; % set quadratic term + if opts.LDL_T + eqn.RR = eqn.R; + eqn.QQ = eqn.Q; + end + eqn.CC = eqn.C'; % set right hand side +else + m = size(eqn.C, 1); % number of outputs + eqn.BB = eqn.C'; % set quadratic term + if opts.LDL_T + eqn.RR = eqn.Q; + eqn.QQ = eqn.R; + end + eqn.CC = eqn.B; % set right hand side +end + +% Some helpful recurring matrices +Im = eye(m); +if opts.LDL_T + invR = mess_symmetrize(eqn.RR \ Im); +end +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Rank-k update system data. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if not(isfield(eqn, 'haveUV')) || isempty(eqn.haveUV) || not(eqn.haveUV) + eqn.haveUV = false; + eqn.sizeUV1 = 0; + eqn.U = []; + eqn.V = []; +else + if opts.LDL_T + mess_err(opts, 'control_data', ... + ['LDL_T formulation with eqn.haveUV == ''True'' is not ', ... + 'yet implemented.']); + end + + if isnumeric(eqn.U) && isnumeric(eqn.V) && ... + size(eqn.U, 1) == size(eqn.V, 1) && size(eqn.U, 2) == size(eqn.V, 2) + + if issparse(eqn.V) + eqn.V = full(eqn.V); + end + if issparse(eqn.U) + eqn.U = full(eqn.U); + end + else + mess_err(opts, 'control_data', ... + ['Inappropriate data of low-rank updated operator ', ... + '(eqn.U and eqn.V)']); + end +end + +% Check for size of constant term in U and V. +if eqn.haveUV + if not(isfield(eqn, 'sizeUV1')) || isempty(eqn.sizeUV1) + eqn.sizeUV1 = size(eqn.U, 2); + else + mess_assert(opts, isnumeric(eqn.sizeUV1) && (eqn.sizeUV1 <= size(eqn.U, 2)), ... + 'control_data', ... + ['Inappropriate size of low-rank updated operator ', ... + '(eqn.U and eqn.V)']); + end +end + +% Define index ranges for sub-indexing the original U and V columns coming from +% the user and the additional feedback columns we add for the Algorithm (see +% initialization just below) in eqn.U and eqn.V +UVcols = 1:eqn.sizeUV1; +K_cols = eqn.sizeUV1 + 1:eqn.sizeUV1 + m; + +% Initialize storage for the computed feedback. +if eqn.type == 'T' + eqn.U = [eqn.U(:, UVcols), -eqn.B]; + eqn.V = [eqn.V(:, UVcols), zeros(size(eqn.B))]; +else + eqn.U = [eqn.U(:, UVcols), zeros(size(eqn.C, 2), size(eqn.C, 1))]; + eqn.V = [eqn.V(:, UVcols), -eqn.C']; +end + +eqn.haveUV = true; + +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Initialize required usf for multiplications +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if eqn.haveE + [eqn, opts, oper] = oper.mul_E_pre(eqn, opts, oper); +end + +[eqn, opts, oper] = oper.mul_A_pre(eqn, opts, oper); + +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Check for RADI Control structure in options +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if not(isfield(opts, 'radi')) || not(isstruct(opts.radi)) + mess_err(opts, 'control_data', ['No radi control data found in ', ... + 'options structure.']); +end + +% Check computation of Riccati solution. +if not(isfield(opts.radi, 'compute_sol_fac')) || ... + isempty(opts.radi.compute_sol_fac) + opts.radi.compute_sol_fac = true; +end + +% Check format of output solution. +if not(isfield(opts.radi, 'get_ZZt')) || isempty(opts.radi.get_ZZt) + opts.radi.get_ZZt = true; +end + +% Check for residual norm. +if not(isfield(opts, 'norm')) || ... + (not(strcmp(opts.norm, 'fro')) && ... + (not(isnumeric(opts.norm)) || not(opts.norm == 2))) + mess_warn(opts, 'control_data', ... + ['Missing or Corrupted opts.norm field.', ... + 'Switching to default: ''fro''']); + opts.norm = 'fro'; +end + +if not(isfield(opts.radi, 'trunc_tol')) + opts.radi.trunc_tol = eps * oper.size(eqn, opts); +end + +if not(isfield(opts.radi, 'trunc_info')) + opts.radi.trunc_info = 0; +end + +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% List all currently unsupported options +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if isfield(opts, 'bdf') && not(isempty(opts.bdf)) + mess_err(opts, 'control_data', 'Options bdf not supported.'); +end + +if isfield(opts, 'rosenbrock') && not(isempty(opts.rosenbrock)) + mess_err(opts, 'control_data', 'Options rosenbrock not supported.'); +end + +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Check for initial values +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Initialize projected residual factor in case of DAE +% oper.init_res assumes that opts.LDL_T is defined. +[eqn, opts, oper] = oper.init_res_pre(eqn, opts, oper); + +onlyK = false; +hasZ0 = isfield(opts.radi, 'Z0') && not(isempty(opts.radi.Z0)); +hasY0 = isfield(opts.radi, 'Y0') && not(isempty(opts.radi.Y0)); +hasW0 = isfield(opts.radi, 'W0') && not(isempty(opts.radi.W0)); +hasT0 = isfield(opts.radi, 'T0') && not(isempty(opts.radi.T0)); +hasK0 = isfield(opts.radi, 'K0') && not(isempty(opts.radi.K0)); + +if hasZ0 + % Stabilizing initial solution. + Z = opts.radi.Z0; + nZ0 = size(Z, 2); + + % Initial middle term. + if hasY0 + Y = opts.radi.Y0; + else + Y = eye(size(Z, 2)); + end + + % Check for residual computation option. + if not(isfield(opts.radi, 'compute_res')) || isempty(opts.radi.compute_res) + mess_warn(opts, 'control_data', ... + ['Missing or Corrupted opts.radi.compute_res field.', ... + 'Switching to default: 1']); + opts.radi.compute_res = true; + end + + % Initial residual. + if hasW0 + % Case: Initial residual is given. + W = opts.radi.W0; + if opts.LDL_T + mess_assert(opts, hasT0, ... + 'control_data', ... + 'Missing or corrupted opts.radi.T0 field.'); + eqn.T = opts.radi.T0; + end + + elseif opts.radi.compute_res + % Case: Initial residual has to be computed. + AZ = oper.mul_A(eqn, opts, eqn.type, Z, 'N'); + + if eqn.haveE + EZ = oper.mul_E(eqn, opts, eqn.type, Z, 'N'); + else + EZ = Z; + end + + if eqn.sizeUV1 + if eqn.type == 'T' + UU = eqn.V(:, UVcols); + VV = EZ * (Y \ (Z' * eqn.U(:, UVcols))); + else + UU = eqn.U(:, UVcols); + VV = EZ * (Y \ (Z' * eqn.V(:, UVcols))); + end + UDV = [zeros(eqn.sizeUV1), eye(eqn.sizeUV1); ... + eye(eqn.sizeUV1), zeros(eqn.sizeUV1)]; + else + UU = []; + VV = []; + UDV = []; + end + + Yinv = mess_symmetrize(Y \ eye(size(Y))); + OY = zeros(size(Y)); + + if opts.LDL_T + D0 = blkdiag([OY, Yinv; Yinv, OY], ... + UDV, -invR, ... + eqn.QQ); + else + D0 = blkdiag([OY, Yinv; Yinv, OY], ... + UDV, -Im, ... + eye(size(eqn.CC, 2))); + end + + G = [AZ, EZ, UU, VV, EZ * (Y \ (Z' * eqn.BB)), eqn.CC]; + [G, S] = mess_column_compression(G, 'N', D0, ... + opts.radi.trunc_tol, ... + opts.radi.trunc_info); + + if opts.LDL_T || not(all(diag(S) > 0)) + if not(opts.LDL_T) + mess_warn(opts, 'control_data', ... + ['The initial residual is indefinite, ' ... + 'changing to LDL^T approach!']); + opts.LDL_T = true; + end + + W = G; + eqn.T = S; + else + W = G * diag(sqrt(diag(S))); + end + + else + % Case: Initial residual is given as right hand-side (Bernoulli). + W = eqn.CC; + if opts.LDL_T + eqn.T = eqn.QQ; + end + end + + % Initial stabilizing feedback. + if eqn.type == 'T' + if isfield(opts.radi, 'K0') && not(isempty(opts.radi.K0)) + eqn.V(:, K_cols) = opts.radi.K0'; + else + if eqn.haveE + eqn.V(:, K_cols) = ... + oper.mul_E(eqn, opts, 'T', Z, 'N') * ... + (Y \ (Z' * eqn.B)); + else + eqn.V(:, K_cols) = Z * (Y \ (Z' * eqn.B)); + end + if opts.LDL_T + eqn.V(:, K_cols) = eqn.V(:, K_cols) / eqn.RR; + end + end + else + if isfield(opts.radi, 'K0') && not(isempty(opts.radi.K0)) + eqn.U(:, K_cols) = opts.radi.K0'; + else + if eqn.haveE + eqn.U(:, K_cols) = ... + oper.mul_E(eqn, opts, 'N', Z, 'N') * ... + (Y \ (Z' * eqn.C')); + else + eqn.U(:, K_cols) = Z * (Y \ (Z' * eqn.C')); + end + if opts.LDL_T + eqn.U(:, K_cols) = eqn.U(:, K_cols) / eqn.RR; + end + end + end + +elseif hasK0 + % Stabilizing initial feedback. + if eqn.type == 'T' + eqn.V(:, K_cols) = opts.radi.K0'; + else + eqn.U(:, K_cols) = opts.radi.K0'; + end + + % Assign the corresponding residual. + if hasW0 + W = opts.radi.W0; + + if opts.LDL_T + mess_assert(opts, hasT0, ... + 'control_data', ... + 'Missing or corrupted opts.radi.T0 field.'); + eqn.T = opts.radi.T0; + + end + else + + W = eqn.CC; + + if opts.LDL_T + eqn.T = eqn.QQ; + end + end + + % Other initial values. + Z = zeros(oper.size(eqn, opts), 0); + nZ0 = 0; + Y = []; + onlyK = true; +else + % Start with zero initial solution. + Z = zeros(oper.size(eqn, opts), 0); + nZ0 = 0; + Y = []; + + W = eqn.CC; + if opts.LDL_T + eqn.T = eqn.QQ; + end + +end + +if opts.LDL_T + [W, res0, eqn, opts, oper] = oper.init_res(eqn, opts, oper, W, eqn.T); +else + [W, res0, eqn, opts, oper] = oper.init_res(eqn, opts, oper, W); +end +p = size(W, 2); % size of residual factor. +Ip = eye(p); + +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Check for shift parameter structure +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if not(isfield(opts, 'shifts')) || not(isstruct(opts.shifts)) + mess_err(opts, 'control_data', ... + 'shift parameter control structure missing.'); +end + +% Default shift method settings. +if not(isfield(opts, 'shifts')) || ... + not(isstruct(opts.shifts)) || ... + not(isfield(opts.shifts, 'method')) + + mess_warn(opts, 'control_data', ... + ['shift parameter control structure missing.', ... + 'Switching to default: method = gen-ham-opti, history = 6.']); + + opts.shifts.method = 'gen-ham-opti'; +end + +% Check for shift history parameter. +if not(isfield(opts.shifts, 'history')) || isempty(opts.shifts.history) + opts.shifts.history = 6 * p; +end + +% Use heuristic penzl shifts routines from MMESS. +if strcmp(opts.shifts.method, 'penzl') || ... + strcmp(opts.shifts.method, 'heur') || ... + strcmp(opts.shifts.method, 'projection') + + if not(isfield(opts.shifts, 'num_desired')) + opts.shifts.num_desired = opts.shifts.history; + end + + if strcmp(opts.shifts.method, 'penzl') || ... + strcmp(opts.shifts.method, 'heur') + + if not(isfield(opts.shifts, 'num_Ritz')) + opts.shifts.num_Ritz = opts.shifts.history + 1; + end + + if not(isfield(opts.shifts, 'num_hRitz')) + opts.shifts.num_hRitz = opts.shifts.history; + end + end +end + +% Use provided shifts. +if strcmp(opts.shifts.method, 'precomputed') + if not((isfield(opts.shifts, 'p')) && ... + isnumeric(opts.shifts.p) && ... + isvector(opts.shifts.p)) + + mess_err(opts, 'shifts', ... + 'Found empty shift vector. Please provide proper shifts.'); + else + illegal_shifts = false; + + % Check if all shifts are in the open left half plane + if any(not(real(opts.shifts.p) < 0)) + illegal_shifts = true; + end + + % Check if complex pairs of shifts are properly ordered. + k = 1; + while k <= length(opts.shifts.p) + if not(isreal(opts.shifts.p(k))) + if not(opts.shifts.p(k + 1) == conj(opts.shifts.p(k))) + illegal_shifts = true; + end + k = k + 1; + end + k = k + 1; + end + + if illegal_shifts + mess_err(opts, 'shifts', 'Improper shift vector detected!'); + end + end +else + % If the shifts are not precomputed, let the shift array initially be + % empty. + opts.shifts.p = []; +end + +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Check info parameter for output verbosity +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if not(isfield(opts.radi, 'info')) + opts.radi.info = 0; +else + if not(isnumeric(opts.radi.info)) && not(islogical(opts.radi.info)) + mess_err(opts, 'inputs', ... + 'opts.radi.info parameter must be logical or numeric.'); + end +end + +if not(isfield(opts.shifts, 'info')) + opts.shifts.info = 0; +else + if not(isnumeric(opts.shifts.info)) && not(islogical(opts.shifts.info)) + mess_err(opts, 'inputs', ... + 'opts.shifts.info parameter must be logical or numeric.'); + end +end + +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Check stopping parameters +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if not(isfield(opts.radi, 'maxiter')) || not(isnumeric(opts.radi.maxiter)) + mess_warn(opts, 'control_data', ... + ['Missing or Corrupted opts.radi.maxiter field.', ... + 'Switching to default: 100']); + opts.radi.maxiter = 100; +end + +if not(isfield(opts.radi, 'rel_diff_tol')) || not(isnumeric(opts.radi.rel_diff_tol)) + mess_warn(opts, 'control_data', ... + ['Missing or Corrupted opts.radi.rel_diff_tol field.', ... + 'Switching to default: 0']); + opts.radi.rel_diff_tol = 0; +end + +if opts.radi.rel_diff_tol + nrmZ = sum(sum(Z.^2)); +end + +if not(isfield(opts.radi, 'res_tol')) || not(isnumeric(opts.radi.res_tol)) + mess_warn(opts, 'control_data', ... + ['Missing or Corrupted opts.radi.res_tol field.', ... + 'Switching to default: 0']); + opts.radi.res_tol = 0; +end + +% Check if the low-rank factor Z needs to be computed entirely. +maxcolZ = (opts.radi.maxiter + 1) * p + nZ0; +opts.radi.compute_sol_facpart = 0; + +if (strcmp(opts.shifts.method, 'gen-ham-opti') || ... + strcmp(opts.shifts.method, 'projection')) && ... + not(opts.radi.compute_sol_fac) + + opts.radi.compute_sol_facpart = 1; + maxcolZ = opts.shifts.history; +end + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% +% All checks done. Here comes the real work! +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Initialize data +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if opts.radi.res_tol + res = zeros(1, opts.radi.maxiter); +else + res = []; +end + +if opts.radi.rel_diff_tol + rc = zeros(1, opts.radi.maxiter); +else + rc = []; +end + +% Get relevant sizes of right hand side and shift vector. +nShifts = length(opts.shifts.p); + +if opts.shifts.info % print shifts + mess_fprintf(opts, 'RADI Shifts:\n'); + for lp = 1:length(opts.shifts.p) + mess_fprintf(opts, '%e\n', opts.shifts.p(lp)); + end +end + +% Reset the timer. +out.timesh = 0; + +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Start iteration +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +k = 1; +k_shift = 1; + +while k < (opts.radi.maxiter + 1) + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + % check whether shifts need to be updated + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + if k_shift > nShifts + k_shift = 1; + tsh = tic; + + [eqn, opts, oper, nShifts] = ... + mess_lrradi_get_shifts(eqn, opts, oper, W, Z, Y); + + timesh = toc(tsh); + out.timesh = out.timesh + timesh; + + if opts.shifts.info % print shifts + mess_fprintf(opts, 'RADI Shifts:\n'); + for lp = 1:length(opts.shifts.p) + mess_fprintf(opts, '%e\n', opts.shifts.p(lp)); + end + end + end + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + % get current shift + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + pc = opts.shifts.p(k_shift); + out.p(k) = pc; + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + % perform the actual step computations + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + [V, eqn, opts, oper] = mess_solve_shifted_system(eqn, opts, oper, pc, W); + + if opts.LDL_T + V = V * eqn.T; + end + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + % update low-rank solution factor + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + if isreal(pc) + % The shift pc is real. Only perform a single step of the method. + V = real(V); + VtB = V' * eqn.BB; + + if opts.LDL_T + Y_new = eqn.T + VtB * (invR * VtB'); + else + Y_new = Ip + VtB * VtB'; + end + + if opts.radi.compute_sol_fac || opts.radi.compute_sol_facpart + % Only store part of Z used for shift generation. + nZ = size(Z, 2); + % Expand the Z matrix. + if opts.radi.compute_sol_facpart + ind = max(nZ - maxcolZ + p, 0) + 1:max(min(maxcolZ, nZ), 0); + Z(:, 1:min(maxcolZ, k * p + nZ0)) = ... + [Z(:, ind), sqrt(-2.0 * pc) * V]; + else + Z(:, nZ + 1:nZ + p) = sqrt(-2.0 * pc) * V; + end + + if opts.radi.compute_sol_fac + Y = blkdiag(Y, Y_new); + end + end + + % Update the low-rank residual factor W. + VY_newi = -2.0 * pc * (V / Y_new); + if eqn.haveE + VY_newi = oper.mul_E(eqn, opts, eqn.type, VY_newi, 'N'); + end + W = W + VY_newi; + + if opts.LDL_T + VtB = VtB / eqn.RR; + end + % Update the K matrix. + if eqn.type == 'T' + eqn.V(:, K_cols) = eqn.V(:, K_cols) + VY_newi * VtB; + else + eqn.U(:, K_cols) = eqn.U(:, K_cols) + VY_newi * VtB; + end + else + % The shift pc is complex. + % Perform a double step with the known solution for the conjugate + % shift. + V1 = sqrt(-2.0 * real(pc)) * real(V); + V2 = sqrt(-2.0 * real(pc)) * imag(V); + + % Some auxiliary matrices. + Vr = V1' * eqn.BB; + Vi = V2' * eqn.BB; + + % Compute the new parts of low-rank approximate solution. + sr = real(pc); + si = imag(pc); + sa = abs(pc); + + AA = [-sr / sa * Vr - si / sa * Vi; ... + si / sa * Vr - sr / sa * Vi]; + BB = [Vr; Vi]; + CC = [si / sa * Ip; ... + sr / sa * Ip]; + + if opts.LDL_T + Y_new = blkdiag(eqn.T, 1 / 2 * eqn.T) - ... + 1 / (4 * sr) * (AA * (invR * AA')) - ... + 1 / (4 * sr) * (BB * (invR * BB')) - ... + 1 / 2 * (CC * (eqn.T * CC')); + else + Y_new = blkdiag(Ip, 1 / 2 * Ip) - ... + 1 / (4 * sr) * (AA * AA') - ... + 1 / (4 * sr) * (BB * BB') - ... + 1 / 2 * (CC * CC'); + end + + if opts.radi.compute_sol_fac || opts.radi.compute_sol_facpart + % Only store part of Z used for shift generation. + nZ = size(Z, 2); + % Expand the Z matrix. Z = [Z, V1, V2]; + if opts.radi.compute_sol_facpart + ind = max(nZ - maxcolZ + 2 * p, 0) + ... + 1:max(min(maxcolZ, nZ), 0); + Z(:, 1:min(maxcolZ, (k + 1) * p + nZ0)) = ... + [Z(:, ind), V1, V2]; + else + Z(:, nZ + 1:nZ + 2 * p) = [V1, V2]; + end + + if opts.radi.compute_sol_fac + Y = blkdiag(Y, Y_new); + end + end + + % Update the low-rank residual factor W. + VY_newi = [V1, V2] / Y_new; + if eqn.haveE + VY_newi = oper.mul_E(eqn, opts, eqn.type, VY_newi, 'N'); + end + + W = W + sqrt(-2.0 * sr) * VY_newi(:, 1:p); + + % Update the K matrix. + if opts.LDL_T + Vr = Vr / eqn.RR; + Vi = Vi / eqn.RR; + end + if eqn.type == 'T' + eqn.V(:, K_cols) = eqn.V(:, K_cols) + VY_newi * [Vr; Vi]; + else + eqn.U(:, K_cols) = eqn.U(:, K_cols) + VY_newi * [Vr; Vi]; + end + + % Forward the indices in the loop. + k = k + 1; + k_shift = k_shift + 1; + + if k > 2 + res(k - 1) = res(k - 2); + else + res(k - 1) = 1; + end + out.p(k) = conj(pc); + end + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + % Compute stopping criteria + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + if opts.radi.res_tol + % Low-rank residual norm computation. + if opts.LDL_T + res(k) = riccati_LR(W, [], opts, eqn.T, []) / res0; + else + res(k) = riccati_LR(W, [], opts, [], []) / res0; + end + end + + if opts.radi.rel_diff_tol + if isreal(pc) + nrmV = -2.0 * pc * sum(sum(V.^2)); + else + % Complex double step means 2 blocks added. + nrmV = sum(sum([V1, V2].^2)); + end + nrmZ = nrmZ + nrmV; + rc(k) = sqrt(nrmV / nrmZ); + end + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + % print status information + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + if opts.radi.info + if opts.radi.rel_diff_tol && opts.radi.res_tol + mess_fprintf(opts, ... + ['RADI step: %4d pc: %e + %ei normalized ' ... + 'residual: %e relative change in Z: %e\n'], ... + k, real(pc), imag(pc), res(k), rc(k)); + elseif opts.radi.res_tol + mess_fprintf(opts, ... + 'RADI step: %4d normalized residual: %e\n', ... + k, res(k)); + elseif opts.radi.rel_diff_tol + mess_fprintf(opts, ... + 'RADI step: %4d relative change in Z: %e\n', ... + k, rc(k)); + end + end + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + % Evaluate stopping criteria + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + if res(k) < opts.radi.res_tol + break + end + + k = k + 1; + k_shift = k_shift + 1; +end + +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Prepare output arguments +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +out.niter = k - (k > opts.radi.maxiter); + +if opts.radi.res_tol + out.res = res(1:out.niter); +end + +% warn the user if we have stopped before reaching the desired accuracy. +% note the >= as with a double step for complex shift pair we may actually +% reach maxiter+1. +if (out.niter >= opts.radi.maxiter) && ... + not(out.res(end) < opts.radi.res_tol) + + mess_warn(opts, 'convergence', ... + ['LR-RADI was stopped by the maximum iteration count.', ... + ' Results may be inaccurate.']); +end + +if opts.radi.rel_diff_tol + out.rc = rc(1:out.niter); +end + +out.res_fact = W; + +if eqn.type == 'T' + out.K = eqn.V(:, K_cols)'; +else + out.K = eqn.U(:, K_cols)'; +end + +if opts.radi.compute_sol_fac && not(onlyK) + + if opts.radi.get_ZZt && not(opts.LDL_T) + R = chol(Y); + out.Z = mess_column_compression(Z / R, 'N', [], ... + opts.radi.trunc_tol, ... + opts.radi.trunc_info); + elseif opts.LDL_T + Yinv = Y \ eye(size(Y, 1)); + Yinv = 0.5 * (Yinv + Yinv'); + [out.Z, out.D] = mess_column_compression(Z, 'N', Yinv, ... + opts.radi.trunc_tol, ... + opts.radi.trunc_info); + out.Y = out.D \ eye(size(out.D, 1)); + else + out.Z = Z; + out.Y = Y; + end +end + +out.res0 = res0; + +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Clean up +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if (size(eqn.V, 2) > eqn.sizeUV1) || (size(eqn.U, 2) > eqn.sizeUV1) + % Cut off the stabilizing feedback. + eqn.V = eqn.V(:, UVcols); + eqn.U = eqn.U(:, UVcols); +end + +if isempty(eqn.V) || isempty(eqn.U) + % Enforce empty matrices and parameters. + eqn.U = []; + eqn.V = []; + eqn.haveUV = false; + eqn.sizeUV1 = 0; +end + +% Delete short cuts for right hand-side and quadratic term. +eqn = rmfield(eqn, 'BB'); +eqn = rmfield(eqn, 'CC'); +if opts.LDL_T + eqn = rmfield(eqn, 'RR'); + eqn = rmfield(eqn, 'T'); +end + +if isfield(opts.shifts, 'tmp') + opts.shifts = rmfield(opts.shifts, 'tmp'); +end + +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Finalize required usfs +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if eqn.haveE + [eqn, opts, oper] = oper.mul_E_post(eqn, opts, oper); +end + +[eqn, opts, oper] = oper.mul_A_post(eqn, opts, oper); +[eqn, opts, oper] = oper.init_res_post(eqn, opts, oper); diff --git a/mat-eqn-solvers/mess_lrri.m b/mat-eqn-solvers/mess_lrri.m index 3793204..5687802 100644 --- a/mat-eqn-solvers/mess_lrri.m +++ b/mat-eqn-solvers/mess_lrri.m @@ -48,17 +48,17 @@ % determining whether (N) or (T) is solved % (optional, default 'N') % -% eqn.haveE possible values: 0, 1, false, true -% if haveE = 0: matrix E in eqn.E_ is assumed to be identity -% (optional, default 0) +% eqn.haveE possible values: false, true +% if haveE = false: matrix E in eqn.E_ is assumed to be identity +% (optional, default false) % -% eqn.haveUV possible values: 0, 1, false, true -% if haveUV = 1: U = [U1, U2] and V = [V1, V2] +% eqn.haveUV possible values: false, true +% if haveUV = true: U = [U1, U2] and V = [V1, V2] % if K or DeltaK are accumulated during the iteration they % use only U2 and V2. U1 and V1 can be used for an external % rank-k update of the operator. % The size of U1 and V1 can be given via eqn.sizeUV1. -% (optional, default: 0) +% (optional, default: false) % % eqn.sizeUV1 possible values: nonnegative integer % if a stabilizing feedback is given via U = [U1, U2] and @@ -120,31 +120,31 @@ % maximum Riccati iteration number % (optional, default: 10) % -% opts.ri.info possible values: 0, 1, false, true +% opts.ri.info possible values: 0, 1 % turn on (1) or off (0) the status output in % every Riccati iteration step % (optional, default: 0) % -% opts.ri.store_lqg possible values: 0, 1, false, true +% opts.ri.store_lqg possible values: false, true % if turned on (1) the solution of the LQG % Riccati equation is stored in out.Z_LQG % and the corresponding feedback in out.K_LQG -% (optional, default: 0) +% (optional, default: false) % -% opts.ri.store_solfac possible values: 0, 1, false, true +% opts.ri.store_solfac possible values: false, true % if turned on (1) the solution factors % computed by the Riccati equation solvers % are stored in the out.nm and out.radi % structures, otherwise only the information % about the iteration are stored -% (optional, default: 0) +% (optional, default: false) % % opts.ri.trunc_tol possible values: scalar > 0 % tolerance for rank truncation of the % low-rank solutions (aka column compression) % (optional, default: eps*n) % -% opts.ri.trunc_info possible values: 0, 1, false, true +% opts.ri.trunc_info possible values: 0, 1 % verbose mode for column compression % (optional, default: 0) % @@ -156,25 +156,25 @@ % % Output fields in struct out: % -% out.Z low rank solution factor, the solution is X = Z*Z' +% out.Z low-rank solution factor, the solution is X = Z*Z' % % out.K stabilizing feedback matrix % -% out.Z_LQG low rank solution factor of the corresponding LQG +% out.Z_LQG low-rank solution factor of the corresponding LQG % problem -% (opts.ri.store_lqg = 1) +% (opts.ri.store_lqg = true) % % out.K_LQG stabilizing feedback matrix of the corresponding LQG % problem -% (opts.ri.store_lqg = 1) +% (opts.ri.store_lqg = true) % % out.niter number of Riccati iteration steps % % out.res array of relative Riccati iteration residual norms -% (opts.ri.res_tol ~= 0) +% (opts.ri.res_tol nonzero) % % out.rc array of relative Riccati iteration change norms -% (opts.ri.rel_diff_tol ~= 0) +% (opts.ri.rel_diff_tol nonzero) % % out.res0 norm of the normalization residual term % @@ -186,70 +186,83 @@ % uses operator functions init and mul_E, mul_E_pre, mul_E_post % and further indirectly in the inner Riccati solver % +% References: +% [1] P. Benner, J. Heiland, and S. W. R. Werner, A low-rank solution +% method for Riccati equations with indefinite quadratic terms, +% Numer. Algorithms, 92(2):1083-1103, 2023. +% https://doi.org/10.1007/s11075-022-01331-w. +% % See also mess_lrnm, mess_lradi, mess_para, % mess_galerkin_projection_acceleration, operatormanager. % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Check system data %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% if not(isfield(eqn, 'haveE')) || isempty(eqn.haveE) - eqn.haveE = 0; + eqn.haveE = false; end % Initialize function operator. [result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A', 'E'); if not(result) - error('MESS:control_data', ... - 'system data is not completely defined or corrupted' ); + mess_err(opts, 'control_data', ... + 'system data is not completely defined or corrupted'); end % Check type of equation. if not(isfield(eqn, 'type')) eqn.type = 'N'; - warning('MESS:control_data',['Unable to determine type of equation.'... - 'Falling back to type ''N''']); -elseif (eqn.type ~= 'N') && (eqn.type ~= 'T') - error('MESS:equation_type', ... - 'Equation type must be either ''T'' or ''N'''); + mess_warn(opts, 'control_data', ['Unable to determine type of equation.'... + 'Falling back to type ''N''']); +elseif not(eqn.type == 'N') && not(eqn.type == 'T') + mess_err(opts, 'equation_type', ... + 'Equation type must be either ''T'' or ''N'''); end % make sure the corresponding matrices from quadratic term are well % defined and the first right hand side is dense so that the resulting % factor is densely stored. if not(isfield(eqn, 'B1')) || not(isnumeric(eqn.B1)) - error('MESS:control_data', 'eqn.B1 is not defined or corrupted'); + mess_err(opts, 'control_data', 'eqn.B1 is not defined or corrupted'); end if not(isfield(eqn, 'C1')) || not(isnumeric(eqn.C1)) - error( 'MESS:control_data', 'eqn.C1 is not defined or corrupted'); + mess_err(opts, 'control_data', 'eqn.C1 is not defined or corrupted'); end -if issparse(eqn.B1), eqn.B1 = full(eqn.B1); end -if issparse(eqn.C1), eqn.C1 = full(eqn.C1); end +if issparse(eqn.B1) + eqn.B1 = full(eqn.B1); +end +if issparse(eqn.C1) + eqn.C1 = full(eqn.C1); +end if eqn.type == 'T' if not(isfield(eqn, 'B2')) || not(isnumeric(eqn.B2)) - error('MESS:control_data', 'eqn.B2 is not defined or corrupted'); + mess_err(opts, 'control_data', 'eqn.B2 is not defined or corrupted'); end - if issparse(eqn.B2), eqn.B2 = full(eqn.B2); end + if issparse(eqn.B2) + eqn.B2 = full(eqn.B2); + end else if not(isfield(eqn, 'C2')) || not(isnumeric(eqn.C2)) - error('MESS:control_data', 'eqn.C2 is not defined or corrupted'); + mess_err(opts, 'control_data', 'eqn.C2 is not defined or corrupted'); end - if issparse(eqn.C2), eqn.C2 = full(eqn.C2); end + if issparse(eqn.C2) + eqn.C2 = full(eqn.C2); + end end %% @@ -257,7 +270,7 @@ % Rank-k update system data. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% if not(isfield(eqn, 'haveUV')) || isempty(eqn.haveUV) || not(eqn.haveUV) - eqn.haveUV = 0; + eqn.haveUV = false; eqn.sizeUV1 = 0; eqn.U = []; eqn.V = []; @@ -265,12 +278,16 @@ if isnumeric(eqn.U) && isnumeric(eqn.V) && ... (size(eqn.U, 1) == size(eqn.V, 1)) && (size(eqn.U, 2) == size(eqn.V, 2)) - if issparse(eqn.V), eqn.V = full(eqn.V); end - if issparse(eqn.U), eqn.U = full(eqn.U); end + if issparse(eqn.V) + eqn.V = full(eqn.V); + end + if issparse(eqn.U) + eqn.U = full(eqn.U); + end else - error('MESS:control_data', ... - ['Inappropriate data of low rank updated operator', ... - ' (eqn.U and eqn.V)']); + mess_err(opts, 'control_data', ... + ['Inappropriate data of low-rank updated operator', ... + ' (eqn.U and eqn.V)']); end end @@ -279,15 +296,16 @@ if not(isfield(eqn, 'sizeUV1')) || isempty(eqn.sizeUV1) eqn.sizeUV1 = size(eqn.U, 2); else - assert(isnumeric(eqn.sizeUV1) && (eqn.sizeUV1 <= size(eqn.U, 2)), ... - 'MESS:control_data',['Inappropriate size of low rank updated' ... - ' operator (eqn.U and eqn.V)']); + mess_assert(opts, ... + isnumeric(eqn.sizeUV1) && (eqn.sizeUV1 <= size(eqn.U, 2)), ... + 'control_data', ... + ['Inappropriate size of low-rank updated' ... + ' operator (eqn.U and eqn.V)']); end end init_sizeUV1 = eqn.sizeUV1; - %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Initialize required usf for multiplications @@ -296,155 +314,155 @@ [eqn, opts, oper] = oper.mul_E_pre(eqn, opts, oper); end - %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Check for Riccati Iteration control structure in options %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% if not(isfield(opts, 'ri')) || not(isstruct(opts.ri)) - error('MESS:control_data', ['No ri control data found in ', ... - 'options structure.']); + mess_err(opts, 'control_data', ['No ri control data found in ', ... + 'options structure.']); end if not(isfield(opts.ri, 'maxiter')) || not(isnumeric(opts.ri.maxiter)) - warning('MESS:control_data', ... - ['Missing or corrupted maxiter field. ', ... - 'Switching to default opts.ri.maxiter = 10.']); + mess_warn(opts, 'control_data', ... + ['Missing or corrupted maxiter field. ', ... + 'Switching to default opts.ri.maxiter = 10.']); opts.ri.maxiter = 10; end if not(isfield(opts.ri, 'res_tol')) || not(isnumeric(opts.ri.res_tol)) - warning('MESS:control_data', ... - ['Missing or corrupted res_tol field. ', ... - 'Switching to default opts.ri.res_tol = 0.']); + mess_warn(opts, 'control_data', ... + ['Missing or corrupted res_tol field. ', ... + 'Switching to default opts.ri.res_tol = 0.']); opts.ri.res_tol = 0; end if not(isfield(opts.ri, 'rel_diff_tol')) || not(isnumeric(opts.ri.rel_diff_tol)) - warning('MESS:control_data', ... - ['Missing or corrupted rel_diff_tol field. ', ... - 'Switching to default opts.ri.rel_diff_tol = 0.']); + mess_warn(opts, 'control_data', ... + ['Missing or corrupted rel_diff_tol field. ', ... + 'Switching to default opts.ri.rel_diff_tol = 0.']); opts.ri.rel_diff_tol = 0; end if not(isfield(opts.ri, 'compres_tol')) || not(isnumeric(opts.ri.compres_tol)) - warning('MESS:control_data', ... - ['Missing or corrupted compres_tol field. ', ... - 'Switching to default opts.ri.compres_tol = 0.']); + mess_warn(opts, 'control_data', ... + ['Missing or corrupted compres_tol field. ', ... + 'Switching to default opts.ri.compres_tol = 0.']); opts.ri.compres_tol = 0; end if not(isfield(opts.ri, 'riccati_solver')) || isempty(opts.ri.riccati_solver) - warning('MESS:control_data', ... - ['Missing or corrupted riccati_solver field. ', ... - 'Switching to default opts.ri.riccati_solver = ''radi''.']); + mess_warn(opts, 'control_data', ... + ['Missing or corrupted riccati_solver field. ', ... + 'Switching to default opts.ri.riccati_solver = ''radi''.']); opts.ri.riccati_solver = 'radi'; riccati_solver = @mess_lrradi; - opts.radi.compute_sol_fac = 1; + opts.radi.compute_sol_fac = true; elseif strcmpi(opts.ri.riccati_solver, 'radi') riccati_solver = @mess_lrradi; - opts.radi.compute_sol_fac = 1; + opts.radi.compute_sol_fac = true; elseif strcmpi(opts.ri.riccati_solver, 'newton') riccati_solver = @mess_lrnm; - opts.adi.compute_sol_fac = 1; + opts.adi.compute_sol_fac = true; else - error('MESS:notimplemented', ... - 'The requested Riccati solver is not implemented.'); + mess_err(opts, 'notimplemented', ... + 'The requested Riccati solver is not implemented.'); end if not(isfield(opts.ri, 'lqg_solver')) || isempty(opts.ri.lqg_solver) lqg_solver = riccati_solver; elseif strcmpi(opts.ri.lqg_solver, 'radi') lqg_solver = @mess_lrradi; - opts.radi.compute_sol_fac = 1; + opts.radi.compute_sol_fac = true; elseif strcmpi(opts.ri.lqg_solver, 'newton') lqg_solver = @mess_lrnm; - opts.adi.compute_sol_fac = 1; + opts.adi.compute_sol_fac = true; else - error('MESS:notimplemented', ... - 'The requested Riccati solver is not implemented.'); + mess_err(opts, 'notimplemented', ... + 'The requested Riccati solver is not implemented.'); end if not(isfield(opts.ri, 'info')) opts.ri.info = 0; else if not(isnumeric(opts.ri.info)) && not(islogical(opts.ri.info)) - error('MESS:control_data', ... - 'opts.ri.info parameter must be logical or numeric.'); + mess_err(opts, 'control_data', ... + 'opts.ri.info parameter must be logical or numeric.'); end end if not(isfield(opts.ri, 'store_lqg')) || isempty(opts.ri.store_lqg) - opts.ri.store_lqg = 0; + opts.ri.store_lqg = false; else - if not(isnumeric(opts.ri.store_lqg)) && not(islogical(opts.ri.store_lqg)) - error('MESS:control_data', ... - 'opts.ri.store_lqg parameter must be logical or numeric.'); + if not(islogical(opts.ri.store_lqg)) + mess_err(opts, 'control_data', ... + 'opts.ri.store_lqg parameter must be logical or numeric.'); end end if not(isfield(opts.ri, 'store_solfac')) || isempty(opts.ri.store_solfac) - opts.ri.store_solfac = 0; + opts.ri.store_solfac = false; else - if not(isnumeric(opts.ri.store_solfac)) && not(islogical(opts.ri.store_solfac)) - error('MESS:control_data', ... - 'opts.ri.store_solfac parameter must be logical or numeric.'); + if not(islogical(opts.ri.store_solfac)) + mess_err(opts, 'control_data', ... + 'opts.ri.store_solfac parameter must be logical or numeric.'); end end % Check for residual norm. if not(isfield(opts, 'norm')) || (not(strcmp(opts.norm, 'fro')) && ... - (not(isnumeric(opts.norm)) || opts.norm ~= 2)) + (not(isnumeric(opts.norm)) || not(opts.norm == 2))) - warning('MESS:control_data', ... - ['Missing or Corrupted opts.norm field.', ... - 'Switching to default: ''fro''']); + mess_warn(opts, 'control_data', ... + ['Missing or Corrupted opts.norm field.', ... + 'Switching to default: ''fro''']); opts.norm = 'fro'; end % Check for incompatible shift selection. -ham_shifts = 0; +ham_shifts = false; if strcmpi(func2str(riccati_solver), 'radi') && ... strcmpi(func2str(lqg_solver), 'newton') && ... isfield(opts, 'shifts') && isfield(opts.shifts, 'method') && ... strcmpi(opts.shifts.method, 'gen-ham-opti') - warning('MESS:control_data', ... - ['The chosen shift method is not usable in the LQG step. ', ... - 'The shift method will be changed for this step to ', ... - '''projection'' and for the inner iteration back to its ', ... - 'original state.']); + mess_warn(opts, 'control_data', ... + ['The chosen shift method is not usable in the LQG step. ', ... + 'The shift method will be changed for this step to ', ... + '''projection'' and for the inner iteration back to its ', ... + 'original state.']); - ham_shifts = 1; + ham_shifts = true; opts.shifts.method = 'projection'; end -if not(isfield(opts.ri,'trunc_tol')), ... - opts.ri.trunc_tol = eps * oper.size(eqn, opts); end -if not(isfield(opts.ri, 'trunc_info')), opts.ri.trunc_info = 0; end - +if not(isfield(opts.ri, 'trunc_tol')) + opts.ri.trunc_tol = eps * oper.size(eqn, opts); +end +if not(isfield(opts.ri, 'trunc_info')) + opts.ri.trunc_info = 0; +end %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % List all currently unsupported options %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% if isfield(opts, 'LDL_T') && opts.LDL_T - error('MESS:notimplemented', ... - 'The LDL_T factorization type is not supported in this function.'); + mess_err(opts, 'notimplemented', ... + 'The LDL_T factorization type is not supported in this function.'); end opts.LDL_T = false; % We need this to apply oper.init_res later. if isfield(opts, 'bdf') && not(isempty(opts.bdf)) - error( 'MESS:control_data', 'Options bdf not supported.'); + mess_err(opts, 'control_data', 'Options bdf not supported.'); end if isfield(opts, 'rosenbrock') && not(isempty(opts.rosenbrock)) - error( 'MESS:control_data', 'Options rosenbrock not supported.'); + mess_err(opts, 'control_data', 'Options rosenbrock not supported.'); end - %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % @@ -473,7 +491,6 @@ normZ = 0; end - %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % ITERATION PHASE 1: Solve the LQG problem @@ -501,9 +518,15 @@ % Store information about Riccati equation solver. tmp = out_riccati; if not(opts.ri.store_solfac) - if isfield(tmp, 'Z'), tmp = rmfield(tmp, 'Z'); end - if isfield(tmp, 'K'), tmp = rmfield(tmp, 'K'); end - if isfield(tmp, 'res_fact'), tmp = rmfield(tmp, 'res_fact'); end + if isfield(tmp, 'Z') + tmp = rmfield(tmp, 'Z'); + end + if isfield(tmp, 'K') + tmp = rmfield(tmp, 'K'); + end + if isfield(tmp, 'res_fact') + tmp = rmfield(tmp, 'res_fact'); + end end switch func2str(lqg_solver) @@ -531,41 +554,41 @@ end % Remove initial feedback for Newton method. -isnmK0 = 0; +isnmK0 = false; if isfield(opts, 'nm') && isfield(opts.nm, 'K0') - isnmK0 = 1; + isnmK0 = true; nmK0 = opts.nm.K0; opts.nm = rmfield(opts.nm, 'K0'); end % Remove initial matrices for RADI method. -isradiZ0 = 0; -isradiY0 = 0; -isradiK0 = 0; -isradiW0 = 0; +isradiZ0 = false; +isradiY0 = false; +isradiK0 = false; +isradiW0 = false; if isfield(opts, 'radi') if isfield(opts, 'radi') && isfield(opts.radi, 'Z0') - isradiZ0 = 1; + isradiZ0 = true; radiZ0 = opts.radi.Z0; opts.radi = rmfield(opts.radi, 'Z0'); end if isfield(opts.radi, 'Y0') - isradiY0 = 1; + isradiY0 = true; radiY0 = opts.radi.Y0; opts.radi = rmfield(opts.radi, 'Y0'); end if isfield(opts.radi, 'K0') - isradiK0 = 1; + isradiK0 = true; radiK0 = opts.radi.K0; opts.radi = rmfield(opts.radi, 'K0'); end if isfield(opts.radi, 'W0') - isradiW0 = 1; + isradiW0 = true; radiW0 = opts.radi.W0; opts.radi = rmfield(opts.radi, 'W0'); end @@ -582,10 +605,10 @@ k = ceil(opts.shifts.history / size(W, 2)); opts.shifts.history = k * size(eqn.B1, 2); - warning('MESS:control_data', ... - ['Size of the residual changed after LQG problem. ', ... - 'The parameter opts.shifts.history is reset to %d.'], ... - opts.shifts.history); + mess_warn(opts, 'control_data', ... + ['Size of the residual changed after LQG problem. ', ... + 'The parameter opts.shifts.history is reset to %d.'], ... + opts.shifts.history); end else if mod(opts.shifts.history, size(eqn.C1, 1)) @@ -593,10 +616,10 @@ k = ceil(opts.shifts.history / size(W, 2)); opts.shifts.history = k * size(eqn.C1, 1); - warning('MESS:control_data', ... - ['Size of the residual changed after LQG problem. ', ... - 'The parameter opts.shifts.history is reset to %d.'], ... - opts.shifts.history); + mess_warn(opts, 'control_data', ... + ['Size of the residual changed after LQG problem. ', ... + 'The parameter opts.shifts.history is reset to %d.'], ... + opts.shifts.history); end end end @@ -616,10 +639,9 @@ eqn.V = [eqn.V(:, 1:eqn.sizeUV1), eqn.C1', -eqn.C2']; end -eqn.haveUV = 1; +eqn.haveUV = true; eqn.sizeUV1 = size(eqn.V, 2); - %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % ITERATION PHASE 2: Riccati Iteration (solve the residual equations) @@ -632,21 +654,21 @@ opts.ri.trunc_tol, opts.ri.trunc_info); else - Z(:, end+1:end+size(out_riccati.Z, 2)) = out_riccati.Z; + Z(:, end + 1:end + size(out_riccati.Z, 2)) = out_riccati.Z; end % Update the constant term and error variables. if eqn.type == 'T' if eqn.haveE - eqn.C = (oper.mul_E( eqn, opts, 'T', out_riccati.Z, 'N' ) ... - * (out_riccati.Z' * eqn.B1))'; + eqn.C = (oper.mul_E(eqn, opts, 'T', out_riccati.Z, 'N') * ... + (out_riccati.Z' * eqn.B1))'; else eqn.C = (eqn.B1' * out_riccati.Z) * out_riccati.Z'; end else if eqn.haveE - eqn.B = oper.mul_E(eqn, opts, 'N', out_riccati.Z, 'N') ... - * (eqn.C1 * out_riccati.Z)'; + eqn.B = oper.mul_E(eqn, opts, 'N', out_riccati.Z, 'N') * ... + (eqn.C1 * out_riccati.Z)'; else eqn.B = out_riccati.Z * (eqn.C1 * out_riccati.Z)'; end @@ -655,17 +677,19 @@ % Set the next rank-k update if eqn.type == 'T' if eqn.haveE - eqn.V(:, end-m12+1:end) = oper.mul_E(eqn, opts, 'T', Z, 'N') ... - * (Z' * [eqn.B1, eqn.B2]); + eqn.V(:, end - m12 + 1:end) = ... + oper.mul_E(eqn, opts, 'T', Z, 'N') * ... + (Z' * [eqn.B1, eqn.B2]); else - eqn.V(:, end-m12+1:end) = Z * (Z' * [eqn.B1, eqn.B2]); + eqn.V(:, end - m12 + 1:end) = Z * (Z' * [eqn.B1, eqn.B2]); end else if eqn.haveE - eqn.U(:, end-m12+1:end) = oper.mul_E(eqn, opts, 'N', Z, 'N') ... - * (Z' * [eqn.C1', eqn.C2']); + eqn.U(:, end - m12 + 1:end) = ... + oper.mul_E(eqn, opts, 'N', Z, 'N') * ... + (Z' * [eqn.C1', eqn.C2']); else - eqn.U(:, end-m12+1:end) = Z * (Z' * [eqn.C1', eqn.C2']); + eqn.U(:, end - m12 + 1:end) = Z * (Z' * [eqn.C1', eqn.C2']); end end @@ -687,23 +711,28 @@ % Print status information. if opts.ri.info if opts.ri.rel_diff_tol && opts.ri.res_tol - fprintf(1, ['RI step: %4d normalized residual: %e ' ... - 'relative change in Z: %e\n'], ... - k, res(k), rc(k)); + mess_fprintf(opts, ... + ['RI step: %4d normalized residual: %e ' ... + 'relative change in Z: %e\n'], ... + k, res(k), rc(k)); elseif opts.ri.res_tol - fprintf(1, 'RI step: %4d normalized residual: %e\n', ... - k, res(k)); + mess_fprintf(opts, ... + 'RI step: %4d normalized residual: %e\n', ... + k, res(k)); elseif opts.ri.rel_diff_tol - fprintf(1, 'RI step: %4d relative change in Z: %e\n', ... - k, rc(k)); + mess_fprintf(opts, ... + 'RI step: %4d relative change in Z: %e\n', ... + k, rc(k)); end if isfield(out_riccati, 'adi') - fprintf(1, ' number of Newton steps: %4d\n\n', ... - out_riccati.niter); + mess_fprintf(opts, ... + ' number of Newton steps: %4d\n\n', ... + out_riccati.niter); elseif isfield(out_riccati, 'niter') - fprintf(1, ' number of RADI steps: %4d\n\n', ... - out_riccati.niter); + mess_fprintf(opts, ... + ' number of RADI steps: %4d\n\n', ... + out_riccati.niter); end end @@ -712,7 +741,7 @@ (opts.ri.rel_diff_tol && (rc(k) < opts.ri.rel_diff_tol)) || ... (k >= opts.ri.maxiter) - break; + break end % Solve the next residual equation. @@ -722,20 +751,25 @@ tmp = out_riccati; if not(opts.ri.store_solfac) - if isfield(tmp, 'Z'), tmp = rmfield(tmp, 'Z'); end - if isfield(tmp, 'K'), tmp = rmfield(tmp, 'K'); end - if isfield(tmp, 'res_fact'), tmp = rmfield(tmp, 'res_fact'); end + if isfield(tmp, 'Z') + tmp = rmfield(tmp, 'Z'); + end + if isfield(tmp, 'K') + tmp = rmfield(tmp, 'K'); + end + if isfield(tmp, 'res_fact') + tmp = rmfield(tmp, 'res_fact'); + end end switch func2str(riccati_solver) case 'mess_lrradi' - out.radi(k+1) = tmp; + out.radi(k + 1) = tmp; case 'mess_lrnm' - out.nm(k+1) = tmp; + out.nm(k + 1) = tmp; end end - %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Prepare output @@ -745,9 +779,9 @@ out.niter = k; if eqn.type == 'T' - out.K = eqn.V(:, end-m12+1:end)'; + out.K = eqn.V(:, end - m12 + 1:end)'; else - out.K = eqn.U(:, end-m12+1:end)'; + out.K = eqn.U(:, end - m12 + 1:end)'; end if opts.ri.res_tol @@ -763,9 +797,9 @@ if (out.niter == opts.ri.maxiter) && ... (opts.ri.res_tol && not(out.res(end) < opts.ri.res_tol)) - warning('MESS:RI:convergence', ... - ['Riccati iteration reached maximum iteration number.',... - ' Results may be inaccurate.']); + mess_warn(opts, 'convergence', ... + ['Riccati iteration reached maximum iteration number.', ... + ' Results may be inaccurate.']); end %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -783,7 +817,7 @@ % Enforce empty matrices and parameters. eqn.U = []; eqn.V = []; - eqn.haveUV = 0; + eqn.haveUV = false; eqn.sizeUV1 = 0; end @@ -792,11 +826,21 @@ eqn = rmfield(eqn, 'C'); % Rebuild initial values in option struct. -if isnmK0, opts.nm.K0 = nmK0; end -if isradiZ0, opts.radi.Z0 = radiZ0; end -if isradiY0, opts.radi.Y0 = radiY0; end -if isradiK0, opts.radi.K0 = radiK0; end -if isradiW0, opts.radi.W0 = radiW0; end +if isnmK0 + opts.nm.K0 = nmK0; +end +if isradiZ0 + opts.radi.Z0 = radiZ0; +end +if isradiY0 + opts.radi.Y0 = radiY0; +end +if isradiK0 + opts.radi.K0 = radiK0; +end +if isradiW0 + opts.radi.W0 = radiW0; +end %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/mat-eqn-solvers/mess_lyap.m b/mat-eqn-solvers/mess_lyap.m index eaf968d..a49e763 100644 --- a/mat-eqn-solvers/mess_lyap.m +++ b/mat-eqn-solvers/mess_lyap.m @@ -15,17 +15,17 @@ % % A*Z*Z'*E' + E*Z*Z'*A' + B*B' = 0 % -% [Z, D] = mess_lyap(A, B, [], S) solves the Lyapunov matrix equation +% [Z, D] = mess_lyap(A, B, [], T) solves the Lyapunov matrix equation % in ZDZ^T formulation: % -% A*Z*D*Z' + Z*D*Z'*A' + B*S*B' = 0 +% A*Z*D*Z' + Z*D*Z'*A' + B*T*B' = 0 % -% [Z, D] = mess_lyap(A, B, [], S, E) solves the generalized Lyapunov +% [Z, D] = mess_lyap(A, B, [], T, E) solves the generalized Lyapunov % equation in ZDZ^T formulation: % -% A*Z*D*Z'*E' + E*Z*D*Z'*A' + B*S*B' = 0 +% A*Z*D*Z'*E' + E*Z*D*Z'*A' + B*T*B' = 0 % -% If S is empty, matrices A,B and E can be given as Z = mess_lyap(sys) +% If T is empty, matrices A, B and E can be given as Z = mess_lyap(sys) % with sys = sparss(A, B , C_ ,D , E) a continuous-time first-order sparse % state-space object of the following form: % E*x'(t) = A*x(t) + B*u(t) @@ -36,16 +36,11 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - -%% Usfs -oper = operatormanager('default'); - - %% Options opts.adi.info = 0; opts.adi.res_tol = 1e-12; @@ -56,86 +51,89 @@ opts.shifts.method = 'projection'; opts.shifts.num_desired = 6; opts.norm = 'fro'; -opts.adi.compute_sol_fac = 1; +opts.adi.compute_sol_fac = true; + +%% Usfs +[oper, opts] = operatormanager(opts, 'default'); %% Decide if sparss or single matrices were passed in if (nargin == 1) && isa(varargin{1}, 'sparss') - [eqn, oper] = mess_wrap_sparss(varargin{1}); + [eqn, opts, oper] = mess_wrap_sparss(varargin{1}, opts); % set eqn properties eqn.type = 'N'; if exist('eqn.C', 'var') - warning('MESS:ignored', ... - 'C is supposed to be empty. Data is ignored.'); + mess_warn(opts, 'ignored', ... + 'C is supposed to be empty. Data is ignored.'); end if exist('eqn.D', 'var') - warning('MESS:ignored', ... - 'D is supposed to be empty. Data is ignored.'); + mess_warn(opts, 'ignored', ... + 'D is supposed to be empty. Data is ignored.'); end - eqn.G = eqn.B; + eqn.W = eqn.B; else if nargin < 5 - S = []; + T = []; else - S = varargin{4}; + T = varargin{4}; end %% Equation type eqn.type = 'N'; if nargout == 1 - if not(isempty(S)) - warning('MESS:ignored',... - 'Fourth argument is supposed to be empty. Data is ignored.'); + if not(isempty(T)) + mess_warn(opts, 'ignored', ... + 'Fourth argument is supposed to be empty. Data is ignored.'); end eqn.A_ = varargin{1}; - eqn.G = varargin{2}; + eqn.W = varargin{2}; if nargin == 2 - eqn.haveE = 0; + eqn.haveE = false; elseif nargin == 5 if not(isempty(varargin{3})) - warning('MESS:ignored',... - 'Third argument is supposed to be empty. Data is ignored.'); + mess_warn(opts, 'ignored', ... + 'Third argument is supposed to be empty. Data is ignored.'); end - eqn.haveE = 1; + eqn.haveE = true; eqn.E_ = varargin{5}; else - error('MESS:notimplemented', 'Feature not yet implemented!'); + mess_err(opts, 'notimplemented', 'Feature not yet implemented!'); end elseif nargout == 2 % ZDZ^T case - opts.LDL_T = 1; + opts.LDL_T = true; eqn.A_ = varargin{1}; - eqn.G = varargin{2}; - eqn.S = varargin{4}; + eqn.W = varargin{2}; + eqn.T = varargin{4}; if nargin == 4 if not(isempty(varargin{3})) - warning('MESS:ignored',... - 'Third argument is supposed to be empty. Data is ignored.'); + mess_warn(opts, 'ignored', ... + 'Third argument is supposed to be empty. Data is ignored.'); end - eqn.haveE = 0; + eqn.haveE = false; elseif nargin == 5 if not(isempty(varargin{3})) - warning('MESS:ignored',... - 'Third argument is supposed to be empty. Data is ignored.'); + mess_warn(opts, 'ignored', ... + 'Third argument is supposed to be empty. Data is ignored.'); end - eqn.haveE = 1; + eqn.haveE = true; eqn.E_ = varargin{5}; else - error('MESS:notimplemented', 'Feature not yet implemented!'); + mess_err(opts, 'notimplemented', 'Feature not yet implemented!'); end else - error('MESS:notimplemented', 'Feature not yet implemented!'); + mess_err(opts, 'notimplemented', 'Feature not yet implemented!'); end eqn.B = varargin{2}; diff --git a/mat-eqn-solvers/mess_lyapunov_bilinear.m b/mat-eqn-solvers/mess_lyapunov_bilinear.m index bc34c81..c9eb442 100644 --- a/mat-eqn-solvers/mess_lyapunov_bilinear.m +++ b/mat-eqn-solvers/mess_lyapunov_bilinear.m @@ -40,8 +40,8 @@ % determining whether (N) or (T) above is solved % (optional, default fallback: 'N') % -% eqn.haveE possible values: 0, 1, false, true -% if haveE = 0: matrix E is assumed to be the identity +% eqn.haveE possible values: false, true +% if haveE = false: matrix E is assumed to be the identity % (optional, default: 0) % % Depending on the operator chosen by the operatormanager, additional @@ -116,33 +116,36 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% Check oper if not(isequal(oper.name, 'default')) - error('MESS:notimplemented', ... - ['Feature not yet implemented!', ... - 'Only accepts operatormanager(''default'')']); + mess_err(opts, 'notimplemented', ... + ['Feature not yet implemented!', ... + 'Only accepts operatormanager(''default'')']); end %% Check for eqn -if not(isfield(eqn, 'haveE')), eqn.haveE = 0; end -if not(isfield(eqn, 'type')), eqn.type = 'N'; end +if not(isfield(eqn, 'haveE')) + eqn.haveE = false; +end +if not(isfield(eqn, 'type')) + eqn.type = 'N'; +end % Check for A_ and E_ -[~, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A','E'); +[~, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A', 'E'); % Check for B and C if not(isfield(eqn, 'B')) || isempty(eqn.B) - warning('MESS:control_data','eqn.B is missing'); + mess_warn(opts, 'control_data', 'eqn.B is missing'); end if not(isfield(eqn, 'C')) || isempty(eqn.C) - warning('MESS:control_data','eqn.C is missing'); + mess_warn(opts, 'control_data', 'eqn.C is missing'); end % Check for eqn.type and declare B or C as full @@ -152,16 +155,18 @@ case 'T' eqn.C = full(eqn.C); otherwise - error('MESS:control_data','eqn.type has to be ''N'' or ''T'''); + mess_err(opts, 'control_data', 'eqn.type has to be ''N'' or ''T'''); end % Transform N to Cell if given as matrix and check N [eqn, opts, oper] = oper.mul_N_pre(eqn, opts, oper); %% check opts for substructures -if not(isfield(opts, 'norm')), opts.norm ='fro'; end +if not(isfield(opts, 'norm')) + opts.norm = 'fro'; +end -expected_subStructures = {'blyap', 'shifts','adi', 'fopts'}; +expected_subStructures = {'blyap', 'shifts', 'adi', 'fopts'}; expected_sub_subStructures{1} = {'maxiter', 'rel_diff_tol', 'res_tol'}; default_values{1} = {10, 1e-5, 1e-5}; @@ -171,7 +176,7 @@ default_values{2} = {50, 25, 'projection', 6}; expected_sub_subStructures{3} = {'maxiter', 'res_tol', ... - 'rel_diff_tol', 'norm'}; + 'rel_diff_tol', 'norm'}; default_values{3} = {100, 1e-12, 0, 'fro'}; expected_sub_subStructures{4} = {'LDL_T', 'norm'}; @@ -182,8 +187,8 @@ % check res2_norm opts if not(isfield(opts, 'resopts')) || isempty(opts.resopts) - warning('MESS:control_data',... - 'opts.resopts is missing. parameters set to default values'); + mess_warn(opts, 'control_data', ... + 'opts.resopts is missing. parameters set to default values'); fields = {'res'}; c = cell(length(fields), 1); opts.resopts = cell2struct(c, fields); @@ -193,9 +198,9 @@ expected_sub_subStructures_resopts{1} = {'maxiter', 'tol', 'orth'}; default_values_resopts{1} = {10, 1e-6, 0}; -opts.resopts = check_opts(opts.resopts,... - expected_subStructures_resopts,expected_sub_subStructures_resopts,... - default_values_resopts); +opts.resopts = check_opts(opts.resopts, ... + expected_subStructures_resopts, expected_sub_subStructures_resopts, ... + default_values_resopts); %% Initialize Data eqn_iter = eqn; % Equationset per Iteration @@ -213,11 +218,11 @@ switch eqn.type case 'N' - norm_B_or_C = norm((eqn.B' * eqn.B)); + norm_B_or_C = norm(eqn.B' * eqn.B); case 'T' norm_B_or_C = norm(eqn.C * eqn.C'); otherwise - error('MESS:control_data','eqn.type has to be ''N'' or ''T'''); + mess_err(opts, 'control_data', 'eqn.type has to be ''N'' or ''T'''); end % info opts @@ -225,21 +230,21 @@ opts.blyap.info = 0; else if not(isnumeric(opts.blyap.info)) && not(islogical(opts.blyap.info)) - error('MESS:info',... - 'opts.shifts.info parameter must be logical or numeric.'); + mess_err(opts, 'info', ... + 'opts.shifts.info parameter must be logical or numeric.'); end - tic + tic; end %% Start iteration -for k = 1 : (opts.blyap.maxiter) +for k = 1:(opts.blyap.maxiter) % Solve A*VV'E' + EVV'A' + BB' = 0 or % Solve A'VV'E + E'VV'A + C'C = 0 eqn_iter.B = B_iter; eqn_iter.C = C_iter; out_lradi = mess_lradi(eqn_iter, opts, oper); - V = mess_column_compression( out_lradi.Z, 'N', [], eps); + V = mess_column_compression(out_lradi.Z, 'N', [], eps); % column_compression colV = size(V, 2); @@ -249,26 +254,26 @@ % building [N_1*V, ..., N_k*V], or the same with N_k' for type 'T' for currentN_k = 1:numberOf_N_matrices NV = mess_column_compression(oper.mul_N(eqn, opts, eqn.type, V, 'N', ... - currentN_k), 'N', [], eps); + currentN_k), 'N', [], eps); col_NV = size(NV, 2); - columns = col_start:(col_start+col_NV-1); + columns = col_start:(col_start + col_NV - 1); compress(:, columns) = NV; col_start = col_start + col_NV; end switch eqn.type case 'N' - B_iter = mess_column_compression(compress(:, 1:col_start-1), ... + B_iter = mess_column_compression(compress(:, 1:col_start - 1), ... 'N', [], eps); case 'T' - C_iter = mess_column_compression(compress(:, 1:col_start-1), ... + C_iter = mess_column_compression(compress(:, 1:col_start - 1), ... 'N', [], eps); C_iter = C_iter'; otherwise - error('MESS:control_data','eqn.type has to be ''N'' or ''T'''); + mess_err(opts, 'control_data', 'eqn.type has to be ''N'' or ''T'''); end - Z = mess_column_compression ([Z,V], 'N', [], eps); + Z = mess_column_compression ([Z, V], 'N', [], eps); % calculate exit conditions rZ_old = rz_new; @@ -276,16 +281,16 @@ ranksZ(k) = rank(Z); - normZ = norm(Z' * Z); normV = norm(V)^2; % test the conditions - if ((normV/normZ) < opts.blyap.rel_diff_tol) || (rZ_old == rz_new) + if ((normV / normZ) < opts.blyap.rel_diff_tol) || (rZ_old == rz_new) % calculate ||A*Z*Z'*E' + E*Z*Z'*A' + Sum_N_k*P*N_k' + B*B|| for % current Z - [lyapunov_Norm, ~, ~, ~, eqn, opts.fopts, oper] = mess_res2_norms(Z,... - 'lyapunov_QB', eqn, opts.fopts, oper, opts.resopts); + [lyapunov_Norm, ~, ~, ~, eqn, opts.fopts, oper] = ... + mess_res2_norms(Z, 'lyapunov_QB', eqn, ... + opts.fopts, oper, opts.resopts); lyapNorm(k) = lyapunov_Norm; @@ -293,10 +298,13 @@ niter_bilinear = k; if opts.blyap.info - fprintf('step: %4d residual: %e rank(Z): %d \n', ... - k, lyapNorm(k), rz_new); - fprintf(['Converged at step: %4d with residual: %e rank(Z):', ... - '%d \n'], k, lyapNorm(k), rz_new); + mess_fprintf(opts, ... + 'step: %4d residual: %e rank(Z): %d \n', ... + k, lyapNorm(k), rz_new); + mess_fprintf(opts, ... + ['Converged at step: %4d with residual: ', ... + '%e rank(Z): %d \n'], ... + k, lyapNorm(k), rz_new); end break end @@ -304,33 +312,36 @@ if k == opts.blyap.maxiter [lyapunov_Norm, ~, ~, ~, eqn, opts.fopts, oper] = ... - mess_res2_norms(Z,'lyapunov_QB', eqn, opts.fopts, ... - oper, opts.resopts); + mess_res2_norms(Z, 'lyapunov_QB', eqn, opts.fopts, ... + oper, opts.resopts); lyapNorm(k) = lyapunov_Norm; niter_bilinear = k; - warning('MESS:maxiter', ... - 'REACHED MAXIMUM ITERATION NUMBER, FINAL RESIDUAL: %d', ... - lyapunov_Norm); + mess_warn(opts, 'maxiter', ... + 'REACHED MAXIMUM ITERATION NUMBER, FINAL RESIDUAL: %d', ... + lyapunov_Norm); if opts.blyap.info - fprintf('step: %4d residual: %e rank(Z): %d \n', ... - k, rz_new, lyapNorm(k)); - fprintf(['Did not converge after %4d steps last residual:', ... - ' %e rank(Z): %d \n'], k, lyapNorm(k), rz_new); + mess_fprintf(opts, ... + 'step: %4d residual: %e rank(Z): %d \n', ... + k, rz_new, lyapNorm(k)); + mess_fprintf(opts, ... + ['Did not converge after %4d steps final ', ... + 'residual: %e rank(Z): %d \n'], ... + k, lyapNorm(k), rz_new); end end if opts.blyap.info - fprintf('step: %4d residual: %e rank(Z): %d \n', ... - k, lyapNorm(k), rz_new); + mess_fprintf(opts, 'step: %4d residual: %e rank(Z): %d \n', ... + k, lyapNorm(k), rz_new); end end % Elapsed time if opts.blyap.info - toc + toc; end % Saving output @@ -340,13 +351,13 @@ % format rank output out.rankZ_bilinear = zeros(out.niter_bilinear, 1); -for k = 1 : out.niter_bilinear +for k = 1:out.niter_bilinear out.rankZ_bilinear(k) = ranksZ(k); end % format residual output out.resNorm_bilinear = zeros(out.niter_bilinear, 1); -for k = 1 : out.niter_bilinear +for k = 1:out.niter_bilinear out.resNorm_bilinear(k) = lyapNorm(k); end @@ -362,54 +373,58 @@ % Check for opts % Input -% opts struct to be checked for options +% opts struct to be checked for options % -% expected_subStructures input as cell with the names of the -% necessary substructures +% expected_subStructures input as cell with the names of the +% necessary substructures % -% expected_sub_subStructures input as cell with the names of the -% necessary sub_substructures -% {n} names of the nth substructure +% expected_sub_subStructures input as cell with the names of the +% necessary sub_substructures +% {n} names of the nth substructure % -% default_values input as cell with the default values for -% the necessary sub_substructures -% {n} values of the nth substructure +% default_values input as cell with the default values for +% the necessary sub_substructures +% {n} values of the nth substructure % % Output -% opts opts structure with the new substructures -% using default values if not assigned +% opts opts structure with the new substructures +% using default values if not assigned % % -for k = 1 : length(expected_subStructures) +for k = 1:length(expected_subStructures) % checks if all necessary data is given - if not(length(expected_subStructures) == length(expected_sub_subStructures)) - error('MESS:control_data', ... - 'Sub_SubStructure for some SubStructure is missing!') + if not(length(expected_subStructures) == ... + length(expected_sub_subStructures)) + mess_err(opts, 'control_data', ... + 'Sub_SubStructure for some SubStructure is missing!'); end - if not(length(expected_sub_subStructures{k}) == length(default_values{k})) - error('MESS:control_data', ... - 'Not every sub_subStructure has an assigned default value!'); + if not(length(expected_sub_subStructures{k}) == ... + length(default_values{k})) + mess_err(opts, 'control_data', ... + ['Not every sub_subStructure has an assigned ', ... + 'default value!']); end % creates structures if not yet existing - if not(isfield(opts, (expected_subStructures{k}))) || ... + if not(isfield(opts, expected_subStructures{k})) || ... isempty(opts.(expected_subStructures{k})) - warning('MESS:control_data', ... - 'opts.%s is missing. parameters set to default values', ... - expected_subStructures{1}); + mess_warn(opts, 'control_data', ... + ['opts.%s is missing. ', ... + 'Parameters set to default values'], ... + expected_subStructures{1}); create_empty_opt = cell(length(expected_sub_subStructures{k}), 1); - opts.(expected_subStructures{k}) = cell2struct(create_empty_opt, ... - expected_sub_subStructures{k}); + opts.(expected_subStructures{k}) = ... + cell2struct(create_empty_opt, expected_sub_subStructures{k}); end - for l = 1 : length(expected_sub_subStructures{k}) + for l = 1:length(expected_sub_subStructures{k}) - % assigins default values if there are no given values + % assigns default values if there are no given values if not(isfield(opts.(expected_subStructures{k}), ... - expected_sub_subStructures{k}{l})) || ... + expected_sub_subStructures{k}{l})) || ... isempty(opts.(expected_subStructures{k}).(expected_sub_subStructures{k}{l})) default_message = default_values{k}{l}; @@ -418,8 +433,11 @@ default_message = num2str(default_values{k}{l}); end - warning('MESS:control_data','opts.%s.%s is set to %s (default)', ... - expected_subStructures{k}, expected_sub_subStructures{k}{l}, default_message); + mess_warn(opts, 'control_data', ... + 'opts.%s.%s is set to %s (default)', ... + expected_subStructures{k}, ... + expected_sub_subStructures{k}{l}, ... + default_message); opts.(expected_subStructures{k}).(expected_sub_subStructures{k}{l}) = default_values{k}{l}; end diff --git a/mat-eqn-solvers/mess_rosenbrock_dre.m b/mat-eqn-solvers/mess_rosenbrock_dre.m index 4af4ee5..40b37b1 100644 --- a/mat-eqn-solvers/mess_rosenbrock_dre.m +++ b/mat-eqn-solvers/mess_rosenbrock_dre.m @@ -30,8 +30,8 @@ % determining whether (N) or (T) is solved % (optional) % -% eqn.haveE possible values: 0, 1, false, true -% if haveE = 0: matrix E is assumed to be the identity +% eqn.haveE possible values: false, true +% if haveE = false: matrix E is assumed to be the identity % (optional) % % Depending on the operator chosen by the operatormanager, additional @@ -48,7 +48,7 @@ % use 1-stage or 2-stage Rosenbrock method % (optional, default: 1) % -% opts.rosenbrock.info possible values: 0, 1, false, true +% opts.rosenbrock.info possible values: 0, 1 % turn on (1) or off (0) the status output in % every Rosenbrock iteration step % (optional, default: 0) @@ -61,16 +61,16 @@ % tolerance for LDL_T column compression % (optional, default: eps*n) % -% opts.rosenbrock.trunc_info possible values: 0, 1, false, true +% opts.rosenbrock.trunc_info possible values: 0, 1 % verbose mode for column compression % (optional, default: 0) % % % opts.rosenbrock. -% save_solution possible values: 0, 1, false, true +% save_solution possible values: false, true % save only K (0) or also the solution % factors L and D (1) -% (optional, default: 0) +% (optional, default: false) % % opts.shifts.period possible values: integer > 0 % number of time steps that should pass @@ -86,10 +86,10 @@ % out.Ks cell array with matrix K for every time step % % out.Ls cell array with solution factor L for every time step -% (only if opts.rosenbrock.save_solution = 1) +% (only if opts.rosenbrock.save_solution = true) % % out.Ds cell array with solution factor D for every time step -% (only if opts.rosenbrock.save_solution = 1) +% (only if opts.rosenbrock.save_solution = true) % % If optional input arguments are missing they may be set to default values % and a 'MESS:control_data' warning is printed. to turn warnings off use @@ -103,102 +103,105 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Check for Rosenbrock Control structure in options %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if not(isfield(opts,'rosenbrock')) || not(isstruct(opts.rosenbrock)) - error('MESS:control_data','Rosenbrock control structure opts.rosenbrock missing.'); +if not(isfield(opts, 'rosenbrock')) || not(isstruct(opts.rosenbrock)) + mess_err(opts, 'control_data', ... + 'Rosenbrock control structure opts.rosenbrock missing.'); end % Single fields are checked below or inside mess_lradi -if not(isfield(opts.rosenbrock,'time_steps')) - error('MESS:control_data','opts.rosenbrock.time_steps is missing.'); +if not(isfield(opts.rosenbrock, 'time_steps')) + mess_err(opts, 'control_data', 'opts.rosenbrock.time_steps is missing.'); end -if not(isfield(opts.rosenbrock,'stage')), opts.rosenbrock.stage=1; end +if not(isfield(opts.rosenbrock, 'stage')) + opts.rosenbrock.stage = 1; +end -if (opts.rosenbrock.stage ~= 1) && (opts.rosenbrock.stage ~= 2) - error('MESS:control_data',['opts.rosenbrock.stage has to be 1 or 2.', ... - ' Other stages are not implemented']); +if not(opts.rosenbrock.stage == 1) && not(opts.rosenbrock.stage == 2) + mess_err(opts, 'control_data', ... + ['opts.rosenbrock.stage has to be 1 or 2.', ... + ' Other stages are not implemented']); end -if not(isfield(opts.rosenbrock,'info')), opts.rosenbrock.info = 0; end +if not(isfield(opts.rosenbrock, 'info')) + opts.rosenbrock.info = 0; +end -if not(isfield(opts.rosenbrock,'trunc_tol')) - opts.rosenbrock.trunc_tol = eps * oper.size(eqn, opts); +if not(isfield(opts.rosenbrock, 'trunc_tol')) + opts.rosenbrock.trunc_tol = eps * oper.size(eqn, opts); end if not(isfield(opts.rosenbrock, 'trunc_info')) - opts.rosenbrock.trunc_info = 0; + opts.rosenbrock.trunc_info = 0; end -if not(isfield(opts.rosenbrock,'gamma')) - opts.rosenbrock.gamma= 1.0 + 1.0 / sqrt(2.0); +if not(isfield(opts.rosenbrock, 'gamma')) + opts.rosenbrock.gamma = 1.0 + 1.0 / sqrt(2.0); end -if not(isfield(opts.rosenbrock,'save_solution')) - opts.rosenbrock.save_solution = 0; +if not(isfield(opts.rosenbrock, 'save_solution')) + opts.rosenbrock.save_solution = false; end %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Check for ADI control structure in options %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if not(isfield(opts,'adi')) || not(isstruct(opts.adi)) - error('MESS:control_data','ADI control structure opts.adi missing.'); +if not(isfield(opts, 'adi')) || not(isstruct(opts.adi)) + mess_err(opts, 'control_data', 'ADI control structure opts.adi missing.'); end -if not(isfield(opts.adi,'compute_sol_fac')) || ... - not(isnumeric(opts.adi.compute_sol_fac)) || ... +if not(isfield(opts.adi, 'compute_sol_fac')) || ... + not(islogical(opts.adi.compute_sol_fac)) || ... not(opts.adi.compute_sol_fac) - warning('MESS:control_data', ... - 'Missing or Corrupted compute_sol_fac field. Switching to default.'); - opts.adi.compute_sol_fac = 1; + mess_warn(opts, 'control_data', ... + 'Missing or Corrupted compute_sol_fac field. Switching to default.'); + opts.adi.compute_sol_fac = true; end -if not(isfield(opts.adi,'accumulateK')) || not(isnumeric(opts.adi.accumulateK)) - warning('MESS:control_data', ... - 'Missing or Corrupted accumulateK field. Switching to default: 1'); - opts.adi.accumulateK = 1; +if not(isfield(opts.adi, 'accumulateK')) || not(islogical(opts.adi.accumulateK)) + mess_warn(opts, 'control_data', ... + 'Missing or Corrupted accumulateK field. Switching to default: 1'); + opts.adi.accumulateK = true; end -if not(isfield(opts.shifts,'period')) - opts.shifts.period=1; +if not(isfield(opts.shifts, 'period')) + opts.shifts.period = 1; end %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Check for shift computation control structure in options %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if not(isfield(opts,'shifts')) || not(isstruct(opts.shifts)) - error('MESS:control_data','shifts control structure opts.shifts missing.'); +if not(isfield(opts, 'shifts')) || not(isstruct(opts.shifts)) + mess_err(opts, 'control_data', 'shifts control structure opts.shifts missing.'); end -if not(isfield(opts.shifts,'implicitVtAV')) +if not(isfield(opts.shifts, 'implicitVtAV')) opts.shifts.implicitVtAV = true; end -if not(isnumeric(opts.shifts.implicitVtAV)) && ... - not(islogical(opts.shifts.implicitVtAV)) - - warning('MESS:implicitVtAV', ... - ['Missing or Corrupted implicitVtAV field.' ... - 'Switching to default (true).']); +if not(islogical(opts.shifts.implicitVtAV)) + mess_warn(opts, 'implicitVtAV', ... + ['Missing or Corrupted implicitVtAV field.' ... + 'Switching to default (true).']); opts.shifts.implicitVtAV = true; end if not(opts.shifts.implicitVtAV) - warning('MESS:implicitVtAV', ... - ['implicitVtAV must be true for mess_rosenbrock_dre.', ... - ' Switching to default (true).']); + mess_warn(opts, 'implicitVtAV', ... + ['implicitVtAV must be true for mess_rosenbrock_dre.', ... + ' Switching to default (true).']); opts.shifts.implicitVtAV = true; end @@ -206,48 +209,55 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Check system data %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if not(isfield(eqn, 'LTV')), eqn.LTV = 0; end +if not(isfield(eqn, 'LTV')) + eqn.LTV = false; +end if eqn.LTV - error('MESS:control_data', ['non-autonomous differential Riccati', ... - ' equation (eqn.LTV=1) is not supported']); + mess_err(opts, 'control_data', ... + ['non-autonomous differential Riccati', ... + ' equation (eqn.LTV=1) is not supported']); end if not(isfield(eqn, 'C')) || not(isnumeric(eqn.C)) - error('MESS:control_data', 'eqn.C is not defined or corrupted'); + mess_err(opts, 'control_data', ... + 'eqn.C is not defined or corrupted'); end if not(isfield(eqn, 'B')) || not(isnumeric(eqn.B)) - error('MESS:control_data', 'eqn.B is not defined or corrupted'); + mess_err(opts, 'control_data', 'eqn.B is not defined or corrupted'); end if not(isfield(eqn, 'L0')) || not(isnumeric(eqn.L0)) - warning('MESS:control_data', ... - ['Initial condition factor L0 is not defined or corrupted.', ... - ' Setting it to the zero vector.']); + mess_warn(opts, 'control_data', ... + ['Initial condition factor L0 is not defined or ', ... + 'corrupted. Setting it to the zero vector.']); n = oper.size(eqn); - eqn.L0 = zeros(n,1); + eqn.L0 = zeros(n, 1); end if not(isfield(eqn, 'D0')) || not(isnumeric(eqn.D0)) - warning('MESS:control_data', ... - ['Initial condition factor D0 is not defined or corrupted.', ... - ' Setting it to the identity matrix.']); + mess_warn(opts, 'control_data', ... + ['Initial condition factor D0 is not defined or ', ... + 'corrupted. Setting it to the identity matrix.']); eqn.D0 = eye(size(eqn.L0, 2)); end if not(isfield(eqn, 'type')) eqn.type = 'N'; - warning('MESS:MESS:control_data', ... - 'Unable to determine type of equation. Falling back to type ''N'''); -elseif (eqn.type ~= 'N') && (eqn.type ~= 'T') - error('MESS:equation_type', 'Equation type must be either ''T'' or ''N'''); + mess_warn(opts, 'control_data', ... + ['Unable to determine type of equation. ', ... + 'Falling back to type ''N''']); +elseif not(eqn.type == 'N') && not(eqn.type == 'T') + mess_err(opts, 'equation_type', ... + 'Equation type must be either ''T'' or ''N'''); end -[result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A','E'); +[result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A', 'E'); if not(result) - error('MESS:control_data', 'system data is not completely defined or corrupted'); + mess_err(opts, 'control_data', ... + 'system data is not completely defined or corrupted'); end if eqn.type == 'T' @@ -280,9 +290,17 @@ D = eye(size(L, 2)); if eqn.type == 'T' - K = oper.mul_E(eqn, opts, eqn.type, (L * (L' * eqn.B)), 'N'); + if eqn.haveE + K = oper.mul_E(eqn, opts, eqn.type, L * (L' * eqn.B), 'N'); + else + K = L * (L' * eqn.B); + end else - K = oper.mul_E(eqn, opts, eqn.type, (L * (eqn.C * L)'), 'N'); + if eqn.haveE + K = oper.mul_E(eqn, opts, eqn.type, L * (eqn.C * L)', 'N'); + else + K = L * (eqn.C * L)'; + end end Iq = eye(q); @@ -298,24 +316,24 @@ eqn.U = K; end -eqn.haveUV = 1; +eqn.haveUV = true; out.Ks = {K'}; % K of step 0 if eqn.type == 'T' - eqn.G = eqn.C'; + eqn.W = eqn.C'; else - eqn.G = eqn.B; + eqn.W = eqn.B; end -G = eqn.G; -opts.LDL_T = 1; +W = eqn.W; +opts.LDL_T = true; %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Start iteration %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -for k = 2 : length(times) +for k = 2:length(times) t = times(k); opts.rosenbrock.tau = times(k - 1) - times(k); @@ -338,7 +356,11 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % update E^T * L %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - EL = oper.mul_E(eqn, opts, eqn.type, L, 'N'); + if eqn.haveE + EL = oper.mul_E(eqn, opts, eqn.type, L, 'N'); + else + EL = L; + end m = size(EL, 2); %% @@ -356,22 +378,22 @@ %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - % update G and S + % update W and T %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - eqn.G = [G, EL]; + eqn.W = [W, EL]; else % stage 2 - BLD = [zeros(m ,m), D; ... + BLD = [zeros(m, m), D; ... D, -(BLD_tmp' * BLD_tmp)]; %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - % update G and S + % update W and T %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - eqn.G = [G, oper.mul_A(eqn, opts, eqn.type, L, 'N'), EL]; + eqn.W = [W, oper.mul_A(eqn, opts, eqn.type, L, 'N'), EL]; end - eqn.S = blkdiag(Iq, BLD); - [eqn.G, eqn.S] = mess_column_compression(eqn.G, 'N', eqn.S, ... + eqn.T = blkdiag(Iq, BLD); + [eqn.W, eqn.T] = mess_column_compression(eqn.W, 'N', eqn.T, ... opts.rosenbrock.trunc_tol, ... opts.rosenbrock.trunc_info); @@ -379,8 +401,8 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % compute new ADI shifts %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - if not(mod(k - 2,opts.shifts.period)) - opts.shifts.p = mess_para(eqn,opts,oper); + if not(mod(k - 2, opts.shifts.period)) + opts.shifts.p = mess_para(eqn, opts, oper); end %% @@ -406,9 +428,20 @@ K = adiout.Knew; else if eqn.type == 'T' - K = oper.mul_E(eqn, opts,eqn.type,L,'N') * (D * (L' * eqn.B)); + if eqn.haveE + K = oper.mul_E(eqn, opts, eqn.type, L, 'N') * ... + (D * (L' * eqn.B)); + else + K = L * (D * (L' * eqn.B)); + end + else - K = oper.mul_E(eqn, opts,eqn.type,L,'N') * (D * (L' * eqn.C')); + if eqn.haveE + K = oper.mul_E(eqn, opts, eqn.type, L, 'N') * ... + (D * (L' * eqn.C')); + else + K = L * (D * (L' * eqn.C')); + end end end else % stage = 2 @@ -426,8 +459,12 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % update RHS for second equation %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - ET1 = oper.mul_E(eqn, opts, eqn.type, T1, 'N'); - eqn.G = ET1; + if eqn.haveE + ET1 = oper.mul_E(eqn, opts, eqn.type, T1, 'N'); + else + ET1 = T1; + end + eqn.W = ET1; if eqn.type == 'T' BT1E_tmp = (eqn.B' * T1) * D1; @@ -436,23 +473,24 @@ end BT1D = opts.rosenbrock.tau * opts.rosenbrock.tau * ... - (BT1E_tmp' * BT1E_tmp) + (2.0 - 1.0 / opts.rosenbrock.gamma) * D1; + (BT1E_tmp' * BT1E_tmp) + ... + (2.0 - 1.0 / opts.rosenbrock.gamma) * D1; - eqn.S = BT1D; + eqn.T = BT1D; %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % compute new ADI shifts %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - if not(mod(k - 2,opts.shifts.period)) - opts.shifts.p = mess_para(eqn,opts,oper); + if not(mod(k - 2, opts.shifts.period)) + opts.shifts.p = mess_para(eqn, opts, oper); end %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % solve second equation %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - adiout2 = mess_lradi(eqn,opts, oper); + adiout2 = mess_lradi(eqn, opts, oper); %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -460,8 +498,8 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% L = [L, T1, adiout2.Z]; %#ok D = blkdiag(D, opts.rosenbrock.tau * ... - (2.0 - 1.0 / (2.0 * opts.rosenbrock.gamma)) * D1, ... - - opts.rosenbrock.tau / 2.0 * adiout2.D); + (2.0 - 1.0 / (2.0 * opts.rosenbrock.gamma)) * D1, ... + -opts.rosenbrock.tau / 2.0 * adiout2.D); %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -471,9 +509,9 @@ opts.rosenbrock.trunc_tol, ... opts.rosenbrock.trunc_info); if eqn.type == 'T' - eqn.G = eqn.C'; + eqn.W = eqn.C'; else - eqn.G = eqn.B; + eqn.W = eqn.B; end %% @@ -482,13 +520,23 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% if opts.adi.accumulateK K = K + opts.rosenbrock.tau * ... - (2.0 - 1.0 / (2.0 * opts.rosenbrock.gamma)) * adiout1.Knew ... - - opts.rosenbrock.tau / 2.0 * adiout2.Knew; + (2.0 - 1.0 / (2.0 * opts.rosenbrock.gamma)) * ... + adiout1.Knew - opts.rosenbrock.tau / 2.0 * adiout2.Knew; else if eqn.type == 'T' - K = oper.mul_E(eqn, opts,eqn.type,L,'N') * (D * (L' * eqn.B)); + if eqn.haveE + K = oper.mul_E(eqn, opts, eqn.type, L, 'N') * ... + (D * (L' * eqn.B)); + else + K = L * (D * (L' * eqn.B)); + end else - K = oper.mul_E(eqn, opts,eqn.type,L,'N') * (D * (L' * eqn.C')); + if eqn.haveE + K = oper.mul_E(eqn, opts, eqn.type, L, 'N') * ... + (D * (L' * eqn.C')); + else + K = L * (D * (L' * eqn.C')); + end end end end @@ -498,7 +546,7 @@ % print status information %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% if opts.rosenbrock.info - fprintf('Rosenbrock step %4d s\n', t); + mess_fprintf(opts, 'Rosenbrock step %4d s\n', t); end if opts.rosenbrock.save_solution @@ -522,4 +570,3 @@ [eqn, opts, oper] = oper.mul_E_post(eqn, opts, oper); [eqn, opts, oper] = oper.mul_A_post(eqn, opts, oper); - diff --git a/mat-eqn-solvers/mess_splitting_dre.m b/mat-eqn-solvers/mess_splitting_dre.m index bac8081..053cdf0 100644 --- a/mat-eqn-solvers/mess_splitting_dre.m +++ b/mat-eqn-solvers/mess_splitting_dre.m @@ -1,4 +1,4 @@ - function [out, eqn, opts, oper] = mess_splitting_dre(eqn, opts, oper) +function [out, eqn, opts, oper] = mess_splitting_dre(eqn, opts, oper) %% function [out, eqn, opts, oper] = mess_splitting_dre(eqn, opts, oper) % LDL^T-factored splitting schemes for differential Riccati equations % E*d/dt X(t)*E' = -B*B' - E*X(t)*A' - A*X(t)*E' + E*X(t)*C'*C*X(t)*E' (N) @@ -29,11 +29,11 @@ % determining whether (N) or (T) is solved % (optional, default 'N') % -% eqn.haveE possible values: 0, 1, false, true -% if haveE = 0: matrix E is assumed to be the identity +% eqn.haveE possible values: false, true +% if haveE = false: matrix E is assumed to be the identity % (optional) % -% eqn.LTV possible values: 0, 1, false, true +% eqn.LTV possible values: false, true % indicates autonomous (false) or % non-autonomous (true) differential % Riccati equation @@ -65,28 +65,28 @@ % to be true % (optional, default 2) % -% opts.splitting.additive possible values: 0, 1, false, true +% opts.splitting.additive possible values: false, true % use (1) or don't use (0) the additive % schemes. If splitting.order > 2 this is set % to 1 automatically % (optional) % -% opts.splitting.symmetric possible values: 0, 1, false, true +% opts.splitting.symmetric possible values: false, true % use symmetric (1) or unsymmetric (0) % additive schemes -% (optional, default 0) +% (optional, default false) % % opts.splitting.trunc_tol possible values: scalar > 0 % column compression tolerance % (optional, default eps * size(A, 1)) % -% opts.splitting.trunc_info possible values: 0, 1, false, true +% opts.splitting.trunc_info possible values: 0, 1 % verbose mode for column compression % (optional, default: 0) % % opts.splitting.quadrature.type % possible values: 'gauss', 'clenshawcurtis', -% 'equidistant', 'adaptive' +% 'equidistant' % type of quadrature to use for approximation % of the integral term % (optional, default 'gauss') @@ -95,6 +95,8 @@ % possible values: positive integer % order of quadrature used for approximation % of the integral term +% has to be even for type 'clenshawcurtis' or +% if embedded = true % (optional, default based on method) % % opts.splitting.quadrature.tol @@ -102,13 +104,36 @@ % tolerance to use for adaptive quadrature % (optional, default 1e-4) % +% opts.splitting.quadrature.rel_err +% possible values: false, true +% use relative error for error estimation +% (optional, default true) +% +% opts.splitting.quadrature.adaptive +% possible values: false, true +% use adaptive composite quadrature rule +% (optional, default true) +% +% opts.splitting.quadrature.intervals +% possible values: positive integer +% number of sub-intervals for composite quadrature rule +% used as start parameter for adaptive quadrature +% (optional, default 1) +% +% opts.splitting.quadrature.embedded +% possible values: false, true +% use embedded error for error estimation +% possible with types 'clenshawcurtis' and 'equidistant' +% and even quadrature orders +% (optional, default true) +% % opts.splitting.intermediates -% possible values: 0, 1, false, true +% possible values: false, true % store intermediate approximations (1) % or only return final L, D (0) -% (optional, default 1) +% (optional, default true) % -% opts.splitting.info possible values: 0, 1, 2, false, true +% opts.splitting.info possible values: 0, 1, 2 % turn on (1) or off (0) the status output at % every time step. 2 prints only the time % steps. @@ -125,10 +150,10 @@ % % % Adaptivity, NOTE: not implemented, future functionality % -% opts.splitting.adaptive possible values: 0, 1, false, true, struct -% use adaptive time stepping (1, struct) or -% not (0) -% (optional, default 0) +% opts.splitting.adaptive possible values: false, true, struct +% use adaptive time stepping (true, struct) or +% not (false) +% (optional, default false) % % opts.splitting.adaptive.controller possible values: 'PI',0,'deadbeat' % the type of adaptive controller; PI @@ -150,11 +175,11 @@ % Output fields in struct out: % % out.Ls cell array with solution factor L for every time step -% if opts.splitting.intermediates = 1, otherwise the final +% if opts.splitting.intermediates = true, otherwise the final % factor % % out.Ds cell array with solution factor D for every time step -% if opts.splitting.intermediates = 1, otherwise the final +% if opts.splitting.intermediates = true, otherwise the final % factor % % out.Ks cell array with feedback term K for every time step @@ -177,65 +202,74 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Check for splitting control structure in options %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if not(isfield(opts,'splitting')) || not(isstruct(opts.splitting)) - error('MESS:control_data', ['splitting control structure opts.' ... - 'splitting missing.']); +if not(isfield(opts, 'splitting')) || not(isstruct(opts.splitting)) + mess_err(opts, 'control_data', ['splitting control structure opts.' ... + 'splitting missing.']); end % Single fields are checked below or inside subfunctions -if not(isfield(opts.splitting,'time_steps')) && ... - (not(isfield(opts.splitting,'adaptive')) || not(opts.splitting.adaptive)) - error('MESS:control_data', ['opts.splitting.time_steps is missing, and ' ... - 'adaptive time stepping has not been requested.']); +if not(isfield(opts.splitting, 'time_steps')) && ... + (not(isfield(opts.splitting, 'adaptive')) || not(opts.splitting.adaptive)) + mess_err(opts, 'control_data', ... + ['opts.splitting.time_steps is missing, and ' ... + 'adaptive time stepping has not been requested.']); end opts.t0 = opts.splitting.time_steps(1); -if not(isfield(opts.splitting, 'order')), opts.splitting.order = 2; end +if not(isfield(opts.splitting, 'order')) + opts.splitting.order = 2; +end if rem(opts.splitting.order, 1) || opts.splitting.order < 1 - error('MESS:control_data', 'opts.splitting.order has an invalid value.'); + mess_err(opts, 'control_data', ... + 'opts.splitting.order has an invalid value.'); end +if not(isfield(opts.splitting, 'additive')) + opts.splitting.additive = false; +end -if not(isfield(opts.splitting, 'additive')), opts.splitting.additive = 0; end - -if opts.splitting.order > 2, opts.splitting.additive = 1; end +if opts.splitting.order > 2 + opts.splitting.additive = true; +end -if not(isfield(opts.splitting, 'symmetric')) && (opts.splitting.additive == 1) - opts.splitting.symmetric = 0; +if not(isfield(opts.splitting, 'symmetric')) && ... + opts.splitting.additive + opts.splitting.symmetric = false; end if opts.splitting.additive && opts.splitting.symmetric && ... - rem(opts.splitting.order, 2) - error('MESS:control_data', ['opts.splitting.order must be a ' ... - 'multiple of 2 to use a symmetric scheme.']); + rem(opts.splitting.order, 2) + mess_err(opts, 'control_data', ... + ['opts.splitting.order must be a ' ... + 'multiple of 2 to use a symmetric scheme.']); end if not(isfield(opts.splitting, 'quadrature')) - error('MESS:control_data', ['Need to specify ' ... - 'opts.splitting.quadrature struct.']); + mess_err(opts, 'control_data', ... + 'Need to specify opts.splitting.quadrature struct.'); end if not(isfield(opts.splitting.quadrature, 'type')) - warning('MESS:control_data',['Unspecified quadrature type. Setting ' ... - 'opts.splitting.quadrature.type=''gauss''']); + mess_warn(opts, 'control_data', ... + ['Unspecified quadrature type. ' ... + 'Setting opts.splitting.quadrature.type=''gauss''']); opts.splitting.quadrature.type = 'gauss'; - -elseif not(ismember(opts.splitting.quadrature.type,{'gauss','clenshawcurtis', ... - 'equidistant','adaptive'})) - warning('MESS:control_data',['Unsupported quadrature type. Setting ' ... - 'opts.splitting.quadrature.type=''gauss''']); +elseif not(ismember(opts.splitting.quadrature.type, ... + {'gauss', 'clenshawcurtis', 'equidistant'})) + mess_warn(opts, 'control_data', ... + ['The specified quadrature type is ' ... + 'not supported.\n setting opts.splitting.quadrature.type=''gauss''']); opts.splitting.quadrature.type = 'gauss'; end @@ -252,7 +286,7 @@ if opts.splitting.additive if opts.splitting.symmetric - opts.splitting.quadrature.order = 2*s + 3; + opts.splitting.quadrature.order = 2 * s + 3; else if mod(s, 2) == 0 % even opts.splitting.quadrature.order = s + 3; @@ -264,31 +298,51 @@ end +if not(isfield(opts.splitting.quadrature, 'rel_err')) + opts.splitting.quadrature.rel_err = true; +end + +if not(isfield(opts.splitting.quadrature, 'adaptive')) + opts.splitting.quadrature.adaptive = true; +end + +if not(isfield(opts.splitting.quadrature, 'intervals')) + opts.splitting.quadrature.intervals = 1; +end + +if not(isfield(opts.splitting.quadrature, 'embedded')) + opts.splitting.quadrature.embedded = false; +end + if strcmp(opts.splitting.quadrature.type, 'clenshawcurtis') - opts.splitting.quadrature.order = opts.splitting.quadrature.order ... - + rem(opts.splitting.quadrature.order, 2); + opts.splitting.quadrature.order = opts.splitting.quadrature.order + ... + rem(opts.splitting.quadrature.order, 2); end -if strcmp(opts.splitting.quadrature.type, 'adaptive') && ... +if opts.splitting.quadrature.adaptive && ... not(isfield(opts.splitting.quadrature, 'tol')) - warning('MESS:control_data',['Using adaptive quadrature, but ' ... - 'tolerance unspecified. Setting ' ... - 'opts.splitting.quadrature.tol=1e-4']); - opts.splitting.quadrature.tol = 1e-4; + mess_warn(opts, 'control_data', ... + ['Using adaptive quadrature, but ' ... + 'tolerance unspecified. Setting ' ... + 'opts.splitting.quadrature.tol=1e-4']); + opts.splitting.quadrature.tol = 1e-4; end if not(isfield(opts.splitting, 'intermediates')) - opts.splitting.intermediates = 1; + opts.splitting.intermediates = true; end -if not(isfield(opts.splitting,'info')), opts.splitting.info = 2; end +if not(isfield(opts.splitting, 'info')) + opts.splitting.info = 2; +end -if isfield(opts,'LDL_T') && (opts.LDL_T == 0) - warning('MESS:control_data',['The splitting code only supports ' ... - 'LDL_T solutions.\n Setting opts.LDL_T=1']); +if isfield(opts, 'LDL_T') && not(opts.LDL_T) + mess_warn(opts, 'control_data', ... + ['The splitting code only supports ' ... + 'LDL_T solutions.\n Setting opts.LDL_T = true']); end -opts.LDL_T = 1; +opts.LDL_T = true; %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -297,15 +351,15 @@ if not(isfield(opts.splitting, 'adaptive')) || ... not(isstruct(opts.splitting.adaptive)) - opts.splitting.adaptive = 0; + opts.splitting.adaptive = false; end -if opts.splitting.adaptive ~= 0 +if not(opts.splitting.adaptive == 0) - error('MESS:missing_feature', ['Time step adaptivity has not yet been' - 'implemented.']); + mess_err(opts, 'missing_feature', ... + 'Time step adaptivity has not yet been implemented.'); - if not(isfield(opts.splitting.adaptive, 'controller')) %#ok + if not(isfield(opts.splitting.adaptive, 'controller')) opts.splitting.adaptive.controller = 'PI'; end @@ -316,47 +370,48 @@ end if not(isfield(opts.splitting.adaptive, 'epus')) - opts.splitting.adaptive.epus = 1; + opts.splitting.adaptive.epus = true; end - end - %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Check system data %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if not(isfield(eqn,'type')) +if not(isfield(eqn, 'type')) eqn.type = 'N'; - warning('MESS:control_data',['Unable to determine type of equation.'... - 'Falling back to type ''N''']); -elseif (eqn.type~='N') && (eqn.type~='T') - error('MESS:equation_type', ['Equation type must be either ''T'' ', ... - 'or ''N''']); + mess_warn(opts, 'control_data', ... + ['Unable to determine type of equation.'... + 'Falling back to type ''N''']); +elseif not(eqn.type == 'N') && not(eqn.type == 'T') + mess_err(opts, 'equation_type', ... + 'Equation type must be either ''T'' or ''N'''); end if not(isfield(eqn, 'LTV')) - eqn.LTV = 0; + eqn.LTV = false; end if eqn.LTV % Instantiate matrices at first time step if isfield(oper, 'eval_matrix_functions') - [eqn, opts, oper] = oper.eval_matrix_functions(eqn, opts, oper, ... - opts.splitting.time_steps(1)); + [eqn, opts, oper] = ... + oper.eval_matrix_functions(eqn, opts, oper, ... + opts.splitting.time_steps(1)); else - error('MESS:missing_feature', ['The function eval_matrix_functions is ', ... - 'required for LTV problems, but it has ', ... - 'not yet been implemented for this set ', ... - 'of USFS functions']); + mess_err(opts, 'missing_feature', ... + ['The function eval_matrix_functions is ', ... + 'required for LTV problems, but it has ', ... + 'not yet been implemented for this set ', ... + 'of USFS functions']); end end -[result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A','E'); +[result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A', 'E'); if not(result) - error('MESS:control_data', ['system data is not completely ', ... - 'defined or corrupted']); + mess_err(opts, 'control_data', ['system data is not completely ', ... + 'defined or corrupted']); end % If the user sends in sparse B and C, make them dense @@ -366,41 +421,39 @@ end if not(isfield(eqn, 'C')) || not(isnumeric(eqn.C)) - error('MESS:control_data', 'eqn.C is not defined or corrupted'); + mess_err(opts, 'control_data', 'eqn.C is not defined or corrupted'); end if not(isfield(eqn, 'B')) || not(isnumeric(eqn.B)) - error('MESS:control_data', 'eqn.B is not defined or corrupted'); + mess_err(opts, 'control_data', 'eqn.B is not defined or corrupted'); end if not(isfield(eqn, 'L0')) || not(isnumeric(eqn.L0)) - warning('MESS:control_data', ... - ['Initial condition factor L0 is not defined or corrupted.',... - ' Setting it to the zero vector.']); + mess_warn(opts, 'control_data', ... + ['Initial condition factor L0 is not defined or ', ... + 'corrupted. Setting it to the zero vector.']); eqn.L0 = zeros(oper.size(eqn, opts), 1); end if not(isfield(eqn, 'D0')) || not(isnumeric(eqn.D0)) - warning('MESS:control_data', ... - ['Initial condition factor D0 is not defined or corrupted.',... - ' Setting it to the identity matrix.']); + mess_warn(opts, 'control_data', ... + ['Initial condition factor D0 is not defined or ', ... + 'corrupted. Setting it to the identity matrix.']); eqn.D0 = eye(size(eqn.L0, 2)); end - % Extra check of general splitting data, which has to be run after the % operator structure has been initialized. It cannot be initialized before % the main splitting checks, because in the LTV case the initialization % needs the first time step, which exists in opts.splitting.time_steps... -if not(isfield(opts.splitting,'trunc_tol')) +if not(isfield(opts.splitting, 'trunc_tol')) opts.splitting.trunc_tol = eps * oper.size(eqn, opts); end -if not(isfield(opts.splitting,'trunc_info')) +if not(isfield(opts.splitting, 'trunc_info')) opts.splitting.trunc_info = 0; end - %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % @@ -416,7 +469,6 @@ [eqn, opts, oper] = oper.mul_E_pre(eqn, opts, oper); - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Initialize data %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -424,19 +476,19 @@ % We solve E'*d/dt X(t)*E = C'*C + E'*X(t)*A + A'*X(t)*E % - E'*X(t)*B*B'*X(t)*E (eqn.type == 'T') % forward in time instead and then flip everything. -t = opts.splitting.time_steps; +time_steps = opts.splitting.time_steps; % In the LTV case, this means we have to evaluate the matrix functions at % tend - t rather than t. if eqn.LTV - opts.splitting.eval_matrix_functions = @(eqn, opts, oper, s) ... - oper.eval_matrix_functions(eqn, opts, oper, t(end) - s); + opts.splitting.eval_matrix_functions = @(eqn, opts, oper, t) ... + oper.eval_matrix_functions(eqn, opts, oper, time_steps(end) - t, 1); else - opts.splitting.eval_matrix_functions = @(eqn, opts, oper, s) ... - mess_do_nothing(eqn, opts, oper); + opts.splitting.eval_matrix_functions = @(eqn, opts, oper, t) ... + mess_do_nothing(eqn, opts, oper); end -Nt = length(t) - 1; -h = (t(end) - t(1)) / Nt; +Nt = length(time_steps) - 1; +h = (time_steps(end) - time_steps(1)) / Nt; L0 = eqn.L0; D0 = eqn.D0; @@ -445,22 +497,22 @@ ms(1) = size(L0, 2); if opts.splitting.intermediates - Ls{Nt+1} = []; + Ls{Nt + 1} = []; Ls{1} = L0; - Ds{Nt+1} = []; + Ds{Nt + 1} = []; Ds{1} = D0; else Ls = L0; Ds = D0; end -Ks{Nt+1} = []; -[eqn, opts, oper] = opts.splitting.eval_matrix_functions(eqn, opts, oper, t(1)); - +Ks{Nt + 1} = []; +[eqn, opts, oper] = ... + opts.splitting.eval_matrix_functions(eqn, opts, oper, time_steps(1)); if eqn.type == 'T' - Ks{1} = (oper.mul_E(eqn, opts, 'T', L0*(D0*(L0'*eqn.B)), 'N'))'; + Ks{1} = (oper.mul_E(eqn, opts, 'T', L0 * (D0 * (L0' * eqn.B)), 'N'))'; elseif eqn.type == 'N' - Ks{1} = (oper.mul_E(eqn, opts, 'T', L0*(D0*(L0'*eqn.C')), 'N'))'; + Ks{1} = (oper.mul_E(eqn, opts, 'T', L0 * (D0 * (L0' * eqn.C')), 'N'))'; end % @@ -474,24 +526,24 @@ end if s == 2 % Strang - as = 1/2; + as = 1 / 2; end if opts.splitting.additive if opts.splitting.symmetric - switch s/2 + switch s / 2 case 1 - gamma = 1/2; + gamma = 1 / 2; case 2 - gamma = [-1/6, 2/3]; + gamma = [-1 / 6, 2 / 3]; case 3 - gamma = [1/48; -8/15; 81/80]; + gamma = [1 / 48; -8 / 15; 81 / 80]; case 4 - gamma = [-1/720; 8/45; -729/560; 512/315]; + gamma = [-1 / 720; 8 / 45; -729 / 560; 512 / 315]; otherwise gamma = compute_additive_coefficients(s, true); end - as = 1./(1:s/2); + as = 1 ./ (1:s / 2); else switch s case 1 @@ -499,13 +551,13 @@ case 2 gamma = [-1, 2]; case 3 - gamma = [1/2, -4, 9/2]; + gamma = [1 / 2, -4, 9 / 2]; case 4 - gamma = [-1/6, 4, -27/2, 32/3]; + gamma = [-1 / 6, 4, -27 / 2, 32 / 3]; otherwise gamma = compute_additive_coefficients(s, false); end - as = 1./(1:s); + as = 1 ./ (1:s); end end @@ -514,7 +566,6 @@ [IQL, IQD] = IQ(eqn, opts, oper, 0, h, as); end - %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Start iteration @@ -522,7 +573,7 @@ for k = 1:Nt if opts.splitting.info > 0 - fprintf('Step: %d of %d, time = %d \n', k, Nt, t(k)); + fprintf('Step: %d of %d, time = %d \n', k, Nt, time_steps(k)); end if opts.splitting.intermediates @@ -534,42 +585,35 @@ end if s == 1 % Lie - [Lnew, Dnew] = expG(eqn, opts, oper, h, Lold, Dold, t(k)); - + [Lnew, Dnew] = expG(eqn, opts, oper, h, Lold, Dold, time_steps(k)); if eqn.LTV - [IQL, IQD] = IQ(eqn, opts, oper, t(k), h, as); + [IQL, IQD] = IQ(eqn, opts, oper, time_steps(k), h, as); end - - [Lnew, Dnew, eqn, opts, oper] = expF(eqn, opts, oper, h, ... - IQL{1}{1}, IQD{1}{1}, ... - Lnew, Dnew, t(k)); - - elseif (s == 2) && not(opts.splitting.additive) % Strang + [Lnew, Dnew, eqn, opts, oper] ... + = expF(eqn, opts, oper, h, IQL{1}{1}, IQD{1}{1}, Lnew, Dnew, time_steps(k)); + elseif s == 2 && not(opts.splitting.additive) % Strang if eqn.LTV - [IQL, IQD] = IQ(eqn, opts, oper, [t(k), t(k) + h/2], h, as); + [IQL, IQD] = IQ(eqn, opts, oper, [time_steps(k), time_steps(k) + h / 2], h, as); end - - [Lnew, Dnew, eqn, opts, oper] = expF(eqn, opts, oper, h/2, ... - IQL{1}{1}, IQD{1}{1}, ... - Lold, Dold, t(k)); - - [Lnew, Dnew] = expG(eqn, opts, oper, h, Lnew, Dnew, t(k)); - + [Lnew, Dnew, eqn, opts, oper] ... + = expF(eqn, opts, oper, ... + h / 2, IQL{1}{1}, IQD{1}{1}, Lold, Dold, time_steps(k)); + [Lnew, Dnew] = expG(eqn, opts, oper, h, Lnew, Dnew, time_steps(k)); if eqn.LTV - [Lnew, Dnew, eqn, opts, oper] = expF(eqn, opts, oper, h/2, ... - IQL{2}{1}, IQD{2}{1}, ... - Lnew, Dnew, t(k) + h/2); + [Lnew, Dnew, eqn, opts, oper] ... + = expF(eqn, opts, oper, ... + h / 2, IQL{2}{1}, IQD{2}{1}, Lnew, Dnew, time_steps(k) + h / 2); else - [Lnew, Dnew, eqn, opts, oper] = expF(eqn, opts, oper, h/2, ... + [Lnew, Dnew, eqn, opts, oper] = expF(eqn, opts, oper, h / 2, ... IQL{1}{1}, IQD{1}{1}, ... Lnew, Dnew); end - elseif opts.splitting.additive - - if opts.splitting.symmetric, lmax = s/2; else, lmax = s; end - - tk = t(k); + if opts.splitting.symmetric + lmax = s / 2; + else + lmax = s; + end if opts.splitting.symmetric if not(eqn.LTV) @@ -584,24 +628,28 @@ D1l = Dold; D2l = Dold; - for m = 1:l % No dependence on m, just do the operations l times - [L2l, D2l, ~, opts_par, ~] = expF(eqn, opts_par, ... - oper, h / l, ... - IQL1{l}, ... - IQD1{l}, ... - L2l, D2l); + for m = 1:l + % No dependence on m, + % just do the operations l times + [L2l, D2l, ~, opts_par, ~] = expF(eqn, ... + opts_par, ... + oper, h / l, ... + IQL1{l}, ... + IQD1{l}, ... + L2l, D2l); [L2l, D2l] = expG(eqn, opts, oper, h / l, ... - L2l, D2l); + L2l, D2l); [L1l, D1l] = expG(eqn, opts, oper, h / l, ... - L1l, D1l); - - [L1l, D1l, ~, opts_par, ~] = expF(eqn, opts_par, ... - oper, h / l, ... - IQL1{l}, ... - IQD1{l}, ... - L1l, D1l); + L1l, D1l); + + [L1l, D1l, ~, opts_par, ~] = expF(eqn, ... + opts_par, ... + oper, h / l, ... + IQL1{l}, ... + IQD1{l}, ... + L1l, D1l); end L1{l} = L1l; L2{l} = L2l; @@ -622,28 +670,38 @@ % temporary variable is used after the parfor-loop. % (Even though it isn't.) [IQLpar, IQDpar] = IQ(eqn, opts_par, oper, ... - tk + h*(0:l-1)/l, h, 1/l); + tk + h * (0:l - 1) / l, ... + h, ... + 1 / l); for m = 1:l - tt = tk + (m-1) / l * h; - - [L2l, D2l, ~, opts_par, ~] = expF(eqn, opts_par, ... - oper, h / l, ... - IQLpar{m}{1}, ... - IQDpar{m}{1}, ... - L2l, D2l, tt); + tt = tk + (m - 1) / l * h; + + [L2l, D2l, ~, opts_par, ~] = expF(eqn, ... + opts_par, ... + oper, ... + h / l, ... + IQLpar{m}{1}, ... + IQDpar{m}{1}, ... + L2l, ... + D2l, ... + tt); [L2l, D2l] = expG(eqn, opts, oper, h / l, ... - L2l, D2l, tt); + L2l, D2l, tt); [L1l, D1l] = expG(eqn, opts, oper, h / l, ... - L1l, D1l, tt); - - [L1l, D1l, ~, opts_par, ~] = expF(eqn, opts_par, ... - oper, h / l, ... - IQLpar{m}{1}, ... - IQDpar{m}{1}, ... - L1l, D1l, tt); + L1l, D1l, tt); + + [L1l, D1l, ~, opts_par, ~] = expF(eqn, ... + opts_par, ... + oper, ... + h / l, ... + IQLpar{m}{1}, ... + IQDpar{m}{1}, ... + L1l, ... + D1l, ... + tt); end L1{l} = L1l; L2{l} = L2l; @@ -655,14 +713,17 @@ % Stack the results Lnew = [cell2mat(L1), cell2mat(L2)]; - D1 = cellfun(@times, D1, num2cell(gamma), 'UniformOutput', false); - D2 = cellfun(@times, D2, num2cell(gamma), 'UniformOutput', false); + D1 = cellfun(@times, D1, num2cell(gamma), ... + 'UniformOutput', false); + D2 = cellfun(@times, D2, num2cell(gamma), ... + 'UniformOutput', false); Dnew = blkdiag(D1{:}, D2{:}); - [Lnew, Dnew] = mess_column_compression(Lnew, 'N', Dnew, ... - opts.splitting.trunc_tol, ... - opts.splitting.trunc_info); + [Lnew, Dnew] = ... + mess_column_compression(Lnew, 'N', Dnew, ... + opts.splitting.trunc_tol, ... + opts.splitting.trunc_info); else % Asymmetric case if not(eqn.LTV) @@ -675,19 +736,21 @@ L1l = Lold; D1l = Dold; - for m = 1:l % No dependence on m, just do the operations l times + for m = 1:l + % No dependence on m, + % just do the operations l times [L1l, D1l] = expG(eqn, opts, oper, h / l, ... - L1l, D1l); + L1l, D1l); [L1l, D1l, ~, opts_par, ~] = expF(eqn, opts_par, ... - oper, h / l, ... - IQL1{l}, ... - IQD1{l}, ... - L1l, D1l); + oper, h / l, ... + IQL1{l}, ... + IQD1{l}, ... + L1l, D1l); end L1{l} = L1l; D1{l} = D1l; - end + end else % Time-varying case parfor l = 1:lmax % Local copy of opts for parallelization @@ -699,23 +762,23 @@ % temporary variable is used after the parfor-loop. % (Even though it isn't.) [IQLpar, IQDpar] = IQ(eqn, opts_par, oper, ... - tk + h*(0:l-1)/l, h, 1/l); + tk + h * (0:l - 1) / l, h, 1 / l); for m = 1:l - tt = tk + (m-1) / l * h; + tt = tk + (m - 1) / l * h; [L1l, D1l] = expG(eqn, opts, oper, h / l, ... - L1l, D1l, tt); + L1l, D1l, tt); [L1l, D1l, ~, opts_par, ~] = expF(eqn, opts_par, ... - oper, h / l, ... - IQLpar{m}{1}, ... - IQDpar{m}{1}, ... - L1l, D1l, tt); + oper, h / l, ... + IQLpar{m}{1}, ... + IQDpar{m}{1}, ... + L1l, D1l, tt); end L1{l} = L1l; D1{l} = D1l; - end + end end % Stack the results @@ -726,27 +789,27 @@ Dnew = blkdiag(D1{:}); [Lnew, Dnew] = mess_column_compression(Lnew, 'N', Dnew, ... - opts.splitting.trunc_tol, opts.splitting.trunc_info); + opts.splitting.trunc_tol, opts.splitting.trunc_info); end end if opts.splitting.intermediates - Ls{k+1} = Lnew; - Ds{k+1} = Dnew; + Ls{k + 1} = Lnew; + Ds{k + 1} = Dnew; else Ls = Lnew; Ds = Dnew; end - ms(k+1) = size(Dnew, 1); + ms(k + 1) = size(Dnew, 1); % Store feedback term K as well. We have % (T): K = B' LDL' E = (E'*LDL'*B)' and % (N): K = C LDL' E = (E'*LDL'*C')' % The extra transpose is because we can only multiply with E from the left. if eqn.type == 'T' - Ks{k+1} = (oper.mul_E(eqn, opts, 'T', Lnew*(Dnew*(Lnew'*eqn.B)), 'N'))'; + Ks{k + 1} = (oper.mul_E(eqn, opts, 'T', Lnew * (Dnew * (Lnew' * eqn.B)), 'N'))'; elseif eqn.type == 'N' - Ks{k+1} = (oper.mul_E(eqn, opts, 'T', Lnew*(Dnew*(Lnew'*eqn.C')),'N'))'; + Ks{k + 1} = (oper.mul_E(eqn, opts, 'T', Lnew * (Dnew * (Lnew' * eqn.C')), 'N'))'; end end diff --git a/mat-eqn-solvers/mess_sylvester_sparse_dense.m b/mat-eqn-solvers/mess_sylvester_sparse_dense.m new file mode 100644 index 0000000..9d0d5e0 --- /dev/null +++ b/mat-eqn-solvers/mess_sylvester_sparse_dense.m @@ -0,0 +1,275 @@ +function [X, eigH, eqn, opts, oper] = mess_sylvester_sparse_dense(varargin) +%% MESS_SYLVESTER_SPARSE_DENSE Solves the Sylvester equation +% +% A * X * F + E * X * H = -M (1) +% +% with F, H small and dense and A, E large and sparse. +% +% Calling sequence: +% +% [X ,eigH, eqn, ops, oper] = ... +% mess_sylvester_sparse_dense(A, TransA, H, TransH, M, E, F) +% +% or +% +% [X ,eigH, eqn, ops, oper] = ... +% mess_sylvester_sparse_dense(eqn, opts,oper, H, TransH, M, F) +% +% If TransA == 'T' the matrices A and E are treated transposed in (1). +% Similarly, TransH == 'T' indicates the same for F, H. +% +% The inputs E and F are optional and default to the identities of +% appropriate size when omitted. +% +% If TransA, TransH are not 'T', or not set, they are set to 'N', i.e., +% (1) is solved just as given above. In the "eqn, opts, oper" case TransA +% is decided from eqn.type and existence of E is determined from eqn.haveE. +% + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +%% check inputs +opts = struct; +if isstruct(varargin{1}) && ... + isstruct(varargin{2}) && ... + isstruct(varargin{3}) + + % The case: mess_sylvester_sparse_dense(eqn, opts, oper, ... + % H, TransH, M, F) + if nargin < 6 + mess_err(opts, 'inputs', ... + ['At least 6 arguments required, ', ... + 'when first input is a matrix']); + + end + + eqn = varargin{1}; + opts = varargin{2}; + oper = varargin{3}; + + if ismatrix(varargin{4}) + H = full(varargin{4}); + else + mess_err(opts, 'inputs', ... + ['Fourth argument must be a dense matrix, ', ... + 'when first is a matrix']); + end + + if isa(varargin{5}, 'char') + TransH = varargin{5}; + else + mess_err(opts, 'inputs', ... + 'Fifth argument must be a char, when first is a matrix'); + end + if not(TransH == 'T') + TransH = 'N'; + end + + if ismatrix(varargin{6}) + M = varargin{6}; + else + mess_err(opts, 'inputs', ... + ['Sixth argument must be a matrix, ', ... + 'when the first is a matrix']); + end + + if nargin < 7 + haveF = false; + F = []; + elseif ismatrix(varargin{7}) + haveF = true; + F = full(varargin{7}); + else + mess_err(opts, 'inputs', ... + ['7th argument must be a matrix, ', ... + 'when the first is a matrix']); + end + +elseif isnumeric(varargin{1}) && ismatrix(varargin{1}) + % The case: mess_sylvester_sparse_dense(A, TransA, H, TransH, M, E, F) + if nargin < 5 + mess_err(opts, 'inputs', ... + ['At least 5 arguments required, ', ... + 'when first input is a matrix']); + + end + + if isa(varargin{2}, 'char') + TransA = varargin{2}; + else + mess_err(opts, 'inputs', ... + 'Second argument must be a char, when first is a matrix'); + end + if not(TransA == 'T') + TransA = 'N'; + end + + if ismatrix(varargin{3}) + H = full(varargin{3}); + else + mess_err(opts, 'inputs', ... + ['Third argument must be a dense matrix, ', ... + 'when first is a matrix']); + end + + if isa(varargin{4}, 'char') + TransH = varargin{4}; + else + mess_err(opts, 'inputs', .... + 'Second argument must be a char, when first is a matrix'); + end + if not(TransH == 'T') + TransH = 'N'; + end + + if ismatrix(varargin{5}) + M = varargin{5}; + else + mess_err(opts, 'inputs', ... + ['Fifth argument must be a matrix, ', ... + 'when the first is a matrix']); + end + + if nargin < 6 + eqn.haveE = false; + else + eqn.E_ = varargin{6}; + % If the user passed the identity for E we still want haveE to be + % false + eqn.haveE = not(full(sum(sum(eqn.E_ - speye(size(eqn.E_, 1)) > ... + eps))) == 0); + if not(eqn.haveE) + eqn = rmfield(eqn, 'E_'); + end + end + + if nargin < 7 + haveF = false; + F = []; + elseif ismatrix(varargin{7}) + haveF = true; + F = full(varargin{7}); + else + mess_err(opts, 'inputs', ... + ['7th argument must be a matrix, ', ... + 'when the first is a matrix']); + end + + % set eqn + eqn.A_ = varargin{1}; + eqn.type = TransA; + + % set oper and opts + [oper, opts] = operatormanager(opts, 'default'); + opts.norm = 2; + +end + +%% Transformation to triangular form +if not(haveF) + [Q, S] = schur(H, 'complex'); + M = M * Q; +else + [T, S, Q, Z] = qz(F, H); + switch TransH + case 'N' + M = M * Z; + Q = Q'; + case 'T' + M = M * Q'; + Q = Z; + end +end + +[~, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A', 'E'); +[eqn, opts, oper] = oper.sol_ApE_pre(eqn, opts, oper); +[eqn, opts, oper] = oper.mul_A_pre(eqn, opts, oper); +[eqn, opts, oper] = oper.mul_E_pre(eqn, opts, oper); + +nH = size(H, 1); +nA = oper.size(eqn, opts, oper); +X = zeros(nA, nH); +AX = zeros(nA, nH); +EX = zeros(nA, nH); + +if TransH == 'N' + if not(haveF) % case: AX + EXH + M = 0 + for j = 1:nH + prev = 1:(j - 1); + rhs = X(:, prev) * S(prev, j); + rhs = -M(:, j) - oper.mul_E(eqn, opts, eqn.type, rhs, 'N'); + X(:, j) = oper.sol_ApE(eqn, opts, eqn.type, ... + S(j, j), eqn.type, rhs, 'N'); + end + + else % case: AXF + EXH + M = 0 + for j = 1:nH + prev = 1:(j - 1); + rhs = -M(:, j) - ... + AX(:, prev) * T(prev, j) - ... + EX(:, prev) * S(prev, j); + X(:, j) = oper.sol_ApE(eqn, opts, ... + eqn.type, ... + S(j, j) / T(j, j), ... + eqn.type, ... + T(j, j) \ rhs, ... + 'N'); + + if j < nH + AX(:, j) = oper.mul_A(eqn, opts, eqn.type, X(:, j), 'N'); + EX(:, j) = oper.mul_E(eqn, opts, eqn.type, X(:, j), 'N'); + end + end + end +else % TransH == 'T' + if not(haveF) % case: A'X + E'XH + M = 0 + for j = nH:-1:1 + prev = (j + 1):nH; + rhs = X(:, prev) * S(j, prev)'; + rhs = -M(:, j) - oper.mul_E(eqn, opts, eqn.type, rhs, 'N'); + X(:, j) = oper.sol_ApE(eqn, opts, ... + eqn.type, ... + conj(S(j, j)), ... + eqn.type, ... + rhs, ... + 'N'); + end + + else % case: A'XF + E'XH + M = 0 + for j = nH:-1:1 + prev = (j + 1):nH; + rhs = -M(:, j) - ... + AX(:, prev) * T(j, prev)' - ... + EX(:, prev) * S(j, prev)'; + X(:, j) = oper.sol_ApE(eqn, opts, ... + eqn.type, ... + conj(S(j, j)) / conj(T(j, j)), ... + eqn.type, ... + conj(T(j, j)) \ rhs, ... + 'N'); + if j > 1 + AX(:, j) = oper.mul_A(eqn, opts, eqn.type, X(:, j), 'N'); + EX(:, j) = oper.mul_E(eqn, opts, eqn.type, X(:, j), 'N'); + end + end + end +end + +X = X * Q'; + +if isreal(H) && isreal(F) + X = real(X); +end +eigH = diag(S); + +[eqn, opts, oper] = oper.sol_ApE_post(eqn, opts, oper); +[eqn, opts, oper] = oper.mul_A_post(eqn, opts, oper); +[eqn, opts, oper] = oper.mul_E_post(eqn, opts, oper); + +end diff --git a/mat-eqn-solvers/private/IQ.m b/mat-eqn-solvers/private/IQ.m index e3a7381..61b4232 100644 --- a/mat-eqn-solvers/private/IQ.m +++ b/mat-eqn-solvers/private/IQ.m @@ -1,15 +1,15 @@ function [IQLas, IQDas, eqn, opts, oper] ... - = IQ(eqn, opts, oper, t0s, h, as) + = IQ(eqn, opts, oper, t_zeros, h, as) % Compute the low-rank factors LDL^T of the integrals % -% \int_{t0s(i)}^{t0s(i) + as(k)*h}{ +% \int_{t_zeros(i)}^{t_zeros(i) + as(k)*h}{ % exp(s(A E^{-1})^T)E^{-T} C^T C E^{-1} exp(s A E^{-1}) ds}, % -% for all the initial times t0(i) in the vector t0s and all scaling factors +% for all the initial times t0(i) in the vector t_zeros and all scaling factors % as(k) in the vector as. This is for eqn.type == 'T'. For eqn.type == 'N', % we factorize instead % -% \int_{t0s(i)}^{t0s(i) + h}{ +% \int_{t_zeros(i)}^{t_zeros(i) + h}{ % exp(s A E^{-1})E^{-1} B B^T E^{-T} exp(s (A E^{-1})^T) ds}. % % If eqn.LTV is true, the integrand is replaced by the relevant integral. @@ -24,7 +24,7 @@ % with A and E % % Input: -% t0s starting times, array +% t_zeros starting times, array % % h main time step size, scalar > 0 % @@ -33,77 +33,67 @@ % % Output: % IQLas cell array such that IQLAs{i}{k} is the L factor corresponding -% to t0s(i) and as(k) +% to t_zeros(i) and as(k) % % IQDas cell array such that IQLAs{i}{k} is the D factor corresponding -% to t0s(i) and as(k) +% to t_zeros(i) and as(k) % % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - qtype = opts.splitting.quadrature.type; order = opts.splitting.quadrature.order; +rel = opts.splitting.quadrature.rel_err; % Decide which type of quadrature to use and compute nodes and weights for % the interval [0, h]. These are then shifted appropriately later. -adaptive = false; +adaptive = opts.splitting.quadrature.adaptive; +embedded = adaptive && opts.splitting.quadrature.embedded; +intervals = opts.splitting.quadrature.intervals; +if (strcmp(qtype, 'clenshawcurtis') || embedded) && rem(order, 2) == 1 + mess_err(opts, 'control_data', ['Quadrature order must be even for' ... + 'Clenshaw-Curtis or embedded formulas.']); +end switch qtype - case 'gauss' - - [xj, wj] = gauss_quadrature_parameters(h, order); - + [xj_base, wj_base] = gauss_quadrature_parameters(1, order); + embedded = false; case 'clenshawcurtis' - - if rem(order,2) == 1 - error('MESS:control_data', ['Quadrature order must be even ' ... - 'Clenshaw-Curtis.']); + [xj_base, wj_base] = clenshawcurtis_parameters(0, 1, order); + xj_base = flipud(xj_base); + if embedded + [~, wj2_base] = clenshawcurtis_parameters(0, 1, order / 2); end - [xj, wj] = clenshawcurtis_parameters(0, h, order); - - case 'adaptive' - - % nodes/weights computed in loop further down - adaptive = true; - order = 4; - case 'equidistant' - - % Equidistant nodes - used for the adaptive methods - xj = linspace(0, h, order+1)'; - wj = compute_quadrature_weights(h, xj); - + xj_base = linspace(0, 1, order + 1)'; + wj_base = compute_quadrature_weights(1, xj_base); + if embedded + wj2_base = compute_quadrature_weights(1, xj_base(1:2:end)); + end otherwise - - error('MESS:IQ:Unknown quadrature type provided.'); + mess_err(opts, 'control_data', ... + 'The specified quadrature type is not supported.'); end +%% set data TOL = 1e-4; if isfield(opts.splitting.quadrature, 'tol') TOL = opts.splitting.quadrature.tol; end -nts = length(t0s); +nts = length(t_zeros); nas = length(as); IQLas = cell(nts, nas); IQDas = cell(nts, nas); -if adaptive - IQLas2 = cell(nts, nas); - IQDas2 = cell(nts, nas); -end - -Las = cell(nts,nas); % The Ls used to form each IQL - % In the autonomous case, we have a fixed block to apply the matrix % exponential to: if not(eqn.LTV) @@ -113,125 +103,149 @@ elseif eqn.type == 'N' LQ = eqn.B; end - % We assume that DQ = I, always. - DQ = eye(size(LQ, 2)); +else + LQ = []; end - - -for k = 1:length(t0s) - - t0 = t0s(k); - errest = Inf; - - % This loop breaks after one iteration unless the adaptive strategy is used: - while errest > TOL - - if adaptive - [xj, wj] = clenshawcurtis_parameters(0, h, order); - [~, wj2] = clenshawcurtis_parameters(0, h, order/2); - % Sort the nodes from 0 to h instead, for iterative computation - % (the weights are symmetric) - xj = flipud(xj); - end - - % For each scaling factor as(k) compute the values Ls(xj) - for l = 1:length(as) - - if not(eqn.LTV) % Autonomous case - Ls = cell(1, length(xj)); - RHS = oper.sol_E(eqn, opts, eqn.type, LQ, 'N'); - % For legacy reasons, the sol_E_DAE2 function does not - % return the rows corresponding to only the states, but the - % full solution. We therefore cut it down to size here. - % This does nothing in the other cases when RHS already has - % the correct size. - RHS = RHS(1:size(LQ,1), :); % - [out, ~, opts, ~] ... - = mess_exp_action(eqn, opts, oper, as(l)*xj(1), RHS); - Ls{1} = out.Z; - - for m = 2:length(xj) - - dx = as(l)*(xj(m) - xj(m-1)); - Ltemp = oper.mul_E(eqn, opts, eqn.type, Ls{m-1}, 'N'); - RHS = oper.sol_E(eqn, opts, eqn.type, Ltemp, 'N'); - % See above comment about RHS: - RHS = RHS(1:size(LQ,1), :); - [out, ~, opts, ~] ... - = mess_exp_action(eqn, opts, oper, dx, RHS); - Ls{m} = out.Z; - end - else % Timevarying case - % This can be done somewhat faster by using BLAS-3 - % blocking, but it requires more memory. See the DREsplit - % package for this option, omitted in the M.E.S.S. version. - for m = 1:length(xj) - - t = t0 + as(l)*xj(m); - % RHS is E(t)'\LQ(t), so update the matrices - [eqn, opts, oper] = ... - opts.splitting.eval_matrix_functions(eqn, opts, ... - oper, t); - if eqn.type == 'T' - LQ = eqn.C'; - elseif eqn.type == 'N' - LQ = eqn.B; - end - ELQ = oper.sol_E(eqn, opts, eqn.type, LQ, 'N'); - % See above comment about RHS: - ELQ = ELQ(1:size(LQ,1), :); - - [out, ~, opts, ~] = mess_exp_action(eqn, opts, oper, ... - as(l)*(h-xj(m)), ... - full(ELQ), t); - Ls{m} = out.Z; - end +%% iterate t_zeros +for i = 1:nts + t0 = t_zeros(i); + %% For each scaling factor as(k) approximate the integral over + % [t0, t0 + as(k)*h] + % Start at the largest a, then the final number of intervals should + % be enough also for the smaller ones. + for k = 1:nas + errest = Inf; + IQLf = []; + %% adaptive loop + % This loop breaks after one iteration unless the adaptive strategy + % is used: + while errest > TOL + % Coarse intervals + % Scale from [0,1] to [0, as(k)*h / intervals] + interval_length = as(k) * h / intervals; + xjc = xj_base * interval_length; + wjc = wj_base * interval_length; + + % The intervals are t0 + xjc, t0 + interval_length + xjc, ... + % Starting points of these intervals: + t0c = t0 + interval_length * (0:intervals); % one extra + + % Fine intervals, twice as many + interval_length_f = as(k) * h / intervals / 2; + xjf = xj_base * interval_length_f; + t0f = t0 + interval_length_f * (0:intervals * 2); % one extra + wjf = wj_base * interval_length_f; + if embedded + wj2f = wj2_base * interval_length_f; + else + wj2f = []; end - - Las{k}{l} = Ls; - IQLas{k}{l} = cell2mat(Ls); - - % Build block diagonal matrix with weight(j)*as(k)*DQ as blocks - if eqn.LTV % We don't know the size of DQ a priori. - DQ = eye(size(LQ, 2)); + %% build block matrices L and D + if isempty(IQLf) + [eqn, opts, oper, IQLc, IQDc] = ... + approximate_subintegrals(eqn, opts, oper, t0c, xjc, ... + wjc, [], as(k), LQ, false, rel); + else + IQLc = IQLf; + IQDc = IQDf; end - - IQDas{k}{l} = kron(diag(wj * as(l)), DQ); - end - - % Column compress approximations - for l = 1:length(as) - [IQLas{k}{l}, IQDas{k}{l}] = ... - mess_column_compression(IQLas{k}{l}, 'N', IQDas{k}{l}, ... - opts.splitting.trunc_tol, opts.splitting.trunc_info); - end - - if adaptive - % Column compress coarser approximation - for l = 1:length(as) - - [IQLas2{k}{l}, IQDas2{k}{l}] = ... - mess_column_compression(... - cell2mat(Las{k}{l}(1:2:end)), 'N', ... - kron(diag(wj2 * as(l)), DQ), ... - opts.splitting.trunc_tol, ... - opts.splitting.trunc_info); + [eqn, opts, oper, IQLf, IQDf, errest_embedded] = ... + approximate_subintegrals(eqn, opts, oper, t0f, xjf, wjf, ... + wj2f, as(k), LQ, embedded, rel); + + % Final result (temporary) + IQLas{i}{k} = IQLf; + IQDas{i}{k} = IQDf; + + %% error estimation + errest_composite = outerfrobnormdiff_LDLT( ... + IQLc, IQDc, IQLf, IQDf, rel); + errest = max(errest_embedded, errest_composite); + if adaptive + if errest > TOL + intervals = intervals * 2; + end + else + break end + end + end +end +end - errest = 0; - - for l = 1:length(as) - errest = ... - max(errest, ... - outerfrobnormdiff_LDLT(IQLas{k}{l}, IQDas{k}{l}, ... - IQLas2{k}{l}, IQDas2{k}{l})); +function [eqn, opts, oper, IQL, IQD, errest] = ... + approximate_subintegrals(eqn, opts, oper, t_zeros_subintegrals, ... + xj, wj, wj2, a, LQ, embedded, rel) +IQL = cell(1, length(t_zeros_subintegrals) - 1); +IQD = cell(1, length(t_zeros_subintegrals) - 1); +IQL2 = cell(1, length(t_zeros_subintegrals) - 1); +IQD2 = cell(1, length(t_zeros_subintegrals) - 1); +Ls = cell(1, length(xj)); +if not(eqn.LTV) + if eqn.type == 'T' + LQ = eqn.C'; + elseif eqn.type == 'N' + LQ = eqn.B; + end +end +for l = 1:length(t_zeros_subintegrals) - 1 + for j = 1:length(xj) + r = t_zeros_subintegrals(l) + xj(j); + t = t_zeros_subintegrals(end); + if eqn.LTV + % RHS is E(r)'\LQ(r), so update the matrices + [eqn, opts, oper] = ... + opts.splitting.eval_matrix_functions(eqn, opts, ... + oper, r); + if eqn.type == 'T' + LQ = eqn.C'; + elseif eqn.type == 'N' + LQ = eqn.B; end - else - break end + ELQ = oper.sol_E(eqn, opts, eqn.type, LQ, 'N'); + % See above comment about RHS: + ELQ = ELQ(1:size(LQ, 1), :); + + [out, ~, opts] = mess_exp_action(eqn, opts, oper, ... + t - r, full(ELQ), r); + Ls{j} = out.Z; + end - order = order * 2; + %% build block matrices L and D over subinterval + IQL{l} = cell2mat(Ls); + % Build block diagonal matrix with wj(j)*DQ as blocks + % LTV: We don't know the size of DQ a priori. + DQ = eye(size(LQ, 2)); + IQD{l} = kron(diag(wj), DQ); + + % Column compress approximation + [IQL{l}, IQD{l}] = ... + mess_column_compression(IQL{l}, 'N', IQD{l}, ... + opts.splitting.trunc_tol, opts.splitting.trunc_info); + % Column compress coarser approximation + if embedded + IQL2{l} = cell2mat(Ls(1:2:end)); + IQD2{l} = kron(diag(wj2 * a), DQ); + [IQL2{l}, IQD2{l}] = ... + mess_column_compression(IQL2{l}, 'N', IQD2{l}, ... + opts.splitting.trunc_tol, opts.splitting.trunc_info); end end +%% build block matrices L and D over full interval +% Column compress over t0 to get approximation over full interval +[IQL, IQD] = ... + mess_column_compression(cell2mat(IQL), 'N', blkdiag(IQD{:}), ... + opts.splitting.trunc_tol, opts.splitting.trunc_info); +if embedded + % Column compress coarser approximation + [IQL2, IQD2] = ... + mess_column_compression(cell2mat(IQL2), 'N', blkdiag(IQD2{:}), ... + opts.splitting.trunc_tol, opts.splitting.trunc_info); + %% error estimation + errest = outerfrobnormdiff_LDLT(IQL, IQD, IQL2, IQD2, rel); +else + errest = 0; +end end diff --git a/mat-eqn-solvers/private/KSM_compute_res.m b/mat-eqn-solvers/private/KSM_compute_res.m new file mode 100644 index 0000000..44b508a --- /dev/null +++ b/mat-eqn-solvers/private/KSM_compute_res.m @@ -0,0 +1,96 @@ +function [eqn, opts, oper] = KSM_compute_res(eqn, opts, oper) +% function [eqn, opts, oper] = KSM_compute_res(eqn,opts,oper) +% Function that compute the absolute residual norm +% +% Input and output: +% +% eqn structure containing equation data +% +% opts structure containing parameters for the algorithm +% +% oper contains function handles with operations for A and E +% + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +it = opts.KSM.compute_struct.it; + +if not(isfield(opts.KSM.compute_struct, 'res')) + opts.KSM.compute_struct.res = []; +end + +if strcmp('EK', opts.KSM.space) + p = size(opts.KSM.compute_struct.beta, 2) / 2; + Y = opts.KSM.compute_struct.Y; + T = opts.KSM.compute_struct.T; + + cc = T(2 * p * it + 1:2 * p * (it + 1), end - 2 * p + 1:end); + % Compute the residual norm + if eqn.haveE + W = [opts.KSM.compute_struct.V(:, 1:2 * p * it) * ... + (Y(:, 2 * p * (it - 1) + 1:2 * p * it) * cc'), ... + opts.KSM.compute_struct.V(:, 2 * p * it + 1: ... + 2 * p * (it + 1))]; + switch eqn.type + case 'N' + D = oper.ss_to_dss(eqn, opts, 'L', 'N', W, 'N'); + case 'T' + D = oper.ss_to_dss(eqn, opts, 'U', 'T', W, 'N'); + end + + [~, N] = qr(full(D), 0); + N = triu(N); + K = zeros(4 * p); + K(1:2 * p, 2 * p + 1:end) = eye(2 * p); + K(2 * p + 1:end, 1:2 * p) = eye(2 * p); + res = norm(N * K * N', 'fro'); + else + res = sqrt(2) * ... + norm(cc * Y(2 * p * (it - 1) + 1:2 * p * it, :), 'fro'); + end + opts.KSM.compute_struct.res = ... + [opts.KSM.compute_struct.res, res]; + +elseif strcmp('RK', opts.KSM.space) + p = size(opts.KSM.compute_struct.beta, 2); + Y = opts.KSM.compute_struct.Y; + T = opts.KSM.compute_struct.T; + H = opts.KSM.compute_struct.H; + V = opts.KSM.compute_struct.V; + + W = [V(:, 1:p * it) * ... + (Y * (H(1:p * it, 1:p * it)' \ ... + H(p * it + 1:p * (it + 1), 1:p * it)')), ... + V(:, p * it + 1:p * (it + 1)) * ... + opts.KSM.compute_struct.shifts(end - 1) - ... + opts.KSM.compute_struct.AVnew + ... + V(:, 1:p * it) * T(1:p * it, p * it + 1:p * (it + 1))]; + + if eqn.haveE + switch eqn.type + case 'N' + D = oper.ss_to_dss(eqn, opts, 'L', 'N', W, 'N'); + case 'T' + D = oper.ss_to_dss(eqn, opts, 'U', 'T', W, 'N'); + end + else + D = W; + end + [~, N] = qr(full(D), 0); + N = triu(N); + K = zeros(2 * p); + K(1:p, p + 1:end) = eye(p); + K(p + 1:end, 1:p) = eye(p); + res = norm(N * K * N', 'fro'); + opts.KSM.compute_struct.res = ... + [opts.KSM.compute_struct.res, res]; + +end + +end diff --git a/mat-eqn-solvers/private/KSM_compute_shifts.m b/mat-eqn-solvers/private/KSM_compute_shifts.m new file mode 100644 index 0000000..0e3c530 --- /dev/null +++ b/mat-eqn-solvers/private/KSM_compute_shifts.m @@ -0,0 +1,188 @@ +function [eqn, opts, oper] = KSM_compute_shifts(eqn, opts, oper) +% function [eqn,opts,oper] = KSM_compute_shifts(eqn,opts,oper) +% Function that computes the new shift of the rational Krylov subspace +% +% Input and output: +% +% eqn structure containing equation data +% +% opts structure containing parameters for the algorithm +% +% oper contains function handles with operations for A and E +% +% +% Output: +% +% opts.KSM.compute_struct structure containing the following: +% +% new_shift computed shift to use in the basis construction of RK +% +% shifts all the computed shifts +% +% shift_cmplxflag true if the last computed shift is complex. +% Then, we need to incorporate its complex conjugate +% + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +p = size(eqn.W, 2); + +it = opts.KSM.compute_struct.it; +if it == 1 + + % compute the eigenvalues of T + eH = eig(opts.KSM.compute_struct.T(1:it * p, 1:it * p)); + eHpoints = sort(opts.KSM.init_shifts); + + % compute the new shift + opts.KSM.compute_struct.new_shift = ... + newpolei(eHpoints, eH, opts.KSM.init_shifts(2) * ones(p, 1)); + % check that it's contained in the right half plane + if real(opts.KSM.compute_struct.new_shift) < 0 + opts.KSM.compute_struct.new_shift = ... + -real(opts.KSM.compute_struct.new_shift) + ... + 1i * imag(opts.KSM.compute_struct.new_shift); + end + % update the shift array + opts.KSM.compute_struct.shifts = ... + [opts.KSM.compute_struct.shifts, ... + opts.KSM.compute_struct.new_shift]; + + % If pole is complex, include its conjugate + opts.KSM.compute_struct.shift_cmplxflag = ... + not(isreal(opts.KSM.compute_struct.new_shift)); + +else + + if strcmp(opts.KSM.type_eqn, 'CARE') && ... + isfield(opts.KSM.compute_struct, 'Y') + if isfield(opts.KSM, 'CARE_shifts') && ... + strcmp(opts.KSM.CARE_shifts, 'Ritz_closedloop') + Y = opts.KSM.compute_struct.Y; + B = opts.KSM.compute_struct.Bm; + B = B(1:p * it, :); + sizeY = size(Y); + % since we may not compute Y at each iteration, we pad it with + % extra zero rows and columns to match the dimension of T if + % necessary + if not(sizeY(1) == p * it) + Y = [[Y; zeros(it * p - sizeY(1), sizeY(2))], ... + zeros(it * p, it * p - sizeY(2))]; + end + eH = ... + eig(opts.KSM.compute_struct.T(1:it * p, 1:it * p) + ... + B * (B' * Y)); + else + eH = eig(opts.KSM.compute_struct.T(1:it * p, 1:it * p)); + end + else + eH = eig(opts.KSM.compute_struct.T(1:it * p, 1:it * p)); + end + eH = sort(eH); + eHorig = eH; + + if strcmp(opts.KSM.type_shifts, 'complex') + % Complex poles. Compute set for next complex pole of r_m + + if any(imag(eH)) && max(abs(imag(eH))) > 1e-5 && length(eH) > 2 + % Roots lambdas come from convex hull too + eH = [eH; -opts.KSM.init_shifts(1)]; + ij = convhull(real(eH), imag(eH)); + eH = eH(ij); + ieH = length(eH); + missing = it * p - ieH; + while missing > 0 + % include enough points from the border + neweH = (eH(1:ieH - 1) + eH(2:ieH)) / 2; + eH = [eH; neweH]; %#ok + missing = it * p - length(eH); + end + + eHpoints = -eH; + eH = eHorig; + else + % if all real eigs, no convex hull possible + eHpoints = sort( ... + [opts.KSM.init_shifts(2); ... + opts.KSM.init_shifts(1).'; ... + -real(eH)]); + end + + else + % Real poles s from real set. Compute complex roots of r_m via Ritz + % convex hull + if any(imag(eH)) && length(eH) > 2 + % Roots lambdas come from convex hull too + eH = [eH; -opts.KSM.init_shifts(2); -opts.KSM.init_shifts(1).']; + ij = convhull(real(eH), imag(eH)); + eH = eH(ij); + ieH = length(eH); + missing = it * p - ieH; + while missing > 0 + % include enough points from the border + neweH = (eH(1:ieH - 1) + eH(2:ieH)) / 2; + eH = [eH; neweH]; %#ok + missing = it * p - length(eH); + end + eH = eH(1:it * p); + end + eHpoints = sort( ... + [opts.KSM.init_shifts(2); ... + opts.KSM.init_shifts(1).'; ... + -real(eH)]); + eH = eHorig; + end + + gs = kron(opts.KSM.compute_struct.shifts(2:end), ones(1, p))'; + opts.KSM.compute_struct.new_shift = newpolei(eHpoints, eH, gs); + % check that it's contained in the right half plane + if real(opts.KSM.compute_struct.new_shift) < 0 + opts.KSM.compute_struct.new_shift = ... + -real(opts.KSM.compute_struct.new_shift) + ... + 1i * imag(opts.KSM.compute_struct.new_shift); + end + + % If pole is complex, include its conjugate + opts.KSM.compute_struct.shift_cmplxflag = ... + not(isreal(opts.KSM.compute_struct.new_shift)); + + % update the shift array + opts.KSM.compute_struct.shifts = ... + [opts.KSM.compute_struct.shifts, ... + opts.KSM.compute_struct.new_shift]; + +end +% print the shift if needed +if opts.shifts.info + mess_fprintf(opts, 'New shift: %10.5e\n', ... + opts.KSM.compute_struct.new_shift); +end + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +function r = ratfun(x, eH, s) +r = zeros(length(x), 1); +for j = 1:length(x) + r(j) = abs(prod((x(j) - s) ./ (x(j) - eH))); +end + +return + +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +function snew = newpolei(eHpoints, eH, s) + +snew_vec = zeros(length(eHpoints) - 1, 1); +for j = 1:length(eHpoints) - 1 + sval = linspace(eHpoints(j), eHpoints(j + 1), 20); + [~, jx] = max (abs(ratfun(sval, eH, s))); + snew_vec(j) = sval(jx); +end +[~, jx] = max(abs(ratfun(snew_vec, eH, s))); +snew = snew_vec(jx); +return diff --git a/mat-eqn-solvers/private/KSM_getT.m b/mat-eqn-solvers/private/KSM_getT.m new file mode 100644 index 0000000..f0e1448 --- /dev/null +++ b/mat-eqn-solvers/private/KSM_getT.m @@ -0,0 +1,155 @@ +function [eqn, opts, oper] = KSM_getT(eqn, opts, oper) +% function [eqn,opts,oper] = KSM_getT(eqn,opts,oper) +% Function that computes the update the projection of A onto the current +% subspace +% +% Input and output: +% +% eqn structure containing equation data +% +% opts structure containing parameters for the algorithm +% +% oper contains function handles with operations for A and E +% +% opts.KSM.compute_struct structure that contain all the useful +% information computed in the previous +% iterations +% +% +% Output: +% +% opts.KSM.compute_struct structure containing the following: +% +% opts.KSM.compute_struct.V basis of the current space +% +% opts.KSM.compute_struct.H matrix collecting the coefficients +% stemming from the Arnoldi +% (or Lanczos) process +% +% opts.KSM.compute_struct.T projection of A onto the current +% space, namely T=V'*A*V +% +% opts.KSM.compute_struct.L, matrices needed to recover the +% columns of T +% opts.KSM.compute_struct.rho from the columns of H +% +% opts.KSM.compute_struct.beta p-by-p matrix such that +% B=V_1*compute_struct.beta +% + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +[eqn, opts, oper] = oper.mul_A_pre(eqn, opts, oper); +p = size(eqn.W, 2); + +VV = opts.KSM.compute_struct.V; +it = opts.KSM.compute_struct.it; + +if strcmp('EK', opts.KSM.space) + Lnew = zeros(2 * p * (it + 1), 2 * p); + Tnew = Lnew; +elseif strcmp('RK', opts.KSM.space) + Tnew = zeros(p * (it + 1), p); +end + +if strcmp('EK', opts.KSM.space) + + if opts.KSM.explicit_proj + T = opts.KSM.compute_struct.T; + AVnew = oper.mul_A(eqn, opts, eqn.type, ... + VV(:, 2 * p * (it - 1) + 1:2 * p * it), 'N'); + Tnew = VV' * AVnew; + + % expand T + if it == 1 + opts.KSM.compute_struct.T = Tnew; + else + opts.KSM.compute_struct.T = ... + [[T; zeros(2 * p, 2 * p * (it - 1))], Tnew]; + end + + else + + L = opts.KSM.compute_struct.L; + T = opts.KSM.compute_struct.T; + H = opts.KSM.compute_struct.H; + hinv = inv(H(2 * p * it + 1:2 * p * (it + 1), :)); + + % Compute the projected matrix T=V'*A*V from the columns of H + if it == 1 + ibeta = inv(opts.KSM.compute_struct.beta); + Lnew = [H(1:3 * p, 1:p) / ibeta(1:p, 1:p), ... + speye(3 * p, p) / ibeta(1:p, 1:p)] * ... + ibeta(1:2 * p, p + 1:2 * p); + else + Lnew(1:2 * p * it, 1:p) = L(1:2 * p * it, p + 1:2 * p) + ... + H(1:2 * p * it, 1:p) * opts.KSM.compute_struct.rho; + Lnew(2 * p * it + 1:2 * p * (it + 1), 1:p) = ... + H(2 * p * it + 1:2 * p * (it + 1), 1:p) * ... + opts.KSM.compute_struct.rho; + end + + % the odd columns of T correspond to the odd column of H + Tnew(1:2 * p * (it + 1), 1:p) = H(1:2 * p * (it + 1), 1:p); % odd columns + + % the even columns of T correspond to the even column of L + % notice that the last pX2p block of such columns is a zero + Tnew(1:2 * p * it + p, p + 1:2 * p) = Lnew(1:2 * p * it + p, 1:p); + + % expand T + if it == 1 + opts.KSM.compute_struct.T = Tnew; + else + opts.KSM.compute_struct.T = ... + [[T; zeros(2 * p, 2 * p * (it - 1))], Tnew]; + end + + I = eye(2 * p * (it + 1)); + Lnew(1:2 * p * (it + 1), p + 1:2 * p) = ... + (I(1:2 * p * (it + 1), 2 * p * it - p + 1:2 * p * it) - ... + opts.KSM.compute_struct.T(1:2 * p * (it + 1), ... + 1:2 * p * it) * ... + H(1:2 * p * it, p + 1:2 * p)) * ... + hinv(p + 1:2 * p, p + 1:2 * p); + + opts.KSM.compute_struct.rho = ... + hinv(1:p, 1:p) \ hinv(1:p, p + 1:2 * p); + opts.KSM.compute_struct.L = Lnew; + + end + +elseif strcmp('RK', opts.KSM.space) + + T = opts.KSM.compute_struct.T; + + % expand T + if isempty(T) + AVnew = oper.mul_A(eqn, opts, eqn.type, ... + VV(:, p * (it - 1) + 1:p * it), 'N'); + Tnew = VV' * AVnew; + opts.KSM.compute_struct.T = Tnew; + else + + AVnew = oper.mul_A(eqn, opts, eqn.type, ... + VV(:, p * it + 1:p * (it + 1)), 'N'); + Tnew = VV' * AVnew; + + % compute the new (block) row of T: Vnew^T*A*VV by first computing + % A^T*Vnew + % REMARK: in RK, the projection of A is not upper Hessenberg in + % general + AVV = oper.mul_A(eqn, opts, eqn.type, VV(:, 1:p * it), 'N'); + Tnew_row = VV(:, p * it + 1:p * (it + 1))' * AVV; + opts.KSM.compute_struct.T = [[T; Tnew_row], Tnew]; + end + opts.KSM.compute_struct.AVnew = AVnew; +end + +[eqn, opts, oper] = oper.mul_A_post(eqn, opts, oper); +end diff --git a/mat-eqn-solvers/private/KSM_mgs.m b/mat-eqn-solvers/private/KSM_mgs.m new file mode 100644 index 0000000..7592e44 --- /dev/null +++ b/mat-eqn-solvers/private/KSM_mgs.m @@ -0,0 +1,126 @@ +function [eqn, opts, oper] = KSM_mgs(eqn, opts, oper) +% KSM_MGS implements the (block) modified Gram-Schmidt +% orthogonalization method for the KSM framework +% +% Input and output: +% +% eqn structure containing equation data +% +% opts structure containing parameters for the algorithm +% +% oper contains function handles with operations for A and E +% +% +% Most important here: +% opts.KSM.compute_struct +% structure that contain all the useful information computed in +% the previous iterations with members: +% +% opts.KSM.compute_struct.V basis of the current space +% +% opts.KSM.compute_struct.H matrix collecting the +% coefficients stemming from the +% Arnoldi/Lanczos process +% +% opts.KSM.compute_struct.T projection of A onto the current +% space, namely T=V'*A*V +% +% opts.KSM.compute_struct.L, matrices needed to recover the +% columns of T +% opts.KSM.compute_struct.rho from the columns of H +% +% opts.KSM.compute_struct.beta p-by-p matrix such that +% B=V_1*compute_struct.beta +% + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +p = size(eqn.W, 2); + +VV = opts.KSM.compute_struct.V; +Vnew = opts.KSM.compute_struct.Vnew; +it = opts.KSM.compute_struct.it; +% perform a full orthogonalization for a better stability +k_max = it; + +% current number of iteration +if strcmp('EK', opts.KSM.space) + Hnew = zeros(2 * p * (it + 1), 2 * p); + + for l = 1:2 + k_min = max(1, it - k_max); + for kk = k_min:it + k1 = (kk - 1) * 2 * p + 1; + k2 = kk * 2 * p; + coef = VV(:, k1:k2)' * Vnew; + Hnew(k1:k2, :) = Hnew(k1:k2, :) + coef; + Vnew = Vnew - VV(:, k1:k2) * coef; + end + end + + % Normalization + if it <= opts.KSM.maxiter + [Vnew, Hnew(2 * p * it + 1:2 * p * (it + 1), :)] = qr(Vnew, 0); + end + + % Compute also the projection of B if we are solving a care + if strcmp(opts.KSM.type_eqn, 'CARE') + switch eqn.type + case 'N' + Bnew = Vnew' * eqn.ssC'; + case 'T' + Bnew = Vnew' * eqn.ssB; + end + opts.KSM.compute_struct.Bm = ... + [opts.KSM.compute_struct.Bm; Bnew]; + end + opts.KSM.compute_struct.V = [VV, Vnew]; + opts.KSM.compute_struct.H = Hnew; + +elseif strcmp('RK', opts.KSM.space) + H = opts.KSM.compute_struct.H; + Hnew = zeros(p * (it + 1), p); + + for l = 1:2 + k_min = max(1, it - k_max); + for kk = k_min:it + k1 = (kk - 1) * p + 1; + k2 = kk * p; + coef = VV(:, k1:k2)' * Vnew; + Hnew(k1:k2, :) = Hnew(k1:k2, :) + coef; + Vnew = Vnew - VV(:, k1:k2) * coef; + end + end + + % Normalization + if it <= opts.KSM.maxiter + [Vnew, Hnew(p * it + 1:p * (it + 1), :)] = qr(Vnew, 0); + end + + % Compute also the projection of B if we are solving a care + if strcmp(opts.KSM.type_eqn, 'CARE') + switch eqn.type + case 'N' + Bnew = Vnew' * eqn.ssC'; + case 'T' + Bnew = Vnew' * eqn.ssB; + end + opts.KSM.compute_struct.Bm = ... + [opts.KSM.compute_struct.Bm; Bnew]; + end + opts.KSM.compute_struct.V = [VV, Vnew]; + + if not(isempty(H)) + opts.KSM.compute_struct.H = [[H; zeros(p, p * (it - 1))], Hnew]; + else + opts.KSM.compute_struct.H = Hnew; + end +end + +end diff --git a/mat-eqn-solvers/private/KSM_space_expansion.m b/mat-eqn-solvers/private/KSM_space_expansion.m new file mode 100644 index 0000000..60f952d --- /dev/null +++ b/mat-eqn-solvers/private/KSM_space_expansion.m @@ -0,0 +1,205 @@ +function [eqn, opts, oper] = KSM_space_expansion(eqn, opts, oper) +% function compute_struct = KSM_space_expansion(eqn, opts, oper, ... +% compute_struct) +% Function that computes the next basis block for the space +% enlarging the basis V and update the projection of A onto such a +% space +% +% Input and output: +% +% eqn structure containing equation data +% +% opts structure containing parameters for the algorithm +% +% oper contains function handles with operations for A and E +% +% +% +% Output: +% +% opts.KSM.compute_struct structure containing the following: +% +% opts.KSM.compute_struct.V basis of the current space +% +% opts.KSM.compute_struct.H matrix collecting the coefficients +% stemming from the Arnoldi +% (or Lanczos) process +% +% opts.KSM.compute_struct.T projection of A onto the current +% space, namely T=V'*A*V +% +% opts.KSM.compute_struct.L, matrices needed to recover the +% columns of T +% opts.KSM.compute_struct.rho from the columns of H +% +% opts.KSM.compute_struct.beta p-by-p matrix such that +% B=V_1*compute_struct.beta + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +p = size(eqn.W, 2); + +VV = opts.KSM.compute_struct.V; + +% current number of iteration +if strcmp('EK', opts.KSM.space) + [eqn, opts, oper] = oper.mul_A_pre(eqn, opts, oper); + [eqn, opts, oper] = oper.sol_A_pre(eqn, opts, oper); + opts.KSM.compute_struct.it = size(VV, 2) / (2 * p); +elseif strcmp('RK', opts.KSM.space) + opts.KSM.compute_struct.it = size(VV, 2) / p; +end + +if isempty(VV) + if strcmp('EK', opts.KSM.space) + rhs = eqn.ssW; + rhs_inv = oper.sol_A(eqn, opts, eqn.type, rhs, 'N'); + [Vnew, beta] = qr([rhs, rhs_inv], 0); + opts.KSM.compute_struct.H = []; + opts.KSM.compute_struct.T = []; + opts.KSM.compute_struct.L = []; + opts.KSM.compute_struct.beta = beta; + opts.KSM.compute_struct.V = Vnew; + + % Compute also the projection of the quadratic term core factor if + % we are solving a care + if strcmp(opts.KSM.type_eqn, 'CARE') + switch eqn.type + case 'N' + opts.KSM.compute_struct.Bm = Vnew' * eqn.ssC'; + + case 'T' + opts.KSM.compute_struct.Bm = Vnew' * eqn.ssB; + end + end + elseif strcmp('RK', opts.KSM.space) + rhs = eqn.ssW; + + % orthogonalize the low-rank factor of the rhs to get the initial + % block + [Vnew, beta] = qr(rhs, 0); + opts.KSM.compute_struct.H = []; + opts.KSM.compute_struct.T = []; + opts.KSM.compute_struct.L = []; + opts.KSM.compute_struct.beta = beta; + opts.KSM.compute_struct.V = Vnew; + opts.KSM.compute_struct.it = 1; + + % update the projection of A onto the current subspace + [eqn, opts, oper] = KSM_getT(eqn, opts, oper); + + % Compute the first shift + opts.KSM.compute_struct.shifts = opts.KSM.init_shifts(2); + [eqn, opts, oper] = KSM_compute_shifts(eqn, opts, oper); + + % Compute also the projection of the quadratic terms core factor if + % we are solving a care + if strcmp(opts.KSM.type_eqn, 'CARE') + switch eqn.type + case 'N' + opts.KSM.compute_struct.Bm = Vnew' * eqn.ssC'; + + case 'T' + opts.KSM.compute_struct.Bm = Vnew' * eqn.ssB; + end + end + + end + +else + + if strcmp('EK', opts.KSM.space) + + % take the last basis block + last_basis_block = VV(:, end - 2 * p + 1:end); + % multiply the first p columns by A + V1 = oper.mul_A(eqn, opts, eqn.type, ... + last_basis_block(:, 1:p), 'N'); + % multiply the last p columns by A^{-1} + V2 = oper.sol_A(eqn, opts, eqn.type, ... + last_basis_block(:, p + 1:2 * p), 'N'); + + opts.KSM.compute_struct.Vnew = [V1, V2]; + + % Block modified Gram-Schmidt + [eqn, opts, oper] = KSM_mgs(eqn, opts, oper); + + % update the projection of A onto the current subspace + [eqn, opts, oper] = KSM_getT(eqn, opts, oper); + + elseif strcmp('RK', opts.KSM.space) + + % we want a real basis! + opts.KSM.compute_struct.cmplxconjugate_flag = false; + + while not(opts.KSM.compute_struct.cmplxconjugate_flag) + % take the last basis block + last_basis_block = VV(:, end - p + 1:end); + + % solve the shifted linear system + % REMARK: mess_solve_shifted_system.m solves (A+p*E)x=v while + % in the RKSM framework we usually work with (A-p*E)x=v. + % Therefore, we pass -p as input + [Vnew, eqn, opts, oper] = ... + mess_solve_shifted_system(eqn, opts, oper, ... + -opts.KSM.compute_struct.new_shift, ... + last_basis_block); + + opts.KSM.compute_struct.basis_cmplxflag = false; + if any(imag(Vnew(:))) && ... + not(opts.KSM.compute_struct.basis_cmplxflag) + Vnew = real(Vnew); + opts.KSM.compute_struct.basis_cmplxflag = true; + elseif any(imag(Vnew(:))) && ... + opts.KSM.compute_struct.basis_cmplxflag + Vnew = imag(Vnew); + end + + opts.KSM.compute_struct.Vnew = Vnew; + + % Block modified Gram-Schmidt + [eqn, opts, oper] = KSM_mgs(eqn, opts, oper); + + if opts.KSM.compute_struct.shift_cmplxflag + % use the complex conjugate of the current shift as new + % shift + opts.KSM.compute_struct.new_shift = ... + conj(opts.KSM.compute_struct.new_shift); + opts.KSM.compute_struct.shifts = ... + [opts.KSM.compute_struct.shifts, ... + opts.KSM.compute_struct.new_shift]; + opts.KSM.compute_struct.shift_cmplxflag = false; + + % update the projection of A onto the current subspace + [eqn, opts, oper] = KSM_getT(eqn, opts, oper); + + % update the number of iterations + VV = opts.KSM.compute_struct.V; + opts.KSM.compute_struct.it = size(VV, 2) / p; + + else + opts.KSM.compute_struct.cmplxconjugate_flag = true; + end + end + + % Compute next shift + [eqn, opts, oper] = KSM_compute_shifts(eqn, opts, oper); + + % update the projection of A onto the current subspace + [eqn, opts, oper] = KSM_getT(eqn, opts, oper); + + end +end + +if strcmp('EK', opts.KSM.space) + [eqn, opts, oper] = oper.mul_A_post(eqn, opts, oper); + [eqn, opts, oper] = oper.sol_A_post(eqn, opts, oper); +end + +end diff --git a/mat-eqn-solvers/private/adaptive_SDIRK43.m b/mat-eqn-solvers/private/adaptive_SDIRK43.m index f0f19bf..7f88423 100644 --- a/mat-eqn-solvers/private/adaptive_SDIRK43.m +++ b/mat-eqn-solvers/private/adaptive_SDIRK43.m @@ -1,4 +1,4 @@ -function [out, eqn, opts, oper] = adaptive_SDIRK43(eqn, opts, oper, h, L, t0) +function [out, eqn, opts, oper] = adaptive_SDIRK43(eqn, opts, oper, h, L, t_zero) % Solve the system E(t)' \dot{z}(t) = A(t)' z(t) with z(0) = L over % the interval [t0, t0 + h]. If t0 is omitted it is assumed to be 0. % If eqn.type == 'N', instead solve E(t) \dot{z}(t) = A(t) z(t) . @@ -14,9 +14,9 @@ % II: Stiff and Differential-Algebraic Problems, 2nd Ed., Springer, 2002. % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % @@ -24,45 +24,46 @@ [n, p] = size(L); normL = norm(L); errest_order = 3; -tend = t0 + h; +tend = t_zero + h; TOL = opts.exp_action.tol; -c = [1/4, 3/4, 11/20, 1/2, 1]; +c = [1 / 4, 3 / 4, 11 / 20, 1 / 2, 1]; -aij = [ 1/4, 0, 0, 0, 0; - 1/2, 1/4, 0, 0, 0; - 17/50, -1/25, 1/4, 0, 0; - 371/1360, -137/2720, 15/544, 1/4, 0; - 25/24, -49/48, 125/16, -85/12, 1/4]; +aij = [1 / 4, 0, 0, 0, 0 + 1 / 2, 1 / 4, 0, 0, 0 + 17 / 50, -1 / 25, 1 / 4, 0, 0 + 371 / 1360, -137 / 2720, 15 / 544, 1 / 4, 0 + 25 / 24, -49 / 48, 125 / 16, -85 / 12, 1 / 4]; -b = [25/24, -49/48, 125/16, -85/12, 1/4]; +b = [25 / 24, -49 / 48, 125 / 16, -85 / 12, 1 / 4]; -b_err = [-3/16, -27/32, 25/32, 0, 1/4]; +b_err = [-3 / 16, -27 / 32, 25 / 32, 0, 1 / 4]; onep = ones(1, p); -B = zeros(5*p, 2*p); +B = zeros(5 * p, 2 * p); for k = 1:5 - B((k-1)*p+1:k*p, 1:p) = diag(b(k)*onep); - B((k-1)*p+1:k*p, p+1:2*p) = diag(b_err(k)*onep); + B((k - 1) * p + 1:k * p, 1:p) = diag(b(k) * onep); + B((k - 1) * p + 1:k * p, p + 1:2 * p) = diag(b_err(k) * onep); end -C = zeros(5*p, 5*p); +C = zeros(5 * p, 5 * p); for k = 1:5 - for l = 1:k-1 - C((l-1)*p+1:l*p, (k-1)*p+1:k*p) = diag(aij(k,l)*onep); + for l = 1:k - 1 + C((l - 1) * p + 1:l * p, (k - 1) * p + 1:k * p) = ... + diag(aij(k, l) * onep); end - C((k-1)*p+1:k*p, 1:p) = diag(b(k)*onep); + C((k - 1) * p + 1:k * p, 1:p) = diag(b(k) * onep); end -t = t0; -hj = (tend-t0) / 100; % Initial step size, heuristic +t = t_zero; +hj = (tend - t_zero) / 100; % Initial step size, heuristic -if hj == 0 +if hj < eps out.Z = L; return end @@ -71,32 +72,33 @@ % without eps the break condition can miss the last % iteration step which leaves the field 'out' unset -tend_eff = tend + eps * tend; +tend_eff = tend + eps * tend; while (t(end) + hj) < tend_eff - - K = zeros(n, 5*p); + K = zeros(n, 5 * p); for l = 1:5 [eqn, opts, oper] = ... opts.splitting.eval_matrix_functions(eqn, opts, oper, ... - t(end)+c(l)*hj); + t(end) + c(l) * hj); RHS = oper.mul_A(eqn, opts, eqn.type, ... - (u + hj*K(:, 1:(l-1)*p)*C(1:(l-1)*p, (l-1)*p+1:l*p)), 'N'); + u + hj * K(:, 1:(l - 1) * p) * ... + C(1:(l - 1) * p, (l - 1) * p + 1:l * p), 'N'); % Want to do (M - aij*h*A)\RHS, but only have support for % (A + pE)\RHS, so scale by -1/(aih*h) - coeff = -1.0/(aij(l,l)*hj); + coeff = -1.0 / (aij(l, l) * hj); - K(:, (l-1)*p+1:l*p) = oper.sol_ApE(eqn, opts, eqn.type, ... - coeff, eqn.type, coeff * RHS, 'N'); + K(:, (l - 1) * p + 1:l * p) = oper.sol_ApE(eqn, opts, eqn.type, ... + coeff, eqn.type, ... + coeff * RHS, 'N'); end % 4th-order approximation: % v2 = u + hj*( 25/24*k1 - 49/48*k2 + % + 125/16*k3 - 85/12*k4 + 1/4*k5); - v = u + hj*K*B(:,1:p); + v = u + hj * K * B(:, 1:p); % 3rd-order approximation: % v = u + h*( 59/48*k1 - 17/96*k2 + @@ -105,15 +107,15 @@ % evaluated in a better way: % errest = hj*norm( -3/16*k1 -27/32*k2 + % + 25/32*k3 + 0*k4 + 1/4*k5); - errest = hj/(1+normL)*norm(K*B(:,p+1:2*p)); + errest = hj / (1 + normL) * norm(K * B(:, p + 1:2 * p)); if errest > TOL % redo step - hj = (0.9*TOL/errest)^(1.0/(errest_order)) * hj; + hj = (0.9 * TOL / errest)^(1.0 / (errest_order)) * hj; else - t(end+1) = t(end) + hj; %#ok + t(end + 1) = t(end) + hj; %#ok % New step size - hj = (0.95*TOL/errest)^(1.0/errest_order) * hj; + hj = (0.95 * TOL / errest)^(1.0 / errest_order) * hj; u = v; @@ -123,9 +125,12 @@ end if t(end) + hj > tend % Ensure ending up precisely at tend - hj = tend-t(end); + hj = tend - t(end); end end end - +if not(exist('out', 'var')) + out.Z = v; + warning('something went wrong with the loop break'); +end end diff --git a/mat-eqn-solvers/private/change_timestep.m b/mat-eqn-solvers/private/change_timestep.m deleted file mode 100644 index 032e112..0000000 --- a/mat-eqn-solvers/private/change_timestep.m +++ /dev/null @@ -1,15 +0,0 @@ -% function hnew = change_timestep(h, errorest, eqn, opts, oper) -% % Placeholder function: future functionality -% % Update the step size based on the error estimate (adaptive solver) - -% -% This file is part of the M-M.E.S.S. project -% (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2021 Jens Saak, Martin Koehler, Peter Benner and others. -% All rights reserved. -% License: BSD 2-Clause License (see COPYING) -% - -% -% -% end \ No newline at end of file diff --git a/mat-eqn-solvers/private/clenshawcurtis_parameters.m b/mat-eqn-solvers/private/clenshawcurtis_parameters.m index 8e34498..066bb78 100644 --- a/mat-eqn-solvers/private/clenshawcurtis_parameters.m +++ b/mat-eqn-solvers/private/clenshawcurtis_parameters.m @@ -8,27 +8,27 @@ % % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % -h = b-a; % interval length +h = b - a; % interval length % Column 1 used for the weights, column 2 for the nodes, so we don't have % to call cos() at all (by setting frequency 1 to 1 and the rest to 0) -c = zeros(N+1, 2); -c(1:2:N+1,1) = (2./[1 1-(2:2:N).^2 ])'; -c(2,2) = 1; +c = zeros(N + 1, 2); +c(1:2:N + 1, 1) = (2 ./ [1 1 - (2:2:N).^2])'; +c(2, 2) = 1; -xi = real(ifft([c(1:N+1,:); c(N:-1:2,:)])); % symmetrize +xi = real(ifft([c(1:N + 1, :); c(N:-1:2, :)])); % symmetrize -w = h*xi(1:N+1,1); +w = h * xi(1:N + 1, 1); w(1) = w(1) / 2; w(end) = w(end) / 2; -x = ((b+a)/2 + N*h/2*xi(1:N+1,2)); +x = ((b + a) / 2 + N * h / 2 * xi(1:N + 1, 2)); end diff --git a/mat-eqn-solvers/private/compute_additive_coefficients.m b/mat-eqn-solvers/private/compute_additive_coefficients.m index da6627f..d2dd05d 100644 --- a/mat-eqn-solvers/private/compute_additive_coefficients.m +++ b/mat-eqn-solvers/private/compute_additive_coefficients.m @@ -9,9 +9,9 @@ % % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % @@ -19,25 +19,25 @@ if symmetric s = order / 2; - A = zeros(s,s); - A(1,:) = 1; - for k = 1:s-1 - A(k+1, :) = (1:s).^(-2*k); + A = zeros(s, s); + A(1, :) = 1; + for k = 1:s - 1 + A(k + 1, :) = (1:s).^(-2 * k); end - b = [1/2; zeros(s-1, 1)]; + b = [1 / 2; zeros(s - 1, 1)]; - gamma = A\b; + gamma = A \ b; else s = order; - A = zeros(s,s); - A(1,:) = 1; - for k = 1:s-1 - A(k+1, :) = (1:s).^(-k); + A = zeros(s, s); + A(1, :) = 1; + for k = 1:s - 1 + A(k + 1, :) = (1:s).^(-k); end - b = [1; zeros(s-1, 1)]; + b = [1; zeros(s - 1, 1)]; - gamma = A\b; -end \ No newline at end of file + gamma = A \ b; +end diff --git a/mat-eqn-solvers/private/compute_quadrature_weights.m b/mat-eqn-solvers/private/compute_quadrature_weights.m index 1c7cbfb..0b196e1 100644 --- a/mat-eqn-solvers/private/compute_quadrature_weights.m +++ b/mat-eqn-solvers/private/compute_quadrature_weights.m @@ -6,44 +6,43 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - - Cf = fliplr(vander(nodes))'; - if length(h) > 1 - b = h(2).^(1:length(nodes))' ... - ./ (1:length(nodes))' - h(1).^(1:length(nodes))' ... - ./ (1:length(nodes))'; - else - b = h.^(1:length(nodes))' ./ (1:length(nodes))'; - end +Cf = fliplr(vander(nodes))'; +if length(h) > 1 + b = h(2).^(1:length(nodes))' ./ ... + (1:length(nodes))' - h(1).^(1:length(nodes))' ./ ... + (1:length(nodes))'; +else + b = h.^(1:length(nodes))' ./ (1:length(nodes))'; +end % weights = Cf\b; - % Better for high number of nodes (ill-conditioned system) - weights = vandersolve(Cf, b); - +% Better for high number of nodes (ill-conditioned system) +weights = vandersolve(Cf, b); - function x = vandersolve(M,b) - % Solve the Vandermonde system M x = b according to the method described - % in A. Bjoerck and V. Pereyra, "Solution of Vandermonde +function x = vandersolve(M, b) + % Solve the Vandermonde system M x = b according to the method + % described in A. Bjoerck and V. Pereyra, "Solution of Vandermonde % Systems of Equations", Mathematics of Computation, Vol. 24, No. 112 % (Oct., 1970), pp. 893-903, http://www.jstor.org/stable/2004623. % (Eq. (14)-(15) for the primal system.) - n = size(M,1) - 1; - d = b; - for k=1:n - d(k+1:n+1) = d(k+1:n+1) - M(2,k)*d(k:n); - end - - x = d; - for k=n:-1:1 - x(k+1:n+1) = x(k+1:n+1) ./ (M(2,k+1:n+1) - M(2,1:n-k+1))'; - x(k:n) = x(k:n) - x(k+1:n+1); - end + n = size(M, 1) - 1; + d = b; + for k = 1:n + d(k + 1:n + 1) = d(k + 1:n + 1) - M(2, k) * d(k:n); + end + x = d; + for k = n:-1:1 + x(k + 1:n + 1) = x(k + 1:n + 1) ./ ... + (M(2, k + 1:n + 1) - M(2, 1:n - k + 1))'; + x(k:n) = x(k:n) - x(k + 1:n + 1); end -end \ No newline at end of file +end + +end diff --git a/helpers/exact_line_search.m b/mat-eqn-solvers/private/exact_line_search.m similarity index 68% rename from helpers/exact_line_search.m rename to mat-eqn-solvers/private/exact_line_search.m index 597b8d3..0f41807 100644 --- a/helpers/exact_line_search.m +++ b/mat-eqn-solvers/private/exact_line_search.m @@ -1,63 +1,59 @@ -function [ lambda ] = exact_line_search( W_old, DeltaK_old, W, DeltaK, S, S_old ) +function [lambda] = ... + exact_line_search(opts, W_old, DeltaK_old, W, DeltaK, S, S_old, R) % Compute lambda for exact line search % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% Check input if isempty(DeltaK_old) - DeltaK_old = 0; + if opts.LDL_T + DeltaK_old = zeros(size(DeltaK)); + else + DeltaK_old = 0; + end end -%% Compute scalar values -delta = sum(sum((DeltaK' * DeltaK).^2, 1), 2); - -if isempty(S) && isempty(S_old) - - alpha = sum(sum(( (W_old' * W_old) ).^2, 1), 2) ... - + sum(sum((DeltaK_old' * DeltaK_old).^2, 1), 2) ... - - 2.0 * sum(sum((DeltaK_old' * W_old).^2, 1), 2); - - beta = sum(sum((W' * W).^2, 1), 2); - - gamma = sum(sum((W_old' * W).^2, 1), 2) ... - - sum(sum((DeltaK_old' * W).^2, 1), 2); - - epsilon = sum(sum((W_old' * DeltaK).^2, 1), 2) ... - - sum(sum((DeltaK_old' * DeltaK).^2, 1), 2); +% This is just the squared Frobenius norm. Still, some arguments are +% none-square and thus we can not use our usual trick via norm of the +% eigenvalue vector. +% F = @(X) (sum(sum((X).^2, 1), 2)); % this appeared to be to unstable for the +% LDL_T case +F = @(X) sum(svd(X).^2); - zeta = sum(sum((DeltaK' * W).^2, 1), 2); +if not(isempty(R)) + DeltaK = DeltaK * sqrtm(R); -elseif not(isempty(S)) && not(isempty(S_old)) - - S = diag(sqrt(S)); + s = size(DeltaK_old, 2) / size(DeltaK, 2); + Rs = kron(ones(s), sqrtm(R)); + DeltaK_old = DeltaK_old * Rs; +end - S_old = diag(sqrt(S_old)); +if not(isempty(S)) && not(isempty(S_old)) + S = sqrtm(S); + S_old = sqrtm(S_old); + W = W * S; + W_old = W_old * S_old; +end - alpha = sum(sum((S_old * (W_old' * W_old) * S_old).^2, 1), 2) ... - + sum(sum((DeltaK_old' * DeltaK_old).^2, 1), 2) ... - - 2.0 * sum(sum((DeltaK_old' * W_old * S_old).^2, 1), 2); +%% Compute scalar values +alpha = F(W_old' * W_old) + F(DeltaK_old' * DeltaK_old) - ... + 2.0 * F(DeltaK_old' * W_old); - beta = sum(sum((S * (W' * W) * S).^2, 1), 2); +beta = F(W' * W); - gamma = sum(sum((S_old * W_old' * W * S).^2, 1), 2) ... - - sum(sum((DeltaK_old' * W * S).^2, 1), 2); +gamma = F(W_old' * W) - F(DeltaK_old' * W); - epsilon = sum(sum((S_old * W_old' * DeltaK).^2, 1), 2) ... - - sum(sum((DeltaK_old' * DeltaK).^2, 1), 2); +delta = F(DeltaK' * DeltaK); - zeta = sum(sum((DeltaK' * W * S).^2, 1), 2); +epsilon = F(W_old' * DeltaK) - F(DeltaK_old' * DeltaK); -else - error('MESS:exact_line_search', ... - 'Incorrect data for S and S_old.'); -end +zeta = F(DeltaK' * W); %% Compute lambda via eigenproblem a = [2.0 * (gamma - alpha), ... @@ -75,9 +71,9 @@ % Octave does not support eig(A, B, 'qz') use eig(A,B) as fallback in this case. try - lambda = eig(A, B, 'qz'); + lambda = eig(A, B, 'qz'); catch - lambda = eig(A, B); + lambda = eig(A, B); end lambda = lambda(not(imag(lambda))); @@ -86,21 +82,22 @@ if isempty(lambda) lambda = 0; - warning('MESS:exact_line_search', ... - 'Could not find a stepsize lambda.'); + mess_warn(opts, 'exact_line_search', ... + 'Could not find a stepsize lambda.'); elseif size(lambda, 1) > 1 - f = @(t) ((1.0 - t).^2) * alpha ... - + (t.^2) * beta ... - + (2.0 * t .* (1.0 - t)) * gamma ... - + (t.^4) * delta ... - - (2.0 * t.^2 .* (1.0 - t)) * epsilon ... - - (2.0 * t.^3) * zeta; + f = @(t) ((1.0 - t).^2) * alpha + ... + (t.^2) * beta + ... + (2.0 * t .* (1.0 - t)) * gamma + ... + (t.^4) * delta - ... + (2.0 * t.^2 .* (1.0 - t)) * epsilon - ... + (2.0 * t.^3) * zeta; [~, I] = min(f(lambda)); lambda = lambda(I); end end + % Here we keep alternative formulations that we tested in case this routine % is investigated again in the future. %% This is the original code by Heiko Weichelt with fminbnd diff --git a/mat-eqn-solvers/private/exact_quadrature_parameters.m b/mat-eqn-solvers/private/exact_quadrature_parameters.m index efb05d5..b0e60fa 100644 --- a/mat-eqn-solvers/private/exact_quadrature_parameters.m +++ b/mat-eqn-solvers/private/exact_quadrature_parameters.m @@ -9,7 +9,7 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % @@ -19,86 +19,86 @@ case 29 xi0 = [ ... --0.10805494870734366206624465021983; ... - 0.10805494870734366206624465021983; ... --0.31911236892788976043567182416847; ... - 0.31911236892788976043567182416847; ... --0.51524863635815409196529071855118; ... - 0.51524863635815409196529071855118; ... --0.68729290481168547014801980301933; ... - 0.68729290481168547014801980301933; ... --0.82720131506976499318979474265039; ... - 0.82720131506976499318979474265039; ... --0.92843488366357351733639113937787; ... - 0.92843488366357351733639113937787; ... --0.98628380869681233884159726670405; ... - 0.98628380869681233884159726670405]; + -0.10805494870734366206624465021983; ... + 0.10805494870734366206624465021983; ... + -0.31911236892788976043567182416847; ... + 0.31911236892788976043567182416847; ... + -0.51524863635815409196529071855118; ... + 0.51524863635815409196529071855118; ... + -0.68729290481168547014801980301933; ... + 0.68729290481168547014801980301933; ... + -0.82720131506976499318979474265039; ... + 0.82720131506976499318979474265039; ... + -0.92843488366357351733639113937787; ... + 0.92843488366357351733639113937787; ... + -0.98628380869681233884159726670405; ... + 0.98628380869681233884159726670405]; weights0 = [ ... - 0.21526385346315779019587644331626; ... - 0.21526385346315779019587644331626; ... - 0.20519846372129560396592406566121; ... - 0.20519846372129560396592406566121; ... - 0.18553839747793781374171659012515; ... - 0.18553839747793781374171659012515; ... - 0.15720316715819353456960193862384; ... - 0.15720316715819353456960193862384; ... - 0.12151857068790318468941480907247; ... - 0.12151857068790318468941480907247; ... - 0.08015808715976020980563327706285; ... - 0.08015808715976020980563327706285; ... - 0.03511946033175186303183287613819; ... - 0.03511946033175186303183287613819]; + 0.21526385346315779019587644331626; ... + 0.21526385346315779019587644331626; ... + 0.20519846372129560396592406566121; ... + 0.20519846372129560396592406566121; ... + 0.18553839747793781374171659012515; ... + 0.18553839747793781374171659012515; ... + 0.15720316715819353456960193862384; ... + 0.15720316715819353456960193862384; ... + 0.12151857068790318468941480907247; ... + 0.12151857068790318468941480907247; ... + 0.08015808715976020980563327706285; ... + 0.08015808715976020980563327706285; ... + 0.03511946033175186303183287613819; ... + 0.03511946033175186303183287613819]; case 13 xi0 = [ ... - 0.66120938646626451366139959501990; ... --0.66120938646626451366139959501990; ... --0.23861918608319690863050172168071; ... - 0.23861918608319690863050172168071; ... --0.93246951420315202781230155449399; ... - 0.93246951420315202781230155449399]; + 0.66120938646626451366139959501990; ... + -0.66120938646626451366139959501990; ... + -0.23861918608319690863050172168071; ... + 0.23861918608319690863050172168071; ... + -0.93246951420315202781230155449399; ... + 0.93246951420315202781230155449399]; weights0 = [ ... - 0.36076157304813860756983351383771; ... - 0.36076157304813860756983351383771; ... - 0.46791393457269104738987034398955; ... - 0.46791393457269104738987034398955; ... - 0.17132449237917034504029614217273; ... - 0.17132449237917034504029614217273]; + 0.36076157304813860756983351383771; ... + 0.36076157304813860756983351383771; ... + 0.46791393457269104738987034398955; ... + 0.46791393457269104738987034398955; ... + 0.17132449237917034504029614217273; ... + 0.17132449237917034504029614217273]; case 9 xi0 = [ ... --0.33998104358485626480266575910324; ... - 0.33998104358485626480266575910324; ... --0.86113631159405257522394648889280; ... - 0.86113631159405257522394648889280]; + -0.33998104358485626480266575910324; ... + 0.33998104358485626480266575910324; ... + -0.86113631159405257522394648889280; ... + 0.86113631159405257522394648889280]; weights0 = [ ... - 0.65214515486254614262693605077800; ... - 0.65214515486254614262693605077800; ... - 0.34785484513745385737306394922199; ... - 0.34785484513745385737306394922199]; + 0.65214515486254614262693605077800; ... + 0.65214515486254614262693605077800; ... + 0.34785484513745385737306394922199; ... + 0.34785484513745385737306394922199]; case 7 xi0 = [ ... - 0; ... --0.77459666924148337703585307995647; ... - 0.77459666924148337703585307995647]; + 0; ... + -0.77459666924148337703585307995647; ... + 0.77459666924148337703585307995647]; weights0 = [ ... - 0.88888888888888888888888888888888; ... - 0.55555555555555555555555555555555; ... - 0.55555555555555555555555555555555]; + 0.88888888888888888888888888888888; ... + 0.55555555555555555555555555555555; ... + 0.55555555555555555555555555555555]; case 5 xi0 = [ ... --0.57735026918962576450914878050195; ... - 0.57735026918962576450914878050195]; + -0.57735026918962576450914878050195; ... + 0.57735026918962576450914878050195]; weights0 = [1; 1]; @@ -128,12 +128,12 @@ otherwise - error('MESS:exact_quadrature_parameters:Unknown order'); + mess_err(opts, 'exact_quadrature_parameters:Unknown order'); end % Conversion from [-1, 1] to [0, h]: -weights = weights0 * h/2; -nodes = h/2 * (xi0 + 1); +weights = weights0 * h / 2; +nodes = h / 2 * (xi0 + 1); % Sort nodes in ascending order to allow for iterative computing in our % particular use-case diff --git a/mat-eqn-solvers/private/expF.m b/mat-eqn-solvers/private/expF.m index f475ffc..a2a13bc 100644 --- a/mat-eqn-solvers/private/expF.m +++ b/mat-eqn-solvers/private/expF.m @@ -1,23 +1,25 @@ -function [L, D, eqn, opts, oper] = expF(eqn, opts, oper, h, IQL, IQD, L0, D0, t0) +function [L, D, eqn, opts, oper] = ... + expF(eqn, opts, oper, h, IQL, IQD, L_zero, D_zero, t_zero) % Solve the affine problem arising from the split DRE. % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % if nargin < 9 - t0 = 0; + t_zero = 0; end -[out, eqn, opts, oper] = mess_exp_action(eqn, opts, oper, h, L0, t0); +[out, eqn, opts, oper] = ... + mess_exp_action(eqn, opts, oper, h, L_zero, t_zero); L = [out.Z, IQL]; -D = blkdiag(D0, IQD); +D = blkdiag(D_zero, IQD); [L, D] = mess_column_compression(L, 'N', D, opts.splitting.trunc_tol, ... - opts.splitting.trunc_info); -end \ No newline at end of file + opts.splitting.trunc_info); +end diff --git a/mat-eqn-solvers/private/expG.m b/mat-eqn-solvers/private/expG.m index 2868702..b173e6b 100644 --- a/mat-eqn-solvers/private/expG.m +++ b/mat-eqn-solvers/private/expG.m @@ -1,23 +1,25 @@ -function [L, D] = expG(eqn, opts, oper, h, L0, D0, t0) +function [L, D] = expG(eqn, opts, oper, h, L_zero, D_zero, t_zero) % Solve the nonlinear problem arising from the split DRE % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % -L = L0; -Id = eye(size(D0)); +L = L_zero; +Id = eye(size(D_zero)); if not(eqn.LTV) % Autonomous case if eqn.type == 'T' - D = (Id + h*D0*L0'*(eqn.B*(eqn.Rinv*(eqn.B'*L0))))\D0; + D = (Id + h * D_zero * L_zero' * ... + (eqn.B * (eqn.Rinv * (eqn.B' * L_zero)))) \ D_zero; elseif eqn.type == 'N' - D = (Id + h*D0*L0'*(eqn.C'*(eqn.Rinv*(eqn.C*L0))))\D0; + D = (Id + h * D_zero * L_zero' * ... + (eqn.C' * (eqn.Rinv * (eqn.C * L_zero)))) \ D_zero; end else % Time-varying case. Only difference is that instead of h*B*Rinv*B' we @@ -25,32 +27,32 @@ % LB*DB*LB' by quadrature. Note that the factor h is included in the % approximation. For the choice of order 29, see Issue #311. [xk, wk] = exact_quadrature_parameters(h, 29); - xk = xk + t0; % Shift from [0, h] t0 [t0, t0+h] + xk = xk + t_zero; % Shift from [0, h] t0 [t0, t0+h] % Need to evaluate eqn.B or eqn.C' at all xk(k) LB = cell(1, length(xk)); for k = 1:length(xk) - [eqn, opts, oper] = ... - opts.splitting.eval_matrix_functions(eqn, opts, oper, xk(k)); - if eqn.type == 'T' - LB{k} = eqn.B; - elseif eqn.type == 'N' - LB{k} = eqn.C'; - end + [eqn, opts, oper] = ... + opts.splitting.eval_matrix_functions(eqn, opts, oper, xk(k)); + if eqn.type == 'T' + LB{k} = eqn.B; + elseif eqn.type == 'N' + LB{k} = eqn.C'; + end end LB = cell2mat(LB); if eqn.type == 'T' - DB = kron(diag(wk), eqn.Rinv*speye(size(LB,2) / length(xk))); + DB = kron(diag(wk), eqn.Rinv * speye(size(LB, 2) / length(xk))); elseif eqn.type == 'N' - DB = kron(diag(wk), speye(size(LB,2) / length(xk))); + DB = kron(diag(wk), speye(size(LB, 2) / length(xk))); end [LB, DB] = mess_column_compression(LB, 'N', DB, ... - opts.splitting.trunc_tol, opts.splitting.trunc_info); + opts.splitting.trunc_tol, ... + opts.splitting.trunc_info); - D = (Id + D0*L0'*(LB*(DB*(LB'*L0))))\D0; + D = (Id + D_zero * L_zero' * (LB * (DB * (LB' * L_zero)))) \ D_zero; end - -D = 0.5 * (D + D'); % prevent symmetry loss due to unsymmetric formulas above +D = mess_symmetrize(D); end diff --git a/mat-eqn-solvers/private/gauss_quadrature_parameters.m b/mat-eqn-solvers/private/gauss_quadrature_parameters.m index 7ea339e..bc9dda3 100644 --- a/mat-eqn-solvers/private/gauss_quadrature_parameters.m +++ b/mat-eqn-solvers/private/gauss_quadrature_parameters.m @@ -9,9 +9,9 @@ % https://doi.org/10.1090/S0025-5718-69-99647-1 % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % @@ -19,17 +19,16 @@ % Golub-Welsch algorithm on the interval [-1, 1] N = (order - 1) / 2; k = 1:N; -beta = k ./ sqrt(4*k.^2 - 1); +beta = k ./ sqrt(4 * k.^2 - 1); -J = diag(beta(1:end-1), -1) + diag(beta(1:end-1), 1); +J = diag(beta(1:end - 1), -1) + diag(beta(1:end - 1), 1); [V, nodes] = eig(J, 'vector'); [nodes, ind] = sort(nodes, 'ascend'); weights = V(1, ind).^2 * 2; % Conversion from [-1, 1] to [0, h]: -weights = weights' * h/2; -nodes = h/2*(nodes + 1); +weights = weights' * h / 2; +nodes = h / 2 * (nodes + 1); end - diff --git a/mat-eqn-solvers/private/mess_accumulateK.m b/mat-eqn-solvers/private/mess_accumulateK.m new file mode 100644 index 0000000..03875fb --- /dev/null +++ b/mat-eqn-solvers/private/mess_accumulateK.m @@ -0,0 +1,210 @@ +function [out, eqn, opts, oper] = ... + mess_accumulateK(eqn, opts, oper, out, pc, V1, V2) +% Updates out.Knew and out.DeltaK +% +% K = E' ZZ' B if eqn.type == 'N' +% K = E ZZ' C' if eqn.type == 'T' +% +% +% Input: +% eqn structure containing equation data +% +% opts structure containing parameters for the algorithm +% +% oper contains function handles with operations for A and E +% +% out contains Knew and DeltaK +% +% pc contains shift parameter p +% +% V1 contains solution of shifted system or Z if pc is empty +% +% V2 contains solution of shifted system +% +% Output: +% out contains Knew and DeltaK +% +% eqn structure containing equation data +% +% opts structure containing parameters for the algorithm +% +% oper contains function handles with operations for A and E + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +%% Check input + +%% Initialize data +if not(isreal(pc)) && not(nargin == 7) + mess_err(opts, 'control_data', ... + 'If the shift is complex, V1 and V2 are required'); +end + +%% preprocess multiplication with E +[eqn, opts, oper] = oper.mul_E_pre(eqn, opts, oper); + +%% update K and DeltaK +if isempty(pc) + if eqn.haveE + if opts.LDL_T + % no separate BDF case; the computed K is not the + % feedback matrix for the ARE resulting in a time + % step of the BDF method but the feedback matrix of + % the original DRE; that is why tau and beta do not + % appear in K, e.g. as factor of B; for residual + % computations of the ARE tau and beta need to be + % taken into account. + if eqn.type == 'T' + out.Knew = oper.mul_E(eqn, opts, eqn.type, ... + V1 * (out.D * (V1' * eqn.B)), 'N') / ... + eqn.R; + else + out.Knew = oper.mul_E(eqn, opts, eqn.type, ... + V1 * (out.D * (eqn.C * V1)'), 'N') / ... + eqn.Q; + end + else + if eqn.type == 'T' + out.Knew = oper.mul_E(eqn, opts, eqn.type, ... + V1 * (V1' * eqn.B), 'N'); + else + out.Knew = oper.mul_E(eqn, opts, eqn.type, ... + V1 * (eqn.C * V1)', 'N'); + end + end + else + if opts.LDL_T + if eqn.type == 'T' + out.Knew = V1 * (out.D * (V1' * eqn.B)) / eqn.R; + else + out.Knew = V1 * (out.D * (eqn.C * V1)') / eqn.Q; + end + else + if eqn.type == 'T' + out.Knew = V1 * (V1' * eqn.B); + else + out.Knew = V1 * (eqn.C * V1)'; + end + end + end +else + if opts.adi.accumulateK || opts.adi.accumulateDeltaK + if isreal(pc) + if eqn.haveE + if eqn.type == 'T' + if opts.LDL_T + % no separate BDF case; the computed K is not the + % feedback matrix for the ARE resulting in a time + % step of the BDF method but the feedback matrix of + % the original DRE; that is why tau and beta do not + % appear in K, e.g. as factor of B; for residual + % computations of the ARE tau and beta need to be + % taken into account. + K_update = ... + oper.mul_E(eqn, opts, eqn.type, V1, 'N') * ... + ((2 * (-pc) * eqn.T) * (V1' * eqn.B)); + K_update = K_update / eqn.R; + else + K_update = ... + oper.mul_E(eqn, opts, eqn.type, V1, 'N') * ... + ((2 * (-pc)) * (V1' * eqn.B)); + end + else + if opts.LDL_T + K_update = ... + oper.mul_E(eqn, opts, eqn.type, V1, 'N') * ... + ((2 * (-pc) * eqn.T) * (eqn.C * V1)'); + K_update = K_update / eqn.Q; + else + K_update = ... + oper.mul_E(eqn, opts, eqn.type, V1, 'N') * ... + ((2 * (-pc)) * (eqn.C * V1)'); + end + end + else + if eqn.type == 'T' + if opts.LDL_T + K_update = V1 * ((2 * (-pc) * eqn.T) * (V1' * eqn.B)); + K_update = K_update / eqn.R; + else + K_update = V1 * ((2 * (-pc)) * (V1' * eqn.B)); + end + else + if opts.LDL_T + K_update = V1 * ((2 * (-pc) * eqn.T) * (eqn.C * V1)'); + K_update = K_update / eqn.Q; + else + K_update = V1 * ((2 * (-pc)) * (eqn.C * V1)'); + end + end + end + else + if eqn.haveE + if eqn.type == 'T' + if opts.LDL_T + K_update = ... + oper.mul_E(eqn, opts, eqn.type, V1, 'N') * ... + (eqn.T * (V1' * eqn.B)) + ... + (oper.mul_E(eqn, opts, eqn.type, V2, 'N')) * ... + (eqn.T * (V2' * eqn.B)); + K_update = K_update / eqn.R; + else + K_update = ... + oper.mul_E(eqn, opts, eqn.type, V1, 'N') * ... + (V1' * eqn.B) + ... + (oper.mul_E(eqn, opts, eqn.type, V2, 'N')) * ... + (V2' * eqn.B); + end + else + if opts.LDL_T + K_update = ... + oper.mul_E(eqn, opts, eqn.type, V1, 'N') * ... + (eqn.T * (eqn.C * V1)') + ... + (oper.mul_E(eqn, opts, eqn.type, V2, 'N')) * ... + (eqn.T * (eqn.C * V2)'); + K_update = K_update / eqn.Q; + else + K_update = ... + oper.mul_E(eqn, opts, eqn.type, V1, 'N') * ... + (eqn.C * V1)' + ... + (oper.mul_E(eqn, opts, eqn.type, V2, 'N')) * ... + (eqn.C * V2)'; + end + end + else + if eqn.type == 'T' + if opts.LDL_T + K_update = V1 * (eqn.T * (V1' * eqn.B)) + ... + V2 * (eqn.T * (V2' * eqn.B)); + K_update = K_update / eqn.R; + else + K_update = V1 * (V1' * eqn.B) + V2 * (V2' * eqn.B); + end + else + if opts.LDL_T + K_update = V1 * (eqn.T * (eqn.C * V1)') + ... + V2 * (eqn.T * (eqn.C * V2)'); + K_update = K_update / eqn.Q; + else + K_update = V1 * (eqn.C * V1)' + V2 * (eqn.C * V2)'; + end + end + end + end + if opts.adi.accumulateK + out.Knew = out.Knew + K_update; + end + if opts.adi.accumulateDeltaK + out.DeltaK = out.DeltaK + K_update; + end + end +end +%% postprocess multiplication with E +[eqn, opts, oper] = oper.mul_E_post(eqn, opts, oper); +end diff --git a/mat-eqn-solvers/private/mess_exp_action.m b/mat-eqn-solvers/private/mess_exp_action.m index 0070aa9..7472ad0 100644 --- a/mat-eqn-solvers/private/mess_exp_action.m +++ b/mat-eqn-solvers/private/mess_exp_action.m @@ -1,11 +1,12 @@ -function [out, eqn, opts, oper] = mess_exp_action(eqn, opts, oper, h, L, t0) +function [out, eqn, opts, oper] = ... + mess_exp_action(eqn, opts, oper, h, L, t_zero) % Computes the matrix exponential action expm(h*(E\A))*L where L is a % skinny block matrix. % % Computes (expm(h*(E'\A'))*L if eqn.type == 'T' % Computes (expm(h*(E\A))*L if eqn.type == 'N' % -% If t0 is given as input and eqn.LTV == 1, instead solve the LTV system +% If t0 is given as input and eqn.LTV == true, instead solve the LTV system % E(t)'\dot{x}(t) = A(t)' x(t) (eqn.type == 'T') % E(t)\dot{x}(t) = A(t) x(t) (eqn.type == 'N') % over the interval [t0, t0 + h]. @@ -28,7 +29,7 @@ % % L contains block matrix L % -% t0 contains starting time t0 in the LTV case +% t_zero contains starting time t0 in the LTV case % % Input fields in opts.exp_action: % @@ -61,28 +62,27 @@ % % out.errest the final error estimate (residual) - % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Check for matrix exponential actions control structure in options %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if not(isfield(opts, 'exp_action')) ... - || not(isstruct(opts.exp_action)) ... - || not(isfield(opts.exp_action, 'method')) - warning('MESS:control_data', ['matrix exponential actions control ' ... - 'structure opts.exp_action ' ... - 'missing. Using default Krylov method.']); - opts.exp_action.method = 'Krylov'; +if not(isfield(opts, 'exp_action')) || ... + not(isstruct(opts.exp_action)) || ... + not(isfield(opts.exp_action, 'method')) + mess_warn(opts, 'control_data', ... + ['matrix exponential actions control ' ... + 'structure opts.exp_action ' ... + 'missing. Using default Krylov method.']); + opts.exp_action.method = 'Krylov'; end if not(isfield(opts.exp_action, 'tol')) @@ -91,20 +91,20 @@ if strcmp(opts.exp_action.method, 'Krylov') if eqn.LTV - error('MESS:control_data', ... - ['LTV problem specified, but opts.exp_action.method=', ... - '''Krylov''. Use option ''LTV'' instead.']); + mess_err(opts, 'control_data', ... + ['LTV problem specified, but opts.exp_action.method=', ... + '''Krylov''. Use option ''LTV'' instead.']); end - if not(isfield(opts.exp_action, 'Krylov')) ... - || not(isstruct(opts.exp_action.Krylov)) + if not(isfield(opts.exp_action, 'Krylov')) || ... + not(isstruct(opts.exp_action.Krylov)) opts.exp_action.Krylov = {}; end if not(isfield(opts.exp_action.Krylov, 'kabsmax')) [n, p] = size(L); - mmem = 8*4*1024^3; % 4 GB + mmem = 8 * 4 * 1024^3; % 4 GB kabsmax = mmem / n / p; else kabsmax = opts.exp_action.Krylov.kabsmax; @@ -114,40 +114,38 @@ % No extra parameters for this method. Tolerance % is set globally in opts.exp_action.tol if eqn.LTV - error('MESS:control_data', ... - ['LTV problem specified, but opts.exp_action.method=', ... - '''adaptiveSDIRK''. Use option ''LTV'' instead.']); + mess_err(opts, 'control_data', ... + ['LTV problem specified, but opts.exp_action.method=', ... + '''adaptiveSDIRK''. Use option ''LTV'' instead.']); end if not(eqn.LTV) % Assume time interval [0, h] for backwards compatibility if nargin < 6 - t0 = 0; + t_zero = 0; end end - elseif strcmp(opts.exp_action.method, 'LTV') % Like the previous method, this one also needs no extra parameters if not(eqn.LTV) - error('MESS:control_data', ... - 'opts.exp_action.method = ''LTV'' but eqn.LTV = 0.'); + mess_err(opts, 'control_data', ... + 'opts.exp_action.method = ''LTV'' but eqn.LTV = false.'); end if nargin < 6 % No t0 given - error('MESS:control_data', ... - ['LTV problem specified, but no initial time set for call ' ... - 'to mess_exp_action']); + mess_err(opts, 'control_data', ... + ['LTV problem specified, but no initial time set for ' ... + 'call to mess_exp_action']); end - else - error('MESS:control_data', ['Chosen method for matrix exponential ' ... - 'actions: ', opts.exp_action.method, ' is not supported']); + mess_err(opts, 'control_data', ... + ['Chosen method for matrix exponential ' ... + 'actions: ', opts.exp_action.method, ' is not supported']); end - switch opts.exp_action.method case 'Krylov' @@ -155,15 +153,15 @@ normL = norm(L); tol = opts.exp_action.tol; - Afun = @(x) -h*oper.sol_E(eqn, ... - opts, ... - eqn.type, ... - oper.mul_A(eqn, ... - opts, ... - eqn.type, ... - x, ... - 'N'), ... - 'N'); + Afun = @(x) -h * oper.sol_E(eqn, ... + opts, ... + eqn.type, ... + oper.mul_A(eqn, ... + opts, ... + eqn.type, ... + x, ... + 'N'), ... + 'N'); kmin = 1; kmax = 2; % Do two initial blocks before estimating the error @@ -175,29 +173,30 @@ while not(converged) for k = kmin:kmax - Uk = Vk(:, (k-1)*p+1:k*p); + Uk = Vk(:, (k - 1) * p + 1:k * p); Wk = Afun(Uk); for i = 1:k % Orthogonalize - Ui = Vk(:, (i-1)*p+1:i*p); - Hik = Ui'*Wk; - Wk = Wk - Ui*Hik; - Hk((i-1)*p+1:i*p, (k-1)*p+1:k*p) = Hik; + Ui = Vk(:, (i - 1) * p + 1:i * p); + Hik = Ui' * Wk; + Wk = Wk - Ui * Hik; + Hk((i - 1) * p + 1:i * p, (k - 1) * p + 1:k * p) = Hik; end - [Ukp1, Hkp1] = qr(Wk,0); + [Ukp1, Hkp1] = qr(Wk, 0); if k == kmax % Compute error estimate - E1 = eye(k*p,k*p); E1 = E1(:, 1:p); - Hkt = [-Hk, E1; zeros(p, (k+1)*p)]; + E1 = eye(k * p, k * p); + E1 = E1(:, 1:p); + Hkt = [-Hk, E1; zeros(p, (k + 1) * p)]; eHt = expm(Hkt); - phiHkE1 = eHt(1:k*p, k*p+1:(k+1)*p); + phiHkE1 = eHt(1:k * p, k * p + 1:(k + 1) * p); - errest = normL*norm(Hkp1) * ... - norm(phiHkE1((k-1)*p+1:k*p, :)); + errest = normL * norm(Hkp1) * ... + norm(phiHkE1((k - 1) * p + 1:k * p, :)); if errest < tol out.converged = true; @@ -205,14 +204,14 @@ % The below essentially does eHk = expm(-Hk) and % Z = Vk*expm(-Hk)*(Vk'*L), but in a more % efficient way - eHk = eHt(1:k*p, 1:k*p); - out.Z = Vk*(eHk(:, 1:p)*R); + eHk = eHt(1:k * p, 1:k * p); + out.Z = Vk * (eHk(:, 1:p) * R); return end end - Vk(:, k*p+1:(k+1)*p) = Ukp1; - Hk(k*p+1:(k+1)*p, (k-1)*p+1:k*p) = Hkp1; + Vk(:, k * p + 1:(k + 1) * p) = Ukp1; + Hk(k * p + 1:(k + 1) * p, (k - 1) * p + 1:k * p) = Hkp1; end @@ -223,9 +222,9 @@ out.Z = NaN; % TODO: improve error handling, see #312 out.converged = false; out.errest = Inf; - warning('MESS:exp_action', ... - ['Krylov method for matrix exponential action ' ... - 'did NOT converge!']); + mess_warn(opts, 'exp_action', ... + ['Krylov method for matrix exponential ' ... + 'action did NOT converge!']); return end @@ -233,7 +232,7 @@ case 'adaptiveSDIRK' [out, eqn, opts, oper] = ... - adaptive_SDIRK43(eqn, opts, oper, h, L, t0); + adaptive_SDIRK43(eqn, opts, oper, h, L, t_zero); case 'LTV' % Temporarily change the matrix updating function to evaluate at @@ -243,11 +242,12 @@ opts.splitting.eval_matrix_functions = @(eqn, opts, oper, s) ... opts.splitting.eval_matrix_functions_temp(eqn, opts, oper, ... - t0 + h - s); + t_zero + h - s); - [out, eqn, opts, oper] = adaptive_SDIRK43(eqn, opts, oper, h, L,0); + [out, eqn, opts, oper] = adaptive_SDIRK43(eqn, opts, oper, ... + h, L, 0); % Restore the matrix updating function opts.splitting.eval_matrix_functions = ... opts.splitting.eval_matrix_functions_temp; -end \ No newline at end of file +end diff --git a/mat-eqn-solvers/private/mess_solve_shifted_system.m b/mat-eqn-solvers/private/mess_solve_shifted_system.m new file mode 100644 index 0000000..a9937e4 --- /dev/null +++ b/mat-eqn-solvers/private/mess_solve_shifted_system.m @@ -0,0 +1,94 @@ +function [X, eqn, opts, oper] = ... + mess_solve_shifted_system(eqn, opts, oper, pc, W, mode) +% Solves (à + p*E)X = W for X, à = A or à = A + UV^T +% +% Solves (à + p*E)X = W for X, à = A or à = A + UV^T if eqn.type == 'N' +% Solves (à + p*E)^T*X = W for X, à = A or à = A + UV^T if eqn.type == 'T' +% +% +% Input: +% eqn structure containing equation data +% +% opts structure containing parameters for the algorithm +% +% oper contains function handles with operations for A and E +% +% pc contains shift parameter p +% +% W contains right hand side +% +% mode decides if we are running plain solvers or as part of +% a Rosenbrock or BDF method (optional, default: empty) +% +% Output: +% X solution of the shifted system +% +% eqn structure containing equation data +% +% opts structure containing parameters for the algorithm +% +% oper contains function handles with operations for A and E + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +%% Check input +haveUV = isfield(eqn, 'haveUV') && eqn.haveUV; +%% Initialize data +k = size(W, 2); +Wcols = 1:k; + +if haveUV + m = size(eqn.U, 2); + UVcols = (k + 1):(k + m); + switch eqn.type + case 'N' + RHS = [W, eqn.U]; + V = eqn.V; + case 'T' + RHS = [W, eqn.V]; + V = eqn.U; + end +else + RHS = W; +end + +if not(exist('mode', 'var')) || isempty(mode) + mode = 'default'; +end + +switch lower(mode) + case 'bdf' + tau_beta = opts.bdf.tau * opts.bdf.beta; + pc = (pc - 0.5) / tau_beta; + RHS = RHS / tau_beta; + case 'rosenbrock' + if opts.rosenbrock.stage == 1 + pc = pc - 1 / (opts.rosenbrock.tau * 2); + else % p = 2 + tau_gamma = (opts.rosenbrock.tau * opts.rosenbrock.gamma); + pc = (pc - 0.5) / tau_gamma; + RHS = RHS / tau_gamma; + end +end + +%% preprocess shifted solver +[eqn, opts, oper] = oper.sol_ApE_pre(eqn, opts, oper); + +%% solve shifted system +X = oper.sol_ApE(eqn, opts, eqn.type, pc, eqn.type, RHS, 'N'); +if haveUV + % Perform Sherman-Morrison-Woodbury-trick + SMW = X(:, UVcols); + X = X(:, Wcols); + X = X - SMW * ((eye(m) + V' * SMW) \ (V' * X)); +end + +%% postprocess shifted solver +[eqn, opts, oper] = oper.sol_ApE_post(eqn, opts, oper); +end diff --git a/mat-eqn-solvers/private/outerfrobnormdiff_LDLT.m b/mat-eqn-solvers/private/outerfrobnormdiff_LDLT.m index 49803e5..dc496fe 100644 --- a/mat-eqn-solvers/private/outerfrobnormdiff_LDLT.m +++ b/mat-eqn-solvers/private/outerfrobnormdiff_LDLT.m @@ -1,21 +1,28 @@ -function s = outerfrobnormdiff_LDLT(L1, D1, L2, D2) -% Compute the Frobenius norm of L1 D1 L1' - L2 D2 L2' for symmetric -% matrices D1 and D2. - -% -% This file is part of the M-M.E.S.S. project -% (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. -% All rights reserved. -% License: BSD 2-Clause License (see COPYING) -% - -[L, D] = mess_column_compression([L1, L2], 'N', blkdiag(D1, -D2), eps, 0); -% Exploit the invariance under cyclic permutations property of the trace -% to compute norm(L*D*L','fro') = sqrt(trace((L'*L*D)^2)) -s = sqrt(sum(sum(((L'*L)*D).^2))); - -% Expensive version -% s = norm(L1*D1*L1' - L2*D2*L2', 'fro'); - -end +function [s, s_ref] = outerfrobnormdiff_LDLT(L1, D1, L2, D2, rel) +% Compute the Frobenius norm of L1 D1 L1' - L2 D2 L2' +% for symmetric D1, D2 + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +[L, D] = mess_column_compression([L1, L2], 'N', blkdiag(D1, -D2), ... + eps, 0); +% Exploit the invariance under cyclic permutations property of the trace +% to compute norm(L*D*L','fro') +s = sqrt(trace((L' * L * D)^2)); +if rel + s_ref = sqrt(trace((L1' * L1 * D1)^2)); + s = s / s_ref; +else + s_ref = []; +end + +% Expensive version +% s = norm(L1*D1*L1' - L2*D2*L2', 'fro'); + +end diff --git a/helpers/prepare_next_adi_iteration.m b/mat-eqn-solvers/private/prepare_next_adi_iteration.m similarity index 54% rename from helpers/prepare_next_adi_iteration.m rename to mat-eqn-solvers/private/prepare_next_adi_iteration.m index 974e571..bea9be8 100644 --- a/helpers/prepare_next_adi_iteration.m +++ b/mat-eqn-solvers/private/prepare_next_adi_iteration.m @@ -1,28 +1,28 @@ -function [ opts, out, stop ] = prepare_next_adi_iteration( opts, out, res, rc, outer_res, i) +function [opts, out, stop] = ... + prepare_next_adi_iteration(opts, out, res, rc, outer_res, i) % Evaluate stopping criteria of LRADI for exact and inexact case and check % whether line search is necessary. % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% Check input %% Evaluate stopping criteria -stop = 0; +stop = false; % Riccati tolerance reached, stop if not(isempty(outer_res)) && ... (outer_res(i) < opts.nm.res_tol) - stop = 1; + stop = true; -% Inexact ADI + % Inexact ADI elseif opts.adi.inexact % Lyapunov residual is growing, stop and perform line search @@ -30,52 +30,51 @@ (i > 2) && ... (res(i) > res(1)) - out.linesearch = 1; - stop = 1; + out.linesearch = true; + stop = true; - % Outer tolerance reached and not close to finish Newton iteration + % Outer tolerance reached and not close to finish Newton iteration elseif opts.adi.res_tol && ... (res(i) < opts.adi.outer_tol) && ... ((res(i) >= 1e2 * opts.nm.res_tol) || ... ((i > 1) && ... - (outer_res(i) >= outer_res(i - 1)))) - - stop = 1; - - % else - % Outer tolerance not reached and Lyapunov residual is not growing or - % outer tolerance is reached but Newton iteration is almost finished, - % do NOT stop ADI iteration! + (outer_res(i) >= outer_res(i - 1)))) + + stop = true; + + % else + % Outer tolerance not reached and Lyapunov residual is not growing or + % outer tolerance is reached but Newton iteration is almost finished, + % do NOT stop ADI iteration! end -% ADI tolerance reached, stop ADI iteration + % ADI tolerance reached, stop ADI iteration elseif ((opts.adi.res_tol && ... - (res(i) < opts.adi.res_tol)) || ... + (res(i) < opts.adi.res_tol)) || ... (opts.adi.rel_diff_tol && ... (rc(i) < opts.adi.rel_diff_tol))) && ... - (isempty(outer_res) || ... + (isempty(outer_res) || ... ((res(i) >= 1e2 * opts.nm.res_tol) || ... ((i > 1) && ... (outer_res(i) >= outer_res(i - 1))))) - stop = 1; + stop = true; % Riccati residual is growing, perform line search if not(isempty(outer_res)) && ... outer_res(i) > outer_res(1) - - out.linesearch = 1; + + out.linesearch = true; end -% Lyapunov residual is growing and inexact ADI with line search probably -% failed already, stop ADI iteration and restart Newton iteration with -% exact ADI iteration + % Lyapunov residual is growing and inexact ADI with line search probably + % failed already, stop ADI iteration and restart Newton iteration with + % exact ADI iteration elseif opts.adi.res_tol && ... (res(i) > res(1) * 1e2) && ... - isfield(opts,'nm') + isfield(opts, 'nm') - out.restart = 1; - stop = 1; + out.restart = true; + stop = true; end end - diff --git a/mat-eqn-solvers/private/reuseIQ.m b/mat-eqn-solvers/private/reuseIQ.m deleted file mode 100644 index d7e3dda..0000000 --- a/mat-eqn-solvers/private/reuseIQ.m +++ /dev/null @@ -1,15 +0,0 @@ -% function [ILas, IDas, xj, Las] = reuseIQ(hold, hnew, as, xj, Las, eqn, opts, oper) -% % Placeholder function: future functionality -% % Recompute low-rank factorization of the integral term I_Q after step -% % size changed, reusing previous data - -% -% This file is part of the M-M.E.S.S. project -% (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2021 Jens Saak, Martin Koehler, Peter Benner and others. -% All rights reserved. -% License: BSD 2-Clause License (see COPYING) -% - -% -% end \ No newline at end of file diff --git a/mess_path.m b/mess_path.m index 0ac8a67..41b0bbe 100644 --- a/mess_path.m +++ b/mess_path.m @@ -1,4 +1,4 @@ -function mypath = mess_path(prototypes) +function mypath = mess_path(prototypes, force) %% Add all required directories to the MATLAB path % Run this script to add all required functions and directories to the % MATLAB path in order to run M.E.S.S. functions and demos or @@ -14,20 +14,53 @@ % mess_path(true) % pathlist = mess_path(true) % -% to also add the prototypes folder. +% to also add the _prototypes folder. +% +% If you want to force-add the path (e.g. because you want to add +% the _prototypes folder after having added the base folder without +% it you may run +% +% mess_path(true, true) +% pathlist = mess_path(true, true) +% +% Note that we only add folders to the path, i.e. something like +% +% mess_path(false, true) +% +% will NOT remove the _prototypes folders if they have been added +% before. +% % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % +%% Let's check if another version is already on the path +if exist('mess_lyap', 'file') + if (nargin > 1) && force + err_warn = @warning; + else + err_warn = @error; + end + + err_warn('MESS:path_exists', ... + ['It seems like M-M.E.S.S. is already ' ... + 'on your MATLAB search path. You should remove ' ... + 'the existing instance from the path to ' ... + 'avoid version conflicts.']); +end + +%% Now generate and add this versions path if (nargin > 0) && prototypes - mypath = genpath_exclude(pwd,{'.git','html'}); + mypath = genpath_exclude(pwd, ... + {'.git', 'html', '_packages', 'resources'}); else - mypath = genpath_exclude(pwd,{'.git','html','_prototypes','_packages'}); + mypath = genpath_exclude(pwd, ... + {'.git', 'html', '_prototypes', '_packages', 'resources'}); end addpath(mypath); diff --git a/mor/mess_Frobenius_TF_error_plot.m b/mor/mess_Frobenius_TF_error_plot.m index 6d95379..d3a0d75 100644 --- a/mor/mess_Frobenius_TF_error_plot.m +++ b/mor/mess_Frobenius_TF_error_plot.m @@ -1,107 +1,24 @@ -function [eqn,opts,oper] = mess_Frobenius_TF_error_plot(eqn, opts, oper, Er,Ar,Br,Cr,Dr,fmin,fmax,nsample) -% Computation of simple sigma-plots for descriptor systems with invertible -% E. +function [out, eqn, opts, oper] = ... + mess_Frobenius_TF_error_plot(arg_one, opts, varargin) +% Computation of simple Frobenius-norm-magnitude-plots for descriptor +% systems and comparison to reduced order models. % -% mess_Frobenius_TF_error_plot(eqn, opts, oper, Er,Ar,Br,Cr,Dr,fmin,fmax,nsample) +% Backward compatibility wrapper for mess_tf_plot with +% opts.tf_plot.type == 'frobenius' % -% INPUTS: -% eqn struct contains data for equations +% arguments are as in mess_tf_plot. All settings formerly passed as +% arguments, now need to be put to opts.tf_plot. % -% opts struct contains parameters for the algorithm -% -% oper struct contains function handles for operation -% with A and E -% -% Er,Ar,Br,Cr,Dr reduced order model matrices -% -% fmin, fmax left and right bounds of the frequency range. They will be -% interpreted as exponents in the logarithmic range if -% integers are passed. -% nsample number of transfer function samples to take in the plot % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % +%% Forward call to mess_tf_plot +opts.tf_plot.type = 'frobenius'; -if (floor(fmin) == fmin) && (floor(fmax) == fmax) - w = logspace(fmin,fmax,nsample); -else - w = logspace(log10(fmin),log10(fmax),nsample); -end - -tr1 = zeros(1,nsample); -tr2 = tr1; -abserr = tr1; -relerr = tr1; - -fprintf(['Computing TFMs of original and reduced order systems and ' ... - 'MOR errors\n']) - -%% preprocess shifted solver -[eqn, opts, oper] = oper.sol_ApE_pre(eqn, opts, oper); - -for k=1:nsample - - if not(mod(k,nsample/10)) - fprintf('\r Step %3d / %3d',k,nsample); - end - - if isfield(eqn,'D') && not(isempty(eqn.D)) - g1 = eqn.C * oper.sol_ApE(eqn, opts,'N',-1i*w(k),'N',-eqn.B,'N') + eqn.D; - else - g1 = eqn.C * oper.sol_ApE(eqn, opts,'N',-1i*w(k),'N',-eqn.B,'N'); - end - - if not(isempty(Dr)) - g2 = Cr / (1i*w(k)*Er - Ar) * Br + Dr; - else - g2 = Cr / (1i*w(k)*Er - Ar) * Br; - end - - tr1(k) = norm(g1,'fro'); - tr2(k) = norm(g2,'fro'); - - abserr(k) = norm(g1 - g2,'fro'); - relerr(k) = abserr(k) / tr1(k); -end - -fprintf('\n\n'); - -%% postprocess shifted solver -[eqn, opts, oper] = oper.sol_ApE_post(eqn, opts, oper); - -%% plot error -figure(); - -subplot(2,1,1); -loglog(w, abserr, 'LineWidth', 3); -title('absolute model reduction error'); -xlabel('\omega'); -ylabel('\sigma_{max}(G(j\omega) - G_r(j\omega))'); -axis tight; - -subplot(2,1,2); -loglog(w, relerr, 'LineWidth', 3); -title('relative model reduction error'); -xlabel('\omega'); -ylabel('\sigma_{max}(G(j\omega) - G_r(j\omega)) / \sigma_{max}(G(j\omega))'); -axis tight; - -%% plot sigma -figure(); - -loglog(w, tr1, 'LineWidth', 3); -hold on; -loglog(w, tr2, 'r--', 'LineWidth', 3); -legend({'original system','reduced system'}); -xlabel('\omega'); -ylabel('\sigma_{max}(G(j\omega))'); -title('Transfer functions of original and reduced systems'); -axis tight; -hold off; - +[out, eqn, opts, oper] = mess_tf_plot(arg_one, opts, varargin{:}); diff --git a/mor/mess_balanced_truncation.m b/mor/mess_balanced_truncation.m index 5d93963..41692d0 100644 --- a/mor/mess_balanced_truncation.m +++ b/mor/mess_balanced_truncation.m @@ -1,36 +1,51 @@ -function [Er, Ar, Br, Cr, outinfo] = mess_balanced_truncation(varargin) +function [Er, Ar, Br, Cr, Dr, outinfo] = mess_balanced_truncation(varargin) % Lyapunov Balanced truncation for descriptor systems with invertible E. % -% [Er, Ar, Br, Cr, outinfo] = mess_balanced_truncation(E, A, B , C, ... -% max_order, trunc_tol, info, opts) +% [Er, Ar, Br, Cr, Dr, outinfo] = ... +% mess_balanced_truncation(E, A, B , C, D, opts) +% +% or +% +% [Er, Ar, Br, Cr, Dr, outinfo] = mess_balanced_truncation(sys, opts) +% with sys = sparss(A, B, C, D, E) +% % or % -% [Er, Ar, Br, Cr, outinfo] = mess_balanced_truncation(sys, ... -% max_order, trunc_tol, info, opts) -% with sys = sparss(A,B,C,D,E) +% [Er, Ar, Br, Cr, Dr, outinfo] = mess_balanced_truncation(eqn, opts, oper) % % INPUTS: -% E, A, B, C The mass, system, input and output matrices describing the -% original system +% E, A, B, C, D The mass, system, input and output matrices describing the +% original system +% +% sys sparss(A, B, C, D, E) +% +% eqn usual eqn structure (see help mess) % -% sys sparss(A,B,C,D,E) +% oper usual oper structure (see help mess, only non-DAE usfs allowed) % -% max_ord maximum reduced order allowed -% (optional, defaults to size(A,1)) +% opts options structure with substructure bt containing members % -% trunc_tol error tolerance used for the Hankel singular value truncation -% (optional, defaults to 1e-5) +% max_ord maximum reduced order allowed +% (optional, defaults to size(A,1)) % -% info verbosity control parameter (optional): -% 0 quiet (default) -% 1 show iteration numbers and residuals -% >1 plot residual history -% >2 compute and show the sigma and error plots +% trunc_tol error tolerance used for the Hankel singular value truncation +% (optional, defaults to 1e-5) % -% opts options structure that can be used to pass setting to the -% LRADI, ADI shift computation, or the square root method (optional) +% info verbosity control parameter (optional): +% 0 quiet (default) +% 1 show iteration numbers and residuals +% >1 plot residual history +% >2 compute and show the sigma and error plots +% +% opts can further be used to pass setting to the +% LRADI, ADI shift computation, or the square root method +% (optional) % (see corresponding routines for additional information) -% It also has fields to control the plotting in case info>2: +% +% opts.srm for the square root method inherits max_ord and trunc_tol +% unless they are already given in opts.srm. +% +% opts also has fields to control the plotting in case info>2 above: % opts.sigma.fmin minimum value in the logspace for the % sigma and error plots % opts.sigma.fmax maximum value in the logspace for the @@ -38,188 +53,176 @@ % opts.sigma.nsample number of elements in the logspace. % % OUTPUTS: -% Er, Ar, Br, Cr the reduced order model matrices +% Er, Ar, Br, Cr, Dr the reduced order model matrices +% % outinfo.TL outinfo.TR the left and right transformation matrices -% outinfo.errbound H-infinity error bound +% +% outinfo.errbound H-infinity error upper bound +% % outinfo.hsv vector with the computed Hankel singular values % % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - - %% check arguments -if isa(varargin{1}, 'sparss') - if nargin > 1 - max_order = varargin{2}; - end - - if nargin > 2 - trunc_tol = varargin{3}; - end - - if nargin > 3 - info = varargin{4}; - end - - if nargin > 4 - opts = varargin{5}; - end - extra_args = nargin - 1; -else - if nargin > 4 - max_order = varargin{5}; - end - - if nargin > 5 - trunc_tol = varargin{6}; - end +switch nargin + case 2 + if isa(varargin{2}, 'struct') + opts = varargin{2}; + else + opts = struct(); + mess_err(opts, 'error_arguments', ... + 'second argument must be a struct in case of 2 inputs'); + end + if isa(varargin{1}, 'sparss') + [eqn, opts, oper] = mess_wrap_sparss(varargin{1}, opts); - if nargin > 6 - info = varargin{7}; - end + else + mess_err(opts, 'error_arguments', ... + 'first argument must be a sparss in case of 2 inputs'); + end - if nargin > 7 - opts = varargin{8}; - end - extra_args = nargin - 4; -end + case 3 + if isa(varargin{1}, 'struct') && ... + isa(varargin{2}, 'struct') && ... + isa(varargin{3}, 'struct') + eqn = varargin{1}; -%% control verbosity of the computations -if extra_args < 3 - opts.adi.info = 0; - opts.bt.info = 0; - opts.srm.info = 0; - info = 0; - opts.shifts.info = 0; -else - if extra_args < 4 - opts.adi.info = info; - opts.bt.info = info; - opts.srm.info = info; - opts.shifts.info = info; - else - if not(isfield(opts,'adi')) || not(isfield(opts.adi,'info')) - opts.adi.info = info; + opts = varargin{2}; + oper = varargin{3}; + else + opts = struct(); + mess_err(opts, 'error_arguments', ... + 'Each argument must be a struct in case of 3 inputs'); end - if not(isfield(opts,'bt')) || not(isfield(opts.bt,'info')) - opts.bt.info = info; + + case 6 + if isa(varargin{6}, 'struct') + opts = varargin{6}; + else + opts = struct(); + mess_err(opts, 'error_arguments', ... + 'Last argument must be a struct in case of 6 inputs'); end - if not(isfield(opts,'srm')) || not(isfield(opts.srm,'info')) - opts.srm.info = info; + + % Problem data + if not(issparse(varargin{1})) || not(issparse(varargin{2})) + mess_err(opts, 'data', 'Both E and A need to be sparse.'); end - if not(isfield(opts,'shifts')) || not(isfield(opts.shifts,'info')) - opts.shifts.info = info; + % needs to be saved in extra variables for octave 4.2 compatibility + rank_1 = sprank(varargin{1}); + dimension_1 = size(varargin{1}, 1); + if rank_1 < dimension_1 + mess_err(opts, 'data', ... + 'Only systems with invertible E are supported at the moment'); end - if not(isfield(opts,'sigma')) || not(isfield(opts.sigma,'info')) - opts.sigma.info = info; + + eqn.E_ = varargin{1}; + eqn.A_ = varargin{2}; + % save non truncated matrices + eqn.B = varargin{3}; + eqn.C = varargin{4}; + eqn.D = varargin{5}; + + % operations are done by the default set of user supplied functions + [oper, opts] = operatormanager(opts, 'default'); + + % Let us avoid E if it is actually the identity. + if norm(eqn.E_ - speye(size(eqn.E_, 1)), 'inf') == 0 + eqn.haveE = 0; + eqn = rmfield(eqn, 'E_'); + else + eqn.haveE = 1; end - end -end + otherwise + opts = struct(); + mess_err(opts, 'error_arguments', 'invalid number of inputs'); +end -%% check if sparss or matrices were passed in -if isa(varargin{1}, 'sparss') - [eqn, oper] = mess_wrap_sparss(varargin{1}); - n = oper.size(eqn, opts); - if exist('eqn.D', 'var') - warning('MESS:ignored',... - 'Matrix D is supposed to be empty. Data is ignored.'); - end - % save non truncated matrices - B = eqn.B; - C = eqn.C; - % Note that we truncate B and C for the best robustness of the low-rank - % Lyapunov solvers, here. - eqn.B = mess_column_compression(full(eqn.B), 'N'); - eqn.C = mess_column_compression(full(eqn.C), 'T'); - eqn.D = []; -else - % Problem data - if not(issparse(varargin{1})) || not(issparse(varargin{2})) - error('MESS:data', 'Both E and A need to be sparse.'); - end - % needs to be saved in extra variables for octave 4.2 compability - rank_1 = sprank(varargin{1}); - dimension_1 = size(varargin{1},1); - if rank_1 < dimension_1 - error('MESS:data', ... - 'Only systems with invertible E are supported at the moment'); - end +if not(isfield(opts, 'bt')) + opts.bt = struct('tol', 1e-5, ... + 'max_ord', oper.size(eqn, opts), ... + 'info', 0); +end - eqn.E_ = varargin{1}; - eqn.A_ = varargin{2}; - % save non truncated matrices - B = varargin{3}; - C = varargin{4}; - % Note that we truncate B and C for the best robustness of the low-rank - % Lyapunov solvers, here. - eqn.B = mess_column_compression(full(B), 'N'); - eqn.C = mess_column_compression(full(C), 'T'); - eqn.D = []; - - % operations are done by the default set of user supplied finctions - oper = operatormanager('default'); - n = oper.size(eqn, opts); - - % Let us avoid E if it is actually the identity. - if norm(eqn.E_-speye(n),'inf') == 0 - eqn.haveE = 0; - eqn = rmfield(eqn, 'E_'); - else - eqn.haveE = 1; - end +if not(isfield(opts.bt, 'info')) + opts.bt.info = 0; end %% BT tolerance and maximum order for the ROM +if not(isfield(opts, 'srm')) + opts.srm = opts.bt; +end + if not(isfield(opts.srm, 'tol')) - if (extra_args < 2) || isempty(trunc_tol) + if not(isfield(opts.bt, 'tol')) || isempty(opt.bt.tol) opts.srm.tol = 1e-5; else - opts.srm.tol = trunc_tol; + opts.srm.tol = opts.bt.tol; end end if not(isfield(opts.srm, 'max_ord')) - if (extra_args < 1) || isempty(max_order) - opts.srm.max_ord = size(eqn.A_,1); + if not(isfield(opts.bt, 'max_ord')) || isempty(opts.bt.max_ord) + opts.srm.max_ord = size(eqn.A_, 1); else - opts.srm.max_ord = max_order; + opts.srm.max_ord = opts.bt.max_ord; end end +if not(isfield(opts.srm, 'info')) + opts.srm.info = opts.bt.info; +end + %% some control settings for the LRADI -if extra_args < 4 +if not(isfield(opts, 'adi')) % ADI tolerance and maximum iteration number opts.adi.maxiter = 100; opts.adi.rel_diff_tol = 1e-16; - opts.norm = 'fro'; + opts.adi.info = opts.bt.info; set_tol = true; else - if not(isfield(opts.adi,'maxiter')), opts.adi.maxiter = 100; end - if not(isfield(opts.adi,'rel_diff_tol')), opts.adi.rel_diff_tol = 1e-16; end - if not(isfield(opts,'norm')), opts.norm = 'fro'; end - set_tol = not(isfield(opts.adi,'res_tol')); + if not(isfield(opts.adi, 'maxiter')) + opts.adi.maxiter = 100; + end + + if not(isfield(opts.adi, 'rel_diff_tol')) + opts.adi.rel_diff_tol = 1e-16; + end + + if not(isfield(opts.adi, 'info')) + opts.adi.info = opts.bt.info; + end + + set_tol = not(isfield(opts.adi, 'res_tol')); +end + +if not(isfield(opts, 'norm')) + opts.norm = 'fro'; end % If not set outside, we use projection shifts -if not(isfield(opts.shifts,'method')) - opts.shifts.num_desired = max(5, min(size(eqn.B,2), size(eqn.C,1))); - opts.shifts.b0 = ones(n,1); +if not(isfield(opts, 'shifts')) || not(isfield(opts.shifts, 'method')) + opts.shifts.num_desired = max(5, min(size(eqn.B, 2), size(eqn.C, 1))); + opts.shifts.b0 = ones(oper.size(eqn, opts), 1); opts.shifts.method = 'projection'; end -% FIXME dead code: -% if opts.shifts.info && not(strcmp(opts.shifts.method, 'projection')) -% [opts.shifts.p, ~, eqn, opts, oper] = mess_para(eqn, opts, oper); -% disp(opts.shifts.p); -% end +%% Compress the RHS factors for the Lyapunov equations for robustness +% save original matrices +B = eqn.B; +C = eqn.C; +% Truncate with machine precision error in the RHS representations, but possibly +% smaller rank when B, C are (almost) rank deficient. +eqn.B = mess_column_compression(full(eqn.B), 'N'); +eqn.C = mess_column_compression(full(eqn.C), 'T'); %% Truncated controllability Gramian eqn.type = 'N'; @@ -228,22 +231,24 @@ % if users set trunc_tol == 0 we need to avoid res_tol = 0 here, % since otherwise LR_ADI will turn of residual checks. - opts.adi.res_tol = min(eps/norm(eqn.B'*eqn.B), max(eps, opts.srm.tol/100)); + opts.adi.res_tol = min(eps / norm(eqn.B' * eqn.B), ... + max(eps, opts.srm.tol / 100)); end outB = mess_lradi(eqn, opts, oper); if outB.niter == opts.adi.maxiter - warning('MESS:BT',['ADI did not converge for controllability Gramian ' ... - 'factor. Reduction results may be inaccurate']); + mess_warn(opts, 'BT', ... + ['ADI did not converge for controllability Gramian ' ... + 'factor. Reduction results may be inaccurate']); end -if info > 0 +if opts.bt.info > 0 [Bm, Bn] = size(outB.Z); - fprintf('size outB.Z: %d x %d\n', Bm, Bn); + mess_fprintf(opts, 'size outB.Z: %d x %d\n', Bm, Bn); - if info > 1 - plot_iter_vs_resnorm(outB.res,eqn.type,eqn.haveE); + if opts.bt.info > 1 + plot_iter_vs_resnorm(outB.res, eqn.type, eqn.haveE); end end @@ -254,27 +259,29 @@ % if users set trunc_tol == 0 we need to avoid res_tol = 0 here, % since otherwise LR_ADI will turn of residual checks. - opts.adi.res_tol = min(eps/norm(eqn.C*eqn.C'), max(eps,opts.srm.tol/100)); + opts.adi.res_tol = min(eps / norm(eqn.C * eqn.C'), ... + max(eps, opts.srm.tol / 100)); end outC = mess_lradi(eqn, opts, oper); if outC.niter == opts.adi.maxiter - warning('MESS:BT',['ADI did not converge for controllability Gramian ' ... - 'factor. Reduction results may be inaccurate']); + mess_warn(opts, 'BT', ... + ['ADI did not converge for controllability Gramian ' ... + 'factor. Reduction results may be inaccurate']); end -if info > 0 +if opts.bt.info > 0 [Cm, Cn] = size(outC.Z); - fprintf('size outC.Z: %d x %d\n', Cm, Cn); + mess_fprintf(opts, 'size outC.Z: %d x %d\n', Cm, Cn); - if info > 1 - plot_iter_vs_resnorm(outC.res,eqn.type,eqn.haveE); + if opts.bt.info > 1 + plot_iter_vs_resnorm(outC.res, eqn.type, eqn.haveE); end end %% Square root method -[TL,TR,hsv] = mess_square_root_method(eqn,opts,oper,outB.Z,outC.Z); +[TL, TR, hsv] = mess_square_root_method(eqn, opts, oper, outB.Z, outC.Z); %% compute ROM matrices % Note that we use the original B and C since the ones in eqn have been @@ -282,35 +289,42 @@ Ar = TL' * oper.mul_A(eqn, opts, 'N', TR, 'N'); Br = TL' * B; Cr = C * TR; -Er = eye(size(Ar,1)); +Er = eye(size(Ar, 1)); -if isfield(eqn,'D') +if isfield(eqn, 'D') Dr = eqn.D; else Dr = []; end %% if desired, plot the approximation results -if info > 2 - if extra_args < 4 - opts.sigma.fmin = 1e-6; - opts.sigma.fmax = 1e6; - opts.sigma.nsample = 100; +if opts.bt.info > 2 + if not(isfield(opts, 'tf_plot')) + opts.tf_plot = struct('fmin', 1e-6, ... + 'fmax', 1e6, ... + 'nsample', 100, ... + 'type', 'sigma'); else - if not(isfield(opts, 'sigma')) - opts.sigma = struct('fmin', 1e-6, 'fmax', 1e6, 'nsample', 100); + if not(isfield(opts.tf_plot, 'fmin')) + opts.tf_plot.fmin = 1e-6; + end + if not(isfield(opts.tf_plot, 'fmax')) + opts.tf_plot.fmax = 1e6; + end + if not(isfield(opts.tf_plot, 'nsample')) + opts.tf_plot.nsample = 100; + end + if not(isfield(opts.tf_plot, 'type')) + opts.tf_plot.type = 'sigma'; end - if not(isfield(opts.sigma,'fmin')), opts.sigma.fmin = 1e-6; end - if not(isfield(opts.sigma,'fmax')), opts.sigma.fmax = 1e6; end - if not(isfield(opts.sigma,'nsample')), opts.sigma.nsample = 100; end end - ROM = struct('A',Ar,'E',Er,'B',Br,'C',Cr,'D',Dr); + ROM = struct('A', Ar, 'E', Er, 'B', Br, 'C', Cr, 'D', Dr); % for the evaluations we need the original B and C in the eqn structure. eqn.B = B; eqn.C = C; - mess_sigma_plot(eqn, opts, oper, ROM); + mess_tf_plot(eqn, opts, oper, ROM); end %% construct output information @@ -318,38 +332,41 @@ r = size(Ar, 1); nr = size(eqn.A_, 1) - length(hsv); - outinfo = struct('TL' , TL, ... - 'TR' , TR, ... - 'errbound', 2.0 * sum(hsv(r+1:end)) + nr * hsv(end), ... - 'hsv' , hsv); + outinfo = struct('TL', TL, ... + 'TR', TR, ... + 'errbound', 2.0 * sum(hsv(r + 1:end)) + nr * hsv(end), ... + 'hsv', hsv); end end -%% local function for plotting iterations vs residual norm -function plot_iter_vs_resnorm(out_res,eqn_type,eqn_haveE) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% +% local function for plotting iterations vs residual norm +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +function plot_iter_vs_resnorm(out_res, eqn_type, eqn_haveE) - figure(); - semilogy(out_res, 'LineWidth', 3); +figure(); +semilogy(out_res, 'LineWidth', 3); - if eqn_type == 'N' +if eqn_type == 'N' - if eqn_haveE - title('A X E^T + E X A^T = -BB^T'); - else - title('A X + X A^T = -BB^T'); - end + if eqn_haveE + title('A X E^T + E X A^T = -BB^T'); + else + title('A X + X A^T = -BB^T'); + end - elseif eqn_type == 'T' +elseif eqn_type == 'T' - if eqn_haveE - title('A^T X E + E^T X A = -C^T C'); - else - title('A^T X + X A = -C^T C'); - end + if eqn_haveE + title('A^T X E + E^T X A = -C^T C'); + else + title('A^T X + X A = -C^T C'); end - - xlabel('number of iterations'); - ylabel('normalized residual norm'); - drawnow; end +xlabel('number of iterations'); +ylabel('normalized residual norm'); +drawnow; +end diff --git a/mor/mess_balanced_truncation_bilinear.m b/mor/mess_balanced_truncation_bilinear.m index 8b373f9..f99f82d 100644 --- a/mor/mess_balanced_truncation_bilinear.m +++ b/mor/mess_balanced_truncation_bilinear.m @@ -1,8 +1,9 @@ function [ROM, outinfo, eqn, opts, oper] = ... mess_balanced_truncation_bilinear(eqn, opts, oper) -% Lyapunov Balanced truncation for descriptor systems with invertible E. +% Approximate balanced truncation for bilinear descriptor systems with +% invertible E. % -% [out, eqn, opts, oper] = mess_balanced_truncation(eqn, opts, oper) +% [out, eqn, opts, oper] = mess_balanced_truncation_bilinear(eqn, opts, oper) % % Input % eqn struct contains data for equations @@ -10,7 +11,8 @@ % opts struct contains parameters for the algorithm % % oper struct contains function handles for operation -% with A, E and N +% with A, E and N (optional, currently only 'default' +% usfs are supported) % % Output % out struct containing output information @@ -32,69 +34,71 @@ % fields may be needed. For the "default", e.g., eqn.A_ and eqn.E_ hold % the A and E matrices. Moreover for the bilinear models we need % eqn.N_ Cell with N_k = N{k} for k = 1,2, ... -% dense (n x n) matrix N_k +% dense (n x n x m1) tensor with (n x n) matrix slices N_k % (if all N_k are given in one large matrix it will be % transformed to a cell. output is matrix again) % -% % Input fields in struct opts: % % opts options structure that can be used to pass setting to the -% LRADI, ADI shift computation, or the square root method (optional) +% LRADI, ADI shift computation, or the square root method +% (optional) % (see corresponding routines for additional information) % % % Output fields in struct out: % Er, Ar, Br, Cr, Nr_ the reduced order model matrices -% (out.Nr_ is given as cell array) +% (outinfo.Nr_ is given as cell array) +% % +% outinfo.outB_lyapunov_bilinear output information of the lyapunov solver +% A*Z*Z'*E' + E*Z*Z'*A' + +% Sum_N_k*Z*N_k' + B*B' = 0 (N - Case) +% (see routine for additional information) % -% out.outB_lyapunov_bilinear output information of the lyapunov solver -% A*Z*Z'*E' + E*Z*Z'*A' + Sum_N_k*Z*N_k' + B*B' = 0 (N - Case) -% (see corresponding routine for additional information) % +% outinfo.outC_lyapunov_bilinear output information of the lyapunov solver +% A'*Z*Z'*E + E'*Z*Z'*A + +% Sum_N_k'*Z*N_k + C'*C = 0 (T - Case) +% (see routine for additional information) % -% out.outC_lyapunov_bilinear output information of the lyapunov solver -% A'*Z*Z'*E + E'*Z*Z'*A + Sum_N_k'*Z*N_k + C'*C = 0 (T - Case) -% (see corresponding routine for additional information) % +% outinfo.TL and outinfo.TR left and right truncation matrices % -% out.TL and out.TR left and right truncation matrices -% out.hsv computed Hankel singular values -% (by the square_root_method) +% outinfo.hsv computed Hankel singular values +% (by the square_root_method) % % References: % -% [1] P. Benner, P. Goyal, Balanced Truncation Model Order Reduction For -% Quadratic-Bilinear Control Systems, e-prints 1705.00160, arXiv, math.OC -% (2017). URL https://arxiv.org/abs/1705.00160 - +% [1] P. Benner, T. Breiten, Low rank methods for a class of generalized +% Lyapunov equations and related issues, Numerische Mathematik 124 (3) +% (2013) 441–470. https://doi.org/10.1007/s00211-013-0521-0. +% % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% Check oper and initialize parameters % operations are done by the default set of user supplied functions if nargin < 3 - oper = operatormanager('default'); + [oper, opts] = operatormanager(opts, 'default'); end % make sure we use default usfs as none of the others supports mul_N so far if not(isequal(oper.name, 'default')) - error('MESS:notimplemented', ... - [oper.name, ' usfs are not supported in this function.']); + mess_err(opts, 'notimplemented', ... + [oper.name, ' usfs are not supported in this function.']); end % Initialize variables n = oper.size(eqn, opts); % BT tolerance and maximum order for the ROM -if not(isfield(opts,'srm')) || not(isfield(opts.srm, 'tol')) +if not(isfield(opts, 'srm')) || not(isfield(opts.srm, 'tol')) opts.srm.tol = 1e-5; end @@ -107,7 +111,7 @@ end % some control settings for the LRADI -if not(isfield(opts,'adi')) || not(isfield(opts.adi, 'maxiter')) +if not(isfield(opts, 'adi')) || not(isfield(opts.adi, 'maxiter')) opts.adi.maxiter = 100; end @@ -124,21 +128,20 @@ end %% Check Problem data -if not(isfield(eqn,'haveE')) - eqn.haveE = 0; - warning('MESS:control_data', ... - ['Missing or corrupted eqn.haveE field.', ... - 'Switching to default: 0']); +if not(isfield(eqn, 'haveE')) + eqn.haveE = false; + mess_warn(opts, 'control_data', ... + ['Missing or corrupted eqn.haveE field.', ... + 'Switching to default: 0']); end % setup USFS [eqn, opts, oper] = oper.mul_A_pre(eqn, opts, oper); [eqn, opts, oper] = oper.mul_N_pre(eqn, opts, oper); - %% make sure proper shift selection parameters are given % If not set outside, we use projection shifts -if not(isfield(opts,'shifts')) || not(isfield(opts.shifts, 'method')) +if not(isfield(opts, 'shifts')) || not(isfield(opts.shifts, 'method')) opts.shifts.method = 'projection'; end @@ -150,6 +153,14 @@ opts.shifts.b0 = ones(n, 1); end +%% Compress the RHS factors for the Lyapunov equations for robustness +% save original matrices +B = eqn.B; +C = eqn.C; +% Truncate with machine precision error in the RHS representations, but possibly +% smaller rank when B, C are (almost) rank deficient. +eqn.B = mess_column_compression(full(eqn.B), 'N'); +eqn.C = mess_column_compression(full(eqn.C), 'T'); %% Truncated controllability Gramian eqn.type = 'N'; @@ -168,10 +179,16 @@ outinfo.outC_lyapunov_bilinear = outC_lyapunov_bilinear; %% Square root method -[outinfo.TL ,outinfo.TR, outinfo.hsv] = mess_square_root_method(eqn, opts , ... - oper, outB_lyapunov_bilinear.Z, outC_lyapunov_bilinear.Z); +[outinfo.TL, outinfo.TR, outinfo.hsv] = ... + mess_square_root_method(eqn, opts, oper, ... + outB_lyapunov_bilinear.Z, ... + outC_lyapunov_bilinear.Z); %% compute ROM matrices +% first restore original B and C +eqn.B = B; +eqn.C = C; + ROM.A = outinfo.TL' * oper.mul_A(eqn, opts, 'N', outinfo.TR, 'N'); ROM.B = outinfo.TL' * eqn.B; ROM.C = eqn.C * outinfo.TR; @@ -179,13 +196,13 @@ numberOf_N_matrices = length(eqn.N_); -for currentN_k = 1 : numberOf_N_matrices +for currentN_k = 1:numberOf_N_matrices ROM.N{currentN_k} = outinfo.TL' * oper.mul_N(eqn, opts, 'N', ... - outinfo.TR, 'N', currentN_k); + outinfo.TR, 'N', currentN_k); end %% clean up usfs [eqn, opts, oper] = oper.mul_A_post(eqn, opts, oper); [eqn, opts, oper] = oper.mul_N_post(eqn, opts, oper); - +end diff --git a/mor/mess_sigma_plot.m b/mor/mess_sigma_plot.m index 2f8775e..0efdc52 100644 --- a/mor/mess_sigma_plot.m +++ b/mor/mess_sigma_plot.m @@ -1,336 +1,29 @@ function [out, eqn, opts, oper] = mess_sigma_plot(arg_one, opts, varargin) -% Computation of simple sigma-magnitude-plots for descriptor systems with -% invertible E and comparison to reduced order models. +% Computation of simple sigma-magnitude-plots for descriptor systems and +% comparison to reduced order models. % -% Calling sequence: +% Backward compatibility wrapper for mess_tf_plot with +% opts.tf_plot.type == 'sigma' % -% [out, eqn, opts, oper] = mess_sigma_plot(eqn, opts, oper, ROM) -% or -% [out, eqn, opts, oper] = mess_sigma_plot(g, opts, ROM) +% arguments are as in mess_tf_plot. All settings put into opts.sigma are +% forwarded to opts.tf_plot. % -% INPUTS: -% eqn struct contains data for equations -% -% g presampled transfer function of the original system -% fitting the parameters in opts.sigma -% -% opts struct contains parameters for the algorithm -% (mandatory with substructure opts.sigma) -% -% oper struct contains function handles for operation -% with A and E -% -% ROM structure containing reduced order model matrices -% either E, A, B, C, D, -% or M, E, K, B, Cv, Cp, D -% where in the first case E and in both cases D are -% optional. -% (optional when eqn is present; mandatory otherwise) -% -% The relevant substructure of opts is opts.sigma with members: -% -% fmin, fmax left and right bounds of the frequency range. They will be -% interpreted as exponents in the logarithmic range if -% integers are passed. -% (mandatory for input eqn, ignored for input tr (check w -% below)) -% -% nsample number of transfer function samples to take in the plot -% (optional, defaults to 100) -% -% info verbosity control. (optional, defaults to 2) -% 1 only progress is reported -% 2 also generate the actual sigma plots. -% -% w vector of frequency samples fitting -% (mandatory for input tr, ignored for input eqn) -% -% Outputs: -% -% out.w vector of sampling frequencies -% -% out.err vector of sampled maximal singular values of the transfer -% function of the error system (only when ROM was given) -% out.relerr vector of sampled maximal singular values of the transfer -% function of the error system (only when ROM was given) -% relative to the FOM. -% out.tr1 vector of sampled maximal singular values of the transfer -% function of the FOM -% out.tr2 vector of sampled maximal singular values of the transfer -% function of the ROM (only when ROM is given) -% out.g1 vector of sampled values of the transfer function of the -% FOM -% out.g2 vector of sampled values of the transfer function of the -% ROM (only when ROM is given) - % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - -%% Check and assign inputs -narginchk(2,4); - -if not(isa(opts,'struct')) - error('second input must be am options structure'); -end - -if nargin == 2 - if not(isa(arg_one,'numeric')) - error(['input 1 must be numeric (3d array of doubles)',... - ' in the 2 input case']); - else - g = arg_one; - ROM = []; - end -end - -if nargin > 2 - if (not(isa(arg_one, 'struct')) && not(isa(arg_one, 'numeric'))) - error(['input 1 must be numeric (3d array of doubles)',... - ' or equation structure']); - end - - if not(isa(varargin{1}, 'struct')) || ... - (nargin == 4 && not(isa(varargin{2}, 'struct'))) - error(['Either all inputs are structures, or the first input',... - 'is numeric and the rest are structures']) - end - - if isa(arg_one, 'numeric') - g = arg_one; - ROM = varargin{1}; - eqn = []; - oper = []; - else - - g=[]; - eqn = arg_one; - oper = varargin{1}; - - if nargin == 4 - ROM = varargin{2}; - else - ROM = []; - end - end -end - -%% check field opts.sigma -if not(isfield(opts,'sigma')) || not(isstruct(opts.sigma)) - error('MESS:control_data',... - 'No sigma plot control data found in options structure.'); -end - -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Check info parameter for output verbosity -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -if not(isfield(opts.sigma,'info')) - opts.sigma.info = 2; -else - if not(isnumeric(opts.sigma.info)) && not(islogical(opts.sigma.info)) - error('MESS:info', ... - 'opts.sigma.info parameter must be logical or numeric.'); - end -end - -if isempty(g) - - if not(isfield(opts.sigma,'w')) && ... - not(all(isfield(opts.sigma,{'fmin','fmax'}))) - - error('MESS:control_data',... - ['sigma plot control data does not contain', ... - ' frequency range bounds.']); - end - - if not(isfield(opts.sigma,'nsample')) - - opts.sigma.nsample = 100; - end - -elseif not(isfield(opts.sigma,'w')) - - error('MESS:control_data', ... - ['sigma plot control data must contain frequency vector w', ... - ' when presampled original is given']); -end - -if isfield(opts.sigma,'w') - w = opts.sigma.w; - opts.sigma.nsample = length(w); -else - if (floor(opts.sigma.fmin) == opts.sigma.fmin) && ... - (floor(opts.sigma.fmax) == opts.sigma.fmax) - w = logspace(opts.sigma.fmin,opts.sigma.fmax,opts.sigma.nsample); - else - w = logspace(log10(opts.sigma.fmin), ... - log10(opts.sigma.fmax),opts.sigma.nsample); - end -end - -%% preallocation -out.tr1 = zeros(1,opts.sigma.nsample); - -if isempty(g) - - m = size(eqn.C,1); - p = size(eqn.B,2); - - out.g1 = zeros(m,p,opts.sigma.nsample); -else - - [m,p] = size(g(:,:,1)); - - out.g1 = g; -end - -if not(isempty(ROM)) - out.tr2 = out.tr1; - out.err = out.tr1; - out.relerr = out.tr1; - - out.g2 = zeros(m,p,opts.sigma.nsample); -end - -if opts.sigma.info - fprintf(['Computing TFMs of original and reduced order systems and ' ... - 'MOR errors\n']); -end - -%% preprocess shifted solver if eqn is given -if isempty(g) - [result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A','E'); - - if not(result) - error('MESS:control_data', ['system data is not completely',... - ' defined or corrupted']); - end - - [eqn, opts, oper] = oper.sol_ApE_pre(eqn, opts, oper); -end - -%% make sure we have an E in the first-order ROM -if not(isempty(ROM)) - - if (not(isfield(ROM,'A')) && any(not(isfield(ROM,{'K','M'})))) || ... - not(isfield(ROM,'B')) || ... - (not(isfield(ROM,'C')) && all(not(isfield(ROM,{'Cv','Cp'})))) - error('Found incomplete ROM structure!') - end - - if not(isfield(ROM,'E')) - if not(isfield(ROM,'A')) - ROM.E = []; - else - ROM.E = eye(size(ROM.A)); - end - end - - if isfield(ROM, 'Cp') && not(isfield(ROM, 'Cv')), ROM.Cv = []; end - if isfield(ROM, 'Cv') && not(isfield(ROM, 'Cp')), ROM.Cp = []; end +%% For backward compatibility copy all information from +% opts.sigma to opts.tf_plot +if isfield(opts, 'sigma') && isstruct(opts.sigma) + opts.tf_plot = opts.sigma; end -%% perform the actual sampling -for k=1:opts.sigma.nsample - - if (opts.sigma.info && not(mod(k,opts.sigma.nsample/10))) - fprintf('\r Step %3d / %3d',k,opts.sigma.nsample); - end - - if isempty(g) % sample original model only if it was not given - - out.g1(:,:,k) = full(eqn.C * oper.sol_ApE(eqn, opts, ... - 'N',-1i*w(k),'N',-eqn.B,'N')); - - if isfield(eqn,'D') && not(isempty(eqn.D)) - - out.g1(:,:,k) = out.g1(:,:,k) + eqn.D; - end - end - - if not(isempty(ROM)) % sample reduced model only if it was given - - if isfield(ROM,'A') - out.g2(:,:,k) = ROM.C * ( (1i*w(k)*ROM.E - ROM.A) \ ROM.B ); - else - out.g2(:,:,k) = (ROM.Cp + 1i*w(k)*ROM.Cv) * ... - (( -w(k) * ( w(k)*ROM.M - 1i*ROM.E ) + ROM.K) \ ROM.B ); - end - - if isfield(ROM,'D') && not(isempty(ROM.D)) - - out.g2(:,:,k) = out.g2(:,:,k) + ROM.D; - end - - end - - out.tr1(k) = max(svd(out.g1(:,:,k))); - - if not(isempty(ROM)) - out.err(k) = max(svd(out.g1(:,:,k) - out.g2(:,:,k))); - out.tr2(k) = max(svd(out.g2(:,:,k))); - out.relerr(k) = out.err(k)/out.tr1(k); - end -end - -out.w = w; - -if opts.sigma.info - fprintf('\n\n'); -end - -%% postprocess shifted solver if eqn is given -if isempty(g) - [eqn, opts, oper] = oper.sol_ApE_post(eqn, opts, oper); -end - -%% Finally, the plots (if desired) -if isnumeric(opts.sigma.info) && opts.sigma.info > 1 - if not(isempty(ROM)) - - figure(); - - subplot(2,1,1); - loglog(out.w, out.err, 'LineWidth', 3); - title('absolute model reduction error'); - xlabel('\omega'); - ylabel('\sigma_{max}(G(j\omega) - G_r(j\omega))'); - axis tight; - - subplot(2,1,2); - loglog(out.w, out.relerr, 'LineWidth', 3); - title('relative model reduction error'); - xlabel('\omega'); - ylabel(['\sigma_{max}(G(j\omega) - G_r(j\omega)) / \' ... - 'sigma_{max}(G(j\omega))']); - axis tight; - end - - figure(); - - loglog(out.w, out.tr1, 'LineWidth', 3); - - if not(isempty(ROM)) - hold on; - loglog(out.w, out.tr2, 'r--', 'LineWidth', 3); - hold off; - - legend({'original system','reduced system'}); - title('Transfer functions of original and reduced systems'); - else - legend({'original system'}); - title('Transfer functions of original system'); - end - - xlabel('\omega'); - ylabel('\sigma_{max}(G(j\omega))'); - axis tight; -end +%% Forward call to mess_tf_plot +opts.tf_plot.type = 'sigma'; +[out, eqn, opts, oper] = mess_tf_plot(arg_one, opts, varargin{:}); diff --git a/mor/mess_square_root_method.m b/mor/mess_square_root_method.m index 22ff185..142da1f 100644 --- a/mor/mess_square_root_method.m +++ b/mor/mess_square_root_method.m @@ -1,9 +1,11 @@ -function [TL,TR,hsv,eqn,opts,oper] = mess_square_root_method(eqn,opts,oper,ZB,ZC) +function [TL, TR, hsv, eqn, opts, oper] = ... + mess_square_root_method(eqn, opts, oper, ZB, ZC) % Square root method for the computation of the balanced and reduced % system % % Call -% [TL,TR,hsv,eqn,opts,oper] = mess_square_root_method(eqn,opts,oper,ZB,ZC); +% [TL, TR, hsv, eqn, opts, oper] = ... +% mess_square_root_method(eqn,opts,oper,ZB,ZC); % % Inputs: % eqn, opt, oper the standard mess structures @@ -12,13 +14,13 @@ % ZB, ZC the (tall and skinny) Gramian factors % % Outputs: -% TL,TR left and right truncation matrices +% TL, TR left and right truncation matrices % hsv computed Hankel singular values % -% The implementation (especially in the case E!=I) follows the +% The implementation (especially in the case not(E==I) ) follows the % derivation in: -% Efficient Numerical Solution of Large Scale Algebraic Matrix -% Equations in PDE Control and Model Order Reduction; +% Efficient Numerical Solution of Large Scale Algebraic Matrix +% Equations in PDE Control and Model Order Reduction; % Saak, Jens; % Dissertation, TU Chemnitz; 2009. % @@ -26,7 +28,7 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % @@ -34,43 +36,45 @@ % Check necessary control data [result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A', 'E'); -[eqn, opts, oper] = oper.mul_E_pre(eqn,opts,oper); +[eqn, opts, oper] = oper.mul_E_pre(eqn, opts, oper); if not(result) - error('MESS:control_data', ... - 'system data is not completely defined or corrupted'); + mess_err(opts, ... + 'control_data', ... + 'system data is not completely defined or corrupted'); end -if isfield(opts,'srm') - if not(isfield(opts.srm,'tol')) - error('MESS:Missing truncation tolerance opts.srm.tol'); - end +if isfield(opts, 'srm') + if not(isfield(opts.srm, 'tol')) + mess_err(opts, 'Missing truncation tolerance opts.srm.tol'); + end - if not(isfield(opts.srm,'max_ord')) - opts.srm.max_ord = oper.size(eqn,opts); - end + if not(isfield(opts.srm, 'max_ord')) + opts.srm.max_ord = oper.size(eqn, opts); + end - if not(isfield(opts.srm,'info')) - opts.srm.info = 0; - end + if not(isfield(opts.srm, 'info')) + opts.srm.info = 0; + end else - error('MESS:Missing srm substructure in opts argument.'); + mess_err(opts, 'Missing srm substructure in opts argument.'); end %% Compute SVD of Gramian factor product in the correct inner product if eqn.haveE - [U0,S0,V0] = svd(ZC'*oper.mul_E(eqn, opts, 'N', ZB, 'N'),0); + [U0, S0, V0] = svd(ZC' * oper.mul_E(eqn, opts, 'N', ZB, 'N'), 0); else - [U0,S0,V0] = svd(ZC'*ZB,0); + [U0, S0, V0] = svd(ZC' * ZB, 0); end %% Determine possible and desired ROM order hsv = diag(S0); ks = length(hsv); -nr = oper.size(eqn,opts) - ks; +nr = oper.size(eqn, opts) - ks; k = ks; -while ((2.0*sum(hsv(ks:-1:k-1))+nr*hsv(ks)) < opts.srm.tol) && (k > 2) +while ((2.0 * sum(hsv(ks:-1:k - 1)) + nr * hsv(ks)) < opts.srm.tol) && ... + (k > 2) k = k - 1; end @@ -79,25 +83,26 @@ r = min([opts.srm.max_ord k0]); if opts.srm.info > 0 - fprintf(1,['reduced system order: %d', ... - ' (max possible/allowed: %d/%d)\n\n'],r,ks,opts.srm.max_ord); + mess_fprintf(opts, ... + ['reduced system order: %d', ... + ' (max possible/allowed: %d/%d)\n\n'], ... + r, ks, opts.srm.max_ord); end % Compute the truncating projection matrices S = sparse(1:r, 1:r, 1 ./ sqrt(hsv(1:r))); -TL = (ZC*U0(:,1:r)) * S; -TR = (ZB*V0(:,1:r)) * S; +TL = (ZC * U0(:, 1:r)) * S; +TR = (ZB * V0(:, 1:r)) * S; % augment projection matrices by preselected columns -if isfield(opts.srm,'V') && ismatrix(opts.srm.V) - TL = [TL,opts.srm.V]; +if isfield(opts.srm, 'V') && ismatrix(opts.srm.V) + TL = [TL, opts.srm.V]; end -if isfield(opts.srm,'W') && ismatrix(opts.srm.W) +if isfield(opts.srm, 'W') && ismatrix(opts.srm.W) TR = [TR, opts.srm.W]; end -[eqn, opts, oper] = oper.mul_E_post(eqn,opts,oper); - +[eqn, opts, oper] = oper.mul_E_post(eqn, opts, oper); diff --git a/mor/mess_tangential_irka.m b/mor/mess_tangential_irka.m index 12babe8..966cdee 100644 --- a/mor/mess_tangential_irka.m +++ b/mor/mess_tangential_irka.m @@ -1,30 +1,32 @@ -function [Er, Ar, Br, Cr, S, b, c, V, W, term_flag] = mess_tangential_irka(varargin) +function [Er, Ar, Br, Cr, Dr, outinfo] = mess_tangential_irka(varargin) % The tangential IRKA method with automatic selection of initial shifts and % tangential directions. % % Call -% [Er,Ar,Br,Cr,S,b,c,V,W,term_flag] = mess_tangential_irka(E,A,B,C,opts) -% or -% = mess_tangential_irka(sys,opts) -% with sys = sparss(A,B,C,[],E) +% [Er, Ar, Br, Cr, Dr, outinfo] = mess_tangential_irka(E, A, B, C, D, opts) +% or +% mess_tangential_irka(sys, opts) +% with sys = sparss(A, B, C, D, E) % -% [Er,Ar,Br,Cr,S,c,V,W,term_flag] = mess_tangential_irka(M,E,K,B,Cp,Cv,opts) -% or -% = mess_tangential_irka(sys,opts) -% with sys = mechss(M,E,K,B,Cp,Cv,[]) +% [Er, Ar, Br, Cr, Dr, outinfo] = +% mess_tangential_irka(M, E, K, B, Cp, Cv, D, opts) +% or +% mess_tangential_irka(sys, opts) +% with sys = mechss(M, E, K, B, Cp, Cv, D) % -% [Er,Ar,Br,Cr,S,c,V,W,term_flag] = mess_tangential_irka(eqn,opts,oper) +% [Er, Ar, Br, Cr, Dr, outinfo] = ... +% mess_tangential_irka(eqn, opts, oper) % % Inputs: -% E,A,B,C The mass, system, input and output matrices describing the -% original system +% E, A, B, C The mass, system, input and output matrices describing the +% original system % -% M,E,K,B, The mass, system, input and output matrices describing the -% Cp,Cv original system +% M, E, K, B, The mass, system, input and output matrices describing the +% Cp, Cv original system % -% eqn struct contains data for equations +% eqn struct contains data for equations % -% opts optional options structure with substructure 'irka' +% opts optional options structure with substructure 'irka' % % Input fields in struct opts.irka: % @@ -33,11 +35,11 @@ % maxiter maximum iteration number for the IRKA iteration % (optional, default: 100) % -% shift_tol bound for the relative change of the IRKA shifts used as -% stopping criterion (optional, default: 1e-6) +% shift_tol bound for the relative change of the IRKA shifts used +% as stopping criterion (optional, default: 1e-6) % -% h2_tol bound for the relative change of the H2-norm compared to -% the last stable ROM (optional, default: 100*eps) +% h2_tol bound for the relative change of the H2-norm compared +% to the last stable ROM (optional, default: 100*eps) % % num_prev_shifts number of previous shift vectors stored for cycle % detection (optional, default: 5) @@ -51,16 +53,18 @@ % (only for matrix inputs) % % init shift and direction initialization choice: (optional) -% 'subspace' chooses a random subspace and uses it to compute -% projected shifts and directions from the -% projected EVP just like in the IRKA iteration. -% (default) -% 'logspace' picks logspaced shifts in [0,1] and all ones -% as tangential directions -% 'random' picks normally distributed random shifts and -% tangential directions -% 'rom' an asymptotically stable initial guess for the -% reduced model of order r is given in +% 'subspace' chooses a random subspace and uses it to +% compute projected shifts and directions +% from the projected EVP just like in the +% IRKA iteration. (default) +% 'logspace' picks logspaced shifts in [0,1] and all +% ones as tangential directions +% 'random' picks normally distributed random shifts +% and tangential directions (does not fix a +% seed, for reproducible results the caller +% should do this) +% 'rom' an asymptotically stable initial guess for +% the reduced model of order r is given in % opts.irka.Er, opts.irka.Ar, opts.irka.Br, % opts.irka.Cr. % @@ -68,67 +72,71 @@ % the wrong halfplane. (optional, default: 0) % % Outputs: -% Er,Ar,Br,Cr The reduced system matrices. -% S,b,c The final shifts and tangential directions -% V,W The final truncation matrices -% term_flag An indicator which stopping criterion stopped IRKA +% Er, Ar, Br, Cr, Dr The reduced system matrices. +% +% outinfo structure with members +% S, b, c The final shifts and tangential directions +% TR, TL The final truncation matrices +% term_flag An indicator which stopping criterion stopped IRKA % % NOTE: Currently only standard state space systems and descriptor systems -% with E invertible are supported. +% with E invertible are supported, when matrices are passed in. % % References: % [1] S. Gugercin, A. C. Antoulas, C. Beattie, H2 model reduction for -% large-scale linear dynamical systems, SIAM J. Matrix Anal. Appl. 30 (2) -% (2008) 609–638. https://doi.org/10.1137/060666123. +% large-scale linear dynamical systems, SIAM J. Matrix Anal. +% Appl. 30 (2) (2008) 609–638. https://doi.org/10.1137/060666123. % % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % %% decide if matrices or sparss/mechss was passed in +opts = struct(); if nargin == 2 if isa(varargin{1}, 'sparss') - [eqn, oper] = mess_wrap_sparss(varargin{1}, 'default'); opts = varargin{2}; + [eqn, opts, oper] = mess_wrap_sparss(varargin{1}, opts, 'default'); elseif isa(varargin{1}, 'mechss') - [eqn, oper] = mess_wrap_mechss(varargin{1}, 'so_2'); opts = varargin{2}; - eqn.haveE = 1; + [eqn, opts, oper] = mess_wrap_mechss(varargin{1}, opts, 'so_2'); end end %% Choose usfs set if matrices were passed in -if nargin == 5 % default first order system - oper = operatormanager('default'); -elseif nargin == 7 % second order system - oper = operatormanager('so_2'); +if nargin == 6 % default first order system + [oper, opts] = operatormanager(opts, 'default'); +elseif nargin == 8 % second order system + [oper, opts] = operatormanager(opts, 'so_2'); end %% Fill equation structure if matrices were passed in -if nargin == 5 +if nargin == 6 eqn.A_ = varargin{2}; if isempty(varargin{1}) eqn.E_ = speye(size(varargin{2}, 1)); else eqn.E_ = varargin{1}; - eqn.haveE = 1; + eqn.haveE = true; end eqn.B = full(varargin{3}); eqn.C = full(varargin{4}); - opts = varargin{5}; -elseif nargin == 7 + eqn.D = full(varargin{5}); + opts = varargin{6}; +elseif nargin == 8 eqn.M_ = varargin{1}; eqn.E_ = varargin{2}; eqn.K_ = varargin{3}; - eqn.haveE = 1; + eqn.haveE = true; eqn.B = [full(varargin{4}); zeros(size(varargin{4}))]; eqn.C = [full(varargin{5}), full(varargin{6})]; - opts = varargin{7}; + eqn.D = full(varargin{7}); + opts = varargin{8}; end %% handle D term @@ -142,55 +150,54 @@ D = eqn.D; end end +Dr = D; %% check field opts.irka if not(isfield(opts, 'irka')) || not(isstruct(opts.irka)) opts.irka = []; end -if not(isfield(opts.irka, 'r')) || isempty(opts.irka.r) +if notfield_or_empty(opts.irka, 'r') opts.irka.r = 25; end -if not(isfield(opts.irka, 'num_prev_shifts')) || ... - isempty(opts.irka.num_prev_shifts) +if notfield_or_empty(opts.irka, 'num_prev_shifts') opts.irka.num_prev_shifts = 5; end -if not(isfield(opts.irka, 'num_prev_ROMs')) || ... - isempty(opts.irka.num_prev_ROMs) +if notfield_or_empty(opts.irka, 'num_prev_ROMs') opts.irka.num_prev_ROMs = 5; end -if not(isfield(opts.irka, 'maxiter')) || isempty(opts.irka.maxiter) +if notfield_or_empty(opts.irka, 'maxiter') opts.irka.maxiter = 100; end -if not(isfield(opts.irka, 'init')) || isempty(opts.irka.init) +if notfield_or_empty(opts.irka, 'init') opts.irka.init = 'subspace'; end -if not(isfield(opts.irka, 'shift_tol')) || isempty(opts.irka.shift_tol) +if notfield_or_empty(opts.irka, 'shift_tol') opts.irka.shift_tol = 1e-6; end -if not(isfield(opts.irka, 'h2_tol')) || isempty(opts.irka.h2_tol) +if notfield_or_empty(opts.irka, 'h2_tol') opts.irka.h2_tol = 100 * eps; end -if not(isfield(opts.irka, 'info')) || isempty(opts.irka.info) +if notfield_or_empty(opts.irka, 'info') opts.irka.info = 1; end -if not(isfield(opts.irka, 'flipeig')) || isempty(opts.irka.flipeig) - opts.irka.flipeig = 0; +if notfield_or_empty(opts.irka, 'flipeig') + opts.irka.flipeig = false; end %% Initialize used usfs [result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A', 'E'); if not(result) - error('MESS:data', 'Equation data seems to be incomplete'); + mess_err(opts, 'data', 'Equation data seems to be incomplete'); end [eqn, opts, oper] = oper.mul_A_pre(eqn, opts, oper); @@ -213,19 +220,19 @@ isstab = zeros(opts.irka.maxiter, 1); % initialize termination flag -term_flag = []; +outinfo.term_flag = []; % Choose the initial shifts and tangential directions -initial_rom = 0; +initial_rom = false; switch opts.irka.init case 'subspace' U = get_initial_subspace(n, opts.irka.r); [X, S, Y] = eig(full(U' * (oper.mul_A(eqn, opts, 'N', U, 'N'))), ... - full(U' * (oper.mul_E(eqn, opts, 'N', U, 'N')))); + full(U' * (oper.mul_E(eqn, opts, 'N', U, 'N')))); - M = diag(ones(opts.irka.r, 1)./sqrt(diag(Y'*X))); + M = diag(ones(opts.irka.r, 1) ./ sqrt(diag(Y' * X))); Y = Y * M; X = X * M; b = (Y' * (U' * eqn.B)).'; @@ -252,21 +259,22 @@ Cr = opts.irka.Cr; [X, S, Y] = eig(Ar, Er); if any(real(diag(S)) >= 0) - error(['MESS:The initial guess for the reduced system must ', ... - 'be asymptotically stable!']); + mess_err(opts, 'unstable', ... + ['The initial guess for the reduced system must ', ... + 'be asymptotically stable!']); end - - M = diag(ones(opts.irka.r, 1)./sqrt(diag(Y'*X))); + + M = diag(ones(opts.irka.r, 1) ./ sqrt(diag(Y' * X))); Y = Y * M; X = X * M; b = (Y.' * Br).'; c = Cr * X; - + [S, perm] = mess_make_proper(diag(S)); b = b(:, perm); c = c(:, perm); - initial_rom = 1; + initial_rom = true; end %% Start iteration @@ -279,7 +287,7 @@ S_old(:, mod(iter, opts.irka.num_prev_shifts) + 1) = S; end - %% save previous ROM + %% save previous ROM into the buffer of recently seen stable ROMs if (initial_rom && (iter == 1)) || ((iter > 1) && isstab(iter - 1)) if initial_rom && (iter == 1) @@ -302,64 +310,65 @@ end %% Compute projection subspaces - V = zeros(n, opts.irka.r); - W = zeros(n, opts.irka.r); + TR = zeros(n, opts.irka.r); + TL = zeros(n, opts.irka.r); k = 1; while k < (opts.irka.r + 1) - x = oper.sol_ApE(eqn, opts, 'N', S(k), 'N', eqn.B*b(:, k), 'N'); - y = oper.sol_ApE(eqn, opts, 'T', S(k), 'T', eqn.C'*c(:, k), 'N'); + x = oper.sol_ApE(eqn, opts, 'N', S(k), 'N', eqn.B * b(:, k), 'N'); + y = oper.sol_ApE(eqn, opts, 'T', S(k), 'T', eqn.C' * c(:, k), 'N'); if not(imag(S(k)) == 0) - V(:, k:k+1) = [real(x), imag(x)]; - W(:, k:k+1) = [real(y), imag(y)]; + TR(:, k:k + 1) = [real(x), imag(x)]; + TL(:, k:k + 1) = [real(y), imag(y)]; k = k + 2; else - V(:, k) = real(x); - W(:, k) = real(y); + TR(:, k) = real(x); + TL(:, k) = real(y); k = k + 1; end end % find orthonormal bases - [V, ~] = qr(V, 0); - [W, ~] = qr(W, 0); + [TR, ~] = qr(TR, 0); + [TL, ~] = qr(TL, 0); - %% Biorthogonalize V,W in the E inner product - Er = (W' * oper.mul_E(eqn, opts, 'N', V, 'N')); + %% Biorthogonalize TR,TL in the E inner product + Er = (TL' * oper.mul_E(eqn, opts, 'N', TR, 'N')); [U, Sigma, Q] = svd(Er); - Sigma = diag(ones(opts.irka.r, 1)./sqrt(diag(Sigma))); - W = W * U * Sigma; - V = V * Q * Sigma; + Sigma = diag(ones(opts.irka.r, 1) ./ sqrt(diag(Sigma))); + TL = TL * U * Sigma; + TR = TR * Q * Sigma; %% Compute new ROM - Ar = W' * oper.mul_A(eqn, opts, 'N', V, 'N'); - Br = W' * eqn.B; - Cr = eqn.C * V; + Ar = TL' * oper.mul_A(eqn, opts, 'N', TR, 'N'); + Br = TL' * eqn.B; + Cr = eqn.C * TR; Er = eye(opts.irka.r); % by construction %% Update interpolation points/tangential directions % compute eigendecomposition - [X, S, Y] = eig(Ar); S=diag(S); - + [X, S, Y] = eig(Ar); + S = diag(S); + % ensure the correct scaling of left and right eigenvectors - M = diag(ones(opts.irka.r, 1)./sqrt(diag(Y'*X))); + M = diag(ones(opts.irka.r, 1) ./ sqrt(diag(Y' * X))); Y = Y * M; X = X * M; - + % make sure all shifts are in the correct half plane. wrongsign = find(real(S) > 0); if not(isempty(wrongsign)) - if (opts.irka.flipeig) - warning('MESS:IRKA:unstable', ... - ['IRKA step %d : %d non-stable reduced eigenvalues ' ... - 'have been flipped.\n'], iter, length(wrongsign)); + if opts.irka.flipeig + mess_warn(opts, 'unstable', ... + ['IRKA step %d : %d non-stable reduced eigenvalues ' ... + 'have been flipped.\n'], iter, length(wrongsign)); else - warning('MESS:IRKA:unstable', ... - ['IRKA step %d : %d non-stable reduced eigenvalues ' ... - 'detected.\n'], iter, length(wrongsign)); + mess_warn(opts, 'unstable', ... + ['IRKA step %d : %d non-stable reduced eigenvalues ' ... + 'detected.\n'], iter, length(wrongsign)); end else isstab(iter) = 1; @@ -372,21 +381,21 @@ % update tangential directions b = (Y.' * Br).'; c = Cr * X; - + % make sure complex conjugate shifts come in consecutive pairs such % that real basis extension works properly [S, perm] = mess_make_proper(S); b = b(:, perm); c = c(:, perm); - + %% compute convergence indices - % maximum pointwise relative change of the shifts for the last num_prev_shifts - % shift vectors + % maximum pointwise relative change of the shifts for the last + % num_prev_shifts shift vectors shiftchg = realmax; for shift_iter = 1:min(opts.irka.num_prev_shifts, iter) - shiftchg_iter = norm((S - S_old(:, shift_iter))./S, 'inf'); + shiftchg_iter = norm((S - S_old(:, shift_iter)) ./ S, 'inf'); if shiftchg_iter < shiftchg shiftchg = shiftchg_iter; @@ -421,61 +430,67 @@ %% If desired print status message if opts.irka.info - fprintf(['IRKA step %3d, rel. chg. shifts = %e , rel. H2-norm ', ... - 'chg. ROM = %e\n'], iter, shiftchg, romchg); + mess_fprintf(opts, ... + ['IRKA step %3d, rel. chg. shifts = %e , rel. H2-norm', ... + ' chg. ROM = %e\n'], ... + iter, shiftchg, romchg); end %% evaluate stopping criteria if shiftchg < opts.irka.shift_tol - term_flag = 'shift_tol'; + outinfo.term_flag = 'shift_tol'; if opts.irka.info - fprintf(['IRKA terminated due to relative change ', ... - 'of shifts criterion.\n\n']); + mess_fprintf(opts, ['IRKA terminated due to relative change ', ... + 'of shifts criterion.\n\n']); end - break; + break end if romchg < opts.irka.h2_tol - term_flag = 'h2_tol'; + outinfo.term_flag = 'h2_tol'; if opts.irka.info - fprintf(['IRKA terminated due to relative change ', ... - 'of ROMs criterion.\n\n']); + mess_fprintf(opts, ['IRKA terminated due to relative change ', ... + 'of ROMs criterion.\n\n']); end - break; + break end end -if (iter == opts.irka.maxiter) && isempty(term_flag) - warning('MESS:IRKA:convergence', ... - 'IRKA: No convergence in %d iterations.\n', opts.irka.maxiter); - term_flag = 'maxiter'; +if (iter == opts.irka.maxiter) && isempty(outinfo.term_flag) + mess_warn(opts, 'convergence', ... + 'IRKA: No convergence in %d iterations.\n', opts.irka.maxiter); + outinfo.term_flag = 'maxiter'; end -if (opts.irka.info > 1) +if opts.irka.info > 1 ROM = struct('A', Ar, 'E', Er, 'B', Br, 'C', Cr, 'D', D); - if not(isfield(opts, 'sigma')) - opts.sigma = struct(); + if not(isfield(opts, 'tf_plot')) + opts.tf_plot = struct(); end - if not(isfield(opts.sigma, 'fmin')) - opts.sigma.fmin = -6; + if not(isfield(opts.tf_plot, 'fmin')) + opts.tf_plot.fmin = -6; end - if not(isfield(opts.sigma, 'fmax')) - opts.sigma.fmax = 6; + if not(isfield(opts.tf_plot, 'fmax')) + opts.tf_plot.fmax = 6; end - if not(isfield(opts.sigma, 'nsample')) - opts.sigma.nsample = 100; + if not(isfield(opts.tf_plot, 'nsample')) + opts.tf_plot.nsample = 100; end - if not(isfield(opts.sigma, 'info')) - opts.sigma.info = opts.irka.info; + if not(isfield(opts.tf_plot, 'info')) + opts.tf_plot.info = opts.irka.info; end - [~, eqn, opts, oper] = mess_sigma_plot(eqn, opts, oper, ROM); + if not(isfield(opts.tf_plot, 'type')) + opts.tf_plot.type = 'sigma'; + end + + [~, eqn, opts, oper] = mess_tf_plot(eqn, opts, oper, ROM); end [eqn, opts, oper] = oper.mul_A_post(eqn, opts, oper); @@ -483,3 +498,15 @@ oper.sol_ApE_post(eqn, opts, oper); +outinfo.S = S; +outinfo.b = b; +outinfo.c = c; + +outinfo.TR = TR; +outinfo.TL = TL; + +end + +function bool = notfield_or_empty(mystruct, myfield) +bool = not(isfield(mystruct, myfield)) || isempty(mystruct.(myfield)); +end diff --git a/mor/mess_tf_plot.m b/mor/mess_tf_plot.m new file mode 100644 index 0000000..a0b9af2 --- /dev/null +++ b/mor/mess_tf_plot.m @@ -0,0 +1,440 @@ +function [out, eqn, opts, oper] = mess_tf_plot(arg_one, opts, varargin) +% Computation of simple transfer function plots for descriptor systems with +% and comparison to reduced order models. +% +% Calling sequence: +% +% [out, eqn, opts, oper] = mess_tf_plot(eqn, opts, oper, ROM) +% or +% +% [out, eqn, opts, oper] = mess_tf_plot(g, opts, ROM) +% +% INPUTS: +% eqn struct contains data for equations +% +% g presampled transfer function of the original system +% fitting the parameters in opts.tf_plot +% +% opts struct contains parameters for the algorithm +% (mandatory with substructure opts.tf_plot) +% +% oper struct contains function handles for operation with A and E +% +% ROM structure containing reduced order model matrices +% either E, A, B, C, D, +% or M, E, K, B, Cv, Cp, D +% where in the first case E and in both cases D are optional. +% (optional when eqn is present; mandatory otherwise) +% +% The relevant substructure of opts is opts.tf_plot with members: +% +% type type of plot (optional, defaults to 'sigma') +% 'sigma' sigma magnitude plot +% 'Fro' Frobenius norm plot +% +% fmin, fmax left and right bounds of the frequency range. They will be +% interpreted as exponents in the logarithmic range if +% integers are passed. +% (mandatory for input eqn, ignored for input tr (check w +% below)) +% +% nsample number of transfer function samples to take in the plot +% (optional, defaults to 100) +% +% info verbosity control. (optional, defaults to 2) +% 1 only progress is reported +% 2 also generate the actual sigma plots. +% +% w vector of frequency samples in rad/s +% (mandatory for input g, ignored for input eqn) +% +% Hz Indicates to use Hertz on the frequency-axis, when info == 2. +% Only used for plotting, Output frequencies (out.w) will +% remain given in rad/s. +% (optional, default: false) +% +% db Indicates to use decibels on the magnitude-axis, when +% info == 2. +% Only scales presentation in the plot, not the vectors in +% out below. +% (optional, default: false) +% +% Outputs: +% +% out.w vector of sampling frequencies +% +% out.err vector of sampled maximal singular values of the transfer +% function of the error system (only when ROM was given) +% out.relerr vector of sampled maximal singular values of the transfer +% function of the error system (only when ROM was given) +% relative to the FOM. +% out.tr1 vector of sampled maximal singular values of the transfer +% function of the FOM +% out.tr2 vector of sampled maximal singular values of the transfer +% function of the ROM (only when ROM is given) +% out.g1 vector of sampled values of the transfer function of the +% FOM +% out.g2 vector of sampled values of the transfer function of the +% ROM (only when ROM is given) + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +%% Check and assign inputs +narginchk(2, 4); + +if not(isa(opts, 'struct')) + mess_err(opts, 'illegal_input', ... + 'second input must be am options structure'); +end + +if nargin == 2 + if not(isa(arg_one, 'numeric')) + mess_err(opts, 'illegal_input', ... + ['First input must be numeric (3d array of doubles)', ... + ' in the two input case']); + else + g = arg_one; + ROM = []; + end +end + +if nargin > 2 + if not(isa(arg_one, 'struct')) && not(isa(arg_one, 'numeric')) + mess_err(opts, 'illegal_input', ... + ['input 1 must be numeric (3d array of doubles)', ... + ' or equation structure']); + end + + if not(isa(varargin{1}, 'struct')) || ... + (nargin == 4 && not(isa(varargin{2}, 'struct'))) + mess_err(opts, 'illegal_input', ... + ['Either all inputs are structures, ', ... + 'or the first input is numeric ', ... + 'and the rest are structures']); + end + + if isa(arg_one, 'numeric') + g = arg_one; + ROM = varargin{1}; + eqn = []; + oper = []; + else + + g = []; + eqn = arg_one; + oper = varargin{1}; + + if nargin == 4 + ROM = varargin{2}; + else + ROM = []; + end + end +end + +%% check field opts.tf_plot +if not(isfield(opts, 'tf_plot')) || not(isstruct(opts.tf_plot)) + mess_err(opts, 'control_data', ... + 'No tf_plot control data found in options structure.'); +end + +if not(isfield(opts.tf_plot, 'type')) || not(ischar(opts.tf_plot.type)) + mess_warn(opts, 'control_data', ... + ['Missing or invalid type selector in options ', ... + 'structure. Falling back to sigma magnitude plot.\n']); + opts.tf_plot.type = 'sigma'; +end + +%% select plot type and setup axis labels +switch lower(opts.tf_plot.type) + case 'sigma' + fun = @(TF) max(svd(TF)); + ystr_err = '\sigma_{max}(G(j\omega) - G_r(j\omega))'; + ystr_fun = '\sigma_{max}(G(j\omega))'; + + case {'fro', 'frobenius'} + fun = @(TF) norm(TF, 'fro'); + ystr_err = '||G(j\omega) - G_r(j\omega)||_{F}'; + ystr_fun = '||G(j\omega)||_{F}'; + + otherwise + mess_err(opts, 'control_data', ... + 'Unknown plot type requested.'); + +end +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Check info parameter for output verbosity and desired axis units +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if not(isfield(opts.tf_plot, 'info')) + opts.tf_plot.info = 2; +else + if not(isnumeric(opts.tf_plot.info)) && ... + not(islogical(opts.tf_plot.info)) + mess_err(opts, 'info', ... + 'opts.tf_plot.info parameter must be logical or numeric.'); + end +end + +if not(isfield(opts.tf_plot, 'Hz')) + opts.tf_plot.Hz = false; +end +if opts.tf_plot.Hz + xstr = '\omega [Hz]'; +else + xstr = '\omega [rad/s]'; +end + +if not(isfield(opts.tf_plot, 'db')) + opts.tf_plot.db = false; +end +if opts.tf_plot.db + ystr_fun = [ystr_fun, ' [db]']; + ystr_err = [ystr_err, ' [db]']; +end +%% +% check if required frequency vector is given together with pre-samples in g +if isempty(g) + + if not(isfield(opts.tf_plot, 'w')) && ... + not(all(isfield(opts.tf_plot, {'fmin', 'fmax'}))) + + mess_err(opts, 'control_data', ... + ['tf_plot control data does not contain', ... + ' frequency range bounds.']); + end + + if not(isfield(opts.tf_plot, 'nsample')) + + opts.tf_plot.nsample = 100; + end + +elseif not(isfield(opts.tf_plot, 'w')) + + mess_err(opts, 'control_data', ... + ['tf_plot control data must contain frequency vector w', ... + ' when presampled original is given']); +end + +% if no frequency vector was passed in let's generate one +if isfield(opts.tf_plot, 'w') + w = opts.tf_plot.w; + opts.tf_plot.nsample = length(w); +else + if (floor(opts.tf_plot.fmin) == opts.tf_plot.fmin) && ... + (floor(opts.tf_plot.fmax) == opts.tf_plot.fmax) + w = logspace(opts.tf_plot.fmin, ... + opts.tf_plot.fmax, ... + opts.tf_plot.nsample); + else + w = logspace(log10(opts.tf_plot.fmin), ... + log10(opts.tf_plot.fmax), ... + opts.tf_plot.nsample); + end +end + +%% preallocation +out.tr1 = zeros(1, opts.tf_plot.nsample); + +if isempty(g) + + m = size(eqn.C, 1); + p = size(eqn.B, 2); + + out.g1 = zeros(m, p, opts.tf_plot.nsample); +else + + [m, p] = size(g(:, :, 1)); + + out.g1 = g; +end + +if not(isempty(ROM)) + out.tr2 = out.tr1; + out.err = out.tr1; + out.relerr = out.tr1; + + out.g2 = zeros(m, p, opts.tf_plot.nsample); +end + +if opts.tf_plot.info + mess_fprintf(opts, ... + ['Computing TFMs of original and reduced order systems ' ... + 'and MOR errors\n']); +end + +%% preprocess shifted solver if eqn is given +if isempty(g) + [result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A', 'E'); + + if not(result) + mess_err(opts, 'control_data', ... + 'system data is not completely defined or corrupted'); + end + + [eqn, opts, oper] = oper.sol_ApE_pre(eqn, opts, oper); +end + +%% make sure we have an E in the first-order ROM +if not(isempty(ROM)) + + if (not(isfield(ROM, 'A')) && any(not(isfield(ROM, {'K', 'M'})))) || ... + not(isfield(ROM, 'B')) || ... + (not(isfield(ROM, 'C')) && ... + all(not(isfield(ROM, {'Cv', 'Cp'})))) + + mess_err(opts, 'illegal_input', ... + 'Found incomplete ROM structure!'); + end + + if not(isfield(ROM, 'E')) + if not(isfield(ROM, 'A')) + ROM.E = []; + else + ROM.E = eye(size(ROM.A)); + end + end + + if isfield(ROM, 'Cp') && not(isfield(ROM, 'Cv')) + ROM.Cv = []; + end + if isfield(ROM, 'Cv') && not(isfield(ROM, 'Cp')) + ROM.Cp = []; + end +end + +%% perform the actual sampling +for k = 1:opts.tf_plot.nsample + + if opts.tf_plot.info && not(mod(k, opts.tf_plot.nsample / 10)) + mess_fprintf(opts, '\r Step %3d / %3d', k, opts.tf_plot.nsample); + end + + if isempty(g) % sample original model only if it was not given + + out.g1(:, :, k) = full(eqn.C * ... + oper.sol_ApE(eqn, opts, ... + 'N', -1i * w(k), ... + 'N', -eqn.B, 'N')); + + if isfield(eqn, 'D') && not(isempty(eqn.D)) + + out.g1(:, :, k) = out.g1(:, :, k) + eqn.D; + end + end + + if not(isempty(ROM)) % sample reduced model only if it was given + + if isfield(ROM, 'A') + out.g2(:, :, k) = ROM.C * ((1i * w(k) * ROM.E - ROM.A) \ ROM.B); + else + out.g2(:, :, k) = (ROM.Cp + 1i * w(k) * ROM.Cv) * ... + ((-w(k) * (w(k) * ROM.M - 1i * ROM.E) + ROM.K) \ ROM.B); + end + + if isfield(ROM, 'D') && not(isempty(ROM.D)) + + out.g2(:, :, k) = out.g2(:, :, k) + ROM.D; + end + + end + + out.tr1(k) = max(svd(out.g1(:, :, k))); + + if not(isempty(ROM)) + out.err(k) = fun(out.g1(:, :, k) - out.g2(:, :, k)); + out.tr2(k) = fun(out.g2(:, :, k)); + out.relerr(k) = out.err(k) / out.tr1(k); + end +end + +out.w = w; + +if opts.tf_plot.info + mess_fprintf(opts, '\n\n'); +end + +%% postprocess shifted solver if eqn is given +if isempty(g) + [eqn, opts, oper] = oper.sol_ApE_post(eqn, opts, oper); +end + +%% Finally, the plots (if desired) +if opts.tf_plot.Hz + % we want to rescale to Hz + rescale_to_unit = @(w) w / (2 * pi); +else + % do nothing + rescale_to_unit = @(w) w; +end + +if isnumeric(opts.tf_plot.info) && opts.tf_plot.info > 1 + if not(isempty(ROM)) + + figure(); + + subplot(2, 1, 1); + if opts.tf_plot.db + semilogx(rescale_to_unit(out.w), ... + 20 * log10(squeeze(out.err)), ... + 'LineWidth', 3); + else + loglog(rescale_to_unit(out.w), out.err, 'LineWidth', 3); + end + title('absolute model reduction error'); + xlabel(xstr); + ylabel(ystr_err); + axis tight; + + subplot(2, 1, 2); + if opts.tf_plot.db + semilogx(rescale_to_unit(out.w), ... + 20 * log10(squeeze(out.relerr)), ... + 'LineWidth', 3); + else + loglog(rescale_to_unit(out.w), out.relerr, 'LineWidth', 3); + end + title('relative model reduction error'); + xlabel(xstr); + ylabel([ystr_err, '/ ', ystr_fun]); + axis tight; + end + + figure(); + if opts.tf_plot.db + semilogx(rescale_to_unit(out.w), ... + 20 * log10(squeeze(out.tr1)), ... + 'LineWidth', 3); + else + loglog(rescale_to_unit(out.w), out.tr1, 'LineWidth', 3); + end + + if not(isempty(ROM)) + hold on; + if opts.tf_plot.db + semilogx(rescale_to_unit(out.w), ... + 20 * log10(squeeze(out.tr2)), ... + 'LineWidth', 3); + else + loglog(rescale_to_unit(out.w), out.tr2, 'r--', 'LineWidth', 3); + end + + hold off; + + legend({'original system', 'reduced system'}); + title('Transfer functions of original and reduced systems'); + else + legend({'original system'}); + title('Transfer functions of original system'); + end + + xlabel(xstr); + ylabel(ystr_fun); + axis tight; +end diff --git a/mor/private/get_initial_subspace.m b/mor/private/get_initial_subspace.m index e6fc541..563c5e3 100644 --- a/mor/private/get_initial_subspace.m +++ b/mor/private/get_initial_subspace.m @@ -1,4 +1,4 @@ -function U = get_initial_subspace(n,r) +function U = get_initial_subspace(n, r) % % U = get_initial_subspace(n,r) % @@ -8,23 +8,23 @@ % column and so on. The first entry is always one. % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % +opts = struct; +if not(nargin == 2) -if nargin~=2 - - error(['MESS:get_initial_subspace:', ... - 'number of rows n and columns r are mandatory!']); + mess_err(opts, 'get_initial_subspace', ... + 'number of rows n and columns r are mandatory!'); end -V = zeros(n,r); +V = zeros(n, r); for k = 1:r - V(1:k:n,k) = 1.0; + V(1:k:n, k) = 1.0; end -[U, ~] = qr(V,0); +[U, ~] = qr(V, 0); diff --git a/mor/private/mess_h2_rom_change.m b/mor/private/mess_h2_rom_change.m new file mode 100644 index 0000000..f3dffed --- /dev/null +++ b/mor/private/mess_h2_rom_change.m @@ -0,0 +1,54 @@ +function [romchg] = mess_h2_rom_change(E1, A1, B1, C1, E2, A2, B2, C2, rel) +% [romchg] = mess_h2_rom_change(E1,A1,B1,C1,E2,A2,B2,C2,rel) +% +% computes the (relative) difference of two stable systems in the H2 norm. +% +% Inputs: +% E1,A1,B1,C1,E2,A2,B2,C2 The system matrices (E1,E2 invertible) +% rel indicator whether the relative or absolute norm +% is desired. +% +% Output: +% romchg the computed H2-norm difference +% + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% +opts = struct; +if nargin < 8 + mess_err(opts, 'error_arguments', 'to few inputs'); +end +if nargin < 9 + rel = false; +end + +E = blkdiag(E1, E2); +A = blkdiag(A1, A2); +B = [B1; B2]; +C = [C1, -C2]; + +if exist('lyap', 'file') + X = lyap(A, B * B', [], E); + +else + B = E \ B; + X = lyap2solve(E \ A, B * B'); +end +nrm = sqrt(trace(C * (X * C'))); +if rel + if exist('lyap', 'file') + X1 = lyap(A1, B1 * B1', [], E1); + else + B1 = E1 \ B1; + X1 = lyap2solve(E1 \ A1, B1 * B1'); + end + nrm1 = sqrt(trace(C1 * (X1 * C1'))); +else + nrm1 = 1.0; +end +romchg = nrm / nrm1; diff --git a/norms/mess_res2_norms.m b/norms/mess_res2_norms.m index a1d3f5e..dfd7561 100644 --- a/norms/mess_res2_norms.m +++ b/norms/mess_res2_norms.m @@ -1,27 +1,34 @@ -function [nrm,k,T,V,eqn,fopts,oper] = ... - mess_res2_norms(Z,Rmul,eqn,fopts,oper,resopts,D) +function [nrm, k, T, V, eqn, fopts, oper] = ... + mess_res2_norms(Z, Rmul, eqn, fopts, oper, resopts, D) +% +% [nrm, k, T, V, eqn, fopts, oper] = ... +% mess_res2_norms(Z, Rmul, eqn, fopts, oper, resopts, D) +% % Computes the 2 Norm of the residual of Z for the symmetric operator given -% by y=Rmul(Z, x, eqn, opts,oper); +% +% by y = Rmul(Z, x, eqn, opts,oper); +% % e.g., for the generalized Lyapunov residual Rmul implements +% % R := F ZZ^T E^T + E ZZ^T F^T + GG^T (1) % % % That means res2 computes the spectral radius of this operator R by a % Lanczos iteration. The function Rmul should exploit the structure of F -% and rectangular structure of Z and G. Thus it can be computed in O(n) -% effort and is therefore much cheaper than the computation of the e.g. the +% and rectangular structure of Z and G. Thus, it can be computed in O(n) +% effort and is therefore much cheaper than the computation of e.g. the % Frobenius norm. % % Method: % % The Lanczos method produces matrices V and T such that % -% V(:,1) in span{rv}, -% V'*V = eye(k+1), -% F*V(:,1:k) = V*T. +% V(:, 1) in span{rv}, +% V' * V = eye(k+1), +% F * V(:, 1:k) = V * T. % % Remark: -% V is only constructed if its required by the output arguments, or if +% V is only constructed if it is required by the output arguments, or if % reorthogonalization is used. % % This implementation does not check for (near-)breakdown! @@ -32,8 +39,10 @@ % % eqn structure with data for operator % -% Rmul function handle to a function implementing the -% multiplication with the residual operator of interest. +% Rmul string picking the appropriate function handle to +% a function implementing the multiplication with the +% residual operator of interest. Currently supported options: +% 'lyapunov', 'lyapunov_QB', 'riccati' % % fopts full options structure (passed on to function handles in % oper) @@ -42,16 +51,16 @@ % data in eqn % % resopts options structure with fields -% resopts.maxiter maximal number of Arnoldi steps (usually k<= n-1 - error('maxiter must be smaller than the order of A!'); + if res.maxiter >= n - 1 + mess_err(fopts, 'error_arguments', ... + 'maxiter must be smaller than the order of A!'); end end -if not(isfield(res,'tol'))||isempty(res.tol) - warning('MESS:control_data','res.tol is set to 1e-6 (default)'); - res.tol= 1e-6; +if not(isfield(res, 'tol')) || isempty(res.tol) + mess_warn(fopts, 'control_data', ... + 'res.tol is set to 1e-6 (default)'); + res.tol = 1e-6; end -if not(isfield(res,'rv'))||isempty(res.rv) - res.rv = oper.init_res(eqn, fopts, oper, randn(n,1)); +% init_res for projections (no center matrix argument required) +if not(isfield(res, 'rv')) || isempty(res.rv) + res.rv = oper.init_res(eqn, fopts, oper, randn(n, 1)); else - res.rv = oper.init_res(eqn, fopts, oper, res.rv); end -if not(isfield(res,'orth'))||isempty(res.orth) - warning('MESS:control_data','res.orth is set to 0 (default)'); - res.orth=0; +if not(isfield(res, 'orth')) || isempty(res.orth) + mess_warn(fopts, 'control_data', 'res.orth is set to 0 (default)'); + res.orth = false; end -if not(isfield(fopts,'LDL_T')), fopts.LDL_T = 0; end -if not(isfield(eqn,'haveUV')), eqn.haveUV = 0; end +if not(isfield(fopts, 'LDL_T')) + fopts.LDL_T = false; +end +if not(isfield(eqn, 'haveUV')) + eqn.haveUV = false; +end -if nargin< 7, D=[]; end +if nargin < 7 + D = []; +end -created_projected_data = 0; -if eqn.type=='N' - if not(isfield(eqn,'pB')) || (eqn.haveUV && not(isfield(eqn, 'pU'))) - created_projected_data = 1; +created_projected_data = false; +if eqn.type == 'N' + if not(isfield(eqn, 'pB')) || (eqn.haveUV && not(isfield(eqn, 'pU'))) + created_projected_data = true; if eqn.haveUV - [W, ~, eqn, fopts, oper] = ... - oper.init_res(eqn, fopts, oper, [eqn.B, eqn.U]); - eqn.pB = W(:,1:size(eqn.B,2)); - eqn.pU = W(:,size(eqn.B,2)+1:end); + W = oper.init_res(eqn, fopts, oper, [eqn.B, eqn.U]); + eqn.pB = W(:, 1:size(eqn.B, 2)); + eqn.pU = W(:, size(eqn.B, 2) + 1:end); else - [pBtemp, ~, eqn, fopts, oper] = ... - oper.init_res(eqn, fopts, oper, eqn.B); + pBtemp = oper.init_res(eqn, fopts, oper, eqn.B); eqn.pB = pBtemp; end end else - if not(isfield(eqn,'pC')) || (eqn.haveUV && not(isfield(eqn, 'pV'))) - created_projected_data = 1; + if not(isfield(eqn, 'pC')) || (eqn.haveUV && not(isfield(eqn, 'pV'))) + created_projected_data = true; if eqn.haveUV - [W, ~, eqn, fopts, oper] = ... - oper.init_res(eqn, fopts, oper, [eqn.C', eqn.V]); - eqn.pC = W(:,1:size(eqn.C,1))'; - eqn.pV = W(:,size(eqn.C,1)+1:end); + W = oper.init_res(eqn, fopts, oper, [eqn.C', eqn.V]); + eqn.pC = W(:, 1:size(eqn.C, 1))'; + eqn.pV = W(:, size(eqn.C, 1) + 1:end); else - [pCtemp, ~, eqn, fopts, oper] = ... - oper.init_res(eqn, fopts, oper, eqn.C'); + pCtemp = oper.init_res(eqn, fopts, oper, eqn.C'); eqn.pC = pCtemp'; end end end %% start computation -T = zeros(res.maxiter+1,res.maxiter); -v1 =(1.0/norm(res.rv))*res.rv; +T = zeros(res.maxiter + 1, res.maxiter); +v1 = (1.0 / norm(res.rv)) * res.rv; % initial step % Matrix-vector product R*v1 -w=Rmul(Z,v1,eqn,oper,fopts,D); +w = Rmul(Z, v1, eqn, oper, fopts, D); -T(1,1)=v1'*w; -r=w-T(1,1)*v1; -T(1,2)=norm(r); -v2 = r./T(1,2); -T(2,1)=T(1,2)'; +T(1, 1) = v1' * w; +r = w - T(1, 1) * v1; +T(1, 2) = norm(r); +v2 = r ./ T(1, 2); +T(2, 1) = T(1, 2)'; % store vectors in V if needed -if res.orth || nargout>3 - V = zeros(n,res.maxiter+1); - V(:,1) = v1; - V(:,2)=v2; +if res.orth || nargout > 3 + V = zeros(n, res.maxiter + 1); + V(:, 1) = v1; + V(:, 2) = v2; end nrm = 0; -for k=2:res.maxiter-1 - %Lanczos 3-term recursion +for k = 2:res.maxiter - 1 + % Lanczos 3-term recursion % Matrix-vector product R*v2 - w = Rmul(Z,v2,eqn,oper,fopts,D); + w = Rmul(Z, v2, eqn, oper, fopts, D); - T(k,k)=v2'*w; - r=w-T(k-1,k)*v1-T(k,k)*v2; + T(k, k) = v2' * w; + r = w - T(k - 1, k) * v1 - T(k, k) * v2; - %re-orthogonalization by MGS + % re-orthogonalization by MGS if res.orth - for j=1:k - r = r - (V(:,j)'*r)*V(:,j); + for j = 1:k + r = r - (V(:, j)' * r) * V(:, j); end end - T(k,k+1)=norm(r); - v1=v2; - v2 = r./T(k,k+1); - if res.orth || nargout>3 - V(:,k+1)=v2; + T(k, k + 1) = norm(r); + v1 = v2; + v2 = r ./ T(k, k + 1); + if res.orth || nargout > 3 + V(:, k + 1) = v2; end - T(k+1,k)=T(k,k+1)'; - nrmold= nrm; - nrm = max(abs(eig(T(1:k,1:k)))); - if abs(nrm-nrmold) - error('excludeDirs input must be a cell-array of strings'); - end - - for i = 1:length(excludeDirs) - excludeStr = [excludeStr '|^' excludeDirs{i} '$']; %#ok - end - end - - - % Generate path based on given root directory - files = dir(d); - if isempty(files) - return - end - - % Add d to the path even if it is empty. - p = [d pathsep]; - - % set logical vector for subdirectory entries in d - isdir = logical(cat(1,files.isdir)); - % - % Recursively descend through directories which are neither - % private nor "class" directories. - % - dirs = files(isdir); % select only directory entries from the - % current listing - - for i=1:length(dirs) - dirname = dirs(i).name; - %NOTE: regexp ignores '.', '..', '@.*', and 'private' - %directories by default. - if not(any(regexp(dirname,['^\.$|^\.\.$|^\@.*|^private$|' ... - excludeStr ],'start'))) - % recursive calling of this function. - p = [p genpath_exclude(fullfile(d,dirname),excludeStr)];%#ok - end - end -end +% pathStr = genpath_exclude(basePath,ignoreDirs) +% +% Extension of Matlab's "genpath" function, except this will exclude +% directories (and their sub-tree) given by "ignoreDirs". +% +% +% +% Inputs: +% basePath: string. The base path for which to generate path string. +% +% excludeDirs: cell-array of strings. all directory names to ignore. Note, +% these strings are passed into regexp surrounded by +% '^' and '$'. If your directory name contains special +% characters to regexp, they must be escaped. For example, +% use '\.svn' to ignore ".svn" directories. You may also +% use regular expressions to ignore certain patterns. For +% example, use '*._ert_rtw' to ignore all directories ending +% with "_ert_rtw". +% +% Outputs: +% pathStr: string. semicolon delimited string of paths. (see genpath) +% +% See also genpath +% +% ---CVS Keywords---- +% $Author: jhopkin $ +% $Date: 2009/10/27 19:06:19 $ +% $Name: $ +% $Revision: 1.5 $ + +% $Log: genpath_exclude.m,v $ +% Revision 1.5 2009/10/27 19:06:19 jhopkin +% fixed regexp handling. added more help comments +% +% Revision 1.4 2008/11/25 19:04:29 jhopkin +% minor cleanup. Made input more robust so that if user enters a +% string as 'excludeDirs' rather than a cell array of strings this +% function will still work. (did this by moving the '^' and '$' to +% surround the entire regexp string, rather than wrapping them +% around each "excludeDir") +% +% Revision 1.3 2008/11/25 18:43:10 jhopkin +% added help comments +% +% Revision 1.1 2008/11/22 00:23:01 jhopkin +% *** empty log message *** +% + +function p = genpath_exclude(d, excludeDirs) +opts = struct; +% if the input is a string, then use it as the searchstr +if ischar(excludeDirs) + excludeStr = excludeDirs; +else + excludeStr = ''; + if not(iscellstr(excludeDirs)) %#ok + mess_err(opts, 'illegal_input', 'excludeDirs input must be a cell-array of strings'); + end + + for i = 1:length(excludeDirs) + excludeStr = [excludeStr '|^' excludeDirs{i} '$']; %#ok + end +end + +% Generate path based on given root directory +files = dir(d); +if isempty(files) + return +end + +% Add d to the path even if it is empty. +p = [d pathsep]; + +% set logical vector for subdirectory entries in d +isdir = logical(cat(1, files.isdir)); +% +% Recursively descend through directories which are neither +% private nor "class" directories. +% +dirs = files(isdir); % select only directory entries from the +% current listing + +for i = 1:length(dirs) + dirname = dirs(i).name; + % NOTE: regexp ignores '.', '..', '@.*', and 'private' + % directories by default. + if not(any(regexp(dirname, ['^\.$|^\.\.$|^\@.*|^private$|' ... + excludeStr], 'start'))) + % recursive calling of this function. + p = [p genpath_exclude(fullfile(d, dirname), excludeStr)]; %#ok + end +end +end diff --git a/shifts/dn.m b/shifts/dn.m index 520be40..737945a 100644 --- a/shifts/dn.m +++ b/shifts/dn.m @@ -1,45 +1,45 @@ -function out=dn(u,k) -%function out=dn(u,k) calculates the value of the elliptic -%function dn (see Abramowitz/Stegun Handbook of mathematical -%functions '65) +function out = dn(u, k) +% function out=dn(u,k) calculates the value of the elliptic +% function dn (see Abramowitz/Stegun Handbook of mathematical +% functions '65) % % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - a(1)=1; - c(1)=k; - b(1)=min(1-eps,sqrt(1-k*k)); - i=1; - while abs(c(i))>eps - i=i+1; - a(i)=(a(i-1)+b(i-1))/2; %#ok - b(i)=sqrt(a(i-1)*b(i-1)); %#ok - c(i)=(a(i-1)-b(i-1))/2; %#ok - end - phi1=(2.^(i-1)).*a(i).*u;%here 2^(i-1) and not 2^i as in - %Abramowitz/Stegun because counting - %starts at 1 not at 0 like in the book - phi0=0; - for j=i:-1:2 - if (j eps + i = i + 1; + a(i) = (a(i - 1) + b(i - 1)) / 2; %#ok + b(i) = sqrt(a(i - 1) * b(i - 1)); %#ok + c(i) = (a(i - 1) - b(i - 1)) / 2; %#ok +end +phi1 = (2.^(i - 1)) .* a(i) .* u; % here 2^(i-1) and not 2^i as in +% Abramowitz/Stegun because counting +% starts at 1 not at 0 like in the book +phi0 = 0; +for j = i:-1:2 + if j < i + phi1 = phi0; end - phi0=(phi1+asin(c(j)*sin(rem(phi1,2*pi))/a(j)))/2; - end - arg=1-k*k*sin(rem(phi0,2*pi))^2; - if (arg<.1) - out=sqrt(arg); - else - out=cos(rem(phi0,2*pi))/cos(phi1-phi0); - end + phi0 = (phi1 + asin(c(j) * sin(rem(phi1, 2 * pi)) / a(j))) / 2; +end +arg = 1 - k * k * sin(rem(phi0, 2 * pi))^2; +if arg < .1 + out = sqrt(arg); +else + out = cos(rem(phi0, 2 * pi)) / cos(phi1 - phi0); +end - %the last two are both representations found in the - %Abramowitz/Stegun book. if arg is close to zero the cosine - %version should be better to avoid numerical inexactness resulting - %from the substraction. +% the last two are both representations found in the +% Abramowitz/Stegun book. if arg is close to zero the cosine +% version should be better to avoid numerical inexactness resulting +% from the subtraction. diff --git a/shifts/ellip.m b/shifts/ellip.m index 1bd8c36..e6c0a20 100644 --- a/shifts/ellip.m +++ b/shifts/ellip.m @@ -1,4 +1,4 @@ -function [F,E]=ellip(hk,phi) +function [F, E] = ellip(hk, phi) % function [F,E]=ellip(hk,phi); % Computes complete and incomplete elliptic integrals F(k,phi) and E(k,phi) % Input : hk --- Modulus k ( 0 < k < 1 ) @@ -8,50 +8,51 @@ % ================================================== % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - -g=0.0; -a0=1.0; -b0=min(1-eps,sqrt(1.0-hk.*hk)); -d0=phi; -r=hk.*hk; -if (hk == 1.0&&phi == pi/2) - F=1.0e+300; - E=1.0; -elseif (hk == 1.0) - F=log((1.0+sin(d0))./cos(d0)); - E=sin(d0); +g = 0.0; +a0 = 1.0; +b0 = min(1 - eps, sqrt(1.0 - hk .* hk)); +d0 = phi; +r = hk .* hk; +if hk == 1.0 && phi == pi / 2 + F = 1.0e+300; + E = 1.0; +elseif hk == 1.0 + F = log((1.0 + sin(d0)) ./ cos(d0)); + E = sin(d0); else - fac=1.0; - for n=1:40 - a=(a0+b0)/2.0; - b=sqrt(a0.*b0); - c=(a0-b0)/2.0; - fac=2.0.*fac; - r=r+fac.*c.*c; - if (phi ~= pi/2) - d=d0+atan((b0/a0).*tan(d0)); - g=g+c.*sin(d); - d0=d+pi*fix(d/pi+.5); + fac = 1.0; + for n = 1:40 + a = (a0 + b0) / 2.0; + b = sqrt(a0 .* b0); + c = (a0 - b0) / 2.0; + fac = 2.0 .* fac; + r = r + fac .* c .* c; + if not(phi == pi / 2) + d = d0 + atan((b0 / a0) .* tan(d0)); + g = g + c .* sin(d); + d0 = d + pi * fix(d / pi + .5); + end + a0 = a; + b0 = b; + if c < 1.0e-15 + break end - a0=a; - b0=b; - if (c < 1.0e-15), break; end end - ck=pi/(2.0.*a); - ce=pi*(2.0-r)/(4.0.*a); - if (phi == pi/2) - F=ck; - E=ce; + ck = pi / (2.0 .* a); + ce = pi * (2.0 - r) / (4.0 .* a); + if phi == pi / 2 + F = ck; + E = ce; else - F=d0/(fac.*a); - E=F*ce/ck+g; + F = d0 / (fac .* a); + E = F * ce / ck + g; end end -return; +return diff --git a/shifts/mess_arn.m b/shifts/mess_arn.m index c38be69..def274e 100644 --- a/shifts/mess_arn.m +++ b/shifts/mess_arn.m @@ -1,10 +1,10 @@ -function [H, V] = mess_arn(eqn, opts, oper, opA) +function [H, V, eqn, opts, oper] = mess_arn(eqn, opts, oper, opA) % % Arnoldi method w.r.t. opA(A) % % Calling sequence: % -% [H,V] = mess_arn(eqn, opts, oper, opA) +% [H, V, eqn, opts, oper] = mess_arn(eqn, opts, oper, opA) % % Input: % @@ -40,78 +40,93 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - - % Input data not completely checked!e %% check input data -if not(isfield(opts,'shifts')) || not(isstruct(opts.shifts)) - warning('MESS:control_data',['shift parameter control structure missing.', ... - 'Switching to default num_desired = 25, num_Ritz = 50, num_hRitz = 25.']); +if not(isfield(opts, 'shifts')) || not(isstruct(opts.shifts)) + mess_warn(opts, 'control_data', ... + ['shift parameter control structure missing.', ... + 'Switching to default num_desired = 25, ', ... + 'num_Ritz = 50, num_hRitz = 25.']); opts.shifts.num_desired = 25; opts.shifts.num_Ritz = 50; opts.shifts.num_hRitz = 25; else - if not(isfield(opts.shifts,'num_desired'))||not(isnumeric(opts.shifts.num_desired)) - warning('MESS:control_data',... - ['Missing or Corrupted opts.shifts.num_desired field.', ... - 'Switching to default: 25']); + if not(isfield(opts.shifts, 'num_desired')) || ... + not(isnumeric(opts.shifts.num_desired)) + mess_warn(opts, 'control_data', ... + ['Missing or corrupted opts.shifts.num_desired ', ... + 'field. Switching to default: 25']); opts.shifts.num_desired = 25; end - if strcmp(opts.shifts.method,'heur')&&... - (not(isfield(opts.shifts,'num_Ritz'))||not(isnumeric(opts.shifts.num_Ritz))) - warning('MESS:control_data',... - ['Missing or Corrupted opts.shifts.num_Ritz field.', ... - 'Switching to default: 50']); + if strcmp(opts.shifts.method, 'heur') && ... + (not(isfield(opts.shifts, 'num_Ritz')) || ... + not(isnumeric(opts.shifts.num_Ritz))) + mess_warn(opts, 'control_data', ... + ['Missing or Corrupted opts.shifts.num_Ritz ', ... + 'field. Switching to default: 50']); opts.shifts.num_Ritz = 50; end - if strcmp(opts.shifts.method,'heur')&&... - (not(isfield(opts.shifts,'num_hRitz'))||not(isnumeric(opts.shifts.num_hRitz))) - warning('MESS:control_data',... - ['Missing or Corrupted opts.shifts.num_hRitz field.', ... - 'Switching to default: 25']); + if strcmp(opts.shifts.method, 'heur') && ... + (not(isfield(opts.shifts, 'num_hRitz')) || ... + not(isnumeric(opts.shifts.num_hRitz))) + mess_warn(opts, 'control_data', ... + ['Missing or Corrupted opts.shifts.num_hRitz ', ... + 'field. Switching to default: 25']); opts.shifts.num_hRitz = 25; end end -if not(isfield(eqn, 'haveE')), eqn.haveE = 0; end -[result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A','E'); +if not(isfield(eqn, 'haveE')) + eqn.haveE = false; +end +[result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A', 'E'); if not(result) - error('MESS:control_data', 'system data is not completely defined or corrupted'); + mess_err(opts, 'control_data', ... + 'system data is not completely defined or corrupted'); end if isfield(eqn, 'haveUV') && eqn.haveUV - if not(isfield(eqn,'U')) || isempty(eqn.U) || not(isfield(eqn,'V')) || isempty(eqn.V)... - || not((size(eqn.U,1))==size(eqn.V,1) && size(eqn.U,2)==size(eqn.V,2)) - error('MESS:SMW','Inappropriate data of low rank updated operator (eqn.U and eqn.V)'); + if not(isfield(eqn, 'U')) || isempty(eqn.U) || ... + not(isfield(eqn, 'V')) || isempty(eqn.V) || ... + not((size(eqn.U, 1)) == size(eqn.V, 1) && ... + size(eqn.U, 2) == size(eqn.V, 2)) + mess_err(opts, 'SMW', ... + 'Inappropriate data of low-rank updated ', ... + 'operator (eqn.U and eqn.V)'); end end -if not(isfield(opts,'rosenbrock')), opts.rosenbrock=[]; end -if isstruct(opts.rosenbrock)&&isfield(opts.rosenbrock,'tau') - rosenbrock = 1; +if not(isfield(opts, 'rosenbrock')) + opts.rosenbrock = []; +end +if isstruct(opts.rosenbrock) && isfield(opts.rosenbrock, 'tau') + rosenbrock = true; pc = -1 / (2 * opts.rosenbrock.tau); else - rosenbrock = 0; + rosenbrock = false; +end +if not(isfield(opts, 'bdf')) + opts.bdf = []; end -if not(isfield(opts,'bdf')), opts.bdf=[]; end -if isstruct(opts.bdf) && isfield(opts.bdf, 'tau') && isfield(opts.bdf, 'beta') - bdf = 1; +if isstruct(opts.bdf) && isfield(opts.bdf, 'tau') && ... + isfield(opts.bdf, 'beta') + bdf = true; pc = -1 / (2 * opts.bdf.tau * opts.bdf.beta); else - bdf = 0; + bdf = false; end %% check input Parameters if not(ischar(opA)) - error('MESS:error_arguments', 'opA is not a char'); + mess_err(opts, 'error_arguments', 'opA is not a char'); end opA = upper(opA); -if(not((opA == 'N' || opA == 'I'))) - error('MESS:error_arguments','opA is not ''N'' or ''I'''); +if not(opA == 'N' || opA == 'I') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''I'''); end % returns order of A or states of A, A is supposed to be square @@ -123,10 +138,24 @@ k = opts.shifts.num_Ritz; end -if k >= n - 1, error('k must be smaller than the order of A!'); end +if k >= n - 1 + mess_err(opts, 'error_arguments', ... + 'k must be smaller than the order of A!'); +end +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Initialize usfs +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +[eqn, opts, oper] = oper.mul_E_pre(eqn, opts, oper); +[eqn, opts, oper] = oper.mul_A_pre(eqn, opts, oper); +[eqn, opts, oper] = oper.sol_E_pre(eqn, opts, oper); +[eqn, opts, oper] = oper.sol_A_pre(eqn, opts, oper); + +if bdf || rosenbrock + [eqn, opts, oper] = oper.sol_ApE_pre(eqn, opts, oper); +end %% initialize data -if (not(isfield(opts.shifts, 'b0')) || isempty(opts.shifts.b0)) - b0 = ones(n,1); +if not(isfield(opts.shifts, 'b0')) || isempty(opts.shifts.b0) + b0 = ones(n, 1); else b0 = opts.shifts.b0; end @@ -138,7 +167,7 @@ beta = 0; %% perform Arnoldi method -for j = 1 : k +for j = 1:k if j > 1 V(:, j) = (1.0 / beta) * w; @@ -146,97 +175,108 @@ % no eqn.type cases needed, eigenvalues are the same for transposed % operator - if opA == 'I' %Perform inverse Arnodi - if isfield(eqn,'haveE') && eqn.haveE - if isfield(eqn,'haveUV') && eqn.haveUV + if opA == 'I' % Perform inverse Arnoldi + if isfield(eqn, 'haveE') && eqn.haveE + + EV = oper.mul_E(eqn, opts, 'N', V(:, j), 'N'); + + if isfield(eqn, 'haveUV') && eqn.haveUV + RHS = [EV eqn.U]; if bdf AB = oper.sol_ApE(eqn, opts, 'N', pc, 'N', ... - 1 / (opts.bdf.tau * opts.bdf.beta) * ... - [oper.mul_E(eqn, opts, 'N', V(:, j), 'N') eqn.U], 'N'); + -2 * pc * RHS, 'N'); elseif rosenbrock AB = oper.sol_ApE(eqn, opts, 'N', pc, 'N', ... - [oper.mul_E(eqn, opts, 'N', V(:, j), 'N') eqn.U], 'N'); + RHS, 'N'); else - AB = oper.sol_A(eqn, opts, 'N', [oper.mul_E(eqn, opts, 'N', V(:, j), 'N') eqn.U], 'N'); + AB = oper.sol_A(eqn, opts, 'N', RHS, 'N'); end - AV = AB(:,1); - AU = AB(:, 2 : end); - w = AV - AU * ((speye(size(eqn.U, 2)) + eqn.V' * AU) \ (eqn.V' * AV)); - else + AV = AB(:, 1); + AU = AB(:, 2:end); + Im = speye(size(eqn.U, 2)); + w = AV - AU * ((Im + eqn.V' * AU) \ (eqn.V' * AV)); + else % no rosenbrock case here as that always has UV if bdf w = oper.sol_ApE(eqn, opts, 'N', pc, 'N', ... - 1 / (opts.bdf.tau * opts.bdf.beta) * ... - oper.mul_E(eqn, opts, 'N', V(:, j), 'N'), 'N'); + -2 * pc * EV, 'N'); else - w = oper.sol_A(eqn, opts, 'N', oper.mul_E(eqn, opts, 'N', V(:, j), 'N'), 'N'); + w = oper.sol_A(eqn, opts, 'N', EV, 'N'); end end else - if isfield(eqn,'haveUV') && eqn.haveUV + if isfield(eqn, 'haveUV') && eqn.haveUV + RHS = [V(:, j) eqn.U]; if bdf AB = oper.sol_ApE(eqn, opts, 'N', pc, 'N', ... - 1 / (opts.bdf.tau * opts.bdf.beta) * ... - [V(:, j) eqn.U], 'N'); + -2 * pc * RHS, 'N'); elseif rosenbrock - AB = oper.sol_ApE(eqn, opts, 'N', pc, 'N', [V(:, j) eqn.U], 'N'); + AB = oper.sol_ApE(eqn, opts, 'N', pc, 'N', ... + RHS, 'N'); else - AB = oper.sol_A(eqn, opts, 'N', [V(:, j) eqn.U], 'N'); + AB = oper.sol_A(eqn, opts, 'N', RHS, 'N'); end - AV = AB(:,1); - AU = AB(:, 2 : end); - w = AV - AU * ((speye(size(eqn.U, 2)) + eqn.V' * AU) \ (eqn.V' * AV)); - else + AV = AB(:, 1); + AU = AB(:, 2:end); + Im = speye(size(eqn.U, 2)); + w = AV - AU * ((Im + eqn.V' * AU) \ (eqn.V' * AV)); + else % no rosenbrock case here as that always has UV if bdf w = oper.sol_ApE(eqn, opts, 'N', pc, 'N', ... - 1 / (opts.bdf.tau * opts.bdf.beta) * ... - V(:, j), 'N'); + -2 * pc * V(:, j), 'N'); else w = oper.sol_A(eqn, opts, 'N', V(:, j), 'N'); end end end else % opA = 'N' Perform standard Arnoldi - if isfield(eqn,'haveE') && eqn.haveE - if isfield(eqn,'haveUV') && eqn.haveUV - if bdf - w = oper.sol_E(eqn, opts, 'N',... - oper.mul_ApE(eqn, opts, 'N', pc, 'N', ... - (opts.bdf.tau * opts.bdf.beta) * ... - V(:, j), 'N') + eqn.U * (eqn.V' * V(:, j)), 'N'); - elseif rosenbrock - w = oper.sol_E(eqn, opts, 'N',... - oper.mul_ApE(eqn, opts, 'N', pc, 'N', V(:, j), 'N')... - + eqn.U * (eqn.V' * V(:, j)), 'N'); + if isfield(eqn, 'haveE') && eqn.haveE + if isfield(eqn, 'haveUV') && eqn.haveUV + UVtV = eqn.U * (eqn.V' * V(:, j)); + if bdf || rosenbrock + AV = oper.mul_ApE(eqn, opts, 'N', pc, 'N', ... + V(:, j), 'N'); else - w = oper.sol_E(eqn, opts, 'N',... - oper.mul_A(eqn, opts, 'N', V(:, j), 'N')... - + eqn.U * (eqn.V' * V(:, j)), 'N'); + AV = oper.mul_A(eqn, opts, 'N', V(:, j), 'N'); + end + + if bdf + w = oper.sol_E(eqn, opts, 'N', ... + (-2 / pc) * AV + UVtV, 'N'); + else % rosenbrock and default are now doing the same + w = oper.sol_E(eqn, opts, 'N', ... + AV + UVtV, 'N'); end - else + else % no rosenbrock case here as that always has UV if bdf - w = oper.sol_E(eqn, opts, 'N', (opts.bdf.tau * opts.bdf.beta) * ... - oper.mul_ApE(eqn, opts, ... - 'N', pc, 'N', V(:, j), 'N'), 'N'); + ApEV = oper.mul_ApE(eqn, opts, 'N', pc, 'N', ... + V(:, j), 'N'); + w = oper.sol_E(eqn, opts, 'N', (-2 / pc) * ... + ApEV, 'N'); else - w = oper.sol_E(eqn, opts, 'N', oper.mul_A(eqn, opts, 'N', V(:, j), 'N'), 'N'); + w = oper.sol_E(eqn, opts, 'N', ... + oper.mul_A(eqn, opts, 'N', ... + V(:, j), 'N'), 'N'); end end else - if isfield(eqn,'haveUV') && eqn.haveUV + if isfield(eqn, 'haveUV') && eqn.haveUV + UVtV = eqn.U * (eqn.V' * V(:, j)); if bdf - w = (opts.bdf.tau * opts.bdf.beta) * ... - oper.mul_ApE(eqn, opts, 'N', pc, 'N', V(:, j), 'N') ... - + eqn.U * (eqn.V' * V(:, j)); + w = (-2 / pc) * ... + oper.mul_ApE(eqn, opts, 'N', pc, 'N', ... + V(:, j), 'N'); elseif rosenbrock - w = oper.mul_ApE(eqn, opts, 'N', pc, 'N', V(:, j), 'N') ... - + eqn.U * (eqn.V' * V(:, j)); + w = oper.mul_ApE(eqn, opts, 'N', pc, 'N', ... + V(:, j), 'N'); else - w = oper.mul_A(eqn, opts, 'N', V(:, j), 'N') + eqn.U * (eqn.V' * V(:, j)); + w = oper.mul_A(eqn, opts, 'N', V(:, j), 'N'); end - else + w = w + UVtV; + else % no rosenbrock case here as that always has UV if bdf w = (opts.bdf.tau * opts.bdf.beta) * ... - oper.mul_ApE(eqn, opts, 'N', pc, 'N', V(:, j), 'N'); + oper.mul_ApE(eqn, opts, 'N', pc, 'N', ... + V(:, j), 'N'); else w = oper.mul_A(eqn, opts, 'N', V(:, j), 'N'); end @@ -244,10 +284,8 @@ end end - -% b0 = w; - for k=1:2 %repeated MGS - for i = 1 : j + for k = 1:2 % repeated MGS + for i = 1:j g = V(:, i)' * w; H(i, j) = H(i, j) + g; w = w - V(:, i) * g; @@ -260,4 +298,16 @@ V(:, k + 1) = (1.0 / beta) * w; +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Initialize usfs +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +[eqn, opts, oper] = oper.mul_E_post(eqn, opts, oper); +[eqn, opts, oper] = oper.mul_A_post(eqn, opts, oper); +[eqn, opts, oper] = oper.sol_E_post(eqn, opts, oper); +[eqn, opts, oper] = oper.sol_A_post(eqn, opts, oper); + +if bdf || rosenbrock + [eqn, opts, oper] = oper.sol_ApE_post(eqn, opts, oper); +end + end diff --git a/shifts/mess_get_projection_shifts.m b/shifts/mess_get_projection_shifts.m index 7661b29..fb609ea 100644 --- a/shifts/mess_get_projection_shifts.m +++ b/shifts/mess_get_projection_shifts.m @@ -1,5 +1,4 @@ -function [ opts, l ] = mess_get_projection_shifts( eqn, opts, oper, ... - Z, W, D) +function [opts, l] = mess_get_projection_shifts(eqn, opts, oper, Z, W, D) % Intended for use inside the ADI iteration, % mess_get_projection_shifts computes new projection shifts and % updates shift vectors if the shift computation method is @@ -18,7 +17,8 @@ % factorization kernel % % Output: -% opts altered opts structure, with the new shifts in opts.shifts.p +% opts altered opts structure, with the new shift vector in +% opts.shifts.p % l the number of admissible shifts computed, % i.e. the length of opts.shifts.p % @@ -34,117 +34,137 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% Check input -k = size(eqn.G, 2); +ncols_W = size(eqn.W, 2); -if not(isfield(opts,'shifts')) || not(isstruct(opts.shifts)) - warning('MESS:control_data',['shift parameter control structure missing.', ... - 'Switching to default num_desired = 25.']); +if not(isfield(opts, 'shifts')) || not(isstruct(opts.shifts)) + mess_warn(opts, 'control_data', ... + ['shift parameter control structure missing. ', ... + 'Switching to default num_desired = 25.']); opts.shifts.num_desired = 25; else - if not(isfield(opts.shifts,'num_desired'))||not(isnumeric(opts.shifts.num_desired)) - warning('MESS:control_data',... - ['Missing or Corrupted opts.shifts.num_desired field.', ... - 'Switching to default: 25']); + if not(isfield(opts.shifts, 'num_desired')) || ... + not(isnumeric(opts.shifts.num_desired)) + mess_warn(opts, 'control_data', ... + ['Missing or Corrupted opts.shifts.num_desired field. ', ... + 'Switching to default: 25']); opts.shifts.num_desired = 25; end end -if not(isfield(opts.shifts, 'banned')) ... - || not(isnumeric(opts.shifts.banned)) +if not(isfield(opts.shifts, 'banned')) || ... + not(isnumeric(opts.shifts.banned)) opts.shifts.banned = []; -elseif not(isfield(opts.shifts, 'banned_tol')) ... - || not(isnumeric(opts.shifts.banned_tol)) ... - || not(isscalar(opts.shifts.banned_tol)) +elseif not(isfield(opts.shifts, 'banned_tol')) || ... + not(isnumeric(opts.shifts.banned_tol)) || ... + not(isscalar(opts.shifts.banned_tol)) opts.shifts.banned_tol = 1e-4; end -if not(isfield(opts.shifts,'recursion_level')) ... - || not(isnumeric(opts.shifts.recursion_level)) ... - || not(isscalar(opts.shifts.recursion_level)) +if not(isfield(opts.shifts, 'recursion_level')) || ... + not(isnumeric(opts.shifts.recursion_level)) || ... + not(isscalar(opts.shifts.recursion_level)) opts.shifts.recursion_level = 0; end +if isfield(opts.shifts, 'info') && opts.shifts.info > 0 + info = 1; +else + info = 0; +end %% Compute new shifts if isfield(opts.shifts, 'method') && ... strcmp(opts.shifts.method, 'projection') - if isfield(opts.shifts,'info')&&opts.shifts.info - disp('updating shifts'); + + if info + mess_fprintf(opts, 'updating shifts\n'); end + if not(isfield(opts.shifts, 'used_shifts')) || ... isempty(opts.shifts.used_shifts) opts.shifts.used_shifts = opts.shifts.p; else opts.shifts.used_shifts = ... [opts.shifts.used_shifts; opts.shifts.p]; - if (size(opts.shifts.used_shifts, 1) > opts.shifts.num_desired) ... - && imag(opts.shifts.used_shifts(end - opts.shifts.num_desired + 1))... - && (abs(opts.shifts.used_shifts(end - opts.shifts.num_desired + 1) ... - -conj(opts.shifts.used_shifts(end - opts.shifts.num_desired))) < eps) + first_dropped = length(opts.shifts.used_shifts) - ... + opts.shifts.num_desired + 1; + last_kept = first_dropped - 1; + if (size(opts.shifts.used_shifts, 1) > opts.shifts.num_desired) && ... + imag(opts.shifts.used_shifts(first_dropped)) && ... + (abs(opts.shifts.used_shifts(first_dropped) - ... + conj(opts.shifts.used_shifts(last_kept))) < eps) % don't cut between pair of complex shifts opts.shifts.used_shifts = ... - opts.shifts.used_shifts(end - opts.shifts.num_desired : end); - elseif (size(opts.shifts.used_shifts, 1) > opts.shifts.num_desired) + opts.shifts.used_shifts(end - opts.shifts.num_desired:end); + elseif size(opts.shifts.used_shifts, 1) > opts.shifts.num_desired opts.shifts.used_shifts = ... - opts.shifts.used_shifts(end - opts.shifts.num_desired + 1 : end); + opts.shifts.used_shifts(end - opts.shifts.num_desired + 1:end); end end - if isfield(oper,'get_ritz_vals') + + %% Compute new shifts + if isfield(oper, 'get_ritz_vals') if opts.LDL_T % scale columns of Z (L) as in original non LDL^T formulation - len = size(opts.shifts.used_shifts, 1) * k - 1; - inds_D = size(D,1) - size(opts.shifts.used_shifts, 1) + 1: size(D,1); + len = size(opts.shifts.used_shifts, 1) * ncols_W - 1; + inds_D = size(D, 1) - size(opts.shifts.used_shifts, 1) + ... + 1:size(D, 1); p = oper.get_ritz_vals(eqn, opts, oper, ... - Z( : ,end - len : end) * ... - kron(sqrt(D(inds_D, inds_D)), ... - eye(k)), W, opts.shifts.used_shifts); + Z(:, end - len:end) * ... + kron(sqrt(D(inds_D, inds_D)), ... + eye(ncols_W)), ... + W, opts.shifts.used_shifts); else + len = (size(opts.shifts.used_shifts, 1) * ncols_W) - 1; p = oper.get_ritz_vals(eqn, opts, oper, ... - Z( : ,end - (size(opts.shifts.used_shifts, 1) * k) + 1 : end), ... - W, opts.shifts.used_shifts); + Z(:, end - len:end), ... + W, opts.shifts.used_shifts); end else if opts.LDL_T % scale columns of Z (L) as in original non LDL^T formulation - len = size(opts.shifts.used_shifts, 1) * k - 1; - inds_D = size(D,1) - size(opts.shifts.used_shifts, 1) + 1: size(D,1); + len = size(opts.shifts.used_shifts, 1) * ncols_W - 1; + inds_D = size(D, 1) - size(opts.shifts.used_shifts, 1) + ... + 1:size(D, 1); p = mess_projection_shifts(eqn, opts, oper, ... - Z( : , end - len : end) * ... - kron(sqrt(D(inds_D, inds_D)), ... - eye(k)), W, opts.shifts.used_shifts); + Z(:, end - len:end) * ... + kron(sqrt(D(inds_D, inds_D)), ... + eye(ncols_W)), ... + W, opts.shifts.used_shifts); else + len = size(opts.shifts.used_shifts, 1) * ncols_W - 1; p = mess_projection_shifts(eqn, opts, oper, ... - Z( : , end - (size(opts.shifts.used_shifts, 1) * k) + 1 : end), ... - W, opts.shifts.used_shifts); + Z(:, end - len:end), ... + W, opts.shifts.used_shifts); end end + %% check computed shifts % check for banned shifts - for j = 1 : length(opts.shifts.banned) - critical_shifts = abs(p - opts.shifts.banned(j)) ... - < opts.shifts.banned_tol * max(abs(p)); - p(critical_shifts) = p(critical_shifts) ... - - opts.shifts.banned_tol * max(abs(p)) * 2; + for j = 1:length(opts.shifts.banned) + critical_shifts = abs(p - opts.shifts.banned(j)) < ... + opts.shifts.banned_tol * max(abs(p)); + p(critical_shifts) = p(critical_shifts) - ... + opts.shifts.banned_tol * max(abs(p)) * 2; end if isempty(p) % if all shifts banned try again with double amount if opts.shifts.recursion_level < 2 - warning('MESS:projection_shifts', ... - 'All computed shifts have been banned. Retrying'); + mess_warn(opts, 'projection_shifts', ... + 'All computed shifts have been banned. Retrying'); num_desired = opts.shifts.num_desired; opts.shifts.num_desired = num_desired * 2; opts.shifts.used_shifts = ... - opts.shifts.used_shifts(1 : end - size(opts.shifts.p, 1)); + opts.shifts.used_shifts(1:end - size(opts.shifts.p, 1)); opts.shifts.recursion_level = opts.shifts.recursion_level + 1; if opts.LDL_T - [ opts ] = mess_get_projection_shifts( eqn, opts, oper, Z, W, D); + [opts] = mess_get_projection_shifts(eqn, opts, oper, Z, W, D); else - [ opts ] = mess_get_projection_shifts( eqn, opts, oper, Z, W); + [opts] = mess_get_projection_shifts(eqn, opts, oper, Z, W); end opts.shifts.num_desired = num_desired; p = opts.shifts.p; @@ -153,15 +173,18 @@ end if not(isempty(p)) opts.shifts.p = p; - if isfield(opts.shifts,'info') && opts.shifts.info - disp(p); + + if info + mess_fprintf(opts, 'p:\n'); + for ip = 1:length(p) + mess_fprintf(opts, '%e\n', p(ip)); + end end else % could not compute new shifts, reuse previous ones - warning('MESS:projection_shifts',... - 'projection update returned empty set. Reusing previous set!'); + mess_warn(opts, 'projection_shifts', ... + 'projection update returned empty set. ', ... + 'Reusing previous set!'); end end l = length(opts.shifts.p); -end - diff --git a/shifts/mess_get_ritz_vals.m b/shifts/mess_get_ritz_vals.m index 97366ab..b458b75 100644 --- a/shifts/mess_get_ritz_vals.m +++ b/shifts/mess_get_ritz_vals.m @@ -1,8 +1,10 @@ -function [rw, Hp, Hm, Vp, Vm, eqn, opts, oper] = mess_get_ritz_vals(eqn,opts,oper) -% [rw, Hp, Hm, Vp, Vm, eqn, opts, oper] = mess_get_ritz_vals(eqn,opts,oper) -% +function [rw, Hp, Hm, Vp, Vm, eqn, opts, oper] = ... + mess_get_ritz_vals(eqn, opts, oper) +% [rw, Hp, Hm, Vp, Vm, eqn, opts, oper] = ... +% mess_get_ritz_vals(eqn,opts,oper) +% % Computes a number of Ritz and harmonic Ritz values for the operator -% defined by oper and eqn. The actual numbers are determined by +% defined by oper and eqn. The actual numbers are determined by % % opts.shifts.num_desired total number of values % opts.shifts.num_Ritz number of Ritz of values @@ -13,58 +15,77 @@ % % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check data -if not(isfield(opts,'shifts')) || not(isstruct(opts.shifts)) - warning('MESS:control_data',['shift parameter control structure missing.', ... - 'Switching to default num_desired = 25, num_Ritz = 50, num_hRitz = 25.']); +if not(isfield(opts, 'shifts')) || not(isstruct(opts.shifts)) + mess_warn(opts, 'control_data', ... + ['shift parameter control structure missing.', ... + 'Switching to default num_desired = 25, ', ... + 'num_Ritz = 50, num_hRitz = 25.']); opts.shifts.num_desired = 25; opts.shifts.num_Ritz = 50; opts.shifts.num_hRitz = 25; else - if not(isfield(opts.shifts,'num_desired'))||not(isnumeric(opts.shifts.num_desired)) - warning('MESS:control_data',... - ['Missing or Corrupted opts.shifts.num_desired field.', ... - 'Switching to default: 25']); + if not(isfield(opts.shifts, 'num_desired')) || ... + not(isnumeric(opts.shifts.num_desired)) + mess_warn(opts, 'control_data', ... + ['Missing or Corrupted opts.shifts.num_desired ', ... + 'field. Switching to default: 25']); opts.shifts.num_desired = 25; end - if not(isfield(opts.shifts,'num_Ritz'))||not(isnumeric(opts.shifts.num_Ritz)) - warning('MESS:control_data',... - ['Missing or Corrupted opts.shifts.num_Ritz field.', ... - 'Switching to default: 50']); + if not(isfield(opts.shifts, 'num_Ritz')) || ... + not(isnumeric(opts.shifts.num_Ritz)) + mess_warn(opts, 'control_data', ... + ['Missing or Corrupted opts.shifts.num_Ritz ', ... + 'field. Switching to default: 50']); opts.shifts.num_Ritz = 50; end - if not(isfield(opts.shifts,'num_hRitz'))||not(isnumeric(opts.shifts.num_hRitz)) - warning('MESS:control_data',... - ['Missing or Corrupted opts.shifts.num_hRitz field.', ... - 'Switching to default: 25']); + if not(isfield(opts.shifts, 'num_hRitz')) || ... + not(isnumeric(opts.shifts.num_hRitz)) + mess_warn(opts, 'control_data', ... + ['Missing or Corrupted opts.shifts.num_hRitz ', ... + 'field. Switching to default: 25']); opts.shifts.num_hRitz = 25; end end -if not(isfield(eqn, 'haveE')), eqn.haveE = 0; end -[result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A','E'); + +if not(isfield(eqn, 'haveE')) + eqn.haveE = false; +end + +[result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A', 'E'); + if not(result) - error('MESS:control_data', 'system data is not completely defined or corrupted'); + mess_err(opts, 'control_data', ... + 'system data is not completely defined or corrupted'); end n = oper.size(eqn, opts); -if opts.shifts.num_Ritz >= n, error('num_Ritz must be smaller than n!'); end -if opts.shifts.num_hRitz >= n, error('num_hRitz must be smaller than n!'); end -if (2 * (opts.shifts.num_desired) >= opts.shifts.num_Ritz + opts.shifts.num_hRitz), ... - error('2*num_desired must be smaller than num_Ritz+num_hRitz!'); end +if opts.shifts.num_Ritz >= n + mess_err(opts, 'error_arguments', ... + 'num_Ritz must be smaller than n!'); +end -if (not(isfield(opts.shifts, 'b0')) || isempty(opts.shifts.b0)) - opts.shifts.b0 = ones(n, 1); +if opts.shifts.num_hRitz >= n + mess_err(opts, 'error_arguments', ... + 'num_hRitz must be smaller than n!'); +end +if 2 * (opts.shifts.num_desired) >= ... + opts.shifts.num_Ritz + opts.shifts.num_hRitz + mess_err(opts, 'error_arguments', ... + '2*num_desired must be smaller than num_Ritz+num_hRitz!'); end +if not(isfield(opts.shifts, 'b0')) || isempty(opts.shifts.b0) + opts.shifts.b0 = ones(n, 1); +end %% initialize data opts.shifts.b0 = (1 / norm(opts.shifts.b0)) * opts.shifts.b0; @@ -76,21 +97,23 @@ %% estimate suboptimal ADI shift parameters if opts.shifts.num_Ritz > 0 - [Hp, Vp] = mess_arn(eqn, opts, oper, 'N'); - rwp = eig(Hp(1:opts.shifts.num_Ritz, 1:opts.shifts.num_Ritz)); % =: R_+ - rw = [rw; rwp]; + [Hp, Vp, eqn, opts, oper] = mess_arn(eqn, opts, oper, 'N'); + keep = 1:opts.shifts.num_Ritz; + rwp = eig(Hp(keep, keep)); % =: R_+ + rw = [rw; rwp]; end if opts.shifts.num_hRitz > 0 - [Hm, Vm] = mess_arn(eqn, opts, oper, 'I'); - rwm = ones(opts.shifts.num_hRitz, 1)./eig(Hm(1:opts.shifts.num_hRitz, ... - 1:opts.shifts.num_hRitz)); % =: 1 / R_- - rw = [rw; rwm]; % =: R + [Hm, Vm, eqn, opts, oper] = mess_arn(eqn, opts, oper, 'I'); + keep = 1:opts.shifts.num_hRitz; + rwm = 1 ./ eig(Hm(keep, keep)); % =: 1 / R_- + rw = [rw; rwm]; % =: R end if any(real(rw) >= zeros(size(rw))) - warning('MESS:antistable_ritz',... - ['Non-stable Ritz values were detected.\n',... - 'These will be removed from the set in further computations.']); - rw = rw(real(rw)<0); + mess_warn(opts, 'antistable_ritz', ... + ['Non-stable Ritz values were detected.\n', ... + 'These will be removed from the set for the ', ... + 'subsequent computations.']); + rw = rw(real(rw) < 0); end end diff --git a/shifts/mess_lrradi_get_shifts.m b/shifts/mess_lrradi_get_shifts.m index 0452a12..456b0f1 100644 --- a/shifts/mess_lrradi_get_shifts.m +++ b/shifts/mess_lrradi_get_shifts.m @@ -1,125 +1,129 @@ -function [eqn, opts, oper, nShifts] = ... - mess_lrradi_get_shifts(eqn, opts, oper, W, Z, Y) -% Compute the next batch of shifts for the RADI method. -% -% Input: -% eqn struct contains data for equations -% -% opts struct contains parameters for the algorithm -% -% oper struct contains function handles for operation -% with A and E -% -% W the current residual matrix in RADI -% -% Z the current Z matrix in RADI -% -% Y the small square factor in the RADI solution -% -% opts.shifts.method possible values: -% 'precomputed' -% 'penzl' -% 'projection' -% 'gen-ham-opti' -% -% If opts.shifts.method == 'heur', then: -% - calls mess_para to generate the shifts. -% -% If opts.shifts.method == 'projection', then: -% - calls mess_get_projection_shifts to generate the shifts. -% -% If opts.shifts.method == 'gen-ham-opti', then: -% - calls mess_lrradi_get_shifts_hamOpti_generalized to generate the shifts. -% - -% -% This file is part of the M-M.E.S.S. project -% (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. -% All rights reserved. -% License: BSD 2-Clause License (see COPYING) -% - -if not(isfield(opts.shifts, 'banned')) ... - || not(isnumeric(opts.shifts.banned)) - opts.shifts.banned = []; -elseif not(isfield(opts.shifts, 'banned_tol')) ... - || not(isnumeric(opts.shifts.banned_tol)) ... - || not(isscalar(opts.shifts.banned_tol)) - opts.shifts.banned_tol = 1e-4; -end - -%% Check input -switch opts.shifts.method - case 'precomputed' - % Just return the same array of shifts as the user provided. - nShifts = length(opts.shifts.p); - - case 'heur' - % Use MESS routines for heuristic penzl shifts. - [p, ~, eqn, opts, oper] = mess_para(eqn, opts, oper); - nShifts = length(p); - opts.shifts.p = p; - - case 'projection' - % Use MESS routines for projection shifts. - if isempty(Z) - Z = W; - end - - nShifts = 0; - i = 1; - while nShifts==0 - nZ = size(Z, 2); - if not(opts.radi.compute_sol_facpart) - % Relevant parts of LRF. - maxcolZ = opts.shifts.history; - ind = max(nZ - maxcolZ, 0)+1:nZ; - else - ind = 1:nZ; - end - - if eqn.type == 'T' - p = mess_projection_shifts( eqn, opts, oper, Z(:,ind), ... - oper.mul_A(eqn, opts, 'T', Z(:,ind), 'N') ... - + eqn.V * (eqn.U' * Z(:,ind)), []); - else - p = mess_projection_shifts( eqn, opts, oper, Z(:,ind), ... - oper.mul_A(eqn, opts, 'N', Z(:,ind), 'N') ... - + eqn.U * (eqn.V' * Z(:,ind)), []); - end - - for j = 1 : size(opts.shifts.banned) - critical_shifts = abs(p - opts.shifts.banned(j)) ... - < opts.shifts.banned_tol * max(abs(p)); - p(critical_shifts) = p(critical_shifts) ... - - opts.shifts.banned_tol * max(abs(p)) * 2; - end - - nShifts = length(p); - opts.shifts.p = p; - if isempty(p) - if (i < 5) - warning('MESS:mess_para',... - ['Could not compute initial projection shifts. ',... - 'Going to retry with random right hand side.']); - Z = rand(size(Z)); - else - error('MESS:mess_para',... - 'Could not compute initial projection shifts.'); - end - end - i = i + 1; - end - case 'gen-ham-opti' - % Residual hamiltonian shifts... recommended+default! - [eqn, opts, oper, nShifts] = ... - mess_lrradi_get_shifts_hamOpti_generalized( ... - eqn, opts, oper, W, Z, Y); - - otherwise - error('MESS:control_data',['unknown shift parameter method: ', ... - opts.shifts.method]); -end - -end +function [eqn, opts, oper, nShifts] = ... + mess_lrradi_get_shifts(eqn, opts, oper, W, Z, Y) +% Compute the next batch of shifts for the RADI method. +% +% Input: +% eqn struct contains data for equations +% +% opts struct contains parameters for the algorithm +% +% oper struct contains function handles for operation +% with A and E +% +% W the current residual matrix in RADI +% +% Z the current Z matrix in RADI +% +% Y the small square factor in the RADI solution +% +% opts.shifts.method possible values: +% 'precomputed' +% 'penzl' +% 'projection' +% 'gen-ham-opti' +% +% If opts.shifts.method == 'heur', then: +% - calls mess_para to generate the shifts. +% +% If opts.shifts.method == 'projection', then: +% - calls mess_get_projection_shifts to generate the shifts. +% +% If opts.shifts.method == 'gen-ham-opti', then: +% - calls mess_lrradi_get_shifts_hamOpti_generalized to generate the shifts. +% + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +if not(isfield(opts.shifts, 'banned')) || ... + not(isnumeric(opts.shifts.banned)) + opts.shifts.banned = []; +elseif not(isfield(opts.shifts, 'banned_tol')) || ... + not(isnumeric(opts.shifts.banned_tol)) || ... + not(isscalar(opts.shifts.banned_tol)) + opts.shifts.banned_tol = 1e-4; +end + +%% Check input +switch opts.shifts.method + case 'precomputed' + % Just return the same array of shifts as the user provided. + nShifts = length(opts.shifts.p); + + case 'heur' + % Use MESS routines for heuristic penzl shifts. + [p, ~, eqn, opts, oper] = mess_para(eqn, opts, oper); + nShifts = length(p); + opts.shifts.p = p; + + case 'projection' + % Use MESS routines for projection shifts. + if isempty(Z) + Z = W; + end + + nShifts = 0; + i = 1; + while nShifts == 0 + nZ = size(Z, 2); + if not(opts.radi.compute_sol_facpart) + % Relevant parts of LRF. + maxcolZ = opts.shifts.history; + ind = max(nZ - maxcolZ, 0) + 1:nZ; + else + ind = 1:nZ; + end + + if eqn.type == 'T' + p = mess_projection_shifts(eqn, opts, oper, Z(:, ind), ... + oper.mul_A(eqn, opts, 'T', ... + Z(:, ind), 'N') + ... + eqn.V * (eqn.U' * Z(:, ind)), []); + else + p = mess_projection_shifts(eqn, opts, oper, Z(:, ind), ... + oper.mul_A(eqn, opts, 'N', ... + Z(:, ind), 'N') + ... + eqn.U * (eqn.V' * Z(:, ind)), []); + end + + for j = 1:length(opts.shifts.banned) + critical_shifts = abs(p - opts.shifts.banned(j)) < ... + opts.shifts.banned_tol * max(abs(p)); + p(critical_shifts) = p(critical_shifts) - ... + opts.shifts.banned_tol * max(abs(p)) * 2; + end + + nShifts = length(p); + opts.shifts.p = p; + if isempty(p) + if i < 5 + mess_warn(opts, 'mess_para', ... + ['Could not compute initial projection ', ... + 'shifts. Going to retry with random ' ... + 'right hand side.']); + Z = rand(size(Z)); + else + mess_err(opts, 'mess_para', ... + 'Could not compute initial projection shifts.'); + end + end + i = i + 1; + end + case 'gen-ham-opti' + % Residual hamiltonian shifts... recommended+default! + [eqn, opts, oper, nShifts] = ... + mess_lrradi_get_shifts_hamOpti_generalized(eqn, opts, oper, ... + W, Z, Y); + + otherwise + mess_err(opts, 'control_data', ... + ['unknown shift parameter method: ', ... + opts.shifts.method]); +end + +end diff --git a/shifts/mess_lrradi_get_shifts_hamOpti_generalized.m b/shifts/mess_lrradi_get_shifts_hamOpti_generalized.m index ad755c2..9590f05 100644 --- a/shifts/mess_lrradi_get_shifts_hamOpti_generalized.m +++ b/shifts/mess_lrradi_get_shifts_hamOpti_generalized.m @@ -1,481 +1,483 @@ -function [eqn, opts, oper, nShifts] = ... - mess_lrradi_get_shifts_hamOpti_generalized(eqn, opts, oper, W, Z, Y) -% Compute the Hamiltonian residual shifts for the RADI method. -% Optionally, run residual minimizing search afterwards, and return -% optimized shifts. -% -% The routine avoids solving linear systems with E. The shifts are computed -% as generalized Ritz values of the matrix pair (H, EE), where -% H = [A + U*V' B*B' ], EE = [ E 0 ] -% W'*W -(A + U*V')' ] [ 0 E' ]. -% -% The matrix pair is projected on a subspace spanned by ell last vectors -% in Z. The generalized eigenvalues and eigenvectors of the obtained pair -% (Hproj, Eproj) are then used to compute the shift in the following way: -% - all obtained eigenvectors [x; y] are sorted by the value of -% tau = norm(y)^2 / abs( x'*E'*y ). -% - the eigenvalue corresponding to the largest value of tau is chosen -% as the next shift. -% -% Input -% eqn struct contains data for equations -% -% opts struct contains parameters for the algorithm -% -% oper struct contains function handles for operation -% with A and E -% -% W the current residual matrix in RADI -% -% Z the current Z matrix in RADI -% -% Y the small square factor in the RADI solution -% (not used) -% -% -% Output -% opts the modified input structure -% -% nShifts the number of shifts computed (=1, always) -% -% -% Input fields in struct eqn used by this routine: -% eqn.BB dense (n x m1) matrix from quadratic term -% -% eqn.U dense (n x m3) matrix U from rank-m3 Update -% -% eqn.V dense (n x m3) matrix V from rank-m3 Update -% -% eqn.type possible values: 'N', 'T' -% determining whether (N) or (T) is solved -% -% eqn.haveE possible values: 0, 1, false, true -% if haveE = 0: matrix E in eqn.E_ is assumed to be identity -% -% -% Input fields in struct opts used by this routine: -% shifts.history -% Possible values: inf or k*p, where k>=2, and p = size(W, 2). -% The number of the last columns of Z which are used to project the -% Hamiltonian pair, i.e., the dimension of the projection subspace. -% If set to inf, all columns of Z will be used. -% -% shifts.naive_update_mode -% Possible values: true | [false] -% Sets the method of updating the projection between successive calls -% to mess_lrradi_get_shifts_hamOpti_generalized. If set to true, the QR -% factorization will be recomputed from scratch in each call to -% obtain the orthonormal basis for the projection subspace. If set -% to (default) false, the QR factorization from the previous step -% will be updated to save computation time. -% -% -% Output fields in struct opts set by this routine: -% shifts.p -% Contains the computed shift. -% -% opts.shifts.tmp -% struct with all the temporary matrices for the shifts -% - -% -% This file is part of the M-M.E.S.S. project -% (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. -% All rights reserved. -% License: BSD 2-Clause License (see COPYING) -% - -% Determine the number of inputs. -p = size(W, 2); - -% Check if the projection subspace size is valid. -if not(opts.shifts.history == Inf ... - || (mod(opts.shifts.history, p) == 0) ... - && (opts.shifts.history >= 2 * p)) - warning('MESS:control_data', ['Shifts history length should be ', ... - 'Inf, or a multiple of number of residual columns p (>=2*p).', ... - 'Set opts.shifts.history = %i.'], ... - 6 * p); - opts.shifts.history = 6 * p; -end - -if not(isfield(opts.shifts, 'naive_update_mode')) ... - || not(islogical(opts.shifts.naive_update_mode)) - opts.shifts.naive_update_mode = false; -end - -% Initialize the shift generator when this function is called for the -% first time. -if not(isfield(opts.shifts, 'tmp')) || not(isfield(opts.shifts.tmp, 'U')) - [eqn, opts, oper, W, Z, Y] = initialize(eqn, opts, oper, W, Z, Y); -end - -% Compute the shift. Truncate shift to real if the imaginary part is small -% enough. -[eqn, opts, oper, shift] = getNextShift(eqn, opts, oper, W, Z, Y); -if (abs(imag(shift)) / abs(shift)) < 1e-8 - shift = real(shift); -end - -opts.shifts.p = shift; -nShifts = 1; - -end - - -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Auxiliary functions for the shift generator. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -function [eqn, opts, oper, W, Z, Y] = initialize(eqn, opts, oper, W, Z, Y) - % Queue for storing previous subspace dimensions. - opts.shifts.tmp.block_queue = {}; - opts.shifts.tmp.dim_current = 0; - opts.shifts.tmp.dim_total_subspace = 0; - opts.shifts.tmp.dim_max = opts.shifts.history; % .. Alias .. - - if isfield(eqn, 'Z0') && (size(eqn.Z0, 2) > opts.shifts.history) - % Ensure that the shift history is larger than the initial - % solution. - opts.shifts.tmp.dim_max = opts.shifts.tmp.dim_max ... - + size(eqn.Z0, 2); - end -end - - -function [eqn, opts, oper, shift] = getNextShift(eqn, opts, oper, W, Z, Y) - % Computes the next shift. - - % Update (or initialize) orthogonal basis of the projected subspace. - [eqn, opts, oper, W, Z, Y] = update_qr(eqn, opts, oper, W, Z, Y); - - % Assemble/update the projected Hamiltonian matrix (size = 2*ell). - [eqn, opts, ~, ~, ~, ~] = update_ray(eqn, opts, oper, W, Z, Y); - - % Compute the eigenpairs of the pair (Hproj, Eproj). - if eqn.haveE - % Compute the eigenvalues of the matric pencil (Hproj, Eproj). - % It turns out that reducing to ordinary eigenvalue problem is - % faster. - % [XX, LL] = eig(opts.shifts.tmp.Hproj, opts.shifts.tmp.Eproj); - [XX, LL] = eig(opts.shifts.tmp.Eproj \ opts.shifts.tmp.Hproj); - else - [XX, LL] = eig(opts.shifts.tmp.Hproj); - end - - % Filter out the stable eigenvalues. - LL = diag(LL); - perm = (real(LL) < 0); - LL = LL(perm); - XX = XX(:, perm); - - % Rescale the stable eigenvectors. - nX = length(XX) / 2; - - % Find the eigenvector with the largest norm(y)^2 / abs(xt*Et*y) - taj = 1; maxi = -1; - - for i = 1 : length(LL) - temp = XX(nX+1:end, i); % y - curr = norm(temp); % norm(y) - - if eqn.haveE - temp = opts.shifts.tmp.UtEU' * temp; % E' * y - end - - temp = abs(XX(1:nX, i)' * temp); % x'*E'*y - if curr - curr = curr / temp * curr; % norm(y)^2 / abs(x'*E'*y) - end - - if (i == 1) || (curr > maxi) - maxi = curr; - taj = i; - end - end - - % The shift is the eigenvalue associated to taj. - shift = LL(taj); -end - - -function [eqn, opts, oper, W, Z, Y] = update_qr(eqn, opts, oper, W, Z, Y) - % Updates the orthogonal basis for the projection subspace. - dim_current = opts.shifts.tmp.dim_current; - dim_total_subspace = opts.shifts.tmp.dim_total_subspace; - dim_max = opts.shifts.tmp.dim_max; - - % Detect how many columns have been added, and how many have to be - % dropped from the previous step. - k = size(Z, 2); - dim_new = k - dim_total_subspace; - opts.shifts.tmp.block_queue{... - length(opts.shifts.tmp.block_queue) + 1} = dim_new; - - dim_drop = 0; dim_keep = dim_current; - while dim_keep + dim_new > dim_max - dim_block = opts.shifts.tmp.block_queue{1}; - opts.shifts.tmp.block_queue(1) = []; - - % Drop columns block by block from the queue. - dim_keep = dim_keep - dim_block; - dim_drop = dim_drop + dim_block; - end - - % If the first shift is required, use the orthonormal basis of W. - % This is NOT reused for the following shifts. - if k == 0 - [opts.shifts.tmp.U, opts.shifts.tmp.RR] = qr(W, 0); - - return; - end - - % Otherwise, update the QR factorization. - if opts.shifts.naive_update_mode || not(isfield(opts.shifts.tmp, 'RR')) - % Just compute the QR factorization of the last - % dim_keep + dim_new columns of Z. - % May be inefficient! - [opts.shifts.tmp.U, opts.shifts.tmp.RR] = ... - qr(Z(:, k-(dim_keep + dim_new)+1:k), 0); - else - % Update the QR factorization by dropping first dim_drop columns - % from the factorization. - - % First, compute the QRF of the last dim_keep columns of RR - % (This could actually be done by a sequence of small Householder - % reflectors, but it is more efficient?) - [opts.shifts.tmp.Q, opts.shifts.tmp.RR] = ... - qr(opts.shifts.tmp.RR(:, ... - dim_current-dim_keep+1:dim_current), 0); - - % Q = Ortho. matrix that transforms old U ([drop keep]) into new - % U ([keep]). Update the basis U with Q from the right. - opts.shifts.tmp.U = opts.shifts.tmp.U * opts.shifts.tmp.Q; - - % The new subspace to append the basis. - U_new = Z(: , k-dim_new+1:k); - - % Check if a part of the new subspace is already a part of the - % old one. - if (size(opts.shifts.tmp.U, 2) > 0) && (size(U_new, 2) > 0) - [U_new, ~] = qr(U_new, 0); - [~, s, v] = svd(opts.shifts.tmp.U' * U_new); - if (size(s, 2) > 1) && (size(s, 1) > 1) - % Tolerance on the cosine of the canonical angles, - % hardcoded... - perm = (diag(s) < 1 - 1e-11); - else - % A weird special case. Matlab would make diag(s) a matrix - % here. - perm = (s(1) < 1 - 1e-11); - end - % Keep only the part of the subspace already not contained - % in U. - U_new = U_new * v(:, perm); - dim_new = size(U_new, 2); - end - - opts.shifts.tmp.RR = blkdiag(opts.shifts.tmp.RR, zeros(dim_new)); - - % Orthogonalize columns of U_new against U, twice is enough. - p = size(opts.shifts.tmp.U, 2); % do it all at once - jj_start = 1; - jj_end = dim_new; - for twice = 1:2 - kk_start = 1; - kk_end = p; - - gamma = opts.shifts.tmp.U(:, kk_start:kk_end)' ... - * U_new(:, jj_start:jj_end); - opts.shifts.tmp.RR(kk_start:kk_end, ... - dim_keep+jj_start:dim_keep+jj_end) = ... - opts.shifts.tmp.RR( kk_start:kk_end, ... - dim_keep+jj_start:dim_keep+jj_end ) + gamma; - - U_new(:, jj_start:jj_end) = U_new(:, jj_start:jj_end) ... - - opts.shifts.tmp.U(:, kk_start:kk_end) * gamma; - end - - % .. Gram-Schmidt to get the ortho. - % Basis for w -> new columns in Z. - [opts.shifts.tmp.U(:, dim_keep+jj_start:dim_keep+jj_end),... - opts.shifts.tmp.RR(dim_keep+jj_start:dim_keep+jj_end, ... - dim_keep+jj_start:dim_keep+jj_end)] = ... - qr(U_new(:, jj_start:jj_end), 0); - end - - % Update the dimensions of the subspace. - opts.shifts.tmp.dim_current = dim_keep + dim_new; - opts.shifts.tmp.dim_total_subspace = k; - opts.shifts.tmp.dim_new = dim_new; -end - - -function [eqn, opts, oper, W, Z, Y] = update_ray(eqn, opts, oper, W, Z, Y) - % Updates the Rayleigh quotients: Hproj and Eproj. - n = oper.size(eqn, opts); - - if not(isfield(opts.shifts.tmp, 'Q')) - opts.shifts.tmp.AU = zeros(n, 0); - opts.shifts.tmp.EU = zeros(n, 0); - opts.shifts.tmp.UtAU = []; - opts.shifts.tmp.UtEU = []; - opts.shifts.tmp.UtB = []; %for quadratic term. - opts.shifts.tmp.UtU = []; %for UV' update term. - opts.shifts.tmp.UtV = []; %for UV' update term. - opts.shifts.tmp.UtR = []; %for right hand side. - opts.shifts.tmp.Q = []; - end - - opp_type = 'N'; - if eqn.type == 'N' - opp_type = 'T'; - end - - if opts.shifts.naive_update_mode || isempty(opts.shifts.tmp.Q) - % Use a naive method of updating the Rayleigh quotient by - % recomputing everything. - - % Do the projection. - opts.shifts.tmp.AU = ... - oper.mul_A(eqn, opts, opp_type, opts.shifts.tmp.U, 'N'); - opts.shifts.tmp.UtAU = opts.shifts.tmp.U' * opts.shifts.tmp.AU; - - if eqn.haveE - opts.shifts.tmp.EU = ... - oper.mul_E(eqn, opts, opp_type, opts.shifts.tmp.U, 'N'); - opts.shifts.tmp.UtEU = opts.shifts.tmp.U' * opts.shifts.tmp.EU; - end - - opts.shifts.tmp.UtB = opts.shifts.tmp.U' * eqn.BB; - opts.shifts.tmp.UtU = opts.shifts.tmp.U' * eqn.U; - opts.shifts.tmp.UtV = opts.shifts.tmp.U' * eqn.V; - opts.shifts.tmp.UtR = opts.shifts.tmp.U' * W; - - if eqn.type == 'T' - AA = opts.shifts.tmp.UtAU ... - + opts.shifts.tmp.UtU * opts.shifts.tmp.UtV'; - else - AA = opts.shifts.tmp.UtAU ... - + opts.shifts.tmp.UtV * opts.shifts.tmp.UtU'; - end - - if opts.LDL_T - opts.shifts.tmp.Hproj = ... - full([AA, ... - opts.shifts.tmp.UtB*opts.shifts.tmp.UtB'; ... - opts.shifts.tmp.UtR * (diag(eqn.S_diag) * opts.shifts.tmp.UtR'), ... - -AA']); - else - opts.shifts.tmp.Hproj = ... - full([AA, opts.shifts.tmp.UtB*opts.shifts.tmp.UtB'; ... - opts.shifts.tmp.UtR*opts.shifts.tmp.UtR', -AA']); - end - - if eqn.haveE - opts.shifts.tmp.Eproj = ... - full(blkdiag(opts.shifts.tmp.UtEU, opts.shifts.tmp.UtEU')); - end - else - % Update the Rayleigh quotient by using the up/downdated - % QR-factorization of the relevant (newest) columns of Z. - % Currently requires matrix-vector products with A for computing - % A * (new columns of Q-factor) in each step. - dim_current = opts.shifts.tmp.dim_current; - dim_new = opts.shifts.tmp.dim_new; - - Unew = opts.shifts.tmp.U(:, dim_current-dim_new+1:dim_current); - - % Compute: AUnew = A * Unew and EUnew = E * Unew; - AUnew = oper.mul_A(eqn, opts, opp_type, Unew, 'N'); - - if eqn.haveE - EUnew = oper.mul_E(eqn, opts, opp_type, Unew, 'N'); - end - - % Update the old A*U and U'*A*U - if size(opts.shifts.tmp.Q, 2) == 0 - opts.shifts.tmp.AU = zeros(n, 0); - opts.shifts.tmp.UtAU = []; - opts.shifts.tmp.EU = zeros(n, 0); - opts.shifts.tmp.UtEU = []; - - if eqn.type == 'T' - opts.shifts.tmp.UtU = Unew' * eqn.U; - else - opts.shifts.tmp.UtV = Unew' * eqn.V; - end - opts.shifts.tmp.UtB = Unew' * eqn.BB; - else - opts.shifts.tmp.AU = opts.shifts.tmp.AU * opts.shifts.tmp.Q; - opts.shifts.tmp.UtAU = opts.shifts.tmp.Q' ... - * (opts.shifts.tmp.UtAU * opts.shifts.tmp.Q); - - if eqn.haveE - opts.shifts.tmp.EU = opts.shifts.tmp.EU ... - * opts.shifts.tmp.Q; - opts.shifts.tmp.UtEU = opts.shifts.tmp.Q' ... - * (opts.shifts.tmp.UtEU * opts.shifts.tmp.Q); - end - - if eqn.type == 'T' - opts.shifts.tmp.UtU = ... - [opts.shifts.tmp.Q' * opts.shifts.tmp.UtU; ... - Unew' * eqn.U]; - else - opts.shifts.tmp.UtV = ... - [opts.shifts.tmp.Q' * opts.shifts.tmp.UtV; ... - Unew' * eqn.V]; - end - opts.shifts.tmp.UtB = ... - [opts.shifts.tmp.Q' * opts.shifts.tmp.UtB; Unew' * eqn.BB]; - end - - opts.shifts.tmp.UtAU = [opts.shifts.tmp.UtAU, ... - opts.shifts.tmp.U(:, 1:dim_current-dim_new)' * AUnew; ... - Unew' * opts.shifts.tmp.AU, Unew' * AUnew ]; - opts.shifts.tmp.AU = [opts.shifts.tmp.AU, AUnew]; - - if eqn.haveE - opts.shifts.tmp.UtEU = [opts.shifts.tmp.UtEU, ... - opts.shifts.tmp.U(:, 1:dim_current-dim_new)'*EUnew; ... - Unew' * opts.shifts.tmp.EU, Unew' * EUnew ]; - opts.shifts.tmp.EU = [opts.shifts.tmp.EU, EUnew]; - end - - opts.shifts.tmp.UtR = opts.shifts.tmp.U' * W; - if eqn.type == 'T' - opts.shifts.tmp.UtV = opts.shifts.tmp.U' * eqn.V; - else - opts.shifts.tmp.UtU = opts.shifts.tmp.U' * eqn.U; - end - - % Finally, assemble the Hamiltonian Rayleigh quotient matrix. - if eqn.type == 'T' - AA = opts.shifts.tmp.UtAU ... - + opts.shifts.tmp.UtU * opts.shifts.tmp.UtV'; - else - AA = opts.shifts.tmp.UtAU ... - + opts.shifts.tmp.UtV * opts.shifts.tmp.UtU'; - end - - if opts.LDL_T - opts.shifts.tmp.Hproj = ... - [AA, ... - opts.shifts.tmp.UtB * opts.shifts.tmp.UtB'; ... - opts.shifts.tmp.UtR * (diag(eqn.S_diag) * opts.shifts.tmp.UtR'), ... - -AA']; - else - opts.shifts.tmp.Hproj = ... - [AA opts.shifts.tmp.UtB * opts.shifts.tmp.UtB'; ... - opts.shifts.tmp.UtR*opts.shifts.tmp.UtR', -AA']; - end - - % If needed, assemble the Rayleigh quotient of diag(E,E') matrix. - if eqn.haveE - opts.shifts.tmp.Eproj = ... - blkdiag(opts.shifts.tmp.UtEU, opts.shifts.tmp.UtEU'); - end - end -end +function [eqn, opts, oper, nShifts] = ... + mess_lrradi_get_shifts_hamOpti_generalized(eqn, opts, oper, W, Z, Y) +% Compute the Hamiltonian residual shifts for the RADI method. +% Optionally, run residual minimizing search afterwards, and return +% optimized shifts. +% +% The routine avoids solving linear systems with E. The shifts are computed +% as generalized Ritz values of the matrix pair (H, EE), where +% H = [A + U*V' B*B' ], EE = [ E 0 ] +% W'*W -(A + U*V')' ] [ 0 E' ]. +% +% The matrix pair is projected onto the subspace spanned by the ell last vectors +% in Z. The generalized eigenvalues and eigenvectors of the obtained pair +% (Hproj, Eproj) are then used to compute the shift in the following way: +% - all obtained eigenvectors [x; y] are sorted by the value of +% tau = norm(y)^2 / abs( x'*E'*y ). +% - the eigenvalue corresponding to the largest value of tau is chosen +% as the next shift. +% +% Input +% eqn struct contains data for equations +% +% opts struct contains parameters for the algorithm +% +% oper struct contains function handles for operation +% with A and E +% +% W the current residual matrix in RADI +% +% Z the current Z matrix in RADI +% +% Y the small square factor in the RADI solution +% (not used) +% +% +% Output +% opts the modified input structure +% +% nShifts the number of shifts computed (=1, always) +% +% +% Input fields in struct eqn used by this routine: +% eqn.BB dense (n x m1) matrix from quadratic term +% +% eqn.U dense (n x m3) matrix U from rank-m3 Update +% +% eqn.V dense (n x m3) matrix V from rank-m3 Update +% +% eqn.type possible values: 'N', 'T' +% determining whether (N) or (T) is solved +% +% eqn.haveE possible values: false, true +% if haveE = false: matrix E in eqn.E_ is assumed to be identity +% +% +% Input fields in struct opts used by this routine: +% shifts.history +% Possible values: inf or k*p, where k>=2, and p = size(W, 2). +% The number of the last columns of Z which are used to project the +% Hamiltonian pair, i.e., the dimension of the projection subspace. +% If set to inf, all columns of Z will be used. +% +% shifts.naive_update_mode +% Possible values: true | [false] +% Sets the method of updating the projection between successive calls +% to mess_lrradi_get_shifts_hamOpti_generalized. If set to true, the QR +% factorization will be recomputed from scratch in each call to +% obtain the orthonormal basis for the projection subspace. If set +% to (default) false, the QR factorization from the previous step +% will be updated to save computation time. +% +% +% Output fields in struct opts set by this routine: +% shifts.p +% Contains the computed shift. +% +% opts.shifts.tmp +% struct with all the temporary matrices for the shifts +% + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +% Determine the number of inputs. +p = size(W, 2); + +% Check if the projection subspace size is valid. +if not(opts.shifts.history == Inf || ... + (mod(opts.shifts.history, p) == 0) && ... + (opts.shifts.history >= 2 * p)) + mess_warn(opts, 'control_data', ['Shifts history length should be ', ... + 'Inf, or a multiple of number of ', ... + 'residual columns p (>=2*p).', ... + 'Set opts.shifts.history = %i.'], ... + 6 * p); + opts.shifts.history = 6 * p; +end + +if not(isfield(opts.shifts, 'naive_update_mode')) || ... + not(islogical(opts.shifts.naive_update_mode)) + opts.shifts.naive_update_mode = false; +end + +% Initialize the shift generator when this function is called for the +% first time. +if not(isfield(opts.shifts, 'tmp')) || not(isfield(opts.shifts.tmp, 'U')) + [eqn, opts, oper, W, Z, Y] = initialize(eqn, opts, oper, W, Z, Y); +end + +% Compute the shift. Truncate shift to real if the imaginary part is small +% enough. +[eqn, opts, oper, shift] = getNextShift(eqn, opts, oper, W, Z, Y); +if (abs(imag(shift)) / abs(shift)) < 1e-8 + shift = real(shift); +end + +opts.shifts.p = shift; +nShifts = 1; + +end + +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Auxiliary functions for the shift generator. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +function [eqn, opts, oper, W, Z, Y] = initialize(eqn, opts, oper, W, Z, Y) +% Queue for storing previous subspace dimensions. +opts.shifts.tmp.block_queue = {}; +opts.shifts.tmp.dim_current = 0; +opts.shifts.tmp.dim_total_subspace = 0; +opts.shifts.tmp.dim_max = opts.shifts.history; % .. Alias .. + +if isfield(eqn, 'Z0') && (size(eqn.Z0, 2) > opts.shifts.history) + % Ensure that the shift history is larger than the initial + % solution. + opts.shifts.tmp.dim_max = opts.shifts.tmp.dim_max + size(eqn.Z0, 2); +end +end + +function [eqn, opts, oper, shift] = getNextShift(eqn, opts, oper, W, Z, Y) +% Computes the next shift. + +% Update (or initialize) orthogonal basis of the projected subspace. +[eqn, opts, oper, W, Z, Y] = update_qr(eqn, opts, oper, W, Z, Y); + +% Assemble/update the projected Hamiltonian matrix (size = 2*ell). +[eqn, opts, ~, ~, ~, ~] = update_ray(eqn, opts, oper, W, Z, Y); + +% Compute the eigenpairs of the pair (Hproj, Eproj). +if eqn.haveE + % Compute the eigenvalues of the matrix pencil (Hproj, Eproj). + % It turns out that reducing to ordinary eigenvalue problem is + % faster. + % [XX, LL] = eig(opts.shifts.tmp.Hproj, opts.shifts.tmp.Eproj); + [XX, LL] = eig(opts.shifts.tmp.Eproj \ opts.shifts.tmp.Hproj); +else + [XX, LL] = eig(opts.shifts.tmp.Hproj); +end + +% Filter out the stable eigenvalues. +LL = diag(LL); +perm = (real(LL) < 0); +LL = LL(perm); +XX = XX(:, perm); + +% Rescale the stable eigenvectors. +nX = length(XX) / 2; + +% Find the eigenvector with the largest norm(y)^2 / abs(xt*Et*y) +taj = 1; +maxi = -1; + +for i = 1:length(LL) + temp = XX(nX + 1:end, i); % y + curr = norm(temp); % norm(y) + + if eqn.haveE + temp = opts.shifts.tmp.UtEU' * temp; % E' * y + end + + temp = abs(XX(1:nX, i)' * temp); % x'*E'*y + if curr + curr = curr / temp * curr; % norm(y)^2 / abs(x'*E'*y) + end + + if (i == 1) || (curr > maxi) + maxi = curr; + taj = i; + end +end + +% The shift is the eigenvalue associated to taj. +shift = LL(taj); +end + +function [eqn, opts, oper, W, Z, Y] = update_qr(eqn, opts, oper, W, Z, Y) +% Updates the orthogonal basis for the projection subspace. +dim_current = opts.shifts.tmp.dim_current; +dim_total_subspace = opts.shifts.tmp.dim_total_subspace; +dim_max = opts.shifts.tmp.dim_max; + +% Detect how many columns have been added, and how many have to be +% dropped from the previous step. +k = size(Z, 2); +dim_new = k - dim_total_subspace; +opts.shifts.tmp.block_queue{length(opts.shifts.tmp.block_queue) + 1} = dim_new; + +dim_drop = 0; +dim_keep = dim_current; +while dim_keep + dim_new > dim_max + dim_block = opts.shifts.tmp.block_queue{1}; + opts.shifts.tmp.block_queue(1) = []; + + % Drop columns block by block from the queue. + dim_keep = dim_keep - dim_block; + dim_drop = dim_drop + dim_block; +end + +% If the first shift is required, use the orthonormal basis of W. +% This is NOT reused for the following shifts. +if k == 0 + [opts.shifts.tmp.U, opts.shifts.tmp.RR] = qr(W, 0); + + return +end + +% Otherwise, update the QR factorization. +if opts.shifts.naive_update_mode || not(isfield(opts.shifts.tmp, 'RR')) + % Just compute the QR factorization of the last + % dim_keep + dim_new columns of Z. + % May be inefficient! + [opts.shifts.tmp.U, opts.shifts.tmp.RR] = ... + qr(Z(:, k - (dim_keep + dim_new) + 1:k), 0); +else + % Update the QR factorization by dropping first dim_drop columns + % from the factorization. + + % First, compute the QRF of the last dim_keep columns of RR + % (This could actually be done by a sequence of small Householder + % reflectors, but it is more efficient?) + [opts.shifts.tmp.Q, opts.shifts.tmp.RR] = ... + qr(opts.shifts.tmp.RR(:, ... + dim_current - dim_keep + 1:dim_current), 0); + + % Q = Ortho. matrix that transforms old U ([drop keep]) into new + % U ([keep]). Update the basis U with Q from the right. + opts.shifts.tmp.U = opts.shifts.tmp.U * opts.shifts.tmp.Q; + + % The new subspace to append the basis. + U_new = Z(:, k - dim_new + 1:k); + + % Check if a part of the new subspace is already a part of the + % old one. + if (size(opts.shifts.tmp.U, 2) > 0) && (size(U_new, 2) > 0) + [U_new, ~] = qr(U_new, 0); + [~, s, v] = svd(opts.shifts.tmp.U' * U_new); + if (size(s, 2) > 1) && (size(s, 1) > 1) + % Tolerance on the cosine of the canonical angles, + % hardcoded... + perm = (diag(s) < 1 - 1e-11); + else + % A weird special case. Matlab would make diag(s) a matrix + % here. + perm = (s(1) < 1 - 1e-11); + end + % Keep only the part of the subspace already not contained + % in U. + U_new = U_new * v(:, perm); + dim_new = size(U_new, 2); + end + + opts.shifts.tmp.RR = blkdiag(opts.shifts.tmp.RR, zeros(dim_new)); + + % Orthogonalize columns of U_new against U, twice is enough. + p = size(opts.shifts.tmp.U, 2); % do it all at once + jj_start = 1; + jj_end = dim_new; + for twice = 1:2 + kk_start = 1; + kk_end = p; + + gamma = opts.shifts.tmp.U(:, kk_start:kk_end)' * ... + U_new(:, jj_start:jj_end); + opts.shifts.tmp.RR(kk_start:kk_end, ... + dim_keep + jj_start:dim_keep + jj_end) = ... + opts.shifts.tmp.RR(kk_start:kk_end, ... + dim_keep + jj_start:dim_keep + jj_end) + gamma; + + U_new(:, jj_start:jj_end) = U_new(:, jj_start:jj_end) - ... + opts.shifts.tmp.U(:, kk_start:kk_end) * gamma; + end + + % .. Gram-Schmidt to get the ortho. + % Basis for w -> new columns in Z. + [opts.shifts.tmp.U(:, dim_keep + jj_start:dim_keep + jj_end), ... + opts.shifts.tmp.RR(dim_keep + jj_start:dim_keep + jj_end, ... + dim_keep + jj_start:dim_keep + jj_end)] = ... + qr(U_new(:, jj_start:jj_end), 0); +end + +% Update the dimensions of the subspace. +opts.shifts.tmp.dim_current = dim_keep + dim_new; +opts.shifts.tmp.dim_total_subspace = k; +opts.shifts.tmp.dim_new = dim_new; +end + +function [eqn, opts, oper, W, Z, Y] = update_ray(eqn, opts, oper, W, Z, Y) +% Updates the Rayleigh quotients: Hproj and Eproj. +n = oper.size(eqn, opts); + +if not(isfield(opts.shifts.tmp, 'Q')) + opts.shifts.tmp.AU = zeros(n, 0); + opts.shifts.tmp.EU = zeros(n, 0); + opts.shifts.tmp.UtAU = []; + opts.shifts.tmp.UtEU = []; + opts.shifts.tmp.UtB = []; % for quadratic term. + opts.shifts.tmp.UtU = []; % for UV' update term. + opts.shifts.tmp.UtV = []; % for UV' update term. + opts.shifts.tmp.UtR = []; % for right hand side. + opts.shifts.tmp.Q = []; +end + +opp_type = 'N'; +if eqn.type == 'N' + opp_type = 'T'; +end + +if opts.shifts.naive_update_mode || isempty(opts.shifts.tmp.Q) + % Use a naive method of updating the Rayleigh quotient by + % recomputing everything. + + % Do the projection. + opts.shifts.tmp.AU = ... + oper.mul_A(eqn, opts, opp_type, opts.shifts.tmp.U, 'N'); + opts.shifts.tmp.UtAU = opts.shifts.tmp.U' * opts.shifts.tmp.AU; + + if eqn.haveE + opts.shifts.tmp.EU = ... + oper.mul_E(eqn, opts, opp_type, opts.shifts.tmp.U, 'N'); + opts.shifts.tmp.UtEU = opts.shifts.tmp.U' * opts.shifts.tmp.EU; + end + + opts.shifts.tmp.UtB = opts.shifts.tmp.U' * eqn.BB; + opts.shifts.tmp.UtU = opts.shifts.tmp.U' * eqn.U; + opts.shifts.tmp.UtV = opts.shifts.tmp.U' * eqn.V; + opts.shifts.tmp.UtR = opts.shifts.tmp.U' * W; + + if eqn.type == 'T' + AA = opts.shifts.tmp.UtAU + ... + opts.shifts.tmp.UtU * opts.shifts.tmp.UtV'; + else + AA = opts.shifts.tmp.UtAU + ... + opts.shifts.tmp.UtV * opts.shifts.tmp.UtU'; + end + + if opts.LDL_T + opts.shifts.tmp.Hproj = ... + full([AA, ... + opts.shifts.tmp.UtB * (eqn.RR \ opts.shifts.tmp.UtB'); ... + opts.shifts.tmp.UtR * (eqn.T * opts.shifts.tmp.UtR'), ... + -AA']); + else + opts.shifts.tmp.Hproj = ... + full([AA, opts.shifts.tmp.UtB * opts.shifts.tmp.UtB'; ... + opts.shifts.tmp.UtR * opts.shifts.tmp.UtR', -AA']); + end + + if eqn.haveE + opts.shifts.tmp.Eproj = ... + full(blkdiag(opts.shifts.tmp.UtEU, opts.shifts.tmp.UtEU')); + end +else + % Update the Rayleigh quotient by using the up/downdated + % QR-factorization of the relevant (newest) columns of Z. + % Currently requires matrix-vector products with A for computing + % A * (new columns of Q-factor) in each step. + dim_current = opts.shifts.tmp.dim_current; + dim_new = opts.shifts.tmp.dim_new; + + Unew = opts.shifts.tmp.U(:, dim_current - dim_new + 1:dim_current); + + % Compute: AUnew = A * Unew and EUnew = E * Unew; + AUnew = oper.mul_A(eqn, opts, opp_type, Unew, 'N'); + + if eqn.haveE + EUnew = oper.mul_E(eqn, opts, opp_type, Unew, 'N'); + end + + % Update the old A*U and U'*A*U + if size(opts.shifts.tmp.Q, 2) == 0 + opts.shifts.tmp.AU = zeros(n, 0); + opts.shifts.tmp.UtAU = []; + opts.shifts.tmp.EU = zeros(n, 0); + opts.shifts.tmp.UtEU = []; + + if eqn.type == 'T' + opts.shifts.tmp.UtU = Unew' * eqn.U; + else + opts.shifts.tmp.UtV = Unew' * eqn.V; + end + opts.shifts.tmp.UtB = Unew' * eqn.BB; + else + opts.shifts.tmp.AU = opts.shifts.tmp.AU * opts.shifts.tmp.Q; + opts.shifts.tmp.UtAU = opts.shifts.tmp.Q' * ... + (opts.shifts.tmp.UtAU * opts.shifts.tmp.Q); + + if eqn.haveE + opts.shifts.tmp.EU = opts.shifts.tmp.EU * ... + opts.shifts.tmp.Q; + opts.shifts.tmp.UtEU = opts.shifts.tmp.Q' * ... + (opts.shifts.tmp.UtEU * opts.shifts.tmp.Q); + end + + if eqn.type == 'T' + opts.shifts.tmp.UtU = ... + [opts.shifts.tmp.Q' * opts.shifts.tmp.UtU; ... + Unew' * eqn.U]; + else + opts.shifts.tmp.UtV = ... + [opts.shifts.tmp.Q' * opts.shifts.tmp.UtV; ... + Unew' * eqn.V]; + end + opts.shifts.tmp.UtB = ... + [opts.shifts.tmp.Q' * opts.shifts.tmp.UtB; Unew' * eqn.BB]; + end + + opts.shifts.tmp.UtAU = [opts.shifts.tmp.UtAU, ... + opts.shifts.tmp.U(:, ... + 1:dim_current - dim_new)' * ... + AUnew; ... + Unew' * opts.shifts.tmp.AU, Unew' * AUnew]; + opts.shifts.tmp.AU = [opts.shifts.tmp.AU, AUnew]; + + if eqn.haveE + opts.shifts.tmp.UtEU = [opts.shifts.tmp.UtEU, ... + opts.shifts.tmp.U(:, ... + 1:dim_current - ... + dim_new)' * ... + EUnew; ... + Unew' * opts.shifts.tmp.EU, Unew' * EUnew]; + opts.shifts.tmp.EU = [opts.shifts.tmp.EU, EUnew]; + end + + opts.shifts.tmp.UtR = opts.shifts.tmp.U' * W; + if eqn.type == 'T' + opts.shifts.tmp.UtV = opts.shifts.tmp.U' * eqn.V; + else + opts.shifts.tmp.UtU = opts.shifts.tmp.U' * eqn.U; + end + + % Finally, assemble the Hamiltonian Rayleigh quotient matrix. + if eqn.type == 'T' + AA = opts.shifts.tmp.UtAU + ... + opts.shifts.tmp.UtU * opts.shifts.tmp.UtV'; + else + AA = opts.shifts.tmp.UtAU + ... + opts.shifts.tmp.UtV * opts.shifts.tmp.UtU'; + end + + if opts.LDL_T + opts.shifts.tmp.Hproj = ... + [AA, ... + opts.shifts.tmp.UtB * (eqn.RR \ opts.shifts.tmp.UtB'); ... + opts.shifts.tmp.UtR * (eqn.T * opts.shifts.tmp.UtR'), ... + -AA']; + else + opts.shifts.tmp.Hproj = ... + [AA opts.shifts.tmp.UtB * opts.shifts.tmp.UtB'; ... + opts.shifts.tmp.UtR * opts.shifts.tmp.UtR', -AA']; + end + + % If needed, assemble the Rayleigh quotient of diag(E,E') matrix. + if eqn.haveE + opts.shifts.tmp.Eproj = ... + blkdiag(opts.shifts.tmp.UtEU, opts.shifts.tmp.UtEU'); + end +end +end diff --git a/shifts/mess_mnmx.m b/shifts/mess_mnmx.m index b3e607b..72fe080 100644 --- a/shifts/mess_mnmx.m +++ b/shifts/mess_mnmx.m @@ -1,4 +1,4 @@ -function p = mess_mnmx(rw,num_desired) +function p = mess_mnmx(rw, num_desired) % % Suboptimal solution of the ADI minimax problem. The delivered parameter % set is closed under complex conjugation. @@ -29,55 +29,54 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - % Exact copy from % % LYAPACK 1.0 (Thilo Penzl, October 1999) % Input data not completely checked! -if not(isnumeric(num_desired)) || (length(num_desired) ~= 1) - error('MESS:error_arguments','num_desired has to be of numeric type'); +if not(isnumeric(num_desired)) || not(length(num_desired) == 1) + mess_err(opts, 'error_arguments', 'num_desired has to be of numeric type'); end if not(isnumeric(rw)) - error('MESS:error_arguments','rw has to be a vector of numeric type'); + mess_err(opts, 'error_arguments', 'rw has to be a vector of numeric type'); end -if length(rw) - else - p = [ p; p0]; %#ok - end + p0 = rw(i); + if imag(p0) + p = [p; p0; conj(p0)]; %#ok + else + p = [p; p0]; %#ok + end - [~,i] = mess_s(p,rw); + [~, i] = mess_s(p, rw); end - diff --git a/shifts/mess_para.m b/shifts/mess_para.m index f691333..b080e81 100644 --- a/shifts/mess_para.m +++ b/shifts/mess_para.m @@ -16,11 +16,11 @@ % % Output: % -% p an opts.shifts.num_desired- or opts.shifts.num_desired+1-vector of -% suboptimal ADI parameters; +% p an opts.shifts.num_desired- or opts.shifts.num_desired+1-vector +% of suboptimal ADI parameters; % % out outputstructure potentially containing the following fields -% (depending on the method used): +% (depending on the method used): % out.err_code Error code = 1, if Ritz values with positive real parts % have been encountered; otherwise, err_code = 0; % out.rw vector containing the Ritz values; @@ -47,8 +47,8 @@ % determining whether (N) or (T) is solved % (optional) % -% eqn.haveE possible values: 0, 1, false, true -% if haveE = 0: matrix E is assumed to be the identity +% eqn.haveE possible values: false, true +% if haveE = false: matrix E is assumed to be the identity % (optional) % % Depending on the operator chosen by the operatormanager, additional @@ -80,7 +80,7 @@ % heuristic shift computation % (optional, default: ones(n, 1)) % -% opts.shifts.info possible values: 0, 1, false, true +% opts.shifts.info possible values: 0, 1 % turn output of used shifts before the first % iteration step on (1) or off (0) % (optional, default: 0) @@ -162,7 +162,7 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % @@ -171,101 +171,104 @@ %% check data -if not(isfield(opts.shifts,'method')) - opts.shifts.method='heuristic'; - warning('MESS:control_data', ... - ['Missing shift parameter selection method. ', ... - 'Switching to default: heuristic shifts']); +if not(isfield(opts.shifts, 'method')) + opts.shifts.method = 'heuristic'; + mess_warn(opts, 'control_data', ... + ['Missing shift parameter selection method. ', ... + 'Switching to default: heuristic shifts']); end -if not(isfield(opts,'shifts')) || not(isstruct(opts.shifts)) - warning('MESS:control_data',... - ['shift parameter control structure missing. ', ... - 'Switching to defaults: ', ... - 'num_desired = 25, num_Ritz = 50, num_hRitz = 25.']); +if not(isfield(opts, 'shifts')) || not(isstruct(opts.shifts)) + mess_warn(opts, 'control_data', ... + ['shift parameter control structure missing. ', ... + 'Switching to defaults: ', ... + 'num_desired = 25, num_Ritz = 50, num_hRitz = 25.']); opts.shifts.num_desired = 25; opts.shifts.num_Ritz = 50; opts.shifts.num_hRitz = 25; else - if not(isfield(opts.shifts,'num_desired')) || ... + if not(isfield(opts.shifts, 'num_desired')) || ... not(isnumeric(opts.shifts.num_desired)) - warning('MESS:control_data',... - ['Missing or Corrupted opts.shifts.num_desired field.', ... - 'Switching to default: 25']); + mess_warn(opts, 'control_data', ... + ['Missing or Corrupted opts.shifts.num_desired field.', ... + 'Switching to default: 25']); opts.shifts.num_desired = 25; end - if strcmp(opts.shifts.method,'heur') && ... - (not(isfield(opts.shifts,'num_Ritz')) || ... - not(isnumeric(opts.shifts.num_Ritz))) - warning('MESS:control_data',... - ['Missing or Corrupted opts.shifts.num_Ritz field.', ... - 'Switching to default: 50']); + if strcmp(opts.shifts.method, 'heur') && ... + (not(isfield(opts.shifts, 'num_Ritz')) || ... + not(isnumeric(opts.shifts.num_Ritz))) + mess_warn(opts, 'control_data', ... + ['Missing or Corrupted opts.shifts.num_Ritz field.', ... + 'Switching to default: 50']); opts.shifts.num_Ritz = 50; end - if strcmp(opts.shifts.method,'heur') && ... - (not(isfield(opts.shifts,'num_hRitz')) || ... + if strcmp(opts.shifts.method, 'heur') && ... + (not(isfield(opts.shifts, 'num_hRitz')) || ... not(isnumeric(opts.shifts.num_hRitz))) - warning('MESS:control_data',... - ['Missing or Corrupted opts.shifts.num_hRitz field.', ... - 'Switching to default: 25']); + mess_warn(opts, 'control_data', ... + ['Missing or Corrupted opts.shifts.num_hRitz field.', ... + 'Switching to default: 25']); opts.shifts.num_hRitz = 25; end end -if not(isfield(eqn, 'haveE')), eqn.haveE = 0; end +if not(isfield(eqn, 'haveE')) + eqn.haveE = false; +end -if not(isfield(eqn, 'type')), eqn.type = 'N'; end +if not(isfield(eqn, 'type')) + eqn.type = 'N'; +end -[result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A','E'); +[result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A', 'E'); if not(result) - error('MESS:control_data', ... - 'system data is not completely defined or corrupted'); + mess_err(opts, 'control_data', ... + 'system data is not completely defined or corrupted'); end -out.err_code = 0; +out.err_code = false; -rosenbrock = 0; -if isfield(opts,'rosenbrock') && isstruct(opts.rosenbrock) && ... - isfield(opts.rosenbrock,'tau') - rosenbrock = 1; +rosenbrock = false; +if isfield(opts, 'rosenbrock') && isstruct(opts.rosenbrock) && ... + isfield(opts.rosenbrock, 'tau') + rosenbrock = true; if opts.rosenbrock.stage == 1 pc = -1 / (2 * opts.rosenbrock.tau); taugamma = 1; else % p = 2 taugamma = (opts.rosenbrock.tau * opts.rosenbrock.gamma); - pc = ( - 0.5) / taugamma; + pc = (-0.5) / taugamma; end end -bdf = 0; -if isfield(opts,'bdf') && isstruct(opts.bdf) && ... +bdf = false; +if isfield(opts, 'bdf') && isstruct(opts.bdf) && ... isfield(opts.bdf, 'tau') && isfield(opts.bdf, 'beta') - bdf = 1; + bdf = true; pc = -1 / (2 * opts.bdf.tau * opts.bdf.beta); end - -if not(isfield(opts.shifts, 'banned')) ... - || not(isnumeric(opts.shifts.banned)) +if not(isfield(opts.shifts, 'banned')) || ... + not(isnumeric(opts.shifts.banned)) opts.shifts.banned = []; -elseif not(isfield(opts.shifts, 'banned_tol')) ... - || not(isnumeric(opts.shifts.banned_tol)) ... - || not(isscalar(opts.shifts.banned_tol)) +elseif not(isfield(opts.shifts, 'banned_tol')) || ... + not(isnumeric(opts.shifts.banned_tol)) || ... + not(isscalar(opts.shifts.banned_tol)) opts.shifts.banned_tol = 1e-4; end -if not(isfield(opts.shifts,'recursion_level')) ... - || not(isnumeric(opts.shifts.recursion_level)) ... - || not(isscalar(opts.shifts.recursion_level)) +if not(isfield(opts.shifts, 'recursion_level')) || ... + not(isnumeric(opts.shifts.recursion_level)) || ... + not(isscalar(opts.shifts.recursion_level)) opts.shifts.recursion_level = 0; end %% initialize usfs -[eqn,opts, oper] = oper.mul_A_pre(eqn, opts, oper); -[eqn,opts, oper] = oper.mul_E_pre(eqn, opts, oper); -[eqn,opts, oper] = oper.sol_A_pre(eqn, opts, oper); -[eqn,opts, oper] = oper.sol_E_pre(eqn, opts, oper); +[eqn, opts, oper] = oper.mul_A_pre(eqn, opts, oper); +[eqn, opts, oper] = oper.mul_E_pre(eqn, opts, oper); +[eqn, opts, oper] = oper.sol_A_pre(eqn, opts, oper); +[eqn, opts, oper] = oper.sol_E_pre(eqn, opts, oper); %% switch opts.shifts.method @@ -308,23 +311,24 @@ end switch opts.shifts.wachspress case 'N' - p = mess_wachspress_n(a,b,alpha,opts.shifts.num_desired); + p = mess_wachspress_n(a, b, alpha, opts.shifts.num_desired); case 'T' - if isfield(opts,'nm') && ... - isfield(opts.nm,'inexact') &&... - isa(opts.nm.inexact,'char') + if isfield(opts, 'nm') && ... + isfield(opts.nm, 'inexact') && ... + isa(opts.nm.inexact, 'char') tol = opts.adi.outer_tol; else - tol=opts.adi.res_tol; + tol = opts.adi.res_tol; end p = mess_wachspress(a, b, alpha, tol); otherwise - error('MESS:shift_method',... - 'wachspress selector needs to be either ''T'' or ''N'''); + mess_err(opts, 'shift_method', ... + ['wachspress selector needs to be either ' ... + ' ''T'' or ''N''']); end case 'projection' - if isfield(eqn, 'G') - U = eqn.G; + if isfield(eqn, 'W') + U = eqn.W; elseif eqn.type == 'N' U = eqn.B; else @@ -343,7 +347,7 @@ elseif rosenbrock AU = taugamma * ... oper.mul_ApE(eqn, opts, eqn.type, pc, eqn.type, U, 'N'); - + if isfield(eqn, 'haveUV') && eqn.haveUV if eqn.type == 'N' AU = AU + eqn.U * (eqn.V' * U); @@ -351,7 +355,7 @@ AU = AU + eqn.V * (eqn.U' * U); end end - + else AU = oper.mul_A(eqn, opts, eqn.type, U, 'N'); @@ -364,47 +368,48 @@ end end - if isfield(oper,'get_ritz_vals') + if isfield(oper, 'get_ritz_vals') p = oper.get_ritz_vals(eqn, opts, oper, U, AU, []); else p = mess_projection_shifts(eqn, opts, oper, U, AU, []); end if isempty(p) - if (i < 5) - warning('MESS:mess_para', ... - ['Could not compute initial projection shifts. ',... - 'Going to retry with random right hand side.']); + if i < 5 + mess_warn(opts, 'mess_para', ... + ['Could not compute initial projection ', ... + 'shifts. Going to retry with random ' ... + 'right hand side.']); U = rand(size(U)); else - error('MESS:mess_para', ... - 'Could not compute initial projection shifts.'); + mess_err(opts, 'mess_para', ... + 'Could not compute initial projection shifts.'); end end - + i = i + 1; end otherwise - error('MESS:shift_method', ... - 'unknown shift computation method requested.'); + mess_err(opts, 'shift_method', ... + 'unknown shift computation method requested.'); end %% check computed shifts % check for banned shifts -for j = 1 : length(opts.shifts.banned) - critical_shifts = abs(p - opts.shifts.banned(j)) ... - < opts.shifts.banned_tol * max(abs(p)); - p(critical_shifts) = p(critical_shifts) ... - - opts.shifts.banned_tol * 2; - % p = p(not(critical_shifts)); +for j = 1:length(opts.shifts.banned) + critical_shifts = abs(p - opts.shifts.banned(j)) < ... + opts.shifts.banned_tol * max(abs(p)); + p(critical_shifts) = p(critical_shifts) - ... + opts.shifts.banned_tol * 2; end if isempty(p) % if all shifts banned try again with double amount if opts.shifts.recursion_level < 2 - warning('MESS:mess_para', 'All computed shifts are banned. Retrying'); + mess_warn(opts, 'mess_para', ... + 'All computed shifts are banned. Retrying'); num_desired = opts.shifts.num_desired; opts.shifts.num_desired = num_desired * 2; opts.shifts.recursion_level = opts.shifts.recursion_level + 1; - [p , ~, eqn, opts, oper] = mess_para(eqn, opts, oper); + [p, ~, eqn, opts, oper] = mess_para(eqn, opts, oper); opts.shifts.num_desired = num_desired; opts.shifts.recursion_level = opts.shifts.recursion_level - 1; end diff --git a/shifts/mess_projection_shifts.m b/shifts/mess_projection_shifts.m index 80ace23..6b0133a 100644 --- a/shifts/mess_projection_shifts.m +++ b/shifts/mess_projection_shifts.m @@ -1,5 +1,5 @@ function p = mess_projection_shifts(eqn, opts, oper, V, W, p_old) -%%function p = mess_projection_shifts(eqn, opts, oper, V, W, p_old) +%% function p = mess_projection_shifts(eqn, opts, oper, V, W, p_old) % % Internal helper function for usfs and mess_get_projection % shifts. Computes new shifts by implicitly or explicitly @@ -16,42 +16,53 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% Check data -if not(isfield(opts,'shifts')) || not(isstruct(opts.shifts)) - warning('MESS:control_data',['shift parameter control structure missing.', ... - 'Switching to default num_desired = 25.']); +if not(isfield(opts, 'shifts')) || not(isstruct(opts.shifts)) + mess_warn(opts, 'control_data', ... + ['shift parameter control structure missing.', ... + 'Switching to default num_desired = 25.']); opts.shifts.num_desired = 25; else - if not(isfield(opts.shifts,'num_desired')) || ... + if not(isfield(opts.shifts, 'num_desired')) || ... not(isnumeric(opts.shifts.num_desired)) - warning('MESS:control_data',... - ['Missing or Corrupted opts.shifts.num_desired field.', ... - 'Switching to default: 25']); + + mess_warn(opts, 'control_data', ... + ['Missing or Corrupted opts.shifts.num_desired field.', ... + 'Switching to default: 25']); opts.shifts.num_desired = 25; end - if not(isfield(opts.shifts,'implicitVtAV'))|| isempty(opts.shifts.implicitVtAV) + if not(isfield(opts.shifts, 'implicitVtAV')) || ... + isempty(opts.shifts.implicitVtAV) opts.shifts.implicitVtAV = true; end end -if not(isfield(eqn, 'haveE')), eqn.haveE = 0; end +if not(isfield(eqn, 'haveE')) + eqn.haveE = false; +end + [result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A', 'E'); + if not(result) - error('MESS:control_data', 'system data is not completely defined or corrupted'); + mess_err(opts, 'control_data', ... + 'system data is not completely defined or corrupted'); end L = length(p_old); -nV = size(V, 2); -nW = size(W, 2); +cols_V = size(V, 2); +cols_W = size(W, 2); + if L > 0 && any(p_old) - if nV / nW ~= L - error('MESS:control_data', 'V and W have inconsistent no. of columns'); + + if not(cols_V / cols_W == L) + + mess_err(opts, 'control_data', ... + 'V and W have inconsistent no. of columns'); end end @@ -60,9 +71,9 @@ T = zeros(L, L); K = zeros(1, L); D = []; - Ir = eye(nW); + Ir = eye(cols_W); iC = find(imag(p_old)); - iCh = iC(1 : 2 : end); + iCh = iC(1:2:end); iR = find(not(imag(p_old))); isubdiag = [iR; iCh]; h = 1; @@ -81,16 +92,17 @@ D = blkdiag(D, sqrt(-2 * p_old(h))); h = h + 1; else % complex conjugated pair of shifts - rpc=real(p_old(h)); - ipc=imag(p_old(h)); - beta=rpc / ipc; - T(h : h + 1, h : h + 1) = [3 * rpc, -ipc; - ipc * (1 + 4 * beta^2), -rpc]; + rpc = real(p_old(h)); + ipc = imag(p_old(h)); + beta = rpc / ipc; + T(h:h + 1, h:h + 1) = [3 * rpc, -ipc + ipc * (1 + 4 * beta^2), -rpc]; if not(isempty(is)) - T(h : h+ 1, is)=[4 * rpc; - 4 * rpc * beta] * ones(1, length(is)); + T(h:h + 1, is) = [4 * rpc + 4 * rpc * beta] * ones(1, length(is)); end - D = blkdiag(D, 2 * sqrt(-rpc) * [1,0; beta, sqrt(1 + beta^2)]); + D = blkdiag(D, ... + 2 * sqrt(-rpc) * [1, 0; beta, sqrt(1 + beta^2)]); h = h + 2; end end @@ -107,18 +119,17 @@ else W = W + eqn.U * (eqn.V' * V); end - end + end end end %% Compute projection matrices -[~, s, v] = svd(V' * V); +[v, s] = eig(V' * V); s = diag(s); -r = sum(s > eps * s(1) * nV); -st = v( : , 1 : r) * diag(1 ./ s(1 : r).^.5); +r = (s > eps * s(end) * cols_V); +st = v(:, r) * diag(1 ./ s(r).^.5); U = V * st; - %% Project V and compute Ritz values if eqn.haveE E_V = oper.mul_E(eqn, opts, eqn.type, V, 'N'); @@ -127,7 +138,7 @@ G = G * st; p = eig(H, G); else - H = U' * (W * K) * st + U'*( V *( S * st )); + H = U' * (W * K) * st + U' * (V * (S * st)); p = eig(H); end @@ -135,16 +146,20 @@ % remove infinite values p = p(isfinite(p)); + % remove zeros p = p(abs(p) > eps); -% make all shifts stable + +% make all shifts are stable p(real(p) > 0) = -p(real(p) > 0); + if not(isempty(p)) - % remove small imaginary pertubations + % remove small imaginary perturbations small_imag = find(abs(imag(p)) ./ abs(p) < 1e-12); p(small_imag) = real(p(small_imag)); + % sort (s.t. compl. pairs are together) - p=sort(p); + p = sort(p); if length(p) > opts.shifts.num_desired p = mess_mnmx(p, opts.shifts.num_desired); end diff --git a/shifts/mess_s.m b/shifts/mess_s.m index 83c2b89..4cf4618 100644 --- a/shifts/mess_s.m +++ b/shifts/mess_s.m @@ -1,4 +1,4 @@ -function [max_r,ind] = mess_s(p,set) +function [max_r, ind] = mess_s(p, set) % % Computation of the maximal magnitude of the rational ADI function over % a discrete subset of the left complex half plane. @@ -21,44 +21,40 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - % Exact copy from % % LYAPACK 1.0 (Thilo Penzl, Jan 1999) % if not(isnumeric(p)) - error('MESS:error_arguments','p has to be a vector of numeric type'); + mess_err(opts, 'error_arguments', 'p has to be a vector of numeric type'); end if not(isnumeric(set)) - error('MESS:error_arguments','set has to be a vector of numeric type'); + mess_err(opts, 'error_arguments', 'set has to be a vector of numeric type'); end max_r = -1; ind = 0; for i = 1:length(set) - x = set(i); + x = set(i); - rr = 1; - for j = 1:length(p) + rr = 1; + for j = 1:length(p) - rr = rr*abs(p(j)-x)/abs(p(j)+x); + rr = rr * abs(p(j) - x) / abs(p(j) + x); - end + end - if rr > max_r + if rr > max_r - max_r = rr; - ind = i; + max_r = rr; + ind = i; - end + end end - - - diff --git a/shifts/mess_wachspress.m b/shifts/mess_wachspress.m index 0599a2a..1df6576 100644 --- a/shifts/mess_wachspress.m +++ b/shifts/mess_wachspress.m @@ -1,6 +1,6 @@ -function p=mess_wachspress(a,b,alpha,TOL) +function p = mess_wachspress(a, b, alpha, TOL) % -% function p=mess_wachspress(a,b,alpha,TOL) +% function p = mess_wachspress(a, b, alpha, TOL) % % calculates the optimal ADI shiftparameters (for equations where % Matrix A is stable and symmetric) according to Jing-Rebecca Li @@ -14,7 +14,7 @@ % % b is assumed to be the absolute value of the largest magnitude eigenvalue % -% alpha is the arctan of the maximum of abs(imag(lamba))/abs(real(lambda)) +% alpha is the arctan of the maximum of abs(imag(lamba)) / abs(real(lambda)) % for all lambda in the spectrum of A % % TOL is the epsilon1 of the above paper. The smaller the better @@ -24,32 +24,33 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - -if not(isnumeric(a)) || (length(a) ~= 1) - error('MESS:error_arguments','a has to be a numeric value'); +opts = struct; +if not(isnumeric(a)) || not(length(a) == 1) + mess_err(opts, 'error_arguments', 'a has to be a numeric value'); end -if not(isnumeric(b)) || (length(b) ~= 1) - error('MESS:error_arguments','b has to be a numeric value'); +if not(isnumeric(b)) || not(length(b) == 1) + mess_err(opts, 'error_arguments', 'b has to be a numeric value'); end -if not(isnumeric(alpha)) || (length(alpha) ~= 1) - error('MESS:error_arguments','alpha has to be a numeric value'); +if not(isnumeric(alpha)) || not(length(alpha) == 1) + mess_err(opts, 'error_arguments', 'alpha has to be a numeric value'); end -if not(isnumeric(TOL)) || (length(TOL) ~= 1) - error('MESS:error_arguments','TOL has to be a numeric value'); +if not(isnumeric(TOL)) || not(length(TOL) == 1) + mess_err(opts, 'error_arguments', 'TOL has to be a numeric value'); end -if (alpha==0) - num_Ritzrime=a/b; +if alpha == 0 + num_Ritzrime = a / b; else - c2 = 2/(1+(a/b+b/a)/2); - m = 2*cos(alpha)*cos(alpha)/c2 -1; - if (m<1) - error(['Shift parameters would be complex, function not applicable, ' ... - 'aborting!']); + c2 = 2 / (1 + (a / b + b / a) / 2); + m = 2 * cos(alpha) * cos(alpha) / c2 - 1; + if m < 1 + mess_err(opts, 'complex_shifts', ... + ['Shift parameters would be complex, function not ' ... + 'applicable, aborting!']); % % FIX ME: if m<1 parameter become complex! switch back to the @@ -60,30 +61,29 @@ % method (see V.Simoncini) % end - num_Ritzrime = 1/(m+sqrt(m^2-1)); + num_Ritzrime = 1 / (m + sqrt(m^2 - 1)); end -k=min(1-eps,sqrt(1-num_Ritzrime^2)); -%this is a workaround for the case -%k=1 that works for our model reduction problems +k = min(1 - eps, sqrt(1 - num_Ritzrime^2)); +% this is a workaround for the case +% k=1 that works for our model reduction problems % (not really nice but it works great for now). +% TODO: check the computation of k, kprime to avoid roundoff errors +% and probably replace the hack above. -%TODO: check the computation of k, kprime to avoid roundoff errors -%and probably replace the hack above. - -[K,~]=ellip(k,pi/2); -if (alpha==0) - [v,~]=ellip(num_Ritzrime,pi/2); +[K, ~] = ellip(k, pi / 2); +if alpha == 0 + [v, ~] = ellip(num_Ritzrime, pi / 2); else - [v,~]=ellip(num_Ritzrime,asin(sqrt(a/(b*num_Ritzrime)))); + [v, ~] = ellip(num_Ritzrime, asin(sqrt(a / (b * num_Ritzrime)))); end -J=ceil(K/(2*v*pi)*log(4/TOL)); +J = ceil(K / (2 * v * pi) * log(4 / TOL)); -p=ones(J,1); -for i=1:J - p(i)=-sqrt(a*b/num_Ritzrime)*dn((i-0.5)*K/J,k); - %here we have the choice to take the - %matlab function ellipj or our own - %one dn. the later can be proted to - %FORTRAN or C Code very easily +p = ones(J, 1); +for i = 1:J + p(i) = -sqrt(a * b / num_Ritzrime) * dn((i - 0.5) * K / J, k); + % here we have the choice to take the + % matlab function ellipj or our own + % one dn. the later can be ported to + % FORTRAN or C Code very easily end diff --git a/shifts/mess_wachspress_n.m b/shifts/mess_wachspress_n.m index 6911bd6..42f6d92 100644 --- a/shifts/mess_wachspress_n.m +++ b/shifts/mess_wachspress_n.m @@ -1,4 +1,4 @@ -function p=mess_wachspress_n(a,b,alpha,num_desired) +function p = mess_wachspress_n(a, b, alpha, num_desired) % function p=mess_wachspress_n(a,b,alpha,num_desired) % % calculates the optimal ADI shiftparameters (for equations where @@ -25,32 +25,33 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - -if not(isnumeric(a)) || (length(a) ~= 1) - error('MESS:error_arguments','a has to be a numeric value') +opts = struct; +if not(isnumeric(a)) || not(length(a) == 1) + mess_err(opts, 'error_arguments', 'a has to be a numeric value'); end -if not(isnumeric(b)) || (length(b) ~= 1) - error('MESS:error_arguments','b has to be a numeric value') +if not(isnumeric(b)) || not(length(b) == 1) + mess_err(opts, 'error_arguments', 'b has to be a numeric value'); end -if not(isnumeric(alpha)) || (length(alpha) ~= 1) - error('MESS:error_arguments','alpha has to be a numeric value') +if not(isnumeric(alpha)) || not(length(alpha) == 1) + mess_err(opts, 'error_arguments', 'alpha has to be a numeric value'); end -if not(isnumeric(num_desired)) || (length(num_desired) ~= 1) - error('MESS:error_arguments','num_desired has to be a numeric value') +if not(isnumeric(num_desired)) || not(length(num_desired) == 1) + mess_err(opts, 'error_arguments', 'num_desired has to be a numeric value'); end -if (alpha==0) - num_Ritzrime=a/b; +if alpha == 0 + num_Ritzrime = a / b; else - c2 = 2/(1+(a/b+b/a)/2); - m = 2*cos(alpha)*cos(alpha)/c2 -1; - if (m<1) - error(['Shift parameters would be complex, function not applicable, ' ... - 'aborting!']); + c2 = 2 / (1 + (a / b + b / a) / 2); + m = 2 * cos(alpha) * cos(alpha) / c2 - 1; + if m < 1 + mess_err(opts, 'complex_shifts', ... + ['Shift parameters would be complex, function not ' ... + 'applicable, aborting!']); % % FIX ME: if m<1 parameters become complex! switch back to the @@ -59,24 +60,24 @@ % If the reason are single outliers treat them separately (Wachspress % suggestion) end - num_Ritzrime = 1/(m+sqrt(m^2-1)); + num_Ritzrime = 1 / (m + sqrt(m^2 - 1)); end -k=min(1-eps,sqrt(1-num_Ritzrime^2)); -%this is a workaround for the case -%k=1 that works for Model reduction problems +k = min(1 - eps, sqrt(1 - num_Ritzrime^2)); +% this is a workaround for the case +% k=1 that works for Model reduction problems % (not really nice but it works great for now). -%TODO: check the computation of k, kprime to avoid roundoff errors -%and probably replace the hack above. +% TODO: check the computation of k, kprime to avoid roundoff errors +% and probably replace the hack above. -[K,~]=ellip(k,pi/2); -J=num_desired; +[K, ~] = ellip(k, pi / 2); +J = num_desired; -p=ones(J,1); -for i=1:J - p(i)=-sqrt(a*b/num_Ritzrime)*dn((i-0.5)*K/J,k); - %here we have the choice to take the - %matlab function ellipj or our own - %one dn. the later can be ported to - %FORTRAN or C Code very easily +p = ones(J, 1); +for i = 1:J + p(i) = -sqrt(a * b / num_Ritzrime) * dn((i - 0.5) * K / J, k); + % here we have the choice to take the + % matlab function ellipj or our own + % one dn. the later can be ported to + % FORTRAN or C Code very easily end diff --git a/usfs/dae_1/eval_matrix_functions_dae_1.m b/usfs/dae_1/eval_matrix_functions_dae_1.m index 4ba4988..b457ae0 100644 --- a/usfs/dae_1/eval_matrix_functions_dae_1.m +++ b/usfs/dae_1/eval_matrix_functions_dae_1.m @@ -1,34 +1,39 @@ -function [ eqn, opts, oper ] = eval_matrix_functions_dae_1( eqn, opts, oper, t ) +function [eqn, opts, oper] = eval_matrix_functions_dae_1(eqn, opts, oper, t, sign_dt_E) %% function eval_matrix_functions_dae_1 updates the matrices in eqn % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % if eqn.LTV + if nargin < 5 + sign_dt_E = 1; + end %% if eqn.haveE eqn.E_ = eqn.E_time(t); - eqn.A_ = eqn.A_time(t) + eqn.dt_E_time(t); + eqn.A_ = eqn.A_time(t) + sign_dt_E * eqn.dt_E_time(t); else eqn.A_ = eqn.A_time(t); end eqn.B = eqn.B_time(t); eqn.C = eqn.C_time(t); %% Compute reduced B and C - st = eqn.st; - if size(eqn.B, 1) > st - eqn.B = eqn.B(1 : st, :) - eqn.A_(1 : st, st + 1 : end) ... - * (eqn.A_(st + 1 : end, st + 1 : end) \ eqn.B(st + 1 : end, :)); + n_ode = eqn.manifold_dim; + if size(eqn.B, 1) > n_ode + eqn.B = eqn.B(1:n_ode, :) - eqn.A_(1:n_ode, n_ode + 1:end) * ... + (eqn.A_(n_ode + 1:end, n_ode + 1:end) \ eqn.B(n_ode + 1:end, :)); end - if size(eqn.C, 2) > st - eqn.C = eqn.C( : , 1 : st) - (eqn.C( : , st + 1 : end) ... - / eqn.A_(st +1 : end, st + 1 : end)) * eqn.A_(st+1 : end, 1 : st); + if size(eqn.C, 2) > n_ode + eqn.C = eqn.C(:, 1:n_ode) - ... + (eqn.C(:, n_ode + 1:end) / ... + eqn.A_(n_ode + 1:end, n_ode + 1:end)) * ... + eqn.A_(n_ode + 1:end, 1:n_ode); end end -end \ No newline at end of file +end diff --git a/usfs/dae_1/get_ritz_vals_dae_1.m b/usfs/dae_1/get_ritz_vals_dae_1.m index da535f7..894e85c 100644 --- a/usfs/dae_1/get_ritz_vals_dae_1.m +++ b/usfs/dae_1/get_ritz_vals_dae_1.m @@ -1,24 +1,25 @@ -function [rw, Hp, Hm, Vp, Vm] = get_ritz_vals_dae_1(eqn, opts, oper, U, W, p_old) +function [rw, Hp, Hm, Vp, Vm, eqn, opts, oper] = ... + get_ritz_vals_dae_1(eqn, opts, oper, U, W, p_old) % This function ensures that W is not empty if the shift % method is projection. Otherwise, it checks opts.shifts.b0. It -% should be a vector of the same size as eqn.A but oper.size gives eqn.st. +% should be a vector of the same size as eqn.A but oper.size gives eqn.manifold_dim. % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - % Input data not completely checked! -if(not(isfield(eqn,'A_'))) || not(isnumeric(eqn.A_)) - error('MESS:error_arguments','field eqn.A_ is not defined'); +if (not(isfield(eqn, 'A_'))) || not(isnumeric(eqn.A_)) + mess_err(opts, 'error_arguments', 'field eqn.A_ is not defined'); end -[result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A','E'); +[result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A', 'E'); if not(result) - error('MESS:control_data', 'system data is not completely defined or corrupted'); + mess_err(opts, 'control_data', ... + 'system data is not completely defined or corrupted'); end n = oper.size(eqn, opts); @@ -27,20 +28,28 @@ if isfield(opts.shifts, 'method') && ... strcmp(opts.shifts.method, 'projection') if isempty(W) - % first shifts are computed with U = eqn.G and W = A * eqn.G + % first shifts are computed with U = eqn.W and W = A * eqn.W W = oper.mul_A(eqn, opts, eqn.type, U, 'N'); + if isfield(eqn, 'haveUV') && eqn.haveUV + switch eqn.type + case 'N' + W = W + eqn.U * (eqn.V' * U); + case 'T' + W = W + eqn.V * (eqn.U' * U); + end + end end - rw = mess_projection_shifts(eqn, opts, oper, U, ... - W, p_old); + rw = mess_projection_shifts(eqn, opts, oper, U, W, p_old); else - if (not(isfield(opts.shifts, 'b0')) || isempty(opts.shifts.b0)) - opts.shifts.b0 = ones(n,1); + if not(isfield(opts.shifts, 'b0')) || isempty(opts.shifts.b0) + opts.shifts.b0 = ones(n, 1); else - if length(opts.shifts.b0) ~= n - warning('MESS:b0',... - 'b0 has the wrong length. Switching to default.'); - opts.shifts.b0 = ones(n,1); + if not(length(opts.shifts.b0) == n) + mess_warn(opts, 'b0', ... + 'b0 has the wrong length. Switching to default.'); + opts.shifts.b0 = ones(n, 1); end end [rw, Hp, Hm, Vp, Vm] = mess_get_ritz_vals(eqn, opts, oper); end +end diff --git a/usfs/dae_1/init_dae_1.m b/usfs/dae_1/init_dae_1.m index 1266618..caed87a 100644 --- a/usfs/dae_1/init_dae_1.m +++ b/usfs/dae_1/init_dae_1.m @@ -1,6 +1,6 @@ function [result, eqn, opts, oper] = init_dae_1(eqn, opts, oper, flag1, flag2) % function [result, eqn, opts, oper] = init_dae_1(eqn, opts, oper, flag1, flag2) -% return true or false if Data for A_ and E_ resp. flag1 and flag2 are +% return true or false if Data for A_ and E_ resp. flag1 and flag2 are % available and correct in eqn. % % result = init(eqn,flag1); @@ -27,260 +27,286 @@ % oper struct contains usfs for operation with A and E % % uses no other dae_1 functions +% % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input Parameters na = nargin; -if not(isfield(eqn, 'LTV')), eqn.LTV=0; end -if(na<3) - error('MESS:control_data','Number of input Arguments are at least 3'); +if not(isfield(eqn, 'LTV')) + eqn.LTV = false; +end +if na < 3 + mess_err(opts, 'control_data', ... + 'Number of input Arguments are at least 3'); -%% result = init(eqn, flag1); -elseif(na==4) + %% result = init(eqn, flag1); +elseif na == 4 switch flag1 - case {'A','a'} + case {'A', 'a'} if eqn.LTV - [eqn,result] = checkA_time(eqn,opts); + [eqn, result] = checkA_time(eqn, opts); else - [eqn,result] = checkA(eqn); + [eqn, result] = checkA(eqn, opts); end - case {'E','e'} + case {'E', 'e'} if eqn.LTV - [eqn,result] = checkE_time(eqn,opts); + [eqn, result] = checkE_time(eqn, opts); else - [eqn,result] = checkE(eqn); + [eqn, result] = checkE(eqn, opts); end otherwise - error('MESS:control_data','flag1 has to be ''A_'' or ''E_'''); + mess_err(opts, 'control_data', ... + 'flag1 has to be ''A_'' or ''E_'''); end -%% result = init(eqn,flag1,flag2); -elseif(nargin==5) + %% result = init(eqn,flag1,flag2); +elseif nargin == 5 switch flag1 - case {'A','a'} + case {'A', 'a'} if eqn.LTV - [eqn, result] = checkA_time(eqn,opts); + [eqn, result] = checkA_time(eqn, opts); else - [eqn, result] = checkA(eqn); + [eqn, result] = checkA(eqn, opts); end switch flag2 - case {'A','a'} + case {'A', 'a'} if eqn.LTV - [eqn, resultA] = checkA_time(eqn,opts); + [eqn, resultA] = checkA_time(eqn, opts); else - [eqn, resultA] = checkA(eqn); + [eqn, resultA] = checkA(eqn, opts); end result = result && resultA; - case {'E','e'} + case {'E', 'e'} if eqn.LTV - [eqn, resultE] = checkE_time(eqn,opts); + [eqn, resultE] = checkE_time(eqn, opts); else - [eqn, resultE]= checkE(eqn); + [eqn, resultE] = checkE(eqn, opts); end result = result && resultE; otherwise - error('MESS:control_data', ... - 'flag2 has to be ''A'' or ''E'''); + mess_err(opts, 'control_data', ... + 'flag2 has to be ''A'' or ''E'''); end - case {'E','e'} + case {'E', 'e'} if eqn.LTV - [eqn, result] = checkE_time(eqn,opts); + [eqn, result] = checkE_time(eqn, opts); else - [eqn, result] = checkE(eqn); + [eqn, result] = checkE(eqn, opts); end switch flag2 - case {'A','a'} + case {'A', 'a'} if eqn.LTV - [eqn, resultA] = checkA_time(eqn,opts); + [eqn, resultA] = checkA_time(eqn, opts); else - [eqn, resultA] = checkA(eqn); + [eqn, resultA] = checkA(eqn, opts); end result = result && resultA; - case {'E','e'} + case {'E', 'e'} if eqn.LTV - [eqn, resultE] = checkE_time(eqn,opts); + [eqn, resultE] = checkE_time(eqn, opts); else - [eqn, resultE]= checkE(eqn); + [eqn, resultE] = checkE(eqn, opts); end result = result && resultE; otherwise - error('MESS:control_data', ... - 'flag2 has to be ''A'' or ''E'''); + mess_err(opts, 'control_data', ... + 'flag2 has to be ''A'' or ''E'''); end otherwise - error('MESS:control_data',... - 'flag1 has to be ''A'' or ''E'''); + mess_err(opts, 'control_data', ... + 'flag1 has to be ''A'' or ''E'''); end end %% Compute reduced B and C -n = size(eqn.A_,1); -st = eqn.st; -one = 1:st; -two = st + 1 : n; +n = size(eqn.A_, 1); +one = 1:eqn.manifold_dim; +two = eqn.manifold_dim + 1:n; if not(eqn.LTV) - if size(eqn.B, 1) > st - eqn.B = eqn.B(one, :) - eqn.A_(one, two) ... - * (eqn.A_(two, two) \ eqn.B(two, :)); + if size(eqn.B, 1) > eqn.manifold_dim + eqn.B = eqn.B(one, :) - eqn.A_(one, two) * ... + (eqn.A_(two, two) \ eqn.B(two, :)); end - if size(eqn.C, 2) > st - eqn.C = eqn.C( : , one) - (eqn.C( : , two) ... - / eqn.A_(two, two)) * eqn.A_(two, one); + if size(eqn.C, 2) > eqn.manifold_dim + eqn.C = eqn.C(:, one) - ... + (eqn.C(:, two) / eqn.A_(two, two)) * eqn.A_(two, one); end end end %% checkdata for A_ -function [eqn,result] = checkA(eqn) -if not(isfield(eqn,'A_')) || not(isnumeric(eqn.A_)) - error('MESS:equation_data',... - 'Empty or Corrupted field A detected in equation structure.'); +function [eqn, result] = checkA(eqn, opts) + +if not(isfield(eqn, 'A_')) || not(isnumeric(eqn.A_)) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field A detected in equation structure.'); end -if (size(eqn.A_,1) ~= size(eqn.A_,2)) - error('MESS:error_arguments', 'field eqn.A_ has to be quadratic'); + +if not(size(eqn.A_, 1) == size(eqn.A_, 2)) + mess_err(opts, 'error_arguments', 'field eqn.A_ has to be quadratic'); end -if(not(issparse(eqn.A_))) - warning('MESS:control_data','A is not sparse'); + +if not(issparse(eqn.A_)) + mess_warn(opts, 'control_data', 'A is not sparse'); end -if not(isfield(eqn, 'st')) || not(isnumeric(eqn.st)) - error('MESS:st',... - 'Missing or Corrupted st field detected in equation structure.'); + +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'equations_data', ... + ['Missing or corrupted manifold_dim field detected in ' ... + 'equation structure.']); end -result = 1; +result = true; end %% checkdata for E_ -function [eqn,result] = checkE(eqn) -if not(isfield(eqn, 'haveE')), eqn.haveE = 0; end -if not(isfield(eqn, 'st')) || not(isnumeric(eqn.st)) - error('MESS:st',... - 'Missing or Corrupted st field detected in equation structure.'); -elseif (not(isfield(eqn,'E_')) || not(isnumeric(eqn.E_))) && eqn.haveE - error('MESS:equation_data',... - 'Empty or Corrupted field E detected in equation structure.'); +function [eqn, result] = checkE(eqn, opts) +if not(isfield(eqn, 'haveE')) + eqn.haveE = false; end -st = eqn.st; -if not(isfield(eqn,'A_')) || not(isnumeric(eqn.A_)) - error('MESS:equation_data',... - 'Empty or Corrupted field A detected in equation structure.'); +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'equation_data', ... + ['Missing or corrupted manifold_dim field detected in ' ... + 'equation structure.']); +elseif (not(isfield(eqn, 'E_')) || not(isnumeric(eqn.E_))) && eqn.haveE + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field E detected in equation structure.'); end -n=size(eqn.A_,1); +n_ode = eqn.manifold_dim; +if not(isfield(eqn, 'A_')) || not(isnumeric(eqn.A_)) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field A detected in equation structure.'); +end +n = size(eqn.A_, 1); if not(eqn.haveE) if isfield(eqn, 'E_') - error('MESS:equation_data', ['Detected eqn.E_ where eqn.haveE ' ... - 'is 0. You need to set haveE=1 or delete E_.']); + mess_err(opts, 'equation_data', ... + ['Detected eqn.E_ where eqn.haveE ' ... + 'is 0. You need to set haveE = true or delete E_.']); else - result = 1; + result = true; end else - if (size(eqn.E_,1) ~= size(eqn.E_,2)) - error('MESS:error_arguments', 'field eqn.E_ has to be quadratic'); + if not(size(eqn.E_, 1) == size(eqn.E_, 2)) + mess_err(opts, 'error_arguments', ... + 'field eqn.E_ has to be quadratic'); end - if(not(issparse(eqn.E_))) - warning('MESS:control_data','E is not sparse'); + if not(issparse(eqn.E_)) + mess_warn(opts, 'control_data', ... + 'E is not sparse'); end % check size(A) == size(E)? - if (n~=size(eqn.E_,1)) - error('MESS:error_arguments',... - 'dimensions of E and A must coincide'); + if not(n == size(eqn.E_, 1)) + mess_err(opts, 'error_arguments', ... + 'dimensions of E and A must coincide'); end % E = [ E1 0 ] % [ 0 0 ] - if full(any([any(eqn.E_(1:st, st + 1:end)), any(eqn.E_(st+1:end,:))])) - warning('MESS:control_data',... - 'E has to be non-zero only in st x st block'); + if full(any([any(eqn.E_(1:n_ode, n_ode + 1:end)), any(eqn.E_(n_ode + 1:end, :))])) + mess_warn(opts, 'control_data', ... + 'E has to be non-zero only in n_ode x n_ode block'); end % result: bool; without 'full()' result: 1x1 sparse - result = 1; + result = true; end end %% checkdata for A_ -function [eqn, result] = checkA_time(eqn,opts) -if not(isfield(eqn, 'A_time')) || not(isa(eqn.A_time,'function_handle')) - error('MESS:equation_data',... - 'Empty or Corrupted field A_time detected in equation structure.'); +function [eqn, result] = checkA_time(eqn, opts) +if not(isfield(eqn, 'A_time')) || not(isa(eqn.A_time, 'function_handle')) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field A_time detected in equation structure.'); end A = eqn.A_time(opts.t0); if not(isnumeric(A)) - error('MESS:equation_data',... - 'Empty or Corrupted field eqn.A_time(t) detected in equation structure.'); + mess_err(opts, 'equation_data', ... + ['Empty or Corrupted field eqn.A_time(t) detected in', ... + ' equation structure.']); end -if (size(A,1) ~= size(A,2)) - error('MESS:error_arguments', 'field eqn.A_time(t) has to be quadratic'); +if not(size(A, 1) == size(A, 2)) + mess_err(opts, 'error_arguments', ... + 'field eqn.A_time(t) has to be quadratic'); end -if(not(issparse(A))) - warning('MESS:control_data','A is not sparse'); +if not(issparse(A)) + mess_warn(opts, 'control_data', 'A is not sparse'); end -if not(isfield(eqn, 'st')) || not(isnumeric(eqn.st)) - error('MESS:st',... - 'Missing or Corrupted st field detected in equation structure.'); +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'equations_data', ... + ['Missing or corrupted manifold_dim field detected in ' ... + 'equation structure.']); end -result = 1; +result = true; end %% checkdata for E_ -function [eqn, result] = checkE_time(eqn,opts) -if not(isfield(eqn, 'haveE')), eqn.haveE = 0; end -if not(isfield(eqn, 'st')) || not(isnumeric(eqn.st)) - error('MESS:st',... - 'Missing or Corrupted st field detected in equation structure.'); +function [eqn, result] = checkE_time(eqn, opts) +if not(isfield(eqn, 'haveE')) + eqn.haveE = false; +end +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'equation_data', ... + ['Missing or corrupted manifold_dim field detected in ' ... + 'equation structure.']); end -st = eqn.st; -if not(isfield(eqn, 'A_time')) || not(isa(eqn.A_time,'function_handle')) - error('MESS:equation_data',... - 'Empty or Corrupted field A_time detected in equation structure.'); +n_ode = eqn.manifold_dim; +if not(isfield(eqn, 'A_time')) || not(isa(eqn.A_time, 'function_handle')) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field A_time detected in equation structure.'); end A = eqn.A_time(opts.t0); if not(isnumeric(A)) - error('MESS:equation_data',... - 'Empty or Corrupted field A_time(t) detected in equation structure.'); + mess_err(opts, 'equation_data', ... + ['Empty or Corrupted field A_time(t) detected in ', ... + 'equation structure.']); end -n=size(A,1); +n = size(A, 1); if not(eqn.haveE) if isfield(eqn, 'E_time') - error('MESS:equation_data',['Detected eqn.E_time where eqn.haveE '... - 'is 0. You need to set haveE=1 or delete E_']); + mess_err(opts, 'equation_data', ... + ['Detected eqn.E_time where eqn.haveE '... + 'is 0. You need to set haveE = true or delete E_']); else - result = 1; + result = true; end else - if not(isfield(eqn, 'E_time')) || not(isa(eqn.E_time,'function_handle')) - error('MESS:equation_data',... - 'Empty or Corrupted field E_time detected in equation structure.'); + if not(isfield(eqn, 'E_time')) || not(isa(eqn.E_time, 'function_handle')) + mess_err(opts, 'equation_data', ... + ['Empty or Corrupted field E_time detected in ', ... + 'equation structure.']); end E = eqn.E_time(opts.t0); if not(isnumeric(E)) - error('MESS:equation_data',... - 'Empty or Corrupted field eqn.E_time(t) detected in equation structure.'); + mess_err(opts, 'equation_data', ... + ['Empty or Corrupted field eqn.E_time(t) detected in ', ... + 'equation structure.']); end - if (size(E,1) ~= size(E,2)) - error('MESS:error_arguments', 'field eqn.E_time(t) has to be quadratic'); + if not(size(E, 1) == size(E, 2)) + mess_err(opts, 'error_arguments', ... + 'field eqn.E_time(t) has to be quadratic'); end - if(not(issparse(E))) - warning('MESS:control_data','eqn.E_time(t) is not sparse'); + if not(issparse(E)) + mess_warn(opts, 'control_data', ... + 'eqn.E_time(t) is not sparse'); end % check size(A) == size(E)? - if (n~=size(E,1)) - error('MESS:error_arguments',... - 'dimensions of eqn.E_time(t) and eqn.A_time(t) must coincide'); + if not(n == size(E, 1)) + mess_err(opts, 'error_arguments', ... + 'dimensions of eqn.E_time(t) and eqn.A_time(t) must coincide'); end % E = [ E1 0 ] % [ 0 0 ] - if full(any([any(E(1:st, st + 1:end)), any(E(st+1:end,:))])) - warning('MESS:control_data',... - 'eqn.E_time(t) has to be non-zero only in st x st block'); + if full(any([any(E(1:n_ode, n_ode + 1:end)), any(E(n_ode + 1:end, :))])) + mess_warn(opts, 'control_data', ... + 'eqn.E_time(t) has to be non-zero only in n_ode x n_ode block'); end % result: bool; without 'full()' result: 1x1 sparse - result = 1; + result = true; end end diff --git a/usfs/dae_1/init_res_dae_1.m b/usfs/dae_1/init_res_dae_1.m index d8ca21d..51362b7 100644 --- a/usfs/dae_1/init_res_dae_1.m +++ b/usfs/dae_1/init_res_dae_1.m @@ -1,17 +1,20 @@ -function [ RHS, res0, eqn, opts, oper ] = init_res_dae_1( eqn, opts, oper, RHS) -%% function init_res initializes the low rank residual W and res0 -% function [ RHS, res0, eqn, opts, oper ] = init_res_dae_1( eqn, opts, oper, RHS) +function [W, res0, eqn, opts, oper] = ... + init_res_dae_1(eqn, opts, oper, W, T) +%% function init_res initializes the low-rank residual W and res0 +% function [ W, res0, eqn, opts, oper ] = ... +% init_res_dae_1( eqn, opts, oper, W, T) % % Input/Output: % % eqn structure containing data for G or B or C % opts structure containing parameters for the algorithm % oper struct contains function handles for operation with A and E -% RHS right hand side matrix +% W right hand side matrix +% T such that residual is W*T*W' % % Outputs: % -% RHS matrix given by ADI to compute residuum +% W matrix given by ADI to compute residuum % res0 initial residuum norm % % uses no other dae_1 function @@ -19,46 +22,48 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check data if not(isfield(opts, 'LDL_T')) - opts.LDL_T = 0; + opts.LDL_T = false; end -if opts.LDL_T && not(isfield(eqn, 'S_diag')) - error('MESS:control_data', 'eqn.S_diag required in LDL_T mode'); +if opts.LDL_T && not(isfield(eqn, 'T')) + mess_err(opts, 'control_data', 'T required in LDL_T mode'); end -if (not(isnumeric(RHS))) || (not(ismatrix(RHS))) - error('MESS:error_arguments','RHS has to ba a matrix'); +if (not(isnumeric(W))) || (not(ismatrix(W))) + mess_err(opts, 'error_arguments', 'W has to ba a matrix'); end -if not(isfield(eqn, 'st')) || not(isnumeric(eqn.st)) - error('MESS:control_data',... - 'Missing or corrupted st field detected in eqn structure.'); +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'control_data', ... + 'Missing or corrupted manifold_dim field detected in eqn structure.'); end -if (eqn.st ~= size(RHS, 1)) - error('MESS:error_arguments', ... - 'number of rows of A_ differs with number of rows of RHS'); +if not(eqn.manifold_dim == size(W, 1)) + mess_err(opts, 'error_arguments', ... + 'number of rows of A_ differs with number of rows of W'); end %% compute res0 +if not(exist('T', 'var')) && opts.LDL_T + % this means we only use init_res for potential projection + return +end if isfield(opts, 'nm') && isfield(opts.nm, 'res0') res0 = opts.nm.res0; else if opts.LDL_T if opts.norm == 2 - res0 = max(abs(eig(RHS' * RHS * diag(eqn.S_diag)))); + res0 = max(abs(eig(W' * W * T))); else - res0 = norm(eig(RHS' * RHS * diag(eqn.S_diag)), 'fro'); + res0 = norm(eig(W' * W * T), 'fro'); end else - res0 = norm(RHS' * RHS, opts.norm); + res0 = norm(W' * W, opts.norm); end end end - diff --git a/usfs/dae_1/mess_usfs_dae_1.m b/usfs/dae_1/mess_usfs_dae_1.m index 75f2e72..529b8f7 100644 --- a/usfs/dae_1/mess_usfs_dae_1.m +++ b/usfs/dae_1/mess_usfs_dae_1.m @@ -1,14 +1,14 @@ % Function Handles for structured index-1 differential-algebraic equations, % e.g., power systems examples from % https://morwiki.mpi-magdeburg.mpg.de/morwiki/index.php/Power_system_examples -% +% % Differential-Algebraic System % | E11 0 | | A11 A12 | | B1 | % | | x'(t) = | | x(t) + | | u(t), % | 0 0 | | A21 A22 | | B2 | -% +% % y(t) = | C1 C2 | x(t) -% +% % Attention, the matrices E11 and A22 need to be invertible. % The fieldnames have to end with _ to indicate that the Data are inputdata % for the Algorithm: @@ -16,15 +16,19 @@ % eqn.E_ % eqn.B % eqn.C -% -% Note that eqn.B and eqn.C are overwritten by their corresponding -% representations on the hidden manifold, i.e. in the ODE realization of +% +% The dimensions of the matrix blocks E11 and A11 above are set in +% eqn.manifold_dim. Also B1 has eqn.manifold_dim many rows and C1 +% eqn.manifold_dim many columns. +% +% Note that eqn.B and eqn.C are overwritten by their corresponding +% representations on the hidden manifold, i.e. in the ODE realization of % the system. % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % diff --git a/usfs/dae_1/mul_A_dae_1.m b/usfs/dae_1/mul_A_dae_1.m index d359a32..50a3349 100644 --- a/usfs/dae_1/mul_A_dae_1.m +++ b/usfs/dae_1/mul_A_dae_1.m @@ -1,4 +1,4 @@ -function C = mul_A_dae_1(eqn, opts, opA, B, opB)%#ok +function C = mul_A_dae_1(eqn, opts, opA, B, opB) %% function mul_A performs operation C = opA(A_)*opB(B) % % Input: @@ -19,12 +19,11 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - % A = [J1 J2; % J3 J4] J4 regular % @@ -34,57 +33,59 @@ % uses size_dae_1 %% check input Parameters -if (not(ischar(opA)) || not(ischar(opB))) - error('MESS:error_arguments', 'opA or opB is not a char'); +if not(ischar(opA)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opA or opB is not a char'); end -opA = upper(opA); opB = upper(opB); -if(not((opA == 'N' || opA == 'T'))) - error('MESS:error_arguments', 'opA is not ''N'' or ''T'''); +opA = upper(opA); +opB = upper(opB); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if(not((opB == 'N' || opB == 'T'))) - error('MESS:error_arguments', 'opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to be a matrix'); + mess_err(opts, 'error_arguments', 'B has to be a matrix'); end %% check data in eqn structure -if(not(isfield(eqn, 'A_'))) || not(isnumeric(eqn.A_)) - error('MESS:error_arguments', 'field eqn.A_ is not defined'); +if (not(isfield(eqn, 'A_'))) || not(isnumeric(eqn.A_)) + mess_err(opts, 'error_arguments', 'field eqn.A_ is not defined'); end -if not(isfield(eqn, 'st')) || not(isnumeric(eqn.st)) - error('MESS:st',... - 'Missing or Corrupted st field detected in equation structure.'); +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'error_arguments', ... + ['Missing or Corrupted manifold_dim field detected in ' ... + 'equation structure.']); end -n = size(eqn.A_,1); -st = eqn.st; -one = 1:st; -two = st + 1 : n; +n = size(eqn.A_, 1); + +one = 1:eqn.manifold_dim; +two = eqn.manifold_dim + 1:n; %% perform multiplication switch opA case 'N' switch opB - %implement operation A_*B + % implement operation A_*B case 'N' - if(st > size(B,1)) - error('MESS:error_arguments', ... - 'number of cols of A_ differs with rows of B'); + if eqn.manifold_dim > size(B, 1) + mess_err(opts, 'error_arguments', ... + 'number of cols of A_ differs with rows of B'); end C = eqn.A_(one, one) * B - eqn.A_(one, two) * ... (eqn.A_(two, two) \ (eqn.A_(two, one) * B)); - %implement operation A_*B' + % implement operation A_*B' case 'T' - if(st > size(B, 2)) - error('MESS:error_arguments', ... - 'number of cols of A_ differs with cols of B'); + if eqn.manifold_dim > size(B, 2) + mess_err(opts, 'error_arguments', ... + 'number of cols of A_ differs with cols of B'); end C = eqn.A_(one, one) * B' - eqn.A_(one, two) * ... (eqn.A_(two, two) \ (eqn.A_(two, one) * B')); @@ -93,24 +94,24 @@ case 'T' switch opB - %implement operation A_'*B + % implement operation A_'*B case 'N' - if(st > size(B, 1)) - error('MESS:error_arguments', ... - 'number of rows of A_ differs with rows of B'); + if eqn.manifold_dim > size(B, 1) + mess_err(opts, 'error_arguments', ... + 'number of rows of A_ differs with rows of B'); end C = eqn.A_(one, one)' * B - eqn.A_(two, one)' * ... (eqn.A_(two, two)' \ (eqn.A_(one, two)' * B)); - %implement operatio A_'*B' + % implement operatio A_'*B' case 'T' - if(st > size(B, 2)) - error('MESS:error_arguments', ... - 'number of rows of A_ differs with cols of B'); + if eqn.manifold_dim > size(B, 2) + mess_err(opts, 'error_arguments', ... + 'number of rows of A_ differs with cols of B'); end C = eqn.A_(one, one)' * B' - ... eqn.A_(two, one)' * (eqn.A_(two, two)' \ ... - (eqn.A_(one, two)' * B')); + (eqn.A_(one, two)' * B')); end end diff --git a/usfs/dae_1/mul_ApE_dae_1.m b/usfs/dae_1/mul_ApE_dae_1.m index 91a1ee5..af473a8 100644 --- a/usfs/dae_1/mul_ApE_dae_1.m +++ b/usfs/dae_1/mul_ApE_dae_1.m @@ -1,4 +1,4 @@ -function C = mul_ApE_dae_1(eqn, opts, opA, p, opE, B, opB)%#ok +function C = mul_ApE_dae_1(eqn, opts, opA, p, opE, B, opB) %% function mul_A performs operation C = (opA(A_)+pc*opE(E_))*opB(B) % % Input: @@ -24,62 +24,66 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input Parameters -if (not(ischar(opA)) || not(ischar(opB)) || not(ischar(opE))) - error('MESS:error_arguments', 'opA, opB or opE is not a char'); +if not(ischar(opA)) || not(ischar(opB)) || not(ischar(opE)) + mess_err(opts, 'error_arguments', 'opA, opB or opE is not a char'); end -opA = upper(opA); opB = upper(opB); opE = upper(opE); +opA = upper(opA); +opB = upper(opB); +opE = upper(opE); -if(not((opA == 'N' || opA == 'T'))) - error('MESS:error_arguments','opA is not ''N'' or ''T'''); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if(not((opB == 'N' || opB == 'T'))) - error('MESS:error_arguments','opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end -if(not((opE == 'N' || opE == 'T'))) - error('MESS:error_arguments','opE is not ''N'' or ''T'''); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end -if(not(isnumeric(p))) - error('MESS:error_arguments','p is not numeric'); +if not(isnumeric(p)) + mess_err(opts, 'error_arguments', 'p is not numeric'); end -if not(isfield(eqn, 'haveE')), eqn.haveE = 0; end +if not(isfield(eqn, 'haveE')) + eqn.haveE = false; +end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -if(eqn.haveE ==1) - if(not(isfield(eqn,'E_')) || not(isnumeric(eqn.E_))... - || not(isfield(eqn,'A_'))) || not(isnumeric(eqn.A_)) - error('MESS:error_arguments', ... - 'field eqn.E_ or eqn.A_ is not defined or corrupted'); +if eqn.haveE + if (not(isfield(eqn, 'E_')) || not(isnumeric(eqn.E_)) || ... + not(isfield(eqn, 'A_'))) || not(isnumeric(eqn.A_)) + mess_err(opts, 'error_arguments', ... + 'field eqn.E_ or eqn.A_ is not defined or corrupted'); end else - if(not(isfield(eqn,'A_'))) || not(isnumeric(eqn.A_)) - error('MESS:error_arguments', ... - 'field eqn.A_ is not defined'); + if (not(isfield(eqn, 'A_'))) || not(isnumeric(eqn.A_)) + mess_err(opts, 'error_arguments', ... + 'field eqn.A_ is not defined'); end end -if not(isfield(eqn, 'st')) || not(isnumeric(eqn.st)) - error('MESS:st',... - 'Missing or Corrupted st field detected in equation structure.'); +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'equation_data', ... + ['Missing or corrupted manifold_dim field detected in ' ... + 'equation structure.']); end -n = size(eqn.A_,1); -st = eqn.st; -one = 1:st; -two = st + 1 : n; +n = size(eqn.A_, 1); + +one = 1:eqn.manifold_dim; +two = eqn.manifold_dim + 1:n; %% perform multiplication switch opA @@ -88,48 +92,52 @@ case 'N' switch opB - %implement operation A_*B + % implement operation A_*B case 'N' - if(st > size(B,1)) - error('MESS:error_arguments', ... - 'number of cols of A_ differs with rows of B'); + if eqn.manifold_dim > size(B, 1) + mess_err(opts, 'error_arguments', ... + ['number of cols of A_ differs ' ... + 'from rows of B']); end - C = (eqn.A_(one, one) + p * eqn.E_(one, one)) * B ... - - eqn.A_(one, two) * (eqn.A_(two, two) \ ... - (eqn.A_(two, one) * B)); + C = (eqn.A_(one, one) + p * eqn.E_(one, one)) * B - ... + eqn.A_(one, two) * (eqn.A_(two, two) \ ... + (eqn.A_(two, one) * B)); - %implement operation A_*B' + % implement operation A_*B' case 'T' - if(st > size(B, 2)) - error('MESS:error_arguments', ... - 'number of cols of A_ differs with cols of B'); + if eqn.manifold_dim > size(B, 2) + mess_err(opts, 'error_arguments', ... + ['number of cols of A_ differs ' ... + 'from cols of B']); end - C = (eqn.A_(one, one) + p * eqn.E_(one, one)) * B' ... - - eqn.A_(one, two) * (eqn.A_(two, two) \ ... - (eqn.A_(two, one) * B')); + C = (eqn.A_(one, one) + p * eqn.E_(one, one)) * B' - ... + eqn.A_(one, two) * (eqn.A_(two, two) \ ... + (eqn.A_(two, one) * B')); end case 'T' switch opB - %implement operation A_*B + % implement operation A_*B case 'N' - if(st > size(B,1)) - error('MESS:error_arguments', ... - 'number of cols of A_ differs with rows of B'); + if eqn.manifold_dim > size(B, 1) + mess_err(opts, 'error_arguments', ... + ['number of cols of A_ differs ' ... + 'from rows of B']); end - C = (eqn.A_(one, one) + p * eqn.E_(one, one)') * B ... - - eqn.A_(one, two) * (eqn.A_(two, two) \ ... - (eqn.A_(two, one) * B)); + C = (eqn.A_(one, one) + p * eqn.E_(one, one)') * B - ... + eqn.A_(one, two) * (eqn.A_(two, two) \ ... + (eqn.A_(two, one) * B)); - %implement operation A_*B' + % implement operation A_*B' case 'T' - if(st > size(B, 2)) - error('MESS:error_arguments', ... - 'number of cols of A_ differs with cols of B'); + if eqn.manifold_dim > size(B, 2) + mess_err(opts, 'error_arguments', ... + ['number of cols of A_ differs ' ... + 'from cols of B']); end - C = (eqn.A_(one, one) + p * eqn.E_(one, one)') * B'... - - eqn.A_(one, two) * (eqn.A_(two, two) \ ... - (eqn.A_(two, one) * B')); + C = (eqn.A_(one, one) + p * eqn.E_(one, one)') * ... + B' - eqn.A_(one, two) * (eqn.A_(two, two) \ ... + (eqn.A_(two, one) * B')); end end @@ -138,51 +146,52 @@ case 'N' switch opB - %implement operation A_'*B + % implement operation A_'*B case 'N' - if(st > size(B, 1)) - error('MESS:error_arguments', ... - 'number of rows of A_ differs with rows of B'); + if eqn.manifold_dim > size(B, 1) + mess_err(opts, 'error_arguments', ... + ['number of rows of A_ differs ' ... + 'with rows of B']); end - C = (eqn.A_(one, one)' + p * eqn.E_(one, one)) * B ... - - eqn.A_(two, one)' * (eqn.A_(two, two)' \ ... - (eqn.A_(one, two)' * B)); + C = (eqn.A_(one, one)' + p * eqn.E_(one, one)) * B - ... + eqn.A_(two, one)' * (eqn.A_(two, two)' \ ... + (eqn.A_(one, two)' * B)); - %implement operatio A_'*B' + % implement operatio A_'*B' case 'T' - if(st > size(B, 2)) - error('MESS:error_arguments', ... - 'number of rows of A_ differs with cols of B'); + if eqn.manifold_dim > size(B, 2) + mess_err(opts, 'error_arguments', ... + ['number of rows of A_ differs ' ... + 'with cols of B']); end - C = (eqn.A_(one, one)' + p * eqn.E_(one, one)) * B'... - - eqn.A_(two, one)' ... - * (eqn.A_(two, two)' \ (eqn.A_(one, two)' ... - * B')); + C = (eqn.A_(one, one)' + p * eqn.E_(one, one)) * ... + B' - eqn.A_(two, one)' * ... + (eqn.A_(two, two)' \ (eqn.A_(one, two)' * B')); end case 'T' switch opB - %implement operation A_'*B + % implement operation A_'*B case 'N' - if(st > size(B, 1)) - error('MESS:error_arguments', ... - 'number of rows of A_ differs with rows of B'); + if eqn.manifold_dim > size(B, 1) + mess_err(opts, 'error_arguments', ... + ['number of rows of A_ differs ' ... + 'with rows of B']); end - C = (eqn.A_(one, one)' + p * eqn.E_(one, one)') * B ... - - eqn.A_(two, one)' ... - * (eqn.A_(two, two)' \ (eqn.A_(one, two)' ... - * B)); + C = (eqn.A_(one, one)' + p * eqn.E_(one, one)') * ... + B - eqn.A_(two, one)' * ... + (eqn.A_(two, two)' \ (eqn.A_(one, two)' * B)); - %implement operatio A_'*B' + % implement operatio A_'*B' case 'T' - if(st > size(B, 2)) - error('MESS:error_arguments', ... - 'number of rows of A_ differs with cols of B'); + if eqn.manifold_dim > size(B, 2) + mess_err(opts, 'error_arguments', ... + ['number of rows of A_ differs ' ... + 'with cols of B']); end - C = (eqn.A_(one, one)' + p * eqn.E_(one, one)') * B' ... - - eqn.A_(two, one)' ... - * (eqn.A_(two, two)' \ (eqn.A_(one, two)' ... - * B')); + C = (eqn.A_(one, one)' + p * eqn.E_(one, one)') * ... + B' - eqn.A_(two, one)' * ... + (eqn.A_(two, two)' \ (eqn.A_(one, two)' * B')); end end diff --git a/usfs/dae_1/mul_ApE_post_dae_1.m b/usfs/dae_1/mul_ApE_post_dae_1.m index bcbcd52..382b6a2 100644 --- a/usfs/dae_1/mul_ApE_post_dae_1.m +++ b/usfs/dae_1/mul_ApE_post_dae_1.m @@ -4,11 +4,11 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % if not(eqn.haveE) - eqn = fake_E_clean(eqn); -end \ No newline at end of file + eqn = fake_E_clean_dae_1(eqn); +end diff --git a/usfs/dae_1/mul_ApE_pre_dae_1.m b/usfs/dae_1/mul_ApE_pre_dae_1.m index 67d8a5d..f5251d2 100644 --- a/usfs/dae_1/mul_ApE_pre_dae_1.m +++ b/usfs/dae_1/mul_ApE_pre_dae_1.m @@ -5,11 +5,11 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % if not(eqn.haveE) - eqn = fake_E(eqn); -end \ No newline at end of file + eqn = fake_E_dae_1(eqn); +end diff --git a/usfs/dae_1/mul_E_dae_1.m b/usfs/dae_1/mul_E_dae_1.m index 0b9f963..dc41813 100644 --- a/usfs/dae_1/mul_E_dae_1.m +++ b/usfs/dae_1/mul_E_dae_1.m @@ -1,4 +1,4 @@ -function C = mul_E_dae_1(eqn, opts, opE, B, opB)%#ok +function C = mul_E_dae_1(eqn, opts, opE, B, opB) %% function mul_A performs operation C = opE(E_)*opB(B) % @@ -25,57 +25,60 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input Parameters if not(ischar(opE)) || not(ischar(opB)) - error('MESS:error_arguments', 'opE or opB is not a char'); + mess_err(opts, 'error_arguments', 'opE or opB is not a char'); end -opE = upper(opE); opB = upper(opB); +opE = upper(opE); +opB = upper(opB); if not(opE == 'N' || opE == 'T') - error('MESS:error_arguments', 'opE is not ''N'' or ''T'''); + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end if not(opB == 'N' || opB == 'T') - error('MESS:error_arguments', 'opB is not ''N'' or ''T'''); + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if not(isnumeric(B)) || not(ismatrix(B)) - error('MESS:error_arguments', 'B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure if not(isfield(eqn, 'E_')) || not(isnumeric(eqn.E_)) - error('MESS:error_arguments', ... - 'Missing or Corrupted E_ field detected in equation structure.'); + mess_err(opts, 'error_arguments', ... + 'Missing or Corrupted E_ field detected in equation structure.'); end -if not(isfield(eqn, 'st')) || not(isnumeric(eqn.st)) - error('MESS:st',... - 'Missing or Corrupted st field detected in equation structure.'); +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'error_arguments', ... + ['Missing or corrupted manifold_dim field detected in ' ... + 'equation structure.']); end -st = eqn.st; -one = 1:st; +one = 1:eqn.manifold_dim; + %% perform multiplication switch opE case 'N' switch opB - %implement operation E_*B + % implement operation E_*B case 'N' - if(st ~= size(B, 1)) - error('MESS:error_arguments','number of cols of E_ differs with rows of B'); + if not(eqn.manifold_dim == size(B, 1)) + mess_err(opts, 'error_arguments', ... + 'number of cols of E_ differs with rows of B'); end C = eqn.E_(one, one) * B; - %implement operation E_*B' + % implement operation E_*B' case 'T' - if(st ~= size(B, 2)) - error('MESS:error_arguments','number of cols of E_ differs with cols of B'); + if not(eqn.manifold_dim == size(B, 2)) + mess_err(opts, 'error_arguments', ... + 'number of cols of E_ differs with cols of B'); end C = eqn.E_(one, one) * B'; end @@ -83,17 +86,19 @@ case 'T' switch opB - %implement operation E_'*B + % implement operation E_'*B case 'N' - if(st ~= size(B, 1)) - error('MESS:error_arguments','number of rows of E_ differs with rows of B'); + if not(eqn.manifold_dim == size(B, 1)) + mess_err(opts, 'error_arguments', ... + 'number of rows of E_ differs with rows of B'); end C = eqn.E_(one, one)' * B; - %implement operatio E_'*B' + % implement operatio E_'*B' case 'T' - if(st ~= size(B, 2)) - error('MESS:error_arguments','number of rows of E_ differs with cols of B'); + if not(eqn.manifold_dim == size(B, 2)) + mess_err(opts, 'error_arguments', ... + 'number of rows of E_ differs with cols of B'); end C = eqn.E_(one, one)' * B'; end diff --git a/usfs/dae_1/private/fake_E.m b/usfs/dae_1/private/fake_E.m deleted file mode 100644 index a24cda7..0000000 --- a/usfs/dae_1/private/fake_E.m +++ /dev/null @@ -1,9 +0,0 @@ -function eqn = fake_E(eqn) -if not(isfield(eqn,'Ecount')) - eqn.Ecount = 1; - % E = [ I 0 ] - % [ 0 0 ] - eqn.E_=sparse(1:st,1:st,ones(st, 1),n,n,st); -else - eqn.Ecount = eqn.Ecount + 1; -end diff --git a/usfs/dae_1/private/fake_E_clean.m b/usfs/dae_1/private/fake_E_clean.m deleted file mode 100644 index 56fb828..0000000 --- a/usfs/dae_1/private/fake_E_clean.m +++ /dev/null @@ -1,6 +0,0 @@ -function eqn = fake_E_clean(eqn) -if eqn.Ecount > 1 - eqn.Ecount = eqn.Ecount -1; -else - eqn = rmfield(eqn,{'E_','Ecount'}); -end \ No newline at end of file diff --git a/usfs/dae_1/private/fake_E_clean_dae_1.m b/usfs/dae_1/private/fake_E_clean_dae_1.m new file mode 100644 index 0000000..bb315ae --- /dev/null +++ b/usfs/dae_1/private/fake_E_clean_dae_1.m @@ -0,0 +1,16 @@ +function eqn = fake_E_clean_dae_1(eqn) +% FAKE_E_CLEAN_DAE_1 removes the dummy eqn.E_ + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +if eqn.Ecount > 1 + eqn.Ecount = eqn.Ecount - 1; +else + eqn = rmfield(eqn, {'E_', 'Ecount'}); +end diff --git a/usfs/dae_1/private/fake_E_dae_1.m b/usfs/dae_1/private/fake_E_dae_1.m new file mode 100644 index 0000000..9681154 --- /dev/null +++ b/usfs/dae_1/private/fake_E_dae_1.m @@ -0,0 +1,23 @@ +function eqn = fake_E_dae_1(eqn) +% FAKE_E_DAE_1 adds a dummy eqn.E_, for later reference in ApE +% routines, when "haveE" is 'false'. + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +if not(isfield(eqn, 'Ecount')) + eqn.Ecount = 1; + % E = [ I 0 ] + % [ 0 0 ] + eqn.E_ = sparse(1:eqn.manifold_dim, ... + 1:eqn.manifold_dim, ... + ones(eqn.manifold_dim, 1), ... + n, n, eqn.manifold_dim); +else + eqn.Ecount = eqn.Ecount + 1; +end diff --git a/usfs/dae_1/size_dae_1.m b/usfs/dae_1/size_dae_1.m index 563903c..b5f0d1e 100644 --- a/usfs/dae_1/size_dae_1.m +++ b/usfs/dae_1/size_dae_1.m @@ -1,4 +1,4 @@ -function n = size_dae_1(eqn, opts, oper)%#ok +function n = size_dae_1(eqn, opts, oper) %#ok % function n = size_dae_1(eqn, opts, oper) % % This function returns the number of rows of matrix A in the Schur @@ -20,17 +20,17 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - -if not(isfield(eqn, 'st')) || not(isnumeric(eqn.st)) - error('MESS:st',... - 'Missing or Corrupted st field detected in equation structure.'); +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'equation_data', ... + ['Missing or corrupted manifold_dim field detected in ' ... + 'equation structure.']); end -n = eqn.st; +n = eqn.manifold_dim; end diff --git a/usfs/dae_1/sol_A_dae_1.m b/usfs/dae_1/sol_A_dae_1.m index e6ee5a6..de4f9bc 100644 --- a/usfs/dae_1/sol_A_dae_1.m +++ b/usfs/dae_1/sol_A_dae_1.m @@ -1,4 +1,4 @@ -function X = sol_A_dae_1(eqn, opts, opA, B, opB)%#ok +function X = sol_A_dae_1(eqn, opts, opA, B, opB) % function sol_A solves solves opA(A_)*X = opB(B) % % Input: @@ -22,57 +22,57 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - - %% check input Parameters -if (not(ischar(opA)) || not(ischar(opB))) - error('MESS:error_arguments', 'opA or opB is not a char'); +if not(ischar(opA)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opA or opB is not a char'); end -opA = upper(opA); opB = upper(opB); -if(not((opA == 'N' || opA == 'T'))) - error('MESS:error_arguments','opA is not ''N'' or ''T'''); +opA = upper(opA); +opB = upper(opB); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if(not((opB == 'N' || opB == 'T'))) - error('MESS:error_arguments','opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -if(not(isfield(eqn, 'A_'))) || not(isnumeric(eqn.A_)) - error('MESS:error_arguments', 'field eqn.A_ is not defined'); +if (not(isfield(eqn, 'A_'))) || not(isnumeric(eqn.A_)) + mess_err(opts, 'error_arguments', 'field eqn.A_ is not defined'); end -if not(isfield(eqn, 'st')) || not(isnumeric(eqn.st)) - error('MESS:st',... - 'Missing or corrupted st field detected in equation structure.'); +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'error_arguments', ... + ['Missing or corrupted manifold_dim field detected in ' ... + 'equation structure.']); end -n = size(eqn.A_,1); -st = eqn.st; -[rowB,colB] = size(B); +n = size(eqn.A_, 1); +manifold_dim = eqn.manifold_dim; +[rowB, colB] = size(B); -if(opB == 'N') - if(n > rowB) - B = [B; - zeros(n - st, colB)]; +if opB == 'N' + if n > rowB + B = [B + zeros(n - manifold_dim, colB)]; elseif n < rowB - error('MESS:error_arguments', 'B has more rows than A'); + mess_err(opts, 'error_arguments', 'B has more rows than A'); end else - if(n > colB) - B = [B, zeros(rowB, n - st)]; + if n > colB + B = [B, zeros(rowB, n - manifold_dim)]; elseif n < colB - error('MESS:error_arguments', 'B has more columns than A'); + mess_err(opts, 'error_arguments', 'B has more columns than A'); end end @@ -82,19 +82,19 @@ case 'N' switch opB - %implement solve A_*X=B + % implement solve A_*X=B case 'N' - if(n ~= size(B, 1)) - error('MESS:error_arguments', ... - 'number of rows of A_ differs with rows of B'); + if not(n == size(B, 1)) + mess_err(opts, 'error_arguments', ... + 'number of rows of A_ differs with rows of B'); end X = eqn.A_ \ B; - %implement solve A_*X=B' + % implement solve A_*X=B' case 'T' - if(n ~= size(B, 2)) - error('MESS:error_arguments', ... - 'number of rows of A_ differs with cols of B'); + if not(n == size(B, 2)) + mess_err(opts, 'error_arguments', ... + 'number of rows of A_ differs with cols of B'); end X = eqn.A_ \ B'; end @@ -102,23 +102,23 @@ case 'T' switch opB - %implement solve A_'*X=B + % implement solve A_'*X=B case 'N' - if(n ~= size(B, 1)) - error('MESS:error_arguments', ... - 'number of cols of A_ differs with rows of B'); + if not(n == size(B, 1)) + mess_err(opts, 'error_arguments', ... + 'number of cols of A_ differs with rows of B'); end X = eqn.A_' \ B; - %implement solve A_'*X=B' + % implement solve A_'*X=B' case 'T' - if(n ~= size(B, 2)) - error('MESS:error_arguments', ... - 'number of cols of A_ differs with cols of B'); + if not(n == size(B, 2)) + mess_err(opts, 'error_arguments', ... + 'number of cols of A_ differs with cols of B'); end X = eqn.A_' \ B'; end end -X = X(1 : st, :); +X = X(1:manifold_dim, :); end diff --git a/usfs/dae_1/sol_ApE_dae_1.m b/usfs/dae_1/sol_ApE_dae_1.m index 5d4d852..e287a34 100644 --- a/usfs/dae_1/sol_ApE_dae_1.m +++ b/usfs/dae_1/sol_ApE_dae_1.m @@ -1,4 +1,4 @@ -function X = sol_ApE_dae_1(eqn, opts, opA, p, opE, B, opB)%#ok +function X = sol_ApE_dae_1(eqn, opts, opA, p, opE, B, opB) %% function sol_ApE solves % (opA(A_) + p*opE(E_))*X = opB(B) @@ -37,78 +37,89 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input Parameters -if (not(ischar(opA)) || not(ischar(opE)) || not(ischar(opB))) - error('MESS:error_arguments', 'opA, opE or opB is not a char'); +if not(ischar(opA)) || not(ischar(opE)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opA, opE or opB is not a char'); end -opA = upper(opA); opE = upper(opE); opB = upper(opB); +opA = upper(opA); +opE = upper(opE); +opB = upper(opB); -if(not((opA == 'N' || opA == 'T'))) - error('MESS:error_arguments', 'opA is not ''N'' or ''T'''); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', ... + 'opA is not ''N'' or ''T'''); end -if(not((opE == 'N' || opE == 'T'))) - error('MESS:error_arguments', 'opE is not ''N'' or ''T'''); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', ... + 'opE is not ''N'' or ''T'''); end -if(not((opB == 'N' || opB == 'T'))) - error('MESS:error_arguments', 'opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', ... + 'opB is not ''N'' or ''T'''); end -if(not(isnumeric(p))) - error('MESS:error_arguments','p is not numeric'); +if not(isnumeric(p)) + mess_err(opts, 'error_arguments', ... + 'p is not numeric'); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', ... + 'B has to ba a matrix'); end %% check data in eqn structure -if not(isfield(eqn, 'haveE')), eqn.haveE = 0; end -if(eqn.haveE) - if(not(isfield(eqn,'E_')) || not(isnumeric(eqn.E_))... - || not(isfield(eqn,'A_'))) || not(isnumeric(eqn.A_)) - error('MESS:error_arguments','field eqn.E_ or eqn.A_ is not defined or corrupted'); +if not(isfield(eqn, 'haveE')) + eqn.haveE = false; +end +if eqn.haveE + if (not(isfield(eqn, 'E_')) || not(isnumeric(eqn.E_)) || ... + not(isfield(eqn, 'A_'))) || not(isnumeric(eqn.A_)) + mess_err(opts, 'error_arguments', ... + 'field eqn.E_ or eqn.A_ is not defined or corrupted'); end else - if(not(isfield(eqn,'A_'))) || not(isnumeric(eqn.A_)) - error('MESS:error_arguments','field eqn.A_ is not defined'); + if (not(isfield(eqn, 'A_'))) || not(isnumeric(eqn.A_)) + mess_err(opts, 'error_arguments', ... + 'field eqn.A_ is not defined'); end end -if not(isfield(eqn, 'st')) || not(isnumeric(eqn.st)) - error('MESS:st',... - 'Missing or Corrupted st field detected in equation structure.'); +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'error_arguments', ... + ['Missing or corrupted manifold_dim field detected in ' ... + 'equation structure.']); end -n = size(eqn.A_,1); -st = eqn.st; -[rowB,colB] = size(B); +n = size(eqn.A_, 1); +n_ode = eqn.manifold_dim; +[rowB, colB] = size(B); -if(opB == 'N') - if (rowB ~= st) - error('MESS:error_arguments', 'B has not same number of rows as A'); - end - B = [B; - zeros(n - st, colB)]; +if opB == 'N' + if not(rowB == n_ode) + mess_err(opts, 'error_arguments', ... + 'B has not same number of rows as A'); + end + B = [B + zeros(n - n_ode, colB)]; else - if (colB ~= st) - error('MESS:error_arguments', 'B has not same number of rows as A'); - end - B = [B, zeros(rowB, n - st)]; + if not(colB == n_ode) + mess_err(opts, 'error_arguments', ... + 'B has not same number of rows as A'); + end + B = [B, zeros(rowB, n - n_ode)]; end - - %% perform solve operations for E_ = [ E 0 ] % [ 0 0 ] -if(eqn.haveE == 1) +if eqn.haveE switch opA case 'N' @@ -118,11 +129,11 @@ switch opB - %implement solve (A_+p*E_)*X=B + % implement solve (A_+p*E_)*X=B case 'N' X = (eqn.A_ + p * eqn.E_) \ B; - %implement solve (A_+p*E_)*X=B' + % implement solve (A_+p*E_)*X=B' case 'T' X = (eqn.A_ + p * eqn.E_) \ B'; @@ -132,11 +143,11 @@ switch opB - %implement solve (A_+p*E_')*X=B + % implement solve (A_+p*E_')*X=B case 'N' X = (eqn.A_ + p * eqn.E_') \ B; - %implement solve (A_+p*E_')*X=B' + % implement solve (A_+p*E_')*X=B' case 'T' X = (eqn.A_ + p * eqn.E_') \ B'; @@ -151,11 +162,11 @@ switch opB - %implement solve (A_'+p*E_)*X=B + % implement solve (A_'+p*E_)*X=B case 'N' X = (eqn.A_' + p * eqn.E_) \ B; - %implement solve (A_'+p*E_)*X=B' + % implement solve (A_'+p*E_)*X=B' case 'T' X = (eqn.A_' + p * eqn.E_) \ B'; @@ -165,11 +176,11 @@ switch opB - %implement solve (A_'+p*E_')*X=B + % implement solve (A_'+p*E_')*X=B case 'N' X = (eqn.A_' + p * eqn.E_') \ B; - %implement solve (A_'+p*E_')*X=B' + % implement solve (A_'+p*E_')*X=B' case 'T' X = (eqn.A_' + p * eqn.E_') \ B'; @@ -177,7 +188,7 @@ end end -elseif(eqn.haveE == 0) +elseif not(eqn.haveE) %% perform solve operations for E_ = [ I 0 ] % [ 0 0 ] switch opA @@ -186,11 +197,11 @@ switch opB - %implement solve (A_+p*E_)*X=B + % implement solve (A_+p*E_)*X=B case 'N' X = (eqn.A_ + p * eqn.E_) \ B; - %implement solve (A_+p*E_)*X=B' + % implement solve (A_+p*E_)*X=B' case 'T' X = (eqn.A_ + p * eqn.E_) \ B'; @@ -200,11 +211,11 @@ switch opB - %implement solve (A_'+p*E_)*X=B + % implement solve (A_'+p*E_)*X=B case 'N' X = (eqn.A_' + p * eqn.E_) \ B; - %implement solve (A_'+p*E_)*X=B' + % implement solve (A_'+p*E_)*X=B' case 'T' X = (eqn.A_' + p * eqn.E_) \ B'; @@ -212,6 +223,5 @@ end end -X = X(1 : st, :); +X = X(1:n_ode, :); end - diff --git a/usfs/dae_1/sol_ApE_post_dae_1.m b/usfs/dae_1/sol_ApE_post_dae_1.m index 698bb1c..15525aa 100644 --- a/usfs/dae_1/sol_ApE_post_dae_1.m +++ b/usfs/dae_1/sol_ApE_post_dae_1.m @@ -4,11 +4,11 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % if not(eqn.haveE) - eqn = fake_E_clean(eqn); -end \ No newline at end of file + eqn = fake_E_clean_dae_1(eqn); +end diff --git a/usfs/dae_1/sol_ApE_pre_dae_1.m b/usfs/dae_1/sol_ApE_pre_dae_1.m index ee2f6c8..99602ab 100644 --- a/usfs/dae_1/sol_ApE_pre_dae_1.m +++ b/usfs/dae_1/sol_ApE_pre_dae_1.m @@ -5,11 +5,11 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % if not(eqn.haveE) - eqn = fake_E(eqn); -end \ No newline at end of file + eqn = fake_E_dae_1(eqn); +end diff --git a/usfs/dae_1/sol_E_dae_1.m b/usfs/dae_1/sol_E_dae_1.m index b825ac4..09511cc 100644 --- a/usfs/dae_1/sol_E_dae_1.m +++ b/usfs/dae_1/sol_E_dae_1.m @@ -1,4 +1,4 @@ -function X = sol_E_dae_1(eqn, opts, opE, B, opB) %#ok +function X = sol_E_dae_1(eqn, opts, opE, B, opB) %% function sol_E_dae_1 solves opE(E)*X = opB(B) resp. performs X=opE(E)\opB(B) % % Input: @@ -25,38 +25,41 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % %% check input Parameters -if (not(ischar(opE)) || not(ischar(opB))) - error('MESS:error_arguments', 'opE or opB is not a char'); +if not(ischar(opE)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opE or opB is not a char'); end -opE = upper(opE); opB = upper(opB); -if(not((opE == 'N' || opE == 'T'))) - error('MESS:error_arguments','opE is not ''N'' or ''T'''); +opE = upper(opE); +opB = upper(opB); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end -if(not((opB == 'N' || opB == 'T'))) - error('MESS:error_arguments','opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -if(not(isfield(eqn, 'E_'))) || not(isnumeric(eqn.E_)) - error('MESS:error_arguments', 'field eqn.E_ is not defined'); +if (not(isfield(eqn, 'E_'))) || not(isnumeric(eqn.E_)) + mess_err(opts, 'error_arguments', 'field eqn.E_ is not defined'); end -if not(isfield(eqn, 'st')) || not(isnumeric(eqn.st)) - error('MESS:st',... - 'Missing or Corrupted st field detected in equation structure.'); +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'error_arguments', ... + ['Missing or Corrupted manifold_dim field detected in ' ... + 'equation structure.']); end -st = eqn.st; + +one = 1:eqn.manifold_dim; %% solve switch opE @@ -64,37 +67,41 @@ case 'N' switch opB - %implement solve A_*X=B + % implement solve A_*X=B case 'N' - if(st ~= size(B, 1)) - error('MESS:error_arguments','number of rows of A_ differs with rows of B'); + if not(eqn.manifold_dim == size(B, 1)) + mess_err(opts, 'error_arguments', ... + 'number of rows of A_ differs with rows of B'); end - X = eqn.E_(1 : st, 1 : st) \ B; + X = eqn.E_(one, one) \ B; - %implement solve A_*X=B' + % implement solve A_*X=B' case 'T' - if(st ~= size(B, 2)) - error('MESS:error_arguments','number of rows of A_ differs with cols of B'); + if not(eqn.manifold_dim == size(B, 2)) + mess_err(opts, 'error_arguments', ... + 'number of rows of A_ differs with cols of B'); end - X = eqn.E_(1 : st, 1 : st) \ B'; + X = eqn.E_(one, one) \ B'; end case 'T' switch opB - %implement solve A_'*X=B + % implement solve A_'*X=B case 'N' - if(st ~= size(B, 1)) - error('MESS:error_arguments','number of cols of A_ differs with rows of B'); + if not(eqn.manifold_dim == size(B, 1)) + mess_err(opts, 'error_arguments', ... + 'number of cols of A_ differs with rows of B'); end - X = eqn.E_(1 : st, 1 : st)' \ B; + X = eqn.E_(one, one)' \ B; - %implement solve A_'*X=B' + % implement solve A_'*X=B' case 'T' - if(st ~= size(B, 2)) - error('MESS:error_arguments','number of cols of A_ differs with cols of B'); + if not(eqn.manifold_dim == size(B, 2)) + mess_err(opts, 'error_arguments', ... + 'number of cols of A_ differs with cols of B'); end - X = eqn.E_(1 : st, 1 : st)' \ B'; + X = eqn.E_(one, one)' \ B'; end end diff --git a/usfs/dae_1_so/get_ritz_vals_dae_1_so.m b/usfs/dae_1_so/get_ritz_vals_dae_1_so.m index 580f3d4..9f3fd78 100644 --- a/usfs/dae_1_so/get_ritz_vals_dae_1_so.m +++ b/usfs/dae_1_so/get_ritz_vals_dae_1_so.m @@ -1,6 +1,8 @@ -function [rw, Hp, Hm, Vp, Vm] = get_ritz_vals_dae_1_so(eqn, opts, oper, U, W, p_old) -% [rw, Hp, Hm, Vp, Vm] = get_ritz_vals_dae_1_so(eqn, opts, oper, U, W, p_old) -% +function [rw, Hp, Hm, Vp, Vm, eqn, opts, oper] = ... + get_ritz_vals_dae_1_so(eqn, opts, oper, U, W, p_old) +% [rw, Hp, Hm, Vp, Vm, eqn, opts, oper] = ... +% get_ritz_vals_dae_1_so(eqn, opts, oper, U, W, p_old) +% % Wrapper for the special system structure around mess_get_ritz_vals. % Additionally due to the second order structure, the real value % opts.shifts.truncate can be set to remove any computed values that are @@ -8,21 +10,18 @@ % % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - % Input data not completely checked! -% if(not(isfield(eqn,'A_'))) || not(isnumeric(eqn.A_)) -% error('MESS:error_arguments','field eqn.A_ is not defined'); -% end -[result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A','E'); +[result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A', 'E'); if not(result) - error('MESS:control_data', 'system data is not completely defined or corrupted'); + mess_err(opts, 'control_data', ... + 'system data is not completely defined or corrupted'); end n = oper.size(eqn, opts); @@ -31,25 +30,33 @@ if isfield(opts.shifts, 'method') && ... strcmp(opts.shifts.method, 'projection') if isempty(W) - % first shifts are computed with U = eqn.G and W = A * eqn.G + % first shifts are computed with U = eqn.W and W = A * eqn.W W = oper.mul_A(eqn, opts, eqn.type, U, 'N'); + if isfield(eqn, 'haveUV') && eqn.haveUV + switch eqn.type + case 'N' + W = W + eqn.U * (eqn.V' * U); + case 'T' + W = W + eqn.V * (eqn.U' * U); + end + end end rw = mess_projection_shifts(eqn, opts, oper, U, W, p_old); else - if (not(isfield(opts.shifts, 'b0')) || isempty(opts.shifts.b0)) - opts.shifts.b0 = ones(n,1); + if not(isfield(opts.shifts, 'b0')) || isempty(opts.shifts.b0) + opts.shifts.b0 = ones(n, 1); else - if length(opts.shifts.b0) ~= n - warning('MESS:b0',... - 'b0 has the wrong length. Switching to default.'); - opts.shifts.b0 = ones(n,1); + if not(length(opts.shifts.b0) == n) + mess_warn(opts, 'b0', ... + 'b0 has the wrong length. Switching to default.'); + opts.shifts.b0 = ones(n, 1); end end [rw, Hp, Hm, Vp, Vm] = mess_get_ritz_vals(eqn, opts, oper); end % -% remove Ritz values that are too large or too small if desired -if isfield(opts.shifts,'truncate') && isnumeric(opts.shifts.truncate) - rw = rw( abs(rw) < opts.shifts.truncate ); - rw = rw( abs(rw) > 1/opts.shifts.truncate ); -end \ No newline at end of file +% remove Ritz values that are too large or too small if desired +if isfield(opts.shifts, 'truncate') && isnumeric(opts.shifts.truncate) + rw = rw(abs(rw) < opts.shifts.truncate); + rw = rw(abs(rw) > 1 / opts.shifts.truncate); +end diff --git a/usfs/dae_1_so/init_dae_1_so.m b/usfs/dae_1_so/init_dae_1_so.m index a2727ea..4a3142b 100644 --- a/usfs/dae_1_so/init_dae_1_so.m +++ b/usfs/dae_1_so/init_dae_1_so.m @@ -33,126 +33,130 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% start checking -if(nargin<=3) - error('MESS:control_data','Number of input Arguments are at least 3'); +if nargin <= 3 + mess_err(opts, 'control_data', 'Number of input Arguments are at least 3'); -%% result = init_dae_1_so_1(eqn, flag1); -elseif(nargin==4) + %% result = init_dae_1_so_1(eqn, flag1); +elseif nargin == 4 switch flag1 - case {'A','a'} - [eqn,result] = checkA(eqn); - case {'E','e'} - [eqn,result] = checkE(eqn); + case {'A', 'a'} + [eqn, result] = checkA(eqn); + case {'E', 'e'} + [eqn, result] = checkE(eqn); otherwise - error('MESS:control_data','flag1 has to be ''A'' or ''E'''); + mess_err(opts, 'control_data', 'flag1 has to be ''A'' or ''E'''); end -%% result = init_dae_1_so_1(eqn,flag1,flag2); -elseif(nargin==5) + %% result = init_dae_1_so_1(eqn,flag1,flag2); +elseif nargin == 5 switch flag1 - case {'A','a'} - [eqn,result] = checkA(eqn); + case {'A', 'a'} + [eqn, result] = checkA(eqn, opts); switch flag2 - case {'A','a'} - [eqn,resultA] = checkA(eqn); + case {'A', 'a'} + [eqn, resultA] = checkA(eqn, opts); result = result && resultA; - case {'E','e'} - [eqn, resultE] = checkE(eqn); + case {'E', 'e'} + [eqn, resultE] = checkE(eqn, opts); result = result && resultE; otherwise - error('MESS:control_data', ... - 'flag2 has to be ''A'' or ''E'''); + mess_err(opts, 'control_data', ... + 'flag2 has to be ''A'' or ''E'''); end - case {'E','e'} - [eqn,result] = checkE(eqn); + case {'E', 'e'} + [eqn, result] = checkE(eqn, opts); switch flag2 - case {'A','a'} - [eqn,resultA] = checkA(eqn); + case {'A', 'a'} + [eqn, resultA] = checkA(eqn, opts); result = result && resultA; - case {'E','e'} - [eqn,resultE] = checkE(eqn); + case {'E', 'e'} + [eqn, resultE] = checkE(eqn, opts); result = result && resultE; otherwise - error('MESS:control_data', ... - 'flag2 has to be ''A'' or ''E'''); + mess_err(opts, 'control_data', ... + 'flag2 has to be ''A'' or ''E'''); end otherwise - error('MESS:control_data', 'flag1 has to be ''A'' or ''E'''); + mess_err(opts, 'control_data', 'flag1 has to be ''A'' or ''E'''); end end -if not(isfield(eqn,'haveE')), eqn.haveE=1; end +if not(isfield(eqn, 'haveE')) + eqn.haveE = true; +end end %% checkdata for A -function [eqn,result] = checkA(eqn) -if (not(isfield(eqn,'K_')) || not(isnumeric(eqn.K_))) - error('MESS:equation_data',... - 'Empty or Corrupted field K detected in equation structure.') +function [eqn, result] = checkA(eqn, opts) +if not(isfield(eqn, 'K_')) || not(isnumeric(eqn.K_)) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field K detected in equation structure.'); end -if(not(issparse(eqn.K_))) - warning('MESS:control_data','K is not sparse'); +if not(issparse(eqn.K_)) + mess_warn(opts, 'control_data', 'K is not sparse'); end [n1k, n2k] = size(eqn.K_); -if n1k ~= n2k - error('MESS:equation_data',... - 'K has to be quadratic') +if not(n1k == n2k) + mess_err(opts, 'equation_data', ... + 'K has to be quadratic'); end -result = 1; +result = true; end %% checkdata for E -function [eqn,result] = checkE(eqn) -if (not(isfield(eqn,'M_')) || not(isnumeric(eqn.M_))) - error('MESS:equation_data',... - 'Empty or Corrupted field M detected in equation structure.') -elseif (not(isfield(eqn,'E_')) || not(isnumeric(eqn.E_))) - error('MESS:equation_data',... - 'Empty or Corrupted field D detected in equation structure.') -end -if not(isfield(eqn, 'nd')) || not(isnumeric(eqn.nd)) - error('MESS:nd',... - 'Missing or Corrupted nd field detected in equation structure.'); -end -if(not(issparse(eqn.M_))) - warning('MESS:control_data','M is not sparse'); -end -if(not(issparse(eqn.E_))) - warning('MESS:control_data','D is not sparse'); -end -nd = eqn.nd; +function [eqn, result] = checkE(eqn, opts) +if not(isfield(eqn, 'M_')) || not(isnumeric(eqn.M_)) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field M detected in equation structure.'); +elseif not(isfield(eqn, 'E_')) || not(isnumeric(eqn.E_)) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field D detected in equation structure.'); +end +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'equation_data', ... + ['Missing or corrupted manifold_dim field detected in ' ... + 'equation structure.']); +end +if not(issparse(eqn.M_)) + mess_warn(opts, 'control_data', 'M is not sparse'); +end +if not(issparse(eqn.E_)) + mess_warn(opts, 'control_data', 'D is not sparse'); +end +manifold_dim = eqn.manifold_dim; [n1m, n2m] = size(eqn.M_); [n1d, n2d] = size(eqn.E_); -if n1m ~= n2m - error('MESS:equation_data',... - 'M has to be quadratic') +if not(n1m == n2m) + mess_err(opts, 'equation_data', ... + 'M has to be quadratic'); end -if n1d ~= n2d - error('MESS:equation_data',... - 'D has to be quadratic') +if not(n1d == n2d) + mess_err(opts, 'equation_data', ... + 'D has to be quadratic'); end -if n1m ~= n1d - error('MESS:equation_data',... - 'M and D must have same size') +if not(n1m == n1d) + mess_err(opts, 'equation_data', ... + 'M and D must have same size'); end -if full(any([any(eqn.M_(1:nd, nd + 1:end)), any(eqn.M_(nd+1:end,:))])) - warning('MESS:control_data', ... - 'M has to be non-zero only in nd x nd block'); +if full(any([any(eqn.M_(1:manifold_dim, manifold_dim + 1:manifold_dim)), ... + any(eqn.M_(manifold_dim + 1:end, :))])) + mess_warn(opts, 'control_data', ... + 'M has to be non-zero only in manifold_dim x manifold_dim block'); end -if full(any([any(eqn.E_(1:nd, nd + 1:end)), any(eqn.E_(nd+1:end,:))])) - warning('MESS:control_data', ... - 'D has to be non-zero only in nd x nd block'); +if full(any([any(eqn.E_(1:manifold_dim, manifold_dim + 1:end)), ... + any(eqn.E_(manifold_dim + 1:end, :))])) + mess_warn(opts, 'control_data', ... + 'D has to be non-zero only in manifold_dim x manifold_dim block'); end -result = 1; +result = true; end diff --git a/usfs/dae_1_so/init_res_dae_1_so.m b/usfs/dae_1_so/init_res_dae_1_so.m index aad725b..cba5883 100644 --- a/usfs/dae_1_so/init_res_dae_1_so.m +++ b/usfs/dae_1_so/init_res_dae_1_so.m @@ -1,17 +1,20 @@ -function [ RHS, res0, eqn, opts, oper ] = init_res_dae_1_so( eqn, opts, oper, RHS) -%% function init_res initializes the low rank residual W and res0 -% function [ RHS, res0, eqn, opts, oper ] = init_res_dae_1_so( eqn, opts, oper, RHS) +function [W, res0, eqn, opts, oper] = ... + init_res_dae_1_so(eqn, opts, oper, W, T) +%% function init_res initializes the low-rank residual W and res0 +% function [ W, res0, eqn, opts, oper ] = ... +% init_res_dae_1_so( eqn, opts, oper, W, T) % % Input/Output: % % eqn structure containing data for G or B or C % opts structure containing parameters for the algorithm % oper struct contains function handles for operation with A and E -% RHS right hand side matrix +% W right hand side matrix +% T such that residual is W*T*W' (optional, defaults to identity) % % Outputs: % -% RHS restriction of RHS to the hidden manifold +% W restriction of W to the hidden manifold % res0 initial residuum norm % % uses no other dae_1_so function @@ -19,49 +22,52 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check data if not(isfield(opts, 'LDL_T')) - opts.LDL_T = 0; + opts.LDL_T = false; end -if opts.LDL_T && not(isfield(eqn, 'S_diag')) - error('MESS:control_data', 'eqn.S_diag required in LDL_T mode'); +if opts.LDL_T && not(isfield(eqn, 'T')) + mess_err(opts, 'control_data', 'T required in LDL_T mode'); end -if (not(isnumeric(RHS))) || (not(ismatrix(RHS))) - error('MESS:error_arguments','RHS has to ba a matrix'); +if (not(isnumeric(W))) || (not(ismatrix(W))) + mess_err(opts, 'error_arguments', 'W has to ba a matrix'); end -if not(isfield(eqn, 'nd')) || not(isnumeric(eqn.nd)) - error('MESS:control_data',... - 'Missing or corrupted nd field detected in eqn structure.'); +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'control_data', ... + 'Missing or corrupted manifold_dim field detected in eqn structure.'); end -if (2*eqn.nd ~= size(RHS, 1)) - error('MESS:error_arguments', ... - 'number of rows of A_ differs with number of rows of RHS'); +if not(2 * eqn.manifold_dim == size(W, 1)) + mess_err(opts, 'error_arguments', ... + 'number of rows of A_ differs with number of rows of W'); end %% compute res0 +if not(exist('T', 'var')) && opts.LDL_T + % this means we only use init_res for potential projection + return +end + if isfield(opts, 'nm') && isfield(opts.nm, 'res0') res0 = opts.nm.res0; else if opts.LDL_T if opts.norm == 2 - res0 = max(abs(eig(RHS' * RHS * diag(eqn.S_diag)))); + res0 = max(abs(eig(W' * W * T))); else - res0 = norm(eig(RHS' * RHS * diag(eqn.S_diag)), 'fro'); + res0 = norm(eig(W' * W * T), 'fro'); end else - res0 = norm(RHS' * RHS, opts.norm); + res0 = norm(W' * W, opts.norm); end end end - diff --git a/usfs/dae_1_so/mess_usfs_dae_1_so.m b/usfs/dae_1_so/mess_usfs_dae_1_so.m index a41f24f..492b1a8 100644 --- a/usfs/dae_1_so/mess_usfs_dae_1_so.m +++ b/usfs/dae_1_so/mess_usfs_dae_1_so.m @@ -20,7 +20,7 @@ % in exactly the form above. % % The size of the square matrices M11 and E11 coincides and is stored in -% eqn.nd. +% eqn.manifold_dim. % % Implicitly the system is lifted to first order form % @@ -34,21 +34,22 @@ % C = C1 - C2 * K22 \ K21 and D = C2 * K22 \ B2. % % Note that eqn.B and eqn.C are overwritten by their corresponding -% representations on the 2*eqn.nd dimensional hidden manifold, i.e. in the -% first order ODE realization of the system. +% representations on the 2*eqn.manifold_dim dimensional hidden +% manifold, i.e. in the first order ODE realization of the system. % % References % -% [1] P. Benner, J. Saak, M. M. Uddin, Structure preserving model order -% reduction of large sparse second-order index-1 systems and -% application to a mechatronics model, -% Math. Comput. Model. Dyn. Syst. 22 (6) (2016) 509–523. -% https://doi.org/10.1080/13873954.2016.1218347. +% [1] P. Benner, J. Saak, M. M. Uddin, Structure preserving model order +% reduction of large sparse second-order index-1 systems and +% application to a mechatronics model, +% Mathematical and Computer Modeling of Dynamical Systems 22 (6) +% (2016) 509–523. +% https://doi.org/10.1080/13873954.2016.1218347. % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % diff --git a/usfs/dae_1_so/mul_A_dae_1_so.m b/usfs/dae_1_so/mul_A_dae_1_so.m index dd8ec37..82d0879 100644 --- a/usfs/dae_1_so/mul_A_dae_1_so.m +++ b/usfs/dae_1_so/mul_A_dae_1_so.m @@ -1,6 +1,6 @@ -function C = mul_A_dae_1_so(eqn, opts, opA, B, opB)%#ok -%% function mul_A performs operation C = opA(A_) * opB(B) -% for A as in (2) in help mess_usfs_dae1_so +function C = mul_A_dae_1_so(eqn, opts, opA, B, opB) +%% function mul_A performs operation C = opA(A_) * opB(B) +% for A as in (2) in help mess_usfs_dae1_so % % C = mul_A_dae_1_so(eqn, opts, opA, B, opB) % @@ -8,7 +8,7 @@ % eqn structure contains field K_, E_, M_ % % opts struct contains parameters for the algorithm -%s +% s % opA character specifies the form of opA(A_) % opA = 'N' performs A_*opB(B) % opA = 'T' performs A_'*opB(B) @@ -24,62 +24,63 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input Parameters -if (not(ischar(opA)) || not(ischar(opB))) - error('MESS:error_arguments', 'opA or opB is not a char'); +if not(ischar(opA)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opA or opB is not a char'); end -opA = upper(opA); opB = upper(opB); +opA = upper(opA); +opB = upper(opB); if not(opA == 'N' || opA == 'T') - error('MESS:error_arguments', 'opA is not ''N'' or ''T'''); + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end if not(opB == 'N' || opB == 'T') - error('MESS:error_arguments', 'opB is not ''N'' or ''T'''); + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to be a matrix'); + mess_err(opts, 'error_arguments', 'B has to be a matrix'); end %% check data in eqn structure -if (not(isfield(eqn,'K_')) || not(isnumeric(eqn.K_))) - error('MESS:equation_data',... - 'Empty or Corrupted field K detected in equation structure.') +if not(isfield(eqn, 'K_')) || not(isnumeric(eqn.K_)) + mess_err(opts, 'equation_data', ... + 'Empty or corrupted field K detected in equation structure.'); end -if not(isfield(eqn, 'nd')) || not(isnumeric(eqn.nd)) - error('MESS:nd',... - 'Missing or Corrupted nd field detected in equation structure.'); +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'equation_data', ... + ['Missing or corrupted manifold_dim field detected in ' ... + 'equation structure.']); end -n = size(eqn.K_,1); -nd = eqn.nd; -one = 1:nd; -two = (nd + 1) : n; -twob = (nd + 1) : (2 * nd); +n = size(eqn.K_, 1); +manifold_dim = eqn.manifold_dim; +one = 1:manifold_dim; +two = (manifold_dim + 1):n; +twob = (manifold_dim + 1):(2 * manifold_dim); -if(opB == 'N') +if opB == 'N' nrows = size(B, 1); else nrows = size(B, 2); end -if not(2 * nd == nrows) - error('MESS:error_arguments', ... - 'number of rows of B differs from number of cols of A ( 2 * nd)'); +if not(2 * manifold_dim == nrows) + mess_err(opts, 'error_arguments', ... + ['number of rows of B differs from number of cols of A' ... + '(2 * manifold_dim)']); end if issymmetric(eqn.K_) && issymmetric(eqn.M_) opA = 'N'; % let us avoid unnecessary transposition of matrices end - %% perform multiplication switch opA @@ -87,33 +88,32 @@ switch opB case 'N' - C = [ -eqn.K_(one, one)* B(one, :) ... - + eqn.K_(one, two) * (eqn.K_(two, two) ... - \ (eqn.K_(two, one) * B(one, :))); - eqn.M_(one, one) * B(twob, :)]; + C = [-eqn.K_(one, one) * B(one, :) + ... + eqn.K_(one, two) * (eqn.K_(two, two) \ ... + (eqn.K_(two, one) * B(one, :))) + eqn.M_(one, one) * B(twob, :)]; case 'T' - C = [ - eqn.K_(one, one)* B(:, one)' ... - + eqn.K_(one, two) * (eqn.K_(two, two) ... - \ (eqn.K_(two, one) * B(:, one)')); - eqn.M_(one, one) * B(:, twob)']; + C = [-eqn.K_(one, one) * B(:, one)' + ... + eqn.K_(one, two) * (eqn.K_(two, two) \ ... + (eqn.K_(two, one) * B(:, one)')) + eqn.M_(one, one) * B(:, twob)']; end case 'T' switch opB - case 'N' - C = [ -eqn.K_(one, one)' * B(one, :) ... - + eqn.K_(two, one)' * (eqn.K_(two, two)' ... - \ (eqn.K_(one, two)' * B(one, :))); - eqn.M_(one, one)' * B(twob, :)]; + C = [-eqn.K_(one, one)' * B(one, :) + ... + eqn.K_(two, one)' * (eqn.K_(two, two)' \ ... + (eqn.K_(one, two)' * B(one, :))) + eqn.M_(one, one)' * B(twob, :)]; case 'T' - C = [ -eqn.K_(one, one)' * B(:, one)' ... - + eqn.K_(two, one)' * (eqn.K_(two, two)' ... - \ (eqn.K_(one, two)' * B(:, one)')); - eqn.M_(one, one)' * B(:, twob)']; + C = [-eqn.K_(one, one)' * B(:, one)' + ... + eqn.K_(two, one)' * (eqn.K_(two, two)' \ ... + (eqn.K_(one, two)' * B(:, one)')) + eqn.M_(one, one)' * B(:, twob)']; end end diff --git a/usfs/dae_1_so/mul_ApE_dae_1_so.m b/usfs/dae_1_so/mul_ApE_dae_1_so.m index af58beb..141d700 100644 --- a/usfs/dae_1_so/mul_ApE_dae_1_so.m +++ b/usfs/dae_1_so/mul_ApE_dae_1_so.m @@ -1,7 +1,7 @@ -function C = mul_ApE_dae_1_so(eqn, opts, opA, p, opE, B, opB)%#ok +function C = mul_ApE_dae_1_so(eqn, opts, opA, p, opE, B, opB) %% function mul_A mul_ApE_dae_1_so operation C = (opA(A_)+pc*opE(E_))*opB(B) -% for A, E as in (2) in help mess_usfs_dae1_so. +% for A, E as in (2) in help mess_usfs_dae1_so. % % C = mul_ApE_dae_1_so(eqn, opts, opA, p, opE, B, opB) % @@ -36,70 +36,71 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input Parameters -if (not(ischar(opA)) || not(ischar(opE)) || not(ischar(opB))) - error('MESS:error_arguments', 'opA, opE or opB is not a char'); +if not(ischar(opA)) || not(ischar(opE)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opA, opE or opB is not a char'); end -opA = upper(opA); opE = upper(opE); opB = upper(opB); +opA = upper(opA); +opE = upper(opE); +opB = upper(opB); -if(not((opA == 'N' || opA == 'T'))) - error('MESS:error_arguments', 'opA is not ''N'' or ''T'''); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if(not((opE == 'N' || opE == 'T'))) - error('MESS:error_arguments', 'opE is not ''N'' or ''T'''); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end -if(not((opB == 'N' || opB == 'T'))) - error('MESS:error_arguments', 'opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end -if(not(isnumeric(p))) - error('MESS:error_arguments','p is not numeric'); +if not(isnumeric(p)) + mess_err(opts, 'error_arguments', 'p is not numeric'); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -if (not(isfield(eqn,'K_')) || not(isnumeric(eqn.K_))) - error('MESS:equation_data',... - 'Empty or Corrupted field K detected in equation structure.') +if not(isfield(eqn, 'K_')) || not(isnumeric(eqn.K_)) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field K detected in equation structure.'); end -if (not(isfield(eqn,'M_')) || not(isnumeric(eqn.M_))) - error('MESS:equation_data',... - 'Empty or Corrupted field M detected in equation structure.') -elseif (not(isfield(eqn,'E_')) || not(isnumeric(eqn.E_))) - error('MESS:equation_data',... - 'Empty or Corrupted field D detected in equation structure.') +if not(isfield(eqn, 'M_')) || not(isnumeric(eqn.M_)) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field M detected in equation structure.'); +elseif not(isfield(eqn, 'E_')) || not(isnumeric(eqn.E_)) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field D detected in equation structure.'); end -if not(isfield(eqn, 'nd')) || not(isnumeric(eqn.nd)) - error('MESS:nd',... - 'Missing or Corrupted nd field detected in equation structure.'); +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'equation_data', ... + ['Missing or corrupted manifold_dim field detected in ' ... + 'equation structure.']); end -n = size(eqn.K_,1); -nd = eqn.nd; -one = 1 : nd; -two = (nd + 1) : n; -twob = (nd + 1) : (2 * nd); +n = size(eqn.K_, 1); +one = 1:eqn.manifold_dim; +two = (eqn.manifold_dim + 1):n; +twob = (eqn.manifold_dim + 1):(2 * eqn.manifold_dim); -if(opB == 'N') +if opB == 'N' rows = size(B, 1); else rows = size(B, 2); end -if(2 * nd ~= rows) - error('MESS:error_arguments','Rows of A differs from rows of B'); +if not(2 * eqn.manifold_dim == rows) + mess_err(opts, 'error_arguments', 'Rows of A differs from rows of B'); end %% compute C = (A + p * E) * B @@ -111,50 +112,50 @@ opA = 'N'; % let us avoid unnecessary transposition of matrices end -%% perform solve operations for E ~= Identity +%% perform solve operations for E in not the Identity switch opA case 'N' switch opE case 'N' switch opB case 'N' - C2 = eqn.M_(one, one)*... + C2 = eqn.M_(one, one) * ... (B(twob, :) + p * B(one, :)); - C1 = -eqn.K_(one, one) * B(one,:) + ... - eqn.K_(one, two) * ( eqn.K_(two, two) \ ... - eqn.K_(two, one) * B(one,:)) + ... + C1 = -eqn.K_(one, one) * B(one, :) + ... + eqn.K_(one, two) * (eqn.K_(two, two) \ ... + eqn.K_(two, one) * B(one, :)) + ... p * (eqn.E_(one, one) * B(one, :) + ... - eqn.M_(one, one) * B(twob,:)); + eqn.M_(one, one) * B(twob, :)); C = [C1; C2]; case 'T' - C2 = eqn.M_(one, one)*... + C2 = eqn.M_(one, one) * ... (B(:, twob)' + p * B(:, one)'); C1 = -eqn.K_(one, one) * B(:, one)' + ... - eqn.K_(one, two) * ( eqn.K_(two, two) \ ... - eqn.K_(two, one) * B(:, one)') + ... + eqn.K_(one, two) * (eqn.K_(two, two) \ ... + eqn.K_(two, one) * B(:, one)') + ... p * (eqn.E_(one, one) * B(:, one)' + ... - eqn.M_(one, one) * B(:, twob)'); + eqn.M_(one, one) * B(:, twob)'); C = [C1; C2]; end case 'T' switch opB case 'N' - C2 = eqn.M_(one, one)* B(twob, :) + ... - p * (eqn.M_(one,one)' * B(one, :)); - C1 = -eqn.K_(one, one) * B(one,:) + ... - eqn.K_(one, two) * ( eqn.K_(two, two) \ ... - eqn.K_(two, one) * B(one,:)) + ... + C2 = eqn.M_(one, one) * B(twob, :) + ... + p * (eqn.M_(one, one)' * B(one, :)); + C1 = -eqn.K_(one, one) * B(one, :) + ... + eqn.K_(one, two) * (eqn.K_(two, two) \ ... + eqn.K_(two, one) * B(one, :)) + ... p * (eqn.E_(one, one)' * B(one, :) + ... - eqn.M_(one, one) * B(twob,:)); + eqn.M_(one, one) * B(twob, :)); C = [C1; C2]; case 'T' - C2 = eqn.M_(one, one)* B(:, twob)' + ... - p * (eqn.M_(one,one)' * B(:, one)'); + C2 = eqn.M_(one, one) * B(:, twob)' + ... + p * (eqn.M_(one, one)' * B(:, one)'); C1 = -eqn.K_(one, one) * B(:, one)' + ... - eqn.K_(one, two) * ( eqn.K_(two, two) \ ... - eqn.K_(two, one) * B(:, one)') + ... + eqn.K_(one, two) * (eqn.K_(two, two) \ ... + eqn.K_(two, one) * B(:, one)') + ... p * (eqn.E_(one, one)' * B(one, :) + ... - eqn.M_(one, one) * B(:, twob)'); + eqn.M_(one, one) * B(:, twob)'); C = [C1; C2]; end end @@ -165,41 +166,41 @@ case 'N' C2 = eqn.M_(one, one)' * B(twob, :) + ... p * (eqn.M_(one, one) * B(one, :)); - C1 = -eqn.K_(one, one)' * B(one,:) + ... - eqn.K_(two, one)' * ( eqn.K_(two, two)' \ ... - eqn.K_(one, two)' * B(one,:)) + ... + C1 = -eqn.K_(one, one)' * B(one, :) + ... + eqn.K_(two, one)' * (eqn.K_(two, two)' \ ... + eqn.K_(one, two)' * B(one, :)) + ... p * (eqn.E_(one, one) * B(one, :) + ... - eqn.M_(one, one) * B(twob,:)); + eqn.M_(one, one) * B(twob, :)); C = [C1; C2]; case 'T' C2 = eqn.M_(one, one)' * B(:, twob)' + ... p * (eqn.M_(one, one) * B(:, one)'); C1 = -eqn.K_(one, one)' * B(:, one)' + ... eqn.K_(two, one)' * (eqn.K_(two, two)' \ ... - eqn.K_(one, two)' * B(:, one)') + ... + eqn.K_(one, two)' * B(:, one)') + ... p * (eqn.E_(one, one) * B(:, one)' + ... - eqn.M_(one, one) * B(:, twob)'); + eqn.M_(one, one) * B(:, twob)'); C = [C1; C2]; end case 'T' switch opB case 'N' - C2 = eqn.M_(one, one)'*... + C2 = eqn.M_(one, one)' * ... (B(twob, :) + p * B(one, :)); - C1 = -eqn.K_(one, one)' * B(one,:) + ... - eqn.K_(two, one)' * ( eqn.K_(two, two)' \ ... - eqn.K_(one, two)' * B(one,:)) + ... + C1 = -eqn.K_(one, one)' * B(one, :) + ... + eqn.K_(two, one)' * (eqn.K_(two, two)' \ ... + eqn.K_(one, two)' * B(one, :)) + ... p * (eqn.E_(one, one)' * B(one, :) + ... - eqn.M_(one, one)' * B(twob,:)); + eqn.M_(one, one)' * B(twob, :)); C = [C1; C2]; - case 'T' - C2 = eqn.M_(one, one)'*... + case 'T' + C2 = eqn.M_(one, one)' * ... (B(:, twob)' + p * B(:, one)'); C1 = -eqn.K_(one, one)' * B(:, one)' + ... - eqn.K_(two, one)' * ( eqn.K_(two, two)' \ ... - eqn.K_(one, two)' * B(:, one)') + ... + eqn.K_(two, one)' * (eqn.K_(two, two)' \ ... + eqn.K_(one, two)' * B(:, one)') + ... p * (eqn.E_(one, one)' * B(:, one)' + ... - eqn.M_(one, one)' * B(:, twob)'); + eqn.M_(one, one)' * B(:, twob)'); C = [C1; C2]; end end diff --git a/usfs/dae_1_so/mul_E_dae_1_so.m b/usfs/dae_1_so/mul_E_dae_1_so.m index 27902bb..0a48d34 100644 --- a/usfs/dae_1_so/mul_E_dae_1_so.m +++ b/usfs/dae_1_so/mul_E_dae_1_so.m @@ -1,7 +1,7 @@ -function C=mul_E_dae_1_so(eqn, opts, opE, B, opB)%#ok +function C = mul_E_dae_1_so(eqn, opts, opE, B, opB) %% function mul_A_so_1 performs operation C = opE(E)*opB(B) -% for E as in (2) in help mess_usfs_dae1_so +% for E as in (2) in help mess_usfs_dae1_so % % C = mul_E_dae_1_so(eqn, opts, opE, B, opB) % @@ -30,56 +30,58 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input Parameters -if (not(ischar(opE)) || not(ischar(opB))) - error('MESS:error_arguments', 'opE or opB is not a char'); +if not(ischar(opE)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opE or opB is not a char'); end -opE = upper(opE); opB = upper(opB); -if(not((opE=='N' || opE=='T'))) - error('MESS:error_arguments','opE is not ''N'' or ''T'''); +opE = upper(opE); +opB = upper(opB); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end -if(not((opB=='N' || opB=='T'))) - error('MESS:error_arguments','opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -if (not(isfield(eqn,'M_')) || not(isnumeric(eqn.M_))) - error('MESS:equation_data', ... - 'Empty or Corrupted field M detected in equation structure.') -elseif (not(isfield(eqn,'E_')) || not(isnumeric(eqn.E_))) - error('MESS:equation_data', ... - 'Empty or Corrupted field D detected in equation structure.') +if not(isfield(eqn, 'M_')) || not(isnumeric(eqn.M_)) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field M detected in equation structure.'); +elseif not(isfield(eqn, 'E_')) || not(isnumeric(eqn.E_)) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field D detected in equation structure.'); end -if not(isfield(eqn, 'nd')) || not(isnumeric(eqn.nd)) - error('MESS:nd', ... - 'Missing or Corrupted nd field detected in equation structure.'); +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'equation_data', ... + ['Missing or corrupted manifold_dim field detected in ' ... + 'equation structure.']); end -nd = eqn.nd; -one = 1 : nd; -twob = (nd + 1) : (2 * nd); +manifold_dim = eqn.manifold_dim; +one = 1:manifold_dim; +twob = (manifold_dim + 1):(2 * manifold_dim); -if(opB == 'N') +if opB == 'N' [rows, ~] = size(B); else [~, rows] = size(B); end -if(2 * nd ~= rows) - error('MESS:error_arguments', ... - 'number of rows of B differs from number of cols of E ( 2 * nd)'); +if not(2 * manifold_dim == rows) + mess_err(opts, 'error_arguments', ... + ['number of rows of B differs from number of cols of E ' ... + '(2 * manifold_dim)']); end if issymmetric(eqn.E_) && issymmetric(eqn.M_) @@ -92,14 +94,14 @@ case 'N' switch opB case 'N' - C = [eqn.E_(one,one) * B(one,:) ... - + eqn.M_(one,one) * B(twob, :); - eqn.M_(one, one) * B(one, :)]; + C = [eqn.E_(one, one) * B(one, :) + ... + eqn.M_(one, one) * B(twob, :) + eqn.M_(one, one) * B(one, :)]; case 'T' - C = [eqn.E_(one,one) * B(:, one)' ... - + eqn.M_(one,one) * B(:, twob)'; - eqn.M_(one, one) * B(:, one)']; + C = [eqn.E_(one, one) * B(:, one)' + ... + eqn.M_(one, one) * B(:, twob)' + eqn.M_(one, one) * B(:, one)']; end @@ -107,15 +109,14 @@ switch opB case 'N' - C = [eqn.E_(one,one)' * B(one,:) ... - + eqn.M_(one,one)' * B(twob, :); - eqn.M_(one, one)' * B(one, :)]; - + C = [eqn.E_(one, one)' * B(one, :) + ... + eqn.M_(one, one)' * B(twob, :) + eqn.M_(one, one)' * B(one, :)]; case 'T' - C = [eqn.E_(one,one)' * B(:, one)' ... - + eqn.M_(one,one)' * B(:, twob)'; - eqn.M_(one, one)' * B(:, one)']; + C = [eqn.E_(one, one)' * B(:, one)' + ... + eqn.M_(one, one)' * B(:, twob)' + eqn.M_(one, one)' * B(:, one)']; end diff --git a/usfs/dae_1_so/size_dae_1_so.m b/usfs/dae_1_so/size_dae_1_so.m index aae26b2..f38ba8e 100644 --- a/usfs/dae_1_so/size_dae_1_so.m +++ b/usfs/dae_1_so/size_dae_1_so.m @@ -1,4 +1,4 @@ -function n = size_dae_1_so(eqn, opts, oper)%#ok +function n = size_dae_1_so(eqn, opts, oper) %#ok % function n = size_dae_1_so(eqn, opts, oper) % % This function returns the number of rows of matrix A in (2) in help @@ -21,18 +21,20 @@ % % See also mess_usfs_dae_1_so - % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % -if not(isfield(eqn, 'nd')) || not(isnumeric(eqn.nd)) - error('MESS:nd',... - 'Missing or Corrupted nd field detected in equation structure.'); +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'equation_data', ... + ['Missing or corrupted manifold_dim field detected in ' ... + 'equation structure.']); end -n = 2 * eqn.nd; + +n = 2 * eqn.manifold_dim; + end diff --git a/usfs/dae_1_so/sol_A_dae_1_so.m b/usfs/dae_1_so/sol_A_dae_1_so.m index d9bbda5..91ae374 100644 --- a/usfs/dae_1_so/sol_A_dae_1_so.m +++ b/usfs/dae_1_so/sol_A_dae_1_so.m @@ -1,6 +1,6 @@ -function X = sol_A_dae_1_so(eqn, opts, opA, B, opB)%#ok +function X = sol_A_dae_1_so(eqn, opts, opA, B, opB) %% function sol_A solves opA(A) * X = opC(B) resp. performs X = opA(A) \ opB(B) -% for A as in (2) in help mess_usfs_dae1_so +% for A as in (2) in help mess_usfs_dae1_so % % X = sol_A_dae_1_so(eqn, opts, opA, B, opB) % @@ -32,49 +32,50 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input Parameters -if (not(ischar(opA)) || not(ischar(opB))) - error('MESS:error_arguments', 'opA or opB is not a char'); +if not(ischar(opA)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opA or opB is not a char'); end -opA = upper(opA); opB = upper(opB); +opA = upper(opA); +opB = upper(opB); -if(not((opA == 'N' || opA == 'T'))) - error('MESS:error_arguments', 'opA is not ''N'' or ''T'''); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if(not((opB == 'N' || opB == 'T'))) - error('MESS:error_arguments', 'opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -if (not(isfield(eqn,'K_')) || not(isnumeric(eqn.K_))) - error('MESS:equation_data',... - 'Empty or Corrupted field K detected in equation structure.') +if not(isfield(eqn, 'K_')) || not(isnumeric(eqn.K_)) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field K detected in equation structure.'); end -if not(isfield(eqn, 'nd')) || not(isnumeric(eqn.nd)) - error('MESS:nd',... - 'Missing or Corrupted nd field detected in equation structure.'); +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'equation_data', ... + ['Missing or corrupted manifold_dim field detected in ' ... + 'equation structure.']); end n = size(eqn.K_, 1); -nd = eqn.nd; -na = n - nd; -one = 1 : nd; -twob = (nd + 1) : (2 * nd); +manifold_dim = eqn.manifold_dim; +na = n - manifold_dim; +one = 1:manifold_dim; +twob = (manifold_dim + 1):(2 * manifold_dim); -if(opB == 'N') +if opB == 'N' rows = size(B, 1); cols = size(B, 2); else @@ -82,9 +83,10 @@ cols = size(B, 1); end -if(2 * nd ~= rows) - error('MESS:error_arguments', ... - 'number of rows of B differs from number of cols of A ( 2 * nd)'); +if not(2 * manifold_dim == rows) + mess_err(opts, 'error_arguments', ... + ['number of rows of B differs from number of cols of A ' ... + '(2 * manifold_dim)']); end %% solve @@ -99,11 +101,11 @@ case 'N' X = eqn.K_ \ [B(one, :); zeros(na, cols)]; - X = [- X(one, :); eqn.M_(one,one) \ B(twob, :) ]; + X = [-X(one, :); eqn.M_(one, one) \ B(twob, :)]; case 'T' X = eqn.K_ \ [B(:, one)'; zeros(na, cols)]; - X = [- X(one, :); eqn.M_(one,one) \ B(:, twob)']; + X = [-X(one, :); eqn.M_(one, one) \ B(:, twob)']; end case 'T' @@ -111,11 +113,11 @@ case 'N' X = eqn.K_' \ [B(one, :); zeros(na, cols)]; - X = [- X(one, :); eqn.M_(one,one)' \ B(twob, :) ]; + X = [-X(one, :); eqn.M_(one, one)' \ B(twob, :)]; case 'T' X = eqn.K_' \ [B(:, one)'; zeros(na, cols)]; - X = [- X(one, :); eqn.M_(one,one)' \ B(:, twob)']; + X = [-X(one, :); eqn.M_(one, one)' \ B(:, twob)']; end diff --git a/usfs/dae_1_so/sol_ApE_dae_1_so.m b/usfs/dae_1_so/sol_ApE_dae_1_so.m index 996981a..4d3d46a 100644 --- a/usfs/dae_1_so/sol_ApE_dae_1_so.m +++ b/usfs/dae_1_so/sol_ApE_dae_1_so.m @@ -1,5 +1,5 @@ -function X = sol_ApE_dae_1_so(eqn, opts, opA, p, opE, C, opC)%#ok -%% function sol_ApE_so_1 solves (opA(A) + p*opE(E))*X = opC(C) respectively +function X = sol_ApE_dae_1_so(eqn, opts, opA, p, opE, C, opC) +%% function sol_ApE_so_1 solves (opA(A) + p*opE(E))*X = opC(C) respectively % performs X=(opA(A)+p*opE(E))\opC(C) for A, E as in (2) in % mess_usfs_dae1_so % @@ -38,63 +38,66 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input Parameters -if (not(ischar(opA)) || not(ischar(opE)) || not(ischar(opC))) - error('MESS:error_arguments', 'opA, opE or opC is not a char'); +if not(ischar(opA)) || not(ischar(opE)) || not(ischar(opC)) + mess_err(opts, 'error_arguments', 'opA, opE or opC is not a char'); end -opA = upper(opA); opE = upper(opE); opC = upper(opC); +opA = upper(opA); +opE = upper(opE); +opC = upper(opC); -if(not((opA == 'N' || opA == 'T'))) - error('MESS:error_arguments', 'opA is not ''N'' or ''T'''); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if(not((opE == 'N' || opE == 'T'))) - error('MESS:error_arguments', 'opE is not ''N'' or ''T'''); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end -if(not((opC == 'N' || opC == 'T'))) - error('MESS:error_arguments', 'opC is not ''N'' or ''T'''); +if not(opC == 'N' || opC == 'T') + mess_err(opts, 'error_arguments', 'opC is not ''N'' or ''T'''); end -if(not(isnumeric(p))) - error('MESS:error_arguments','p is not numeric'); +if not(isnumeric(p)) + mess_err(opts, 'error_arguments', 'p is not numeric'); end if (not(isnumeric(C))) || (not(ismatrix(C))) - error('MESS:error_arguments','C has to ba a matrix'); + mess_err(opts, 'error_arguments', 'C has to ba a matrix'); end - %% check data in eqn structure -if (not(isfield(eqn,'K_')) || not(isnumeric(eqn.K_))) - error('MESS:equation_data',... - 'Empty or Corrupted field K detected in equation structure.') +if not(isfield(eqn, 'K_')) || not(isnumeric(eqn.K_)) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field K detected in equation structure.'); end -if (not(isfield(eqn,'M_')) || not(isnumeric(eqn.M_))) - error('MESS:equation_data',... - 'Empty or Corrupted field M detected in equation structure.') -elseif (not(isfield(eqn,'E_')) || not(isnumeric(eqn.E_))) - error('MESS:equation_data',... - 'Empty or Corrupted field D detected in equation structure.') +if not(isfield(eqn, 'M_')) || not(isnumeric(eqn.M_)) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field M detected in equation structure.'); +elseif not(isfield(eqn, 'E_')) || not(isnumeric(eqn.E_)) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field D detected in equation structure.'); end -if not(isfield(eqn, 'nd')) || not(isnumeric(eqn.nd)) - error('MESS:nd',... - 'Missing or Corrupted nd field detected in equation structure.'); +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'nd', ... + ['Missing or corrupted manifold_dim field detected in ' ... + 'equation structure.']); +end +if not(isfield(eqn, 'haveE')) + eqn.haveE = false; end -if not(isfield(eqn,'haveE')), eqn.haveE=0; end -n = size(eqn.K_,1); -nd = eqn.nd; -one = 1 : nd; -twoc = (nd + 1) : (2 * nd); +n = size(eqn.K_, 1); +manifold_dim = eqn.manifold_dim; +one = 1:manifold_dim; +twoc = (manifold_dim + 1):(2 * manifold_dim); -if(opC == 'N') +if opC == 'N' rows = size(C, 1); cols = size(C, 2); else @@ -102,13 +105,12 @@ cols = size(C, 1); end -if(2 * nd ~= rows) - error('MESS:error_arguments','Rows of A differs from rows of C'); +if not(2 * manifold_dim == rows) + mess_err(opts, 'error_arguments', 'Rows of A differs from rows of C'); end - %% solve (A + p * E) * x = C -%% perform solve operations for E ~= Identity +%% perform solve operations for E not the Identity switch opA case 'N' @@ -119,15 +121,17 @@ switch opC case 'N' - X1 = (eqn.K_ + p * ( p * eqn.M_ - eqn.E_)) \ ... - [p * C(twoc, :)-C(one, :); zeros(n - nd, cols)]; + X1 = (eqn.K_ + p * (p * eqn.M_ - eqn.E_)) \ ... + [p * C(twoc, :) - C(one, :); ... + zeros(n - manifold_dim, cols)]; X1 = X1(one, :); X2 = eqn.M_(one, one) \ C(twoc, :) - p * X1; X = [X1; X2]; case 'T' - X1 = (eqn.K_ + p * ( p * eqn.M_ - eqn.E_)) \ ... - [p * C(:, twoc)'-C(:, one)'; zeros(n - nd, cols)]; + X1 = (eqn.K_ + p * (p * eqn.M_ - eqn.E_)) \ ... + [p * C(:, twoc)' - C(:, one)'; ... + zeros(n - manifold_dim, cols)]; X1 = X1(one, :); X2 = eqn.M_(one, one) \ C(:, twoc)' - p * X1; X = [X1; X2]; @@ -135,30 +139,32 @@ end case 'T' - + if not(issymmetric(eqn.M_)) - error('MESS:notimplemented', ... - ['this combination of opA, opE is only ',... - 'available for M11 symmetric.']); + mess_err(opts, 'notimplemented', ... + ['this combination of opA, opE is only ', ... + 'available for M11 symmetric.']); % this would imply eqn.M_'*eqn.M_\eqn.M_' in X1 below else switch opC case 'N' - X1 = (eqn.K_ + p * ( p * eqn.M_ - eqn.E_')) \ ... - [p * C(twoc, :)-C(one, :); zeros(n - nd, cols)]; + X1 = (eqn.K_ + p * (p * eqn.M_ - eqn.E_')) \ ... + [p * C(twoc, :) - C(one, :); ... + zeros(n - manifold_dim, cols)]; X1 = X1(one, :); X2 = eqn.M_(one, one) \ C(twoc, :) - p * X1; X = [X1; X2]; - + case 'T' - X1 = (eqn.K_ + p * ( p * eqn.M_ - eqn.E_')) \ ... - [p * C(:, twoc)'-C(:, one)'; zeros(n - nd, cols)]; + X1 = (eqn.K_ + p * (p * eqn.M_ - eqn.E_')) \ ... + [p * C(:, twoc)' - C(:, one)'; ... + zeros(n - manifold_dim, cols)]; X1 = X1(one, :); X2 = eqn.M_(one, one) \ C(:, twoc)' - p * X1; X = [X1; X2]; - + end - + end end @@ -167,58 +173,59 @@ switch opE case 'N' - + if not(issymmetric(eqn.M_)) - error('MESS:notimplemented', ... - ['this combination of opA, opE is only ',... - 'available for M11 symmetric.']); + mess_err(opts, 'notimplemented', ... + ['this combination of opA, opE is only ', ... + 'available for M11 symmetric.']); % this would imply eqn.M_*eqn.M_'\eqn.M_ in X1 below else - + switch opC - + case 'N' - X1 = (eqn.K_' + p * ( p * eqn.M_ - eqn.E_)) \ ... - [p * C(twoc, :)-C(one, :); zeros(n - nd, cols)]; + X1 = (eqn.K_' + p * (p * eqn.M_ - eqn.E_)) \ ... + [p * C(twoc, :) - C(one, :); ... + zeros(n - manifold_dim, cols)]; X1 = X1(one, :); X2 = eqn.M_(one, one) \ C(twoc, :) - p * X1; X = [X1; X2]; - + case 'T' - X1 = (eqn.K_' + p * ( p * eqn.M_ - eqn.E_)) \ ... - [p * C(:, twoc)'-C(:, one)'; zeros(n - nd, cols)]; + X1 = (eqn.K_' + p * (p * eqn.M_ - eqn.E_)) \ ... + [p * C(:, twoc)' - C(:, one)'; ... + zeros(n - manifold_dim, cols)]; X1 = X1(one, :); X2 = eqn.M_(one, one) \ C(:, twoc)' - p * X1; X = [X1; X2]; - + end - + end - + case 'T' switch opC - + case 'N' - X1 = (eqn.K_' + p * ( p * eqn.M_' - eqn.E_')) \ ... - [p * C(twoc, :)-C(one, :); zeros(n - nd, cols)]; + X1 = (eqn.K_' + p * (p * eqn.M_' - eqn.E_')) \ ... + [p * C(twoc, :) - C(one, :); ... + zeros(n - manifold_dim, cols)]; X1 = X1(one, :); X2 = eqn.M_(one, one)' \ C(twoc, :) - p * X1; X = [X1; X2]; - + case 'T' - X1 = (eqn.K_' + p * ( p * eqn.M_' - eqn.E_')) \ ... - [p * C(:, twoc)'-C(:, one)'; zeros(n - nd, cols)]; + X1 = (eqn.K_' + p * (p * eqn.M_' - eqn.E_')) \ ... + [p * C(:, twoc)' - C(:, one)'; ... + zeros(n - manifold_dim, cols)]; X1 = X1(one, :); X2 = eqn.M_(one, one)' \ C(:, twoc)' - p * X1; X = [X1; X2]; - + end end - -end - - +end diff --git a/usfs/dae_1_so/sol_E_dae_1_so.m b/usfs/dae_1_so/sol_E_dae_1_so.m index fb84e94..c33a51b 100644 --- a/usfs/dae_1_so/sol_E_dae_1_so.m +++ b/usfs/dae_1_so/sol_E_dae_1_so.m @@ -1,6 +1,6 @@ -function X = sol_E_dae_1_so(eqn, opts, opE, B, opB)%#ok -%% function sol_E_dae_1_so solves opE(E)*X = opB(B), i.e., -% it performs X=opE(E)\opB(B) with E as in (2) in help mess_usfs_dae1_so +function X = sol_E_dae_1_so(eqn, opts, opE, B, opB) +%% function sol_E_dae_1_so solves opE(E)*X = opB(B), i.e., +% it performs X=opE(E)\opB(B) with E as in (2) in help mess_usfs_dae1_so % % Input: % eqn structure contains data for E (here M_,K_) @@ -28,55 +28,58 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % %% check input Parameters -if (not(ischar(opE)) || not(ischar(opB))) - error('MESS:error_arguments', 'opE or opB is not a char'); +if not(ischar(opE)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opE or opB is not a char'); end -opE = upper(opE); opB = upper(opB); -if(not((opE == 'N' || opE == 'T'))) - error('MESS:error_arguments','opE is not ''N'' or ''T'''); +opE = upper(opE); +opB = upper(opB); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end -if(not((opB == 'N' || opB == 'T'))) - error('MESS:error_arguments','opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -if (not(isfield(eqn,'M_')) || not(isnumeric(eqn.M_))) - error('MESS:equation_data',... - 'Empty or Corrupted field M detected in equation structure.') -elseif (not(isfield(eqn,'E_')) || not(isnumeric(eqn.E_))) - error('MESS:equation_data',... - 'Empty or Corrupted field D detected in equation structure.') +if not(isfield(eqn, 'M_')) || not(isnumeric(eqn.M_)) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field M detected in equation structure.'); +elseif not(isfield(eqn, 'E_')) || not(isnumeric(eqn.E_)) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field D detected in equation structure.'); end -if not(isfield(eqn, 'nd')) || not(isnumeric(eqn.nd)) - error('MESS:nd',... - 'Missing or Corrupted nd field detected in equation structure.'); +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'equation_data', ... + ['Missing or corrupted manifold_dim field detected in ' ... + 'equation structure.']); end -nd = eqn.nd; -one = 1 : nd; -twob = (nd + 1) : (2 * nd); +manifold_dim = eqn.manifold_dim; +one = 1:manifold_dim; +twob = (manifold_dim + 1):(2 * manifold_dim); -if(opB == 'N') +if opB == 'N' rows = size(B, 1); else rows = size(B, 2); end -if(2 * nd ~= rows) - error('MESS:error_arguments', ... - 'number of rows of B differs from number of cols of E ( 2 * nd)'); +if not(2 * manifold_dim == rows) + mess_err(opts, 'error_arguments', ... + ['number of rows of B differs from number of cols of E ' ... + '(2 * manifold_dim)']); end if issymmetric(eqn.E_) && issymmetric(eqn.M_) @@ -92,12 +95,12 @@ case 'N' X1 = eqn.M_(one, one) \ B(twob, :); X = [X1; eqn.M_(one, one) \ ... - (B(one , : ) - eqn.E_(one, one) * X1)]; + (B(one, :) - eqn.E_(one, one) * X1)]; case 'T' X1 = eqn.M_(one, one) \ B(:, twob)'; X = [X1; eqn.M_(one, one) \ ... - (B(:, one)' - eqn.E_(one, one) * X1)]; + (B(:, one)' - eqn.E_(one, one) * X1)]; end @@ -107,12 +110,12 @@ case 'N' X1 = eqn.M_(one, one)' \ B(twob, :); X = [X1; eqn.M_(one, one)' \ ... - (B(one , : ) - eqn.E_(one, one)' * X1)]; + (B(one, :) - eqn.E_(one, one)' * X1)]; case 'T' X1 = eqn.M_(one, one)' \ B(:, twob)'; X = [X1; eqn.M_(one, one)' \ ... - (B(:, one)' - eqn.E_(one, one)' * X1)]; + (B(:, one)' - eqn.E_(one, one)' * X1)]; end end diff --git a/usfs/dae_2/get_ritz_vals_dae_2.m b/usfs/dae_2/get_ritz_vals_dae_2.m index 78d852a..74ea36d 100644 --- a/usfs/dae_2/get_ritz_vals_dae_2.m +++ b/usfs/dae_2/get_ritz_vals_dae_2.m @@ -1,4 +1,5 @@ -function [rw, Hp, Hm, Vp, Vm] = get_ritz_vals_dae_2(eqn, opts, oper, U, W, p_old) +function [rw, Hp, Hm, Vp, Vm, eqn, opts, oper] = ... + get_ritz_vals_dae_2(eqn, opts, oper, U, W, p_old) % This function is an exact copy of the Penzl heuristic part in mess_para. % the only difference is that B or C and K are filled up by trailing zero % blocks to allow for the computation of the Ritz values with respect to @@ -10,54 +11,75 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - % Input data not completely checked! -if(not(isfield(eqn,'A_'))) || not(isnumeric(eqn.A_)) - error('MESS:error_arguments','field eqn.A_ is not defined'); +if (not(isfield(eqn, 'A_'))) || not(isnumeric(eqn.A_)) + mess_err(opts, 'error_arguments', 'field eqn.A_ is not defined'); end -[result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A','E'); + +[result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A', 'E'); + if not(result) - error('MESS:control_data', 'system data is not completely defined or corrupted'); + mess_err(opts, 'control_data', ... + 'system data is not completely defined or corrupted'); end % returns order of A or states of A, A is supposed to be square -n = size(eqn.A_,1); +n = size(eqn.A_, 1); +nv = oper.size(eqn, opts); %% -% here we add the trailing zero blocks. Note that we are not passing the -% eqn structure back as an output, so this change is not visible in +% here we add the trailing zero blocks. Note that we are passing the +% eqn structure back as an output, so to ensure this change is not visible in % anything above this routine and will only be passed on to the function -% handles used in here. +% handles used in here, we need to truncate again later. if isfield(eqn, 'U') && not(isempty(eqn.U)) eqn.U = [eqn.U; zeros(n - size(eqn.U, 1), size(eqn.U, 2))]; end -if isfield(eqn,'V') && not(isempty(eqn.V)) - eqn.V = [eqn.V; zeros(n - size(eqn.V,1), size(eqn.V,2))]; + +if isfield(eqn, 'V') && not(isempty(eqn.V)) + eqn.V = [eqn.V; zeros(n - size(eqn.V, 1), size(eqn.V, 2))]; end + if isfield(opts.shifts, 'method') && ... strcmp(opts.shifts.method, 'projection') U = [U; zeros(n - size(U, 1), size(U, 2))]; if isempty(W) - % first shifts are computed with U = eqn.G and W = A * eqn.G + % first shifts are computed with U = eqn.W and W = A * eqn.W W = oper.mul_A(eqn, opts, eqn.type, U, 'N'); + if isfield(eqn, 'haveUV') && eqn.haveUV + switch eqn.type + case 'N' + W = W + eqn.U * (eqn.V' * U); + case 'T' + W = W + eqn.V * (eqn.U' * U); + end + end else W = [W; zeros(n - size(W, 1), size(W, 2))]; end - rw = mess_projection_shifts(eqn, opts, oper, U, ... - W, p_old); + rw = mess_projection_shifts(eqn, opts, oper, U, W, p_old); else - if (not(isfield(opts.shifts, 'b0')) || isempty(opts.shifts.b0)) - opts.shifts.b0 = ones(n,1); + if not(isfield(opts.shifts, 'b0')) || isempty(opts.shifts.b0) + opts.shifts.b0 = ones(n, 1); else - if length(opts.shifts.b0) ~= n - warning('MESS:b0',... - 'b0 has the wrong length. Switching to default.'); - opts.shifts.b0 = ones(n,1); + if not(length(opts.shifts.b0) == n) + mess_warn(opts, 'b0', ... + 'b0 has the wrong length. Switching to default.'); + opts.shifts.b0 = ones(n, 1); end end [rw, Hp, Hm, Vp, Vm] = mess_get_ritz_vals(eqn, opts, oper); end +%% +% Let's truncate U and V back +if isfield(eqn, 'U') && not(isempty(eqn.U)) + eqn.U = eqn.U(1:nv, :); +end +if isfield(eqn, 'V') && not(isempty(eqn.V)) + eqn.V = eqn.V(1:nv, :); +end +end diff --git a/usfs/dae_2/init_dae_2.m b/usfs/dae_2/init_dae_2.m index 0fa474c..31686c7 100644 --- a/usfs/dae_2/init_dae_2.m +++ b/usfs/dae_2/init_dae_2.m @@ -32,126 +32,131 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input Parameters -if(nargin<=3) - error('MESS:check_data','Number of input Arguments must be at least 3'); +if nargin <= 3 + mess_err(opts, 'check_data', 'Number of input Arguments must be at least 3'); -%% result = init_dae_2(eqn, opts, oper, flag1); -elseif(nargin==4) + %% result = init_dae_2(eqn, opts, oper, flag1); +elseif nargin == 4 switch flag1 - case {'A','a'} - [eqn,result] = checkA(eqn); - case {'E','e'} - [eqn,result] = checkE(eqn); + case {'A', 'a'} + [eqn, result] = checkA(eqn, opts); + case {'E', 'e'} + [eqn, result] = checkE(eqn, opts); otherwise - error('MESS:check_data','flag1 has to be ''A'' or ''E'''); + mess_err(opts, 'check_data', 'flag1 has to be ''A'' or ''E'''); end -%% result = init_dae_2(eqn, opts, oper,flag1,flag2); -elseif(nargin==5) + %% result = init_dae_2(eqn, opts, oper,flag1,flag2); +elseif nargin == 5 switch flag1 - case {'A','a'} - [eqn,result] = checkA(eqn); + case {'A', 'a'} + [eqn, result] = checkA(eqn, opts); switch flag2 - case {'A','a'} - [eqn,resultA] = checkA(eqn); - result = result && resultA; - case {'E','e'} - [eqn,resultE] = checkE(eqn); - result = result &&resultE; + case {'A', 'a'} + [eqn, resultA] = checkA(eqn, opts); + result = result && resultA; + case {'E', 'e'} + [eqn, resultE] = checkE(eqn, opts); + result = result && resultE; otherwise - error('MESS:check_data','flag2 has to be ''A'' or ''E'''); + mess_err(opts, 'check_data', ... + 'flag2 has to be ''A'' or ''E'''); end - case {'E','e'} - [eqn, result] = checkE(eqn); + case {'E', 'e'} + [eqn, result] = checkE(eqn, opts); switch flag2 - case {'A','a'} - [eqn,resultA] = checkA(eqn); - result = result && resultA; - case {'E','e'} - [eqn,resultE] = checkE(eqn); - result = result && resultE; + case {'A', 'a'} + [eqn, resultA] = checkA(eqn, opts); + result = result && resultA; + case {'E', 'e'} + [eqn, resultE] = checkE(eqn, opts); + result = result && resultE; otherwise - error('MESS:check_data','flag2 has to be ''A'' or ''E'''); + mess_err(opts, 'check_data', ... + 'flag2 has to be ''A'' or ''E'''); end otherwise - error('MESS:check_data','flag1 has to be ''A'' or ''E'''); + mess_err(opts, 'check_data', 'flag1 has to be ''A'' or ''E'''); end end end %% checkdata for A_ -function [eqn,result] = checkA(eqn) +function [eqn, result] = checkA(eqn, opts) % A = [ A11 A12; % A21 0] % -if not(isfield(eqn, 'st')) || not(isnumeric(eqn.st)) - error('MESS:st',... - 'Missing or Corrupted st field detected in equation structure.'); +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'error_arguments', ... + ['Missing or corrupted manifold_dim field detected in ' ... + 'equation structure.']); end -if not(isfield(eqn,'A_')) || not(isnumeric(eqn.A_)) - error('MESS:equation_data',... - 'Empty or Corrupted field A detected in equation structure.'); +if not(isfield(eqn, 'A_')) || not(isnumeric(eqn.A_)) + mess_err(opts, 'equation_data', ... + 'Empty or corrupted field A detected in equation structure.'); end -if (size(eqn.A_,1) ~= size(eqn.A_,2)) - error('MESS:error_arguments', 'field eqn.A_ has to be quadratic'); +if not(size(eqn.A_, 1) == size(eqn.A_, 2)) + mess_err(opts, 'error_arguments', 'field eqn.A_ has to be quadratic'); end -if(not(issparse(eqn.A_))) - warning('MESS:check_data','A has to be sparse for best performance'); +if not(issparse(eqn.A_)) + mess_warn(opts, 'check_data', 'A has to be sparse for best performance'); end % check if lower right block is empty -if (any(any(eqn.A_(eqn.st+1:end,eqn.st+1:end)))) - error('MESS:equation_data',... - 'Corrupted field A detected in equation structure.'); +if any(any(eqn.A_(eqn.manifold_dim + 1:end, eqn.manifold_dim + 1:end))) + mess_err(opts, 'equation_data', ... + 'Corrupted field A detected in equation structure.'); end -result = 1; +result = true; end %% checkdata for E_ -function [eqn,result] = checkE(eqn) -if not(isfield(eqn, 'haveE')), eqn.haveE = 0; end -if not(isfield(eqn, 'st')) || not(isnumeric(eqn.st)) - error('MESS:st',... - ['Missing or Corrupted st field detected in equation ' ... - 'structure.']); +function [eqn, result] = checkE(eqn, opts) +if not(isfield(eqn, 'haveE')) + eqn.haveE = false; +end +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'error_arguments', ... + ['Missing or corrupted manifold_dim field detected in equation ' ... + 'structure.']); end if eqn.haveE - if not(isfield(eqn,'E_')) || not(isnumeric(eqn.E_)) - error('MESS:equation_data',... - 'Empty or Corrupted field E detected in equation structure.'); + if not(isfield(eqn, 'E_')) || not(isnumeric(eqn.E_)) + mess_err(opts, 'equation_data', ... + 'Empty or corrupted field E detected in equation structure.'); end - if (size(eqn.E_,1) ~= size(eqn.E_,2)) - error('MESS:error_arguments', 'field eqn.E_ has to be quadratic'); + if not(size(eqn.E_, 1) == size(eqn.E_, 2)) + mess_err(opts, 'error_arguments', 'field eqn.E_ has to be quadratic'); end if not(issparse(eqn.E_)) - warning('MESS:check_data','E has to be sparse for best performance'); + mess_warn(opts, 'check_data', ... + 'E has to be sparse for best performance'); end - st = eqn.st; + n_ode = eqn.manifold_dim; % E = [ E1 0; % 0 0] - if full(any([any(eqn.E_(1:st, st + 1:end)), any(eqn.E_(st+1:end,:))])) - warning('MESS:check_data',['E has to be non-zero only in the ' ... - 'upper left st x st block']); + if full(any([any(eqn.E_(1:n_ode, n_ode + 1:end)), any(eqn.E_(n_ode + 1:end, :))])) + mess_warn(opts, 'check_data', ['E has to be non-zero only in the ' ... + 'upper left n_ode x n_ode block']); end else % E = [ I 0 ] % [ 0 0 ] - if not(isfield(eqn,'A_')) || not(isnumeric(eqn.A_)) - error('MESS:equation_data',... - 'Empty or Corrupted field A detected in equation structure.'); + if not(isfield(eqn, 'A_')) || not(isnumeric(eqn.A_)) + mess_err(opts, 'equation_data', ... + 'Empty or corrupted field A detected in equation structure.'); end - st = eqn.st; - n=size(eqn.A_,1); - eqn.E_=sparse(1:st,1:st,ones(st, 1),n,n,st); + n_ode = eqn.manifold_dim; + n = size(eqn.A_, 1); + eqn.E_ = sparse(1:n_ode, 1:n_ode, ones(n_ode, 1), n, n, n_ode); end -result = 1; +result = true; end diff --git a/usfs/dae_2/init_res_dae_2.m b/usfs/dae_2/init_res_dae_2.m index 350f851..bdcbfd3 100644 --- a/usfs/dae_2/init_res_dae_2.m +++ b/usfs/dae_2/init_res_dae_2.m @@ -1,13 +1,16 @@ -function [ W, res0, eqn, opts, oper ] = init_res_dae_2( eqn, opts, oper, RHS) -%% function init_res initializes the low rank residual W and res0 -% function [ W, res0, eqn, opts, oper ] = init_res_dae_2( eqn, opts, oper, RHS) +function [W, res0, eqn, opts, oper] = init_res_dae_2(eqn, opts, oper, W, T) +%% function init_res initializes the low-rank residual W and res0 +% function [W, res0, eqn, opts, oper] = ... +% init_res_dae_2(eqn, opts, oper, W, T) % % Input/Output: % % eqn structure containing data for G or B or C % opts structure containing parameters for the algorithm % oper struct contains function handles for operation with A and E -% RHS right hand side matrix +% W right hand side matrix +% T matrix such that the residual is W*T*W' +% (optional, defaults to identity) % % Outputs: % @@ -19,50 +22,57 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check data -if not(isfield(eqn,'A_')) || not(isnumeric(eqn.A_)) - error('MESS:equation_data',... - 'Empty or Corrupted field A detected in equation structure.'); +if not(isfield(eqn, 'A_')) || not(isnumeric(eqn.A_)) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field A detected in equation structure.'); end -if not(isfield(eqn, 'st')) || not(isnumeric(eqn.st)) - error('MESS:st',... - 'Missing or Corrupted st field detected in equation structure.'); +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'equation_data', ... + ['Missing or Corrupted manifold_dim field detected in ' ... + 'equation structure.']); end -if not(isfield(eqn,'E_')) || not(isnumeric(eqn.E_)) - error('MESS:equation_data',... - 'Empty or Corrupted field E detected in equation structure.'); +if not(isfield(eqn, 'E_')) || not(isnumeric(eqn.E_)) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field E detected in equation structure.'); end -if (not(isnumeric(RHS))) || (not(ismatrix(RHS))) - error('MESS:error_arguments','RHS has to ba a matrix'); +if (not(isnumeric(W))) || (not(ismatrix(W))) + mess_err(opts, 'error_arguments', 'W has to ba a matrix'); end -if (eqn.st ~= size(RHS, 1)) - error('MESS:error_arguments','eqn.st differs with number of rows of RHS'); +if not(eqn.manifold_dim == size(W, 1)) + mess_err(opts, 'error_arguments', ... + 'eqn.manifold_dim differs with number of rows of W'); end -%% compute low rank residual - -W = mul_Pi(eqn,'N',RHS,'N'); - +%% compute low-rank residual +switch eqn.type + case 'N' + W = mul_Pi(eqn, opts, 'l', 'N', W, 'N'); + case 'T' + W = mul_Pi(eqn, opts, 'r', 'T', W, 'N'); +end %% compute res0 +if not(exist('T', 'var')) && opts.LDL_T + % this means we only use init_res for projection + return +end if isfield(opts, 'nm') && isfield(opts.nm, 'res0') res0 = opts.nm.res0; else if opts.LDL_T if opts.norm == 2 - res0 = max(abs(eig(RHS' * RHS * diag(eqn.S_diag)))); + res0 = max(abs(eig(W' * W * T))); else - res0 = norm(eig(RHS' * RHS * diag(eqn.S_diag)), 'fro'); + res0 = norm(eig(W' * W * T), 'fro'); end else - res0 = norm(full(RHS' * RHS), opts.norm); %opts.norm == 2 needs dense matrix + res0 = norm(full(W' * W), opts.norm); % opts.norm == 2 needs dense matrix end end end - diff --git a/usfs/dae_2/init_res_post_dae_2.m b/usfs/dae_2/init_res_post_dae_2.m index d6e76ea..d3c3761 100644 --- a/usfs/dae_2/init_res_post_dae_2.m +++ b/usfs/dae_2/init_res_post_dae_2.m @@ -1,4 +1,4 @@ -function [ eqn, opts, oper ] = init_res_post_dae_2( eqn, opts, oper ) +function [eqn, opts, oper] = init_res_post_dae_2(eqn, opts, oper) %% function pre initializes data and/or functions % % Input: @@ -16,12 +16,10 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - -[eqn, opts, oper] = mul_Pi_post(eqn,opts,oper); +[eqn, opts, oper] = mul_Pi_post(eqn, opts, oper); end - diff --git a/usfs/dae_2/init_res_pre_dae_2.m b/usfs/dae_2/init_res_pre_dae_2.m index f98739b..eb1c756 100644 --- a/usfs/dae_2/init_res_pre_dae_2.m +++ b/usfs/dae_2/init_res_pre_dae_2.m @@ -1,4 +1,4 @@ -function [ eqn, opts, oper ] = init_res_pre_dae_2( eqn, opts, oper ) +function [eqn, opts, oper] = init_res_pre_dae_2(eqn, opts, oper) %% function pre initializes data and/or functions % % Input: @@ -16,12 +16,10 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - -[eqn, opts, oper] = mul_Pi_pre(eqn,opts,oper); +[eqn, opts, oper] = mul_Pi_pre(eqn, opts, oper); end - diff --git a/usfs/dae_2/mess_usfs_dae_2.m b/usfs/dae_2/mess_usfs_dae_2.m index 82a05fe..eb0e575 100644 --- a/usfs/dae_2/mess_usfs_dae_2.m +++ b/usfs/dae_2/mess_usfs_dae_2.m @@ -7,7 +7,7 @@ % % The fieldnames for A and E have to end with _ to indicate that the data % are inputdata for the algorithm. Further A_ and E_ have to be -% substructured as given below. +% substructured as given below. % % eqn.A_ = [ A11 A12; % A21 0 ] @@ -17,7 +17,7 @@ % eqn.C = C % % The sizes of A11 and E1 have to coincide and the value needs to -% be specified in eqn.st. Also B has eqn.st rows and C eqn.st +% be specified in eqn.manifold_dim. Also B has eqn.manifold_dim rows and C eqn.manifold_dim % columns. % Furthermore, A12 needs to have full column-rank and A21 full row-rank. % @@ -27,7 +27,7 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % diff --git a/usfs/dae_2/mul_A_dae_2.m b/usfs/dae_2/mul_A_dae_2.m index c4f077a..e79b9c1 100644 --- a/usfs/dae_2/mul_A_dae_2.m +++ b/usfs/dae_2/mul_A_dae_2.m @@ -1,4 +1,4 @@ -function C = mul_A_dae_2(eqn, opts, opA, B, opB)%#ok +function C = mul_A_dae_2(eqn, opts, opA, B, opB) %% function mul_A performs operation C = opA(A_)*opB(B) % Depending on the size of B either multiplication with % A = [A1 F; @@ -29,68 +29,72 @@ % % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input Parameters -if (not(ischar(opA)) || not(ischar(opB))) - error('MESS:error_arguments', 'opA or opB is not a char'); +if not(ischar(opA)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opA or opB is not a char'); end -opA = upper(opA); opB = upper(opB); -if(not((opA == 'N' || opA == 'T'))) - error('MESS:error_arguments', 'opA is not ''N'' or ''T'''); +opA = upper(opA); +opB = upper(opB); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if(not((opB == 'N' || opB == 'T'))) - error('MESS:error_arguments', 'opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -if(not(isfield(eqn, 'A_'))) || not(isnumeric(eqn.A_)) - error('MESS:error_arguments', 'field eqn.A_ is not defined'); +if (not(isfield(eqn, 'A_'))) || not(isnumeric(eqn.A_)) + mess_err(opts, 'error_arguments', 'field eqn.A_ is not defined'); end -if not(isfield(eqn, 'st')) || not(isnumeric(eqn.st)) - error('MESS:st',... - 'Missing or Corrupted st field detected in equation structure.'); +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'equation_data', ... + ['Missing or corrupted manifold_dim field detected in ' ... + 'equation structure.']); end -n = size(eqn.A_,1); -st = eqn.st; +n = size(eqn.A_, 1); +n_ode = eqn.manifold_dim; +one = 1:n_ode; -[rowB,colB] = size(B); +[rowB, colB] = size(B); -if(opB == 'N') +if opB == 'N' switch rowB case n dim = n; - case st - dim = st; + case n_ode + dim = n_ode; otherwise - error('MESS:error_arguments', 'B has wrong number of rows.'); + mess_err(opts, 'error_arguments', ... + 'B has wrong number of rows.'); end else switch colB case n dim = n; - case st - dim = st; + case n_ode + dim = n_ode; otherwise - error('MESS:error_arguments', 'B has wrong number of columns.'); + mess_err(opts, 'error_arguments', ... + 'B has wrong number of columns.'); end end %% perform multiplication -if dim==n +if dim == n switch opA case 'N' @@ -98,12 +102,12 @@ switch opB case 'N' - %implement operation A_*B - C=eqn.A_*B; + % implement operation A_*B + C = eqn.A_ * B; case 'T' - %implement operation A_*B' - C=eqn.A_*B'; + % implement operation A_*B' + C = eqn.A_ * B'; end @@ -112,13 +116,12 @@ switch opB case 'N' - %implement operation A_'*B - C=eqn.A_'*B; - + % implement operation A_'*B + C = eqn.A_' * B; case 'T' - %implement operation A_'*B' - C=eqn.A_'*B'; + % implement operation A_'*B' + C = eqn.A_' * B'; end @@ -128,10 +131,11 @@ switch opA case 'N' - V = eqn.A_(1:st,1:st)*mul_Pi(eqn, 'T', B , opB); + V = eqn.A_(one, one) * mul_Pi(eqn, opts, 'r', 'N', B, opB); + C = mul_Pi(eqn, opts, 'l', 'N', V, 'N'); case 'T' - V = eqn.A_(1:st,1:st)'*mul_Pi(eqn, 'T', B , opB); + V = eqn.A_(one, one)' * mul_Pi(eqn, opts, 'l', 'T', B, opB); + C = mul_Pi(eqn, opts, 'r', 'T', V, 'N'); end - C = mul_Pi(eqn, 'N', V, 'N'); end end diff --git a/usfs/dae_2/mul_A_post_dae_2.m b/usfs/dae_2/mul_A_post_dae_2.m index 3388d39..b35482f 100644 --- a/usfs/dae_2/mul_A_post_dae_2.m +++ b/usfs/dae_2/mul_A_post_dae_2.m @@ -1,4 +1,4 @@ -function [eqn,opts,oper] = mul_A_post_dae_2(eqn,opts,oper) +function [eqn, opts, oper] = mul_A_post_dae_2(eqn, opts, oper) % MUL_A_POST_DAE_2 clears the hidden manifold projector used in % mul_A_dae_2. % @@ -9,11 +9,11 @@ % % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % -[eqn,opts,oper] = mul_Pi_post(eqn,opts,oper); \ No newline at end of file +[eqn, opts, oper] = mul_Pi_post(eqn, opts, oper); diff --git a/usfs/dae_2/mul_A_pre_dae_2.m b/usfs/dae_2/mul_A_pre_dae_2.m index 59b7f26..f290a87 100644 --- a/usfs/dae_2/mul_A_pre_dae_2.m +++ b/usfs/dae_2/mul_A_pre_dae_2.m @@ -1,4 +1,4 @@ -function [eqn,opts,oper] = mul_A_pre_dae_2(eqn,opts,oper) +function [eqn, opts, oper] = mul_A_pre_dae_2(eqn, opts, oper) % MUL_A_PRE_DAE_2 creates the hidden manifold projector used in % mul_A_dae_2. % @@ -9,12 +9,11 @@ % % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - -[eqn,opts,oper] = mul_Pi_pre(eqn,opts,oper); \ No newline at end of file +[eqn, opts, oper] = mul_Pi_pre(eqn, opts, oper); diff --git a/usfs/dae_2/mul_ApE_dae_2.m b/usfs/dae_2/mul_ApE_dae_2.m index 756701b..d7d5313 100644 --- a/usfs/dae_2/mul_ApE_dae_2.m +++ b/usfs/dae_2/mul_ApE_dae_2.m @@ -1,4 +1,4 @@ -function C = mul_ApE_dae_2(eqn, opts, opA,p,opE, B, opB)%#ok +function C = mul_ApE_dae_2(eqn, opts, opA, p, opE, B, opB) %% function mul_ApE_default performs operation C = (opA(A_)+p*opE(E_))*opB(B) % @@ -25,94 +25,94 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - - %% check input Parameters -if (not(ischar(opA)) || not(ischar(opB))|| not(ischar(opE))) - error('MESS:error_arguments', 'opA, opE or opB is not a char'); +if not(ischar(opA)) || not(ischar(opB)) || not(ischar(opE)) + mess_err(opts, 'error_arguments', 'opA, opE or opB is not a char'); end -opA = upper(opA); opB = upper(opB);opE = upper(opE); -if(not((opA == 'N' || opA == 'T'))) - error('MESS:error_arguments', 'opA is not ''N'' or ''T'''); +opA = upper(opA); +opB = upper(opB); +opE = upper(opE); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if(not((opB == 'N' || opB == 'T'))) - error('MESS:error_arguments', 'opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end -if(not((opE == 'N' || opE == 'T'))) - error('MESS:error_arguments', 'opE is not ''N'' or ''T'''); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end -if(not(isnumeric(p))) - error('MESS:error_arguments','p is not numeric'); +if not(isnumeric(p)) + mess_err(opts, 'error_arguments', 'p is not numeric'); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -if(not(isfield(eqn, 'A_'))) || not(isnumeric(eqn.A_)) - error('MESS:error_arguments', 'field eqn.A_ is not defined'); +if (not(isfield(eqn, 'A_'))) || not(isnumeric(eqn.A_)) + mess_err(opts, 'error_arguments', 'field eqn.A_ is not defined'); end -if(not(isfield(eqn, 'E_'))) || not(isnumeric(eqn.E_)) - error('MESS:error_arguments', 'field eqn.E_ is not defined'); +if (not(isfield(eqn, 'E_'))) || not(isnumeric(eqn.E_)) + mess_err(opts, 'error_arguments', 'field eqn.E_ is not defined'); end -n = size(eqn.A_,1); -st = eqn.st; +n = size(eqn.A_, 1); +n_ode = eqn.manifold_dim; -[rowB,colB] = size(B); +[rowB, colB] = size(B); -if(opB == 'N') - if(n > rowB) - B = [B; zeros(n - st, colB)]; +if opB == 'N' + if n > rowB + B = [B; zeros(n - n_ode, colB)]; elseif n < rowB - error('MESS:error_arguments', 'B has more rows than A'); + mess_err(opts, 'error_arguments', 'B has more rows than A'); end else - if(n > colB) - B = [B, zeros(rowB, n - st)]; + if n > colB + B = [B, zeros(rowB, n - n_ode)]; elseif n < colB - error('MESS:error_arguments', 'B has more columns than A'); + mess_err(opts, 'error_arguments', 'B has more columns than A'); end end %% perform multiplication switch opA - case 'N' + case 'N' - switch opB + switch opB - case 'N' - %implement operation (A_+p*E_)*B - C=(eqn.A_+p*eqn.E_)*B; + case 'N' + % implement operation (A_+p*E_)*B + C = (eqn.A_ + p * eqn.E_) * B; - case 'T' - %implement operation (A_+p*E_)*B' - C=(eqn.A_+p*eqn.E_)*B'; - end + case 'T' + % implement operation (A_+p*E_)*B' + C = (eqn.A_ + p * eqn.E_) * B'; + end - case 'T' + case 'T' - switch opB + switch opB - case 'N' - %implement operation (A_+p*E_)'*B - C=(eqn.A_+p*eqn.E_)'*B; + case 'N' + % implement operation (A_+p*E_)'*B + C = (eqn.A_ + p * eqn.E_)' * B; - case 'T' - %implement operatio (A_+p*E_)'*B' - C=(eqn.A_+p*eqn.E_)'*B'; - end + case 'T' + % implement operatio (A_+p*E_)'*B' + C = (eqn.A_ + p * eqn.E_)' * B'; + end end end diff --git a/usfs/dae_2/mul_E_dae_2.m b/usfs/dae_2/mul_E_dae_2.m index d39402c..590bc3f 100644 --- a/usfs/dae_2/mul_E_dae_2.m +++ b/usfs/dae_2/mul_E_dae_2.m @@ -1,4 +1,4 @@ -function C = mul_E_dae_2(eqn, opts, opE, B, opB)%#ok +function C = mul_E_dae_2(eqn, opts, opE, B, opB) %% function mul_E performs operation C = opE(E_)*opB(B) % @@ -25,86 +25,102 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input Parameters -if (not(ischar(opE)) || not(ischar(opB))) - error('MESS:error_arguments', 'opE or opB is not a char'); +if not(ischar(opE)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opE or opB is not a char'); end -opE = upper(opE); opB = upper(opB); -if(not((opE == 'N' || opE == 'T'))) - error('MESS:error_arguments','opE is not ''N'' or ''T'''); +opE = upper(opE); +opB = upper(opB); + +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end -if(not((opB == 'N' || opB == 'T'))) - error('MESS:error_arguments','opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -if(not(isfield(eqn, 'E_'))) || not(isnumeric(eqn.E_)) - error('MESS:error_arguments', 'field eqn.E_ is not defined'); +if (not(isfield(eqn, 'E_'))) || not(isnumeric(eqn.E_)) + mess_err(opts, 'error_arguments', 'field eqn.E_ is not defined'); end -if(not(isfield(eqn, 'S_'))) || not(isnumeric(eqn.S_)) - error('MESS:error_arguments', ['field eqn.S_ is not defined. Did ' ... - 'you forget to run mul_E_pre?']); +if (not(isfield(eqn, 'M_'))) || not(isnumeric(eqn.M_)) + mess_err(opts, 'error_arguments', ... + 'field eqn.M_ is not defined. Did you forget to run mul_E_pre?'); end -if not(isfield(eqn, 'st')) || not(isnumeric(eqn.st)) - error('MESS:st',... - 'Missing or Corrupted st field detected in equation structure.'); +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'error_arguments', ... + ['Missing or Corrupted manifold_dim field detected in ' ... + 'equation structure.']); end -st = eqn.st; +n = size(eqn.E_, 1); +one = 1:eqn.manifold_dim; + switch opB - case 'N' - rowB=size(B,1); - case 'T' - rowB=size(B,2); + case 'N' + dim = size(B, 1); + case 'T' + dim = size(B, 2); end -if rowB~=st && rowB~=size(eqn.E_,1) - error('MESS:error_arguments', 'size of B does not match data in E'); + +if not(dim == eqn.manifold_dim) && not(dim == n) + mess_err(opts, 'error_arguments', 'size of B does not match data in E'); end %% perform multiplication -switch opE +if dim == n + switch opE - case 'N' - switch opB + case 'N' - %implement operation E_*B - case 'N' - C = eqn.S_(1 : rowB, 1 : rowB) * B; + switch opB - %implement operation E_*B' - case 'T' - C = eqn.S_(1 : rowB, 1 : rowB) * B'; - end + case 'N' + % implement operation A_*B + C = eqn.M_ * B; - case 'T' - switch opB + case 'T' + % implement operation A_*B' + C = eqn.M_ * B'; + + end + + case 'T' + + switch opB + + case 'N' + % implement operation A_'*B + C = eqn.M_' * B; + + case 'T' + % implement operation A_'*B' + C = eqn.M_' * B'; + + end - %implement operation E_'*B - case 'N' - C = eqn.S_(1 : rowB, 1 : rowB)' * B; + end - %implement operation E_'*B' - case 'T' - C = eqn.S_(1 : rowB, 1 : rowB)' * B'; - end +else + switch opE + case 'N' + V = eqn.E_(one, one) * mul_Pi(eqn, opts, 'r', 'N', B, opB); + C = mul_Pi(eqn, opts, 'l', 'N', V, 'N'); + case 'T' + V = eqn.E_(one, one)' * mul_Pi(eqn, opts, 'l', 'T', B, opB); + C = mul_Pi(eqn, opts, 'r', 'T', V, 'N'); + end end -% This portion would make multiplication with E more correct. Still, -% currently explicit projection is not needed anywhere in our codes and it -% easily double the runtime. -% if rowB==st -% C = mul_Pi(eqn,'N',C,'N'); -% end end diff --git a/usfs/dae_2/mul_E_post_dae_2.m b/usfs/dae_2/mul_E_post_dae_2.m index 004f049..09eddc8 100644 --- a/usfs/dae_2/mul_E_post_dae_2.m +++ b/usfs/dae_2/mul_E_post_dae_2.m @@ -1,4 +1,4 @@ -function [ eqn, opts, oper ] = mul_E_post_dae_2( eqn, opts, oper ) +function [eqn, opts, oper] = mul_E_post_dae_2(eqn, opts, oper) %% function post finalizes data and/or functions % % Input: @@ -16,22 +16,22 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - if(not(isfield(eqn, 'Scount'))) || not(isnumeric(eqn.Scount)) - error('MESS:error_arguments', ['field eqn.Scount is not defined. Did ' ... - 'you forget to run mul_E_pre?']); - end - if eqn.Scount>1 - eqn.Scount=eqn.Scount-1; - else - eqn=rmfield(eqn,'S_'); - eqn=rmfield(eqn,'Scount'); - end +if (not(isfield(eqn, 'Mcount'))) || not(isnumeric(eqn.Mcount)) + mess_err(opts, 'error_arguments', ['field eqn.Mcount is not defined. Did ' ... + 'you forget to run mul_E_pre?']); +end +if eqn.Mcount > 1 + eqn.Mcount = eqn.Mcount - 1; +else + eqn = rmfield(eqn, 'M_'); + eqn = rmfield(eqn, 'Mcount'); +end -[eqn,opts,oper] = mul_Pi_post(eqn,opts,oper); +[eqn, opts, oper] = mul_Pi_post(eqn, opts, oper); end diff --git a/usfs/dae_2/mul_E_pre_dae_2.m b/usfs/dae_2/mul_E_pre_dae_2.m index ad682ca..25c3ce3 100644 --- a/usfs/dae_2/mul_E_pre_dae_2.m +++ b/usfs/dae_2/mul_E_pre_dae_2.m @@ -1,4 +1,4 @@ -function [ eqn, opts, oper ] = mul_E_pre_dae_2( eqn, opts, oper ) +function [eqn, opts, oper] = mul_E_pre_dae_2(eqn, opts, oper) %% function pre initializes data and/or functions % % Input: @@ -16,33 +16,35 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - alpha=-1/50; - if isfield(eqn,'st')&&isnumeric(eqn.st) - st=eqn.st; - else - error('MESS:wrong_arguments','missing or corrupted field st detected'); - end - if not(isfield(eqn,'S_')) - if(not(isfield(eqn,'E_')) || not(isnumeric(eqn.E_))... - || not(isfield(eqn,'A_'))) || not(isnumeric(eqn.A_)) - error('MESS:error_arguments','field eqn.E_ or eqn.A_ is not defined or corrupted'); +alpha = -1 / 50; +if isfield(eqn, 'manifold_dim') && isnumeric(eqn.manifold_dim) + one = 1:eqn.manifold_dim; +else + mess_err(opts, 'wrong_arguments', ... + 'missing or corrupted field st detected'); +end +if not(isfield(eqn, 'M_')) + if not(isfield(eqn, 'E_')) || not(isnumeric(eqn.E_)) || ... + not(isfield(eqn, 'A_')) || not(isnumeric(eqn.A_)) + mess_err(opts, 'error_arguments', ... + 'field eqn.E_ or eqn.A_ is not defined or corrupted'); end - eqn.S_=alpha*eqn.A_; - eqn.S_(1:st,1:st)=eqn.E_(1:st,1:st); - eqn.Scount=1; - else - if(not(isfield(eqn, 'Scount'))) || not(isnumeric(eqn.Scount)) - error('MESS:error_arguments', ['field eqn.Scount is not defined. Did ' ... - 'you forget to run mul_E_pre?']); + eqn.M_ = alpha * eqn.A_; + eqn.M_(one, one) = eqn.E_(one, one); + eqn.Mcount = 1; +else + if not(isfield(eqn, 'Mcount')) || not(isnumeric(eqn.Mcount)) + mess_err(opts, 'error_arguments', ... + 'field eqn.Mcount is not defined. Did ', ... + 'you forget to run mul_E_pre?'); end - eqn.Scount=eqn.Scount+1; - end - - [eqn,opts,oper] = mul_Pi_pre(eqn,opts,oper); + eqn.Mcount = eqn.Mcount + 1; end +[eqn, opts, oper] = mul_Pi_pre(eqn, opts, oper); +end diff --git a/usfs/dae_2/private/mul_Pi.m b/usfs/dae_2/private/mul_Pi.m index b9185d2..f03f020 100644 --- a/usfs/dae_2/private/mul_Pi.m +++ b/usfs/dae_2/private/mul_Pi.m @@ -1,51 +1,68 @@ -function C = mul_Pi(eqn,opP,B, opB) +function C = mul_Pi(eqn, opts, type, opP, B, opB) % MUL_Pi multiplies with the hidden manifold projection matrix or its % transpose. Note that the multiplication is actually implemented as the % solution of a saddle point structured linear system. % % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - -if not(isfield(eqn,'P_')) - error('MESS:equation_data',['Could not find required field ''P_''.',... - 'Did you not run mul_Pi_pre? ']); +if not(isfield(eqn, 'P_')) + mess_err(opts, 'equation_data', ... + 'Could not find required field ''P_''. Did you not run mul_Pi_pre?'); end -n = size(eqn.P_,1); -st = eqn.st; +n = size(eqn.P_, 1); +one = 1:eqn.manifold_dim; +n_two = n - eqn.manifold_dim; -if opP == 'N' - if opB == 'N' - C = eqn.P_ \ [B; zeros(n -st,size(B,2))]; - C = eqn.E_(1:eqn.st,1:eqn.st) * C(1:eqn.st,:); - elseif opB== 'T' - C = eqn.P_ \ [B, zeros(size(B,1),n-st)]'; - C = eqn.E_(1:eqn.st,1:eqn.st) * C(1:eqn.st,:); - else - error('MESS:input_data','opB must be either ''N'' or ''T''.'); - end -elseif opP == 'T' - if opB == 'N' +%% build extended RHS +switch opB + case 'N' H = B; - elseif opB== 'T' + case 'T' H = B'; + otherwise + mess_err(opts, 'input_data', ... + 'opB must be either ''N'' or ''T''.'); +end + +%% solve augmented saddle point system +if type == 'r' + if opP == 'N' + H = [eqn.E_(one, one) * H; zeros(n_two, size(H, 2))]; + C = eqn.P_ \ H; + C = C(one, :); + elseif opP == 'T' + H = [H; zeros(n_two, size(H, 2))]; + C = eqn.P_' \ H; + C = eqn.E_(one, one)' * C(one, :); else - error('MESS:input_data','opB must be either ''N'' or ''T''.'); - end - H = [eqn.E_(1:eqn.st,1:eqn.st)' * H; zeros(n-st,size(H,2))]; - C = eqn.P_' \ H; - C = C(1:eqn.st,:); + mess_err(opts, 'input_data', ... + 'opP must be either ''N'' or ''T''.'); + end +elseif type == 'l' + if opP == 'N' + H = [H; zeros(n_two, size(H, 2))]; + C = eqn.P_ \ H; + C = eqn.E_(one, one) * C(one, :); + elseif opP == 'T' + H = [eqn.E_(one, one)' * H; zeros(n_two, size(H, 2))]; + C = eqn.P_' \ H; + C = C(one, :); + else + mess_err(opts, 'input_data', ... + 'opP must be either ''N'' or ''T''.'); + end else - error('MESS:input_data','opP must be either ''N'' or ''T''.'); + mess_err(opts, 'input_data', ... + 'type must be either ''N'' or ''T''.'); end end - diff --git a/usfs/dae_2/private/mul_Pi_post.m b/usfs/dae_2/private/mul_Pi_post.m index 825dbe5..2aef91e 100644 --- a/usfs/dae_2/private/mul_Pi_post.m +++ b/usfs/dae_2/private/mul_Pi_post.m @@ -1,23 +1,23 @@ -function [eqn, opts, oper] = mul_Pi_post(eqn,opts,oper) +function [eqn, opts, oper] = mul_Pi_post(eqn, opts, oper) % MUL_Pi multiplies with the hidden manifold projection matrix or it % transpose. Note that the multiplication is actually implemented as the % solution of a saddle point system. % % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % -if isfield(eqn,'Pcount') +if isfield(eqn, 'Pcount') if eqn.Pcount - eqn.Pcount = eqn.Pcount -1; + eqn.Pcount = eqn.Pcount - 1; if eqn.Pcount == 0 eqn = rmfield(eqn, 'P_'); eqn = rmfield(eqn, 'Pcount'); end end -end \ No newline at end of file +end diff --git a/usfs/dae_2/private/mul_Pi_pre.m b/usfs/dae_2/private/mul_Pi_pre.m index 42ad45f..7df27fc 100644 --- a/usfs/dae_2/private/mul_Pi_pre.m +++ b/usfs/dae_2/private/mul_Pi_pre.m @@ -1,23 +1,21 @@ -function [eqn, opts, oper] = mul_Pi_pre(eqn,opts,oper) +function [eqn, opts, oper] = mul_Pi_pre(eqn, opts, oper) % MUL_Pi multiplies with the hidden manifold projection matrix or it % transpose. Note that the multiplication is actually implemented as the % solution of a saddle point system. % % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - -if not(isfield(eqn,'P_')) +if not(isfield(eqn, 'P_')) eqn.P_ = eqn.A_; - eqn.P_(1:eqn.st, 1:eqn.st) = eqn.E_(1:eqn.st,1:eqn.st); + eqn.P_(1:eqn.manifold_dim, 1:eqn.manifold_dim) = eqn.E_(1:eqn.manifold_dim, 1:eqn.manifold_dim); eqn.Pcount = 1; else - eqn.Pcount = eqn.Pcount +1; + eqn.Pcount = eqn.Pcount + 1; end - diff --git a/usfs/dae_2/size_dae_2.m b/usfs/dae_2/size_dae_2.m index b0dd05b..c70870e 100644 --- a/usfs/dae_2/size_dae_2.m +++ b/usfs/dae_2/size_dae_2.m @@ -1,4 +1,4 @@ -function n = size_dae_2(eqn, opts, oper)%#ok +function n = size_dae_2(eqn, opts, oper) %#ok % function n = size_dae_2(eqn, opts, oper) % % This function returns the number of rows of the implicitly projected A @@ -20,15 +20,16 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % -if not(isfield(eqn, 'st')) || not(isnumeric(eqn.st)) - error('MESS:st',... - 'Missing or Corrupted st field detected in equation structure.'); +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'error_arguments', ... + ['Missing or corrupted manifold_dim field detected in ' ... + 'equation structure.']); end -n = eqn.st; +n = eqn.manifold_dim; end diff --git a/usfs/dae_2/sol_A_dae_2.m b/usfs/dae_2/sol_A_dae_2.m index aa95967..80cdd60 100644 --- a/usfs/dae_2/sol_A_dae_2.m +++ b/usfs/dae_2/sol_A_dae_2.m @@ -1,4 +1,4 @@ -function X = sol_A_dae_2(eqn, opts, opA, B, opB)%#ok +function X = sol_A_dae_2(eqn, opts, opA, B, opB) %% function sol_A solves solves opA(A_)*X = opB(B) % % Depending on the vertical dimension of B this solves either with @@ -29,83 +29,85 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - - %% check input Parameters -if (not(ischar(opA)) || not(ischar(opB))) - error('MESS:error_arguments', 'opA or opB is not a char'); +if not(ischar(opA)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opA or opB is not a char'); end -opA = upper(opA); opB = upper(opB); -if(not((opA == 'N' || opA == 'T'))) - error('MESS:error_arguments','opA is not ''N'' or ''T'''); +opA = upper(opA); +opB = upper(opB); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if(not((opB == 'N' || opB == 'T'))) - error('MESS:error_arguments','opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -if(not(isfield(eqn, 'A_'))) - error('MESS:error_arguments', 'field eqn.A_ is not defined'); +if not(isfield(eqn, 'A_')) + mess_err(opts, 'error_arguments', 'field eqn.A_ is not defined'); end -if not(isfield(eqn, 'st')) || not(isnumeric(eqn.st)) - error('MESS:st',... - 'Missing or Corrupted st field detected in equation structure.'); +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'error_arguments', ... + ['Missing or corrupted manifold_dim field detected in ' ... + 'equation structure.']); end -n = size(eqn.A_,1); -st = eqn.st; +n = size(eqn.A_, 1); +n_ode = eqn.manifold_dim; -[rowB,colB] = size(B); +[rowB, colB] = size(B); -if(opB == 'N') +if opB == 'N' switch rowB case n dim = n; - case st - dim = st; + case n_ode + dim = n_ode; otherwise - error('MESS:error_arguments', 'B has wrong number of rows.'); + mess_err(opts, 'error_arguments', 'B has wrong number of rows.'); end else switch colB case n dim = n; - case st - dim = st; + case n_ode + dim = n_ode; otherwise - error('MESS:error_arguments', 'B has wrong number of columns.'); + mess_err(opts, 'error_arguments', 'B has wrong number of columns.'); end end %% solve -if dim ==n +if dim == n switch opA case 'N' switch opB - %implement solve A_*X=B + % implement solve A_*X=B case 'N' - if(n ~= size(B, 1)) - error('MESS:error_arguments','number of rows of A_ differs with rows of B'); + if not(n == size(B, 1)) + mess_err(opts, 'error_arguments', ... + 'number of rows of A_ differs with rows of B'); end X = eqn.A_ \ B; - %implement solve A_*X=B' + % implement solve A_*X=B' case 'T' - if(n ~= size(B, 2)) - error('MESS:error_arguments','number of rows of A_ differs with cols of B'); + if not(n == size(B, 2)) + mess_err(opts, 'error_arguments', ... + 'number of rows of A_ differs with cols of B'); end X = eqn.A_ \ B'; end @@ -113,22 +115,24 @@ case 'T' switch opB - %implement solve A_'*X=B + % implement solve A_'*X=B case 'N' - if(n ~= size(B, 1)) - error('MESS:error_arguments','number of cols of A_ differs with rows of B'); + if not(n == size(B, 1)) + mess_err(opts, 'error_arguments', ... + 'number of cols of A_ differs with rows of B'); end X = eqn.A_' \ B; - %implement solve A_'*X=B' + % implement solve A_'*X=B' case 'T' - if(n ~= size(B, 2)) - error('MESS:error_arguments','number of cols of A_ differs with cols of B'); + if not(n == size(B, 2)) + mess_err(opts, 'error_arguments', ... + 'number of cols of A_ differs with cols of B'); end X = eqn.A_' \ B'; end end else - error('MESS:error_arguments','A is singular in these coordinates'); + mess_err(opts, 'error_arguments', 'A is singular in these coordinates'); end diff --git a/usfs/dae_2/sol_ApE_dae_2.m b/usfs/dae_2/sol_ApE_dae_2.m index b36b8b8..de0c009 100644 --- a/usfs/dae_2/sol_ApE_dae_2.m +++ b/usfs/dae_2/sol_ApE_dae_2.m @@ -1,4 +1,4 @@ -function X = sol_ApE_dae_2(eqn, opts, opA, p, opE, B, opB)%#ok +function X = sol_ApE_dae_2(eqn, opts, opA, p, opE, B, opB) %% function sol_ApE solves (opA(A_) + p*opE(E_))*X = opB(B) resp. performs X=(opA(A_)+p*opE(E_))\opB(B) % @@ -38,177 +38,177 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input Parameters -if (not(ischar(opA)) || not(ischar(opE)) || not(ischar(opB))) - error('MESS:error_arguments', 'opA, opE or opB is not a char'); +if not(ischar(opA)) || not(ischar(opE)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opA, opE or opB is not a char'); end -opA = upper(opA); opE = upper(opE); opB = upper(opB); +opA = upper(opA); +opE = upper(opE); +opB = upper(opB); -if(not((opA == 'N' || opA == 'T'))) - error('MESS:error_arguments', 'opA is not ''N'' or ''T'''); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if(not((opE == 'N' || opE == 'T'))) - error('MESS:error_arguments', 'opE is not ''N'' or ''T'''); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end -if(not((opB == 'N' || opB == 'T'))) - error('MESS:error_arguments', 'opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end -if(not(isnumeric(p))) - error('MESS:error_arguments','p is not numeric'); +if not(isnumeric(p)) + mess_err(opts, 'error_arguments', 'p is not numeric'); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -if not(isfield(eqn,'A_')) || not(isnumeric(eqn.A_)) - error('MESS:equation_data',... - 'Empty or Corrupted field A detected in equation structure.'); +if not(isfield(eqn, 'A_')) || not(isnumeric(eqn.A_)) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field A detected in equation structure.'); +end +if not(isfield(eqn, 'E_')) || not(isnumeric(eqn.E_)) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field E detected in equation structure.'); end -if not(isfield(eqn,'E_')) || not(isnumeric(eqn.E_)) - error('MESS:equation_data',... - 'Empty or Corrupted field E detected in equation structure.'); +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'error_arguments', ... + ['Missing or corrupted manifold_dim field detected in ' ... + 'equation structure.']); end -if not(isfield(eqn, 'st')) || not(isnumeric(eqn.st)) - error('MESS:st',... - 'Missing or Corrupted st field detected in equation structure.'); +if not(isfield(eqn, 'haveE')) + eqn.haveE = false; end -if not(isfield(eqn, 'haveE')), eqn.haveE = 0; end -n = size(eqn.A_,1); -st = eqn.st; +n = size(eqn.A_, 1); +n_ode = eqn.manifold_dim; -[rowB,colB] = size(B); +[rowB, colB] = size(B); -if(opB == 'N') - if (rowB ~= st) - error('MESS:error_arguments', 'B has not same number of rows as A'); - end - B = [B; zeros(n - st, colB)]; +if opB == 'N' + if not(rowB == n_ode) + mess_err(opts, 'error_arguments', 'B has not same number of rows as A'); + end + B = [B; zeros(n - n_ode, colB)]; else - if (colB ~= st) - error('MESS:error_arguments', 'B has not same number of rows as A'); - end - B = [B, zeros(rowB, n - st)]; + if not(colB == n_ode) + mess_err(opts, 'error_arguments', 'B has not same number of rows as A'); + end + B = [B, zeros(rowB, n - n_ode)]; end +%% perform solve operations for not(E_ == Identity) +if eqn.haveE + switch opA + case 'N' + switch opE + case 'N' -%% perform solve operations for E_ ~= Identity -if(eqn.haveE == 1) - switch opA - - case 'N' - switch opE + switch opB - case 'N' + % implement solve (A_+p*E_)*X=B + case 'N' + X = (eqn.A_ + p * eqn.E_) \ B; - switch opB + % implement solve (A_+p*E_)*X=B' + case 'T' + X = (eqn.A_ + p * eqn.E_) \ B'; - %implement solve (A_+p*E_)*X=B - case 'N' - X = (eqn.A_ + p * eqn.E_) \ B; + end - %implement solve (A_+p*E_)*X=B' - case 'T' - X = (eqn.A_ + p * eqn.E_) \ B'; + case 'T' - end + switch opB - case 'T' + % implement solve (A_+p*E_')*X=B + case 'N' + X = (eqn.A_ + p * eqn.E_') \ B; - switch opB + % implement solve (A_+p*E_')*X=B' + case 'T' + X = (eqn.A_ + p * eqn.E_') \ B'; - %implement solve (A_+p*E_')*X=B - case 'N' - X = (eqn.A_ + p * eqn.E_') \ B; + end - %implement solve (A_+p*E_')*X=B' - case 'T' - X = (eqn.A_ + p * eqn.E_') \ B'; + end - end + case 'T' + switch opE - end + case 'N' - case 'T' - switch opE + switch opB - case 'N' + % implement solve (A_'+p*E_)*X=B + case 'N' + X = (eqn.A_' + p * eqn.E_) \ B; - switch opB + % implement solve (A_'+p*E_)*X=B' + case 'T' + X = (eqn.A_' + p * eqn.E_) \ B'; - %implement solve (A_'+p*E_)*X=B - case 'N' - X = (eqn.A_' + p * eqn.E_) \ B; + end - %implement solve (A_'+p*E_)*X=B' - case 'T' - X = (eqn.A_' + p * eqn.E_) \ B'; + case 'T' - end + switch opB - case 'T' + % implement solve (A_'+p*E_')*X=B + case 'N' + X = (eqn.A_' + p * eqn.E_') \ B; - switch opB + % implement solve (A_'+p*E_')*X=B' + case 'T' + X = (eqn.A_' + p * eqn.E_') \ B'; - %implement solve (A_'+p*E_')*X=B - case 'N' - X = (eqn.A_' + p * eqn.E_') \ B; + end + end - %implement solve (A_'+p*E_')*X=B' - case 'T' - X = (eqn.A_' + p * eqn.E_') \ B'; + end +elseif not(eqn.haveE) + %% perform solve operations for E_ = Identity + switch opA - end - end + case 'N' - end -elseif(eqn.haveE == 0) - %% perform solve operations for E_ = Identity - switch opA + switch opB - case 'N' + % implement solve (A_+p*E_)*X=B + case 'N' + X = (eqn.A_ + p * eqn.E_) \ B; - switch opB + % implement solve (A_+p*E_)*X=B' + case 'T' + X = (eqn.A_ + p * eqn.E_) \ B'; - %implement solve (A_+p*E_)*X=B - case 'N' - X = (eqn.A_ + p * eqn.E_) \ B; + end - %implement solve (A_+p*E_)*X=B' case 'T' - X = (eqn.A_ + p * eqn.E_) \ B'; - - end - case 'T' + switch opB - switch opB + % implement solve (A_'+p*E_)*X=B + case 'N' + X = (eqn.A_' + p * eqn.E_) \ B; - %implement solve (A_'+p*E_)*X=B - case 'N' - X = (eqn.A_' + p * eqn.E_) \ B; - - %implement solve (A_'+p*E_)*X=B' - case 'T' - X = (eqn.A_' + p * eqn.E_) \ B'; + % implement solve (A_'+p*E_)*X=B' + case 'T' + X = (eqn.A_' + p * eqn.E_) \ B'; - end + end - end + end end -X = X(1 : st, :); +X = X(1:n_ode, :); end - diff --git a/usfs/dae_2/sol_E_dae_2.m b/usfs/dae_2/sol_E_dae_2.m index e635e52..0fa32e3 100644 --- a/usfs/dae_2/sol_E_dae_2.m +++ b/usfs/dae_2/sol_E_dae_2.m @@ -1,7 +1,7 @@ -function X = sol_E_dae_2(eqn, opts, opE, B, opB) %#ok -%% function sol_E solves opE(S_)*X = opB(B) resp. performs X=opE(S_)\opB(B) +function X = sol_E_dae_2(eqn, opts, opE, B, opB) +%% function sol_E solves opE(M_)*X = opB(B) resp. performs X=opE(M_)\opB(B) % sol_E_pre should be called before to construct -% S_ = [ E1 -J'; +% M_ = [ E1 -J'; % [ J 0 ] % from % A = [ A1 -J'; @@ -10,7 +10,7 @@ % 0 0] % % Input: -% eqn structure contains data for S_ +% eqn structure contains data for M_ % % opts struct contains parameters for the algorithm % @@ -33,89 +33,87 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input Parameters -if (not(ischar(opE)) || not(ischar(opB))) - error('MESS:error_arguments', 'opE or opB is not a char'); +if not(ischar(opE)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opE or opB is not a char'); end -opE = upper(opE); opB = upper(opB); -if(not((opE == 'N' || opE == 'T'))) - error('MESS:error_arguments','opE is not ''N'' or ''T'''); +opE = upper(opE); +opB = upper(opB); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end -if(not((opB == 'N' || opB == 'T'))) - error('MESS:error_arguments','opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -if(not(isfield(eqn, 'S_'))) - error('MESS:error_arguments', ['field eqn.S_ is not defined. Did ' ... - 'you forget to run sol_E_pre?']); +if not(isfield(eqn, 'M_')) + mess_err(opts, 'error_arguments', ['field eqn.M_ is not defined. Did ' ... + 'you forget to run sol_E_pre?']); end -if not(isfield(eqn, 'st')) || not(isnumeric(eqn.st)) - error('MESS:st',... - 'Missing or Corrupted st field detected in equation structure.'); +if not(isfield(eqn, 'manifold_dim')) || not(isnumeric(eqn.manifold_dim)) + mess_err(opts, 'equation_data', ... + ['Missing or corrupted manifold_dim field detected in ' ... + 'equation structure.']); end -st = eqn.st; - -n = size(eqn.S_,1); +n = size(eqn.M_, 1); -[rowB,colB] = size(B); +[rowB, colB] = size(B); -if(opB == 'N') - if(rowB == st) +if opB == 'N' + if rowB == eqn.manifold_dim B = [B; zeros(n - rowB, colB)]; - elseif rowB ~= n - error('MESS:error_arguments', 'size of B does not match data in E'); + elseif not(rowB == n) + mess_err(opts, 'error_arguments', 'size of B does not match data in E'); end else - if(colB == st) + if colB == eqn.manifold_dim B = [B, zeros(rowB, n - colB)]; - elseif colB ~= n - error('MESS:error_arguments', 'size of B does not match data in E'); + elseif not(colB == n) + mess_err(opts, 'error_arguments', 'size of B does not match data in E'); end end - %% solve switch opE case 'N' switch opB - %implement solve S_*X=B + % implement solve M_*X=B case 'N' - X = eqn.S_ \ B; + X = eqn.M_ \ B; - %implement solve S_*X=B' + % implement solve M_*X=B' case 'T' - X = eqn.S_ \ B'; + X = eqn.M_ \ B'; end case 'T' switch opB - %implement solve S_'*X=B + % implement solve M_'*X=B case 'N' - X = eqn.S_' \ B; + X = eqn.M_' \ B; - %implement solve S_'*X=B' + % implement solve M_'*X=B' case 'T' - X = eqn.S_' \ B'; + X = eqn.M_' \ B'; end end diff --git a/usfs/dae_2/sol_E_post_dae_2.m b/usfs/dae_2/sol_E_post_dae_2.m index 1e8be1b..3bb3828 100644 --- a/usfs/dae_2/sol_E_post_dae_2.m +++ b/usfs/dae_2/sol_E_post_dae_2.m @@ -1,4 +1,4 @@ -function [ eqn, opts, oper ] = sol_E_post_dae_2( eqn, opts, oper ) +function [eqn, opts, oper] = sol_E_post_dae_2(eqn, opts, oper) %% function post finalizes data and/or functions % % Input: @@ -16,19 +16,19 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - if(not(isfield(eqn, 'Scount'))) || not(isnumeric(eqn.Scount)) - error('MESS:error_arguments', ['field eqn.Scount is not defined. Did ' ... - 'you forget to run mul_E_pre?']); - end - if eqn.Scount>1 - eqn.Scount=eqn.Scount-1; - else - eqn=rmfield(eqn,'S_'); - eqn=rmfield(eqn,'Scount'); - end +if (not(isfield(eqn, 'Mcount'))) || not(isnumeric(eqn.Mcount)) + mess_err(opts, 'error_arguments', ['field eqn.Mcount is not defined. Did ' ... + 'you forget to run sol_E_pre?']); +end +if eqn.Mcount > 1 + eqn.Mcount = eqn.Mcount - 1; +else + eqn = rmfield(eqn, 'M_'); + eqn = rmfield(eqn, 'Mcount'); +end end diff --git a/usfs/dae_2/sol_E_pre_dae_2.m b/usfs/dae_2/sol_E_pre_dae_2.m index fd63fb4..5a33fa1 100644 --- a/usfs/dae_2/sol_E_pre_dae_2.m +++ b/usfs/dae_2/sol_E_pre_dae_2.m @@ -1,4 +1,4 @@ -function [ eqn, opts, oper ] = sol_E_pre_dae_2( eqn, opts, oper ) +function [eqn, opts, oper] = sol_E_pre_dae_2(eqn, opts, oper) %% function pre initializes data and/or functions % % Input: @@ -16,31 +16,28 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - alpha=-1/50; - if isfield(eqn,'st')&&isnumeric(eqn.st) - st=eqn.st; - else - error('MESS:wrong_arguments','missing or corrupted field st detected'); - end - if not(isfield(eqn,'S_')) - if(not(isfield(eqn,'E_')) || not(isnumeric(eqn.E_))... - || not(isfield(eqn,'A_'))) || not(isnumeric(eqn.A_)) - error('MESS:error_arguments','field eqn.E_ or eqn.A_ is not defined or corrupted'); - end - eqn.S_=alpha*eqn.A_; - eqn.S_(1:st,1:st)=eqn.E_(1:st,1:st); - eqn.Scount=1; - else - if(not(isfield(eqn, 'Scount'))) || not(isnumeric(eqn.Scount)) - error('MESS:error_arguments', ['field eqn.Scount is not defined. Did ' ... - 'you forget to run sol_E_pre?']); +alpha = -1 / 50; +if isfield(eqn, 'manifold_dim') && isnumeric(eqn.manifold_dim) + one = 1:eqn.manifold_dim; +else + mess_err(opts, 'wrong_arguments', ... + 'missing or corrupted field manifold_dim detected'); +end +if not(isfield(eqn, 'M_')) + if (not(isfield(eqn, 'E_')) || not(isnumeric(eqn.E_)) || ... + not(isfield(eqn, 'A_'))) || not(isnumeric(eqn.A_)) + mess_err(opts, 'error_arguments', ... + 'field eqn.E_ or eqn.A_ is not defined or corrupted'); end - eqn.Scount=eqn.Scount+1; - end + eqn.M_ = alpha * eqn.A_; + eqn.M_(one, one) = eqn.E_(one, one); + eqn.Mcount = 1; +else + eqn.Mcount = eqn.Mcount + 1; +end end - diff --git a/usfs/dae_2_so/get_ritz_vals_dae_2_so.m b/usfs/dae_2_so/get_ritz_vals_dae_2_so.m index e5b24b2..136cae5 100644 --- a/usfs/dae_2_so/get_ritz_vals_dae_2_so.m +++ b/usfs/dae_2_so/get_ritz_vals_dae_2_so.m @@ -1,74 +1,89 @@ -function [rw, Hp, Hm, Vp, Vm] = get_ritz_vals_dae_2_so(eqn, opts, oper, U, W, p_old) +function [rw, Hp, Hm, Vp, Vm, eqn, opts, oper] = ... + get_ritz_vals_dae_2_so(eqn, opts, oper, U, W, p_old) % This function is an exact copy of the Penzl heuristic part in mess_para. % the only difference is that B or C and K are filled up by trailing zero % blocks to allow for the computation of the Ritz values with respect to % the full size block matrices instead of the restriction to the % (1,1)-block for which the ADI is formulated. -% -% MMESS (Jens Saak, October 2013) % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - % Input data not completely checked! -for mat='MEKG' - if(not(isfield(eqn, sprintf('%c_',mat))) || ... - not(eval(sprintf('isnumeric(eqn.%c_)',mat)))) - error('MESS:error_arguments', 'field eqn.%c_ is not defined',mat); +for mat = 'MEKG' + if not(isfield(eqn, sprintf('%c_', mat))) || ... + not(eval(sprintf('isnumeric(eqn.%c_)', mat))) + mess_err(opts, 'error_arguments', 'field eqn.%c_ is not defined', mat); end end -[result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A','E'); +[result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A', 'E'); if not(result) - error('MESS:control_data', 'system data is not completely defined or corrupted'); + mess_err(opts, 'control_data', ... + 'system data is not completely defined or corrupted'); end % returns order of A or states of A, A is supposed to be square -nv = size(eqn.M_,1); -np = size(eqn.G_,1); +nv = size(eqn.M_, 1); +np = size(eqn.G_, 1); %% -% here we add the trailing zero blocks. Note that we are not passing the -% eqn structure back as an output, so this change is not visible in +% here we add the trailing zero blocks. Note that we are passing the +% eqn structure back as an output, so to ensure this change is not visible in % anything above this routine and will only be passed on to the function -% handles used in here. +% handles used in here, we need to truncate again later. if isfield(eqn, 'U') && not(isempty(eqn.U)) eqn.U = [eqn.U; sparse(np, size(eqn.U, 2))]; end -if isfield(eqn,'V') && not(isempty(eqn.V)) - eqn.V=[eqn.V; sparse(np, size(eqn.V,2))]; +if isfield(eqn, 'V') && not(isempty(eqn.V)) + eqn.V = [eqn.V; sparse(np, size(eqn.V, 2))]; end if isfield(opts.shifts, 'method') && ... strcmp(opts.shifts.method, 'projection') U = [U; zeros(2 * nv + np - size(U, 1), size(U, 2))]; if isempty(W) - % first shifts are computed with U = eqn.G and W = A * eqn.G + % first shifts are computed with U = eqn.W and W = A * eqn.W W = oper.mul_A(eqn, opts, eqn.type, U, 'N'); + if isfield(eqn, 'haveUV') && eqn.haveUV + switch eqn.type + case 'N' + W = W + eqn.U * (eqn.V' * U); + case 'T' + W = W + eqn.V * (eqn.U' * U); + end + end else W = [W; zeros(2 * nv + np - size(W, 1), size(W, 2))]; end - rw = mess_projection_shifts(eqn, opts, oper, U, ... - W, p_old); + rw = mess_projection_shifts(eqn, opts, oper, U, W, p_old); else - if (not(isfield(opts.shifts, 'b0')) || isempty(opts.shifts.b0)) - opts.shifts.b0 = ones(n,1); + if not(isfield(opts.shifts, 'b0')) || isempty(opts.shifts.b0) + opts.shifts.b0 = ones(n, 1); else - if length(opts.shifts.b0) ~= 2*nv+np - warning('MESS:b0',... - 'b0 has the wrong length. Switching to default.'); - opts.shifts.b0 = ones(2*nv+np,1); + if not(length(opts.shifts.b0) == 2 * nv + np) + mess_warn(opts, 'b0', ... + 'b0 has the wrong length. Switching to default.'); + opts.shifts.b0 = ones(2 * nv + np, 1); end end [rw, Hp, Hm, Vp, Vm] = mess_get_ritz_vals(eqn, opts, oper); end -if isfield(opts.shifts,'truncate') && isnumeric(opts.shifts.truncate) - rw = rw(abs(rw)1/opts.shifts.truncate); +if isfield(opts.shifts, 'truncate') && isnumeric(opts.shifts.truncate) + rw = rw(abs(rw) < opts.shifts.truncate); + rw = rw(abs(rw) > 1 / opts.shifts.truncate); +end +%% +% Let's truncate U and V back +if isfield(eqn, 'U') && not(isempty(eqn.U)) + eqn.U = eqn.U(1:2 * nv, :); end +if isfield(eqn, 'V') && not(isempty(eqn.V)) + eqn.V = eqn.V(1:2 * nv, :); +end + end diff --git a/usfs/dae_2_so/init_dae_2_so.m b/usfs/dae_2_so/init_dae_2_so.m index 266102a..9375113 100644 --- a/usfs/dae_2_so/init_dae_2_so.m +++ b/usfs/dae_2_so/init_dae_2_so.m @@ -28,119 +28,124 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - - %% check input Parameters na = nargin; -if(na<=3) - error('MESS:check_data','Number of input Arguments must be at least 3'); +if na <= 3 + mess_err(opts, 'check_data', ... + 'Number of input Arguments must be at least 3'); %% result = init_dae_2(eqn, flag1); -elseif(na==4) +elseif na == 4 switch flag1 - case {'A','a'} - [eqn,result] = checkA(eqn); - case {'E','e'} - [eqn,result] = checkE(eqn); + case {'A', 'a'} + [eqn, result] = checkA(eqn, opts); + case {'E', 'e'} + [eqn, result] = checkE(eqn, opts); otherwise - error('MESS:check_data','flag1 has to be ''A'' or ''E'''); + mess_err(opts, 'check_data', 'flag1 has to be ''A'' or ''E'''); end %% result = init_dae_2(eqn,flag1,flag2); -elseif(na==5) +elseif na == 5 switch flag1 - case {'A','a'} - [eqn,result] = checkA(eqn); + case {'A', 'a'} + [eqn, result] = checkA(eqn, opts); switch flag2 - case {'A','a'} - [eqn,resultA] = checkA(eqn); + case {'A', 'a'} + [eqn, resultA] = checkA(eqn, opts); result = result && resultA; - case {'E','e'} - [eqn,resultE] = checkE(eqn); - result = result &&resultE; + case {'E', 'e'} + [eqn, resultE] = checkE(eqn, opts); + result = result && resultE; otherwise - error('MESS:check_data','flag2 has to be ''A'' or ''E'''); + mess_err(opts, 'check_data', ... + 'flag2 has to be ''A'' or ''E'''); end - case {'E','e'} - [eqn, result] = checkE(eqn); + case {'E', 'e'} + [eqn, result] = checkE(eqn, opts); switch flag2 - case {'A','a'} - [eqn,resultA] = checkA(eqn); + case {'A', 'a'} + [eqn, resultA] = checkA(eqn, opts); result = result && resultA; - case {'E','e'} - [eqn,resultE] = checkE(eqn); + case {'E', 'e'} + [eqn, resultE] = checkE(eqn, opts); result = result && resultE; otherwise - error('MESS:check_data','flag2 has to be ''A'' or ''E'''); + mess_err(opts, 'check_data', ... + 'flag2 has to be ''A'' or ''E'''); end otherwise - error('MESS:check_data','flag1 has to be ''A'' or ''E'''); + mess_err(opts, 'check_data', 'flag1 has to be ''A'' or ''E'''); end end end %% checkdata for A_ -function [eqn,result] = checkA(eqn) +function [eqn, result] = checkA(eqn, opts) -if not(isfield(eqn,'E_')) || not(isnumeric(eqn.E_)) - error('MESS:equation_data',... - 'Empty or Corrupted field D detected in equation structure.'); +if not(isfield(eqn, 'E_')) || not(isnumeric(eqn.E_)) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field D detected in equation structure.'); elseif not(issparse(eqn.E_)) - warning('MESS:control_data','D is not sparse'); + mess_warn(opts, 'control_data', 'D is not sparse'); end -if not(isfield(eqn,'K_')) || not(isnumeric(eqn.K_)) - error('MESS:equation_data',... - 'Empty or Corrupted field K detected in equation structure.'); +if not(isfield(eqn, 'K_')) || not(isnumeric(eqn.K_)) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field K detected in equation structure.'); elseif not(issparse(eqn.K_)) - warning('MESS:control_data','K is not sparse'); + mess_warn(opts, 'control_data', 'K is not sparse'); end -if not(isfield(eqn,'G_')) || not(isnumeric(eqn.G_)) - error('MESS:equation_data',... - 'Empty or Corrupted field K detected in equation structure.'); +if not(isfield(eqn, 'G_')) || not(isnumeric(eqn.G_)) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field K detected in equation structure.'); elseif not(issparse(eqn.G_)) - warning('MESS:control_data','G is not sparse'); + mess_warn(opts, 'control_data', 'G is not sparse'); end -if (size(eqn.E_,1) ~= size(eqn.E_,2)) - error('MESS:error_arguments', 'field eqn.E_ has to be quadratic'); +if not(size(eqn.E_, 1) == size(eqn.E_, 2)) + mess_err(opts, 'error_arguments', 'field eqn.E_ has to be quadratic'); end -if (size(eqn.K_,1) ~= size(eqn.K_,2)) - error('MESS:error_arguments', 'field eqn.K_ has to be quadratic'); +if not(size(eqn.K_, 1) == size(eqn.K_, 2)) + mess_err(opts, 'error_arguments', 'field eqn.K_ has to be quadratic'); end -if (size(eqn.E_,1) ~= size(eqn.G_,2)) - error('MESS:error_arguments', 'field eqn.G_ has invalid number of columns'); +if not(size(eqn.E_, 1) == size(eqn.G_, 2)) + mess_err(opts, 'error_arguments', ... + 'field eqn.G_ has invalid number of columns'); end -result = 1; +result = true; end %% checkdata for E_ -function [eqn,result] = checkE(eqn) -if not(isfield(eqn, 'haveE')), eqn.haveE = 1; end +function [eqn, result] = checkE(eqn, opts) +if not(isfield(eqn, 'haveE')) + eqn.haveE = true; +end -if not(isfield(eqn,'M_')) || not(isnumeric(eqn.M_)) - error('MESS:equation_data',... - 'Empty or Corrupted field M detected in equation structure.'); +if not(isfield(eqn, 'M_')) || not(isnumeric(eqn.M_)) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field M detected in equation structure.'); end -if (size(eqn.M_,1) ~= size(eqn.M_,2)) - error('MESS:error_arguments', 'field eqn.M_ has to be quadratic'); +if not(size(eqn.M_, 1) == size(eqn.M_, 2)) + mess_err(opts, 'error_arguments', 'field eqn.M_ has to be quadratic'); end -if(not(issparse(eqn.M_))) - warning('MESS:check_data','M is not sparse'); +if not(issparse(eqn.M_)) + mess_warn(opts, 'check_data', 'M is not sparse'); end if not(isfield(eqn, 'alpha')) || not(isnumeric(eqn.alpha)) - error('MESS:equation_data',... - 'No parameter alpha given for shifting infinite eigenvalues of the pencil'); + mess_err(opts, 'equation_data', ... + ['No parameter alpha given for shifting infinite ' ... + 'eigenvalues of the pencil']); end -result=1; +result = true; end diff --git a/usfs/dae_2_so/init_res_dae_2_so.m b/usfs/dae_2_so/init_res_dae_2_so.m index 9ca1bed..aa772b2 100644 --- a/usfs/dae_2_so/init_res_dae_2_so.m +++ b/usfs/dae_2_so/init_res_dae_2_so.m @@ -1,13 +1,16 @@ -function [ W, res0, eqn, opts, oper ] = init_res_dae_2_so( eqn, opts, oper, RHS) -%% function init_res initializes the low rank residual W and res0 -% function [ W, res0, eqn, opts, oper ] = init_res_dae_2_so( eqn, opts, oper, RHS) +function [W, res0, eqn, opts, oper] = init_res_dae_2_so(eqn, opts, oper, W, T) +%% function init_res initializes the low-rank residual W and res0 +% function [ W, res0, eqn, opts, oper ] = ... +% init_res_dae_2_so( eqn, opts, oper, W, T) % % Input/Output: % % eqn structure containing data for G or B or C % opts structure containing parameters for the algorithm % oper struct contains function handles for operation with A and E -% RHS right hand side matrix +% W right hand side matrix +% T matrix such that the residual is W*T*W' +% (optional, defaults to identity % % Outputs: % @@ -19,73 +22,74 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check data -for mat='MEKG' - if(not(isfield(eqn, sprintf('%c_',mat))) || not(eval(sprintf('isnumeric(eqn.%c_)',mat)))) - error('MESS:error_arguments', 'field eqn.%c_ is not defined',mat); +for mat = 'MEKG' + if not(isfield(eqn, sprintf('%c_', mat))) || not(eval(sprintf('isnumeric(eqn.%c_)', mat))) + mess_err(opts, 'error_arguments', 'field eqn.%c_ is not defined', mat); end end -nv = size(eqn.M_,1); -np = size(eqn.G_,1); +nv = size(eqn.M_, 1); +np = size(eqn.G_, 1); -if not(isfield(eqn,'type')) - eqn.type='N'; - warning('MESS:equation_type',['Unable to determine type of equation.'... - 'Falling back to type ''N''']); +if not(isfield(eqn, 'type')) + eqn.type = 'N'; + mess_warn(opts, 'equation_type', ['Unable to determine type of equation.'... + 'Falling back to type ''N''']); end -if (not(isnumeric(RHS))) || (not(ismatrix(RHS))) - error('MESS:error_arguments','RHS has to be a matrix'); +if (not(isnumeric(W))) || (not(ismatrix(W))) + mess_err(opts, 'error_arguments', 'W has to be a matrix'); end -%% compute low rank residual -RHStemp = zeros(2*nv+np,size(RHS,2)); -RHStemp(1:size(RHS,1),:)=RHS; +%% compute low-rank residual +Wtemp = zeros(2 * nv + np, size(W, 2)); +Wtemp(1:size(W, 1), :) = W; -%if eqn.type=='N' +% if eqn.type=='N' % S = [speye(nv,nv),sparse(nv,nv),sparse(nv,np); % sparse(nv,nv),eqn.M_,eqn.G_'; % sparse(np,nv),eqn.G_,sparse(np,np)]; -% X = full( S \ RHStemp); +% X = full( S \ Wtemp); % W = [X(1:nv,:);eqn.M_*X(nv+1:2*nv,:)]; % else % S = [speye(nv,nv),sparse(nv,nv),sparse(nv,np); % sparse(nv,nv),eqn.M_',eqn.G_'; % sparse(np,nv),eqn.G_,sparse(np,np)]; -% %X = full( S \ [RHS; sparse(np,size(RHS, 2))]); -% X = full( S \ RHStemp); +% %X = full( S \ [W; sparse(np,size(W, 2))]); +% X = full( S \ Wtemp); % W = [X(1:nv,:);eqn.M_'*X(nv+1:2*nv,:)]; % end -S = [speye(nv,nv),sparse(nv,nv),sparse(nv,np); - sparse(nv,nv),eqn.M_,eqn.G_'; - sparse(np,nv),eqn.G_,sparse(np,np)]; -X = full( S \ RHStemp); -W = [X(1:nv,:);eqn.M_*X(nv+1:2*nv,:)]; - - +S = [speye(nv, nv), sparse(nv, nv), sparse(nv, np) + sparse(nv, nv), eqn.M_, eqn.G_' + sparse(np, nv), eqn.G_, sparse(np, np)]; +X = full(S \ Wtemp); +W = [X(1:nv, :); eqn.M_ * X(nv + 1:2 * nv, :)]; %% compute res0 +if not(exist('T', 'var')) && opts.LDL_T + % this means we only use init_res for potential projection + return +end + if isfield(opts, 'nm') && isfield(opts.nm, 'res0') res0 = opts.nm.res0; else if opts.LDL_T if opts.norm == 2 - res0 = max(abs(eig(RHS' * RHS * diag(eqn.S_diag)))); + res0 = max(abs(eig(W' * W * T))); else - res0 = norm(eig(RHS' * RHS * diag(eqn.S_diag)), 'fro'); + res0 = norm(eig(W' * W * T), 'fro'); end else - res0 = norm(RHS' * RHS, opts.norm); + res0 = norm(W' * W, opts.norm); end end end - diff --git a/usfs/dae_2_so/mul_A_dae_2_so.m b/usfs/dae_2_so/mul_A_dae_2_so.m index 37ec1a0..0b70ac9 100644 --- a/usfs/dae_2_so/mul_A_dae_2_so.m +++ b/usfs/dae_2_so/mul_A_dae_2_so.m @@ -1,4 +1,4 @@ -function C = mul_A_dae_2_so(eqn, opts, opA, B, opB)%#ok +function C = mul_A_dae_2_so(eqn, opts, opA, B, opB) %% function mul_A performs operation C = opA(A_)*opB(B) % % Input: @@ -19,12 +19,11 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - % A = [ 0 I 0; % K D G'; % G 0 0] @@ -35,55 +34,56 @@ % uses size_dae_1 %% check input Parameters -if (not(ischar(opA)) || not(ischar(opB))) - error('MESS:error_arguments', 'opA or opB is not a char'); +if not(ischar(opA)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opA or opB is not a char'); end -opA = upper(opA); opB = upper(opB); -if(not((opA == 'N' || opA == 'T'))) - error('MESS:error_arguments', 'opA is not ''N'' or ''T'''); +opA = upper(opA); +opB = upper(opB); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if(not((opB == 'N' || opB == 'T'))) - error('MESS:error_arguments', 'opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -for mat='EKG' - if(not(isfield(eqn, sprintf('%c_',mat))) || ... - not(eval(sprintf('isnumeric(eqn.%c_)',mat)))) - error('MESS:error_arguments', 'field eqn.%c_ is not defined',mat); +for mat = 'EKG' + if not(isfield(eqn, sprintf('%c_', mat))) || ... + not(eval(sprintf('isnumeric(eqn.%c_)', mat))) + mess_err(opts, 'error_arguments', 'field eqn.%c_ is not defined', mat); end end -nv = size(eqn.M_,1); -np = size(eqn.G_,1); -st = 2*nv; +nv = size(eqn.M_, 1); +np = size(eqn.G_, 1); +st = 2 * nv; n = st + np; -[rowB,colB] = size(B); +[rowB, colB] = size(B); -if(opB == 'N') - if(n > rowB) +if opB == 'N' + if n > rowB B = [B; zeros(np, colB)]; elseif n < rowB - error('MESS:error_arguments', 'B has more rows than A'); + mess_err(opts, 'error_arguments', 'B has more rows than A'); end else - if(n > colB) + if n > colB B = [B, zeros(rowB, np)]; elseif n < colB - error('MESS:error_arguments', 'B has more columns than A'); + mess_err(opts, 'error_arguments', 'B has more columns than A'); end end %% perform multiplication -if (opB=='N' && (size(B,1)==(2*nv+np))) || (opB=='T' && (size(B,2)==(2*nv+np))) +if (opB == 'N' && (size(B, 1) == (2 * nv + np))) || (opB == 'T' && (size(B, 2) == (2 * nv + np))) switch opA case 'N' @@ -91,40 +91,40 @@ switch opB case 'N' - %implement operation A_*B - C = [B(nv+1:2*nv,:);... - eqn.K_*B(1:nv,:)+eqn.E_*B(nv+1:2*nv,:)+eqn.G_'*B(2*nv+1:end,:); - eqn.G_*B(1:nv,:)]; + % implement operation A_*B + C = [B(nv + 1:2 * nv, :); ... + eqn.K_ * B(1:nv, :) + eqn.E_ * B(nv + 1:2 * nv, :) + eqn.G_' * B(2 * nv + 1:end, :) + eqn.G_ * B(1:nv, :)]; case 'T' - %implement operation A_*B' - C = [B(:,nv+1:2*nv)';... - eqn.K_*B(:,1:nv)'+eqn.E_*B(:,nv+1:2*nv)'+eqn.G_'*B(:,2*nv+1:end)'; - eqn.G_*B(:,1:nv)']; + % implement operation A_*B' + C = [B(:, nv + 1:2 * nv)'; ... + eqn.K_ * B(:, 1:nv)' + eqn.E_ * B(:, nv + 1:2 * nv)' + eqn.G_' * B(:, 2 * nv + 1:end)' + eqn.G_ * B(:, 1:nv)']; end case 'T' switch opB case 'N' - %implement operation A_'*B - C = [eqn.K_'*B(nv+1:2*nv,:)+ eqn.G_'*B(2*nv+1:end,:);... - B(1:nv,:)+eqn.E_'*B(nv+1:2*nv,:); - eqn.G_*B(nv+1:2*nv,:)]; + % implement operation A_'*B + C = [eqn.K_' * B(nv + 1:2 * nv, :) + eqn.G_' * B(2 * nv + 1:end, :); ... + B(1:nv, :) + eqn.E_' * B(nv + 1:2 * nv, :) + eqn.G_ * B(nv + 1:2 * nv, :)]; case 'T' - %implement operation A_'*B' - C = [eqn.K_'*B(:,nv+1:2*nv)'+ eqn.G_'*B(:,2*nv+1:end)';... - B(:,1:nv)'+eqn.E_'*B(:,nv+1:2*nv)'; - eqn.G_*B(:,nv+1:2*nv)']; + % implement operation A_'*B' + C = [eqn.K_' * B(:, nv + 1:2 * nv)' + eqn.G_' * B(:, 2 * nv + 1:end)'; ... + B(:, 1:nv)' + eqn.E_' * B(:, nv + 1:2 * nv)' + eqn.G_ * B(:, nv + 1:2 * nv)']; end end -elseif (opB=='N' && (size(B,1)==(2*nv))) || (opB=='T' && (size(B,2)==(2*nv))) - error('MESS:error_usage','mul_A_dae_2_so is only coded for shift parameter computation'); +elseif (opB == 'N' && (size(B, 1) == (2 * nv))) || (opB == 'T' && (size(B, 2) == (2 * nv))) + mess_err(opts, 'error_usage', 'mul_A_dae_2_so is only coded for shift parameter computation'); else - error('MESS:error_arguments', 'B has wrong number of cols'); + mess_err(opts, 'error_arguments', 'B has wrong number of cols'); end if opB == 'N' - C = C(1 : rowB, : ); + C = C(1:rowB, :); else - C = C(1 : colB, : ); + C = C(1:colB, :); end end diff --git a/usfs/dae_2_so/mul_ApE_dae_2_so.m b/usfs/dae_2_so/mul_ApE_dae_2_so.m index 768f86d..a2047ef 100644 --- a/usfs/dae_2_so/mul_ApE_dae_2_so.m +++ b/usfs/dae_2_so/mul_ApE_dae_2_so.m @@ -1,4 +1,4 @@ -function C = mul_ApE_dae_2_so(eqn, opts, opA,p,opE, B, opB)%#ok +function C = mul_ApE_dae_2_so(eqn, opts, opA, p, opE, B, opB) %% function mul_ApE_dae_2_so computes C = (opA(A_) + p*opE(E_))*opB(B) % % @@ -36,183 +36,199 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input Parameters -if (not(ischar(opA)) || not(ischar(opE)) || not(ischar(opB))) - error('MESS:error_arguments', 'opA, opE or opB is not a char'); +if not(ischar(opA)) || not(ischar(opE)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opA, opE or opB is not a char'); end -opA = upper(opA); opE = upper(opE); opB = upper(opB); +opA = upper(opA); +opE = upper(opE); +opB = upper(opB); -if(not((opA == 'N' || opA == 'T'))) - error('MESS:error_arguments', 'opA is not ''N'' or ''T'''); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if(not((opE == 'N' || opE == 'T'))) - error('MESS:error_arguments', 'opE is not ''N'' or ''T'''); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end -if(not((opB == 'N' || opB == 'T'))) - error('MESS:error_arguments', 'opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end -if(not(isnumeric(p))) - error('MESS:error_arguments','p is not numeric'); +if not(isnumeric(p)) + mess_err(opts, 'error_arguments', 'p is not numeric'); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -for mat='MEKG' - if(not(isfield(eqn, sprintf('%c_',mat))) || ... - not(eval(sprintf('isnumeric(eqn.%c_)',mat)))) - error('MESS:error_arguments', 'field eqn.%c_ is not defined',mat); +for mat = 'MEKG' + if not(isfield(eqn, sprintf('%c_', mat))) || ... + not(eval(sprintf('isnumeric(eqn.%c_)', mat))) + mess_err(opts, 'error_arguments', ... + 'field eqn.%c_ is not defined', mat); end end -nv = size(eqn.M_,1); -np = size(eqn.G_,1); +nv = size(eqn.M_, 1); +np = size(eqn.G_, 1); -[rowB,colB] = size(B); +[rowB, colB] = size(B); -if(opB == 'N') - if (rowB ~= 2*nv + np) +if opB == 'N' + if not(rowB == 2 * nv + np) B = [B; zeros(2 * nv + np - rowB, colB)]; end else - if (colB ~= 2*nv + np) + if not(colB == 2 * nv + np) B = [B, zeros(rowB, 2 * nv + np - colB)]; end end if eqn.haveE - %% perform solve operations for E ~= Identity + %% perform solve operations for E not the Identity switch opA - case 'N' - switch opE - case 'N' - switch opB - case 'N' - C1 = p * B(1 : nv, :) + B(nv + 1 : 2 * nv, :); - C2 = eqn.K_ * B(1 : nv, :) ... - + (eqn.E_ + p * eqn.M_) * B(nv + 1 : 2 * nv, :) ... - + eqn.G_' * B(2 * nv + 1 : end, :); - C3 = eqn.G_ * B(nv + 1 : 2 * nv, :); - C = [C1; C2; C3]; - case 'T' - C1 = p * B( : , 1 : nv)' + B( : , nv + 1 : 2 * nv)'; - C2 = eqn.K_ * B( : , 1 : nv)' ... - + (eqn.E_ + p * eqn.M_) * B( : , nv + 1 : 2 * nv)' ... - + eqn.G_' * B( : , 2 * nv + 1 : end)'; - C3 = eqn.G_ * B( : , nv + 1 : 2 * nv)'; - C = [C1; C2; C3]; - end - case 'T' - switch opB - case 'N' - C1 = p * B(1 : nv, :) + B(nv + 1 : 2 * nv, :); - C2 = eqn.K_ * B(1 : nv, :) ... - + (eqn.E_ + p * eqn.M_') * B(nv + 1 : 2 * nv, :) ... - + eqn.G_' * B(2 * nv + 1 : end, :); - C3 = eqn.G_ * B(nv + 1 : 2 * nv, :); - C = [C1; C2; C3]; - case 'T' - C1 = p * B( : , 1 : nv)' + B( : , nv + 1 : 2 * nv)'; - C2 = eqn.K_ * B( : , 1 : nv)' ... - + (eqn.E_ + p * eqn.M_') * B( : , nv + 1 : 2 * nv)' ... - + eqn.G_' * B( : , 2 * nv + 1 : end)'; - C3 = eqn.G_ * B( : , nv + 1 : 2 * nv)'; - C = [C1; C2; C3]; - end - end - case 'T' - switch opE - case 'N' - switch opB - case 'N' - C1 = p * B(1 : nv, :) + eqn.K_' * B(nv + 1 : 2 * nv, :); - C2 = B(1 : nv, :) ... - + (eqn.E_' + p * eqn.M_) * B(nv + 1 : 2 * nv, :) ... - + eqn.G_' * B(2 * nv + 1 : end, :); - C3 = eqn.G_ * B(nv + 1 : 2 * nv, :); - C = [C1; C2; C3]; - case 'T' - C1 = p * B( : , 1 : nv)' + eqn.K_' * B( : , nv + 1 : 2 * nv)'; - C2 = B( : , 1 : nv)' ... - + (eqn.E_' + p * eqn.M_) * B( : , nv + 1 : 2 * nv)' ... - + eqn.G_' * B( : , 2 * nv + 1 : end)'; - C3 = eqn.G_ * B( : , nv + 1 : 2 * nv)'; - C = [C1; C2; C3]; + case 'N' + switch opE + case 'N' + switch opB + case 'N' + C1 = p * B(1:nv, :) + B(nv + 1:2 * nv, :); + C2 = eqn.K_ * B(1:nv, :) + ... + (eqn.E_ + p * eqn.M_) * ... + B(nv + 1:2 * nv, :) + ... + eqn.G_' * B(2 * nv + 1:end, :); + C3 = eqn.G_ * B(nv + 1:2 * nv, :); + C = [C1; C2; C3]; + case 'T' + C1 = p * B(:, 1:nv)' + B(:, nv + 1:2 * nv)'; + C2 = eqn.K_ * B(:, 1:nv)' + ... + (eqn.E_ + p * eqn.M_) * ... + B(:, nv + 1:2 * nv)' + ... + eqn.G_' * B(:, 2 * nv + 1:end)'; + C3 = eqn.G_ * B(:, nv + 1:2 * nv)'; + C = [C1; C2; C3]; + end + case 'T' + switch opB + case 'N' + C1 = p * B(1:nv, :) + B(nv + 1:2 * nv, :); + C2 = eqn.K_ * B(1:nv, :) + ... + (eqn.E_ + p * eqn.M_') * ... + B(nv + 1:2 * nv, :) + ... + eqn.G_' * B(2 * nv + 1:end, :); + C3 = eqn.G_ * B(nv + 1:2 * nv, :); + C = [C1; C2; C3]; + case 'T' + C1 = p * B(:, 1:nv)' + B(:, nv + 1:2 * nv)'; + C2 = eqn.K_ * B(:, 1:nv)' + ... + (eqn.E_ + p * eqn.M_') * ... + B(:, nv + 1:2 * nv)' + ... + eqn.G_' * B(:, 2 * nv + 1:end)'; + C3 = eqn.G_ * B(:, nv + 1:2 * nv)'; + C = [C1; C2; C3]; + end end - case 'T' - switch opB - case 'N' - C1 = p * B(1 : nv, :) + eqn.K_' * B(nv + 1 : 2 * nv, :); - C2 = B(1 : nv, :) ... - + (eqn.E_' + p * eqn.M_') * B(nv + 1 : 2 * nv, :) ... - + eqn.G_' * B(2 * nv + 1 : end, :); - C3 = eqn.G_ * B(nv + 1 : 2 * nv, :); - C = [C1; C2; C3]; - case 'T' - C1 = p * B( : , 1 : nv)' + eqn.K_' * B( : , nv + 1 : 2 * nv)'; - C2 = B( : , 1 : nv)' ... - + (eqn.E_' + p * eqn.M_') * B( : , nv + 1 : 2 * nv)' ... - + eqn.G_' * B( : , 2 * nv + 1 : end)'; - C3 = eqn.G_ * B( : , nv + 1 : 2 * nv)'; - C = [C1; C2; C3]; + case 'T' + switch opE + case 'N' + switch opB + case 'N' + C1 = p * B(1:nv, :) + eqn.K_' * B(nv + 1:2 * nv, :); + C2 = B(1:nv, :) + ... + (eqn.E_' + p * eqn.M_) * ... + B(nv + 1:2 * nv, :) + ... + eqn.G_' * B(2 * nv + 1:end, :); + C3 = eqn.G_ * B(nv + 1:2 * nv, :); + C = [C1; C2; C3]; + case 'T' + C1 = p * B(:, 1:nv)' + ... + eqn.K_' * B(:, nv + 1:2 * nv)'; + C2 = B(:, 1:nv)' + ... + (eqn.E_' + p * eqn.M_) * ... + B(:, nv + 1:2 * nv)' + ... + eqn.G_' * B(:, 2 * nv + 1:end)'; + C3 = eqn.G_ * B(:, nv + 1:2 * nv)'; + C = [C1; C2; C3]; + end + case 'T' + switch opB + case 'N' + C1 = p * B(1:nv, :) + eqn.K_' * B(nv + 1:2 * nv, :); + C2 = B(1:nv, :) + ... + (eqn.E_' + p * eqn.M_') * ... + B(nv + 1:2 * nv, :) + ... + eqn.G_' * B(2 * nv + 1:end, :); + C3 = eqn.G_ * B(nv + 1:2 * nv, :); + C = [C1; C2; C3]; + case 'T' + C1 = p * B(:, 1:nv)' + ... + eqn.K_' * B(:, nv + 1:2 * nv)'; + C2 = B(:, 1:nv)' + ... + (eqn.E_' + p * eqn.M_') * ... + B(:, nv + 1:2 * nv)' + ... + eqn.G_' * B(:, 2 * nv + 1:end)'; + C3 = eqn.G_ * B(:, nv + 1:2 * nv)'; + C = [C1; C2; C3]; + end end - end end else %% perform solve operations for E = Identity switch opA - case 'N' - switch opB - case 'N' - C1 = p * B(1 : nv, :) + B(nv + 1 : 2 * nv, :); - C2 = eqn.K_ * B(1 : nv, :) ... - + (eqn.E_ + p * speye(nv, nv)) * B(nv + 1 : 2 * nv, :) ... - + eqn.G_' * B(2 * nv + 1 : end, :); - C3 = eqn.G_ * B(nv + 1 : 2 * nv, :); - C = [C1; C2; C3]; - case 'T' - C1 = p * B( : , 1 : nv)' + B( : , nv + 1 : 2 * nv)'; - C2 = eqn.K_ * B( : , 1 : nv)' ... - + (eqn.E_ + p * speye(nv, nv)) * B( : , nv + 1 : 2 * nv)' ... - + eqn.G_' * B( : , 2 * nv + 1 : end)'; - C3 = eqn.G_ * B( : , nv + 1 : 2 * nv)'; - C = [C1; C2; C3]; - end - case 'T' - switch opB - case 'N' - C1 = p * B(1 : nv, :) + eqn.K_' * B(nv + 1 : 2 * nv, :); - C2 = B(1 : nv, :) ... - + (eqn.E_' + p * speye(nv, nv)) * B(nv + 1 : 2 * nv, :) ... - + eqn.G_' * B(2 * nv + 1 : end, :); - C3 = eqn.G_ * B(nv + 1 : 2 * nv, :); - C = [C1; C2; C3]; - case 'T' - C1 = p * B( : , 1 : nv)' + eqn.K_' * B( : , nv + 1 : 2 * nv)'; - C2 = B( : , 1 : nv)' ... - + (eqn.E_' + p * speye(nv, nv)) * B( : , nv + 1 : 2 * nv)' ... - + eqn.G_' * B( : , 2 * nv + 1 : end)'; - C3 = eqn.G_ * B( : , nv + 1 : 2 * nv)'; - C = [C1; C2; C3]; - end + case 'N' + switch opB + case 'N' + C1 = p * B(1:nv, :) + B(nv + 1:2 * nv, :); + C2 = eqn.K_ * B(1:nv, :) + ... + (eqn.E_ + p * speye(nv, nv)) * ... + B(nv + 1:2 * nv, :) + ... + eqn.G_' * B(2 * nv + 1:end, :); + C3 = eqn.G_ * B(nv + 1:2 * nv, :); + C = [C1; C2; C3]; + case 'T' + C1 = p * B(:, 1:nv)' + B(:, nv + 1:2 * nv)'; + C2 = eqn.K_ * B(:, 1:nv)' + ... + (eqn.E_ + p * speye(nv, nv)) * ... + B(:, nv + 1:2 * nv)' + ... + eqn.G_' * B(:, 2 * nv + 1:end)'; + C3 = eqn.G_ * B(:, nv + 1:2 * nv)'; + C = [C1; C2; C3]; + end + case 'T' + switch opB + case 'N' + C1 = p * B(1:nv, :) + eqn.K_' * B(nv + 1:2 * nv, :); + C2 = B(1:nv, :) + ... + (eqn.E_' + p * speye(nv, nv)) * ... + B(nv + 1:2 * nv, :) + ... + eqn.G_' * B(2 * nv + 1:end, :); + C3 = eqn.G_ * B(nv + 1:2 * nv, :); + C = [C1; C2; C3]; + case 'T' + C1 = p * B(:, 1:nv)' + eqn.K_' * B(:, nv + 1:2 * nv)'; + C2 = B(:, 1:nv)' + ... + (eqn.E_' + p * speye(nv, nv)) * ... + B(:, nv + 1:2 * nv)' + ... + eqn.G_' * B(:, 2 * nv + 1:end)'; + C3 = eqn.G_ * B(:, nv + 1:2 * nv)'; + C = [C1; C2; C3]; + end end end if opB == 'N' - C = C(1 : rowB, :); + C = C(1:rowB, :); else - C = C(1 : colB, :); + C = C(1:colB, :); end % C = C(1 : 2 * nv, : ); diff --git a/usfs/dae_2_so/mul_E_dae_2_so.m b/usfs/dae_2_so/mul_E_dae_2_so.m index 30b9519..916ca54 100644 --- a/usfs/dae_2_so/mul_E_dae_2_so.m +++ b/usfs/dae_2_so/mul_E_dae_2_so.m @@ -1,4 +1,4 @@ -function C = mul_E_dae_2_so(eqn, opts, opE, B, opB)%#ok +function C = mul_E_dae_2_so(eqn, opts, opE, B, opB) %% function mul_A performs operation C = opE(E_)*opB(B) % % Input: @@ -23,114 +23,114 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input Parameters -if (not(ischar(opE)) || not(ischar(opB))) - error('MESS:error_arguments', 'opE or opB is not a char'); +if not(ischar(opE)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opE or opB is not a char'); end -opE = upper(opE); opB = upper(opB); -if(not((opE == 'N' || opE == 'T'))) - error('MESS:error_arguments','opE is not ''N'' or ''T'''); +opE = upper(opE); +opB = upper(opB); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end -if(not((opB == 'N' || opB == 'T'))) - error('MESS:error_arguments','opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -for mat='MG' - if(not(isfield(eqn, sprintf('%c_',mat))) || not(eval(sprintf('isnumeric(eqn.%c_)',mat)))) - error('MESS:error_arguments', 'field eqn.%c_ is not defined',mat); +for mat = 'MG' + if not(isfield(eqn, sprintf('%c_', mat))) || not(eval(sprintf('isnumeric(eqn.%c_)', mat))) + mess_err(opts, 'error_arguments', 'field eqn.%c_ is not defined', mat); end end %% perform multiplication -nv = size(eqn.M_,1); -np = size(eqn.G_,1); +nv = size(eqn.M_, 1); +np = size(eqn.G_, 1); -if (opB=='N' && (size(B,1)==(2*nv+np))) || (opB=='T' && (size(B,2)==(2*nv+np))) +if (opB == 'N' && (size(B, 1) == (2 * nv + np))) || (opB == 'T' && (size(B, 2) == (2 * nv + np))) switch opE case 'N' switch opB - %implement operation E_*B + % implement operation E_*B case 'N' - C = [B(1:nv,:); - eqn.M_*B(nv+1:2*nv,:)+eqn.alpha*eqn.G_'*B(2*nv+1:end,:); - eqn.alpha*eqn.G_*B(nv+1:2*nv,:)]; + C = [B(1:nv, :) + eqn.M_ * B(nv + 1:2 * nv, :) + eqn.alpha * eqn.G_' * B(2 * nv + 1:end, :) + eqn.alpha * eqn.G_ * B(nv + 1:2 * nv, :)]; - %implement operation E_*B' + % implement operation E_*B' case 'T' - C = [B(:,1:nv)'; - eqn.M_*B(:,nv+1:2*nv)'+eqn.alpha*eqn.G_'*B(:,2*nv+1:end)'; - eqn.alpha*eqn.G_*B(:,nv+1:2*nv)']; + C = [B(:, 1:nv)' + eqn.M_ * B(:, nv + 1:2 * nv)' + eqn.alpha * eqn.G_' * B(:, 2 * nv + 1:end)' + eqn.alpha * eqn.G_ * B(:, nv + 1:2 * nv)']; end case 'T' switch opB - %implement operation E_'*B + % implement operation E_'*B case 'N' - C = [B(1:nv,:); - eqn.M_'*B(nv+1:2*nv,:)+eqn.alpha*eqn.G_'*B(2*nv+1:end,:); - eqn.alpha*eqn.G_*B(nv+1:2*nv,:)]; + C = [B(1:nv, :) + eqn.M_' * B(nv + 1:2 * nv, :) + eqn.alpha * eqn.G_' * B(2 * nv + 1:end, :) + eqn.alpha * eqn.G_ * B(nv + 1:2 * nv, :)]; - %implement operation E_'*B' + % implement operation E_'*B' case 'T' - C = [B(:,1:nv)'; - eqn.M_'*B(:,nv+1:2*nv)'+eqn.alpha*eqn.G_'*B(:,2*nv+1:end)'; - eqn.alpha*eqn.G_*B(:,nv+1:2*nv)']; + C = [B(:, 1:nv)' + eqn.M_' * B(:, nv + 1:2 * nv)' + eqn.alpha * eqn.G_' * B(:, 2 * nv + 1:end)' + eqn.alpha * eqn.G_ * B(:, nv + 1:2 * nv)']; end end -elseif (opB=='N' && (size(B,1)==(2*nv))) || (opB=='T' && (size(B,2)==(2*nv))) +elseif (opB == 'N' && (size(B, 1) == (2 * nv))) || (opB == 'T' && (size(B, 2) == (2 * nv))) switch opE case 'N' switch opB - %implement operation E_*B + % implement operation E_*B case 'N' - C = [B(1:nv,:); - eqn.M_*B(nv+1:2*nv,:)]; + C = [B(1:nv, :) + eqn.M_ * B(nv + 1:2 * nv, :)]; - %implement operation E_*B' + % implement operation E_*B' case 'T' - C = [B(:,1:nv)'; - eqn.M_*B(:,nv+1:2*nv)']; + C = [B(:, 1:nv)' + eqn.M_ * B(:, nv + 1:2 * nv)']; end case 'T' switch opB - %implement operation E_'*B + % implement operation E_'*B case 'N' - C = [B(1:nv,:); - eqn.M_'*B(nv+1:2*nv,:)]; + C = [B(1:nv, :) + eqn.M_' * B(nv + 1:2 * nv, :)]; - %implement operation E_'*B' + % implement operation E_'*B' case 'T' - C = [B(:,1:nv)'; - eqn.M_'*B(:,nv+1:2*nv)']; + C = [B(:, 1:nv)' + eqn.M_' * B(:, nv + 1:2 * nv)']; end end else - error('MESS:error_arguments', 'B has wrong number of cols'); + mess_err(opts, 'error_arguments', 'B has wrong number of cols'); end end diff --git a/usfs/dae_2_so/size_dae_2_so.m b/usfs/dae_2_so/size_dae_2_so.m index 8a15f90..6fb390d 100644 --- a/usfs/dae_2_so/size_dae_2_so.m +++ b/usfs/dae_2_so/size_dae_2_so.m @@ -1,4 +1,4 @@ -function n = size_dae_2_so(eqn, opts, oper)%#ok +function n = size_dae_2_so(eqn, opts, oper) %#ok % function n = size_dae_2_so(eqn, opts, oper) % % This function returns the number of rows of the implicitly projected A @@ -20,11 +20,10 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - -n= 2*size(eqn.M_,1); +n = 2 * size(eqn.M_, 1); end diff --git a/usfs/dae_2_so/sol_A_dae_2_so.m b/usfs/dae_2_so/sol_A_dae_2_so.m index 759f2c2..a1ac91a 100644 --- a/usfs/dae_2_so/sol_A_dae_2_so.m +++ b/usfs/dae_2_so/sol_A_dae_2_so.m @@ -1,4 +1,4 @@ -function X = sol_A_dae_2_so(eqn, opts, opA, B, opB)%#ok +function X = sol_A_dae_2_so(eqn, opts, opA, B, opB) % function sol_A solves solves opA(A_)*X = opB(B) % % Input: @@ -19,81 +19,91 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - - %% check input Parameters -if (not(ischar(opA)) || not(ischar(opB))) - error('MESS:error_arguments', 'opA or opB is not a char'); +if not(ischar(opA)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opA or opB is not a char'); end -opA = upper(opA); opB = upper(opB); -if(not((opA == 'N' || opA == 'T'))) - error('MESS:error_arguments','opA is not ''N'' or ''T'''); +opA = upper(opA); +opB = upper(opB); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if(not((opB == 'N' || opB == 'T'))) - error('MESS:error_arguments','opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -for mat='EKG' - if(not(isfield(eqn, sprintf('%c_',mat))) || not(eval(sprintf('isnumeric(eqn.%c_))',mat)))) - error('MESS:error_arguments', 'field eqn.%c_ is not defined',mat); +for mat = 'EKG' + if not(isfield(eqn, sprintf('%c_', mat))) || ... + not(eval(sprintf('isnumeric(eqn.%c_))', mat))) + mess_err(opts, 'error_arguments', ... + 'field eqn.%c_ is not defined', mat); end end -nv = size(eqn.M_,1); -np = size(eqn.G_,1); +nv = size(eqn.M_, 1); +np = size(eqn.G_, 1); %% solve -if (opB=='N' && (size(B,1)==(2*nv+np))) || (opB=='T' && (size(B,2)==(2*nv+np))) -switch opA - - case 'N' - switch opB - - %implement solve A_*X=B - case 'N' - x = [eqn.K_, eqn.G_';eqn.G_,sparse(np,np)]\ [B(nv+1:2*nv,:)-eqn.E_*B(1:nv,:);B(2*nv+1:end,:)]; - X = [x(1:nv,:);B(1:nv,:);x(nv+1:end,:)]; - - %implement solve A_*X=B' - case 'T' - x = [eqn.K_, eqn.G_';eqn.G_,sparse(np,np)]\ [B(:,nv+1:2*nv)'-eqn.E_*B(:,1:nv)';B(:,2*nv+1:end)']; - X = [x(1:nv,:);B(:,1:nv)';x(nv+1:end,:)]; - end - - case 'T' - switch opB +if (opB == 'N' && (size(B, 1) == (2 * nv + np))) || ... + (opB == 'T' && (size(B, 2) == (2 * nv + np))) + switch opA + + case 'N' + switch opB + + % implement solve A_*X=B + case 'N' + x = [eqn.K_, eqn.G_'; eqn.G_, sparse(np, np)] \ ... + [B(nv + 1:2 * nv, :) - eqn.E_ * B(1:nv, :); ... + B(2 * nv + 1:end, :)]; + X = [x(1:nv, :); B(1:nv, :); x(nv + 1:end, :)]; + + % implement solve A_*X=B' + case 'T' + x = [eqn.K_, eqn.G_'; eqn.G_, sparse(np, np)] \ ... + [B(:, nv + 1:2 * nv)' - eqn.E_ * B(:, 1:nv)'; ... + B(:, 2 * nv + 1:end)']; + X = [x(1:nv, :); B(:, 1:nv)'; x(nv + 1:end, :)]; + end + + case 'T' + switch opB + + % implement solve A_'*X=B + case 'N' + x = [eqn.K_', eqn.G_'; eqn.G_, sparse(np, np)] \ ... + [B(1:nv, :); B(2 * nv + 1:end, :)]; + X = [B(nv + 1:2 * nv, :) - eqn.E_' * x(1:nv, :); ... + x(1:nv, :); x(nv + 1:end, :)]; + + % implement solve A_'*X=B' + case 'T' + x = [eqn.K_', eqn.G_'; eqn.G_, sparse(np, np)] \ ... + [B(:, 1:nv)'; B(:, 2 * nv + 1:end)']; + X = [B(:, nv + 1:2 * nv)' - eqn.E_' * x(1:nv, :); ... + x(1:nv, :); x(nv + 1:end, :)]; + end - %implement solve A_'*X=B - case 'N' - x = [eqn.K_',eqn.G_';eqn.G_,sparse(np,np)]\[B(1:nv,:);B(2*nv+1:end,:)]; - X = [B(nv+1:2*nv,:)-eqn.E_'*x(1:nv,:);x(1:nv,:);x(nv+1:end,:)]; - - %implement solve A_'*X=B' - case 'T' - x = [eqn.K_',eqn.G_';eqn.G_,sparse(np,np)]\[B(:,1:nv)';B(:,2*nv+1:end)']; - X = [B(:,nv+1:2*nv)'-eqn.E_'*x(1:nv,:);x(1:nv,:);x(nv+1:end,:)]; - end - -end -elseif (opB=='N' && (size(B,1)==(2*nv))) || (opB=='T' && (size(B,2)==(2*nv))) - error('MESS:error_usage','mul_A_dae_2_so is only coded for shift parameter computation'); + end +elseif (opB == 'N' && (size(B, 1) == (2 * nv))) || ... + (opB == 'T' && (size(B, 2) == (2 * nv))) + mess_err(opts, 'error_usage', ... + 'mul_A_dae_2_so is only coded for shift parameter computation'); else - error('MESS:error_arguments', 'B has wrong number of cols'); + mess_err(opts, 'error_arguments', 'B has wrong number of cols'); end - - end diff --git a/usfs/dae_2_so/sol_ApE_dae_2_so.m b/usfs/dae_2_so/sol_ApE_dae_2_so.m index 337b84a..84ff26c 100644 --- a/usfs/dae_2_so/sol_ApE_dae_2_so.m +++ b/usfs/dae_2_so/sol_ApE_dae_2_so.m @@ -1,4 +1,4 @@ -function X = sol_ApE_dae_2_so(eqn, opts, opA, p, opE, B, opB)%#ok +function X = sol_ApE_dae_2_so(eqn, opts, opA, p, opE, B, opB) %% function sol_ApE solves (opA(A_) + p*opE(E_))*X = opB(B) % resp. performs X=(opA(A_)+p*opE(E_))\opB(B) % @@ -38,157 +38,157 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input Parameters -if (not(ischar(opA)) || not(ischar(opE)) || not(ischar(opB))) - error('MESS:error_arguments', 'opA, opE or opB is not a char'); +if not(ischar(opA)) || not(ischar(opE)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opA, opE or opB is not a char'); end -opA = upper(opA); opE = upper(opE); opB = upper(opB); +opA = upper(opA); +opE = upper(opE); +opB = upper(opB); -if(not((opA == 'N' || opA == 'T'))) - error('MESS:error_arguments', 'opA is not ''N'' or ''T'''); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if(not((opE == 'N' || opE == 'T'))) - error('MESS:error_arguments', 'opE is not ''N'' or ''T'''); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end -if(not((opB == 'N' || opB == 'T'))) - error('MESS:error_arguments', 'opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end -if(not(isnumeric(p))) - error('MESS:error_arguments','p is not numeric'); +if not(isnumeric(p)) + mess_err(opts, 'error_arguments', 'p is not numeric'); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -for mat='MEKG' - if(not(isfield(eqn, sprintf('%c_',mat))) || ... - not(eval(sprintf('isnumeric(eqn.%c_)',mat)))) - error('MESS:error_arguments', 'field eqn.%c_ is not defined',mat); +for mat = 'MEKG' + if not(isfield(eqn, sprintf('%c_', mat))) || ... + not(eval(sprintf('isnumeric(eqn.%c_)', mat))) + mess_err(opts, 'error_arguments', 'field eqn.%c_ is not defined', mat); end end -nv = size(eqn.M_,1); -np = size(eqn.G_,1); +nv = size(eqn.M_, 1); +np = size(eqn.G_, 1); -[rowB,colB] = size(B); +[rowB, colB] = size(B); -if(opB == 'N') - if (rowB ~= 2*nv + np) +if opB == 'N' + if not(rowB == 2 * nv + np) B = [B; zeros(2 * nv + np - rowB, colB)]; end else - if (colB ~= 2*nv + np) + if not(colB == 2 * nv + np) B = [B, zeros(rowB, 2 * nv + np - colB)]; end end - switch opA +switch opA case 'N' - switch opE - - case 'N' + switch opE - switch opB - %implement solve (A_+p*E_)*X=B case 'N' - x23 = [eqn.K_-p*eqn.E_-p^2*eqn.M_, -p*eqn.G_'; ... - -p*eqn.G_,zeros(np,np)] \ ... - [eqn.K_*B(1:nv,:)-p*B(nv+1:2*nv,:);-p*B(2*nv+1:end,:)]; - X = [(B(1:nv,:)-x23(1:nv,:))./p;x23]; - %X = (A + p * E) \ B; - %implement solve (A_+p*E_)*X=B' + switch opB + % implement solve (A_+p*E_)*X=B + case 'N' + x23 = [eqn.K_ - p * eqn.E_ - p^2 * eqn.M_, -p * eqn.G_'; ... + -p * eqn.G_, zeros(np, np)] \ ... + [eqn.K_ * B(1:nv, :) - p * B(nv + 1:2 * nv, :); -p * B(2 * nv + 1:end, :)]; + X = [(B(1:nv, :) - x23(1:nv, :)) ./ p; x23]; + % X = (A + p * E) \ B; + + % implement solve (A_+p*E_)*X=B' + case 'T' + x23 = [eqn.K_ - p * eqn.E_ - p^2 * eqn.M_, -p * eqn.G_'; ... + -p * eqn.G_, zeros(np, np)] \ ... + [eqn.K_ * B(:, 1:nv)' - p * B(:, nv + 1:2 * nv)'; -p * B(:, 2 * nv + 1:end)']; + X = [(B(:, 1:nv)' - x23(1:nv, :)) ./ p; x23]; + % X = (A + p * E) \ B'; + end + case 'T' - x23 = [eqn.K_-p*eqn.E_-p^2*eqn.M_, -p*eqn.G_';... - -p*eqn.G_,zeros(np,np)] \ ... - [eqn.K_*B(:,1:nv)'-p*B(:,nv+1:2*nv)';-p*B(:,2*nv+1:end)']; - X = [(B(:,1:nv)'-x23(1:nv,:))./p;x23]; - %X = (A + p * E) \ B'; - end - case 'T' + switch opB + % implement solve (A_+p*E_)*X=B + case 'N' + x23 = [eqn.K_ - p * eqn.E_ - p^2 * eqn.M_', -p * eqn.G_'; ... + -p * eqn.G_, zeros(np, np)] \ ... + [eqn.K_ * B(1:nv, :) - p * B(nv + 1:2 * nv, :); -p * B(2 * nv + 1:end, :)]; + X = [(B(1:nv, :) - x23(1:nv, :)) ./ p; x23]; + % X = (A + p * E) \ B; + + % implement solve (A_+p*E_)*X=B' + case 'T' + x23 = [eqn.K_ - p * eqn.E_ - p^2 * eqn.M_', -p * eqn.G_'; ... + -p * eqn.G_, zeros(np, np)] \ ... + [eqn.K_ * B(:, 1:nv)' - p * B(:, nv + 1:2 * nv)'; -p * B(:, 2 * nv + 1:end)']; + X = [(B(:, 1:nv)' - x23(1:nv, :)) ./ p; x23]; + % X = (A + p * E) \ B'; + end + + end + + case 'T' + switch opE - switch opB - %implement solve (A_+p*E_)*X=B case 'N' - x23 = [eqn.K_-p*eqn.E_-p^2*eqn.M_', -p*eqn.G_';... - -p*eqn.G_,zeros(np,np)] \ ... - [eqn.K_*B(1:nv,:)-p*B(nv+1:2*nv,:);-p*B(2*nv+1:end,:)]; - X = [(B(1:nv,:)-x23(1:nv,:))./p;x23]; - %X = (A + p * E) \ B; - %implement solve (A_+p*E_)*X=B' + switch opB + % implement solve (A_+p*E_)*X=B + case 'N' + x23 = [eqn.K_' - p * eqn.E_' - p^2 * eqn.M_, -p * eqn.G_'; ... + -p * eqn.G_, zeros(np, np)] \ ... + [B(1:nv, :) - p * B(nv + 1:2 * nv, :); -p * B(2 * nv + 1:end, :)]; + X = [(B(1:nv, :) - eqn.K_' * x23(1:nv, :)) ./ p; x23]; + % X = (A + p * E) \ B; + + % implement solve (A_+p*E_)*X=B' + case 'T' + x23 = [eqn.K_' - p * eqn.E_' - p^2 * eqn.M_, -p * eqn.G_'; ... + -p * eqn.G_, zeros(np, np)] \ ... + [B(:, 1:nv)' - p * B(:, nv + 1:2 * nv)'; -p * B(:, 2 * nv + 1:end)']; + X = [(B(:, 1:nv)' - eqn.K_' * x23(1:nv, :)) ./ p; x23]; + % X = (A + p * E) \ B'; + end + case 'T' - x23 = [eqn.K_-p*eqn.E_-p^2*eqn.M_', -p*eqn.G_';... - -p*eqn.G_,zeros(np,np)] \ ... - [eqn.K_*B(:,1:nv)'-p*B(:,nv+1:2*nv)';-p*B(:,2*nv+1:end)']; - X = [(B(:,1:nv)'-x23(1:nv,:))./p;x23]; - %X = (A + p * E) \ B'; - end - end + switch opB + % implement solve (A_+p*E_)*X=B + case 'N' + x23 = [eqn.K_' - p * eqn.E_' - p^2 * eqn.M_', -p * eqn.G_'; ... + -p * eqn.G_, zeros(np, np)] \ ... + [B(1:nv, :) - p * B(nv + 1:2 * nv, :); -p * B(2 * nv + 1:end, :)]; + X = [(B(1:nv, :) - eqn.K_' * x23(1:nv, :)) ./ p; x23]; + % implement solve (A_+p*E_)*X=B' + case 'T' + x23 = [eqn.K_' - p * eqn.E_' - p^2 * eqn.M_', -p * eqn.G_'; ... + -p * eqn.G_, zeros(np, np)] \ ... + [B(:, 1:nv)' - p * B(:, nv + 1:2 * nv)'; -p * B(:, 2 * nv + 1:end)']; + X = [(B(:, 1:nv)' - eqn.K_' * x23(1:nv, :)) ./ p; x23]; + % X = (A + p * E) \ B'; + end + end - case 'T' - switch opE - - case 'N' - - switch opB - %implement solve (A_+p*E_)*X=B - case 'N' - x23 = [eqn.K_'-p*eqn.E_'-p^2*eqn.M_, -p*eqn.G_';... - -p*eqn.G_,zeros(np,np)] \ ... - [B(1:nv,:)-p*B(nv+1:2*nv,:);-p*B(2*nv+1:end,:)]; - X = [(B(1:nv,:)-eqn.K_'*x23(1:nv,:))./p;x23]; - %X = (A + p * E) \ B; - - %implement solve (A_+p*E_)*X=B' - case 'T' - x23 = [eqn.K_'-p*eqn.E_'-p^2*eqn.M_, -p*eqn.G_';... - -p*eqn.G_,zeros(np,np)] \ ... - [B(:,1:nv)'-p*B(:,nv+1:2*nv)';-p*B(:,2*nv+1:end)']; - X = [(B(:,1:nv)'-eqn.K_'*x23(1:nv,:))./p;x23]; - %X = (A + p * E) \ B'; - end - - case 'T' - - switch opB - %implement solve (A_+p*E_)*X=B - case 'N' - x23 = [eqn.K_'-p*eqn.E_'-p^2*eqn.M_', -p*eqn.G_';... - -p*eqn.G_,zeros(np,np)] \ ... - [B(1:nv,:)-p*B(nv+1:2*nv,:);-p*B(2*nv+1:end,:)]; - X = [(B(1:nv,:)-eqn.K_'*x23(1:nv,:))./p;x23]; - %implement solve (A_+p*E_)*X=B' - case 'T' - x23 = [eqn.K_'-p*eqn.E_'-p^2*eqn.M_', -p*eqn.G_';... - -p*eqn.G_,zeros(np,np)] \ ... - [B(:,1:nv)'-p*B(:,nv+1:2*nv)';-p*B(:,2*nv+1:end)']; - X = [(B(:,1:nv)'-eqn.K_'*x23(1:nv,:))./p;x23]; - %X = (A + p * E) \ B'; - end - end - - end - if opB == 'N' - X = X(1 : rowB, :); - else - X = X(1 : colB, :); - end - % X = X(1 : 2*nv, :); end - +if opB == 'N' + X = X(1:rowB, :); +else + X = X(1:colB, :); +end +% X = X(1 : 2*nv, :); +end diff --git a/usfs/dae_2_so/sol_E_dae_2_so.m b/usfs/dae_2_so/sol_E_dae_2_so.m index be30b9d..320697f 100644 --- a/usfs/dae_2_so/sol_E_dae_2_so.m +++ b/usfs/dae_2_so/sol_E_dae_2_so.m @@ -1,4 +1,4 @@ -function X = sol_E_dae_2_so(eqn, opts, opE, B, opB)%#ok +function X = sol_E_dae_2_so(eqn, opts, opE, B, opB) %% function sol_E_dae_2_so solves opE(E)*X = opB(B) resp. performs X=opE(E)\opB(B) % % Input: @@ -20,60 +20,60 @@ % % X matrix fulfills equation opE(E)*X = opB(B) - % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % %% check input Parameters -if (not(ischar(opE)) || not(ischar(opB))) - error('MESS:error_arguments', 'opE or opB is not a char'); +if not(ischar(opE)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opE or opB is not a char'); end -opE = upper(opE); opB = upper(opB); -if(not((opE == 'N' || opE == 'T'))) - error('MESS:error_arguments','opE is not ''N'' or ''T'''); +opE = upper(opE); +opB = upper(opB); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end -if(not((opB == 'N' || opB == 'T'))) - error('MESS:error_arguments','opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -if(not(isfield(eqn, 'M_'))) || not(isnumeric(eqn.M_)) - error('MESS:error_arguments', 'field eqn.M_ is not defined'); +if (not(isfield(eqn, 'M_'))) || not(isnumeric(eqn.M_)) + mess_err(opts, 'error_arguments', 'field eqn.M_ is not defined'); end -nv = size(eqn.M_,1); -np = size(eqn.G_,1); +nv = size(eqn.M_, 1); +np = size(eqn.G_, 1); %% solve -if (opB=='N' && (size(B,1)==(2*nv+np))) || (opB=='T' && (size(B,2)==(2*nv+np))) +if (opB == 'N' && (size(B, 1) == (2 * nv + np))) || (opB == 'T' && (size(B, 2) == (2 * nv + np))) switch opE case 'N' switch opB - %implement solve E*X=B + % implement solve E*X=B case 'N' - X = [B(1:nv,:); - [eqn.M_,eqn.alpha*eqn.G_'; ... - eqn.alpha*eqn.G_,sparse(np,np)] \ B(nv+1:end,:) + X = [B(1:nv, :) + [eqn.M_, eqn.alpha * eqn.G_'; ... + eqn.alpha * eqn.G_, sparse(np, np)] \ B(nv + 1:end, :) ]; - %implement solve A*X=B' + % implement solve A*X=B' case 'T' - X = [B(:,1:nv)'; - [eqn.M_,eqn.alpha*eqn.G_'; ... - eqn.alpha*eqn.G_,sparse(np,np)] \ B(:,nv+1:end)' + X = [B(:, 1:nv)' + [eqn.M_, eqn.alpha * eqn.G_'; ... + eqn.alpha * eqn.G_, sparse(np, np)] \ B(:, nv + 1:end)' ]; end @@ -81,28 +81,27 @@ case 'T' switch opB - %implement solve E'*X=B + % implement solve E'*X=B case 'N' - X = [B(1:nv,:); - [eqn.M_',eqn.alpha*eqn.G_'; ... - eqn.alpha*eqn.G_,sparse(np,np)] \ B(nv+1:end,:) + X = [B(1:nv, :) + [eqn.M_', eqn.alpha * eqn.G_'; ... + eqn.alpha * eqn.G_, sparse(np, np)] \ B(nv + 1:end, :) ]; - %implement solve A_'*X=B' + % implement solve A_'*X=B' case 'T' - X = [B(:,1:nv)'; - [eqn.M_',eqn.alpha*eqn.G_'; ... - eqn.alpha*eqn.G_,sparse(np,np)] \ B(:,nv+1:end)' + X = [B(:, 1:nv)' + [eqn.M_', eqn.alpha * eqn.G_'; ... + eqn.alpha * eqn.G_, sparse(np, np)] \ B(:, nv + 1:end)' ]; end end -elseif (opB=='N' && (size(B,1)==(2*nv))) || (opB=='T' && (size(B,2)==(2*nv))) - error('MESS:error_usage','sol_E_dae_2_so is only coded for shift parameter computation'); +elseif (opB == 'N' && (size(B, 1) == (2 * nv))) || (opB == 'T' && (size(B, 2) == (2 * nv))) + mess_err(opts, 'error_usage', 'sol_E_dae_2_so is only coded for shift parameter computation'); else - error('MESS:error_arguments', 'B has wrong number of cols'); + mess_err(opts, 'error_arguments', 'B has wrong number of cols'); end - end diff --git a/usfs/dae_3_so/get_ritz_vals_dae_3_so.m b/usfs/dae_3_so/get_ritz_vals_dae_3_so.m index 021b007..7c6bc54 100644 --- a/usfs/dae_3_so/get_ritz_vals_dae_3_so.m +++ b/usfs/dae_3_so/get_ritz_vals_dae_3_so.m @@ -9,28 +9,27 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - % Input data not completely checked! -for mat='MEKG' - if(not(isfield(eqn, sprintf('%c_',mat))) || ... - not(eval(sprintf('isnumeric(eqn.%c_)',mat)))) - error('MESS:error_arguments', 'field eqn.%c_ is not defined',mat); +for mat = 'MEKG' + if not(isfield(eqn, sprintf('%c_', mat))) || ... + not(eval(sprintf('isnumeric(eqn.%c_)', mat))) + mess_err(opts, 'error_arguments', 'field eqn.%c_ is not defined', mat); end end -[result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A','E'); +[result, eqn, opts, oper] = oper.init(eqn, opts, oper, 'A', 'E'); if not(result) - error('MESS:control_data', ... - 'system data is not completely defined or corrupted'); + mess_err(opts, 'control_data', ... + 'system data is not completely defined or corrupted'); end % returns order of A or states of A, A is supposed to be square -nv = size(eqn.M_,1); -np = size(eqn.G_,1); +nv = size(eqn.M_, 1); +np = size(eqn.G_, 1); %% % here we add the trailing zero blocks. Note that we are passing the @@ -40,43 +39,51 @@ if isfield(eqn, 'U') && not(isempty(eqn.U)) eqn.U = [eqn.U; sparse(np, size(eqn.U, 2))]; end -if isfield(eqn,'V') && not(isempty(eqn.V)) - eqn.V=[eqn.V; sparse(np, size(eqn.V,2))]; +if isfield(eqn, 'V') && not(isempty(eqn.V)) + eqn.V = [eqn.V; sparse(np, size(eqn.V, 2))]; end if isfield(opts.shifts, 'method') && ... strcmp(opts.shifts.method, 'projection') U = [U; zeros(2 * nv + np - size(U, 1), size(U, 2))]; if isempty(W) - % first shifts are computed with U = eqn.G and W = A * eqn.G + % first shifts are computed with U = eqn.W and W = A * eqn.W W = oper.mul_A(eqn, opts, eqn.type, U, 'N'); + if isfield(eqn, 'haveUV') && eqn.haveUV + switch eqn.type + case 'N' + W = W + eqn.U * (eqn.V' * U); + case 'T' + W = W + eqn.V * (eqn.U' * U); + end + end else W = [W; zeros(2 * nv + np - size(W, 1), size(W, 2))]; end rw = mess_projection_shifts(eqn, opts, oper, U, W, p_old); else - if (not(isfield(opts.shifts, 'b0')) || isempty(opts.shifts.b0)) - opts.shifts.b0 = ones(n,1); + if not(isfield(opts.shifts, 'b0')) || isempty(opts.shifts.b0) + opts.shifts.b0 = ones(n, 1); else - if length(opts.shifts.b0) ~= 2*nv+np - warning('MESS:b0',... - 'b0 has the wrong length. Switching to default.'); - opts.shifts.b0 = ones(2*nv+np,1); + if not(length(opts.shifts.b0) == 2 * nv + np) + mess_warn(opts, 'b0', ... + 'b0 has the wrong length. Switching to default.'); + opts.shifts.b0 = ones(2 * nv + np, 1); end end [rw, Hp, Hm, Vp, Vm] = mess_get_ritz_vals(eqn, opts, oper); end -if isfield(opts.shifts,'truncate') && isnumeric(opts.shifts.truncate) - rw = rw(abs(rw)1/opts.shifts.truncate); +if isfield(opts.shifts, 'truncate') && isnumeric(opts.shifts.truncate) + rw = rw(abs(rw) < opts.shifts.truncate); + rw = rw(abs(rw) > 1 / opts.shifts.truncate); end %% % Let's truncate U and V back if isfield(eqn, 'U') && not(isempty(eqn.U)) - eqn.U = eqn.U(1:2*nv, :); + eqn.U = eqn.U(1:2 * nv, :); end -if isfield(eqn,'V') && not(isempty(eqn.V)) - eqn.V= eqn.V(1:2*nv, :); +if isfield(eqn, 'V') && not(isempty(eqn.V)) + eqn.V = eqn.V(1:2 * nv, :); end end diff --git a/usfs/dae_3_so/init_dae_3_so.m b/usfs/dae_3_so/init_dae_3_so.m index 1bdb71d..a3e7e62 100644 --- a/usfs/dae_3_so/init_dae_3_so.m +++ b/usfs/dae_3_so/init_dae_3_so.m @@ -28,118 +28,122 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input Parameters na = nargin; -if(na<=3) - error('MESS:check_data','Number of input Arguments must be at least 3'); +if na <= 3 + mess_err(opts, 'check_data', 'Number of input Arguments must be at least 3'); %% result = init_dae_3_so(eqn, flag1); -elseif(na==4) +elseif na == 4 switch flag1 - case {'A','a'} - [eqn,result] = checkA(eqn); - case {'E','e'} - [eqn,result] = checkE(eqn); + case {'A', 'a'} + [eqn, result] = checkA(eqn, opts); + case {'E', 'e'} + [eqn, result] = checkE(eqn, opts); otherwise - error('MESS:check_data','flag1 has to be ''A'' or ''E'''); + mess_err(opts, 'check_data', 'flag1 has to be ''A'' or ''E'''); end %% result = init_dae_3_so(eqn,flag1,flag2); -elseif(na==5) +elseif na == 5 switch flag1 - case {'A','a'} - [eqn,result] = checkA(eqn); + case {'A', 'a'} + [eqn, result] = checkA(eqn, opts); switch flag2 - case {'A','a'} - [eqn,resultA] = checkA(eqn); + case {'A', 'a'} + [eqn, resultA] = checkA(eqn, opts); result = result && resultA; - case {'E','e'} - [eqn,resultE] = checkE(eqn); - result = result &&resultE; + case {'E', 'e'} + [eqn, resultE] = checkE(eqn, opts); + result = result && resultE; otherwise - error('MESS:check_data','flag2 has to be ''A'' or ''E'''); + mess_err(opts, 'check_data', 'flag2 has to be ''A'' or ''E'''); end - case {'E','e'} - [eqn, result] = checkE(eqn); + case {'E', 'e'} + [eqn, result] = checkE(eqn, opts); switch flag2 - case {'A','a'} - [eqn,resultA] = checkA(eqn); + case {'A', 'a'} + [eqn, resultA] = checkA(eqn, opts); result = result && resultA; - case {'E','e'} - [eqn,resultE] = checkE(eqn); + case {'E', 'e'} + [eqn, resultE] = checkE(eqn, opts); result = result && resultE; otherwise - error('MESS:check_data','flag2 has to be ''A'' or ''E'''); + mess_err(opts, 'check_data', ... + 'flag2 has to be ''A'' or ''E'''); end otherwise - error('MESS:check_data','flag1 has to be ''A'' or ''E'''); + mess_err(opts, 'check_data', 'flag1 has to be ''A'' or ''E'''); end end end %% checkdata for A_ -function [eqn,result] = checkA(eqn) +function [eqn, result] = checkA(eqn, opts) -if not(isfield(eqn,'E_')) || not(isnumeric(eqn.E_)) - error('MESS:equation_data',... - 'Empty or Corrupted field D detected in equation structure.'); +if not(isfield(eqn, 'E_')) || not(isnumeric(eqn.E_)) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field D detected in equation structure.'); elseif not(issparse(eqn.E_)) - warning('MESS:control_data','D is not sparse'); + mess_warn(opts, 'control_data', 'D is not sparse'); end -if not(isfield(eqn,'K_')) || not(isnumeric(eqn.K_)) - error('MESS:equation_data',... - 'Empty or Corrupted field K detected in equation structure.'); +if not(isfield(eqn, 'K_')) || not(isnumeric(eqn.K_)) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field K detected in equation structure.'); elseif not(issparse(eqn.K_)) - warning('MESS:control_data','K is not sparse'); + mess_warn(opts, 'control_data', 'K is not sparse'); end -if not(isfield(eqn,'G_')) || not(isnumeric(eqn.G_)) - error('MESS:equation_data',... - 'Empty or Corrupted field K detected in equation structure.'); +if not(isfield(eqn, 'G_')) || not(isnumeric(eqn.G_)) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field K detected in equation structure.'); elseif not(issparse(eqn.G_)) - warning('MESS:control_data','G is not sparse'); + mess_warn(opts, 'control_data', 'G is not sparse'); end -if (size(eqn.E_,1) ~= size(eqn.E_,2)) - error('MESS:error_arguments', 'field eqn.E_ has to be quadratic'); +if not(size(eqn.E_, 1) == size(eqn.E_, 2)) + mess_err(opts, 'error_arguments', 'field eqn.E_ has to be quadratic'); end -if (size(eqn.K_,1) ~= size(eqn.K_,2)) - error('MESS:error_arguments', 'field eqn.K_ has to be quadratic'); +if not(size(eqn.K_, 1) == size(eqn.K_, 2)) + mess_err(opts, 'error_arguments', 'field eqn.K_ has to be quadratic'); end -if (size(eqn.E_,1) ~= size(eqn.G_,2)) - error('MESS:error_arguments', 'field eqn.G_ has invalid number of columns'); +if not(size(eqn.E_, 1) == size(eqn.G_, 2)) + mess_err(opts, 'error_arguments', ... + 'field eqn.G_ has invalid number of columns'); end -result = 1; +result = true; end %% checkdata for E_ -function [eqn,result] = checkE(eqn) -if not(isfield(eqn, 'haveE')), eqn.haveE = 1; end +function [eqn, result] = checkE(eqn, opts) +if not(isfield(eqn, 'haveE')) + eqn.haveE = true; +end -if not(isfield(eqn,'M_')) || not(isnumeric(eqn.M_)) - error('MESS:equation_data',... - 'Empty or Corrupted field M detected in equation structure.'); +if not(isfield(eqn, 'M_')) || not(isnumeric(eqn.M_)) + mess_err(opts, 'equation_data', ... + 'Empty or Corrupted field M detected in equation structure.'); end -if (size(eqn.M_,1) ~= size(eqn.M_,2)) - error('MESS:error_arguments', 'field eqn.M_ has to be quadratic'); +if not(size(eqn.M_, 1) == size(eqn.M_, 2)) + mess_err(opts, 'error_arguments', 'field eqn.M_ has to be quadratic'); end -if(not(issparse(eqn.M_))) - warning('MESS:check_data','M is not sparse'); +if not(issparse(eqn.M_)) + mess_warn(opts, 'check_data', 'M is not sparse'); end if not(isfield(eqn, 'alpha')) || not(isnumeric(eqn.alpha)) - error('MESS:equation_data',... - 'No parameter alpha given for shifting infinite eigenvalues of the pencil'); + mess_err(opts, 'equation_data', ... + ['No parameter alpha given for shifting infinite ' ... + 'eigenvalues of the pencil']); end -result=1; +result = true; end diff --git a/usfs/dae_3_so/init_res_dae_3_so.m b/usfs/dae_3_so/init_res_dae_3_so.m index f5479ba..de68725 100644 --- a/usfs/dae_3_so/init_res_dae_3_so.m +++ b/usfs/dae_3_so/init_res_dae_3_so.m @@ -1,13 +1,17 @@ -function [ W, res0, eqn, opts, oper ] = init_res_dae_3_so( eqn, opts, oper, RHS) -%% function init_res initializes the low rank residual W and res0 -% function [ W, res0, eqn, opts, oper ] = init_res_dae_3_so( eqn, opts, oper, RHS) +function [W, res0, eqn, opts, oper] = ... + init_res_dae_3_so(eqn, opts, oper, W, T) +%% function init_res initializes the low-rank residual W and res0 +% function [ W, res0, eqn, opts, oper ] = ... +% init_res_dae_3_so( eqn, opts, oper, W, T) % % Input/Output: % % eqn structure containing data for G or B or C % opts structure containing parameters for the algorithm % oper struct contains function handles for operation with A and E -% RHS right hand side matrix +% W right hand side matrix +% T matrix such that the residual is W*T*W' +% (optional, defaults to the identity) % % Outputs: % @@ -19,60 +23,61 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check data -for mat='MEKG' - if(not(isfield(eqn, sprintf('%c_',mat))) || not(eval(sprintf('isnumeric(eqn.%c_)',mat)))) - error('MESS:error_arguments', 'field eqn.%c_ is not defined',mat); +for mat = 'MEKG' + if not(isfield(eqn, sprintf('%c_', mat))) || not(eval(sprintf('isnumeric(eqn.%c_)', mat))) + mess_err(opts, 'error_arguments', 'field eqn.%c_ is not defined', mat); end end -nv = size(eqn.M_,1); -np = size(eqn.G_,1); +nv = size(eqn.M_, 1); +np = size(eqn.G_, 1); -if not(isfield(eqn,'type')) - eqn.type='N'; - warning('MESS:equation_type',['Unable to determine type of equation.'... - 'Falling back to type ''N''']); +if not(isfield(eqn, 'type')) + eqn.type = 'N'; + mess_warn(opts, 'equation_type', ['Unable to determine type of equation.'... + 'Falling back to type ''N''']); end -if (not(isnumeric(RHS))) || (not(ismatrix(RHS))) - error('MESS:error_arguments','RHS has to be a matrix'); +if (not(isnumeric(W))) || (not(ismatrix(W))) + mess_err(opts, 'error_arguments', 'W has to be a matrix'); end -%% compute low rank residual -RHStemp1 = zeros(nv+np,size(RHS,2)); -RHStemp2 = zeros(nv+np,size(RHS,2)); -RHStemp1(1:nv,:) = RHS(1:nv,:); -RHStemp2(1:nv,:) = RHS(nv+1:2*nv,:); - -S = [eqn.M_,eqn.G_'; - eqn.G_,sparse(np,np)]; -X1 = full( S \ RHStemp1); -X2 = full( S \ RHStemp2); -W = [eqn.M_*X1(1:nv,:);eqn.M_*X2(1:nv,:)]; - +%% compute low-rank residual +Wtemp1 = zeros(nv + np, size(W, 2)); +Wtemp2 = zeros(nv + np, size(W, 2)); +Wtemp1(1:nv, :) = W(1:nv, :); +Wtemp2(1:nv, :) = W(nv + 1:2 * nv, :); +S = [eqn.M_, eqn.G_' + eqn.G_, sparse(np, np)]; +X1 = full(S \ Wtemp1); +X2 = full(S \ Wtemp2); +W = [eqn.M_ * X1(1:nv, :); eqn.M_ * X2(1:nv, :)]; %% compute res0 +if not(exist('T', 'var')) && opts.LDL_T + % this means we only use init_res for projection + return +end + if isfield(opts, 'nm') && isfield(opts.nm, 'res0') res0 = opts.nm.res0; else if opts.LDL_T if opts.norm == 2 - res0 = max(abs(eig(RHS' * RHS * diag(eqn.S_diag)))); + res0 = max(abs(eig(W' * W * T))); else - res0 = norm(eig(RHS' * RHS * diag(eqn.S_diag)), 'fro'); + res0 = norm(eig(W' * W * T), 'fro'); end else - res0 = norm(RHS' * RHS, opts.norm); + res0 = norm(W' * W, opts.norm); end end end - diff --git a/usfs/dae_3_so/mul_A_dae_3_so.m b/usfs/dae_3_so/mul_A_dae_3_so.m index 01acb89..dbda1e2 100644 --- a/usfs/dae_3_so/mul_A_dae_3_so.m +++ b/usfs/dae_3_so/mul_A_dae_3_so.m @@ -1,4 +1,4 @@ -function C = mul_A_dae_3_so(eqn, opts, opA, B, opB)%#ok +function C = mul_A_dae_3_so(eqn, opts, opA, B, opB) %% function mul_A performs operation C = opA(A_)*opB(B) % % Input: @@ -27,61 +27,62 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % %% check input Parameters -if (not(ischar(opA)) || not(ischar(opB))) - error('MESS:error_arguments', 'opA or opB is not a char'); +if not(ischar(opA)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opA or opB is not a char'); end -opA = upper(opA); opB = upper(opB); -if(not((opA == 'N' || opA == 'T'))) - error('MESS:error_arguments', 'opA is not ''N'' or ''T'''); +opA = upper(opA); +opB = upper(opB); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if(not((opB == 'N' || opB == 'T'))) - error('MESS:error_arguments', 'opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -for mat='EKG' - if(not(isfield(eqn, sprintf('%c_',mat))) || ... - not(eval(sprintf('isnumeric(eqn.%c_)',mat)))) - error('MESS:error_arguments', 'field eqn.%c_ is not defined',mat); +for mat = 'EKG' + if not(isfield(eqn, sprintf('%c_', mat))) || ... + not(eval(sprintf('isnumeric(eqn.%c_)', mat))) + mess_err(opts, 'error_arguments', 'field eqn.%c_ is not defined', mat); end end -nv = size(eqn.M_,1); -np = size(eqn.G_,1); -st = 2*nv; +nv = size(eqn.M_, 1); +np = size(eqn.G_, 1); +st = 2 * nv; n = st + np; -[rowB,colB] = size(B); +[rowB, colB] = size(B); -if(opB == 'N') - if(n > rowB) +if opB == 'N' + if n > rowB B = [B; zeros(np, colB)]; elseif n < rowB - error('MESS:error_arguments', 'B has more rows than A'); + mess_err(opts, 'error_arguments', 'B has more rows than A'); end else - if(n > colB) + if n > colB B = [B, zeros(rowB, np)]; elseif n < colB - error('MESS:error_arguments', 'B has more columns than A'); + mess_err(opts, 'error_arguments', 'B has more columns than A'); end end %% perform multiplication -if (opB=='N' && (size(B,1)==(2*nv+np))) || (opB=='T' && (size(B,2)==(2*nv+np))) +if (opB == 'N' && (size(B, 1) == (2 * nv + np))) || (opB == 'T' && (size(B, 2) == (2 * nv + np))) switch opA case 'N' @@ -89,40 +90,40 @@ switch opB case 'N' - %implement operation A_*B - C = [B(nv+1:2*nv,:);... - eqn.K_*B(1:nv,:)+eqn.E_*B(nv+1:2*nv,:)+eqn.G_'*B(2*nv+1:end,:); - eqn.G_*B(1:nv,:)]; + % implement operation A_*B + C = [B(nv + 1:2 * nv, :); ... + eqn.K_ * B(1:nv, :) + eqn.E_ * B(nv + 1:2 * nv, :) + eqn.G_' * B(2 * nv + 1:end, :) + eqn.G_ * B(1:nv, :)]; case 'T' - %implement operation A_*B' - C = [B(:,nv+1:2*nv)';... - eqn.K_*B(:,1:nv)'+eqn.E_*B(:,nv+1:2*nv)'+eqn.G_'*B(:,2*nv+1:end)'; - eqn.G_*B(:,1:nv)']; + % implement operation A_*B' + C = [B(:, nv + 1:2 * nv)'; ... + eqn.K_ * B(:, 1:nv)' + eqn.E_ * B(:, nv + 1:2 * nv)' + eqn.G_' * B(:, 2 * nv + 1:end)' + eqn.G_ * B(:, 1:nv)']; end case 'T' switch opB case 'N' - %implement operation A_'*B - C = [eqn.K_'*B(nv+1:2*nv,:)+ eqn.G_'*B(2*nv+1:end,:);... - B(1:nv,:)+eqn.E_'*B(nv+1:2*nv,:); - eqn.G_*B(nv+1:2*nv,:)]; + % implement operation A_'*B + C = [eqn.K_' * B(nv + 1:2 * nv, :) + eqn.G_' * B(2 * nv + 1:end, :); ... + B(1:nv, :) + eqn.E_' * B(nv + 1:2 * nv, :) + eqn.G_ * B(nv + 1:2 * nv, :)]; case 'T' - %implement operation A_'*B' - C = [eqn.K_'*B(:,nv+1:2*nv)'+ eqn.G_'*B(:,2*nv+1:end)';... - B(:,1:nv)'+eqn.E_'*B(:,nv+1:2*nv)'; - eqn.G_*B(:,nv+1:2*nv)']; + % implement operation A_'*B' + C = [eqn.K_' * B(:, nv + 1:2 * nv)' + eqn.G_' * B(:, 2 * nv + 1:end)'; ... + B(:, 1:nv)' + eqn.E_' * B(:, nv + 1:2 * nv)' + eqn.G_ * B(:, nv + 1:2 * nv)']; end end -elseif (opB=='N' && (size(B,1)==(2*nv))) || (opB=='T' && (size(B,2)==(2*nv))) - error('MESS:error_usage','mul_A_dae_3_so is only coded for shift parameter computation'); +elseif (opB == 'N' && (size(B, 1) == (2 * nv))) || (opB == 'T' && (size(B, 2) == (2 * nv))) + mess_err(opts, 'error_usage', 'mul_A_dae_3_so is only coded for shift parameter computation'); else - error('MESS:error_arguments', 'B has wrong number of cols'); + mess_err(opts, 'error_arguments', 'B has wrong number of cols'); end if opB == 'N' - C = C(1 : rowB, : ); + C = C(1:rowB, :); else - C = C(1 : colB, : ); + C = C(1:colB, :); end end diff --git a/usfs/dae_3_so/mul_ApE_dae_3_so.m b/usfs/dae_3_so/mul_ApE_dae_3_so.m index b72f694..d704b79 100644 --- a/usfs/dae_3_so/mul_ApE_dae_3_so.m +++ b/usfs/dae_3_so/mul_ApE_dae_3_so.m @@ -1,4 +1,4 @@ -function C = mul_ApE_dae_3_so(eqn, opts, opA,p,opE, B, opB)%#ok +function C = mul_ApE_dae_3_so(eqn, opts, opA, p, opE, B, opB) %% function mul_ApE_dae_3_so computes C = (opA(A_) + p*opE(E_))*opB(B) % % @@ -36,183 +36,195 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input Parameters -if (not(ischar(opA)) || not(ischar(opE)) || not(ischar(opB))) - error('MESS:error_arguments', 'opA, opE or opB is not a char'); +if not(ischar(opA)) || not(ischar(opE)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opA, opE or opB is not a char'); end -opA = upper(opA); opE = upper(opE); opB = upper(opB); +opA = upper(opA); +opE = upper(opE); +opB = upper(opB); -if(not((opA == 'N' || opA == 'T'))) - error('MESS:error_arguments', 'opA is not ''N'' or ''T'''); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if(not((opE == 'N' || opE == 'T'))) - error('MESS:error_arguments', 'opE is not ''N'' or ''T'''); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end -if(not((opB == 'N' || opB == 'T'))) - error('MESS:error_arguments', 'opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end -if(not(isnumeric(p))) - error('MESS:error_arguments','p is not numeric'); +if not(isnumeric(p)) + mess_err(opts, 'error_arguments', 'p is not numeric'); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -for mat='MEKG' - if(not(isfield(eqn, sprintf('%c_',mat))) ||... - not(eval(sprintf('isnumeric(eqn.%c_))',mat)))) - error('MESS:error_arguments', 'field eqn.%c_ is not defined',mat); +for mat = 'MEKG' + if not(isfield(eqn, sprintf('%c_', mat))) || ... + not(eval(sprintf('isnumeric(eqn.%c_))', mat))) + mess_err(opts, 'error_arguments', 'field eqn.%c_ is not defined', mat); end end -nv = size(eqn.M_,1); -np = size(eqn.G_,1); +nv = size(eqn.M_, 1); +np = size(eqn.G_, 1); -[rowB,colB] = size(B); +[rowB, colB] = size(B); -if(opB == 'N') - if (rowB ~= 2*nv + np) +if opB == 'N' + if not(rowB == 2 * nv + np) B = [B; zeros(2 * nv + np - rowB, colB)]; end else - if (colB ~= 2*nv + np) + if not(colB == 2 * nv + np) B = [B, zeros(rowB, 2 * nv + np - colB)]; end end %% compute C = (A + p * E) * B if eqn.haveE - %% perform solve operations for E ~= Identity + %% perform solve operations for E is not the Identity switch opA - case 'N' - switch opE - case 'N' - switch opB - case 'N' - C1 = p * B(1 : nv, :) + B(nv + 1 : 2 * nv, :); - C2 = eqn.K_ * B(1 : nv, :) ... - + (eqn.E_ + p * eqn.M_) * B(nv + 1 : 2 * nv, :) ... - + eqn.G_' * B(2 * nv + 1 : end, :); - C3 = eqn.G_ * B(1 : nv, :); - C = [C1; C2; C3]; - case 'T' - C1 = p * B( : , 1 : nv)' + B( : , nv + 1 : 2 * nv)'; - C2 = eqn.K_ * B( : , 1 : nv)' ... - + (eqn.E_ + p * eqn.M_) * B( : , nv + 1 : 2 * nv)' ... - + eqn.G_' * B( : , 2 * nv + 1 : end)'; - C3 = eqn.G_ * B( : , 1 : nv)'; - C = [C1; C2; C3]; - end - case 'T' - switch opB - case 'N' - C1 = p * B(1 : nv, :) + B(nv + 1 : 2 * nv, :); - C2 = eqn.K_ * B(1 : nv, :) ... - + (eqn.E_ + p * eqn.M_') * B(nv + 1 : 2 * nv, :) ... - + eqn.G_' * B(2 * nv + 1 : end, :); - C3 = eqn.G_ * B(1 : nv, :); - C = [C1; C2; C3]; - case 'T' - C1 = p * B( : , 1 : nv)' + B( : , nv + 1 : 2 * nv)'; - C2 = eqn.K_ * B( : , 1 : nv)' ... - + (eqn.E_ + p * eqn.M_') * B( : , nv + 1 : 2 * nv)' ... - + eqn.G_' * B( : , 2 * nv + 1 : end)'; - C3 = eqn.G_ * B( : , 1 : nv)'; - C = [C1; C2; C3]; - end - end - case 'T' - switch opE - case 'N' - switch opB - case 'N' - C1 = p * B(1 : nv, :) + eqn.K_' * B(nv + 1 : 2 * nv, :) ... - + eqn.G_' * B(2 * nv + 1 : end, :); - C2 = B(1 : nv, :) ... - + (eqn.E_' + p * eqn.M_) * B(nv + 1 : 2 * nv, :); - C3 = eqn.G_ * B(nv + 1 : 2 * nv, :); - C = [C1; C2; C3]; - case 'T' - C1 = p * B( : , 1 : nv)' + eqn.K_' * B( : , nv + 1 : 2 * nv)' ... - + eqn.G_' * B( : , 2 * nv + 1 : end)'; - C2 = B( : , 1 : nv)' ... - + (eqn.E_' + p * eqn.M_) * B( : , nv + 1 : 2 * nv)'; - C3 = eqn.G_ * B( : , nv + 1 : 2 * nv)'; - C = [C1; C2; C3]; + case 'N' + switch opE + case 'N' + switch opB + case 'N' + C1 = p * B(1:nv, :) + B(nv + 1:2 * nv, :); + C2 = eqn.K_ * B(1:nv, :) + ... + (eqn.E_ + p * eqn.M_) * ... + B(nv + 1:2 * nv, :) + ... + eqn.G_' * B(2 * nv + 1:end, :); + C3 = eqn.G_ * B(1:nv, :); + C = [C1; C2; C3]; + case 'T' + C1 = p * B(:, 1:nv)' + B(:, nv + 1:2 * nv)'; + C2 = eqn.K_ * B(:, 1:nv)' + ... + (eqn.E_ + p * eqn.M_) * ... + B(:, nv + 1:2 * nv)' + ... + eqn.G_' * B(:, 2 * nv + 1:end)'; + C3 = eqn.G_ * B(:, 1:nv)'; + C = [C1; C2; C3]; + end + case 'T' + switch opB + case 'N' + C1 = p * B(1:nv, :) + B(nv + 1:2 * nv, :); + C2 = eqn.K_ * B(1:nv, :) + ... + (eqn.E_ + p * eqn.M_') * ... + B(nv + 1:2 * nv, :) + ... + eqn.G_' * B(2 * nv + 1:end, :); + C3 = eqn.G_ * B(1:nv, :); + C = [C1; C2; C3]; + case 'T' + C1 = p * B(:, 1:nv)' + B(:, nv + 1:2 * nv)'; + C2 = eqn.K_ * B(:, 1:nv)' + ... + (eqn.E_ + p * eqn.M_') * ... + B(:, nv + 1:2 * nv)' + ... + eqn.G_' * B(:, 2 * nv + 1:end)'; + C3 = eqn.G_ * B(:, 1:nv)'; + C = [C1; C2; C3]; + end end - case 'T' - switch opB - case 'N' - C1 = p * B(1 : nv, :) + eqn.K_' * B(nv + 1 : 2 * nv, :) ... - + eqn.G_' * B(2 * nv + 1 : end, :); - C2 = B(1 : nv, :) ... - + (eqn.E_' + p * eqn.M_') * B(nv + 1 : 2 * nv, :); - C3 = eqn.G_ * B(nv + 1 : 2 * nv, :); - C = [C1; C2; C3]; - case 'T' - C1 = p * B( : , 1 : nv)' + eqn.K_' * B( : , nv + 1 : 2 * nv)' ... - + eqn.G_' * B( : , 2 * nv + 1 : end)'; - C2 = B( : , 1 : nv)' ... - + (eqn.E_' + p * eqn.M_') * B( : , nv + 1 : 2 * nv)'; - C3 = eqn.G_ * B( : , nv + 1 : 2 * nv)'; - C = [C1; C2; C3]; + case 'T' + switch opE + case 'N' + switch opB + case 'N' + C1 = p * B(1:nv, :) + ... + eqn.K_' * B(nv + 1:2 * nv, :) + ... + eqn.G_' * B(2 * nv + 1:end, :); + C2 = B(1:nv, :) + ... + (eqn.E_' + p * eqn.M_) * B(nv + 1:2 * nv, :); + C3 = eqn.G_ * B(nv + 1:2 * nv, :); + C = [C1; C2; C3]; + case 'T' + C1 = p * B(:, 1:nv)' + ... + eqn.K_' * B(:, nv + 1:2 * nv)' + ... + eqn.G_' * B(:, 2 * nv + 1:end)'; + C2 = B(:, 1:nv)' + ... + (eqn.E_' + p * eqn.M_) * B(:, nv + 1:2 * nv)'; + C3 = eqn.G_ * B(:, nv + 1:2 * nv)'; + C = [C1; C2; C3]; + end + case 'T' + switch opB + case 'N' + C1 = p * B(1:nv, :) + ... + eqn.K_' * B(nv + 1:2 * nv, :) + ... + eqn.G_' * B(2 * nv + 1:end, :); + C2 = B(1:nv, :) + ... + (eqn.E_' + p * eqn.M_') * B(nv + 1:2 * nv, :); + C3 = eqn.G_ * B(nv + 1:2 * nv, :); + C = [C1; C2; C3]; + case 'T' + C1 = p * B(:, 1:nv)' + ... + eqn.K_' * B(:, nv + 1:2 * nv)' + ... + eqn.G_' * B(:, 2 * nv + 1:end)'; + C2 = B(:, 1:nv)' + ... + (eqn.E_' + p * eqn.M_') * B(:, nv + 1:2 * nv)'; + C3 = eqn.G_ * B(:, nv + 1:2 * nv)'; + C = [C1; C2; C3]; + end end - end end else %% perform solve operations for E = Identity switch opA - case 'N' - switch opB - case 'N' - C1 = p * B(1 : nv, :) + B(nv + 1 : 2 * nv, :); - C2 = eqn.K_ * B(1 : nv, :) ... - + (eqn.E_ + p * speye(nv, nv)) * B(nv + 1 : 2 * nv, :) ... - + eqn.G_' * B(2 * nv + 1 : end, :); - C3 = eqn.G_ * B(1 : nv, :); - C = [C1; C2; C3]; - case 'T' - C1 = p * B( : , 1 : nv)' + B( : , nv + 1 : 2 * nv)'; - C2 = eqn.K_ * B( : , 1 : nv)' ... - + (eqn.E_ + p * speye(nv, nv)) * B( : , nv + 1 : 2 * nv)' ... - + eqn.G_' * B( : , 2 * nv + 1 : end)'; - C3 = eqn.G_ * B( : , 1 : nv)'; - C = [C1; C2; C3]; - end - case 'T' - switch opB - case 'N' - C1 = p * B(1 : nv, :) + eqn.K_' * B(nv + 1 : 2 * nv, :) ... - + eqn.G_' * B(2 * nv + 1 : end, :); - C2 = B(1 : nv, :) ... - + (eqn.E_' + p * speye(nv, nv)) * B(nv + 1 : 2 * nv, :); - C3 = eqn.G_ * B(nv + 1 : 2 * nv, :); - C = [C1; C2; C3]; - case 'T' - C1 = p * B( : , 1 : nv)' + eqn.K_' * B( : , nv + 1 : 2 * nv)' ... - + eqn.G_' * B( : , 2 * nv + 1 : end)'; - C2 = B( : , 1 : nv)' ... - + (eqn.E_' + p * speye(nv, nv)) * B( : , nv + 1 : 2 * nv)'; - C3 = eqn.G_ * B( : , nv + 1 : 2 * nv)'; - C = [C1; C2; C3]; - end + case 'N' + switch opB + case 'N' + C1 = p * B(1:nv, :) + B(nv + 1:2 * nv, :); + C2 = eqn.K_ * B(1:nv, :) + ... + (eqn.E_ + p * speye(nv, nv)) * ... + B(nv + 1:2 * nv, :) + ... + eqn.G_' * B(2 * nv + 1:end, :); + C3 = eqn.G_ * B(1:nv, :); + C = [C1; C2; C3]; + case 'T' + C1 = p * B(:, 1:nv)' + B(:, nv + 1:2 * nv)'; + C2 = eqn.K_ * B(:, 1:nv)' + ... + (eqn.E_ + p * speye(nv, nv)) * ... + B(:, nv + 1:2 * nv)' + ... + eqn.G_' * B(:, 2 * nv + 1:end)'; + C3 = eqn.G_ * B(:, 1:nv)'; + C = [C1; C2; C3]; + end + case 'T' + switch opB + case 'N' + C1 = p * B(1:nv, :) + eqn.K_' * B(nv + 1:2 * nv, :) + ... + eqn.G_' * B(2 * nv + 1:end, :); + C2 = B(1:nv, :) + ... + (eqn.E_' + p * speye(nv, nv)) * B(nv + 1:2 * nv, :); + C3 = eqn.G_ * B(nv + 1:2 * nv, :); + C = [C1; C2; C3]; + case 'T' + C1 = p * B(:, 1:nv)' + ... + eqn.K_' * B(:, nv + 1:2 * nv)' + ... + eqn.G_' * B(:, 2 * nv + 1:end)'; + C2 = B(:, 1:nv)' + ... + (eqn.E_' + p * speye(nv, nv)) * B(:, nv + 1:2 * nv)'; + C3 = eqn.G_ * B(:, nv + 1:2 * nv)'; + C = [C1; C2; C3]; + end end end if opB == 'N' - C = C(1 : rowB, : ); + C = C(1:rowB, :); else - C = C(1 : colB, : ); + C = C(1:colB, :); end end diff --git a/usfs/dae_3_so/mul_E_dae_3_so.m b/usfs/dae_3_so/mul_E_dae_3_so.m index 1545c5f..aa4f92c 100644 --- a/usfs/dae_3_so/mul_E_dae_3_so.m +++ b/usfs/dae_3_so/mul_E_dae_3_so.m @@ -1,4 +1,4 @@ -function C = mul_E_dae_3_so(eqn, opts, opE, B, opB)%#ok +function C = mul_E_dae_3_so(eqn, opts, opE, B, opB) %% function mul_A performs operation C = opE(E_)*opB(B) % % Input: @@ -23,115 +23,115 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input Parameters -if (not(ischar(opE)) || not(ischar(opB))) - error('MESS:error_arguments', 'opE or opB is not a char'); +if not(ischar(opE)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opE or opB is not a char'); end -opE = upper(opE); opB = upper(opB); -if(not((opE == 'N' || opE == 'T'))) - error('MESS:error_arguments','opE is not ''N'' or ''T'''); +opE = upper(opE); +opB = upper(opB); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end -if(not((opB == 'N' || opB == 'T'))) - error('MESS:error_arguments','opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -for mat='MG' - if(not(isfield(eqn, sprintf('%c_',mat))) || ... - not(eval(sprintf('isnumeric(eqn.%c_)',mat)))) - error('MESS:error_arguments', 'field eqn.%c_ is not defined',mat); +for mat = 'MG' + if not(isfield(eqn, sprintf('%c_', mat))) || ... + not(eval(sprintf('isnumeric(eqn.%c_)', mat))) + mess_err(opts, 'error_arguments', 'field eqn.%c_ is not defined', mat); end end %% perform multiplication -nv = size(eqn.M_,1); -np = size(eqn.G_,1); +nv = size(eqn.M_, 1); +np = size(eqn.G_, 1); -if (opB=='N' && (size(B,1)==(2*nv+np))) || (opB=='T' && (size(B,2)==(2*nv+np))) +if (opB == 'N' && (size(B, 1) == (2 * nv + np))) || (opB == 'T' && (size(B, 2) == (2 * nv + np))) switch opE case 'N' switch opB - %implement operation E_*B + % implement operation E_*B case 'N' - C = [B(1:nv,:); - eqn.M_*B(nv+1:2*nv,:)+eqn.alpha*eqn.G_'*B(2*nv+1:end,:); - eqn.alpha*eqn.G_*B(nv+1:2*nv,:)]; + C = [B(1:nv, :) + eqn.M_ * B(nv + 1:2 * nv, :) + eqn.alpha * eqn.G_' * B(2 * nv + 1:end, :) + eqn.alpha * eqn.G_ * B(nv + 1:2 * nv, :)]; - %implement operation E_*B' + % implement operation E_*B' case 'T' - C = [B(:,1:nv)'; - eqn.M_*B(:,nv+1:2*nv)'+eqn.alpha*eqn.G_'*B(:,2*nv+1:end)'; - eqn.alpha*eqn.G_*B(:,nv+1:2*nv)']; + C = [B(:, 1:nv)' + eqn.M_ * B(:, nv + 1:2 * nv)' + eqn.alpha * eqn.G_' * B(:, 2 * nv + 1:end)' + eqn.alpha * eqn.G_ * B(:, nv + 1:2 * nv)']; end case 'T' switch opB - %implement operation E_'*B + % implement operation E_'*B case 'N' - C = [B(1:nv,:); - eqn.M_'*B(nv+1:2*nv,:)+eqn.alpha*eqn.G_'*B(2*nv+1:end,:); - eqn.alpha*eqn.G_*B(nv+1:2*nv,:)]; + C = [B(1:nv, :) + eqn.M_' * B(nv + 1:2 * nv, :) + eqn.alpha * eqn.G_' * B(2 * nv + 1:end, :) + eqn.alpha * eqn.G_ * B(nv + 1:2 * nv, :)]; - %implement operation E_'*B' + % implement operation E_'*B' case 'T' - C = [B(:,1:nv)'; - eqn.M_'*B(:,nv+1:2*nv)'+eqn.alpha*eqn.G_'*B(:,2*nv+1:end)'; - eqn.alpha*eqn.G_*B(:,nv+1:2*nv)']; + C = [B(:, 1:nv)' + eqn.M_' * B(:, nv + 1:2 * nv)' + eqn.alpha * eqn.G_' * B(:, 2 * nv + 1:end)' + eqn.alpha * eqn.G_ * B(:, nv + 1:2 * nv)']; end end -elseif (opB=='N' && (size(B,1)==(2*nv))) || (opB=='T' && (size(B,2)==(2*nv))) +elseif (opB == 'N' && (size(B, 1) == (2 * nv))) || (opB == 'T' && (size(B, 2) == (2 * nv))) switch opE case 'N' switch opB - %implement operation E_*B + % implement operation E_*B case 'N' - C = [B(1:nv,:); - eqn.M_*B(nv+1:2*nv,:)]; + C = [B(1:nv, :) + eqn.M_ * B(nv + 1:2 * nv, :)]; - %implement operation E_*B' + % implement operation E_*B' case 'T' - C = [B(:,1:nv)'; - eqn.M_*B(:,nv+1:2*nv)']; + C = [B(:, 1:nv)' + eqn.M_ * B(:, nv + 1:2 * nv)']; end case 'T' switch opB - %implement operation E_'*B + % implement operation E_'*B case 'N' - C = [B(1:nv,:); - eqn.M_'*B(nv+1:2*nv,:)]; + C = [B(1:nv, :) + eqn.M_' * B(nv + 1:2 * nv, :)]; - %implement operation E_'*B' + % implement operation E_'*B' case 'T' - C = [B(:,1:nv)'; - eqn.M_'*B(:,nv+1:2*nv)']; + C = [B(:, 1:nv)' + eqn.M_' * B(:, nv + 1:2 * nv)']; end end else - error('MESS:error_arguments', 'B has wrong number of cols'); + mess_err(opts, 'error_arguments', 'B has wrong number of cols'); end end diff --git a/usfs/dae_3_so/size_dae_3_so.m b/usfs/dae_3_so/size_dae_3_so.m index b8e927f..e8299d7 100644 --- a/usfs/dae_3_so/size_dae_3_so.m +++ b/usfs/dae_3_so/size_dae_3_so.m @@ -1,4 +1,4 @@ -function n = size_dae_3_so(eqn, opts, oper)%#ok +function n = size_dae_3_so(eqn, opts, oper) %#ok % function n = size_dae_3_so(eqn, opts, oper) % % This function returns the number of rows of the implicitly projected A @@ -20,11 +20,10 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - -n= 2*size(eqn.M_,1); +n = 2 * size(eqn.M_, 1); end diff --git a/usfs/dae_3_so/sol_A_dae_3_so.m b/usfs/dae_3_so/sol_A_dae_3_so.m index 1b2aef3..5e1c672 100644 --- a/usfs/dae_3_so/sol_A_dae_3_so.m +++ b/usfs/dae_3_so/sol_A_dae_3_so.m @@ -1,4 +1,4 @@ -function X = sol_A_dae_3_so(eqn, opts, opA, B, opB)%#ok +function X = sol_A_dae_3_so(eqn, opts, opA, B, opB) % function sol_A solves solves opA(A_)*X = opB(B) % % Input: @@ -19,82 +19,90 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - - %% check input Parameters -if (not(ischar(opA)) || not(ischar(opB))) - error('MESS:error_arguments', 'opA or opB is not a char'); +if not(ischar(opA)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opA or opB is not a char'); end -opA = upper(opA); opB = upper(opB); -if(not((opA == 'N' || opA == 'T'))) - error('MESS:error_arguments','opA is not ''N'' or ''T'''); +opA = upper(opA); +opB = upper(opB); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if(not((opB == 'N' || opB == 'T'))) - error('MESS:error_arguments','opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -for mat='EKG' - if(not(isfield(eqn, sprintf('%c_',mat))) || ... - not(eval(sprintf('isnumeric(eqn.%c_)',mat)))) - error('MESS:error_arguments', 'field eqn.%c_ is not defined',mat); +for mat = 'EKG' + if not(isfield(eqn, sprintf('%c_', mat))) || ... + not(eval(sprintf('isnumeric(eqn.%c_)', mat))) + mess_err(opts, 'error_arguments', 'field eqn.%c_ is not defined', mat); end end -nv = size(eqn.M_,1); -np = size(eqn.G_,1); +nv = size(eqn.M_, 1); +np = size(eqn.G_, 1); %% solve -if (opB=='N' && (size(B,1)==(2*nv+np))) || (opB=='T' && (size(B,2)==(2*nv+np))) -switch opA - - case 'N' - switch opB - - %implement solve A_*X=B - case 'N' - x = [eqn.K_, eqn.G_';eqn.G_,sparse(np,np)]\ [B(nv+1:2*nv,:)-eqn.E_*B(1:nv,:);B(2*nv+1:end,:)]; - X = [x(1:nv,:);B(1:nv,:);x(nv+1:end,:)]; - - %implement solve A_*X=B' - case 'T' - x = [eqn.K_, eqn.G_';eqn.G_,sparse(np,np)]\ [B(:,nv+1:2*nv)'-eqn.E_*B(:,1:nv)';B(:,2*nv+1:end)']; - X = [x(1:nv,:);B(:,1:nv)';x(nv+1:end,:)]; - end - - case 'T' - switch opB +if (opB == 'N' && (size(B, 1) == (2 * nv + np))) || ... + (opB == 'T' && (size(B, 2) == (2 * nv + np))) + switch opA + + case 'N' + switch opB + + % implement solve A_*X=B + case 'N' + x = [eqn.K_, eqn.G_'; eqn.G_, sparse(np, np)] \ ... + [B(nv + 1:2 * nv, :) - eqn.E_ * B(1:nv, :); ... + B(2 * nv + 1:end, :)]; + X = [x(1:nv, :); B(1:nv, :); x(nv + 1:end, :)]; + + % implement solve A_*X=B' + case 'T' + x = [eqn.K_, eqn.G_'; eqn.G_, sparse(np, np)] \ ... + [B(:, nv + 1:2 * nv)' - eqn.E_ * B(:, 1:nv)'; ... + B(:, 2 * nv + 1:end)']; + X = [x(1:nv, :); B(:, 1:nv)'; x(nv + 1:end, :)]; + end + + case 'T' + switch opB + + % implement solve A_'*X=B + case 'N' + x = [eqn.K_', eqn.G_'; eqn.G_, sparse(np, np)] \ ... + [B(1:nv, :); B(2 * nv + 1:end, :)]; + X = [B(nv + 1:2 * nv, :) - eqn.E_' * x(1:nv, :); ... + x(1:nv, :); x(nv + 1:end, :)]; + + % implement solve A_'*X=B' + case 'T' + x = [eqn.K_', eqn.G_'; eqn.G_, sparse(np, np)] \ ... + [B(:, 1:nv)'; B(:, 2 * nv + 1:end)']; + X = [B(:, nv + 1:2 * nv)' - eqn.E_' * x(1:nv, :); ... + x(1:nv, :); x(nv + 1:end, :)]; + end - %implement solve A_'*X=B - case 'N' - x = [eqn.K_',eqn.G_';eqn.G_,sparse(np,np)]\[B(1:nv,:);B(2*nv+1:end,:)]; - X = [B(nv+1:2*nv,:)-eqn.E_'*x(1:nv,:);x(1:nv,:);x(nv+1:end,:)]; - - %implement solve A_'*X=B' - case 'T' - x = [eqn.K_',eqn.G_';eqn.G_,sparse(np,np)]\[B(:,1:nv)';B(:,2*nv+1:end)']; - X = [B(:,nv+1:2*nv)'-eqn.E_'*x(1:nv,:);x(1:nv,:);x(nv+1:end,:)]; - end - -end -elseif (opB=='N' && (size(B,1)==(2*nv))) || (opB=='T' && (size(B,2)==(2*nv))) - error('MESS:error_usage','mul_A_dae_2_so is only coded for shift parameter computation'); + end +elseif (opB == 'N' && (size(B, 1) == (2 * nv))) || ... + (opB == 'T' && (size(B, 2) == (2 * nv))) + mess_err(opts, 'error_usage', ... + 'mul_A_dae_2_so is only coded for shift parameter computation'); else - error('MESS:error_arguments', 'B has wrong number of cols'); + mess_err(opts, 'error_arguments', 'B has wrong number of cols'); end - - end diff --git a/usfs/dae_3_so/sol_ApE_dae_3_so.m b/usfs/dae_3_so/sol_ApE_dae_3_so.m index 28b5e7a..1542929 100644 --- a/usfs/dae_3_so/sol_ApE_dae_3_so.m +++ b/usfs/dae_3_so/sol_ApE_dae_3_so.m @@ -1,4 +1,4 @@ -function X = sol_ApE_dae_3_so(eqn, opts, opA, p, opE, B, opB)%#ok +function X = sol_ApE_dae_3_so(eqn, opts, opA, p, opE, B, opB) %% function sol_ApE solves (opA(A_) + p*opE(E_))*X = opB(B) % resp. performs X=(opA(A_)+p*opE(E_))\opB(B) % @@ -38,170 +38,202 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input Parameters -if (not(ischar(opA)) || not(ischar(opE)) || not(ischar(opB))) - error('MESS:error_arguments', 'opA, opE or opB is not a char'); +if not(ischar(opA)) || not(ischar(opE)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opA, opE or opB is not a char'); end -opA = upper(opA); opE = upper(opE); opB = upper(opB); +opA = upper(opA); +opE = upper(opE); +opB = upper(opB); -if(not((opA == 'N' || opA == 'T'))) - error('MESS:error_arguments', 'opA is not ''N'' or ''T'''); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if(not((opE == 'N' || opE == 'T'))) - error('MESS:error_arguments', 'opE is not ''N'' or ''T'''); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end -if(not((opB == 'N' || opB == 'T'))) - error('MESS:error_arguments', 'opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end -if(not(isnumeric(p))) - error('MESS:error_arguments','p is not numeric'); +if not(isnumeric(p)) + mess_err(opts, 'error_arguments', 'p is not numeric'); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -for mat='MEKG' - if(not(isfield(eqn, sprintf('%c_',mat))) || ... - not(eval(sprintf('isnumeric(eqn.%c_)',mat)))) - error('MESS:error_arguments', 'field eqn.%c_ is not defined',mat); +for mat = 'MEKG' + if not(isfield(eqn, sprintf('%c_', mat))) || ... + not(eval(sprintf('isnumeric(eqn.%c_)', mat))) + mess_err(opts, 'error_arguments', 'field eqn.%c_ is not defined', mat); end end -nv = size(eqn.M_,1); -np = size(eqn.G_,1); +nv = size(eqn.M_, 1); +np = size(eqn.G_, 1); -[rowB,colB] = size(B); +[rowB, colB] = size(B); -if(opB == 'N') - if (rowB ~= 2*nv + np) +if opB == 'N' + if not(rowB == 2 * nv + np) B = [B; zeros(2 * nv + np - rowB, colB)]; end else - if (colB ~= 2*nv + np) + if not(colB == 2 * nv + np) B = [B, zeros(rowB, 2 * nv + np - colB)]; end end - switch opA +switch opA case 'N' - switch opE - - case 'N' + switch opE - switch opB - %implement solve (A_+p*E_)*X=B case 'N' - x13 = [eqn.K_-p*eqn.E_-p^2*eqn.M_, eqn.G_';... - eqn.G_,zeros(np,np)] \ ... - [B(nv+1:2*nv,:)-eqn.E_*B(1:nv,:)-p*eqn.M_*B(1:nv,:);... - B(2*nv+1:end,:)]; - X = [x13(1:nv,:); B(1:nv,:)-p*x13(1:nv,:); x13(nv+1:end,:)]; - %X = (A + p * E) \ B; - - %implement solve (A_+p*E_)*X=B' + + switch opB + % implement solve (A_+p*E_)*X=B + case 'N' + x13 = [eqn.K_ - p * eqn.E_ - p^2 * eqn.M_, eqn.G_'; ... + eqn.G_, sparse(np, np)] \ ... + [B(nv + 1:2 * nv, :) - ... + eqn.E_ * B(1:nv, :) - ... + p * eqn.M_ * B(1:nv, :); ... + B(2 * nv + 1:end, :)]; + X = [x13(1:nv, :); ... + B(1:nv, :) - p * x13(1:nv, :); ... + x13(nv + 1:end, :)]; + % X = (A + p * E) \ B; + + % implement solve (A_+p*E_)*X=B' + case 'T' + x13 = [eqn.K_ - p * eqn.E_ - p^2 * eqn.M_, eqn.G_'; ... + eqn.G_, sparse(np, np)] \ ... + [B(:, nv + 1:2 * nv)' - ... + eqn.E_ * B(:, 1:nv)' - ... + p * eqn.M_ * B(:, 1:nv)'; ... + B(:, 2 * nv + 1:end)']; + X = [x13(1:nv, :); B(:, 1:nv)' - ... + p * x13(1:nv, :); ... + x13(nv + 1:end, :)]; + % X = (A + p * E) \ B'; + end + case 'T' - x13 = [eqn.K_-p*eqn.E_-p^2*eqn.M_, eqn.G_';... - eqn.G_,zeros(np,np)]\... - [B(:,nv+1:2*nv)'-eqn.E_*B(:,1:nv)'-p*eqn.M_*B(:,1:nv)';... - B(:,2*nv+1:end)']; - X = [x13(1:nv,:); B(:,1:nv)'-p*x13(1:nv,:); x13(nv+1:end,:)]; - %X = (A + p * E) \ B'; - end - - case 'T' - - switch opB - %implement solve (A_+p*E_)*X=B + + switch opB + % implement solve (A_+p*E_)*X=B + case 'N' + x13 = [eqn.K_ - p * eqn.E_ - p^2 * eqn.M_', eqn.G_'; ... + eqn.G_, sparse(np, np)] \ ... + [B(nv + 1:2 * nv, :) - ... + eqn.E_ * B(1:nv, :) - ... + p * eqn.M_' * B(1:nv, :); ... + B(2 * nv + 1:end, :)]; + X = [x13(1:nv, :); ... + B(1:nv, :) - p * x13(1:nv, :); ... + x13(nv + 1:end, :)]; + % X = (A + p * E') \ B; + + % implement solve (A_+p*E_)*X=B' + case 'T' + x13 = [eqn.K_ - p * eqn.E_ - p^2 * eqn.M_', eqn.G_'; ... + eqn.G_, sparse(np, np)] \ ... + [B(:, nv + 1:2 * nv)' - ... + eqn.E_ * B(:, 1:nv)' - ... + p * eqn.M_' * B(:, 1:nv)'; ... + B(:, 2 * nv + 1:end)']; + X = [x13(1:nv, :); ... + B(:, 1:nv)' - p * x13(1:nv, :); ... + x13(nv + 1:end, :)]; + % X = (A + p * E') \ B'; + end + + end + + case 'T' + switch opE + case 'N' - x13 = [eqn.K_-p*eqn.E_-p^2*eqn.M_', eqn.G_';... - eqn.G_,zeros(np,np)] \... - [B(nv+1:2*nv,:)-eqn.E_*B(1:nv,:)-p*eqn.M_'*B(1:nv,:);... - B(2*nv+1:end,:)]; - X = [x13(1:nv,:); B(1:nv,:)-p*x13(1:nv,:); x13(nv+1:end,:)]; - %X = (A + p * E') \ B; - - %implement solve (A_+p*E_)*X=B' + + switch opB + % implement solve (A_+p*E_)*X=B + case 'N' + x23 = [eqn.K_' - p * eqn.E_' - ... + p^2 * eqn.M_, eqn.G_'; ... + eqn.G_, sparse(np, np)] \ ... + [B(1:nv, :) - p * B(nv + 1:2 * nv, :); ... + -B(2 * nv + 1:end, :)]; + X = [(B(1:nv, :) - ... + eqn.K_' * x23(1:nv, :) - ... + eqn.G_' * x23(nv + 1:end, :)) ./ p; ... + x23(1:nv, :); ... + x23(nv + 1:end, :)]; + % X = (A' + p * E) \ B; + + % implement solve (A_+p*E_)*X=B' + case 'T' + x23 = [eqn.K_' - p * eqn.E_' - ... + p^2 * eqn.M_, eqn.G_'; ... + eqn.G_, ... + sparse(np, np)] \ ... + [B(:, 1:nv)' - p * B(:, nv + 1:2 * nv)'; ... + -B(:, 2 * nv + 1:end)']; + X = [(B(:, 1:nv)' - eqn.K_' * x23(1:nv, :) - ... + eqn.G_' * x23(nv + 1:end, :)) ./ p; ... + x23(1:nv, :); ... + x23(nv + 1:end, :)]; + % X = (A' + p * E) \ B'; + end + case 'T' - x13 = [eqn.K_-p*eqn.E_-p^2*eqn.M_', eqn.G_';... - eqn.G_,zeros(np,np)] \... - [B(:,nv+1:2*nv)'-eqn.E_*B(:,1:nv)'-p*eqn.M_'*B(:,1:nv)';... - B(:,2*nv+1:end)']; - X = [x13(1:nv,:); B(:,1:nv)'-p*x13(1:nv,:); x13(nv+1:end,:)]; - %X = (A + p * E') \ B'; - end - end + switch opB + % implement solve (A_+p*E_)*X=B + case 'N' + x23 = [eqn.K_' - p * eqn.E_' - p^2 * eqn.M_', ... + eqn.G_'; ... + eqn.G_, ... + sparse(np, np)] \ ... + [B(1:nv, :) - p * B(nv + 1:2 * nv, :); ... + -B(2 * nv + 1:end, :)]; + X = [(B(1:nv, :) - eqn.K_' * x23(1:nv, :) - ... + eqn.G_' * x23(nv + 1:end, :)) ./ p; ... + x23(1:nv, :); ... + x23(nv + 1:end, :)]; + % X = (A' + p * E') \ B; + + % implement solve (A_+p*E_)*X=B' + case 'T' + x23 = [eqn.K_' - p * eqn.E_' - ... + p^2 * eqn.M_', eqn.G_'; ... + eqn.G_, ... + sparse(np, np)] \ ... + [B(:, 1:nv)' - p * B(:, nv + 1:2 * nv)'; ... + -B(:, 2 * nv + 1:end)']; + X = [(B(:, 1:nv)' - eqn.K_' * x23(1:nv, :) - ... + eqn.G_' * x23(nv + 1:end, :)) ./ p; ... + x23(1:nv, :); ... + x23(nv + 1:end, :)]; + % X = (A' + p * E') \ B'; + end + end - case 'T' - switch opE - - case 'N' - - switch opB - %implement solve (A_+p*E_)*X=B - case 'N' - x23 = [eqn.K_'-p*eqn.E_'-p^2*eqn.M_, eqn.G_';... - eqn.G_,zeros(np,np)] \ ... - [B(1:nv,:)-p*B(nv+1:2*nv,:);-B(2*nv+1:end,:)]; - X = [(B(1:nv,:)-eqn.K_'*x23(1:nv,:)... - -eqn.G_'*x23(nv+1:end,:))./p;... - x23(1:nv,:); x23(nv+1:end,:)]; - %X = (A' + p * E) \ B; - - %implement solve (A_+p*E_)*X=B' - case 'T' - x23 = [eqn.K_'-p*eqn.E_'-p^2*eqn.M_, eqn.G_';... - eqn.G_,zeros(np,np)] \ ... - [B(:,1:nv)'-p*B(:,nv+1:2*nv)';-B(:,2*nv+1:end)']; - X = [(B(:,1:nv)'-eqn.K_'*x23(1:nv,:)... - -eqn.G_'*x23(nv+1:end,:))./p;... - x23(1:nv,:); x23(nv+1:end,:)]; - %X = (A' + p * E) \ B'; - end - - case 'T' - - switch opB - %implement solve (A_+p*E_)*X=B - case 'N' - x23 = [eqn.K_'-p*eqn.E_'-p^2*eqn.M_', eqn.G_'; ... - eqn.G_,zeros(np,np)] \ ... - [B(1:nv,:)-p*B(nv+1:2*nv,:);-B(2*nv+1:end,:)]; - X = [(B(1:nv,:)-eqn.K_'*x23(1:nv,:)... - -eqn.G_'*x23(nv+1:end,:))./p;... - x23(1:nv,:); x23(nv+1:end,:)]; - %X = (A' + p * E') \ B; - - %implement solve (A_+p*E_)*X=B' - case 'T' - x23 = [eqn.K_'-p*eqn.E_'-p^2*eqn.M_', eqn.G_';... - eqn.G_,zeros(np,np)] \ ... - [B(:,1:nv)'-p*B(:,nv+1:2*nv)';-B(:,2*nv+1:end)']; - X = [(B(:,1:nv)'-eqn.K_'*x23(1:nv,:)... - -eqn.G_'*x23(nv+1:end,:))./p;... - x23(1:nv,:); x23(nv+1:end,:)]; - %X = (A' + p * E') \ B'; - end - end - - end - if opB == 'N' - X = X(1 : rowB, :); - else - X = X(1 : colB, :); - end end - +if opB == 'N' + X = X(1:rowB, :); +else + X = X(1:colB, :); +end +end diff --git a/usfs/dae_3_so/sol_E_dae_3_so.m b/usfs/dae_3_so/sol_E_dae_3_so.m index 2831837..44aac29 100644 --- a/usfs/dae_3_so/sol_E_dae_3_so.m +++ b/usfs/dae_3_so/sol_E_dae_3_so.m @@ -1,4 +1,4 @@ -function X = sol_E_dae_3_so(eqn, opts, opE, B, opB)%#ok +function X = sol_E_dae_3_so(eqn, opts, opE, B, opB) %% function sol_E_dae_3_so solves opE(E)*X = opB(B) resp. performs X=opE(E)\opB(B) % % Input: @@ -20,60 +20,60 @@ % % X matrix fulfills equation opE(E)*X = opB(B) - % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % %% check input Parameters -if (not(ischar(opE)) || not(ischar(opB))) - error('MESS:error_arguments', 'opE or opB is not a char'); +if not(ischar(opE)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opE or opB is not a char'); end -opE = upper(opE); opB = upper(opB); -if(not((opE == 'N' || opE == 'T'))) - error('MESS:error_arguments','opE is not ''N'' or ''T'''); +opE = upper(opE); +opB = upper(opB); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end -if(not((opB == 'N' || opB == 'T'))) - error('MESS:error_arguments','opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -if(not(isfield(eqn, 'M_'))) || not(isnumeric(eqn.M_)) - error('MESS:error_arguments', 'field eqn.M_ is not defined'); +if (not(isfield(eqn, 'M_'))) || not(isnumeric(eqn.M_)) + mess_err(opts, 'error_arguments', 'field eqn.M_ is not defined'); end -nv = size(eqn.M_,1); -np = size(eqn.G_,1); +nv = size(eqn.M_, 1); +np = size(eqn.G_, 1); %% solve -if (opB=='N' && (size(B,1)==(2*nv+np))) || (opB=='T' && (size(B,2)==(2*nv+np))) +if (opB == 'N' && (size(B, 1) == (2 * nv + np))) || (opB == 'T' && (size(B, 2) == (2 * nv + np))) switch opE case 'N' switch opB - %implement solve E*X=B + % implement solve E*X=B case 'N' - X = [B(1:nv,:); - [eqn.M_,eqn.alpha*eqn.G_'; ... - eqn.alpha*eqn.G_,sparse(np,np)] \ B(nv+1:end,:) + X = [B(1:nv, :) + [eqn.M_, eqn.alpha * eqn.G_'; ... + eqn.alpha * eqn.G_, sparse(np, np)] \ B(nv + 1:end, :) ]; - %implement solve A*X=B' + % implement solve A*X=B' case 'T' - X = [B(:,1:nv)'; - [eqn.M_,eqn.alpha*eqn.G_'; ... - eqn.alpha*eqn.G_,sparse(np,np)] \ B(:,nv+1:end)' + X = [B(:, 1:nv)' + [eqn.M_, eqn.alpha * eqn.G_'; ... + eqn.alpha * eqn.G_, sparse(np, np)] \ B(:, nv + 1:end)' ]; end @@ -81,28 +81,27 @@ case 'T' switch opB - %implement solve E'*X=B + % implement solve E'*X=B case 'N' - X = [B(1:nv,:); - [eqn.M_',eqn.alpha*eqn.G_'; ... - eqn.alpha*eqn.G_,sparse(np,np)] \ B(nv+1:end,:) + X = [B(1:nv, :) + [eqn.M_', eqn.alpha * eqn.G_'; ... + eqn.alpha * eqn.G_, sparse(np, np)] \ B(nv + 1:end, :) ]; - %implement solve A_'*X=B' + % implement solve A_'*X=B' case 'T' - X = [B(:,1:nv)'; - [eqn.M_',eqn.alpha*eqn.G_'; ... - eqn.alpha*eqn.G_,sparse(np,np)] \ B(:,nv+1:end)' + X = [B(:, 1:nv)' + [eqn.M_', eqn.alpha * eqn.G_'; ... + eqn.alpha * eqn.G_, sparse(np, np)] \ B(:, nv + 1:end)' ]; end end -elseif (opB=='N' && (size(B,1)==(2*nv))) || (opB=='T' && (size(B,2)==(2*nv))) - error('MESS:error_usage','sol_E_dae_2_so is only coded for shift parameter computation'); +elseif (opB == 'N' && (size(B, 1) == (2 * nv))) || (opB == 'T' && (size(B, 2) == (2 * nv))) + mess_err(opts, 'error_usage', 'sol_E_dae_2_so is only coded for shift parameter computation'); else - error('MESS:error_arguments', 'B has wrong number of cols'); + mess_err(opts, 'error_arguments', 'B has wrong number of cols'); end - end diff --git a/usfs/default/eval_matrix_functions_default.m b/usfs/default/eval_matrix_functions_default.m index f695bce..d28f97f 100644 --- a/usfs/default/eval_matrix_functions_default.m +++ b/usfs/default/eval_matrix_functions_default.m @@ -1,24 +1,27 @@ -function [ eqn, opts, oper ] = eval_matrix_functions_default( eqn, opts, oper, t ) +function [eqn, opts, oper] = eval_matrix_functions_default(eqn, opts, oper, t, sign_dt_E) %% function eval_matrix_functions_default updates the matrices in eqn % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % if eqn.LTV + if nargin < 5 + sign_dt_E = 1; + end %% if eqn.haveE eqn.E_ = eqn.E_time(t); - eqn.A_ = eqn.A_time(t) + eqn.dt_E_time(t); + eqn.A_ = eqn.A_time(t) + sign_dt_E * eqn.dt_E_time(t); else eqn.A_ = eqn.A_time(t); end eqn.B = eqn.B_time(t); eqn.C = eqn.C_time(t); end -end \ No newline at end of file +end diff --git a/usfs/default/init_default.m b/usfs/default/init_default.m index 33bb0e1..f5d02c0 100644 --- a/usfs/default/init_default.m +++ b/usfs/default/init_default.m @@ -1,6 +1,6 @@ function [result, eqn, opts, oper] = init_default(eqn, opts, oper, flag1, flag2) - -% function [result, eqn, opts, oper] = init_default(eqn, opts, oper, flag1, flag2) +% function [result, eqn, opts, oper] = ... +% init_default(eqn, opts, oper, flag1, flag2) % % The function returns true or false if data for A_ and E_ % resp. flag1 and flag2 are available and corrects in structure @@ -44,154 +44,164 @@ % quadratic field) % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input Parameters na = nargin; -if not(isfield(eqn, 'LTV')), eqn.LTV=0; end -if(na<3) - error('MESS:control_data','Number of input Arguments are at least 4'); +if not(isfield(eqn, 'LTV')) + eqn.LTV = false; +end +if na < 3 + mess_err(opts, 'control_data', ... + 'Number of input Arguments are at least 4'); - %result = init_default(eqn, flag1); -elseif(nargin==4) + % result = init_default(eqn, flag1); +elseif nargin == 4 switch flag1 - case {'A','a'} + case {'A', 'a'} if eqn.LTV - [eqn, result] = checkA_time(eqn,opts); + [eqn, result] = checkA_time(eqn, opts); else - [eqn, result] = checkA(eqn); + [eqn, result] = checkA(eqn, opts); end - case {'E','e'} + case {'E', 'e'} if eqn.LTV - [eqn, result] = checkE_time(eqn,opts); + [eqn, result] = checkE_time(eqn, opts); else - [eqn, result] = checkE(eqn); + [eqn, result] = checkE(eqn, opts); end - otherwise - error('MESS:control_data','flag1 has to be ''A_'' or ''E_'''); + otherwise + mess_err(opts, 'control_data', ... + 'flag1 has to be ''A_'' or ''E_'''); end - %result = init_default(eqn,flag1,flag2); -elseif(nargin==5) + % result = init_default(eqn,flag1,flag2); +elseif nargin == 5 switch flag1 - case {'A','a'} + case {'A', 'a'} if eqn.LTV - [eqn, result] = checkA_time(eqn,opts); + [eqn, result] = checkA_time(eqn, opts); else - [eqn, result] = checkA(eqn); + [eqn, result] = checkA(eqn, opts); end - switch flag2 - case {'A','a'} + switch flag2 + case {'A', 'a'} if eqn.LTV - [eqn, resultA] = checkA_time(eqn,opts); + [eqn, resultA] = checkA_time(eqn, opts); else - [eqn, resultA] = checkA(eqn); + [eqn, resultA] = checkA(eqn, opts); end result = result && resultA; - case {'E','e'} + case {'E', 'e'} if eqn.LTV - [eqn, resultE] = checkE_time(eqn,opts); + [eqn, resultE] = checkE_time(eqn, opts); else - [eqn, resultE]= checkE(eqn); + [eqn, resultE] = checkE(eqn, opts); end result = result && resultE; - otherwise - error('MESS:control_data','flag2 has to be ''A'' or ''E'''); - end - case {'E','e'} + otherwise + mess_err(opts, 'control_data', ... + 'flag2 has to be ''A'' or ''E'''); + end + case {'E', 'e'} if eqn.LTV - [eqn, result] = checkE_time(eqn,opts); + [eqn, result] = checkE_time(eqn, opts); else - [eqn, result] = checkE(eqn); + [eqn, result] = checkE(eqn, opts); end - switch flag2 - case {'A','a'} + switch flag2 + case {'A', 'a'} if eqn.LTV - [eqn, resultA] = checkA_time(eqn,opts); + [eqn, resultA] = checkA_time(eqn, opts); else - [eqn, resultA] = checkA(eqn); + [eqn, resultA] = checkA(eqn, opts); end result = result && resultA; - case {'E','e'} + case {'E', 'e'} if eqn.LTV - [eqn,resultE] = checkE_time(eqn,opts); + [eqn, resultE] = checkE_time(eqn, opts); else - [eqn, resultE]= checkE(eqn); + [eqn, resultE] = checkE(eqn, opts); end result = result && resultE; - otherwise - error('MESS:control_data','flag2 has to be ''A'' or ''E'''); - end - otherwise - error('MESS:control_data','flag1 has to be ''A'' or ''E'''); + otherwise + mess_err(opts, 'control_data', ... + 'flag2 has to be ''A'' or ''E'''); + end + otherwise + mess_err(opts, 'control_data', ... + 'flag1 has to be ''A'' or ''E'''); end end end -%checkdata for A_ -function [eqn, result] = checkA(eqn) -result = isfield(eqn,'A_'); -if(result) +% checkdata for A_ +function [eqn, result] = checkA(eqn, ~) +result = isfield(eqn, 'A_'); +if result result = isnumeric(eqn.A_); end -result=result&&(size(eqn.A_,1)==size(eqn.A_,2)); +result = result && (size(eqn.A_, 1) == size(eqn.A_, 2)); end -%checkdata for E_ -function [eqn, result] = checkE(eqn) -if not(isfield(eqn, 'haveE')), eqn.haveE = 0; end +% checkdata for E_ +function [eqn, result] = checkE(eqn, opts) +if not(isfield(eqn, 'haveE')) + eqn.haveE = false; +end if not(eqn.haveE) if isfield(eqn, 'E_') - error('MESS:equation_data', ['Detected eqn.E_ where eqn.haveE ' ... - 'is 0. You need to set haveE=1 or ' ... - 'delete E_.']); + mess_err(opts, 'equation_data', ... + ['Detected eqn.E_ where eqn.haveE ' ... + 'is 0. You need to set haveE = true or delete E_.']); else - result = 1; + result = true; end else - result = isfield(eqn,'E_'); - if(result) + result = isfield(eqn, 'E_'); + if result result = isnumeric(eqn.E_); end - result=result&&(size(eqn.E_,1)==size(eqn.E_,2)); + result = result && (size(eqn.E_, 1) == size(eqn.E_, 2)); end end -%checkdata for A_time -function [eqn, result] = checkA_time(eqn,opts) -result = isa(eqn.A_time,'function_handle'); +% checkdata for A_time +function [eqn, result] = checkA_time(eqn, opts) +result = isa(eqn.A_time, 'function_handle'); A = eqn.A_time(opts.t0); -if(result) +if result result = isnumeric(A); end -result=result&&(size(A,1)==size(A,2)); +result = result && (size(A, 1) == size(A, 2)); end -%checkdata for E_time -function [eqn, result] = checkE_time(eqn,opts) -if not(isfield(eqn, 'haveE')), eqn.haveE = 0; end +% checkdata for E_time +function [eqn, result] = checkE_time(eqn, opts) +if not(isfield(eqn, 'haveE')) + eqn.haveE = false; +end if not(eqn.haveE) if isfield(eqn, 'E_time') - error('MESS:equation_data', ['Detected eqn.E_time where eqn.haveE ' ... - 'is 0. You need to set haveE=1 or ' ... - 'delete E_']); + mess_err(opts, 'equation_data', ... + ['Detected eqn.E_time where eqn.haveE ' ... + 'is 0. You need to set haveE = true or delete E_']); else - result = 1; + result = true; end else - result = isa(eqn.E_time,'function_handle') ... - && isa(eqn.dt_E_time,'function_handle'); + result = isa(eqn.E_time, 'function_handle') && ... + isa(eqn.dt_E_time, 'function_handle'); E = eqn.E_time(opts.t0); - if(result) + if result result = isnumeric(E); end - result=result&&(size(E,1)==size(E,2)); + result = result && (size(E, 1) == size(E, 2)); end end diff --git a/usfs/default/init_res_default.m b/usfs/default/init_res_default.m index 53c88b7..0ef8fed 100644 --- a/usfs/default/init_res_default.m +++ b/usfs/default/init_res_default.m @@ -1,6 +1,7 @@ -function [ RHS, res0, eqn, opts, oper ] = init_res_default( eqn, opts, oper, RHS) -%% function init_res initializes the low rank residual W and res0 -% function [ RHS, res0, eqn, opts, oper ] = init_res_default( eqn, opts, oper, RHS) +function [W, res0, eqn, opts, oper] = init_res_default(eqn, opts, oper, W, T) +%% function init_res initializes the low-rank residual W and res0 +% function [ W, res0, eqn, opts, oper ] = ... +% init_res_default( eqn, opts, oper, W, T) % % This function returns the initial residual factor W and its associated norm res0. % @@ -9,41 +10,45 @@ % eqn structure containing data for G or B or C % opts structure containing parameters for the algorithm % oper struct contains function handles for operation with A and E -% RHS right hand side matrix +% W right hand side matrix % % Outputs: % -% RHS matrix given by ADI to compute residuum +% W matrix given by ADI to compute residuum % res0 initial residuum norm % % This function does not use other default functions. % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % %% check input data -if (not(isnumeric(RHS))) || (not(ismatrix(RHS))) - error('MESS:error_arguments','RHS has to ba a matrix'); +if (not(isnumeric(W))) || (not(ismatrix(W))) + mess_err(opts, 'error_arguments', 'W has to ba a matrix'); end %% compute res0 +if not(exist('T', 'var')) && opts.LDL_T + % this means we only use init_res for potential projection + return +end if isfield(opts, 'nm') && isfield(opts.nm, 'res0') res0 = opts.nm.res0; else if opts.LDL_T if opts.norm == 2 - res0 = max(abs(eig(RHS' * RHS * diag(eqn.S_diag)))); + res0 = max(abs(eig(W' * W * T))); else - res0 = norm(eig(RHS' * RHS * diag(eqn.S_diag)), 'fro'); + res0 = norm(eig(W' * W * T), 'fro'); end else - res0 = norm(RHS' * RHS, opts.norm); + res0 = norm(W' * W, opts.norm); end end -end +end diff --git a/usfs/default/mess_usfs_default.m b/usfs/default/mess_usfs_default.m index 738de18..1a9c609 100644 --- a/usfs/default/mess_usfs_default.m +++ b/usfs/default/mess_usfs_default.m @@ -22,7 +22,7 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % diff --git a/usfs/default/mul_A_default.m b/usfs/default/mul_A_default.m index 43ff78c..4f8d92e 100644 --- a/usfs/default/mul_A_default.m +++ b/usfs/default/mul_A_default.m @@ -1,4 +1,4 @@ -function C=mul_A_default(eqn, opts, opA, B, opB) +function C = mul_A_default(eqn, opts, opA, B, opB) % function C=mul_A_default(eqn, opts, opA, B, opB) % % This function returns C = A_*B, where matrix A_ given by @@ -27,36 +27,34 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - - %% check input parameters -if (not(ischar(opA)) || not(ischar(opB))) - error('MESS:error_arguments', 'opA or opB is not a char'); +if not(ischar(opA)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opA or opB is not a char'); end -opA = upper(opA); +opA = upper(opA); opB = upper(opB); -if not( opA == 'N' || opA == 'T' ) - error('MESS:error_arguments', 'opA is not ''N'' or ''T'''); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if not( opB == 'N' || opB == 'T' ) - error('MESS:error_arguments', 'opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if not(isnumeric(B)) || not(ismatrix(B)) - error('MESS:error_arguments', 'B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure if not(isfield(eqn, 'A_')) - error('MESS:error_arguments', 'field eqn.A_ is not defined'); + mess_err(opts, 'error_arguments', 'field eqn.A_ is not defined'); end rowA = size_default(eqn, opts); @@ -65,47 +63,46 @@ %% perform multiplication switch opA - case 'N' - switch opB - - %implement operation A_ * B - case 'N' - if not(colA == size(B,1)) - error('MESS:error_arguments', ... - 'number of columns of A_ differs with number of rows of B'); - end - C = eqn.A_ * B; - - %implement operation A_ * B' - case 'T' - if not(colA == size(B,2)) - error('MESS:error_arguments', ... - 'number of columns of A_ differs with number of columns of B'); + case 'N' + switch opB + + % implement operation A_ * B + case 'N' + if not(colA == size(B, 1)) + mess_err(opts, 'error_arguments', ... + 'number of columns of A_ differs with number of rows of B'); + end + C = eqn.A_ * B; + + % implement operation A_ * B' + case 'T' + if not(colA == size(B, 2)) + mess_err(opts, 'error_arguments', ... + 'number of columns of A_ differs with number of columns of B'); + end + C = eqn.A_ * B'; end - C = eqn.A_ * B'; - end - case 'T' - switch opB - - %implement operation A_' * B - case 'N' - if not(rowA == size(B,1)) - error('MESS:error_arguments', ... - 'number of rows of A_ differs with number rows of B'); - end - C = eqn.A_' * B; - - %implement operatio A_' * B' - case 'T' - if not(rowA == size(B,2)) - error('MESS:error_arguments', ... - 'number of rows of A_ differs with number of columns of B'); + case 'T' + switch opB + + % implement operation A_' * B + case 'N' + if not(rowA == size(B, 1)) + mess_err(opts, 'error_arguments', ... + 'number of rows of A_ differs with number rows of B'); + end + C = eqn.A_' * B; + + % implement operatio A_' * B' + case 'T' + if not(rowA == size(B, 2)) + mess_err(opts, 'error_arguments', ... + 'number of rows of A_ differs with number of columns of B'); + end + C = eqn.A_' * B'; end - C = eqn.A_' * B'; - end end end - diff --git a/usfs/default/mul_ApE_default.m b/usfs/default/mul_ApE_default.m index 6d6c08d..089cc5c 100644 --- a/usfs/default/mul_ApE_default.m +++ b/usfs/default/mul_ApE_default.m @@ -1,4 +1,4 @@ -function C=mul_ApE_default(eqn, opts,opA,p,opE,B,opB) +function C = mul_ApE_default(eqn, opts, opA, p, opE, B, opB) % function C=mul_ApE_default(eqn, opts,opA,p,opE,B,opB) % % This function returns C = (A_+p*E_)*B, where matrices A_ and E_ @@ -30,244 +30,242 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - - %% check input parameters -if (not(ischar(opA)) || not(ischar(opB)) || not(ischar(opE))) - error('MESS:error_arguments', 'opA, opB or opE is not a char'); +if not(ischar(opA)) || not(ischar(opB)) || not(ischar(opE)) + mess_err(opts, 'error_arguments', 'opA, opB or opE is not a char'); end opA = upper(opA); opB = upper(opB); opE = upper(opE); -if not( opA=='N' || opA=='T' ) - error('MESS:error_arguments', 'opA is not ''N'' or ''T'''); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if not( opB=='N' || opB=='T' ) - error('MESS:error_arguments', 'opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end -if not( opE=='N' || opE=='T' ) - error('MESS:error_arguments', 'opE is not ''N'' or ''T'''); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end if not(isnumeric(p)) || not(length(p) == 1) - error('MESS:error_arguments', 'p is not numeric'); + mess_err(opts, 'error_arguments', 'p is not numeric'); end -if not(isfield(eqn, 'haveE')), eqn.haveE = 0; end +if not(isfield(eqn, 'haveE')) + eqn.haveE = false; +end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -if (eqn.haveE == 1) - if not(isfield(eqn,'E_')) || not(isfield(eqn,'A_')) - error('MESS:error_arguments', 'field eqn.E_ or eqn.A_ is not defined'); +if eqn.haveE + if not(isfield(eqn, 'E_')) || not(isfield(eqn, 'A_')) + mess_err(opts, 'error_arguments', 'field eqn.E_ or eqn.A_ is not defined'); end else - if not(isfield(eqn,'A_')) - error('MESS:error_arguments', 'field eqn.A_ is not defined'); + if not(isfield(eqn, 'A_')) + mess_err(opts, 'error_arguments', 'field eqn.A_ is not defined'); end end [rowA, colA] = size(eqn.A_); -if eqn.haveE == 1 - %% perform multiplication operations for E_ ~= Identity +if eqn.haveE + %% perform multiplication operations for not(E_ == Identity) switch opA - case 'N' - switch opE + case 'N' + switch opE - case 'N' + case 'N' - switch opB + switch opB - %implement multiplication (A_ + p * E_) * B = C - case 'N' + % implement multiplication (A_ + p * E_) * B = C + case 'N' - if not(colA == size(B,1)) - error('MESS:error_arguments', ... - ['number of columns of A_ differs with number ' ... - 'of rows of B']); - end + if not(colA == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['number of columns of A_ differs with number ' ... + 'of rows of B']); + end - C = (eqn.A_ + p * eqn.E_) * B; + C = (eqn.A_ + p * eqn.E_) * B; - %implement multiplication (A_ + p * E_) * B' = C - case 'T' + % implement multiplication (A_ + p * E_) * B' = C + case 'T' - if not(colA == size(B,2)) - error('MESS:error_arguments', ... - ['number of columns of A_ differs with number ' ... - 'of columns of B']); - end + if not(colA == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of columns of A_ differs with number ' ... + 'of columns of B']); + end - C = (eqn.A_ + p * eqn.E_) * B'; + C = (eqn.A_ + p * eqn.E_) * B'; - end + end - case 'T' + case 'T' - switch opB + switch opB - %implement multiplication (A_ + p * E_') * B = C - case 'N' + % implement multiplication (A_ + p * E_') * B = C + case 'N' - if not(colA == size(B,1)) - error('MESS:error_arguments', ... - ['number of columns of A_ differs with number ' ... - 'of rows of B']); - end + if not(colA == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['number of columns of A_ differs with number ' ... + 'of rows of B']); + end - C = (eqn.A_ + p * eqn.E_') * B; + C = (eqn.A_ + p * eqn.E_') * B; - %implement multiplication (A_ + p * E_') * B' = C - case 'T' + % implement multiplication (A_ + p * E_') * B' = C + case 'T' - if not(colA ==size(B,2) ) - error('MESS:error_arguments', ... - ['number of columns of A_ differs with number ' ... - 'of columns of B']); - end + if not(colA == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of columns of A_ differs with number ' ... + 'of columns of B']); + end - C = (eqn.A_ + p * eqn.E_') * B'; + C = (eqn.A_ + p * eqn.E_') * B'; + + end end - end + case 'T' + switch opE - case 'T' - switch opE + case 'N' - case 'N' + switch opB - switch opB + % implement multiplication (A_' + p * E_) * B = C + case 'N' - %implement multiplication (A_' + p * E_) * B = C - case 'N' + if not(rowA == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['number of rows of A_ differs with number ' ... + 'of rows of B']); + end - if not(rowA == size(B,1)) - error('MESS:error_arguments', ... - ['number of rows of A_ differs with number ' ... - 'of rows of B']); - end + C = (eqn.A_' + p * eqn.E_) * B; - C = (eqn.A_' + p * eqn.E_) * B; + % implement multiplication (A_' + p * E_) * B' = C + case 'T' - %implement multiplication (A_' + p * E_) * B' = C - case 'T' + if not(rowA == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of rows of A_ differs with number ' ... + 'of columns of B']); + end - if not(rowA == size(B,2)) - error('MESS:error_arguments', ... - ['number of rows of A_ differs with number ' ... - 'of columns of B']); - end + C = (eqn.A_' + p * eqn.E_) * B'; - C = (eqn.A_' + p * eqn.E_) * B'; + end - end + case 'T' - case 'T' + switch opB - switch opB + % implement multiplication (A_' + p * E_') * B = C + case 'N' - %implement multiplication (A_' + p * E_') * B = C - case 'N' + if not(rowA == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['number of rows of A_ differs with number ' ... + 'of rows of B']); + end - if not(rowA == size(B,1)) - error('MESS:error_arguments', ... - ['number of rows of A_ differs with number ' ... - 'of rows of B']); - end + C = (eqn.A_' + p * eqn.E_') * B; - C = (eqn.A_' + p * eqn.E_') * B; + % implement multiplication (A_' + p * E_') * B' = C + case 'T' - %implement multiplication (A_' + p * E_') * B' = C - case 'T' + if not(rowA == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of rows of A_ differs with number ' ... + 'of columns of B']); + end - if not(rowA == size(B,2)) - error('MESS:error_arguments', ... - ['number of rows of A_ differs with number ' ... - 'of columns of B']); - end + C = (eqn.A_' + p * eqn.E_') * B'; - C = (eqn.A_' + p * eqn.E_') * B'; + end end - - end end -elseif(eqn.haveE==0) +elseif not(eqn.haveE) %% perform multiplication operations for E_ = Identity switch opA - case 'N' + case 'N' - switch opB + switch opB - %implement multiplication (A_ + p * E_) * B = C - case 'N' + % implement multiplication (A_ + p * E_) * B = C + case 'N' - if not(colA == size(B,1)) - error('MESS:error_arguments', ... - ['number of columns of A_ differs with number of rows ' ... - 'of B']); - end + if not(colA == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['number of columns of A_ differs with number of rows ' ... + 'of B']); + end - C = mul_A_default(eqn, opts, 'N', B, 'N') + p * B; + C = mul_A_default(eqn, opts, 'N', B, 'N') + p * B; - %implement multiplication (A_ + p * E_) * B' = C - case 'T' + % implement multiplication (A_ + p * E_) * B' = C + case 'T' - if not(colA == size(B,2)) - error('MESS:error_arguments', ... - ['number of columns of A_ differs with number of ' ... - 'columns of B']); - end + if not(colA == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of columns of A_ differs with number of ' ... + 'columns of B']); + end - C = mul_A_default(eqn, opts, 'N', B, 'T') + p * B'; + C = mul_A_default(eqn, opts, 'N', B, 'T') + p * B'; - end + end - case 'T' + case 'T' - switch opB + switch opB - %implement multiplication (A_' + p * E_) * B = C - case 'N' + % implement multiplication (A_' + p * E_) * B = C + case 'N' - if not(rowA == size(B,1)) - error('MESS:error_arguments', ... - 'number of rows of A_ differs with number of rows of B'); - end + if not(rowA == size(B, 1)) + mess_err(opts, 'error_arguments', ... + 'number of rows of A_ differs with number of rows of B'); + end - C = mul_A_default(eqn, opts, 'T', B, 'N') + p * B; + C = mul_A_default(eqn, opts, 'T', B, 'N') + p * B; - %implement multiplication (A_' + p * E_) * B' = C - case 'T' + % implement multiplication (A_' + p * E_) * B' = C + case 'T' - if not(rowA == size(B,2)) - error('MESS:error_arguments', ... - ['number of rows of A_ differs with number of columns ' ... - 'of B']); - end + if not(rowA == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of rows of A_ differs with number of columns ' ... + 'of B']); + end - C = mul_A_default(eqn, opts, 'T', B, 'T') + p * B'; + C = mul_A_default(eqn, opts, 'T', B, 'T') + p * B'; - end + end end end end - - diff --git a/usfs/default/mul_ApE_post_default.m b/usfs/default/mul_ApE_post_default.m deleted file mode 100644 index 049670d..0000000 --- a/usfs/default/mul_ApE_post_default.m +++ /dev/null @@ -1,14 +0,0 @@ -function [eqn, opts, oper] = mul_ApE_post_default(eqn, opts, oper) -% we need to remove the identity added in _pre_ again. - -% -% This file is part of the M-M.E.S.S. project -% (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2021 Jens Saak, Martin Koehler, Peter Benner and others. -% All rights reserved. -% License: BSD 2-Clause License (see COPYING) -% - -if not(eqn.haveE) - eqn = fake_E_clean(eqn); -end \ No newline at end of file diff --git a/usfs/default/mul_ApE_pre_default.m b/usfs/default/mul_ApE_pre_default.m deleted file mode 100644 index 4b96c47..0000000 --- a/usfs/default/mul_ApE_pre_default.m +++ /dev/null @@ -1,15 +0,0 @@ -function [eqn, opts, oper] = mul_ApE_pre_default(eqn, opts, oper) -% to simplify matters in sol_ApE we add a field eqn.E_ holding the -% identity matrix when we do not have an E matrix already. - -% -% This file is part of the M-M.E.S.S. project -% (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2021 Jens Saak, Martin Koehler, Peter Benner and others. -% All rights reserved. -% License: BSD 2-Clause License (see COPYING) -% - -if not(eqn.haveE) - eqn = fake_E(eqn); -end \ No newline at end of file diff --git a/usfs/default/mul_E_default.m b/usfs/default/mul_E_default.m index 1135319..4d8832e 100644 --- a/usfs/default/mul_E_default.m +++ b/usfs/default/mul_E_default.m @@ -1,4 +1,4 @@ -function C=mul_E_default(eqn, opts,opE,B,opB) +function C = mul_E_default(eqn, opts, opE, B, opB) % function C=mul_E_default(eqn, opts,opE,B,opB) % @@ -30,33 +30,33 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input parameters -if (not(ischar(opE)) || not(ischar(opB))) - error('MESS:error_arguments', 'opE or opB is not a char'); +if not(ischar(opE)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opE or opB is not a char'); end -opE = upper(opE); opB = upper(opB); -if not((opE=='N' || opE=='T')) - error('MESS:error_arguments', 'opE is not ''N'' or ''T'''); +opE = upper(opE); +opB = upper(opB); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end -if not((opB=='N' || opB=='T')) - error('MESS:error_arguments', 'opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments', 'B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -if not(isfield(eqn,'E_')) - error('MESS:error_arguments', 'field eqn.E_ is not defined'); +if not(isfield(eqn, 'E_')) + mess_err(opts, 'error_arguments', 'field eqn.E_ is not defined'); end rowE = size_default(eqn, opts); @@ -70,19 +70,19 @@ % implement operation E_ * B case 'N' - if not(colE == size(B,1)) - error('MESS:error_arguments', ... - ['number of columns of E_ differs with number ' ... - 'of rows of B']); + if not(colE == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['number of columns of E_ differs with number ' ... + 'of rows of B']); end C = eqn.E_ * B; - % implement operation E_ * B' + % implement operation E_ * B' case 'T' - if not(colE == size(B,2)) - error('MESS:error_arguments', ... - ['number of columns of E_ differs with number ' ... - 'of columns of B']); + if not(colE == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of columns of E_ differs with number ' ... + 'of columns of B']); end C = eqn.E_ * B'; end @@ -92,19 +92,19 @@ % implement operation E_' * B case 'N' - if not(rowE == size(B,1)) - error('MESS:error_arguments', ... - ['number of rows of E_ differs with number ' ... - 'of rows of B']); + if not(rowE == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['number of rows of E_ differs with number ' ... + 'of rows of B']); end C = eqn.E_' * B; - % implement operation E_' * B' + % implement operation E_' * B' case 'T' - if not(rowE == size(B,2)) - error('MESS:error_arguments', ... - ['number of rows of E_ differs with number ' ... - 'of columns of B']); + if not(rowE == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of rows of E_ differs with number ' ... + 'of columns of B']); end C = eqn.E_' * B'; end diff --git a/usfs/default/mul_N_default.m b/usfs/default/mul_N_default.m index 6100bd7..d3f1b2a 100644 --- a/usfs/default/mul_N_default.m +++ b/usfs/default/mul_N_default.m @@ -1,4 +1,4 @@ -function C = mul_N_default(eqn, opts, opN, B, opB, h) %#ok +function C = mul_N_default(eqn, opts, opN, B, opB, h) % function C = mul_N_default(eqn, opts, opN, B, opB) % % This function returns C = N{h}*B, with a given Matrix N{h} and input @@ -31,14 +31,13 @@ % opts) to obtain the number of rows of matrix N in structure eqn. % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check data in eqn structure rowN = size(eqn.N_{h}, 1); @@ -50,19 +49,21 @@ case 'N' switch opB - %implement operation N*B + % implement operation N*B case 'N' - if(colN~=size(B, 1)) - error('MESS:error_arguments',['number of columns of N ' ... - 'differs with number of rows of B']); + if not(colN == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['number of columns of N differs with ' ... + 'number of rows of B']); end C = eqn.N_{h} * B; - %implement operation N*B' + % implement operation N*B' case 'T' - if(colN ~= size(B, 2)) - error('MESS:error_arguments',['number of columns of N ' ... - 'differs with number of columns of B']); + if not(colN == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of columns of N differs with ' ... + 'number of columns of B']); end C = eqn.N_{h} * B'; end @@ -70,19 +71,21 @@ case 'T' switch opB - %implement operation N'*B + % implement operation N'*B case 'N' - if(rowN ~= size(B, 1)) - error('MESS:error_arguments',['number of rows of N ' ... - 'differs with number rows of B']); + if not(rowN == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['number of rows of N differs with ' ... + 'number rows of B']); end C = eqn.N_{h}' * B; - %implement operatio N'*B' + % implement operation N'*B' case 'T' - if(rowN ~= size(B, 2)) - error('MESS:error_arguments',['number of rows of N ' ... - 'differs with number of columns of B']); + if not(rowN == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of rows of N differs with ' ... + 'number of columns of B']); end C = eqn.N_{h}' * B'; end @@ -90,4 +93,3 @@ end end - diff --git a/usfs/default/mul_N_post_default.m b/usfs/default/mul_N_post_default.m index ccb0459..982da05 100644 --- a/usfs/default/mul_N_post_default.m +++ b/usfs/default/mul_N_post_default.m @@ -18,29 +18,28 @@ % eqn.Ncount (should be 1) % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - % checks if mul_E_pre was initialized -if(not(isfield(eqn, 'Ncount'))) || not(isnumeric(eqn.Ncount)) - error('MESS:error_arguments', ['field eqn.Ncount is not defined. Did ' ... - 'you forget to run mul_E_pre?']); +if (not(isfield(eqn, 'Ncount'))) || not(isnumeric(eqn.Ncount)) + mess_err(opts, 'error_arguments', ['field eqn.Ncount is not defined. Did ' ... + 'you forget to run mul_E_pre?']); end % checks Ncount and decides output as cell or matrix if eqn.Ncount > 1 eqn.Ncount = eqn.Ncount - 1; else - if not(isfield(eqn, 'originalN'))||isempty(eqn.originalN) + if not(isfield(eqn, 'originalN')) || isempty(eqn.originalN) eqn.N_ = eqn.N_; else eqn.N_ = eqn.originalN; end end -end \ No newline at end of file +end diff --git a/usfs/default/mul_N_pre_default.m b/usfs/default/mul_N_pre_default.m index a4a4be8..193e408 100644 --- a/usfs/default/mul_N_pre_default.m +++ b/usfs/default/mul_N_pre_default.m @@ -17,16 +17,15 @@ % % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - if not(isfield(eqn, 'N_')) || isempty(eqn.N_) - warning('MESS:control_data', 'eqn.N_ is missing'); + mess_warn(opts, 'control_data', 'eqn.N_ is missing'); end % transforms matrix into a cell array @@ -36,21 +35,21 @@ rowN = size(eqn.N_, 1); colN = size(eqn.N_, 2); - if(rowN == colN) - N = cell (1, 1); - N{1} = eqn.N_; + if rowN == colN + N = cell (1, 1); + N{1} = eqn.N_; else dimN = sqrt(rowN); N = cell (1, colN); - for h = 1 : colN - N{h} = reshape(eqn.N_(:,h), dimN, dimN); + for h = 1:colN + N{h} = reshape(eqn.N_(:, h), dimN, dimN); end end - eqn.Ncount = 1; %sets flag for post_N (Input was Matrix) + eqn.Ncount = 1; % sets flag for post_N (Input was Matrix) eqn.N_ = N; -% no transformation and counts function calls + % no transformation and counts function calls else if not(isfield(eqn, 'Ncount')) eqn.Ncount = 1; @@ -59,12 +58,12 @@ end -%check if N{h} is quadratic +% check if N{h} is quadratic k = length(eqn.N_); -for h = 1 : k +for h = 1:k if not(size(eqn.N_{k}, 1) == size(eqn.N_{k}, 2)) - error('MESS:error_arguments', ['number of columns of a N{h} ' ... - 'differs with number of rows of N{h}']); + mess_err(opts, 'error_arguments', ['number of columns of a N{h} ' ... + 'differs with number of rows of N{h}']); end end diff --git a/usfs/default/private/fake_E_clean.m b/usfs/default/private/fake_E_clean.m deleted file mode 100644 index 0f589c2..0000000 --- a/usfs/default/private/fake_E_clean.m +++ /dev/null @@ -1,15 +0,0 @@ -function eqn = fake_E_clean(eqn) - -% -% This file is part of the M-M.E.S.S. project -% (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. -% All rights reserved. -% License: BSD 2-Clause License (see COPYING) -% - -if eqn.Ecount > 1 - eqn.Ecount = eqn.Ecount -1; -else - eqn = rmfield(eqn,{'E_','Ecount'}); -end \ No newline at end of file diff --git a/usfs/default/private/fake_E_clean_default.m b/usfs/default/private/fake_E_clean_default.m new file mode 100644 index 0000000..0a6bc88 --- /dev/null +++ b/usfs/default/private/fake_E_clean_default.m @@ -0,0 +1,15 @@ +function eqn = fake_E_clean_default(eqn) + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +if eqn.Ecount > 1 + eqn.Ecount = eqn.Ecount - 1; +else + eqn = rmfield(eqn, {'E_', 'Ecount'}); +end diff --git a/usfs/default/private/fake_E.m b/usfs/default/private/fake_E_default.m similarity index 53% rename from usfs/default/private/fake_E.m rename to usfs/default/private/fake_E_default.m index c54dba7..a03ce01 100644 --- a/usfs/default/private/fake_E.m +++ b/usfs/default/private/fake_E_default.m @@ -1,14 +1,14 @@ -function eqn = fake_E(eqn) +function eqn = fake_E_default(eqn) % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % -if not(isfield(eqn,'Ecount')) +if not(isfield(eqn, 'Ecount')) eqn.Ecount = 1; eqn.E_ = speye(size(eqn.A_)); else diff --git a/usfs/default/size_default.m b/usfs/default/size_default.m index aa99194..a40a27c 100644 --- a/usfs/default/size_default.m +++ b/usfs/default/size_default.m @@ -1,4 +1,4 @@ -function n = size_default(eqn, opts, oper)%#ok +function n = size_default(eqn, opts, oper) %#ok % function n = size_default(eqn, opts, oper) % % This function returns the number of rows of matrix A_ in structure eqn. @@ -21,15 +21,14 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % -if not(isfield(eqn,'A_')) - error('MESS:error_arguments', 'field eqn.A_ is not defined'); +if not(isfield(eqn, 'A_')) + mess_err(opts, 'error_arguments', 'field eqn.A_ is not defined'); end n = size(eqn.A_, 1); end - diff --git a/usfs/default/sol_A_default.m b/usfs/default/sol_A_default.m index dd3266c..10c93c1 100644 --- a/usfs/default/sol_A_default.m +++ b/usfs/default/sol_A_default.m @@ -1,4 +1,4 @@ -function X=sol_A_default(eqn, opts,opA,B,opB) +function X = sol_A_default(eqn, opts, opA, B, opB) % function X=sol_A_default(eqn, opts,opA,B,opB) % % This function returns X = A_\B, where matrix A_ given by @@ -28,35 +28,33 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - - %% check input parameters if not(ischar(opA)) || not(ischar(opB)) - error('MESS:error_arguments', 'opA or opB is not a char'); + mess_err(opts, 'error_arguments', 'opA or opB is not a char'); end opA = upper(opA); opB = upper(opB); -if not( opA=='N' || opA=='T' ) - error('MESS:error_arguments', 'opA is not ''N'' or ''T'''); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if not( opB=='N' || opB=='T' ) - error('MESS:error_arguments', 'opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end -if not( isnumeric(B)) || not(ismatrix(B)) - error('MESS:error_arguments', 'B has to ba a matrix'); +if not(isnumeric(B)) || not(ismatrix(B)) + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -if not(isfield(eqn,'A_')) - error('MESS:error_arguments', 'field eqn.A_ is not defined'); +if not(isfield(eqn, 'A_')) + mess_err(opts, 'error_arguments', 'field eqn.A_ is not defined'); end rowA = size_default(eqn, opts); @@ -65,47 +63,46 @@ %% perform solve operations switch opA - case 'N' - switch opB - - %implement solve A_ * X = B - case 'N' - if not(rowA == size(B,1)) - error('MESS:error_arguments', ... - 'number of rows of A_ differs with number of rows of B'); + case 'N' + switch opB + + % implement solve A_ * X = B + case 'N' + if not(rowA == size(B, 1)) + mess_err(opts, 'error_arguments', ... + 'number of rows of A_ differs with number of rows of B'); + end + X = eqn.A_ \ B; + + % implement solve A_ * X = B' + case 'T' + if not(rowA == size(B, 2)) + mess_err(opts, 'error_arguments', ... + 'number of rows of A_ differs with number of columns of B'); + end + X = eqn.A_ \ B'; end - X = eqn.A_ \ B; - %implement solve A_ * X = B' - case 'T' - if not(rowA == size(B,2)) - error('MESS:error_arguments', ... - 'number of rows of A_ differs with number of columns of B'); + case 'T' + switch opB + + % implement solve A_' * X = B + case 'N' + if not(colA == size(B, 1)) + mess_err(opts, 'error_arguments', ... + 'number of columns of A_ differs with number of rows of B'); + end + X = eqn.A_' \ B; + + % implement solve A_' * X = B' + case 'T' + if not(colA == size(B, 2)) + mess_err(opts, 'error_arguments', ['number of columns of A_ ' ... + 'differs with number of columns of B']); + end + X = eqn.A_' \ B'; end - X = eqn.A_ \ B'; - end - - case 'T' - switch opB - - %implement solve A_' * X = B - case 'N' - if not(colA == size(B,1)) - error('MESS:error_arguments', ... - 'number of columns of A_ differs with number of rows of B'); - end - X = eqn.A_' \ B; - - %implement solve A_' * X = B' - case 'T' - if not(colA == size(B,2)) - error('MESS:error_arguments', ['number of columns of A_ ' ... - 'differs with number of columns of B']); - end - X = eqn.A_' \ B'; - end end end - diff --git a/usfs/default/sol_ApE_default.m b/usfs/default/sol_ApE_default.m index b570577..5e372c3 100644 --- a/usfs/default/sol_ApE_default.m +++ b/usfs/default/sol_ApE_default.m @@ -1,4 +1,4 @@ -function X=sol_ApE_default(eqn, opts,opA,p,opE,C,opC)%#ok +function X = sol_ApE_default(eqn, opts, opA, p, opE, C, opC) % function X=sol_ApE_default(eqn, opts,opA,p,opE,C,opC) % % This function returns X = (A_ + p*E_)\C, where matrices A_ and E_ @@ -30,58 +30,56 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - - %% check input parameters if not(ischar(opA)) || not(ischar(opE)) || not(ischar(opC)) - error('MESS:error_arguments', 'opA, opE or opC is not a char'); + mess_err(opts, 'error_arguments', 'opA, opE or opC is not a char'); end opA = upper(opA); opE = upper(opE); opC = upper(opC); -if not((opA=='N' || opA=='T')) - error('MESS:error_arguments', 'opA is not ''N'' or ''T'''); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if not((opE=='N' || opE=='T')) - error('MESS:error_arguments', 'opE is not ''N'' or ''T'''); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end -if not((opC=='N' || opC=='T')) - error('MESS:error_arguments', 'opC is not ''N'' or ''T'''); +if not(opC == 'N' || opC == 'T') + mess_err(opts, 'error_arguments', 'opC is not ''N'' or ''T'''); end if not(isnumeric(p)) || not(length(p) == 1) - error('MESS:error_arguments', 'p is not numeric'); + mess_err(opts, 'error_arguments', 'p is not numeric'); end if not(isnumeric(C)) || not(ismatrix(C)) - error('MESS:error_arguments', 'C has to ba a matrix'); + mess_err(opts, 'error_arguments', 'C has to ba a matrix'); end %% check data in eqn structure -if not(isfield(eqn, 'haveE')), eqn.haveE = 0; end -if eqn.haveE ==1 - if not(isfield(eqn,'E_')) || not(isfield(eqn,'A_')) - error('MESS:error_arguments', 'field eqn.E_ or eqn.A_ is not defined'); +if not(isfield(eqn, 'haveE')) + eqn.haveE = false; +end +if eqn.haveE + if not(isfield(eqn, 'E_')) || not(isfield(eqn, 'A_')) + mess_err(opts, 'error_arguments', 'field eqn.E_ or eqn.A_ is not defined'); end else - if not(isfield(eqn,'A_')) - error('MESS:error_arguments', 'field eqn.A_ is not defined'); + if not(isfield(eqn, 'A_')) + mess_err(opts, 'error_arguments', 'field eqn.A_ is not defined'); end end [rowA, colA] = size(eqn.A_); - - switch opA case 'N' @@ -92,25 +90,25 @@ switch opC - %implement solve (A_+p*E_)*X=C + % implement solve (A_+p*E_)*X=C case 'N' if not(rowA == size(C, 1)) - error('MESS:error_arguments',['number ' ... - 'of rows of A differs ' ... - 'with number of rows of C']); + mess_err(opts, 'error_arguments', ['number ' ... + 'of rows of A differs ' ... + 'with number of rows of C']); end X = (eqn.A_ + p * eqn.E_) \ C; - %implement solve (A_ + p * E_) * X = C' + % implement solve (A_ + p * E_) * X = C' case 'T' - if not(rowA ==size(C, 2)) - error('MESS:error_arguments',['number ' ... - 'of rows of A differs ' ... - 'with number of ' ... - 'columns of C']); + if not(rowA == size(C, 2)) + mess_err(opts, 'error_arguments', ['number ' ... + 'of rows of A differs ' ... + 'with number of ' ... + 'columns of C']); end X = (eqn.A_ + p * eqn.E_) \ C'; @@ -121,25 +119,25 @@ switch opC - %implement solve (A_ + p * E_') * X = C + % implement solve (A_ + p * E_') * X = C case 'N' - if not(rowA == size(C,1)) - error('MESS:error_arguments',['number ' ... - 'of rows of A differs ' ... - 'with number of rows of C']); + if not(rowA == size(C, 1)) + mess_err(opts, 'error_arguments', ['number ' ... + 'of rows of A differs ' ... + 'with number of rows of C']); end X = (eqn.A_ + p * eqn.E_') \ C; - %implement solve (A_ + p * E_') * X = C' + % implement solve (A_ + p * E_') * X = C' case 'T' if not(rowA == size(C, 2)) - error('MESS:error_arguments',['number ' ... - 'of rows of A differs ' ... - 'with number of ' ... - 'columns of C']); + mess_err(opts, 'error_arguments', ['number ' ... + 'of rows of A differs ' ... + 'with number of ' ... + 'columns of C']); end X = (eqn.A_ + p * eqn.E_') \ C'; @@ -156,26 +154,26 @@ switch opC - %implement solve (A_' + p * E_) * X = C + % implement solve (A_' + p * E_) * X = C case 'N' - if not(colA == size(C,1)) - error('MESS:error_arguments',['number ' ... - 'of columns of A ' ... - 'differs with number ' ... - 'of rows of C']); + if not(colA == size(C, 1)) + mess_err(opts, 'error_arguments', ['number ' ... + 'of columns of A ' ... + 'differs with number ' ... + 'of rows of C']); end X = (eqn.A_' + p * eqn.E_) \ C; - %implement solve (A_' + p * E_) * X = C' + % implement solve (A_' + p * E_) * X = C' case 'T' if not(colA == size(C, 2)) - error('MESS:error_arguments',['number ' ... - 'of columns of A ' ... - 'differs with number ' ... - 'of columns of C']); + mess_err(opts, 'error_arguments', ['number ' ... + 'of columns of A ' ... + 'differs with number ' ... + 'of columns of C']); end X = (eqn.A_' + p * eqn.E_) \ C'; @@ -186,26 +184,26 @@ switch opC - %implement solve (A_' + p * E_') * X = C + % implement solve (A_' + p * E_') * X = C case 'N' if not(colA == size(C, 1)) - error('MESS:error_arguments',['number ' ... - 'of columns of A ' ... - 'differs with number ' ... - 'of rows of C']); + mess_err(opts, 'error_arguments', ['number ' ... + 'of columns of A ' ... + 'differs with number ' ... + 'of rows of C']); end X = (eqn.A_' + p * eqn.E_') \ C; - %implement solve (A_' + p * E_') * X = C' + % implement solve (A_' + p * E_') * X = C' case 'T' - if not(colA == size(C,2)) - error('MESS:error_arguments',['number ' ... - 'of columns of A ' ... - 'differs with number ' ... - 'of columns of C']); + if not(colA == size(C, 2)) + mess_err(opts, 'error_arguments', ['number ' ... + 'of columns of A ' ... + 'differs with number ' ... + 'of columns of C']); end X = (eqn.A_' + p * eqn.E_') \ C'; diff --git a/usfs/default/sol_ApE_post_default.m b/usfs/default/sol_ApE_post_default.m index bc40db4..3d58bb3 100644 --- a/usfs/default/sol_ApE_post_default.m +++ b/usfs/default/sol_ApE_post_default.m @@ -4,11 +4,11 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % if not(eqn.haveE) - eqn = fake_E_clean(eqn); -end \ No newline at end of file + eqn = fake_E_clean_default(eqn); +end diff --git a/usfs/default/sol_ApE_pre_default.m b/usfs/default/sol_ApE_pre_default.m index afe2b0f..f5ddf7f 100644 --- a/usfs/default/sol_ApE_pre_default.m +++ b/usfs/default/sol_ApE_pre_default.m @@ -5,11 +5,11 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % if not(eqn.haveE) - eqn = fake_E(eqn); -end \ No newline at end of file + eqn = fake_E_default(eqn); +end diff --git a/usfs/default/sol_E_default.m b/usfs/default/sol_E_default.m index 193d36d..4659f7d 100644 --- a/usfs/default/sol_E_default.m +++ b/usfs/default/sol_E_default.m @@ -1,4 +1,4 @@ -function X=sol_E_default(eqn, opts,opE,B,opB) +function X = sol_E_default(eqn, opts, opE, B, opB) % function X=sol_E_default(eqn, opts,opE,B,opB) % % This function returns X = E_\B, where matrix E_ given by @@ -29,33 +29,32 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - - %% check input parameters if not(ischar(opE)) || not(ischar(opB)) - error('MESS:error_arguments', 'opE or opB is not a char'); + mess_err(opts, 'error_arguments', 'opE or opB is not a char'); end -opE = upper(opE); opB = upper(opB); -if not( opE=='N' || opE=='T' ) - error('MESS:error_arguments', 'opE is not ''N'' or ''T'''); +opE = upper(opE); +opB = upper(opB); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end -if not( opB=='N' || opB=='T' ) - error('MESS:error_arguments', 'opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if not(isnumeric(B)) || not(ismatrix(B)) - error('MESS:error_arguments', 'B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -if not(isfield(eqn,'E_')) - error('MESS:error_arguments', 'field eqn.E_ is not defined'); +if not(isfield(eqn, 'E_')) + mess_err(opts, 'error_arguments', 'field eqn.E_ is not defined'); end rowE = size_default(eqn, opts); @@ -70,18 +69,18 @@ % implement solve E_ * X = B case 'N' if not(rowE == size(B, 1)) - error('MESS:error_arguments', ... - ['number of rows of E_ differs with number ' ... - 'of rows of B']); + mess_err(opts, 'error_arguments', ... + ['number of rows of E_ differs with number ' ... + 'of rows of B']); end X = eqn.E_ \ B; - % implement solve E_ * X = B' + % implement solve E_ * X = B' case 'T' if not(rowE == size(B, 2)) - error('MESS:error_arguments', ... - ['number of rows of E_ differs with number ' ... - 'of columns of B']); + mess_err(opts, 'error_arguments', ... + ['number of rows of E_ differs with number ' ... + 'of columns of B']); end X = eqn.E_ \ B'; end @@ -92,18 +91,18 @@ % implement solve E_' * X = B case 'N' if not(colE == size(B, 1)) - error('MESS:error_arguments', ... - ['number of columns of E_ differs with number ' ... - 'of rows of B']); + mess_err(opts, 'error_arguments', ... + ['number of columns of E_ differs with number ' ... + 'of rows of B']); end X = eqn.E_' \ B; - % implement solve E_' * X = B' + % implement solve E_' * X = B' case 'T' - if not(colE ==size(B, 2)) - error('MESS:error_arguments',['number of columns ' ... - 'of E_ differs with number ' ... - 'of columns of B']); + if not(colE == size(B, 2)) + mess_err(opts, 'error_arguments', ['number of columns ' ... + 'of E_ differs with number ' ... + 'of columns of B']); end X = eqn.E_' \ B'; end @@ -111,4 +110,3 @@ end end - diff --git a/usfs/default_iter/init_default_iter.m b/usfs/default_iter/init_default_iter.m new file mode 100644 index 0000000..deeca9e --- /dev/null +++ b/usfs/default_iter/init_default_iter.m @@ -0,0 +1,326 @@ +function [result, eqn, opts, oper] = init_default_iter(eqn, opts, oper, flag1, flag2) +% function [result, eqn, opts, oper] = init_default_iter(eqn, opts, oper, flag1, flag2) +% +% The function returns true or false if data for A_ and E_ +% resp. flag1 and flag2 are available and correct in structure +% eqn. +% +% Input: +% +% eqn structure with data +% opts structure containing parameter for the algorithm +% oper structure contains function handles for operation with A and E +% flag1 'A'/'E' to check if A or E is in eqn +% flag2 'A'/'E' to check if A or E is in eqn +% +% Output: +% +% result 1 if data corresponding to flag1 (and flag2) +% is available , 0 if data is not available +% eqn structure with data +% opts structure containing parameter for the algorithm +% oper structure contains function handles for operation with A and E +% +% This function does not use other default functions. +% +% This function calls two other functions checkA and checkE +% implemented at the end. +% +% The function checkA(eqn) proves if a field 'A_' is included in +% the structure eqn and if the field 'A_' is numeric and +% quadratic. +% +% The function checkE(eqn) proves if a field 'E_' is included in +% the structure eqn and if the field 'E_' is numeric and +% quadratic. +% If the structure does not include a field E, a new field 'E_' +% is defined as a sparse identity matrix by size of field 'A_'. +% + +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +%% Check input Parameters +% Definition of list of solvers + +% Check if eqn.E_ is symmetric and positive definite +if isfield(eqn, 'E_') + if issymmetric(eqn.E_) + opts.usfs.default_iter.E_is_sym = true; + if not(any(diag(eqn.E_ <= 0))) + opts.usfs.default_iter.E_is_spd = true; + else + opts.usfs.default_iter.E_is_spd = false; + end + else + opts.usfs.default_iter.E_is_sym = false; + opts.usfs.default_iter.E_is_spd = false; + end +end + +% Check if eqn.A_ is symmetric +if isfield(eqn, 'A_') + if issymmetric(eqn.A_) + opts.usfs.default_iter.A_is_sym = true; + if not(any(diag(eqn.A_ <= 0))) + opts.usfs.default_iter.A_is_spd = true; + else + opts.usfs.default_iter.A_is_spd = false; + end + else + opts.usfs.default_iter.A_is_sym = true; + opts.usfs.default_iter.A_is_spd = false; + end +end + +% Required fields for the iterative solver +if not(isfield(opts, 'usfs')) || not(isfield(opts.usfs, 'default_iter')) + + mess_warn(opts, 'control_data', [' The ''default_iter'' usfs need the ', ... + '''opts.usfs.default_iter'' substructure to be present.']); + +end + +% Check for the solver used +if isfield(opts.usfs.default_iter, 'method_A') + if not(exist(opts.usfs.default_iter.method_A, 'file') == 2) + mess_err(opts, 'control_data', ['Iterative solver method field ''method_A''', ... + ' is an unsupported solver.']); + end +else + if opts.usfs.default_iter.A_is_sym + mess_warn(opts, 'control_data', ['Iterative solver method field ''method_A''', ... + ' is unset. Falling back to PCG.']); + opts.usfs.default_iter.method_A = 'pcg'; + else + mess_warn(opts, 'control_data', ['Iterative solver method field ''method_A''', ... + ' is unset. Falling back to GMRES.']); + opts.usfs.default_iter.method_A = 'gmres'; + end +end + +if isfield(opts.usfs.default_iter, 'method_E') + if not(exist(opts.usfs.default_iter.method_E, 'file') == 2) + mess_err(opts, 'control_data', ['Iterative solver method field ''method_E''', ... + ' is an unsupported solver.']); + end +else + if opts.usfs.default_iter.E_is_spd + mess_warn(opts, 'control_data', ['Iterative solver method field ''method_E''', ... + ' is unset. Falling back to PCG.']); + opts.usfs.default_iter.method_E = 'pcg'; + + else + mess_warn(opts, 'control_data', ['Iterative solver method field ''method_E''', ... + ' is unset. Falling back to GMRES.']); + opts.usfs.default_iter.method_E = 'gmres'; + end +end + +% Required residual tolerance for stopping the iterative solver +if isfield(opts.usfs.default_iter, 'res_tol') + if opts.usfs.default_iter.res_tol < 0 + mess_err(opts, 'control_data', ['Iterative solver residual tolerance value', ... + 'is invalid']); + end +else + mess_warn(opts, 'control_data', ['Iterative solver residual tolerance value not', ... + ' found. Falling back to default']); + opts.usfs.default_iter.res_tol = 1e-12; + +end + +% Number of iterations allowed + +if isfield(opts.usfs.default_iter, 'max_iter') + if opts.usfs.default_iter.max_iter < 0 + mess_err(opts, 'control_data', ['Iterative solver max. iterations', ... + 'is invalid']); + end +else + mess_warn(opts, 'control_data', ['Iterative solver max. iterations not', ... + ' found. Falling back to default']); + opts.usfs.default_iter.max_iter = oper.size(eqn, opts, oper); + +end + +% Restart size for GMRES +if strcmpi(opts.usfs.default_iter.method_A, 'gmres') || ... + strcmpi(opts.usfs.default_iter.method_E, 'gmres') + + if isfield(opts.usfs.default_iter, 'restIter') + if opts.usfs.default_iter.restIter < 0 + mess_err(opts, 'control_data', ['GMRES restart iterations value', ... + 'is invalid']); + end + else + mess_warn(opts, 'control_data', ['GMRES restart iterations value not', ... + ' found. Falling back to default']); + opts.usfs.default_iter.restIter = 25; + end + +end + +%% Operations +na = nargin; +if isfield(eqn, 'LTV') + mess_warn(opts, 'not_implemented', ... + ['''default_iter'' does not yet support', ... + ' LTV systems.']); +end +if na < 4 + mess_err(opts, 'control_data', 'Number of input Arguments are at least 4'); + +elseif nargin == 4 % result = init_default_iter(eqn, flag1); + switch flag1 + case {'A', 'a'} + [eqn, opts, result] = checkA(eqn, opts); + + case {'E', 'e'} + [eqn, opts, result] = checkE(eqn, opts); + + otherwise + mess_err(opts, 'control_data', 'flag1 has to be ''A_'' or ''E_'''); + end + +elseif nargin == 5 % result = init_default_iter(eqn,flag1,flag2); + switch flag1 + case {'A', 'a'} + [eqn, opts, result] = checkA(eqn, opts); + + switch flag2 + case {'A', 'a'} + case {'E', 'e'} + [eqn, opts, resultE] = checkE(eqn, opts); + result = result && resultE; + + otherwise + mess_err(opts, 'control_data', 'flag2 has to be ''A'' or ''E'''); + + end + + case {'E', 'e'} + [eqn, result] = checkE(eqn, opts); + + switch flag2 + case {'A', 'a'} + [eqn, opts, resultA] = checkA(eqn, opts); + result = result && resultA; + + case {'E', 'e'} + + otherwise + mess_err(opts, 'control_data', 'flag2 has to be ''A'' or ''E'''); + + end + + otherwise + mess_err(opts, 'control_data', 'flag1 has to be ''A'' or ''E'''); + + end + +end +end + +% Check data for A_ +function [eqn, opts, result] = checkA(eqn, opts) +% This function returns the changed structure eqn and a boolean +% value result (1 if 'A_' is in structure eqn and a numeric, symmetric and +% quadratic field, 0 otherwise). +% This function also defines the preconditioner for A_ by using ICHOL or +% ILU function, depending on whether A_ is symmetric and positive +% definite, or not. + +result = isfield(eqn, 'A_'); + +if result + + result = opts.usfs.default_iter.A_is_sym; + +end + +if not(isfield(opts.usfs.default_iter, 'PA_R')) + + if not(isfield(opts.usfs.default_iter, 'PA_L')) + + mess_warn(opts, 'control_data', ['No preconditioner for A could be found.', ... + ' Switching to ICHOL/ILU']); + if opts.usfs.default_iter.A_is_spd + S = ichol(eqn.A_); + opts.usfs.default_iter.PA_L = S; + opts.usfs.default_iter.PA_R = S'; + + else + [L, U] = ilu(-eqn.A_); + opts.usfs.default_iter.PA_L = L; + opts.usfs.default_iter.PA_R = U; + end + + else + + opts.usfs.default_iter.PA_R = []; + + end + +end + +end + +% Check data for E_ +function [eqn, opts, result] = checkE(eqn, opts) +% This function returns the changed structure eqn and a boolean +% value result (1 if 'E_' is in structure eqn and a numeric, symmetric and +% quadratic field, 0 otherwise). +% This function also defines the preconditioner for E_ by using ICHOL or +% ILU function, depending on whether E_ is symmetric and positive +% definite, or not. + +if not(isfield(eqn, 'haveE')) + eqn.haveE = false; +end + +if not(eqn.haveE) + if isfield(eqn, 'E_') + mess_err(opts, 'equation_data', ['Detected eqn.E_ where eqn.haveE ' ... + 'is 0. You need to set haveE = true or ' ... + 'delete E_.']); + else + result = true; + end +else + result = isfield(eqn, 'E_'); + if result + result = opts.usfs.default_iter.E_is_spd; + end + + % Preconditioner for E + if not(isfield(opts.usfs.default_iter, 'PE_R')) + + if not(isfield(opts.usfs.default_iter, 'PE_L')) + + mess_warn(opts, 'control_data', ['No preconditioner for E could be', ... + ' found. Switching to ICHOL/ILU']); + if result + S = ichol(eqn.E_, struct('type', 'nofill', 'michol', 'on')); + opts.usfs.default_iter.PE_L = S; + opts.usfs.default_iter.PE_R = S'; + + else + [L, U] = ilu(eqn.E_); + opts.usfs.default_iter.PE_L = L; + opts.usfs.default_iter.PE_R = U; + end + else + + opts.usfs.default_iter.PE_R = []; + + end + + end + +end +end diff --git a/usfs/default_iter/init_res_default_iter.m b/usfs/default_iter/init_res_default_iter.m new file mode 100644 index 0000000..8d40a1d --- /dev/null +++ b/usfs/default_iter/init_res_default_iter.m @@ -0,0 +1,56 @@ +function [W, res0, eqn, opts, oper] = ... + init_res_default_iter(eqn, opts, oper, W, T) +%% Function init_res_default_iter initializes the low-rank residual W and res0 +% function [ W, res0, eqn, opts, oper ] = ... +% init_res_default_iter( eqn, opts, oper, W, T) +% +% This function returns the initial residual factor W and its +% associated norm res0. +% +% Input/Output: +% +% eqn structure containing data for G or B or C +% opts structure containing parameters for the algorithm +% oper structure contains function handles for operation with A and E +% W right hand side matrix +% T matrix such that the residual is W*T*W' +% (optional, defaults to the identity) +% +% Outputs: +% +% W matrix given by ADI to compute residuum +% res0 initial residuum norm +% +% This function does not use other default functions. +% + +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% +%% Check input data +if (not(isnumeric(W))) || (not(ismatrix(W))) + mess_err(opts, 'error_arguments', 'W has to ba a matrix'); +end + +%% Compute res0 +if not(exist('T', 'var')) && opts.LDL_T + % this means we only use init_res for potential projection + return +end +if isfield(opts, 'nm') && isfield(opts.nm, 'res0') + res0 = opts.nm.res0; +else + if opts.LDL_T + if opts.norm == 2 + res0 = max(abs(eig(W' * W * T))); + else + res0 = norm(eig(W' * W * T), 'fro'); + end + else + res0 = norm(W' * W, opts.norm); + end +end +end diff --git a/usfs/default_iter/mess_usfs_default_iter.m b/usfs/default_iter/mess_usfs_default_iter.m new file mode 100644 index 0000000..6816691 --- /dev/null +++ b/usfs/default_iter/mess_usfs_default_iter.m @@ -0,0 +1,68 @@ +% The first order system +% +% E * z'(t) = A * z(t) + B * u(t) +% y(t) = C * z(t) +% +% is encoded in the eqn structure +% +% The fieldnames for A and E have to end with _ to indicate that the data +% are inputdata for the algorithm. +% +% eqn.A_ = A +% eqn.E_ = E +% eqn.B = B +% eqn.C = C +% +% Note that E_ and A_ are expected to be sparse and of size n x n, +% while B and C may be dense (and will be converted to dense by +% some routines anyway) and should have far less columns (for B) +% and rows (for C) than n. +% +% In contrast to the "default" usfs, here all solve operations are +% performed using iterative solvers rather than "\". +% The `sol_*` calls will look into `opts.usfs.default_iter` for +% further setting. `opts.usfs.default_iter` is a structure with +% members: +% +% method_A the iterative solver function for solving with A +% +% method_ApE the iterative solver function for the shifted solves +% +% method_E the iterative solver function for solving with E +% +% all of these can currently be any suitable iterative solver from +% MATLAB or GNU Octave. we are regularly testing: +% +% matlab_solvers = {'bicg', 'bicgstab', 'bicgstabl', ... +% 'cgs', 'gmres', 'lsqr', 'minres', 'pcg', 'qmr', 'symmlq', 'tfqmr'}; +% octave_solvers = {'bicg', 'bicgstab', ... +% 'cgs', 'gmres', 'pcg', 'qmr', 'tfqmr', 'pcr'}; +% +% for `method_A` and `method_E`, while fixing `method_ApE = 'gmres'` +% +% Moreover, `opts.usfs.default_iter` should contain +% +% res_tol residual tolerance passed to all iterative solvers +% +% max_iter maximum iteration number passed to all iterative solvers +% +% restIter restart length passed to GMRES +% +% PA_L, PA_R preconditioner matrices for A passed to the iterative +% solvers (as M1 and M2 in the default MATLAB +% iterative solver interface) +% PE_L, PE_R preconditioner matrices for E passed to the iterative +% solvers (as M1 and M2 in the default MATLAB +% iterative solver interface) +% +% `oper.init` will check, and, in case they are absent, initialize them +% with defaults. +% + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% diff --git a/usfs/default_iter/mul_A_default_iter.m b/usfs/default_iter/mul_A_default_iter.m new file mode 100644 index 0000000..4c97726 --- /dev/null +++ b/usfs/default_iter/mul_A_default_iter.m @@ -0,0 +1,110 @@ +function C = mul_A_default_iter(eqn, opts, opA, B, opB) +% function C=mul_A_default_iter(eqn,opts,opA,B,opB) +% +% This function returns C = A_*B, where matrix A_ given by +% structure eqn and input matrix B could be transposed. +% Matrix A_ is assumed to be quadratic. +% +% Inputs: +% +% eqn structure containing field 'A_' +% opts structure containing parameters for the algorithm +% opA character specifying the shape of A_ +% opA = 'N' performs A_*opB(B) +% opA = 'T' performs A_'*opB(B) +% B m-x-p matrix +% opB character specifying the shape of B +% opB = 'N' performs opA(A_)*B +% opB = 'T' performs opA(A_)*B' +% +% Output: +% +% C = opA(A_)*opB(B) +% +% This function uses another default function size_default_iter(eqn, +% opts) to obtain the number of rows of matrix A_ in structure eqn, +% that should be equal to the number of rows of matrix E_. +% + +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% +%% Check input parameters +if not(ischar(opA)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opA or opB is not a char'); +end + +opA = upper(opA); +opB = upper(opB); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); +end + +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); +end + +if (not(isnumeric(B))) || (not(ismatrix(B))) + mess_err(opts, 'error_arguments', 'B has to be a matrix'); +end + +%% Check data in eqn structure +if not(isfield(eqn, 'A_')) + mess_err(opts, 'error_arguments', 'field eqn.A_ is not defined'); +end + +rowA = size_default_iter(eqn, opts); +colA = rowA; + +%% Perform multiplication +switch opA + + case 'N' + switch opB + + % Implement multiplication A_*B + case 'N' + if not(colA == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['number of columns of A_ ' ... + 'differs from number of rows of B']); + end + C = eqn.A_ * B; + + % Implement multiplication A_*B' + case 'T' + if not(colA == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of columns of A_ ' ... + 'differs from number of columns of B']); + end + C = eqn.A_ * B'; + end + + case 'T' + switch opB + + % Implement multiplication A_'*B + case 'N' + if not(rowA == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['number of rows of A_ ' ... + 'differs from number rows of B']); + end + C = eqn.A_' * B; + + % Implement multiplication A_'*B' + case 'T' + if not(rowA == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of rows of A_ differs from ' ... + 'number of columns of B']); + end + C = eqn.A_' * B'; + end + +end +end diff --git a/usfs/default_iter/mul_ApE_default_iter.m b/usfs/default_iter/mul_ApE_default_iter.m new file mode 100644 index 0000000..0ddbe63 --- /dev/null +++ b/usfs/default_iter/mul_ApE_default_iter.m @@ -0,0 +1,284 @@ +function C = mul_ApE_default_iter(eqn, opts, opA, p, opE, B, opB) + +% function C=mul_ApE_default_iter(eqn, opts,opA,p,opE,B,opB) +% +% This function returns C = (A_+p*E_)*B, where matrices A_ and E_ +% given by a structure eqn and input matrix B could be transposed. +% +% Inputs: +% +% eqn structure containing fields 'A_' and 'E_' +% opts structure containing parameters for the algorithm +% opA character specifying the shape of A_ +% opA = 'N' performs (A_ + p*opE(E_))*opB(B) +% opA = 'T' performs (A_' + p*opE(E_))*opB(B) +% p scalar value +% opE character specifying the shape of E_ +% opE = 'N' performs (opA(A_) + p*E_)*opB(B) +% opE = 'T' performs (opA(A_) + p*E_')*opB(B) +% B m-x-p matrix +% opB character specifying the shape of B +% opB = 'N' performs (opA(A_) + p*opE(E_))*B +% opB = 'T' performs (opA(A_) + p*opE(E_))*B' +% Output: +% +% C = (opA(A_)+ p * opE(E_))*opB(B) +% +% This function uses another default function +% size_default_iter(eqn,opts) to obtain the number of rows of matrix A_ +% in structure eqn, that should be equal to the number of rows of +% the matrix E_. +% This function also uses another default function +% mul_A_default_iter(eqn,opA,B,opB) to obtain the result if E=I. +% + +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% +%% Check input parameters +if not(ischar(opA)) || not(ischar(opB)) || not(ischar(opE)) + mess_err(opts, 'error_arguments', 'opA, opB or opE is not a char'); +end + +opA = upper(opA); +opB = upper(opB); +opE = upper(opE); + +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); +end + +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); +end + +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); +end + +if (not(isnumeric(p))) || not(length(p) == 1) + mess_err(opts, 'error_arguments', 'p is not numeric or a scalar value'); +end + +if not(isfield(eqn, 'haveE')) + eqn.haveE = false; +end + +if (not(isnumeric(B))) || (not(ismatrix(B))) + mess_err(opts, 'error_arguments', 'B has to be a matrix'); +end + +%% Check data in eqn structure +if eqn.haveE + if not(isfield(eqn, 'E_')) || not(isfield(eqn, 'A_')) + mess_err(opts, 'error_arguments', 'field eqn.E_ or eqn.A_ is not defined'); + end +else + if not(isfield(eqn, 'A_')) + mess_err(opts, 'error_arguments', 'field eqn.A_ is not defined'); + end +end + +rowA = size_default_iter(eqn, opts); +colA = rowA; + +if eqn.haveE + %% Perform multiplication when E_ is not the Identity + switch opA + + case 'N' + switch opE + + case 'N' + + switch opB + + % Implement operation (A_+p*E_)*B=C + case 'N' + + if not(colA == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['number of columns of A_ ' ... + 'differs from number of rows of B']); + end + + C = (eqn.A_ + p * eqn.E_) * B; + + % Implement operation (A_+p*E_)*B'=C + case 'T' + + if not(colA == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of columns of A_ ' ... + 'differs from number of ' ... + 'columns of B']); + end + + C = (eqn.A_ + p * eqn.E_) * B'; + + end + + case 'T' + + switch opB + + % Implement operation (A_+p*E_')*B=C + case 'N' + + if not(colA == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['number of columns ' ... + 'of A_ differs from number ' ... + 'of rows of B']); + end + + C = (eqn.A_ + p * eqn.E_') * B; + + % Implement operation (A_+p*E_')*B'=C + case 'T' + + if not(colA == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of columns ' ... + 'of A_ differs from number ' ... + 'of columns of B']); + end + + C = (eqn.A_ + p * eqn.E_') * B'; + + end + + end + + case 'T' + switch opE + + case 'N' + + switch opB + + % Implement operation (A_'+p*E_)*B=C + case 'N' + + if not(rowA == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['number of rows ' ... + 'of A_ differs from number ' ... + 'of rows of B']); + end + + C = (eqn.A_' + p * eqn.E_) * B; + + % Implement operation (A_'+p*E_)*B'=C + case 'T' + + if not(rowA == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of rows ' ... + 'of A_ differs from number ' ... + 'of columns of B']); + end + + C = (eqn.A_' + p * eqn.E_) * B'; + + end + + case 'T' + + switch opB + + % Implement operation (A_'+p*E_')*B=C + case 'N' + + if not(rowA == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['number of rows ' ... + 'of A_ differs from number ' ... + 'of rows of B']); + end + + C = (eqn.A_' + p * eqn.E_') * B; + + % Implement operation (A_'+p*E_')*B'=C + case 'T' + + if not(rowA == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of rows ' ... + 'of A_ differs from number ' ... + 'of columns of B']); + end + + C = (eqn.A_' + p * eqn.E_') * B'; + + end + + end + end +elseif not(eqn.haveE) + %% Perform multiplication when E_ = Identity + switch opA + + case 'N' + + switch opB + + % Implement operation (A_+p*I)*B=C + case 'N' + + if not(colA == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['number of columns of ' ... + 'A_ differs from number of rows of B']); + end + + C = mul_A_default_iter(eqn, opts, 'N', B, 'N') + p * B; + + % Implement operation (A_+p*I)*B'=C + case 'T' + + if not(colA == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of columns of ' ... + 'A_ differs from number of ' ... + 'columns of B']); + end + + C = mul_A_default_iter(eqn, opts, 'N', B, 'T') + p * B'; + + end + + case 'T' + + switch opB + + % Implement operation (A_'+p*I)*B=C + case 'N' + + if not(rowA == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['number of rows of A_ ' ... + 'differs from number of rows of B']); + end + + C = mul_A_default_iter(eqn, opts, 'T', B, 'N') + p * B; + + % Implement operation (A_'+p*I)*B'=C + case 'T' + + if not(rowA == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of rows of A_ ' ... + 'differs from number of columns of B']); + end + + C = mul_A_default_iter(eqn, opts, 'T', B, 'T') + p * B'; + + end + + end +end +end diff --git a/usfs/default_iter/mul_E_default_iter.m b/usfs/default_iter/mul_E_default_iter.m new file mode 100644 index 0000000..221d8ff --- /dev/null +++ b/usfs/default_iter/mul_E_default_iter.m @@ -0,0 +1,114 @@ +function C = mul_E_default_iter(eqn, opts, opE, B, opB) + +% function C=mul_E_default_iter(eqn, opts,opE,B,opB) +% +% This function returns C = E_*B, where matrix E_ given by structure +% eqn and input matrix B could be transposed. Matrix E_ is assumed +% to be quadratic and has the same size as A_ in structure eqn. +% +% Inputs: +% +% eqn structure containing field 'E_' +% opts structure containing parameters for the algorithm +% opE character specifying the shape of E_ +% opE = 'N' performs E_*opB(B) +% opE = 'T' performs E_'*opB(B) +% B m-x-p matrix +% opB character specifying the shape of B +% opB = 'N' performs opE(E_)*B +% opB = 'T' performs opE(E_)*B' +% +% Output: +% +% C = opE(E_)*opB(B) +% +% This function uses another default function +% size_default_iter(eqn,opts) to obtain the number of rows of matrix A_ +% in structure eqn, that should be equal to the number of rows of +% the matrix E_. + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +%% Check input parameters +if not(ischar(opE)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opE or opB is not a char'); +end + +opE = upper(opE); +opB = upper(opB); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); +end + +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); +end + +if (not(isnumeric(B))) || (not(ismatrix(B))) + mess_err(opts, 'error_arguments', 'B has to be a matrix'); +end + +%% Check data in eqn structure +if not(isfield(eqn, 'E_')) + mess_err(opts, 'error_arguments', 'field eqn.E_ is not defined'); +end + +rowE = size_default_iter(eqn, opts); +colE = rowE; + +%% Perform multiplication +switch opE + + case 'N' + switch opB + + % Implement multiplication E_*B + case 'N' + if not(colE == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['number of columns of E_ differs from number ' ... + 'of rows of B']); + end + C = eqn.E_ * B; + + % Implement multiplication E_*B' + case 'T' + if not(colE == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of columns of E_ differs from number ' ... + 'of columns of B']); + end + C = eqn.E_ * B'; + end + + case 'T' + switch opB + + % Implement multiplication E_'*B + case 'N' + if not(rowE == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['number of rows of E_ differs from number ' ... + 'of rows of B']); + end + C = eqn.E_' * B; + + % Implement multiplication E_'*B' + case 'T' + if not(rowE == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of rows of E_ differs from number ' ... + 'of columns of B']); + end + C = eqn.E_' * B'; + end + +end + +end diff --git a/usfs/default_iter/size_default_iter.m b/usfs/default_iter/size_default_iter.m new file mode 100644 index 0000000..6d9f78d --- /dev/null +++ b/usfs/default_iter/size_default_iter.m @@ -0,0 +1,30 @@ +function n = size_default_iter(eqn, opts, oper) %#ok +% function n = size_default_iter(eqn, opts, oper) +% +% This function returns the number of rows of matrix A_ in structure eqn. +% +% Input: +% +% eqn structure contains data for equations +% +% opts structure contains parameters for the algorithm +% +% oper structure contains function handles for operation +% with A and E +% +% Output: +% +% n number of rows of matrix A_ in structure eqn +% +% This function does not use other default functions. + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +n = size(eqn.A_, 1); +end diff --git a/usfs/default_iter/sol_A_default_iter.m b/usfs/default_iter/sol_A_default_iter.m new file mode 100644 index 0000000..b675723 --- /dev/null +++ b/usfs/default_iter/sol_A_default_iter.m @@ -0,0 +1,250 @@ +function X = sol_A_default_iter(eqn, opts, opA, B, opB) +% function X=sol_A_default_iter(eqn, opts,opA,B,opB) +% +% This function returns X = A_\B, where matrix A_ given by +% structure eqn and input matrix B could be transposed. Matrix A_ +% is assumed to be quadratic. +% +% Inputs: +% +% eqn structure containing field 'A_' +% opts structure containing parameters for the algorithm +% opA character specifying the shape of A_ +% opA = 'N' solves A_*X = opB(B) +% opA = 'T' solves A_'*X = opB(B) +% B p-x-q matrix +% opB character specifying the shape of B +% opB = 'N' solves opA(A_)*X = B +% opB = 'T' solves opA(A_)*X = B' +% +% Output: +% +% X matrix fulfilling equation opA(A_)*X = opB(B) +% +% This function uses another default function size_default_iter(eqn, +% opts) to obtain the number of rows of matrix A_ in structure eqn, +% that should be equal to the number of rows of matrix E_. + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% +%% Check input parameters +if not(ischar(opA)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opA or opB is not a char'); +end + +opA = upper(opA); +opB = upper(opB); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); +end + +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); +end + +if (not(isnumeric(B))) || (not(ismatrix(B))) + mess_err(opts, 'error_arguments', 'B has to be a matrix'); +end + +% Initial guess for vector X + +if not(isfield(opts.usfs.default_iter, 'X0_A')) + opts.usfs.default_iter.X0_A = []; +end + +%% Check data in eqn structure +switch lower(opts.usfs.default_iter.method_A) + case {'minres', 'pcg', 'symmlq', 'pcr'} + if not(opts.usfs.default_iter.A_is_sym) + mess_err(opts, 'error_arguments', ... + 'field eqn.A_ is not symmetric.'); + end +end + +n = size_default_iter(eqn, opts); + +%% Preallocate solution +if opB == 'N' + X = zeros(size(B)); + flags = zeros(1, size(B, 2)); +else + X = zeros(size(B')); + flags = zeros(1, size(B, 1)); +end + +%% Create anonymous functions +% To call multiplication with A respecting opA +switch lower(opts.usfs.default_iter.method_A) + case {'bicg', 'lsqr', 'qmr'} + + mul_A = @(X, flag) flagged_mul_A(X, flag, eqn, opts, opA); + case 'pcg' + + mul_A = @(X) -mul_A_default_iter(eqn, opts, opA, X, 'N'); + otherwise + + mul_A = @(X) mul_A_default_iter(eqn, opts, opA, X, 'N'); +end + +% For calling the actual iterative solver + +solver = eval(sprintf('@%s', lower(opts.usfs.default_iter.method_A))); + +%% Perform solve operations +switch opB + + case 'N' + if not(n == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['Number of rows of A_ differs from number ' ... + 'of rows of B']); + end + + switch lower(opts.usfs.default_iter.method_A) + + case 'pcg' + for i = 1:size(B, 2) + [x, flags(i)] = ... + solver(mul_A, B(:, i), ... + opts.usfs.default_iter.res_tol, ... + opts.usfs.default_iter.max_iter, ... + opts.usfs.default_iter.PA_L, ... + opts.usfs.default_iter.PA_R, ... + opts.usfs.default_iter.X0_A); + X(:, i) = -x; + end + case 'gmres' + for i = 1:size(B, 2) + [X(:, i), flags(i)] = ... + solver(mul_A, B(:, i), ... + opts.usfs.default_iter.restIter, ... + opts.usfs.default_iter.res_tol, ... + opts.usfs.default_iter.max_iter, ... + opts.usfs.default_iter.PA_L, ... + opts.usfs.default_iter.PA_R, ... + opts.usfs.default_iter.X0_A); + end + case 'pcr' + for i = 1:size(B, 2) + [X(:, i), flags(i)] = ... + solver(mul_A, B(:, i), ... + opts.usfs.default_iter.res_tol, ... + opts.usfs.default_iter.max_iter, ... + @(X) mfun(X, opts), ... + opts.usfs.default_iter.X0_A); + end + otherwise + for i = 1:size(B, 2) + [X(:, i), flags(i)] = ... + solver(mul_A, B(:, i), ... + opts.usfs.default_iter.res_tol, ... + opts.usfs.default_iter.max_iter, ... + opts.usfs.default_iter.PA_L, ... + opts.usfs.default_iter.PA_R, ... + opts.usfs.default_iter.X0_A); + end + + end + + case 'T' + if not(n == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['Number of rows of A_ differs from number ' ... + 'of columns of B']); + end + + switch lower(opts.usfs.default_iter.method_A) + + case 'pcg' + for i = 1:size(B, 1) + [x, flags(i)] = ... + solver(mul_A, B(i, :)', ... + opts.usfs.default_iter.res_tol, ... + opts.usfs.default_iter.max_iter, ... + opts.usfs.default_iter.PA_L, ... + opts.usfs.default_iter.PA_R, ... + opts.usfs.default_iter.X0_A); + X(:, i) = -x; + end + case 'gmres' + for i = 1:size(B, 1) + [X(:, i), flags(i)] = ... + solver(mul_A, B(i, :)', ... + opts.usfs.default_iter.restIter, ... + opts.usfs.default_iter.res_tol, ... + opts.usfs.default_iter.max_iter, ... + opts.usfs.default_iter.PA_L, ... + opts.usfs.default_iter.PA_R, ... + opts.usfs.default_iter.X0_A); + end + case 'pcr' + for i = 1:size(B, 1) + [X(:, i), flags(i)] = ... + solver(mul_A, B(i, :)', ... + opts.usfs.default_iter.res_tol, ... + opts.usfs.default_iter.max_iter, ... + @(X) mfun(X, opts), ... + opts.usfs.default_iter.X0_A); + end + otherwise + for i = 1:size(B, 1) + [X(:, i), flags(i)] = ... + solver(mul_A, B(i, :)', ... + opts.usfs.default_iter.res_tol, ... + opts.usfs.default_iter.max_iter, ... + opts.usfs.default_iter.PA_L, ... + opts.usfs.default_iter.PA_R, ... + opts.usfs.default_iter.X0_A); + end + + end + +end +if any(flags) + mess_warn(opts, 'usfs_iter', ... + [lower(opts.usfs.default_iter.method_A) ... + ' did not converge as desired']); + mess_fprintf(opts, ... + ['These are the right hand side indices and ', ... + 'corresponding non-zero termination flags ', ... + 'we encountered:\n']); + idx = find(not(flags == 0)); + for iidx = 1:length(idx) + mess_fprintf(opts, '%d %d\n', idx(iidx), flags(idx(iidx))); + end +end +end + +function Y = flagged_mul_A(X, flag, eqn, opts, opA) +% function Y = flagged_mul_A(X, flag, eqn, opts, opA) +% This is a function handle that accepts the vector input X and the matrix +% A_ given by the eqn structure, and returns the matrix vector product +% A_*X. The input 'flag' defines whether A_ should be transposed or not. + +switch lower(flag) + case 'notransp' + my_opA = opA; + case 'transp' + if strcmp(opA, 'N') + my_opA = 'T'; + else + my_opA = 'N'; + end +end +Y = mul_A_default_iter(eqn, opts, my_opA, X, 'N'); +end + +function Y = mfun(X, opts) +% function Y = mfun(X, opts) +% This is a function handle used specifically in pcr iterative solver +% that accepts the vector input X, and the preconditioner matrices U +% and L, to reconstruct the M preconditioner matrix, and solve the +% system Y = U \ (L \ X). + +Y = opts.usfs.default_iter.PA_R \ (opts.usfs.default_iter.PA_L \ X); +end diff --git a/usfs/default_iter/sol_ApE_default_iter.m b/usfs/default_iter/sol_ApE_default_iter.m new file mode 100644 index 0000000..ba3bbb0 --- /dev/null +++ b/usfs/default_iter/sol_ApE_default_iter.m @@ -0,0 +1,272 @@ +function X = sol_ApE_default_iter(eqn, opts, opA, p, opE, C, opC) + +% function X=sol_ApE_default_iter(eqn, opts,opA,p,opE,C,opC) +% +% This function returns X = (A_ + p*E_)\C, where matrices A_ and E_ +% given by structure eqn and input matrix C could be transposed. +% Matrices A_ and E_ are assumed to be quadratic. +% +% Inputs: +% +% eqn structure containing fields 'A_' and 'E_' +% opts structure containing parameters for the algorithm +% opA character specifying the shape of A +% opA = 'N' solves (A_ + p* opE(E_))*X = opC(C) +% opA = 'T' solves (A_' + p* opE(E_))*X = opC(C) +% p scalar value +% opE character specifying the shape of E_ +% opE = 'N' solves (opA(A_) + p* E_)*X = opC(C) +% opE = 'T' solves (opA(A_) + p* E_')*X = opC(C) +% C n-x-p matrix +% opC character specifies the form of opC(C) +% opC = 'N' solves (opA(A_) + p* opE(E_))*X = C +% opC = 'T' solves (opA(A_) + p* opE(E_))*X = C' +% +% Output: +% +% X matrix fulfilling equation (opA(A_)+p*opE(E_))*X = opC(C) +% +% This function uses another default function size_default_iter(eqn, +% opts) to obtain the number of rows of matrix A_ in structure eqn, +% that should be equal to the number of rows of matrix E_. +% + +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% +%% Check input parameters +if not(ischar(opA)) || not(ischar(opE)) || not(ischar(opC)) + mess_err(opts, 'error_arguments', 'opA, opE or opC is not a char'); +end + +opA = upper(opA); +opE = upper(opE); +opC = upper(opC); + +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); +end + +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); +end + +if not(opC == 'N' || opC == 'T') + mess_err(opts, 'error_arguments', 'opC is not ''N'' or ''T'''); +end + +if (not(isnumeric(p))) || not(length(p) == 1) + mess_err(opts, 'error_arguments', 'p is not numeric'); +end + +if (not(isnumeric(C))) || (not(ismatrix(C))) + mess_err(opts, 'error_arguments', 'C has to be a matrix'); +end + +n = size_default_iter(eqn, opts); + +% Initial guess for vector X + +if not(isfield(opts.usfs.default_iter, 'X0_ApE')) + opts.usfs.default_iter.X0_ApE = []; +end +%% Check data in eqn structure +switch lower(opts.usfs.default_iter.method_ApE) + case {'minres', 'pcg', 'symmlq'} + if not(issymmetric(eqn.A_ + p * eqn.E_)) + mess_err(opts, 'error_arguments', 'Resulting matrix of (eqn.A_+p*eqn.E_) is not symmetric'); + end +end +%% Preallocate solution + +if opC == 'N' + X = zeros(size(C)); + flags = zeros(1, size(C, 2)); +else + X = zeros(size(C')); + flags = zeros(1, size(C, 1)); +end + +%% Create anonymous functions +% To call multiplication with ApE respecting opA and opE +switch lower(opts.usfs.default_iter.method_ApE) + + case {'bicg', 'lsqr', 'qmr'} + + mul_ApE = @(X, flag) flagged_mul_ApE(X, flag, eqn, opts, opA, p, opE); + case 'pcg' + + mul_ApE = @(X) -mul_ApE_default_iter(eqn, opts, opA, p, opE, X, 'N'); + otherwise + + mul_ApE = @(X) mul_ApE_default_iter(eqn, opts, opA, p, opE, X, 'N'); +end + +% For calling the actual iterative solver +solver = eval(sprintf('@%s', lower(opts.usfs.default_iter.method_ApE))); +%% Perform solve operations + +switch opC + + case 'N' + if not(n == size(C, 1)) + mess_err(opts, 'error_arguments', ['Number of rows ' ... + 'of A_ differs with number ' ... + 'of rows of C']); + end + + switch lower(opts.usfs.default_iter.method_ApE) + + case 'pcg' + for i = 1:size(C, 2) + [x, flags(i)] = ... + solver(mul_ApE, C(:, i), ... + opts.usfs.default_iter.res_tol, ... + opts.usfs.default_iter.max_iter, ... + opts.usfs.default_iter.PApE_L, ... + opts.usfs.default_iter.PApE_R, ... + opts.usfs.default_iter.X0_ApE); + X(:, i) = -x; + end + + case 'gmres' + for i = 1:size(C, 2) + [X(:, i), flags(i)] = ... + solver(mul_ApE, C(:, i), ... + opts.usfs.default_iter.restIter, ... + opts.usfs.default_iter.res_tol, ... + opts.usfs.default_iter.max_iter, ... + opts.usfs.default_iter.PApE_L, ... + opts.usfs.default_iter.PApE_R, ... + opts.usfs.default_iter.X0_ApE); + end + case 'pcr' + for i = 1:size(C, 2) + [X(:, i), flags(i)] = ... + solver(mul_ApE, C(:, i), ... + opts.usfs.default_iter.res_tol, ... + opts.usfs.default_iter.max_iter, ... + @(X) mfun(X, opts), ... + opts.usfs.default_iter.X0_ApE); + end + otherwise + for i = 1:size(C, 2) + [X(:, i), flags(i)] = ... + solver(mul_ApE, C(:, i), ... + opts.usfs.default_iter.res_tol, ... + opts.usfs.default_iter.max_iter, ... + opts.usfs.default_iter.PApE_L, ... + opts.usfs.default_iter.PApE_R, ... + opts.usfs.default_iter.X0_ApE); + end + + end + + case 'T' + if not(n == size(C, 2)) + mess_err(opts, 'error_arguments', ... + ['Number of rows of A_ differs with number ' ... + 'of columns of C']); + end + + switch lower(opts.usfs.default_iter.method_ApE) + + case 'pcg' + for i = 1:size(C, 1) + [x, flags(i)] = ... + solver(mul_ApE, C(i, :)', ... + opts.usfs.default_iter.res_tol, ... + opts.usfs.default_iter.max_iter, ... + opts.usfs.default_iter.PApE_L, ... + opts.usfs.default_iter.PApE_R, ... + opts.usfs.default_iter.X0_ApE); + X(:, i) = -x; + end + + case 'gmres' + for i = 1:size(C, 1) + [X(:, i), flags(i)] = ... + solver(mul_ApE, C(i, :)', ... + opts.usfs.default_iter.restIter, ... + opts.usfs.default_iter.res_tol, ... + opts.usfs.default_iter.max_iter, ... + opts.usfs.default_iter.PApE_L, ... + opts.usfs.default_iter.PApE_R, ... + opts.usfs.default_iter.X0_ApE); + end + case 'pcr' + for i = 1:size(C, 1) + [X(:, i), flags(i)] = ... + solver(mul_ApE, C(i, :)', ... + opts.usfs.default_iter.res_tol, ... + opts.usfs.default_iter.max_iter, ... + @(X) mfun(X, opts), ... + opts.usfs.default_iter.X0_ApE); + end + otherwise + for i = 1:size(C, 1) + [X(:, i), flags(i)] = ... + solver(mul_ApE, C(i, :)', ... + opts.usfs.default_iter.res_tol, ... + opts.usfs.default_iter.max_iter, ... + opts.usfs.default_iter.PApE_L, ... + opts.usfs.default_iter.PApE_R, ... + opts.usfs.default_iter.X0_ApE); + end + end + +end +if any(flags) + mess_warn(opts, 'usfs_iter', ... + [lower(opts.usfs.default_iter.method_ApE) ... + ' did not converge as desired']); + mess_fprintf(opts, ... + ['These are the right hand side indices and ', ... + 'corresponding non-zero termination flags ', ... + 'we encountered:\n']); + idx = find(not(flags == 0)); + for iidx = 1:length(idx) + mess_fprintf(opts, '%d %d\n', idx(iidx), flags(idx(iidx))); + end +end +end + +function Y = flagged_mul_ApE(X, flag, eqn, opts, opA, p, opE) +% function Y = flagged_mul_ApE(X, flag, eqn, opts, opA, p, opE) +% This is a function handle that accepts the vector input X, the scalar p +% and the matrices A_ and E_ given by the eqn structure, and returns the matrix +% vector product (A_+p*E_)*X. The input 'flag' defines whether A_ and E_ +% should be transposed or not. + +switch lower(flag) + case 'notransp' + Y = mul_ApE_default_iter(eqn, opts, opA, p, opE, X, 'N'); + case 'transp' + if strcmp(opA, 'N') + my_opA = 'T'; + else + my_opA = 'N'; + end + if strcmp(opE, 'N') + my_opE = 'T'; + else + my_opE = 'N'; + end + Y = mul_ApE_default_iter( ... + eqn, opts, my_opA, conj(p), my_opE, X, 'N'); +end + +end + +function Y = mfun(X, opts) +% function Y = mfun(X, opts) +% This is a function handle used specifically in pcr iterative solver +% that accepts the vector input X, and the preconditioner matrices U +% and L, to reconstruct the M preconditioner matrix, and solve the +% system Y = U \ (L \ X). + +Y = opts.usfs.default_iter.PApE_R \ (opts.usfs.default_iter.PApE_L \ X); +end diff --git a/usfs/default_iter/sol_ApE_post_default_iter.m b/usfs/default_iter/sol_ApE_post_default_iter.m new file mode 100644 index 0000000..6795ab0 --- /dev/null +++ b/usfs/default_iter/sol_ApE_post_default_iter.m @@ -0,0 +1,13 @@ +function [eqn, opts, oper] = sol_ApE_post_default_iter(eqn, opts, oper) +% function [eqn, opts, oper] = sol_ApE_post_default_iter(eqn, opts, oper) +% It is necessary to remove the identity added in _pre_ again. + +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) + +if not(eqn.haveE) + eqn = fake_E_clean_default(eqn); +end diff --git a/usfs/default_iter/sol_ApE_pre_default_iter.m b/usfs/default_iter/sol_ApE_pre_default_iter.m new file mode 100644 index 0000000..5daa758 --- /dev/null +++ b/usfs/default_iter/sol_ApE_pre_default_iter.m @@ -0,0 +1,80 @@ +function [eqn, opts, oper] = sol_ApE_pre_default_iter(eqn, opts, oper) +% function [eqn, opts, oper] = sol_ApE_pre_default_iter(eqn, opts, oper) +% To simplify matters in sol_ApE we add a field eqn.E_ holding the +% identity matrix when we do not have an E matrix already. + +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) + +if not(eqn.haveE) + eqn = fake_E_default(eqn); +end + +%% Check input Parameters +if not(isfield(eqn, 'haveE')) + eqn.haveE = false; +end +if eqn.haveE + if not(isfield(eqn, 'E_')) || not(isfield(eqn, 'A_')) + mess_err(opts, 'error_arguments', 'Field eqn.E_ or eqn.A_ is not defined'); + end +else + if not(isfield(eqn, 'A_')) + mess_err(opts, 'error_arguments', 'Field eqn.A_ is not defined'); + end + if isfield(eqn, 'E_') + mess_err(opts, 'equation_data', ['Detected eqn.E_ where eqn.haveE ' ... + 'is 0. You need to set haveE = true or delete E_.']); + end +end + +% Check for the solver used +if isfield(opts.usfs.default_iter, 'method_ApE') + if not(exist(opts.usfs.default_iter.method_ApE, 'file') == 2) + mess_err(opts, 'control_data', ['iterative solver method field ''method_ApE''', ... + ' is an unsupported solver.']); + end +else + mess_warn(opts, 'control_data', ['iterative solver method field ''method_ApE''', ... + ' is unset. Falling back to GMRES.']); + opts.usfs.default_iter.method_ApE = 'gmres'; +end + +% Restart size for GMRES +if strcmpi(opts.usfs.default_iter.method_ApE, 'gmres') + + if isfield(opts.usfs.default_iter, 'restIter') + if opts.usfs.default_iter.restIter < 0 + mess_err(opts, 'control_data', ['GMRES restart iterations value', ... + 'is invalid']); + end + else + mess_warn(opts, 'control_data', ['GMRES restart iterations not', ... + ' found. Falling back to default']); + opts.usfs.default_iter.restIter = 25; + end +end + +%% Pre-defined preconditioner + +if not(isfield(opts.usfs.default_iter, 'PApE_R')) + + if not(isfield(opts.usfs.default_iter, 'PApE_L')) + + mess_warn(opts, 'control_data', ['No preconditioner for ApE could be found.', ... + ' Switching to ILU']); + [L, U] = ilu(-eqn.A_ + opts.usfs.default_iter.p_ * eqn.E_); + opts.usfs.default_iter.PApE_L = L; + opts.usfs.default_iter.PApE_R = U; + else + + opts.usfs.default_iter.PApE_R = []; + + end + +end + +end diff --git a/usfs/default_iter/sol_E_default_iter.m b/usfs/default_iter/sol_E_default_iter.m new file mode 100644 index 0000000..0e1de22 --- /dev/null +++ b/usfs/default_iter/sol_E_default_iter.m @@ -0,0 +1,231 @@ +function X = sol_E_default_iter(eqn, opts, opE, B, opB) + +% function X=sol_E_default_iter(eqn, opts, opE, B, opB) +% +% This function returns X = E_\B, where matrix E_ given by +% structure eqn and input matrix B could be transposed. Matrix E_ +% is assumed to be quadratic and has the same size as A_ in +% structure eqn. +% +% Inputs: +% +% eqn structure containing field 'E_' +% opts structure containing parameters for the algorithm +% opE character specifying the shape of E_ +% opE = 'N' solves E_*X = opB(B) +% opE = 'T' solves E_'*X = opB(B) +% B p-x-q matrix +% opB character specifying the shape of B +% opB = 'N' solves opE(E_)*X = B +% opB = 'T' solves opE(E_)*X = B' +% +% Output: +% +% X matrix fulfilling equation opE(E_)*X = opB(B) +% +% This function uses another default function size_default_iter(eqn, +% opts) to obtain the number of rows of matrix A_ in structure eqn, +% that should be equal to the number of rows of matrix E_. + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +%% Check input parameters +if not(ischar(opE)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opE or opB is not a char'); +end +opE = upper(opE); +opB = upper(opB); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); +end + +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); +end + +if (not(isnumeric(B))) || (not(ismatrix(B))) + mess_err(opts, 'error_arguments', 'B has to be a matrix'); +end + +% Initial guess for vector X + +if not(isfield(opts.usfs.default_iter, 'X0_E')) + opts.usfs.default_iter.X0_E = []; +end + +%% Check data in eqn structure + +switch lower(opts.usfs.default_iter.method_E) + case 'pcg' + if not(opts.usfs.default_iter.E_is_spd) + mess_err(opts, 'error_arguments', ... + 'Field eqn.E_ is not symmetric and positive definite'); + end + case {'minres', 'symmlq', 'pcr'} + if not(issymmetric(eqn.E_)) + mess_err(opts, 'error_arguments', 'Field eqn.E_ is not symmetric'); + end +end + +n = size_default_iter(eqn, opts); + +%% Preallocate solution +if opB == 'N' + X = zeros(size(B)); + flags = zeros(1, size(B, 2)); +else + X = zeros(size(B')); + flags = zeros(1, size(B, 1)); +end + +%% Create anonymous functions +% To call multiplication with E respecting opE + +switch lower(opts.usfs.default_iter.method_E) + + case {'bicg', 'lsqr', 'qmr'} + mul_E = @(X, flag) flagged_mul_E(X, flag, eqn, opts, opE); + + otherwise + mul_E = @(X) mul_E_default_iter(eqn, opts, opE, X, 'N'); + +end + +% For calling the actual iterative solver +solver = eval(sprintf('@%s', lower(opts.usfs.default_iter.method_E))); + +%% Perform solve operations +switch opB + + case 'N' + if not(n == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['Number of rows of E_ differs from number ' ... + 'of rows of B']); + end + + switch lower(opts.usfs.default_iter.method_E) + + case 'gmres' + for i = 1:size(B, 2) + [X(:, i), flags(i)] = ... + solver(mul_E, B(:, i), ... + opts.usfs.default_iter.restIter, ... + opts.usfs.default_iter.res_tol, ... + opts.usfs.default_iter.max_iter, ... + opts.usfs.default_iter.PE_L, ... + opts.usfs.default_iter.PE_R, ... + opts.usfs.default_iter.X0_E); + end + case 'pcr' + for i = 1:size(B, 2) + [X(:, i), flags(i)] = ... + solver(mul_E, B(:, i), ... + opts.usfs.default_iter.res_tol, ... + opts.usfs.default_iter.max_iter, ... + @(X) mfun(X, opts), ... + opts.usfs.default_iter.X0_E); + end + otherwise + for i = 1:size(B, 2) + [X(:, i), flags(i)] = ... + solver(mul_E, B(:, i), ... + opts.usfs.default_iter.res_tol, ... + opts.usfs.default_iter.max_iter, ... + opts.usfs.default_iter.PE_L, ... + opts.usfs.default_iter.PE_R, ... + opts.usfs.default_iter.X0_E); + end + + end + + case 'T' + if not(n == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['Number of rows of E_ differs from number ' ... + 'of columns of B']); + end + + switch lower(opts.usfs.default_iter.method_E) + + case 'gmres' + for i = 1:size(B, 1) + [X(:, i), flags(i)] = ... + solver(mul_E, B(i, :)', ... + opts.usfs.default_iter.restIter, ... + opts.usfs.default_iter.res_tol, ... + opts.usfs.default_iter.max_iter, ... + opts.usfs.default_iter.PE_L, ... + opts.usfs.default_iter.PE_R, ... + opts.usfs.default_iter.X0_E); + end + case 'pcr' + for i = 1:size(B, 1) + [X(:, i), flags(i)] = ... + solver(mul_E, B(i, :)', ... + opts.usfs.default_iter.res_tol, ... + opts.usfs.default_iter.max_iter, ... + @(X) mfun(X, opts), ... + opts.usfs.default_iter.X0_E); + end + otherwise + for i = 1:size(B, 1) + [X(:, i), flags(i)] = ... + solver(mul_E, B(i, :)', ... + opts.usfs.default_iter.res_tol, ... + opts.usfs.default_iter.max_iter, ... + opts.usfs.default_iter.PE_L, ... + opts.usfs.default_iter.PE_R, ... + opts.usfs.default_iter.X0_E); + end + + end +end +if any(flags) + mess_warn(opts, 'usfs_iter', ... + [lower(opts.usfs.default_iter.method_E) ... + ' did not converge as desired']); + mess_fprintf(opts, ... + ['These are the right hand side indices and ', ... + 'corresponding non-zero termination flags ', ... + 'we encountered:\n']); + idx = find(not(flags == 0)); + for iidx = 1:length(idx) + mess_fprintf(opts, '%d %d\n', idx(iidx), flags(idx(iidx))); + end +end +end + +function Y = flagged_mul_E(X, flag, eqn, opts, opE) +% function Y = flagged_mul_E(X, flag, eqn, opts, opE) +% This is a function handle that accepts the vector input X and the matrix +% E_ given by the eqn structure, and returns the matrix vector product +% A_*X. The input 'flag' defines whether E_ should be transposed or not. +switch lower(flag) + case 'notransp' + my_opE = opE; + case 'transp' + if strcmp(opE, 'N') + my_opE = 'T'; + else + my_opE = 'N'; + end +end +Y = mul_E_default_iter(eqn, opts, my_opE, X, 'N'); +end + +function Y = mfun(X, opts) +% function Y = mfun(X, opts) +% This is a function handle used specifically in pcr iterative solver +% that accepts the vector input X, and the preconditioner matrices U +% and L, to reconstruct the M preconditioner matrix, and solve the +% system Y = U \ (L \ X). + +Y = opts.usfs.default_iter.PE_R \ (opts.usfs.default_iter.PE_L \ X); +end diff --git a/usfs/mess_do_nothing.m b/usfs/mess_do_nothing.m index b70e092..c4c86b8 100644 --- a/usfs/mess_do_nothing.m +++ b/usfs/mess_do_nothing.m @@ -6,12 +6,11 @@ % Output = Input % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - varargout = varargin; diff --git a/usfs/mess_wrap_mechss.m b/usfs/mess_wrap_mechss.m index 3e3c14f..795bdbb 100644 --- a/usfs/mess_wrap_mechss.m +++ b/usfs/mess_wrap_mechss.m @@ -1,44 +1,58 @@ -function [eqn, oper] = mess_wrap_mechss(sys, usfs) -%% function [eqn, oper] = mess_wrap_mechss(sys, usfs) +function [eqn, opts, oper] = mess_wrap_mechss(sys, opts, usfs) +%% function [eqn, opts, oper] = mess_wrap_mechss(sys, opts, usfs) % % Input -% sys mechss(M,C,K,B,F,G,D) a continuous-time first-order sparse state-space model -% object of the following form: -% M*x''(t) C*x'(t) + K*x(t) = B*u(t) -% y(t) = F*x(t) + G*x'(t) + D*u(t) +% sys mechss(M,C,K,B,F,G,D) a continuous-time first-order sparse +% state-space model object of the following form: +% M*x''(t) C*x'(t) + K*x(t) = B*u(t) +% y(t) = F*x(t) + G*x'(t) + D*u(t) % -% usfs string: name of folder containing the function handle set -% (optional, defaults to 'so_1') +% opts transit argument required by logger functions +% +% usfs string: name of folder containing the function handle set +% (optional, defaults to 'so_1') % % Output -% eqn struct contains data for equations -% M*x"(t) + E x'(t) + K*x(t)= B2*u(t) -% y(t)= Cp*x(t) + Cv*x'(t) + D*u(t) +% eqn struct contains data for equations +% M*x"(t) + E x'(t) + K*x(t)= B2*u(t) +% y(t)= Cp*x(t) + Cv*x'(t) + D*u(t) +% +% eqn.M_ = M +% eqn.E_ = C +% eqn.K_ = K +% eqn.C = |Cp Cv| +% eqn.D = D % -% eqn.M_ = M -% eqn.E_ = C -% eqn.K_ = K -% eqn.C = |Cp Cv| -% eqn.D = D +% for usfs = 'so_1': +% | 0 | +% eqn.B = | B2 | % -% for usfs = 'so_1': -% | 0 | -% eqn.B = | B2 | +% for usfs = 'so_2': +% | B2 | +% eqn.B = | 0 | % -% for usfs = 'so_2': -% | B2 | -% eqn.B = | 0 | +% opts transit argument required by logger functions % +% oper struct contains function handles for operation with A and E % -% oper struct contains function handles for operation with A and E % + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) % +%% +narginchk(2, 3); + %% set oper -if not(exist('usfs', 'var')) - oper = operatormanager('so_1'); %default setting +if nargin < 3 || isempty(usfs) + [oper, opts] = operatormanager(opts, 'so_1'); % default setting else - oper = operatormanager(usfs); + [oper, opts] = operatormanager(opts, usfs); end %% set eqn @@ -47,6 +61,7 @@ if not(isempty(find(eqn.sys.M, 1))) eqn.M_ = eqn.sys.M; end + if not(isempty(find(eqn.sys.C, 1))) eqn.E_ = eqn.sys.C; end @@ -54,26 +69,31 @@ eqn.K_ = eqn.sys.K; end if not(isempty(find(eqn.sys.B, 1))) - switch(usfs) + switch usfs case 'so_1' eqn.B = [zeros(size(eqn.sys.B)); full(eqn.sys.B)]; case 'so_2' eqn.B = [full(eqn.sys.B); zeros(size(eqn.sys.B))]; otherwise - warning('MESS:warning_arguments','eqn.B is only set for function handles ''so1'' and ''so2'''); + mess_warn(opts, 'warning_arguments', ... + ['eqn.B is only set for function handles ', ... + '''so1'' and ''so2''']); end end -if not(isempty(eqn.sys.F))&& not(isempty(eqn.sys.G)) +if not(isempty(eqn.sys.F)) && not(isempty(eqn.sys.G)) eqn.C = [full(eqn.sys.F), full(eqn.sys.G)]; -elseif not(isempty(eqn.sys.F))&& isempty(eqn.sys.G) +elseif not(isempty(eqn.sys.F)) && isempty(eqn.sys.G) eqn.C = [full(eqn.sys.F), zeros(size(eqn.sys.F))]; -elseif isempty(eqn.sys.F)&& not(isempty(eqn.sys.G)) - eqn.C = [zeros(size(eqn.sys.G)), full(eqn.sys.G),]; +elseif isempty(eqn.sys.F) && not(isempty(eqn.sys.G)) + eqn.C = [zeros(size(eqn.sys.G)), full(eqn.sys.G)]; else - warning('MESS:warning_arguments','Neither Cp nor Cv is given. eqn.C will be missing'); + mess_warn(opts, 'warning_arguments', ... + 'Neither Cp nor Cv is given. eqn.C will be missing'); end if not(isempty(find(eqn.sys.D, 1))) eqn.D = eqn.sys.D; end + +eqn.haveE = true; diff --git a/usfs/mess_wrap_sparss.m b/usfs/mess_wrap_sparss.m index 826f26f..d0a1126 100644 --- a/usfs/mess_wrap_sparss.m +++ b/usfs/mess_wrap_sparss.m @@ -1,5 +1,5 @@ -function [eqn, oper] = mess_wrap_sparss(sys, usfs) -%% function [eqn, oper] = mess_wrap_sparss(sys, usfs) +function [eqn, opts, oper] = mess_wrap_sparss(sys, opts, usfs) +%% function [eqn, opts, oper] = mess_wrap_sparss(sys, opts, usfs) % % Input % sys sys = sparss(A,B,C,D,E) a continuous-time first-order @@ -7,22 +7,36 @@ % E*x'(t) = A*x(t) + B*u(t) % y(t) = C*x(t) + D*u(t) % +% opts transit argument required by logger functions +% % usfs string: name of folder containing the function handle set % (optional, defaults to 'default') % % Output % eqn struct contains data for equations % +% opts transit argument required by logger functions +% % oper struct contains function handles for operation with A and E % % +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +%% +narginchk(2, 3); %% set oper -if not(exist('usfs', 'var')) - oper = operatormanager('default'); %default setting +if nargin < 3 || isempty(usfs) + [oper, opts] = operatormanager(opts, 'default'); % default setting else - oper = operatormanager(usfs); + [oper, opts] = operatormanager(opts, usfs); end %% set eqn @@ -31,19 +45,22 @@ if not(isempty(find(eqn.sys.A, 1))) eqn.A_ = eqn.sys.A; end + if not(isempty(find(eqn.sys.B, 1))) eqn.B = full(eqn.sys.B); end + if not(isempty(find(eqn.sys.C, 1))) eqn.C = full(eqn.sys.C); end + if not(isempty(find(eqn.sys.D, 1))) eqn.D = eqn.sys.D; end + if not(isempty(find(eqn.sys.E, 1))) eqn.E_ = eqn.sys.E; - eqn.haveE = 1; + eqn.haveE = true; else - eqn.haveE = 0; + eqn.haveE = false; end - diff --git a/usfs/operatormanager.m b/usfs/operatormanager.m index a321a49..b3bf956 100644 --- a/usfs/operatormanager.m +++ b/usfs/operatormanager.m @@ -1,64 +1,64 @@ -function oper = operatormanager(name) -%% function oper = operatormanager(name) +function [oper, opts] = operatormanager(opts, name) +%% function [oper, opts] = operatormanager(opts, name) % % Return structure with function handles that are implemented in folder % name. An error is thrown if the necessary function handles are not % given. % % Input +% opts the standard options structure required for logging % name name of folder containing the function handle set % % Output -% oper struct, containing the function handles +% oper struct, containing the function handles % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% Check input parameter. -assert(ischar(name), ... - 'MESS:control_data', ... - 'input argument name has to be a string.'); +mess_assert(opts, ischar(name), ... + 'control_data', ... + 'input argument name has to be a string.'); %% Check path to function handles. [fhpath, ~, ~] = fileparts(mfilename('fullpath')); fhpath = strcat(fhpath, filesep, name); -assert(any(exist(fhpath, 'dir')), ... - 'MESS:control_data', ... - 'there is no folder %s', fhpath); +mess_assert(opts, any(exist(fhpath, 'dir')), ... + 'control_data', ... + 'there is no folder %s', fhpath); %% Check for minimal function handle set. funcs = { ... - 'mul_A', ... - 'mul_E', ... - 'size', ... - 'sol_A', ... - 'sol_E', ... - 'sol_ApE', ... - 'mul_ApE', ... - 'init', ... - 'init_res'}; + 'mul_A', ... + 'mul_E', ... + 'size', ... + 'sol_A', ... + 'sol_E', ... + 'sol_ApE', ... + 'mul_ApE', ... + 'init', ... + 'init_res'}; for f = funcs - assert(any(exist(strcat(fhpath, filesep, f{1}, '_', name, '.m'), ... - 'file')), ... - 'MESS:check_data', ... - 'file %s does not exist', strcat(f{1}, '_', name, '.m')); + mess_assert(opts, any(exist(strcat(fhpath, filesep, f{1}, '_', name, '.m'), ... + 'file')), ... + 'check_data', ... + 'file %s does not exist', strcat(f{1}, '_', name, '.m')); end % Additional function check for state space transformed systems. if any(strfind(name, 'state_space_transformed')) funcs = {'dss_to_ss', 'ss_to_dss'}; for f = funcs - assert(any(exist(strcat(fhpath, filesep, f{1}, '_', name, '.m'), ... - 'file')), ... - 'MESS:check_data', ... - 'file %s does not exist', strcat(f{1}, '_', name, '.m')); + mess_assert(opts, any(exist(strcat(fhpath, filesep, f{1}, '_', name, '.m'), ... + 'file')), ... + 'check_data', ... + 'file %s does not exist', strcat(f{1}, '_', name, '.m')); end end @@ -69,31 +69,31 @@ for k = 3:length(funcs) % Sort out functions with wrong naming scheme and not M-files. - [~,~,file_ext] = fileparts(funcs(k).name); - if not(any(strfind(funcs(k).name, name))) || not(strcmp(file_ext,'.m')) - continue; + [~, ~, file_ext] = fileparts(funcs(k).name); + if not(any(strfind(funcs(k).name, name))) || not(strcmp(file_ext, '.m')) + continue end fname = strrep(funcs(k).name, strcat('_', name, '.m'), ''); % Put the existing function into the function handle set. eval(sprintf('oper.%s = @%s;', ... - fname, ... - strrep(funcs(k).name, '.m', ''))); + fname, ... + strrep(funcs(k).name, '.m', ''))); % Replace non-existing functions by do-nothing function. - if not((any(strfind(fname, '_pre'))) ... - || any(strfind(fname, '_post')) ... - || exist(strcat(fhpath, filesep,fname, '_pre_', name, '.m'), ... - 'file')) + if not((any(strfind(fname, '_pre'))) || ... + any(strfind(fname, '_post')) || ... + exist(strcat(fhpath, filesep, fname, '_pre_', name, '.m'), ... + 'file')) eval(sprintf('oper.%s = @mess_do_nothing;', ... - strcat(fname, '_pre'))); + strcat(fname, '_pre'))); end - if not((any(strfind(fname, '_pre'))) ... - || any(strfind(fname, '_post')) ... - || exist(strcat(fhpath, filesep,fname, '_post_', name, '.m'), ... - 'file')) + if not((any(strfind(fname, '_pre'))) || ... + any(strfind(fname, '_post')) || ... + exist(strcat(fhpath, filesep, fname, '_post_', name, '.m'), ... + 'file')) eval(sprintf('oper.%s = @mess_do_nothing;', ... - strcat(fname, '_post'))); + strcat(fname, '_post'))); end end diff --git a/usfs/so_1/get_ritz_vals_so_1.m b/usfs/so_1/get_ritz_vals_so_1.m index 0d3882f..4cfa046 100644 --- a/usfs/so_1/get_ritz_vals_so_1.m +++ b/usfs/so_1/get_ritz_vals_so_1.m @@ -1,5 +1,5 @@ -function [rw, Hp, Hm, Vp, Vm, eqn, opts, oper] = get_ritz_vals_so_1(eqn, ... - opts, oper, U, W, p_old) +function [rw, Hp, Hm, Vp, Vm, eqn, opts, oper] = ... + get_ritz_vals_so_1(eqn, opts, oper, U, W, p_old) % [rw, Hp, Hm, Vp, Vm, eqn, opts, oper] = get_ritz_vals_so_1(eqn,opts,oper) % % Call help mess_usfs_so_1 to see the description of the second order @@ -33,35 +33,41 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - if isfield(opts.shifts, 'method') && ... strcmp(opts.shifts.method, 'projection') if isempty(W) - % first shifts are computed with U = eqn.G and W = A * eqn.G + % first shifts are computed with U = eqn.W and W = A * eqn.W W = oper.mul_A(eqn, opts, eqn.type, U, 'N'); + if isfield(eqn, 'haveUV') && eqn.haveUV + switch eqn.type + case 'N' + W = W + eqn.U * (eqn.V' * U); + case 'T' + W = W + eqn.V * (eqn.U' * U); + end + end end - rw = mess_projection_shifts(eqn, opts, oper, U, ... - W, p_old); + rw = mess_projection_shifts(eqn, opts, oper, U, W, p_old); else n = oper.size(eqn, opts); - if (not(isfield(opts.shifts, 'b0')) || isempty(opts.shifts.b0)) - opts.shifts.b0 = ones(n,1); + if not(isfield(opts.shifts, 'b0')) || isempty(opts.shifts.b0) + opts.shifts.b0 = ones(n, 1); else - if length(opts.shifts.b0) ~= n - warning('MESS:b0',... - 'b0 has the wrong length. Switching to default.'); - opts.shifts.b0 = ones(n,1); + if not(length(opts.shifts.b0) == n) + mess_warn(opts, 'b0', ... + 'b0 has the wrong length. Switching to default.'); + opts.shifts.b0 = ones(n, 1); end end [rw, Hp, Hm, Vp, Vm] = mess_get_ritz_vals(eqn, opts, oper); end -if isfield(opts.shifts,'truncate') && isnumeric(opts.shifts.truncate) - rw = rw(abs(rw)1/opts.shifts.truncate); +if isfield(opts.shifts, 'truncate') && isnumeric(opts.shifts.truncate) + rw = rw(abs(rw) < opts.shifts.truncate); + rw = rw(abs(rw) > 1 / opts.shifts.truncate); end end diff --git a/usfs/so_1/init_res_so_1.m b/usfs/so_1/init_res_so_1.m index e36d7a2..0b950c4 100644 --- a/usfs/so_1/init_res_so_1.m +++ b/usfs/so_1/init_res_so_1.m @@ -1,6 +1,8 @@ -function [ RHS, res0, eqn, opts, oper ] = init_res_so_1( eqn, opts, oper, RHS) -%% function init_res initializes the low rank residual W and res0 -% function [ RHS, res0, eqn, opts, oper ] = init_res_so_1( eqn, opts, oper, RHS) +function [W, res0, eqn, opts, oper] = ... + init_res_so_1(eqn, opts, oper, W, T) +%% function init_res initializes the low-rank residual W and res0 +% function [ W, res0, eqn, opts, oper ] = ... +% init_res_so_1( eqn, opts, oper, W, T) % % Call help mess_usfs_so_1 to see the description of the second order % system and its transformed first order system @@ -13,11 +15,13 @@ % eqn structure containing data for G or B or C % opts structure containing parameters for the algorithm % oper struct contains function handles for operation with A and E -% RHS right hand side matrix +% W right hand side matrix +% T matrix such that the residual is W*T*W' +% (optional, defaults to the identity) % % Outputs: % -% RHS matrix given by ADI to compute residuum +% W matrix given by ADI to compute residuum % res0 initial residuum norm % % This function does not use other so1 functions. @@ -25,30 +29,33 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % %% check input data -if (not(isnumeric(RHS))) || (not(ismatrix(RHS))) - error('MESS:error_arguments','RHS has to ba a matrix'); +if (not(isnumeric(W))) || (not(ismatrix(W))) + mess_err(opts, 'error_arguments', 'W has to ba a matrix'); end %% compute res0 +if not(exist('T', 'var')) && opts.LDL_T + % this means we only use init_res for potential projection + return +end if isfield(opts, 'nm') && isfield(opts.nm, 'res0') res0 = opts.nm.res0; else if opts.LDL_T if opts.norm == 2 - res0 = max(abs(eig(RHS' * RHS * diag(eqn.S_diag)))); + res0 = max(abs(eig(W' * W * T))); else - res0 = norm(eig(RHS' * RHS * diag(eqn.S_diag)), 'fro'); + res0 = norm(eig(W' * W * T), 'fro'); end else - res0 = norm(RHS' * RHS, opts.norm); + res0 = norm(W' * W, opts.norm); end end end - diff --git a/usfs/so_1/init_so_1.m b/usfs/so_1/init_so_1.m index c16d4e7..10dd324 100644 --- a/usfs/so_1/init_so_1.m +++ b/usfs/so_1/init_so_1.m @@ -44,88 +44,90 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % +% start checking -%start checking +if nargin <= 3 + mess_err(opts, 'control_data', 'Number of input Arguments are at least 3'); -if(nargin<=3) - error('MESS:control_data','Number of input Arguments are at least 3'); - -%result = init_so_1(eqn, flag1); -elseif(nargin==4) + % result = init_so_1(eqn, flag1); +elseif nargin == 4 switch flag1 - case {'A','a'} - [eqn,result] = checkA(eqn); - case {'E','e'} - [eqn,result] = checkE(eqn); + case {'A', 'a'} + [eqn, result] = checkA(eqn, opts); + case {'E', 'e'} + [eqn, result] = checkE(eqn, opts); otherwise - error('MESS:control_data','flag1 has to be ''A'' or ''E'''); + mess_err(opts, 'control_data', 'flag1 has to be ''A'' or ''E'''); end -%result = init_so_1(eqn,flag1,flag2); -elseif(nargin==5) + % result = init_so_1(eqn,flag1,flag2); +elseif nargin == 5 switch flag1 - case {'A','a'} - [eqn,result] = checkA(eqn); + case {'A', 'a'} + [eqn, result] = checkA(eqn, opts); switch flag2 - case {'A','a'} - [eqn,resultA] = checkA(eqn); + case {'A', 'a'} + [eqn, resultA] = checkA(eqn, opts); result = result && resultA; - case {'E','e'} - [eqn,resultE] = checkE(eqn); + case {'E', 'e'} + [eqn, resultE] = checkE(eqn, opts); result = result && resultE; otherwise - error('MESS:control_data','flag2 has to be ''A'' or ''E'''); + mess_err(opts, 'control_data', ... + 'flag2 has to be ''A'' or ''E'''); end - case {'E','e'} - [eqn,result] = checkE(eqn); + case {'E', 'e'} + [eqn, result] = checkE(eqn, opts); switch flag2 - case {'A','a'} - [eqn,resultA] = checkA(eqn); - result = result &&resultA; - case {'E','e'} - [eqn,resultE] = checkE(eqn); + case {'A', 'a'} + [eqn, resultA] = checkA(eqn, opts); + result = result && resultA; + case {'E', 'e'} + [eqn, resultE] = checkE(eqn, opts); result = result && resultE; otherwise - error('MESS:control_data','flag2 has to be ''A'' or ''E'''); + mess_err(opts, 'control_data', ... + 'flag2 has to be ''A'' or ''E'''); end otherwise - error('MESS:control_data','flag1 has to be ''A'' or ''E'''); + mess_err(opts, 'control_data', ... + 'flag1 has to be ''A'' or ''E'''); end end end -%checkdata for A +% checkdata for A -function [eqn,result] = checkA(eqn) -result = isfield(eqn,'K_') && isfield(eqn,'E_'); -if(result) - result = isnumeric(eqn.K_) && isnumeric(eqn.E_)... - && issymmetric(eqn.M_) && issymmetric(eqn.K_); - if(not(issparse(eqn.K_)) || not(issymmetric(eqn.K_))) - warning('MESS:control_data','K must be sparse and symmetric'); +function [eqn, result] = checkA(eqn, opts) +result = isfield(eqn, 'K_') && isfield(eqn, 'E_'); +if result + result = isnumeric(eqn.K_) && isnumeric(eqn.E_) && ... + issymmetric(eqn.M_) && issymmetric(eqn.K_); + if not(issparse(eqn.K_)) || not(issymmetric(eqn.K_)) + mess_warn(opts, 'control_data', 'K must be sparse and symmetric'); end - if(not(issparse(eqn.E_)) || not(issymmetric(eqn.E_))) - warning('MESS:control_data','E must be sparse and symmetric'); + if not(issparse(eqn.E_)) || not(issymmetric(eqn.E_)) + mess_warn(opts, 'control_data', 'E must be sparse and symmetric'); end end end -%checkdata for E -function [eqn,result] = checkE(eqn) -result = isfield(eqn,'M_')&&isfield(eqn,'K_'); -if(result) - result = isnumeric(eqn.M_) && isnumeric(eqn.K_) ... - &&issymmetric(eqn.M_) && issymmetric(eqn.K_); - if(not(issparse(eqn.M_)) || not(issymmetric(eqn.M_))) - warning('MESS:control_data','M must be sparse and symmetric'); +% checkdata for E +function [eqn, result] = checkE(eqn, opts) +result = isfield(eqn, 'M_') && isfield(eqn, 'K_'); +if result + result = isnumeric(eqn.M_) && isnumeric(eqn.K_) && ... + issymmetric(eqn.M_) && issymmetric(eqn.K_); + if not(issparse(eqn.M_)) || not(issymmetric(eqn.M_)) + mess_warn(opts, 'control_data', 'M must be sparse and symmetric'); end - if(not(issparse(eqn.K_)) || not(issymmetric(eqn.K_))) - warning('MESS:control_data','K must be sparse and symmetric'); + if not(issparse(eqn.K_)) || not(issymmetric(eqn.K_)) + mess_warn(opts, 'control_data', 'K must be sparse and symmetric'); end end end diff --git a/usfs/so_1/mess_usfs_so_1.m b/usfs/so_1/mess_usfs_so_1.m index b8e7ab4..d9b0a82 100644 --- a/usfs/so_1/mess_usfs_so_1.m +++ b/usfs/so_1/mess_usfs_so_1.m @@ -40,9 +40,9 @@ % eqn.C = C_f % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % diff --git a/usfs/so_1/mul_A_so_1.m b/usfs/so_1/mul_A_so_1.m index c828604..96e31ec 100644 --- a/usfs/so_1/mul_A_so_1.m +++ b/usfs/so_1/mul_A_so_1.m @@ -1,12 +1,13 @@ -function C=mul_A_so_1(eqn, opts,opA,B,opB)%#ok -% function C=mul_A_so_1(eqn, opts,opA,B,opB) +function C = mul_A_so_1(eqn, opts, opA, B, opB) +% function C = mul_A_so_1(eqn, opts, opA, B, opB) % % Call help mess_usfs_so_1 to see the description of the second order % system and its transformed first order system % % -% This function returns C = A*B, where matrix A given by structure eqn and input matrix B could be transposed. -% Matrix A is assumed to be quadratic and has a size of 2* size(K). +% This function returns C = A*B, where matrix A given by structure +% eqn and input matrix B could be transposed. +% Matrix A is assumed to be quadratic and has a size of 2 * size(K). % % Inputs: % @@ -32,61 +33,63 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input parameters -if (not(ischar(opA)) || not(ischar(opB))) - error('MESS:error_arguments', 'opA or opB is not a char'); +if not(ischar(opA)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opA or opB is not a char'); end -opA = upper(opA); opB = upper(opB); -if(not((opA=='N' || opA=='T'))) - error('MESS:error_arguments','opA is not ''N'' or ''T'''); +opA = upper(opA); +opB = upper(opB); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if(not((opB=='N' || opB=='T'))) - error('MESS:error_arguments','opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -if(not(isfield(eqn,'K_')) || not(isnumeric(eqn.K_)) || not(isfield(eqn,'E_'))) || not(isnumeric(eqn.E_)) - error('MESS:error_arguments',... - 'A consists of K and D, field eqn.K_ or eqn.E_ is not defined or corrupted'); +if not(isfield(eqn, 'K_')) || not(isnumeric(eqn.K_)) || ... + not(isfield(eqn, 'E_')) || not(isnumeric(eqn.E_)) + mess_err(opts, 'error_arguments', ... + ['A consists of K and E, field eqn.K_ or eqn.E_ is not ' ... + 'defined or corrupted']); end - [rowK, colK] = size(eqn.K_); -colA = 2*colK; +colA = 2 * colK; %% perform multiplication switch opB - %implement operation A*B + % implement operation A*B case 'N' - if(colA~=size(B,1)) - error('MESS:error_arguments','number of columns of A differs with number of rows of B'); + if not(colA == size(B, 1)) + mess_err(opts, 'error_arguments', ... + 'number of columns of A differs with number of rows of B'); end - C = [-eqn.K_*B(rowK+1:end,:); - -eqn.K_*B(1:rowK,:) - eqn.E_*B(rowK+1:end,:)]; + C = [-eqn.K_ * B(rowK + 1:end, :) + -eqn.K_ * B(1:rowK, :) - eqn.E_ * B(rowK + 1:end, :)]; - %implement operation A*B' + % implement operation A*B' case 'T' - if(colA~=size(B,2)) - error('MESS:error_arguments','number of columns of A differs with number of columns of B'); + if not(colA == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of columns of A differs with number ' ... + 'of columns of B']); end - C=[ -eqn.K_*B(:,colK+1:end)';... - -eqn.K_*B(:,1:colK)' - eqn.E_*B(:,colK+1:end)']; + C = [-eqn.K_ * B(:, colK + 1:end)'; ... + -eqn.K_ * B(:, 1:colK)' - eqn.E_ * B(:, colK + 1:end)']; end - end - diff --git a/usfs/so_1/mul_ApE_so_1.m b/usfs/so_1/mul_ApE_so_1.m index fda002c..4b1aea7 100644 --- a/usfs/so_1/mul_ApE_so_1.m +++ b/usfs/so_1/mul_ApE_so_1.m @@ -1,4 +1,4 @@ -function C=mul_ApE_so_1(eqn, opts,opA,p,opE,B,opB)%#ok +function C = mul_ApE_so_1(eqn, opts, opA, p, opE, B, opB) % function C=mul_ApE_so_1(eqn, opts,opA,p,opE,B,opB) % % Call help mess_usfs_so_1 to see the description of the second order @@ -38,66 +38,68 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input parameters -if (not(ischar(opA)) || not(ischar(opB)) || not(ischar(opE))) - error('MESS:error_arguments', 'opA, opB or opE is not a char'); +if not(ischar(opA)) || not(ischar(opB)) || not(ischar(opE)) + mess_err(opts, 'error_arguments', 'opA, opB or opE is not a char'); end -opA = upper(opA); opB = upper(opB); opE = upper(opE); +opA = upper(opA); +opB = upper(opB); +opE = upper(opE); -if(not((opA=='N' || opA=='T'))) - error('MESS:error_arguments','opA is not ''N'' or ''T'''); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if(not((opB=='N' || opB=='T'))) - error('MESS:error_arguments','opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end -if(not((opE=='N' || opE=='T'))) - error('MESS:error_arguments','opE is not ''N'' or ''T'''); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end -if(not(isnumeric(p))) - error('MESS:error_arguments','p is not numeric'); +if not(isnumeric(p)) + mess_err(opts, 'error_arguments', 'p is not numeric'); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure [rowK, colK] = size(eqn.K_); -colA = 2*colK; +colA = 2 * colK; one = 1:rowK; -two = (rowK + 1) : colA; +two = (rowK + 1):colA; switch opB - %implement multiplication (A+p*E)*B=C - case 'N' - if(colA~=size(B,1)) - error('MESS:error_arguments',['number of columns of A ' ... - 'differs with number of rows of B']); + % implement multiplication (A+p*E)*B=C + case 'N' + if not(colA == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['number of columns of A differs with number ' ... + 'of rows of B']); end - C = -[(p*(eqn.K_*B(one, :)) + eqn.K_*B(two, :)); - (eqn.K_*B(one, :)) - p*(eqn.M_*B(two, :)) + eqn.E_*B(two, :)]; - - %implement multiplication (A+p*E)*B'=C - case 'T' - if(colA~=size(B,2)) - error('MESS:error_arguments',['number of columns of A ' ... - 'differs with number of columns of B']); + C = -[(p * (eqn.K_ * B(one, :)) + eqn.K_ * B(two, :)) + (eqn.K_ * B(one, :)) - p * (eqn.M_ * B(two, :)) + eqn.E_ * B(two, :)]; + + % implement multiplication (A+p*E)*B'=C + case 'T' + if not(colA == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of columns of A differs with number ' ... + 'of columns of B']); end - C = -[(p*(eqn.K_*B(:,one)') + (eqn.K_*B(:,two)'));... - (eqn.K_*B(:,one)') - p*(eqn.M_*B(:,two)') + eqn.E_*B(:,two)']; + C = -[(p * (eqn.K_ * B(:, one)') + (eqn.K_ * B(:, two)')); ... + (eqn.K_ * B(:, one)') - p * (eqn.M_ * B(:, two)') + eqn.E_ * B(:, two)']; end - end diff --git a/usfs/so_1/mul_E_so_1.m b/usfs/so_1/mul_E_so_1.m index 7bbf8d2..225b2bf 100644 --- a/usfs/so_1/mul_E_so_1.m +++ b/usfs/so_1/mul_E_so_1.m @@ -1,11 +1,12 @@ -function C=mul_E_so_1(eqn, opts,opE,B,opB)%#ok +function C = mul_E_so_1(eqn, opts, opE, B, opB) % function C=mul_E_so_1(eqn, opts,opE,B,opB) % % Call help mess_usfs_so_1 to see the description of the second order % system and its transformed first order system % % -% This function returns C = E*B, where matrix E given by structure eqn and input matrix B could be transposed. +% This function returns C = E*B, where matrix E given by structure +% eqn and input matrix B could be transposed. % Matrix E is assumed to be quadratic and has a same size of 2*size(K). % % Inputs: @@ -32,64 +33,62 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - - %% check input parameters -if (not(ischar(opE)) || not(ischar(opB))) - error('MESS:error_arguments', 'opE or opB is not a char'); +if not(ischar(opE)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opE or opB is not a char'); end -opE = upper(opE); opB = upper(opB); -if(not((opE=='N' || opE=='T'))) - error('MESS:error_arguments','opE is not ''N'' or ''T'''); +opE = upper(opE); +opB = upper(opB); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end -if(not((opB=='N' || opB=='T'))) - error('MESS:error_arguments','opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -if(not(isfield(eqn,'K_')) || not(isnumeric(eqn.K_)) || not(isfield(eqn,'M_')) ... - || not(isnumeric(eqn.M_))) - error('MESS:error_arguments',... - 'E consists of K and M, field eqn.K_ or eqn.M_ is not defined'); +if not(isfield(eqn, 'K_')) || not(isnumeric(eqn.K_)) || ... + not(isfield(eqn, 'M_')) || not(isnumeric(eqn.M_)) + mess_err(opts, 'error_arguments', ... + 'E consists of K and M, field eqn.K_ or eqn.M_ is not defined'); end - [rowK, colK] = size(eqn.K_); -colE = 2*colK; - +colE = 2 * colK; %% perform multiplication switch opB - %implement operation E*B + % implement operation E*B case 'N' - if(colE~=size(B,1)) - error('MESS:error_arguments','number of columns of E differs with number of rows of B'); + if not(colE == size(B, 1)) + mess_err(opts, 'error_arguments', ... + 'number of columns of E differs with number of rows of B'); end - C = [-eqn.K_*B(1:rowK,:); - eqn.M_*B(rowK+1:end,:)]; + C = [-eqn.K_ * B(1:rowK, :) + eqn.M_ * B(rowK + 1:end, :)]; - %implement operation E*B' + % implement operation E*B' case 'T' - if(colE~=size(B,2)) - error('MESS:error_arguments','number of columns of E differs with number of columns of B'); + if not(colE == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of columns of E differs with number ' ... + 'of columns of B']); end - C=[-eqn.K_*B(:,1:colK)';... - eqn.M_*B(:,colK+1:end)']; + C = [-eqn.K_ * B(:, 1:colK)'; ... + eqn.M_ * B(:, colK + 1:end)']; end - end - diff --git a/usfs/so_1/size_so_1.m b/usfs/so_1/size_so_1.m index 66bad68..e62f447 100644 --- a/usfs/so_1/size_so_1.m +++ b/usfs/so_1/size_so_1.m @@ -1,4 +1,4 @@ -function n = size_so_1(eqn, opts)%#ok +function n = size_so_1(eqn, opts, oper) %#ok % function n = size_so_1(eqn, opts) % % Call help mess_usfs_so_1 to see the description of the second order @@ -21,15 +21,15 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % -if(not(isfield(eqn,'K_')) || not(isnumeric(eqn.K_))) - error('MESS:error_arguments',... - 'A consists of K and D, field eqn.K_ is not defined or corrupted'); +if not(isfield(eqn, 'K_')) || not(isnumeric(eqn.K_)) + mess_err(opts, 'error_arguments', ... + 'A consists of K and D, field eqn.K_ is not defined or corrupted'); end -n = 2*size(eqn.K_,1); +n = 2 * size(eqn.K_, 1); end diff --git a/usfs/so_1/sol_A_so_1.m b/usfs/so_1/sol_A_so_1.m index 54c9f07..ef7789d 100644 --- a/usfs/so_1/sol_A_so_1.m +++ b/usfs/so_1/sol_A_so_1.m @@ -1,4 +1,4 @@ -function X=sol_A_so_1(eqn, opts,opA,B,opB)%#ok +function X = sol_A_so_1(eqn, opts, opA, B, opB) % function X=sol_A_so_1(eqn, opts,opA,B,opB) % % Call help mess_usfs_so_1 to see the description of the second order @@ -31,68 +31,68 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input parameters -if (not(ischar(opA)) || not(ischar(opB))) - error('MESS:error_arguments', 'opA or opB is not a char'); +if not(ischar(opA)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opA or opB is not a char'); end -opA = upper(opA); opB = upper(opB); -if(not((opA=='N' || opA=='T'))) - error('MESS:error_arguments','opA is not ''N'' or ''T'''); +opA = upper(opA); +opB = upper(opB); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if(not((opB=='N' || opB=='T'))) - error('MESS:error_arguments','opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -if(not(isfield(eqn,'K_')) || not(isnumeric(eqn.K_)) || not(isfield(eqn,'E_'))) || not(isnumeric(eqn.E_)) - error('MESS:error_arguments',... - 'A consists of K and D, field eqn.K_ or eqn.E_ is not defined or corrupted'); +if not(isfield(eqn, 'K_')) || not(isnumeric(eqn.K_)) || ... + not(isfield(eqn, 'E_')) || not(isnumeric(eqn.E_)) + mess_err(opts, 'error_arguments', ... + ['A consists of K and D, field eqn.K_ or eqn.E_ is not ' ... + 'defined or corrupted']); end [rowK, colK] = size(eqn.K_); -rowA = 2*rowK; - - +rowA = 2 * rowK; %% perform solve operations switch opB - %implement solve A*X=B + % implement solve A*X=B case 'N' - if(rowA~=size(B,1)) - error('MESS:error_arguments','number of rows of A differs with number of rows of B'); + if not(rowA == size(B, 1)) + mess_err(opts, 'error_arguments', ... + 'number of rows of A differs with number of rows of B'); end - %%K_ hat vollen Rang - X2 = eqn.K_\B(1:rowK,:); - X1 = eqn.K_\(B(rowK+1:end,:)-eqn.E_*X2); - X= [-X1;-X2]; + %% K_ has full rank + X2 = eqn.K_ \ B(1:rowK, :); + X1 = eqn.K_ \ (B(rowK + 1:end, :) - eqn.E_ * X2); + X = [-X1; -X2]; - %implement solve A*X=B' + % implement solve A*X=B' case 'T' - if(rowA~=size(B,2)) - error('MESS:error_arguments','number of rows of A differs with number of columns of B'); + if not(rowA == size(B, 2)) + mess_err(opts, 'error_arguments', ... + 'number of rows of A differs with number of columns of B'); end - X2 = eqn.K_\B(:,1:colK)'; - X1 = eqn.K_\(B(:,colK+1:end)'-eqn.E_*X2); - X= [-X1;-X2]; + X2 = eqn.K_ \ B(:, 1:colK)'; + X1 = eqn.K_ \ (B(:, colK + 1:end)' - eqn.E_ * X2); + X = [-X1; -X2]; end - end - diff --git a/usfs/so_1/sol_ApE_so_1.m b/usfs/so_1/sol_ApE_so_1.m index f292664..2a8c0b3 100644 --- a/usfs/so_1/sol_ApE_so_1.m +++ b/usfs/so_1/sol_ApE_so_1.m @@ -1,4 +1,4 @@ -function X=sol_ApE_so_1(eqn, opts,opA,p,opE,C,opC)%#ok +function X = sol_ApE_so_1(eqn, opts, opA, p, opE, C, opC) % function X=sol_ApE_so_1(eqn, opts,opA,p,opE,C,opC) % % Call help mess_usfs_so_1 to see the description of the second order @@ -38,64 +38,65 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input parameters -if (not(ischar(opA)) || not(ischar(opE)) || not(ischar(opC))) - error('MESS:error_arguments', 'opA, opE or opC is not a char'); +if not(ischar(opA)) || not(ischar(opE)) || not(ischar(opC)) + mess_err(opts, 'error_arguments', 'opA, opE or opC is not a char'); end -opA = upper(opA); opE = upper(opE); opC = upper(opC); +opA = upper(opA); +opE = upper(opE); +opC = upper(opC); -if(not((opA=='N' || opA=='T'))) - error('MESS:error_arguments','opA is not ''N'' or ''T'''); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if(not((opE=='N' || opE=='T'))) - error('MESS:error_arguments','opE is not ''N'' or ''T'''); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end -if(not((opC=='N' || opC=='T'))) - error('MESS:error_arguments','opC is not ''N'' or ''T'''); +if not(opC == 'N' || opC == 'T') + mess_err(opts, 'error_arguments', 'opC is not ''N'' or ''T'''); end -if(not(isnumeric(p))) - error('MESS:error_arguments','p is not numeric'); +if not(isnumeric(p)) + mess_err(opts, 'error_arguments', 'p is not numeric'); end if (not(isnumeric(C))) || (not(ismatrix(C))) - error('MESS:error_arguments','C has to ba a matrix'); + mess_err(opts, 'error_arguments', 'C has to ba a matrix'); end [rowK, colK] = size(eqn.K_); -colA = 2*colK; +colA = 2 * colK; one = 1:rowK; -two = (rowK + 1) : colA; +two = (rowK + 1):colA; switch opC case 'N' % implement solve (A+p*E)*X=C - if not(colA == size(C,1)) - error('MESS:error_arguments',['number of rows of A ' ... - 'differs with number of rows of C']); + if not(colA == size(C, 1)) + mess_err(opts, 'error_arguments', ['number of rows of A ' ... + 'differs with number of rows of C']); end X2 = (p * (p * eqn.M_ - eqn.E_) + eqn.K_) \ ... - (p * C(two,:) - C(one,:)); - X1 = (-p*eqn.K_) \ (C(one,:) + eqn.K_ * X2); - X = [ X1; X2]; + (p * C(two, :) - C(one, :)); + X1 = (-p * eqn.K_) \ (C(one, :) + eqn.K_ * X2); + X = [X1; X2]; case 'T' % implement solve (A+p*E)*X=C' - if not(colA == size(C,2)) - error('MESS:error_arguments',['number of rows of A ' ... - 'differs with number of columns of C']); + if not(colA == size(C, 2)) + mess_err(opts, 'error_arguments', ['number of rows of A ' ... + 'differs with number of columns of C']); end X2 = (p * (p * eqn.M_ - eqn.E_) + eqn.K_) \ ... @@ -104,4 +105,3 @@ X = [X1; X2]; end end - diff --git a/usfs/so_1/sol_E_so_1.m b/usfs/so_1/sol_E_so_1.m index 80a71af..1435596 100644 --- a/usfs/so_1/sol_E_so_1.m +++ b/usfs/so_1/sol_E_so_1.m @@ -1,11 +1,12 @@ -function X=sol_E_so_1(eqn, opts,opE,B,opB)%#ok +function X = sol_E_so_1(eqn, opts, opE, B, opB) % function X=sol_E_so_1(eqn, opts,opE,B,opB) % % Call help mess_usfs_so_1 to see the description of the second order % system and its transformed first order system % % -% This function returns X= E\B, where matrix E given by structure eqn and input matrix B could be transposed. +% This function returns X= E\B, where matrix E given by structure +% eqn and input matrix B could be transposed. % % Inputs: % eqn structure containing data for matrix E (fields 'M_' and 'K_') @@ -30,59 +31,59 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - - %% check input parameters -if (not(ischar(opE)) || not(ischar(opB))) - error('MESS:error_arguments', 'opE or opB is not a char'); +if not(ischar(opE)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opE or opB is not a char'); end -opE = upper(opE); opB = upper(opB); -if(not((opE=='N' || opE=='T'))) - error('MESS:error_arguments','opE is not ''N'' or ''T'''); +opE = upper(opE); +opB = upper(opB); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end -if(not((opB=='N' || opB=='T'))) - error('MESS:error_arguments','opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -if(not(isfield(eqn,'K_')) || not(isnumeric(eqn.K_)) || not(isfield(eqn,'M_')) ... - || not(isnumeric(eqn.M_))) - error('MESS:error_arguments',... - 'E consists of K and M, field eqn.K_ or eqn.M_ is not defined'); +if not(isfield(eqn, 'K_')) || not(isnumeric(eqn.K_)) || ... + not(isfield(eqn, 'M_')) || not(isnumeric(eqn.M_)) + mess_err(opts, 'error_arguments', ... + 'E consists of K and M, field eqn.K_ or eqn.M_ is not defined'); end - [rowK, colK] = size(eqn.K_); -rowE = 2*rowK; - +rowE = 2 * rowK; %% perform solve operations switch opB - %implement solve E*X=B + % implement solve E*X=B case 'N' - if(rowE~=size(B,1)) - error('MESS:error_arguments','number of rows of E differs with number of rows of B'); + if not(rowE == size(B, 1)) + mess_err(opts, 'error_arguments', ... + 'number of rows of E differs with number of rows of B'); end - X= [-eqn.K_\B(1:rowK,:);eqn.M_\B(rowK+1:end,:)]; + X = [-eqn.K_ \ B(1:rowK, :); ... + eqn.M_ \ B(rowK + 1:end, :)]; - %implement solve E*X=B' + % implement solve E*X=B' case 'T' - if(rowE~=size(B,2)) - error('MESS:error_arguments','number of rows of E differs with number of columns of B'); + if not(rowE == size(B, 2)) + mess_err(opts, 'error_arguments', ... + 'number of rows of E differs with number of columns of B'); end - X= [-eqn.K_\B(:,1:colK)';eqn.M_\B(:,colK+1:end)']; + X = [-eqn.K_ \ B(:, 1:colK)'; ... + eqn.M_ \ B(:, colK + 1:end)']; end end - diff --git a/usfs/so_2/get_ritz_vals_so_2.m b/usfs/so_2/get_ritz_vals_so_2.m index f2f529f..9591576 100644 --- a/usfs/so_2/get_ritz_vals_so_2.m +++ b/usfs/so_2/get_ritz_vals_so_2.m @@ -1,5 +1,7 @@ -function [rw, Hp, Hm, Vp, Vm, eqn, opts, oper] = get_ritz_vals_so_2(eqn, opts, oper, U, W, p_old) -% [rw, Hp, Hm, Vp, Vm, eqn, opts, oper] = get_ritz_vals_so_2(eqn,opts,oper) +function [rw, Hp, Hm, Vp, Vm, eqn, opts, oper] = ... + get_ritz_vals_so_2(eqn, opts, oper, U, W, p_old) +% [rw, Hp, Hm, Vp, Vm, eqn, opts, oper] = +% get_ritz_vals_so_2(eqn,opts,oper, U, W, p_old) % % Call help mess_usfs_so_2 to see the description of the second order % system and its transformed first order system @@ -32,35 +34,41 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - if isfield(opts.shifts, 'method') && ... strcmp(opts.shifts.method, 'projection') if isempty(W) - % first shifts are computed with U = eqn.G and W = A * eqn.G + % first shifts are computed with U = eqn.W and W = A * eqn.W W = oper.mul_A(eqn, opts, eqn.type, U, 'N'); + if isfield(eqn, 'haveUV') && eqn.haveUV + switch eqn.type + case 'N' + W = W + eqn.U * (eqn.V' * U); + case 'T' + W = W + eqn.V * (eqn.U' * U); + end + end end - rw = mess_projection_shifts(eqn, opts, oper, U, ... - W, p_old); + rw = mess_projection_shifts(eqn, opts, oper, U, W, p_old); else n = oper.size(eqn, opts); - if (not(isfield(opts.shifts, 'b0')) || isempty(opts.shifts.b0)) - opts.shifts.b0 = ones(n,1); + if not(isfield(opts.shifts, 'b0')) || isempty(opts.shifts.b0) + opts.shifts.b0 = ones(n, 1); else - if length(opts.shifts.b0) ~= n - warning('MESS:b0',... - 'b0 has the wrong length. Switching to default.'); - opts.shifts.b0 = ones(n,1); + if not(length(opts.shifts.b0) == n) + mess_warn(opts, 'b0', ... + 'b0 has the wrong length. Switching to default.'); + opts.shifts.b0 = ones(n, 1); end end [rw, Hp, Hm, Vp, Vm] = mess_get_ritz_vals(eqn, opts, oper); end -if isfield(opts.shifts,'truncate') && isnumeric(opts.shifts.truncate) +if isfield(opts.shifts, 'truncate') && isnumeric(opts.shifts.truncate) rw = rw(abs(rw) < opts.shifts.truncate); - rw = rw(abs(rw) > 1/opts.shifts.truncate); + rw = rw(abs(rw) > 1 / opts.shifts.truncate); end end diff --git a/usfs/so_2/init_res_so_2.m b/usfs/so_2/init_res_so_2.m index 5ec435d..276bf15 100644 --- a/usfs/so_2/init_res_so_2.m +++ b/usfs/so_2/init_res_so_2.m @@ -1,6 +1,8 @@ -function [ RHS, res0, eqn, opts, oper ] = init_res_so_2( eqn, opts, oper, RHS) -%% function init_res initializes the low rank residual W and res0 -% function [ RHS, res0, eqn, opts, oper ] = init_res_so_2( eqn, opts, oper, RHS) +function [W, res0, eqn, opts, oper] = ... + init_res_so_2(eqn, opts, oper, W, T) +%% function init_res initializes the low-rank residual W and res0 +% function [ W, res0, eqn, opts, oper ] = ... +% init_res_so_2( eqn, opts, oper, W, T) % % Call help mess_usfs_so_2 to see the description of the second order % system and its transformed first order system @@ -13,11 +15,13 @@ % eqn structure containing data for G or B or C % opts structure containing parameters for the algorithm % oper struct contains function handles for operation with A and E -% RHS right hand side matrix +% W right hand side matrix +% T matrix such that the residual is W*T*W' +% (optional, defaults to the identity) % % Outputs: % -% RHS matrix given by ADI to compute residuum +% W matrix given by ADI to compute residuum % res0 initial residuum norm % % This function does not use other so3 functions. @@ -25,30 +29,33 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % %% check input data -if (not(isnumeric(RHS))) || (not(ismatrix(RHS))) - error('MESS:error_arguments','RHS has to ba a matrix'); +if (not(isnumeric(W))) || (not(ismatrix(W))) + mess_err(opts, 'error_arguments', 'W has to ba a matrix'); end %% compute res0 +if not(exist('T', 'var')) && opts.LDL_T + % this means we only use init_res for potential projection + return +end if isfield(opts, 'nm') && isfield(opts.nm, 'res0') res0 = opts.nm.res0; else if opts.LDL_T if opts.norm == 2 - res0 = max(abs(eig(RHS' * RHS * diag(eqn.S_diag)))); + res0 = max(abs(eig(W' * W * T))); else - res0 = norm(eig(RHS' * RHS * diag(eqn.S_diag)), 'fro'); + res0 = norm(eig(W' * W * T), 'fro'); end else - res0 = norm(RHS' * RHS, opts.norm); + res0 = norm(W' * W, opts.norm); end end end - diff --git a/usfs/so_2/init_so_2.m b/usfs/so_2/init_so_2.m index 8109750..29bf142 100644 --- a/usfs/so_2/init_so_2.m +++ b/usfs/so_2/init_so_2.m @@ -31,86 +31,92 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % +% start checking +if nargin <= 3 + mess_err(opts, 'control_data', 'Number of input Arguments are at least 3'); -%start checking -if(nargin<=3) - error('MESS:control_data','Number of input Arguments are at least 3'); - -%result = init_so_1(eqn, flag1); -elseif(nargin==4) + % result = init_so_1(eqn, flag1); +elseif nargin == 4 switch flag1 - case {'A','a'} - [eqn,result] = checkA(eqn); - case {'E','e'} - [eqn,result] = checkE(eqn); + case {'A', 'a'} + [eqn, result] = checkA(eqn, opts); + case {'E', 'e'} + [eqn, result] = checkE(eqn, opts); otherwise - error('MESS:control_data','flag1 has to be ''A'' or ''E'''); + mess_err(opts, 'control_data', 'flag1 has to be ''A'' or ''E'''); end -%result = init_so_1(eqn,flag1,flag2); -elseif(nargin==5) + % result = init_so_1(eqn,flag1,flag2); +elseif nargin == 5 switch flag1 - case {'A','a'} - [eqn,result] = checkA(eqn); + case {'A', 'a'} + [eqn, result] = checkA(eqn, opts); switch flag2 - case {'A','a'} - [eqn,resultA] = checkA(eqn); + case {'A', 'a'} + [eqn, resultA] = checkA(eqn, opts); result = result && resultA; - case {'E','e'} - [eqn,resultE] = checkE(eqn); + case {'E', 'e'} + [eqn, resultE] = checkE(eqn, opts); result = result && resultE; otherwise - error('MESS:control_data','flag2 has to be ''A'' or ''E'''); + mess_err(opts, 'control_data', ... + 'flag2 has to be ''A'' or ''E'''); end - case {'E','e'} - [eqn,result] = checkE(eqn); + case {'E', 'e'} + [eqn, result] = checkE(eqn, opts); switch flag2 - case {'A','a'} - [eqn,resultA] = checkA(eqn); - result = result &&resultA; - case {'E','e'} - [eqn,resultE] = checkE(eqn); + case {'A', 'a'} + [eqn, resultA] = checkA(eqn, opts); + result = result && resultA; + case {'E', 'e'} + [eqn, resultE] = checkE(eqn, opts); result = result && resultE; otherwise - error('MESS:control_data','flag2 has to be ''A'' or ''E'''); + mess_err(opts, 'control_data', ... + 'flag2 has to be ''A'' or ''E'''); end otherwise - error('MESS:control_data','flag1 has to be ''A'' or ''E'''); + mess_err(opts, 'control_data', ... + 'flag1 has to be ''A'' or ''E'''); end end end -%checkdata for A -function [eqn,result] = checkA(eqn) -result = isfield(eqn,'K_') && isfield(eqn,'E_'); -if(result) - result = isnumeric(eqn.K_) && isnumeric(eqn.E_)... - && issymmetric(eqn.M_) && issymmetric(eqn.K_); - if(not(issparse(eqn.K_)) || not(issymmetric(eqn.K_))) - warning('MESS:control_data','K must be sparse and symmetric'); +% checkdata for A +function [eqn, result] = checkA(eqn, opts) +result = isfield(eqn, 'K_') && isfield(eqn, 'E_'); +if result + result = isnumeric(eqn.K_) && isnumeric(eqn.E_) && ... + issymmetric(eqn.M_) && issymmetric(eqn.K_); + if not(issparse(eqn.K_)) || not(issymmetric(eqn.K_)) + mess_warn(opts, 'control_data', ... + 'K must be sparse and symmetric'); end - if(not(issparse(eqn.E_)) || not(issymmetric(eqn.E_))) - warning('MESS:control_data','E must be sparse and symmetric'); + if not(issparse(eqn.E_)) || not(issymmetric(eqn.E_)) + mess_warn(opts, 'control_data', ... + 'E must be sparse and symmetric'); end end end -%checkdata for E -function [eqn,result] = checkE(eqn) -result = isfield(eqn,'M_')&&isfield(eqn,'K_'); -if(result) - result = isnumeric(eqn.M_) && isnumeric(eqn.K_) ... - &&issymmetric(eqn.M_) && issymmetric(eqn.K_); - if(not(issparse(eqn.M_)) || not(issymmetric(eqn.M_))) - warning('MESS:control_data','M must be sparse and symmetric'); +% checkdata for E +function [eqn, result] = checkE(eqn, opts) +result = isfield(eqn, 'M_') && isfield(eqn, 'K_'); +if result + result = isnumeric(eqn.M_) && isnumeric(eqn.K_) && ... + issymmetric(eqn.M_) && issymmetric(eqn.K_); + if not(issparse(eqn.M_)) || not(issymmetric(eqn.M_)) + mess_warn(opts, 'control_data', ... + 'M must be sparse and symmetric'); end - if(not(issparse(eqn.K_)) || not(issymmetric(eqn.K_))) - warning('MESS:control_data','K must be sparse and symmetric'); + if not(issparse(eqn.K_)) || not(issymmetric(eqn.K_)) + mess_warn(opts, 'control_data', ... + 'K must be sparse and symmetric'); end end end diff --git a/usfs/so_2/mess_usfs_so_2.m b/usfs/so_2/mess_usfs_so_2.m index 394da37..646cccc 100644 --- a/usfs/so_2/mess_usfs_so_2.m +++ b/usfs/so_2/mess_usfs_so_2.m @@ -41,7 +41,7 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % diff --git a/usfs/so_2/mul_A_so_2.m b/usfs/so_2/mul_A_so_2.m index a43a6de..e34b822 100644 --- a/usfs/so_2/mul_A_so_2.m +++ b/usfs/so_2/mul_A_so_2.m @@ -1,4 +1,4 @@ -function C=mul_A_so_2(eqn, opts,opA,B,opB)%#ok +function C = mul_A_so_2(eqn, opts, opA, B, opB) % function C=mul_A_so_2(eqn, opts,opA,B,opB) % % Call help mess_usfs_so_2 to see the description of the second order @@ -32,63 +32,65 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - - %% check input parameters -if (not(ischar(opA)) || not(ischar(opB))) - error('MESS:error_arguments', 'opA or opB is not a char'); +if not(ischar(opA)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opA or opB is not a char'); end -opA = upper(opA); opB = upper(opB); -if(not((opA=='N' || opA=='T'))) - error('MESS:error_arguments','opA is not ''N'' or ''T'''); +opA = upper(opA); +opB = upper(opB); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if(not((opB=='N' || opB=='T'))) - error('MESS:error_arguments','opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -if(not(isfield(eqn,'K_')) || not(isnumeric(eqn.K_)) || not(isfield(eqn,'M_')) ... - || not(isnumeric(eqn.M_))) - error('MESS:error_arguments',... - 'A consists of K and M, field eqn.K_ or eqn.M_ is not defined'); +if not(isfield(eqn, 'K_')) || not(isnumeric(eqn.K_)) || ... + not(isfield(eqn, 'M_')) || not(isnumeric(eqn.M_)) + mess_err(opts, 'error_arguments', ... + 'A consists of K and M, field eqn.K_ or eqn.M_ is not defined'); end - [rowK, colK] = size(eqn.K_); -colA = 2*colK; +colA = 2 * colK; %% perform multiplication switch opB % implement operation A*B = C case 'N' - if(colA ~= size(B,1)) - error('MESS:error_arguments','number of columns of A differs with number of rows of B'); + if not(colA == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['number of columns of A differs with number ' ... + 'of rows of B']); end - C = [-eqn.K_*B(1:rowK,:) ;... - eqn.M_*B(rowK+1:end,:)]; + C = [-eqn.K_ * B(1:rowK, :); ... + eqn.M_ * B(rowK + 1:end, :)]; - % implement operation A*B' = C + % implement operation A*B' = C case 'T' - if(colA ~= size(B,2)) - error('MESS:error_arguments','number of columns of A differs with number of columns of B'); + if not(colA == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of columns of A differs with number ' ... + 'of columns of B']); end - C = [-eqn.K_*B(:,1:colK)';... - eqn.M_*B(:,colK+1:end)']; + C = [-eqn.K_ * B(:, 1:colK)'; ... + eqn.M_ * B(:, colK + 1:end)']; end end diff --git a/usfs/so_2/mul_ApE_so_2.m b/usfs/so_2/mul_ApE_so_2.m index d2e8182..3d6f523 100644 --- a/usfs/so_2/mul_ApE_so_2.m +++ b/usfs/so_2/mul_ApE_so_2.m @@ -1,5 +1,4 @@ -function C=mul_ApE_so_2(eqn, opts,opA,p,opE,B,opB)%#ok -% function C=mul_ApE_so_2(eqn, opts,opA,p,opE,B,opB) +function C = mul_ApE_so_2(eqn, opts, opA, p, opE, B, opB) % function C=mul_ApE_so_2(eqn, opts,opA,p,opE,B,opB) % % Call help mess_usfs_so_2 to see the description of the second order % system and its transformed first order system @@ -38,77 +37,78 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - - %% check input parameters -if (not(ischar(opA)) || not(ischar(opB)) || not(ischar(opE))) - error('MESS:error_arguments', 'opA, opB or opE is not a char'); +if not(ischar(opA)) || not(ischar(opB)) || not(ischar(opE)) + mess_err(opts, 'error_arguments', 'opA, opB or opE is not a char'); end -opA = upper(opA); opB = upper(opB); opE = upper(opE); +opA = upper(opA); +opB = upper(opB); +opE = upper(opE); -if(not((opA=='N' || opA=='T'))) - error('MESS:error_arguments','opA is not ''N'' or ''T'''); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if(not((opB=='N' || opB=='T'))) - error('MESS:error_arguments','opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end -if(not((opE=='N' || opE=='T'))) - error('MESS:error_arguments','opE is not ''N'' or ''T'''); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end -if(not(isnumeric(p))) - error('MESS:error_arguments','p is not numeric'); +if not(isnumeric(p)) + mess_err(opts, 'error_arguments', 'p is not numeric'); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end - %% check data in eqn structure -if not(isfield(eqn, 'haveE')), eqn.haveE = 0; end -if(eqn.haveE ==1) - if(not(isfield(eqn,'M_')) || not(isnumeric(eqn.M_)) || not(isfield(eqn,'E_')) || ... - not(isnumeric(eqn.E_)) || not(isfield(eqn,'K_')) || not(isnumeric(eqn.K_))) - error('MESS:error_arguments',... - 'field eqn.M_, eqn.E_ or eqn.K_ is not defined or corrupted'); +if not(isfield(eqn, 'haveE')) + eqn.haveE = false; +end +if eqn.haveE + if not(isfield(eqn, 'M_')) || not(isnumeric(eqn.M_)) || not(isfield(eqn, 'E_')) || ... + not(isnumeric(eqn.E_)) || not(isfield(eqn, 'K_')) || not(isnumeric(eqn.K_)) + mess_err(opts, 'error_arguments', ... + 'field eqn.M_, eqn.E_ or eqn.K_ is not defined or corrupted'); end else - error('MESS:error_arguments',['eqn.haveE has to be 1 because of ' ... - 'the structure of E']); + mess_err(opts, 'error_arguments', ['eqn.haveE has to be 1 because of ' ... + 'the structure of E']); end [rowK, colK] = size(eqn.K_); -colA = 2*colK; +colA = 2 * colK; %% perform multiplication switch opB % implement operation (A+p*E)*B = C case 'N' - if(colA ~= size(B,1)) - error('MESS:error_arguments',['number of columns of A ' ... - 'differs with number of rows of B']); + if not(colA == size(B, 1)) + mess_err(opts, 'error_arguments', ... + 'number of columns of A differs from number of rows of B'); end - temp = p*eqn.M_; - C = [ (p*eqn.E_ -eqn.K_)*B(1:rowK,:) + temp*B(rowK+1:end,:); ... - temp*B(1:rowK,:) + eqn.M_*B(rowK+1:end,:)]; - % implement operation (A+p*E)*B'= C + temp = p * eqn.M_; + C = [(p * eqn.E_ - eqn.K_) * B(1:rowK, :) + temp * B(rowK + 1:end, :); ... + temp * B(1:rowK, :) + eqn.M_ * B(rowK + 1:end, :)]; + % implement operation (A+p*E)*B'= C case 'T' - if(colA ~= size(B,2)) - error('MESS:error_arguments',['number of columns of A ' ... - 'differs with number of columns of B']); + if not(colA == size(B, 2)) + mess_err(opts, 'error_arguments', ... + 'number of columns of A differs with number of columns of B'); end - temp = p*eqn.M_; - C = [(p*eqn.E_ - eqn.K_)*B(:,1:rowK)' + temp*B(:,rowK+1:end)';... - temp*B(:,1:rowK)' + eqn.M_*B(:,rowK+1:end)']; + temp = p * eqn.M_; + C = [(p * eqn.E_ - eqn.K_) * B(:, 1:rowK)' + temp * B(:, rowK + 1:end)'; ... + temp * B(:, 1:rowK)' + eqn.M_ * B(:, rowK + 1:end)']; end end diff --git a/usfs/so_2/mul_E_so_2.m b/usfs/so_2/mul_E_so_2.m index 66ae18d..b9ef2e3 100644 --- a/usfs/so_2/mul_E_so_2.m +++ b/usfs/so_2/mul_E_so_2.m @@ -1,4 +1,4 @@ -function C=mul_E_so_2(eqn, opts,opE,B,opB)%#ok +function C = mul_E_so_2(eqn, opts, opE, B, opB) % function C=mul_E_so_2(eqn, opts,opE,B,opB) % @@ -33,62 +33,65 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - - %% check input parameters -if (not(ischar(opE)) || not(ischar(opB))) - error('MESS:error_arguments', 'opE or opB is not a char'); +if not(ischar(opE)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opE or opB is not a char'); end -opE = upper(opE); opB = upper(opB); -if(not((opE=='N' || opE=='T'))) - error('MESS:error_arguments','opE is not ''N'' or ''T'''); +opE = upper(opE); +opB = upper(opB); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end -if(not((opB=='N' || opB=='T'))) - error('MESS:error_arguments','opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -if(not(isfield(eqn,'E_')) || not(isnumeric(eqn.E_)) ... - || not(isfield(eqn,'M_')) || not(isnumeric(eqn.M_))) - error('MESS:error_arguments',... - 'E consists of D and M, field eqn.E_ or eqn.M_ is not defined'); +if not(isfield(eqn, 'E_')) || not(isnumeric(eqn.E_)) || ... + not(isfield(eqn, 'M_')) || not(isnumeric(eqn.M_)) + mess_err(opts, 'error_arguments', ... + 'E consists of D and M, field eqn.E_ or eqn.M_ is not defined'); end -if not(isfield(eqn,'K_')) || not(isnumeric(eqn.K_)) - error('MESS:error_arguments',... - 'Field eqn.K_ is not defined or corrupted'); +if not(isfield(eqn, 'K_')) || not(isnumeric(eqn.K_)) + mess_err(opts, 'error_arguments', ... + 'Field eqn.K_ is not defined or corrupted'); end [rowK, colK] = size(eqn.K_); -colE = 2*colK; +colE = 2 * colK; %% perform multiplication switch opB % implement operation E*B = C case 'N' - if(colE ~= size(B,1)) - error('MESS:error_arguments','number of columns of E differs with number of rows of B'); + if not(colE == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['number of columns of E differs with number ' ... + 'of rows of B']); end - C = [ eqn.E_*B(1:rowK,:) + eqn.M_*B(rowK+1:end,:);... - eqn.M_*B(1:rowK,:)]; + C = [eqn.E_ * B(1:rowK, :) + eqn.M_ * B(rowK + 1:end, :); ... + eqn.M_ * B(1:rowK, :)]; - % implement operation E*B' = C + % implement operation E*B' = C case 'T' - if(colE ~= size(B,2)) - error('MESS:error_arguments','number of columns of E differs with number of columns of B'); + if not(colE == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of columns of E differs with number ' ... + 'of columns of B']); end - C = [eqn.E_*B(:,1:rowK)' + eqn.M_*B(:,rowK+1:end)';... - eqn.M_*B(:,1:rowK)']; + C = [eqn.E_ * B(:, 1:rowK)' + eqn.M_ * B(:, rowK + 1:end)'; ... + eqn.M_ * B(:, 1:rowK)']; end end diff --git a/usfs/so_2/size_so_2.m b/usfs/so_2/size_so_2.m index e237bfc..da1ff6d 100644 --- a/usfs/so_2/size_so_2.m +++ b/usfs/so_2/size_so_2.m @@ -1,4 +1,4 @@ -function n = size_so_2(eqn, opts)%#ok +function n = size_so_2(eqn, opts, oper) %#ok % function n = size_so_2(eqn, opts) % @@ -22,18 +22,18 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % %% check data -if not(isfield(eqn,'K_')) || not(isnumeric(eqn.K_)) - error('MESS:error_arguments',... - 'Field eqn.K_ is not defined or corrupted'); +if not(isfield(eqn, 'K_')) || not(isnumeric(eqn.K_)) + mess_err(opts, 'error_arguments', ... + 'Field eqn.K_ is not defined or corrupted'); end %% compute size -n = 2*size(eqn.K_,1); +n = 2 * size(eqn.K_, 1); end diff --git a/usfs/so_2/sol_A_so_2.m b/usfs/so_2/sol_A_so_2.m index c957614..a408e6c 100644 --- a/usfs/so_2/sol_A_so_2.m +++ b/usfs/so_2/sol_A_so_2.m @@ -1,4 +1,4 @@ -function X=sol_A_so_2(eqn, opts,opA,B,opB)%#ok +function X = sol_A_so_2(eqn, opts, opA, B, opB) % function X=sol_A_so_2(eqn, opts,opA,B,opB) % % Call help mess_usfs_so_2 to see the description of the second order @@ -31,62 +31,64 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input parameters -if (not(ischar(opA)) || not(ischar(opB))) - error('MESS:error_arguments', 'opA or opB is not a char'); +if not(ischar(opA)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opA or opB is not a char'); end -opA = upper(opA); opB = upper(opB); -if(not((opA=='N' || opA=='T'))) - error('MESS:error_arguments','opA is not ''N'' or ''T'''); +opA = upper(opA); +opB = upper(opB); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if(not((opB=='N' || opB=='T'))) - error('MESS:error_arguments','opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -if(not(isfield(eqn,'K_')) || not(isnumeric(eqn.K_)) || not(isfield(eqn,'M_')) ... - || not(isnumeric(eqn.M_))) - error('MESS:error_arguments',... - 'A consists of K and M, field eqn.K_ or eqn.M_ is not defined'); +if not(isfield(eqn, 'K_')) || not(isnumeric(eqn.K_)) || ... + not(isfield(eqn, 'M_')) || not(isnumeric(eqn.M_)) + mess_err(opts, 'error_arguments', ... + 'A consists of K and M, field eqn.K_ or eqn.M_ is not defined'); end rowK = size(eqn.K_, 1); -rowA = 2*rowK; +rowA = 2 * rowK; %% perform solve operations switch opB % implement solve A*X = B case 'N' - if (rowA ~= size(B,1)) - error('MESS:error_arguments','number of rows of A differs with number of rows of B'); + if not(rowA == size(B, 1)) + mess_err(opts, 'error_arguments', ... + 'number of rows of A differs with number of rows of B'); end - X1 = eqn.K_\B(1:rowK,:); - X2 = eqn.M_\B(rowK+1:end,:); - X = [-X1;X2]; + X1 = eqn.K_ \ B(1:rowK, :); + X2 = eqn.M_ \ B(rowK + 1:end, :); + X = [-X1; X2]; - % implement solve A*X = B' + % implement solve A*X = B' case 'T' - if(rowA ~= size(B,2)) - error('MESS:error_arguments','number of rows of A differs with number of columns of B'); + if not(rowA == size(B, 2)) + mess_err(opts, 'error_arguments', ... + 'number of rows of A differs with number of columns of B'); end - X1 = eqn.K_\B(:,1:rowK)'; - X2 = eqn.M_\B(:,rowK+1:end)'; - X = [-X1;X2]; + X1 = eqn.K_ \ B(:, 1:rowK)'; + X2 = eqn.M_ \ B(:, rowK + 1:end)'; + X = [-X1; X2]; end end diff --git a/usfs/so_2/sol_ApE_so_2.m b/usfs/so_2/sol_ApE_so_2.m index e1c0445..c032267 100644 --- a/usfs/so_2/sol_ApE_so_2.m +++ b/usfs/so_2/sol_ApE_so_2.m @@ -1,4 +1,4 @@ -function X=sol_ApE_so_2(eqn, opts,opA,p,opE,B,opB)%#ok +function X = sol_ApE_so_2(eqn, opts, opA, p, opE, B, opB) % function X=sol_ApE_so_2(eqn, opts,opA,p,opE,C,opC) % % Call help mess_usfs_so_2 to see the description of the second order @@ -38,76 +38,81 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input parameters -if (not(ischar(opA)) || not(ischar(opE)) || not(ischar(opB))) - error('MESS:error_arguments', 'opA, opE or opC is not a char'); +if not(ischar(opA)) || not(ischar(opE)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opA, opE or opC is not a char'); end -opA = upper(opA); opE = upper(opE); opB = upper(opB); +opA = upper(opA); +opE = upper(opE); +opB = upper(opB); -if(not((opA=='N' || opA=='T'))) - error('MESS:error_arguments','opA is not ''N'' or ''T'''); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); end -if(not((opE=='N' || opE=='T'))) - error('MESS:error_arguments','opE is not ''N'' or ''T'''); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end -if(not((opB=='N' || opB=='T'))) - error('MESS:error_arguments','opC is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opC is not ''N'' or ''T'''); end -if(not(isnumeric(p))) - error('MESS:error_arguments','p is not numeric'); +if not(isnumeric(p)) + mess_err(opts, 'error_arguments', 'p is not numeric'); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -if not(isfield(eqn, 'haveE')), eqn.haveE = 0; end -if(eqn.haveE ==1) - if(not(isfield(eqn,'M_')) || not(isnumeric(eqn.M_)) || not(isfield(eqn,'E_')) || ... - not(isnumeric(eqn.E_)) || not(isfield(eqn,'K_')) || not(isnumeric(eqn.K_))) - error('MESS:error_arguments',... - 'field eqn.M_, eqn.E_ or eqn.K_ is not defined or corrupted'); +if not(isfield(eqn, 'haveE')) + eqn.haveE = false; +end +if eqn.haveE + if not(isfield(eqn, 'M_')) || not(isnumeric(eqn.M_)) || ... + not(isfield(eqn, 'E_')) || not(isnumeric(eqn.E_)) || ... + not(isfield(eqn, 'K_')) || not(isnumeric(eqn.K_)) + mess_err(opts, 'error_arguments', ... + 'field eqn.M_, eqn.E_ or eqn.K_ is not defined or corrupted'); end else - error('MESS:error_arguments',['eqn.haveE has to be 1 because of ' ... - 'the structure of E']); + mess_err(opts, 'error_arguments', ... + 'eqn.haveE has to be 1 because of the structure of E'); end rowK = size(eqn.K_, 1); -rowA = 2*rowK; +rowA = 2 * rowK; %% perform solve operations switch opB % implement solve (A+p*E)*X = B case 'N' - if (rowA ~= size(B,1)) - error('MESS:error_arguments',['number of rows of A differs ' ... - 'with number of rows of B']); + if not(rowA == size(B, 1)) + mess_err(opts, 'error_arguments', ... + 'number of rows of A differs from number of rows of B'); end - temp = p*eqn.E_ - eqn.K_; - X1 = (p^2*eqn.M_ - temp)\(p*B(rowK+1:end,:) - B(1:rowK,:)); - X2 = (p*eqn.M_)\(B(1:rowK,:) - temp*X1); - X = [X1;X2]; + temp = p * eqn.E_ - eqn.K_; + X1 = (p^2 * eqn.M_ - temp) \ (p * B(rowK + 1:end, :) - B(1:rowK, :)); + X2 = (p * eqn.M_) \ (B(1:rowK, :) - temp * X1); + X = [X1; X2]; - % implement solve (A+p*E)*X = B' + % implement solve (A+p*E)*X = B' case 'T' - if (rowA ~= size(B,2)) - error('MESS:error_arguments',['number of rows of A differs ' ... - 'with number of columns of B']); + if not(rowA == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of rows of A differs ' ... + 'from number of columns of B']); end - temp = p*eqn.E_ -eqn.K_; - X1 = (p^2*eqn.M_ - temp)\(p*B(:,rowK+1:end)' - B(:,1:rowK)'); - X2 = (p*eqn.M_)\(B(:,1:rowK)' - temp*X1); - X = [X1;X2]; + temp = p * eqn.E_ - eqn.K_; + X1 = (p^2 * eqn.M_ - temp) \ (p * B(:, rowK + 1:end)' - B(:, 1:rowK)'); + X2 = (p * eqn.M_) \ (B(:, 1:rowK)' - temp * X1); + X = [X1; X2]; end diff --git a/usfs/so_2/sol_E_so_2.m b/usfs/so_2/sol_E_so_2.m index cfeb46b..d81975b 100644 --- a/usfs/so_2/sol_E_so_2.m +++ b/usfs/so_2/sol_E_so_2.m @@ -1,11 +1,12 @@ -function X=sol_E_so_2(eqn, opts,opE,B,opB)%#ok +function X = sol_E_so_2(eqn, opts, opE, B, opB) % function X=sol_E_so_2(eqn, opts,opE,B,opB) % % Call help mess_usfs_so_2 to see the description of the second order % system and its transformed first order system % % -% This function returns X= E\B, where matrix E given by structure eqn and input matrix B could be transposed. +% This function returns X= E\B, where matrix E given by structure +% eqn and input matrix B could be transposed. % % Inputs: % eqn structure containing data for matrix E (fields 'E_' and 'M_') @@ -30,43 +31,42 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% check input parameters -if (not(ischar(opE)) || not(ischar(opB))) - error('MESS:error_arguments', 'opE or opB is not a char'); +if not(ischar(opE)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opE or opB is not a char'); end -opE = upper(opE); opB = upper(opB); -if(not((opE=='N' || opE=='T'))) - error('MESS:error_arguments','opE is not ''N'' or ''T'''); +opE = upper(opE); +opB = upper(opB); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); end -if(not((opB=='N' || opB=='T'))) - error('MESS:error_arguments','opB is not ''N'' or ''T'''); +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); end if (not(isnumeric(B))) || (not(ismatrix(B))) - error('MESS:error_arguments','B has to ba a matrix'); + mess_err(opts, 'error_arguments', 'B has to ba a matrix'); end %% check data in eqn structure -if(not(isfield(eqn,'E_')) || not(isnumeric(eqn.E_)) ... - || not(isfield(eqn,'M_')) || not(isnumeric(eqn.M_))) - error('MESS:error_arguments',... - 'E consists of D and M, field eqn.E_ or eqn.M_ is not defined'); +if not(isfield(eqn, 'E_')) || not(isnumeric(eqn.E_)) || ... + not(isfield(eqn, 'M_')) || not(isnumeric(eqn.M_)) + mess_err(opts, 'error_arguments', ... + 'E consists of D and M, field eqn.E_ or eqn.M_ is not defined'); end -if not(isfield(eqn,'K_')) || not(isnumeric(eqn.K_)) - error('MESS:error_arguments',... - 'Field eqn.K_ is not defined or corrupted'); +if not(isfield(eqn, 'K_')) || not(isnumeric(eqn.K_)) + mess_err(opts, 'error_arguments', ... + 'Field eqn.K_ is not defined or corrupted'); end - rowK = size(eqn.K_, 1); -rowE = 2*rowK; +rowE = 2 * rowK; %% perform solve operations switch opB @@ -74,24 +74,26 @@ % implement solve E*X = B case 'N' - if(rowE ~= size(B,1)) - error('MESS:error_arguments','number of rows of E differ with number of rows of B') + if not(rowE == size(B, 1)) + mess_err(opts, 'error_arguments', ... + 'number of rows of E differ with number of rows of B'); end - X1 = eqn.M_\B(rowK+1:end,:); - X2 = eqn.M_\(B(1:rowK,:)-eqn.E_*X1); - X = [X1;X2]; + X1 = eqn.M_ \ B(rowK + 1:end, :); + X2 = eqn.M_ \ (B(1:rowK, :) - eqn.E_ * X1); + X = [X1; X2]; - % implement solve E*X = B' + % implement solve E*X = B' case 'T' - if(rowE ~= size(B,2)) - error('MESS:error_arguments','number of rows of E differs with number of columns of B') + if not(rowE == size(B, 2)) + mess_err(opts, 'error_arguments', ... + 'number of rows of E differs with number of columns of B'); end - X1 = eqn.M_\B(:,rowK+1:end)'; - X2 = eqn.M_\(B(:,1:rowK)' - eqn.E_*X1); - X = [X1;X2]; + X1 = eqn.M_ \ B(:, rowK + 1:end)'; + X2 = eqn.M_ \ (B(:, 1:rowK)' - eqn.E_ * X1); + X = [X1; X2]; end diff --git a/usfs/so_iter/init_res_so_iter.m b/usfs/so_iter/init_res_so_iter.m new file mode 100644 index 0000000..0d98db8 --- /dev/null +++ b/usfs/so_iter/init_res_so_iter.m @@ -0,0 +1,56 @@ +function [W, res0, eqn, opts, oper] = ... + init_res_so_iter(eqn, opts, oper, W, T) +%% Function init_res_so_iter initializes the low-rank residual W and res0 +% function [ W, res0, eqn, opts, oper ] = ... +% init_res_so_iter( eqn, opts, oper, W, T) +% +% This function returns the initial residual factor W and its +% associated norm res0. +% +% Input/Output: +% +% eqn structure containing data for G or B or C +% opts structure containing parameters for the algorithm +% oper structure contains function handles for operation with A and E +% W right hand side matrix +% T (optional, defaults to the identity) +% +% Outputs: +% +% W matrix given by ADI to compute residuum +% res0 initial residuum norm +% +% This function does not use other so_iter functions. +% + +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% +%% Check input data. +if (not(isnumeric(W))) || (not(ismatrix(W))) + mess_err(opts, 'error_arguments', 'W has to ba a matrix'); +end + +%% Compute res0. +if not(exist('T', 'var')) && opts.LDL_T + % this means we only use init_res for potential projection + return +end + +if isfield(opts, 'nm') && isfield(opts.nm, 'res0') + res0 = opts.nm.res0; +else + if opts.LDL_T + if opts.norm == 2 + res0 = max(abs(eig(W' * W * T))); + else + res0 = norm(eig(W' * W * T), 'fro'); + end + else + res0 = norm(W' * W, opts.norm); + end +end +end diff --git a/usfs/so_iter/init_so_iter.m b/usfs/so_iter/init_so_iter.m new file mode 100644 index 0000000..b25cbe4 --- /dev/null +++ b/usfs/so_iter/init_so_iter.m @@ -0,0 +1,398 @@ +function [result, eqn, opts, oper] = init_so_iter(eqn, opts, oper, flag1, flag2) + +% function [result, eqn, opts, oper] = init_so_iter(eqn, opts, oper, flag1, flag2) +% +% The function returns true or false if data for A_ and E_ +% resp. flag1 and flag2 are available and correct in structure +% eqn. +% +% Input: +% +% eqn structure with data +% opts structure containing parameter for the algorithm +% oper structure contains function handles for operation with A and E +% flag1 'A'/'E' to check if A or E is in eqn +% flag2 'A'/'E' to check if A or E is in eqn +% +% Output: +% +% result 1 if data corresponding to flag1 (and flag2) +% is available , 0 if data is not available +% eqn structure with data +% opts structure containing parameter for the algorithm +% oper structure contains function handles for operation with A and E +% +% This function does not use other default functions. +% +% This function calls two other functions checkA and checkE +% implemented at the end. +% +% The function checkA(eqn) proves if a field 'A_' is included in +% the structure eqn and if the field 'A_' is numeric and +% quadratic. +% +% The function checkE(eqn) proves if a field 'E_' is included in +% the structure eqn and if the field 'E_' is numeric and +% quadratic. +% If the structure does not include a field E, a new field 'E_' +% is defined as a sparse identity matrix by size of field 'A_'. +% + +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +%% Calculate Alpha +mfun = @(x) (eqn.M_ * x + eqn.E_ * (eqn.K_ \ (eqn.E_ * x)) / 4); +colD = size(eqn.E_, 1); +opts.usfs.so_iter.alpha = 1 / (2 * eigs(mfun, colD, eqn.E_, 1, 'LR')); + +%% Check input Parameters +% Check if M is positive definite + +if isfield(eqn, 'M_') + if issymmetric(eqn.M_) + opts.usfs.so_iter.M_is_sym = true; + if not(any(diag(eqn.M_ <= 0))) + opts.usfs.so_iter.M_is_spd = true; + else + opts.usfs.so_iter.M_is_spd = false; + end + else + opts.usfs.so_iter.M_is_sym = false; + opts.usfs.so_iter.M_is_spd = false; + end +end + +% Check if E is positive definite + +if isfield(eqn, 'E_') + if issymmetric(eqn.E_) + opts.usfs.so_iter.E_is_sym = true; + if not(any(diag(eqn.E_ <= 0))) + opts.usfs.so_iter.E_is_spd = true; + else + opts.usfs.so_iter.E_is_spd = false; + end + else + opts.usfs.so_iter.E_is_sym = false; + opts.usfs.so_iter.E_is_spd = false; + end +end + +% Check if K is positive definite + +if isfield(eqn, 'K_') + if issymmetric(eqn.K_) + opts.usfs.so_iter.K_is_sym = true; + if not(any(diag(eqn.K_ <= 0))) + opts.usfs.so_iter.K_is_spd = true; + else + opts.usfs.so_iter.K_is_spd = false; + end + else + opts.usfs.so_iter.K_is_sym = false; + opts.usfs.so_iter.K_is_spd = false; + end +end + +% Verification checks, to determine if a proper alpha has been selected. + +% E is positive definite iff: +% i) M > 0, which is true by assumption, +% ii) K–α2M > 0, +% iii) Since E is built symmetric plus the previous 2 conditions, it becomes spd +if not(any(diag(eqn.M_ <= 0))) + if not(any(diag((eqn.K_ - 2 * opts.usfs.so_iter.alpha * eqn.M_) <= 0))) + opts.usfs.so_iter.E_is_spd = true; + else + opts.usfs.so_iter.E_is_spd = false; + end +else + opts.usfs.so_iter.E_is_spd = false; +end + +% A is negative definite iff +% i) –αK < 0, which is true by assumption, +% ii) – D + α ( M + 1/4 (D*(K^-1)* D ) < 0 , +% iii) A is built NO symmetric plus the previous 2 conditions, it becomes NO spd. +if any(diag((-opts.usfs.so_iter.alpha * eqn.K_) < 0)) + if any(-eqn.E_ + opts.usfs.so_iter.alpha * (eqn.M_ + ... + (eqn.E_ * (eqn.K_^-1) * eqn.E_) / 4)) + opts.usfs.so_iter.A_is_spd = 0; + else + opts.usfs.so_iter.A_is_spd = -1; + mess_warn(opts, 'control_data', 'A is not negative definite'); + end +else + opts.usfs.so_iter.A_is_spd = -1; +end + +% Required fields for the iterative solver +if not(isfield(opts, 'usfs')) || not(isfield(opts.usfs, 'so_iter')) + + mess_warn(opts, 'control_data', [' The ''so_iter'' usfs need the ', ... + '''opts.usfs.so_iter'' substructure to be present.']); + +end + +% Check for the solver used +if isfield(opts.usfs.so_iter, 'method_A') + if not(exist(opts.usfs.so_iter.method_A, 'file') == 2) + mess_err(opts, 'control_data', ['Iterative solver method field ''method_A''', ... + ' is an unsupported solver.']); + end +else + mess_warn(opts, 'control_data', ['Iterative solver method field ''method_A''', ... + ' is unset. Falling back to GMRES.']); + opts.usfs.so_iter.method_A = 'gmres'; + +end + +if isfield(opts.usfs.so_iter, 'method_E') + if not(exist(opts.usfs.so_iter.method_E, 'file') == 2) + mess_err(opts, 'control_data', ['Iterative solver method field ''method_E''', ... + ' is an unsupported solver.']); + end +else + if opts.usfs.so_iter.K_is_spd && opts.usfs.so_iter.M_is_spd + mess_warn(opts, 'control_data', ['Iterative solver method field ''method_E''', ... + ' is unset. Falling back to PCG.']); + opts.usfs.so_iter.method_E = 'pcg'; + + else + mess_warn(opts, 'control_data', ['Iterative solver method field ''method_E''', ... + ' is unset. Falling back to GMRES.']); + opts.usfs.so_iter.method_E = 'gmres'; + end +end + +% Required residual tolerance for stopping the iterative solver +if isfield(opts.usfs.so_iter, 'res_tol') + if opts.usfs.so_iter.res_tol < 0 + mess_err(opts, 'control_data', ['Iterative solver residual tolerance value', ... + 'is invalid']); + end +else + mess_warn(opts, 'control_data', ['Iterative solver residual tolerance value not', ... + ' found. Falling back to default']); + opts.usfs.so_iter.res_tol = 1e-12; + +end + +% Number of iterations allowed + +if isfield(opts.usfs.so_iter, 'max_iter') + if opts.usfs.so_iter.max_iter < 0 + mess_err(opts, 'control_data', ['Iterative solver max. iterations', ... + 'is invalid']); + end +else + mess_warn(opts, 'control_data', ['Iterative solver max. iterations not', ... + ' found. Falling back to default']); + opts.usfs.so_iter.max_iter = oper.size(eqn, opts, oper); + +end + +% Restart size for GMRES +if strcmpi(opts.usfs.so_iter.method_A, 'gmres') || ... + strcmpi(opts.usfs.so_iter.method_E, 'gmres') + + if isfield(opts.usfs.so_iter, 'restIter') + if opts.usfs.so_iter.restIter < 0 + mess_err(opts, 'control_data', ['GMRES restart iterations value', ... + 'is invalid']); + end + else + mess_warn(opts, 'control_data', ['GMRES restart iterations value not', ... + ' found. Falling back to default']); + opts.usfs.so_iter.restIter = 25; + end + +end + +%% Operations +na = nargin; +if isfield(eqn, 'LTV') + mess_warn(opts, 'not_implemented', ['''so_iter'' does not yet support', ... + ' LTV systems.']); +end +if na < 4 + mess_err(opts, 'control_data', 'Number of input Arguments are at least 4'); + +elseif nargin == 4 % result = init_so_iter(eqn, flag1); + switch flag1 + case {'A', 'a'} + [eqn, opts, result] = checkA(eqn, opts); + + case {'E', 'e'} + [eqn, opts, result] = checkE(eqn, opts); + + otherwise + mess_err(opts, 'control_data', 'flag1 has to be ''A_'' or ''E_'''); + end + +elseif nargin == 5 % result = init_so_iter(eqn,flag1,flag2); + switch flag1 + case {'A', 'a'} + [eqn, opts, result] = checkA(eqn, opts); + + switch flag2 + case {'A', 'a'} + case {'E', 'e'} + [eqn, opts, resultE] = checkE(eqn, opts); + result = result && resultE; + + otherwise + mess_err(opts, 'control_data', 'flag2 has to be ''A'' or ''E'''); + end + + case {'E', 'e'} + [eqn, opts, result] = checkE(eqn, opts); + + switch flag2 + case {'A', 'a'} + [eqn, opts, resultA] = checkA(eqn, opts); + result = result && resultA; + + case {'E', 'e'} + + otherwise + mess_err(opts, 'control_data', 'flag2 has to be ''A'' or ''E'''); + + end + + otherwise + mess_err(opts, 'control_data', 'flag1 has to be ''A'' or ''E'''); + + end + +end +end + +% Check data for A_ +function [eqn, opts, result] = checkA(eqn, opts) +% This function returns the changed structure eqn and a boolean +% value result (1 if 'A_' is in structure eqn and a numeric, symmetric and +% quadratic field, 0 otherwise). +% This function also defines the preconditioner for A_ by using +% ILU function. + +result = isfield(eqn, 'M_') && isfield(eqn, 'E_') && isfield(eqn, 'K_'); +if result + if not(opts.usfs.so_iter.M_is_spd) + mess_err(opts, 'control_data', ['The set of so_iter functions has only been' ... + 'implemented for systems where M is symmetric and positive definite']); + end + if not(opts.usfs.so_iter.E_is_spd) + mess_err(opts, 'control_data', ['The set of so_iter functions has only been' ... + 'implemented for systems where E is symmetric and positive definite']); + end + if not(opts.usfs.so_iter.K_is_spd) + mess_err(opts, 'control_data', ['The set of so_iter functions has only been' ... + 'implemented for systems where K is symmetric and positive definite']); + end +end + +if not(isfield(opts.usfs.so_iter, 'PA_R')) + + if not(isfield(opts.usfs.so_iter, 'PA_L')) + + mess_warn(opts, 'control_data', ['No preconditioner for A could be found.', ... + ' Switching to ICHOL/ILU']); + form_A = @(alpha)afun(alpha, eqn); + [L, U] = ilu(form_A(opts.usfs.so_iter.alpha)); + opts.usfs.so_iter.PA_L = L; + opts.usfs.so_iter.PA_R = U; + + else + + opts.usfs.so_iter.PA_R = []; + + end + +end + +end + +% Check data for E_ +function [eqn, opts, result] = checkE(eqn, opts) +% This function returns the changed structure eqn and a boolean +% value result (1 if 'E_' is in structure eqn and a numeric, symmetric and +% quadratic field, 0 otherwise). +% This function also defines the preconditioner for E_ by using ICHOL or +% ILU function, depending on whether E_ is symmetric and positive +% definite, or not. + +if not(isfield(eqn, 'haveE')) + eqn.haveE = false; +end % Does this still apply? + +% if not(eqn.haveE) +% if isfield(eqn, 'E_') +% mess_err(opts,'equation_data', ['Detected eqn.E_ where eqn.haveE ' ... +% 'is 0. You need to set haveE = true or ' ... +% 'delete E_.']); +% else +% result = true; +% end +% else + +result = isfield(eqn, 'M_') && isfield(eqn, 'K_'); +if result + if not(opts.usfs.so_iter.M_is_spd) + mess_err(opts, 'control_data', ['The set of so_iter functions has only been' ... + 'implemented for systems where M is symmetric and positive definite']); + end + if not(opts.usfs.so_iter.K_is_spd) + mess_err(opts, 'control_data', ['The set of so_iter functions has only been' ... + 'implemented for systems where K is symmetric and positive definite']); + end +end + +% Preconditioner for E +if not(isfield(opts.usfs.so_iter, 'PE_R')) + + if not(isfield(opts.usfs.so_iter, 'PE_L')) + + mess_warn(opts, 'control_data', ['No preconditioner for E could be', ... + ' found. Switching to ICHOL/ILU']); + form_E = @(alpha)efun(alpha, eqn); + if result + S = ichol(form_E(opts.usfs.so_iter.alpha)); + opts.usfs.so_iter.PE_L = S; + opts.usfs.so_iter.PE_R = S'; + + else + [L, U] = ilu(form_E(opts.usfs.so_iter.alpha)); + opts.usfs.so_iter.PE_L = L; + opts.usfs.so_iter.PE_R = U; + end + else + + opts.usfs.so_iter.PE_R = []; + + end + +end + +end + +function Y = afun(alpha, eqn) +% Y = afun(alpha, eqn) +% This is a function handler that accepts the parameter alpha and returns +% the matrix A_ for solving a second order system re-shaping it as a first +% order system. +Y = [-alpha * eqn.K_, eqn.K_ - alpha * eqn.E_; -eqn.K_, -eqn.E_ + alpha * eqn.E_]; +end + +function Y = efun(alpha, eqn) +% Y = efun(alpha, eqn) +% This is a function handler that accepts the parameter alpha and returns +% the matrix E_ for solving a second order system re-shaping it as a first +% order system. +Y = [eqn.K_, alpha * eqn.M_; alpha * eqn.M_, eqn.M_]; +end diff --git a/usfs/so_iter/mess_usfs_so_iter.m b/usfs/so_iter/mess_usfs_so_iter.m new file mode 100644 index 0000000..09d4d9a --- /dev/null +++ b/usfs/so_iter/mess_usfs_so_iter.m @@ -0,0 +1,96 @@ +% The second order system +% +% M*x"(t) + E*x'(t) + K*x(t) = B2*u(t), +% y(t) = Cp*x(t) + Cv*x'(t), +% +% is implicitly transformed to the first order system +% +% E_f*x_f' = A_f*x_f + B_f*u, +% y(t) = C_f*x_f, +% +% where +% +% | K αM | +% E_f = | αM M | , +% +% |-αK K-αE | +% A_f = | -K -E+αM |, +% +% | αB2| +% B_f = | B2|, +% +% C_f = |Cp Cv| +% +% | x | +% x_f = | x'|, +% +% and 0 < α < λ_min( E / (M+.25E*K\E) ), following [1] (Thm 6.1). +% +% The Matrix M, E, K are assumed to be symmetric positive definite and square. +% The fieldnames have to end with _ to indicate that the data are +% inputdata for the Algorithm. +% +% eqn.M_ = M +% eqn.K_ = K +% eqn.E_ = E +% eqn.B = B_f +% eqn.C = C_f +% +% In contrast to the other second order usfs, here all solve operations are +% performed using iterative solvers rather than "\". +% The `sol_*` calls will look into `opts.usfs.so_iter` for +% further setting. `opts.usfs.so_iter` is a structure with +% members: +% +% method_A the iterative solver function for solving with A +% +% method_ApE the iterative solver function for the shifted solves +% +% method_E the iterative solver function for solving with E +% +% all of these can currently be any suitable iterative solver from +% MATLAB or GNU Octave. we are regularly testing: +% +% matlab_solvers = {'bicg', 'bicgstab', 'bicgstabl', ... +% 'cgs', 'gmres', 'lsqr', 'minres', 'pcg', 'qmr', 'symmlq', 'tfqmr'}; +% octave_solvers = {'bicg', 'bicgstab', ... +% 'cgs', 'gmres', 'pcg', 'qmr', 'tfqmr', 'pcr'}; +% +% for `method_A` and `method_E`, while fixing `method_ApE = 'gmres'` +% +% Moreover, `opts.usfs.so_iter` should contain +% +% alpha α in the implicitly transformed system above +% +% res_tol residual tolerance passed to all iterative solvers +% +% max_iter maximum iteration number passed to all iterative solvers +% +% restIter restart length passed to GMRES +% +% PA_L, PA_R preconditioner matrices for A passed to the iterative +% solvers (as M1 and M2 in the default MATLAB +% iterative solver interface) +% PE_L, PE_R preconditioner matrices for E passed to the iterative +% solvers (as M1 and M2 in the default MATLAB +% iterative solver interface) +% +% `oper.init` will check, and, in case they are absent, initialize them +% with defaults. +% +% References: +% +% [1] H. K. F. Panzer, Model order reduction by Krylov subspace +% methods with global error bounds and automatic choice of +% parameters, Dissertation, Technische Universität München, +% Munich, Germany (2014). +% https://mediatum.ub.tum.de/doc/1207822/1207822.pdf +% + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% diff --git a/usfs/so_iter/mul_A_so_iter.m b/usfs/so_iter/mul_A_so_iter.m new file mode 100644 index 0000000..d83ce04 --- /dev/null +++ b/usfs/so_iter/mul_A_so_iter.m @@ -0,0 +1,117 @@ +function C = mul_A_so_iter(eqn, opts, opA, B, opB) +% function C=mul_A_so_iter_iter(eqn,opts,opA,B,opB) +% +% This function returns C = A_*B, where matrix A_ given by +% structure eqn and input matrix B could be transposed. +% Matrix A_ is assumed to be quadratic. +% +% Inputs: +% +% eqn structure containing field 'A_' +% opts structure containing parameters for the algorithm +% opA character specifying the shape of A_ +% opA = 'N' performs A_*opB(B) +% opA = 'T' performs A_'*opB(B) +% B m-x-p matrix +% opB character specifying the shape of B +% opB = 'N' performs opA(A_)*B +% opB = 'T' performs opA(A_)*B' +% +% Output: +% +% C = opA(A_)*opB(B) +% +% This function uses another so_iter function size_so_iter_iter(eqn, +% opts) to obtain the number of rows of matrix A_ in structure eqn, +% that should be equal to the number of rows of matrix E_. +% + +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% +%% Check input parameters +if not(ischar(opA)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opA or opB is not a char'); +end + +opA = upper(opA); +opB = upper(opB); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); +end + +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); +end + +if (not(isnumeric(B))) || (not(ismatrix(B))) + mess_err(opts, 'error_arguments', 'B has to be a matrix'); +end + +%% Check data in eqn structure +if not(isfield(eqn, 'M_') && isfield(eqn, 'E_') && isfield(eqn, 'K_')) + mess_err(opts, 'error_arguments', ... + 'field eqn.M_ or eqn.E_ or eqn.K_ is not defined'); +end + +rowM = size_so_iter(eqn, opts); +colM = 2 * rowM; +colK = 2 * size(eqn.K_, 1); +colD = 2 * size(eqn.E_, 1); +rowB = size(B, 1); +colB = size(B, 2); +n = rowB / 2; +alpha = opts.usfs.so_iter.alpha; + +%% Perform multiplication + +switch opB + + % Implement multiplication A_*B + case 'N' + if not(colM == size(B, 1)) % M and B/2 and K should agree in size + mess_err(opts, 'error_arguments', ... + ['number of columns of A differs from number ' ... + 'of rows of B']); + end + if not(colK == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['number of columns of A differs from number ' ... + 'of rows of B']); + end + if not(colD == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['number of columns of A differs from number ' ... + 'of rows of B']); + end + B_mat = [B(1:n, :), B(n + 1:rowB, :)]; + K_mat = eqn.K_ * B_mat; + C = [-alpha * K_mat(:, 1:colB) + K_mat(:, colB + 1:2 * colB) - alpha * eqn.E_ * B_mat(:, colB + 1:2 * colB) + -K_mat(:, 1:colB) - eqn.E_ * B_mat(:, colB + 1:2 * colB) + alpha * eqn.M_ * B_mat(:, colB + 1:2 * colB)]; + + % Implement multiplication A_*B' + case 'T' + if not(colM == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of columns of A differs from number ' ... + 'of columns of B']); + end + if not(colK == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of columns of A differs from number ' ... + 'of columns of B']); + end + if not(colD == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of columns of A differs from number ' ... + 'of columns of B']); + end + B_mat = [B(:, 1:colB / 2)', B(:, 1 + colB / 2:colB)']; + K_mat = eqn.K_ * B_mat; + C = [-alpha * K_mat(:, 1:colB) + K_mat(:, colB + 1:2 * colB) - alpha * eqn.E_ * B_mat(:, colB + 1:2 * colB) + -K_mat(:, 1:colB) - eqn.E_ * B_mat(:, colB + 1:2 * colB) + alpha * eqn.M_ * B_mat(:, colB + 1:2 * colB)]; +end +end diff --git a/usfs/so_iter/mul_ApE_so_iter.m b/usfs/so_iter/mul_ApE_so_iter.m new file mode 100644 index 0000000..b8b2c4b --- /dev/null +++ b/usfs/so_iter/mul_ApE_so_iter.m @@ -0,0 +1,145 @@ +function C = mul_ApE_so_iter(eqn, opts, opA, p, opE, B, opB) + +% function C=mul_ApE_so_iter_iter(eqn, opts,opA,p,opE,B,opB) +% +% This function returns C = (A_+p*E_)*B, where matrices A_ and E_ +% given by a structure eqn and input matrix B could be transposed. +% +% Inputs: +% +% eqn structure containing fields 'A_' and 'E_' +% opts structure containing parameters for the algorithm +% opA character specifying the shape of A_ +% opA = 'N' performs (A_ + p*opE(E_))*opB(B) +% opA = 'T' performs (A_' + p*opE(E_))*opB(B) +% p scalar value +% opE character specifying the shape of E_ +% opE = 'N' performs (opA(A_) + p*E_)*opB(B) +% opE = 'T' performs (opA(A_) + p*E_')*opB(B) +% B m-x-p matrix +% opB character specifying the shape of B +% opB = 'N' performs (opA(A_) + p*opE(E_))*B +% opB = 'T' performs (opA(A_) + p*opE(E_))*B' +% Output: +% +% C = (opA(A_)+ p * opE(E_))*opB(B) +% +% This function uses another so_iter function +% size_so_iter_iter(eqn,opts) to obtain the number of rows of matrix A_ +% in structure eqn, that should be equal to the number of rows of +% the matrix E_. +% + +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% +%% Check input parameters +if not(ischar(opA)) || not(ischar(opB)) || not(ischar(opE)) + mess_err(opts, 'error_arguments', 'opA, opB or opE is not a char'); +end + +opA = upper(opA); +opB = upper(opB); +opE = upper(opE); + +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); +end + +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); +end + +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); +end + +if (not(isnumeric(p))) || not(length(p) == 1) + mess_err(opts, 'error_arguments', 'p is not numeric or a scalar value'); +end + +if not(isfield(eqn, 'haveE')) + eqn.haveE = false; +end + +if (not(isnumeric(B))) || (not(ismatrix(B))) + mess_err(opts, 'error_arguments', 'B has to be a matrix'); +end + +%% Check data in eqn structure +if not(isfield(eqn, 'M_') && isfield(eqn, 'E_') && isfield(eqn, 'K_')) + mess_err(opts, 'error_arguments', ... + 'field eqn.M_ or eqn.E_ or eqn.K_ is not defined'); +end + +rowM = size_so_iter(eqn, opts); +colM = 2 * rowM; +colK = 2 * size(eqn.K_, 1); +colD = 2 * size(eqn.E_, 1); +rowB = size(B, 1); +colB = size(B, 2); +alpha = opts.usfs.so_iter.alpha; + +%% Perform multiplication when E_ is not the Identity + +switch opB + + % Implement operation (A + p * E)*B=C + case 'N' + + if not(colM == size(B, 1)) % M and B/2 and K should agree in size + mess_err(opts, 'error_arguments', ... + ['number of columns of A differs from number ' ... + 'of rows of B']); + end + if not(colK == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['number of columns of A differs from number ' ... + 'of rows of B']); + end + if not(colD == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['number of columns of A differs from number ' ... + 'of rows of B']); + end + B_mat = [B(1:(rowB / 2), :), B((rowB / 2) + 1:rowB, :)]; + K_mat = eqn.K_ * B_mat; + M_mat = eqn.M_ * B_mat; + D_x2 = eqn.E_ * B_mat(:, colB + 1:2 * colB); + C = [(p - alpha) * K_mat(:, 1:colB) + K_mat(:, colB + 1:2 * colB) - alpha * D_x2 + ... + p * alpha * M_mat(:, colB + 1:2 * colB) + -K_mat(:, 1:colB) + p * alpha * M_mat(:, 1:colB) - D_x2 + alpha * D_x2 + ... + p * M_mat(:, colB + 1:2 * colB)]; + + % Implement operation (A + p * E)*B'=C + case 'T' + + if not(colM == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of columns of A differs from number ' ... + 'of columns of B']); + end + if not(colK == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of columns of A differs from number ' ... + 'of columns of B']); + end + if not(colD == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of columns of A differs from number ' ... + 'of columns of B']); + end + B_mat = [B(:, 1:colB / 2)', B(:, 1 + colB / 2:colB)']; + K_mat = eqn.K_ * B_mat; + M_mat = eqn.M_ * B_mat; + D_x2 = eqn.E_ * B_mat(:, colB + 1:2 * colB); + C = [(p - alpha) * K_mat(:, 1:colB) + K_mat(:, colB + 1:2 * colB) - alpha * D_x2 + ... + p * alpha * M_mat(:, colB + 1:2 * colB) + -K_mat(:, 1:colB) + p * alpha * M_mat(:, 1:colB) - D_x2 + alpha * D_x2 + ... + p * M_mat(:, colB + 1:2 * colB)]; + +end +end diff --git a/usfs/so_iter/mul_E_so_iter.m b/usfs/so_iter/mul_E_so_iter.m new file mode 100644 index 0000000..c77988c --- /dev/null +++ b/usfs/so_iter/mul_E_so_iter.m @@ -0,0 +1,116 @@ +function C = mul_E_so_iter(eqn, opts, opE, B, opB) + +% function C=mul_E_so_iter(eqn, opts,opE,B,opB) +% +% This function returns C = E_*B, where matrix E_ given by structure +% eqn and input matrix B could be transposed. Matrix E_ is assumed +% to be quadratic and has the same size as A_ in structure eqn. +% +% Inputs: +% +% eqn structure containing field 'E_' +% opts structure containing parameters for the algorithm +% opE character specifying the shape of E_ +% opE = 'N' performs E_*opB(B) +% opE = 'T' performs E_'*opB(B) +% B m-x-p matrix +% opB character specifying the shape of B +% opB = 'N' performs opE(E_)*B +% opB = 'T' performs opE(E_)*B' +% +% Output: +% +% C = opE(E_)*opB(B) +% +% This function uses another so_iter function +% size_so_iter_iter(eqn,opts) to obtain the number of rows of matrix A_ +% in structure eqn, that should be equal to the number of rows of +% the matrix E_. + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +%% Check input parameters +if not(ischar(opE)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opE or opB is not a char'); +end + +opE = upper(opE); +opB = upper(opB); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); +end + +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); +end + +if (not(isnumeric(B))) || (not(ismatrix(B))) + mess_err(opts, 'error_arguments', 'B has to be a matrix'); +end + +%% Check data in eqn structure +if not(isfield(eqn, 'M_') && isfield(eqn, 'K_')) + mess_err(opts, 'error_arguments', 'field eqn.M_ or eqn.K_is not defined'); +end + +if not(mod(size(B, 1), 2) == 0) + mess_err(opts, 'error_arguments', ... + 'matrix B must have an even number of rows'); +end + +rowM = size_so_iter(eqn, opts); +colM = 2 * rowM; +colK = 2 * size(eqn.K_, 1); +rowB = size(B, 1); +colB = size(B, 2); +n = rowB / 2; +alpha = opts.usfs.so_iter.alpha; + +%% Perform multiplication +% Since the implicit E is symmetric there is no need to do this switch + +switch opB + + % Implement multiplication E_*B + case 'N' + if not(colM == size(B, 1)) % M and B/2 and K should agree in size + mess_err(opts, 'error_arguments', ... + ['number of columns of M_ differs from number ' ... + 'of rows of B']); + end + if not(colK == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['number of columns of K_ differs from number ' ... + 'of rows of B']); + end + % B_mat = reshape(B,[],2*size(B,2)); % reshape places the columns + % first the top and right next the button. + B_mat = [B(1:n, :), B(n + 1:rowB, :)]; + M_mat = eqn.M_ * B_mat; + C = [eqn.K_ * B_mat(:, 1:colB) + alpha * M_mat(:, colB + 1:2 * colB) + alpha * M_mat(:, 1:colB) + M_mat(:, colB + 1:2 * colB)]; + % Implement multiplication E_*B' + case 'T' + if not(colM == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of columns of M_ differs from number ' ... + 'of columns of B']); + end + if not(colK == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['number of columns of K_ differs from number ' ... + 'of columns of B']); + end + B_mat = [B(:, 1:colB / 2)', B(:, 1 + colB / 2:colB)']; + M_mat = eqn.M_ * B_mat; + C = [eqn.K_ * B_mat(:, 1:colB) + alpha * M_mat(:, colB + 1:2 * colB) + alpha * M_mat(:, 1:colB) + M_mat(:, colB + 1:2 * colB)]; +end + +end diff --git a/usfs/so_iter/size_so_iter.m b/usfs/so_iter/size_so_iter.m new file mode 100644 index 0000000..3d7124b --- /dev/null +++ b/usfs/so_iter/size_so_iter.m @@ -0,0 +1,30 @@ +function n = size_so_iter(eqn, opts, oper) %#ok +% function n = size_so_iter(eqn, opts, oper) +% +% This function returns the number of rows of matrix A_ in structure eqn. +% +% Input: +% +% eqn structure contains data for equations +% +% opts structure contains parameters for the algorithm +% +% oper structure contains function handles for operation +% with A and E +% +% Output: +% +% n number of rows of matrix A_ in structure eqn +% +% This function does not use other so_iter functions. + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +n = size(eqn.M_, 1); +end diff --git a/usfs/so_iter/sol_A_so_iter.m b/usfs/so_iter/sol_A_so_iter.m new file mode 100644 index 0000000..081a0b0 --- /dev/null +++ b/usfs/so_iter/sol_A_so_iter.m @@ -0,0 +1,248 @@ +function X = sol_A_so_iter(eqn, opts, opA, B, opB) +% function X=sol_A_so_iter(eqn, opts,opA,B,opB) +% +% This function returns X = A_\B, where matrix A_ given by +% structure eqn and input matrix B could be transposed. Matrix A_ +% is assumed to be quadratic. +% +% Inputs: +% +% eqn structure containing field 'A_' +% opts structure containing parameters for the algorithm +% opA character specifying the shape of A_ +% opA = 'N' solves A_*X = opB(B) +% opA = 'T' solves A_'*X = opB(B) +% B p-x-q matrix +% opB character specifying the shape of B +% opB = 'N' solves opA(A_)*X = B +% opB = 'T' solves opA(A_)*X = B' +% +% Output: +% +% X matrix fulfilling equation opA(A_)*X = opB(B) +% +% This function uses another function size_so_iter(eqn, +% opts) to obtain the number of rows of matrix A_ in structure eqn, +% that should be equal to the number of rows of matrix E_. + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% +%% Check input parameters +if not(ischar(opA)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opA or opB is not a char'); +end + +opA = upper(opA); +opB = upper(opB); +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); +end + +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); +end + +if (not(isnumeric(B))) || (not(ismatrix(B))) + mess_err(opts, 'error_arguments', 'B has to be a matrix'); +end + +% Initial guess for vector X + +if not(isfield(opts.usfs.so_iter, 'X0_A')) + opts.usfs.so_iter.X0_A = []; +end + +%% Check data in eqn structure +switch lower(opts.usfs.so_iter.method_A) + case {'minres', 'pcg', 'symmlq', 'pcr'} + mess_err(opts, 'error_arguments', ... + 'field eqn.A_ is not symmetric and positive definite.'); +end + +n = 2 * size_so_iter(eqn, opts); + +%% Preallocate solution +if opB == 'N' + X = zeros(size(B)); + flags = zeros(1, size(B, 2)); +else + X = zeros(size(B')); + flags = zeros(1, size(B, 1)); +end + +%% Create anonymous functions +% To call multiplication with A respecting opA +switch lower(opts.usfs.so_iter.method_A) + case {'bicg', 'lsqr', 'qmr'} + + mul_A = @(X, flag) flagged_mul_A(X, flag, eqn, opts, opA); + case 'pcg' + + mul_A = @(X) -mul_A_so_iter(eqn, opts, opA, X, 'N'); + otherwise + + mul_A = @(X) mul_A_so_iter(eqn, opts, opA, X, 'N'); +end + +% For calling the actual iterative solver. + +solver = eval(sprintf('@%s', lower(opts.usfs.so_iter.method_A))); + +%% Perform solve operations +switch opB + + case 'N' + if not(n == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['Number of rows of A_ differs with number ' ... + 'of rows of B']); + end + + switch lower(opts.usfs.so_iter.method_A) + + case 'pcg' + for i = 1:size(B, 2) + [x, flags(i)] = ... + solver(mul_A, B(:, i), ... + opts.usfs.so_iter.res_tol, ... + opts.usfs.so_iter.max_iter, ... + opts.usfs.so_iter.PA_L, ... + opts.usfs.so_iter.PA_R, ... + opts.usfs.so_iter.X0_A); + X(:, i) = -x; + end + case 'gmres' + for i = 1:size(B, 2) + [X(:, i), flags(i)] = ... + solver(mul_A, B(:, i), ... + opts.usfs.so_iter.restIter, ... + opts.usfs.so_iter.res_tol, ... + opts.usfs.so_iter.max_iter, ... + opts.usfs.so_iter.PA_L, ... + opts.usfs.so_iter.PA_R, ... + opts.usfs.so_iter.X0_A); + end + case 'pcr' + for i = 1:size(B, 2) + [X(:, i), flags(i)] = ... + solver(mul_A, B(:, i), ... + opts.usfs.so_iter.res_tol, ... + opts.usfs.so_iter.max_iter, ... + @(X) mfun(X, opts), ... + opts.usfs.so_iter.X0_A); + end + otherwise + for i = 1:size(B, 2) + [X(:, i), flags(i)] = ... + solver(mul_A, B(:, i), ... + opts.usfs.so_iter.res_tol, ... + opts.usfs.so_iter.max_iter, ... + opts.usfs.so_iter.PA_L, ... + opts.usfs.so_iter.PA_R, ... + opts.usfs.so_iter.X0_A); + end + + end + + case 'T' + if not(n == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['Number of rows of A_ differs with number ' ... + 'of columns of B']); + end + + switch lower(opts.usfs.so_iter.method_A) + + case 'pcg' + for i = 1:size(B, 1) + [x, flags(i)] = ... + solver(mul_A, B(i, :)', ... + opts.usfs.so_iter.res_tol, ... + opts.usfs.so_iter.max_iter, ... + opts.usfs.so_iter.PA_L, ... + opts.usfs.so_iter.PA_R, ... + opts.usfs.so_iter.X0_A); + X(:, i) = -x; + end + case 'gmres' + for i = 1:size(B, 1) + [X(:, i), flags(i)] = ... + solver(mul_A, B(i, :)', ... + opts.usfs.so_iter.restIter, ... + opts.usfs.so_iter.res_tol, ... + opts.usfs.so_iter.max_iter, ... + opts.usfs.so_iter.PA_L, ... + opts.usfs.so_iter.PA_R, ... + opts.usfs.so_iter.X0_A); + end + case 'pcr' + for i = 1:size(B, 1) + [X(:, i), flags(i)] = ... + solver(mul_A, B(i, :)', ... + opts.usfs.so_iter.res_tol, ... + opts.usfs.so_iter.max_iter, ... + @(X) mfun(X, opts), ... + opts.usfs.so_iter.X0_A); + end + otherwise + for i = 1:size(B, 1) + [X(:, i), flags(i)] = ... + solver(mul_A, B(i, :)', ... + opts.usfs.so_iter.res_tol, ... + opts.usfs.so_iter.max_iter, ... + opts.usfs.so_iter.PA_L, ... + opts.usfs.so_iter.PA_R, ... + opts.usfs.so_iter.X0_A); + end + + end + +end +if any(flags) + mess_warn(opts, 'usfs_iter', ... + [lower(opts.usfs.so_iter.method_A) ... + ' did not converge as desired']); + mess_fprintf(opts, ... + ['These are the right hand side indices and ', ... + 'corresponding non-zero termination flags ', ... + 'we encountered:\n']); + idx = find(not(flags == 0)); + for iidx = 1:length(idx) + mess_fprintf(opts, '%d %d\n', idx(iidx), flags(idx(iidx))); + end +end +end + +function Y = flagged_mul_A(X, flag, eqn, opts, opA) +% function Y = flagged_mul_A(X, flag, eqn, opts, opA) +% This is a function handle that accepts the vector input X and the matrix +% A_ given by the eqn structure, and returns the matrix vector product +% A_*X. The input 'flag' defines whether A_ should be transposed or not. + +switch lower(flag) + case 'notransp' + my_opA = opA; + case 'transp' + if strcmp(opA, 'N') + my_opA = 'T'; + else + my_opA = 'N'; + end +end +Y = mul_A_so_iter(eqn, opts, my_opA, X, 'N'); +end + +function Y = mfun(X, opts) +% function Y = mfun(X, opts) +% This is a function handle used specifically in pcr iterative solver +% that accepts the vector input X, and the preconditioner matrices U +% and L, to reconstruct the M preconditioner matrix, and solve the +% system Y = U \ (L \ X). + +Y = opts.usfs.so_iter.PA_R \ (opts.usfs.so_iter.PA_L \ X); +end diff --git a/usfs/so_iter/sol_ApE_post_so_iter.m b/usfs/so_iter/sol_ApE_post_so_iter.m new file mode 100644 index 0000000..bd63c10 --- /dev/null +++ b/usfs/so_iter/sol_ApE_post_so_iter.m @@ -0,0 +1,13 @@ +function [eqn, opts, oper] = sol_ApE_post_so_iter(eqn, opts, oper) +% function [eqn, opts, oper] = sol_ApE_post_so_iter(eqn, opts, oper) +% It is necessary to remove the identity added in _pre_ again + +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) + +if not(eqn.haveE) + eqn = fake_E_clean_default(eqn); +end diff --git a/usfs/so_iter/sol_ApE_pre_so_iter.m b/usfs/so_iter/sol_ApE_pre_so_iter.m new file mode 100644 index 0000000..ba4fcae --- /dev/null +++ b/usfs/so_iter/sol_ApE_pre_so_iter.m @@ -0,0 +1,92 @@ +function [eqn, opts, oper] = sol_ApE_pre_so_iter(eqn, opts, oper) +% function [eqn, opts, oper] = sol_ApE_pre_so_iter(eqn, opts, oper) +% To simplify matters in sol_ApE we add a field eqn.E_ holding the +% identity matrix when we do not have an E matrix already. + +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) + +if not(eqn.haveE) + eqn = fake_E_default(eqn); +end + +%% Check input Parameters +if not(isfield(eqn, 'haveE')) + eqn.haveE = false; +end +if eqn.haveE + if not(isfield(eqn, 'E_')) || not(isfield(eqn, 'K_')) || not(isfield(eqn, 'M_')) + mess_err(opts, 'error_arguments', 'Field eqn.M_ or eqn.E_ or eqn.K_ is not defined'); + end +else + if not(isfield(eqn, 'M_')) + mess_err(opts, 'error_arguments', 'Field eqn.M_ is not defined'); + end + if not(isfield(eqn, 'K_')) + mess_err(opts, 'error_arguments', 'Field eqn.K_ is not defined'); + end + if not(isfield(eqn, 'E_')) + mess_err(opts, 'error_arguments', 'Field eqn.E_ is not defined'); + end +end + +% Check for the solver used +if isfield(opts.usfs.so_iter, 'method_ApE') + if not(exist(opts.usfs.so_iter.method_ApE, 'file') == 2) + mess_err(opts, 'control_data', ['iterative solver method field ''method_ApE''', ... + ' is an unsupported solver.']); + end +else + mess_warn(opts, 'control_data', ['iterative solver method field ''method_ApE''', ... + ' is unset. Falling back to GMRES.']); + opts.usfs.so_iter.method_ApE = 'gmres'; +end + +% Restart size for GMRES +if strcmpi(opts.usfs.so_iter.method_ApE, 'gmres') + + if isfield(opts.usfs.so_iter, 'restIter') + if opts.usfs.so_iter.restIter < 0 + mess_err(opts, 'control_data', ['GMRES restart iterations value', ... + 'is invalid']); + end + else + mess_warn(opts, 'control_data', ['GMRES restart iterations not', ... + ' found. Falling back to default']); + opts.usfs.so_iter.restIter = 25; + end +end + +%% Pre-defined preconditioner + +if not(isfield(opts.usfs.so_iter, 'PApE_R')) + + if not(isfield(opts.usfs.so_iter, 'PApE_L')) + + mess_warn(opts, 'control_data', ['No preconditioner for ApE could be found.', ... + ' Switching to ILU']); + form_ApE = @(alpha, p)ApEfun(alpha, p, eqn); + [L, U] = ilu(form_ApE(opts.usfs.so_iter.alpha, opts.usfs.so_iter.p_)); + opts.usfs.so_iter.PApE_L = L; + opts.usfs.so_iter.PApE_R = U; + else + + opts.usfs.so_iter.PApE_R = []; + + end + +end + +end + +function Y = ApEfun(alpha, p, eqn) +% Y = ApEfun(alpha, p, eqn); +% This is a function handler that accepts the parameter alpha and p, to return +% the matrix ApE_ for solving a second order system re-shaping it as a first +% order system. +Y = [-alpha * eqn.K_ + p * eqn.K_, eqn.K_ - alpha * eqn.E_ + p * alpha * eqn.M_; ... + -eqn.K_ + p * alpha * eqn.M_, -eqn.E_ + alpha * eqn.E_ + p * eqn.M_]; +end diff --git a/usfs/so_iter/sol_ApE_so_iter.m b/usfs/so_iter/sol_ApE_so_iter.m new file mode 100644 index 0000000..c4f227b --- /dev/null +++ b/usfs/so_iter/sol_ApE_so_iter.m @@ -0,0 +1,271 @@ +function X = sol_ApE_so_iter(eqn, opts, opA, p, opE, C, opC) + +% function X=sol_ApE_so_iter(eqn, opts,opA,p,opE,C,opC) +% +% This function returns X = (A_ + p*E_)\C, where matrices A_ and E_ +% given by structure eqn and input matrix C could be transposed. +% Matrices A_ and E_ are assumed to be quadratic. +% +% Inputs: +% +% eqn structure containing fields 'A_' and 'E_' +% opts structure containing parameters for the algorithm. +% opA character specifying the shape of A +% opA = 'N' solves (A_ + p* opE(E_))*X = opC(C) +% opA = 'T' solves (A_' + p* opE(E_))*X = opC(C) +% p scalar value +% opE character specifying the shape of E_ +% opE = 'N' solves (opA(A_) + p* E_)*X = opC(C) +% opE = 'T' solves (opA(A_) + p* E_')*X = opC(C) +% C n-x-p matrix +% opC character specifies the form of opC(C) +% opC = 'N' solves (opA(A_) + p* opE(E_))*X = C +% opC = 'T' solves (opA(A_) + p* opE(E_))*X = C' +% +% Output: +% +% X matrix fulfilling equation (opA(A_)+p*opE(E_))*X = opC(C) +% +% This function uses another function size_so_iter(eqn, +% opts) to obtain the number of rows of matrix A_ in structure eqn, +% that should be equal to the number of rows of matrix E_. +% + +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% +%% Check input parameters +if not(ischar(opA)) || not(ischar(opE)) || not(ischar(opC)) + mess_err(opts, 'error_arguments', 'opA, opE or opC is not a char'); +end + +opA = upper(opA); +opE = upper(opE); +opC = upper(opC); + +if not(opA == 'N' || opA == 'T') + mess_err(opts, 'error_arguments', 'opA is not ''N'' or ''T'''); +end + +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); +end + +if not(opC == 'N' || opC == 'T') + mess_err(opts, 'error_arguments', 'opC is not ''N'' or ''T'''); +end + +if (not(isnumeric(p))) || not(length(p) == 1) + mess_err(opts, 'error_arguments', 'p is not numeric'); +end + +if (not(isnumeric(C))) || (not(ismatrix(C))) + mess_err(opts, 'error_arguments', 'C has to be a matrix'); +end + +n = 2 * size_so_iter(eqn, opts); + +% Initial guess for vector X + +if not(isfield(opts.usfs.so_iter, 'X0_ApE')) + opts.usfs.so_iter.X0_ApE = []; +end +%% Check data in eqn structure +switch lower(opts.usfs.so_iter.method_ApE) + case {'minres', 'pcg', 'symmlq', 'pcr'} + mess_err(opts, 'error_arguments', ['Resulting matrix of ApE is not' ... + 'symmetric and positive definite']); +end +%% Preallocate solution + +if opC == 'N' + X = zeros(size(C)); + flags = zeros(1, size(C, 2)); +else + X = zeros(size(C')); + flags = zeros(1, size(C, 1)); +end + +%% Create anonymous functions +% To call multiplication with ApE respecting opA and opE +switch lower(opts.usfs.so_iter.method_ApE) + + case {'bicg', 'lsqr', 'qmr'} + + mul_ApE = @(X, flag) flagged_mul_ApE(X, flag, eqn, opts, opA, p, opE); + case 'pcg' + + mul_ApE = @(X) -mul_ApE_so_iter(eqn, opts, opA, p, opE, X, 'N'); + otherwise + + mul_ApE = @(X) mul_ApE_so_iter(eqn, opts, opA, p, opE, X, 'N'); +end + +% For calling the actual iterative solver +solver = eval(sprintf('@%s', lower(opts.usfs.so_iter.method_ApE))); +%% Perform solve operations + +switch opC + + case 'N' + if not(n == size(C, 1)) + mess_err(opts, 'error_arguments', ... + ['Number of rows of A_ differs from number ' ... + 'of rows of C']); + end + + switch lower(opts.usfs.so_iter.method_ApE) + + case 'pcg' + for i = 1:size(C, 2) + [x, flags(i)] = ... + solver(mul_ApE, C(:, i), ... + opts.usfs.so_iter.res_tol, ... + opts.usfs.so_iter.max_iter, ... + opts.usfs.so_iter.PApE_L, ... + opts.usfs.so_iter.PApE_R, ... + opts.usfs.so_iter.X0_ApE); + X(:, i) = -x; + end + + case 'gmres' + for i = 1:size(C, 2) + [X(:, i), flags(i)] = ... + solver(mul_ApE, C(:, i), ... + opts.usfs.so_iter.restIter, ... + opts.usfs.so_iter.res_tol, ... + opts.usfs.so_iter.max_iter, ... + opts.usfs.so_iter.PApE_L, ... + opts.usfs.so_iter.PApE_R, ... + opts.usfs.so_iter.X0_ApE); + end + case 'pcr' + for i = 1:size(C, 2) + [X(:, i), flags(i)] = ... + solver(mul_ApE, C(:, i), ... + opts.usfs.so_iter.res_tol, ... + opts.usfs.so_iter.max_iter, ... + @(X) mfun(X, opts), ... + opts.usfs.so_iter.X0_ApE); + end + otherwise + for i = 1:size(C, 2) + [X(:, i), flags(i)] = ... + solver(mul_ApE, C(:, i), ... + opts.usfs.so_iter.res_tol, ... + opts.usfs.so_iter.max_iter, ... + opts.usfs.so_iter.PApE_L, ... + opts.usfs.so_iter.PApE_R, ... + opts.usfs.so_iter.X0_ApE); + end + + end + + case 'T' + if not(n == size(C, 2)) + mess_err(opts, 'error_arguments', ... + ['Number of rows of A_ differs from number ' ... + 'of columns of C']); + end + + switch lower(opts.usfs.so_iter.method_ApE) + + case 'pcg' + for i = 1:size(C, 1) + [x, flags(i)] = ... + solver(mul_ApE, C(i, :)', ... + opts.usfs.so_iter.res_tol, ... + opts.usfs.so_iter.max_iter, ... + opts.usfs.so_iter.PApE_L, ... + opts.usfs.so_iter.PApE_R, ... + opts.usfs.so_iter.X0_ApE); + X(:, i) = -x; + end + + case 'gmres' + for i = 1:size(C, 1) + [X(:, i), flags(i)] = ... + solver(mul_ApE, C(i, :)', ... + opts.usfs.so_iter.restIter, ... + opts.usfs.so_iter.res_tol, ... + opts.usfs.so_iter.max_iter, ... + opts.usfs.so_iter.PApE_L, ... + opts.usfs.so_iter.PApE_R, ... + opts.usfs.so_iter.X0_ApE); + end + case 'pcr' + for i = 1:size(C, 1) + [X(:, i), flags(i)] = ... + solver(mul_ApE, C(i, :)', ... + opts.usfs.so_iter.res_tol, ... + opts.usfs.so_iter.max_iter, ... + @(X) mfun(X, opts), ... + opts.usfs.so_iter.X0_ApE); + end + otherwise + for i = 1:size(C, 1) + [X(:, i), flags(i)] = ... + solver(mul_ApE, C(i, :)', ... + opts.usfs.so_iter.res_tol, ... + opts.usfs.so_iter.max_iter, ... + opts.usfs.so_iter.PApE_L, ... + opts.usfs.so_iter.PApE_R, ... + opts.usfs.so_iter.X0_ApE); + end + end + +end +if any(flags) + mess_warn(opts, 'usfs_iter', ... + [lower(opts.usfs.so_iter.method_ApE) ... + ' did not converge as desired']); + mess_fprintf(opts, ... + ['These are the right hand side indices and ', ... + 'corresponding non-zero termination flags ', ... + 'we encountered:\n']); + idx = find(not(flags == 0)); + for iidx = 1:length(idx) + mess_fprintf(opts, '%d %d\n', idx(iidx), flags(idx(iidx))); + end +end +end + +function Y = flagged_mul_ApE(X, flag, eqn, opts, opA, p, opE) +% function Y = flagged_mul_ApE(X, flag, eqn, opts, opA, p, opE) +% This is a function handle that accepts the vector input X, the scalar p +% and the matrices A_ and E_ given by the eqn structure, and returns the matrix +% vector product (A_+p*E_)*X. The input 'flag' defines whether A_ and E_ +% should be transposed or not. + +switch lower(flag) + case 'notransp' + Y = mul_ApE_so_iter(eqn, opts, opA, p, opE, X, 'N'); + case 'transp' + if strcmp(opA, 'N') + my_opA = 'T'; + else + my_opA = 'N'; + end + if strcmp(opE, 'N') + my_opE = 'T'; + else + my_opE = 'N'; + end + Y = mul_ApE_so_iter( ... + eqn, opts, my_opA, conj(p), my_opE, X, 'N'); +end + +end + +function Y = mfun(X, opts) +% function Y = mfun(X, opts) +% This is a function handle used specifically in pcr iterative solver +% that accepts the vector input X, and the preconditioner matrices U +% and L, to reconstruct the M preconditioner matrix, and solve the +% system Y = U \ (L \ X). + +Y = opts.usfs.so_iter.PApE_R \ (opts.usfs.so_iter.PApE_L \ X); +end diff --git a/usfs/so_iter/sol_E_so_iter.m b/usfs/so_iter/sol_E_so_iter.m new file mode 100644 index 0000000..803e3d8 --- /dev/null +++ b/usfs/so_iter/sol_E_so_iter.m @@ -0,0 +1,231 @@ +function X = sol_E_so_iter(eqn, opts, opE, B, opB) + +% function X=sol_E_so_iter(eqn, opts, opE, B, opB) +% +% This function returns X = E_\B, where matrix E_ given by +% structure eqn and input matrix B could be transposed. Matrix E_ +% is assumed to be quadratic and has the same size as A_ in +% structure eqn. +% +% Inputs: +% +% eqn structure containing field 'E_' +% opts structure containing parameters for the algorithm. +% opE character specifying the shape of E_ +% opE = 'N' solves E_*X = opB(B) +% opE = 'T' solves E_'*X = opB(B) +% B p-x-q matrix +% opB character specifying the shape of B +% opB = 'N' solves opE(E_)*X = B +% opB = 'T' solves opE(E_)*X = B' +% +% Output: +% +% X matrix fulfilling equation opE(E_)*X = opB(B) +% +% This function uses another function size_so_iter(eqn, +% opts) to obtain the number of rows of matrix A_ in structure eqn, +% that should be equal to the number of rows of matrix E_. + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +%% Check input parameters +if not(ischar(opE)) || not(ischar(opB)) + mess_err(opts, 'error_arguments', 'opE or opB is not a char'); +end +opE = upper(opE); +opB = upper(opB); +if not(opE == 'N' || opE == 'T') + mess_err(opts, 'error_arguments', 'opE is not ''N'' or ''T'''); +end + +if not(opB == 'N' || opB == 'T') + mess_err(opts, 'error_arguments', 'opB is not ''N'' or ''T'''); +end + +if (not(isnumeric(B))) || (not(ismatrix(B))) + mess_err(opts, 'error_arguments', 'B has to be a matrix'); +end + +% Initial guess for vector X + +if not(isfield(opts.usfs.so_iter, 'X0_E')) + opts.usfs.so_iter.X0_E = []; +end + +%% Check data in eqn structure + +switch lower(opts.usfs.so_iter.method_E) + case 'pcg' + if not(opts.usfs.so_iter.E_is_spd) + mess_err(opts, 'error_arguments', ... + 'Field eqn.E_ is not symmetric and positive definite'); + end + case {'minres', 'symmlq', 'pcr'} + if not(issymmetric(eqn.E_)) + mess_err(opts, 'error_arguments', 'Field eqn.E_ is not symmetric'); + end +end + +n = 2 * size_so_iter(eqn, opts); + +%% Preallocate solution +if opB == 'N' + X = zeros(size(B)); + flags = zeros(1, size(B, 2)); +else + X = zeros(size(B')); + flags = zeros(1, size(B, 1)); +end + +%% Create anonymous functions +% To call multiplication with E respecting opE + +switch lower(opts.usfs.so_iter.method_E) + + case {'bicg', 'lsqr', 'qmr'} + mul_E = @(X, flag) flagged_mul_E(X, flag, eqn, opts, opE); + + otherwise + mul_E = @(X) mul_E_so_iter(eqn, opts, opE, X, 'N'); + +end + +% For calling the actual iterative solver +solver = eval(sprintf('@%s', lower(opts.usfs.so_iter.method_E))); + +%% Perform solve operations +switch opB + + case 'N' + if not(n == size(B, 1)) + mess_err(opts, 'error_arguments', ... + ['Number of rows of E_ differs from number ' ... + 'of rows of B']); + end + + switch lower(opts.usfs.so_iter.method_E) + + case 'gmres' + for i = 1:size(B, 2) + [X(:, i), flags(i)] = ... + solver(mul_E, B(:, i), ... + opts.usfs.so_iter.restIter, ... + opts.usfs.so_iter.res_tol, ... + opts.usfs.so_iter.max_iter, ... + opts.usfs.so_iter.PE_L, ... + opts.usfs.so_iter.PE_R, ... + opts.usfs.so_iter.X0_E); + end + case 'pcr' + for i = 1:size(B, 2) + [X(:, i), flags(i)] = ... + solver(mul_E, B(:, i), ... + opts.usfs.so_iter.res_tol, ... + opts.usfs.so_iter.max_iter, ... + @(X) mfun(X, opts), ... + opts.usfs.so_iter.X0_E); + end + otherwise + for i = 1:size(B, 2) + [X(:, i), flags(i)] = ... + solver(mul_E, B(:, i), ... + opts.usfs.so_iter.res_tol, ... + opts.usfs.so_iter.max_iter, ... + opts.usfs.so_iter.PE_L, ... + opts.usfs.so_iter.PE_R, ... + opts.usfs.so_iter.X0_E); + end + + end + + case 'T' + if not(n == size(B, 2)) + mess_err(opts, 'error_arguments', ... + ['Number of rows of E_ differs from number ' ... + 'of columns of B']); + end + + switch lower(opts.usfs.so_iter.method_E) + + case 'gmres' + for i = 1:size(B, 1) + [X(:, i), flags(i)] = ... + solver(mul_E, B(i, :)', ... + opts.usfs.so_iter.restIter, ... + opts.usfs.so_iter.res_tol, ... + opts.usfs.so_iter.max_iter, ... + opts.usfs.so_iter.PE_L, ... + opts.usfs.so_iter.PE_R, ... + opts.usfs.so_iter.X0_E); + end + case 'pcr' + for i = 1:size(B, 1) + [X(:, i), flags(i)] = ... + solver(mul_E, B(i, :)', ... + opts.usfs.so_iter.res_tol, ... + opts.usfs.so_iter.max_iter, ... + @(X) mfun(X, opts), ... + opts.usfs.so_iter.X0_E); + end + otherwise + for i = 1:size(B, 1) + [X(:, i), flags(i)] = ... + solver(mul_E, B(i, :)', ... + opts.usfs.so_iter.res_tol, ... + opts.usfs.so_iter.max_iter, ... + opts.usfs.so_iter.PE_L, ... + opts.usfs.so_iter.PE_R, ... + opts.usfs.so_iter.X0_E); + end + + end +end +if any(flags) + mess_warn(opts, 'usfs_iter', ... + [lower(opts.usfs.so_iter.method_E) ... + ' did not converge as desired']); + mess_fprintf(opts, ... + ['These are the right hand side indices and ', ... + 'corresponding non-zero termination flags ', ... + 'we encountered:\n']); + idx = find(not(flags == 0)); + for iidx = 1:length(idx) + mess_fprintf(opts, '%d %d\n', idx(iidx), flags(idx(iidx))); + end +end +end + +function Y = flagged_mul_E(X, flag, eqn, opts, opE) +% function Y = flagged_mul_E(X, flag, eqn, opts, opE) +% This is a function handle that accepts the vector input X and the matrix +% E_ given by the eqn structure, and returns the matrix vector product +% A_*X. The input 'flag' defines whether E_ should be transposed or not. +switch lower(flag) + case 'notransp' + my_opE = opE; + case 'transp' + if strcmp(opE, 'N') + my_opE = 'T'; + else + my_opE = 'N'; + end +end +Y = mul_E_so_iter(eqn, opts, my_opE, X, 'N'); +end + +function Y = mfun(X, opts) +% function Y = mfun(X, opts) +% This is a function handle used specifically in pcr iterative solver +% that accepts the vector input X, and the preconditioner matrices U +% and L, to reconstruct the M preconditioner matrix, and solve the +% system Y = U \ (L \ X). + +Y = opts.usfs.so_iter.PE_R \ (opts.usfs.so_iter.PE_L \ X); +end diff --git a/usfs/state_space_transformed_default/README_state_space_transformed_default.md b/usfs/state_space_transformed_default/README_state_space_transformed_default.md deleted file mode 100644 index ec25f02..0000000 --- a/usfs/state_space_transformed_default/README_state_space_transformed_default.md +++ /dev/null @@ -1,16 +0,0 @@ -Function handles for solving state-space transformed matrix equations -via Krylov subspace methods. -Assume the linear first-order system of the form - -``` - Ex' = Ax + Bu, - y = Cx, -``` - -with E = LU invertible. -Then in the state-space transformed case, we are considering the system - -``` - z' = (L\A/U)z + (L\B)u, - y = (C/U)z. -``` diff --git a/usfs/state_space_transformed_default/dss_to_ss_post_state_space_transformed_default.m b/usfs/state_space_transformed_default/dss_to_ss_post_state_space_transformed_default.m index 2b7ad2e..f0861cd 100644 --- a/usfs/state_space_transformed_default/dss_to_ss_post_state_space_transformed_default.m +++ b/usfs/state_space_transformed_default/dss_to_ss_post_state_space_transformed_default.m @@ -22,22 +22,11 @@ % with A and E % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - -assert(isfield(eqn, 'Ecount'), ... - 'MESS:error_arguments', ... - 'field eqn.Scount is not defined.'); - -if eqn.Ecount > 1 - eqn.Ecount = eqn.Ecount - 1; -else - eqn = rmfield(eqn, 'Ecount'); - eqn = rmfield(eqn, 'EL'); - eqn = rmfield(eqn, 'EU'); -end +eqn = LU_E_clean(eqn, opts); diff --git a/usfs/state_space_transformed_default/dss_to_ss_pre_state_space_transformed_default.m b/usfs/state_space_transformed_default/dss_to_ss_pre_state_space_transformed_default.m index cc03a67..2cd6678 100644 --- a/usfs/state_space_transformed_default/dss_to_ss_pre_state_space_transformed_default.m +++ b/usfs/state_space_transformed_default/dss_to_ss_pre_state_space_transformed_default.m @@ -22,21 +22,11 @@ % with A and E % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - -if isfield(eqn, 'EL') && isfield(eqn, 'EU') - if isfield(eqn, 'Ecount') - eqn.Ecount = eqn.Ecount + 1; - else - eqn.Ecount = 2; - end -else - [eqn.EL, eqn.EU] = lu(eqn.E_); - eqn.Ecount = 1; -end +eqn = LU_E(eqn); diff --git a/usfs/state_space_transformed_default/dss_to_ss_state_space_transformed_default.m b/usfs/state_space_transformed_default/dss_to_ss_state_space_transformed_default.m index 8c41ee7..a3a350a 100644 --- a/usfs/state_space_transformed_default/dss_to_ss_state_space_transformed_default.m +++ b/usfs/state_space_transformed_default/dss_to_ss_state_space_transformed_default.m @@ -1,4 +1,4 @@ -function C = dss_to_ss_state_space_transformed_default... +function C = dss_to_ss_state_space_transformed_default ... (eqn, opts, fac, opFac, B, opB) %% function C = dss_to_ss_state_space_transformed_default... % (eqn, opts, fac, opFac, B, opB) @@ -18,7 +18,7 @@ % % opFac character specifying the shape of the used factor % opFac = 'N' solves EL*C = op(B) or EU*C = op(B) -% opFac = 'T' solves EL'*C = op(B) or EU'*C = op(B) +% opFac = 'T' solves EL'*C = op(B) or EU'*C = op(B) % % B n-x-p matrix % @@ -27,7 +27,7 @@ % opB = 'T' solves op(EL)*C = B' or op(EU)*C = B' % % Output -% C matrix fulfilling the equation +% C matrix fulfilling the equation % op(EL)*C = op(B) or op(EU)*C = op(B) % % This function uses another default function size_default(eqn, opts) to @@ -36,46 +36,46 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % %% Check input parameters. -assert(ischar(fac) && ischar(opFac) && ischar(opB), ... - 'MESS:error_arguments', ... - 'fac, opFac or opB is not a char'); +mess_assert(opts, ischar(fac) && ischar(opFac) && ischar(opB), ... + 'error_arguments', ... + 'fac, opFac or opB is not a char'); fac = upper(fac); opFac = upper(opFac); opB = upper(opB); -assert((fac == 'L') || (fac == 'U'), ... - 'MESS:error_arguments', ... - 'fac is not ''N'' or ''T'''); +mess_assert(opts, (fac == 'L') || (fac == 'U'), ... + 'error_arguments', ... + 'fac is not ''N'' or ''T'''); -assert((opFac == 'N') || (opFac == 'T'), ... - 'MESS:error_arguments', ... - 'opFac is not ''N'' or ''T'''); +mess_assert(opts, (opFac == 'N') || (opFac == 'T'), ... + 'error_arguments', ... + 'opFac is not ''N'' or ''T'''); -assert((opB == 'N') || (opB == 'T'), ... - 'MESS:error_arguments', ... - 'opB is not ''N'' or ''T'''); +mess_assert(opts, (opB == 'N') || (opB == 'T'), ... + 'error_arguments', ... + 'opB is not ''N'' or ''T'''); -assert(isnumeric(B) && ismatrix(B), ... - 'MESS:error_arguments', ... - 'B has to ba a matrix'); +mess_assert(opts, isnumeric(B) && ismatrix(B), ... + 'error_arguments', ... + 'B has to ba a matrix'); %% Check data in eqn structure. if isfield(eqn, 'haveE') && eqn.haveE - assert(isfield(eqn, 'EL'), ... - 'MESS:error_arguments', ... - 'field eqn.EL is not defined'); - assert(isfield(eqn, 'EU'), ... - 'MESS:error_arguments', ... - 'field eqn.EU is not defined'); + mess_assert(opts, isfield(eqn, 'EL'), ... + 'error_arguments', ... + 'field eqn.EL is not defined'); + mess_assert(opts, isfield(eqn, 'EU'), ... + 'error_arguments', ... + 'field eqn.EU is not defined'); else - eqn.haveE = 0; + eqn.haveE = false; end rowE = size_default(eqn, opts); @@ -89,33 +89,33 @@ case 'N' switch opB case 'N' % Implement solve EL*C = B. - assert(rowE == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of rows of E_ differs with ' ... - 'number rows of B']); - C = eqn.EL \ B; + mess_assert(opts, rowE == size(B, 1), ... + 'error_arguments', ... + ['number of rows of E_ differs with ' ... + 'number rows of B']); + C = eqn.EL \ (eqn.ER(:, eqn.Ep) \ B); case 'T' % Implement solve EL*C = B'. - assert(rowE == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of rows of E_ differs with ' ... - 'number of columns of B']); - C = eqn.EL \ B'; + mess_assert(opts, rowE == size(B, 2), ... + 'error_arguments', ... + ['number of rows of E_ differs with ' ... + 'number of columns of B']); + C = eqn.EL \ (eqn.ER(:, eqn.Ep) \ B'); end case 'T' switch opB case 'N' % Implement solve EL'*C = B. - assert(colE == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of columns of E_ differs ' ... - 'with number of rows of B']); - C = eqn.EL' \ B; + mess_assert(opts, colE == size(B, 1), ... + 'error_arguments', ... + ['number of columns of E_ differs ' ... + 'with number of rows of B']); + C = eqn.ER(:, eqn.Ep)' \ (eqn.EL' \ B); case 'T' % Implement solve EL'*C = B'. - assert(colE == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of columns of E_ differs ' ... - 'with number of columns of B']); - C = eqn.EL' \ B'; + mess_assert(opts, colE == size(B, 2), ... + 'error_arguments', ... + ['number of columns of E_ differs ' ... + 'with number of columns of B']); + C = eqn.ER(:, eqn.Ep)' \ (eqn.EL' \ B'); end end @@ -124,37 +124,43 @@ case 'N' switch opB case 'N' % Implement solve EU*C = B. - assert(rowE == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of rows of E_ differs with ' ... - 'number rows of B']); - C = eqn.EU \ B; + mess_assert(opts, rowE == size(B, 1), ... + 'error_arguments', ... + ['number of rows of E_ differs with ' ... + 'number rows of B']); + C(eqn.Eq, :) = eqn.EU \ B; case 'T' % Implement solve EU*C = B'. - assert(rowE == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of rows of E_ differs with ' ... - 'number of columns of B']); - C = eqn.EU \ B'; + mess_assert(opts, rowE == size(B, 2), ... + 'error_arguments', ... + ['number of rows of E_ differs with ' ... + 'number of columns of B']); + C(eqn.Eq, :) = eqn.EU \ B'; end case 'T' switch opB case 'N' % Implement solve EU'*C = B. - assert(colE == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of columns of E_ differs ' ... - 'with number of rows of B']); - C = eqn.EU' \ B; + mess_assert(opts, colE == size(B, 1), ... + 'error_arguments', ... + ['number of columns of E_ differs ' ... + 'with number of rows of B']); + C = eqn.EU' \ B(eqn.Eq, :); case 'T' % Implement solve EU'*C = B'. - assert(colE == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of columns of E_ differs ' ... - 'with number of columns of B']); - C = eqn.EU' \ B'; + mess_assert(opts, colE == size(B, 2), ... + 'error_arguments', ... + ['number of columns of E_ differs ' ... + 'with number of columns of B']); + C = eqn.EU' \ B(:, eqn.Eq)'; end end end else % Case of E_ = I_n, was set by init. - C = B; + switch opB + case 'N' + C = B; + case 'T' + C = B'; + end +end end diff --git a/usfs/state_space_transformed_default/init_res_state_space_transformed_default.m b/usfs/state_space_transformed_default/init_res_state_space_transformed_default.m index 6e5b84b..b296999 100644 --- a/usfs/state_space_transformed_default/init_res_state_space_transformed_default.m +++ b/usfs/state_space_transformed_default/init_res_state_space_transformed_default.m @@ -1,9 +1,9 @@ -function [RHS, res0, eqn, opts, oper] = ... - init_res_state_space_transformed_default(eqn, opts, oper, RHS) -%% function [RHS, res0, eqn, opts, oper] = ... -% init_res_state_space_transformed_default(eqn, opts, oper, RHS) +function [W, res0, eqn, opts, oper] = ... + init_res_state_space_transformed_default(eqn, opts, oper, W, T) +%% function [W, res0, eqn, opts, oper] = ... +% init_res_state_space_transformed_default(eqn, opts, oper, W, T) % -% This function returns the initial residual factor RHS and its +% This function returns the initial residual factor W and its % associated norm res0. % % Input @@ -14,12 +14,15 @@ % oper struct contains function handles for operation % with A and E % -% RHS right hand-side matrix +% W right hand-side matrix +% +% T matrix such that the residual is W*T*W' +% (optional, defaults to the identity) % % Output -% RHS right hand-side matrix +% W right hand-side matrix % -% res0 residuum norm of RHS +% res0 residuum norm of W % % eqn struct contains data for equations % @@ -29,32 +32,35 @@ % with A and E % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% Check input data. -if not(isnumeric(RHS)) || not(ismatrix(RHS)) - error( ... - 'MESS:error_arguments', ... - 'RHS has to ba a matrix'); +if not(isnumeric(W)) || not(ismatrix(W)) + mess_err(opts, ... + 'error_arguments', ... + 'W has to ba a matrix'); end %% Compute res0. +if not(exist('T', 'var')) && opts.LDL_T + % this means we only use init_res for potential projection + return +end if isfield(opts, 'nm') && isfield(opts.nm, 'res0') res0 = opts.nm.res0; else if opts.LDL_T if opts.norm == 2 - res0 = max(abs(eig(RHS' * RHS * diag(eqn.S_diag)))); + res0 = max(abs(eig(W' * W * T))); else - res0 = norm(eig(RHS' * RHS * diag(eqn.S_diag)), 'fro'); + res0 = norm(eig(W' * W * T), 'fro'); end else - res0 = norm(RHS' * RHS, opts.norm); + res0 = norm(W' * W, opts.norm); end end diff --git a/usfs/state_space_transformed_default/init_state_space_transformed_default.m b/usfs/state_space_transformed_default/init_state_space_transformed_default.m index 95dda3f..05eb6cd 100644 --- a/usfs/state_space_transformed_default/init_state_space_transformed_default.m +++ b/usfs/state_space_transformed_default/init_state_space_transformed_default.m @@ -47,20 +47,19 @@ % result (true if 'E_' is in structure eqn and a numeric and quadratic field). % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - -%start checking +% start checking na = nargin; if na <= 3 - error( ... - 'MESS:control_data', ... - 'Number of input Arguments are at least 3'); + mess_err(opts, ... + 'control_data', ... + 'Number of input Arguments are at least 3'); elseif na == 4 switch flag1 @@ -69,9 +68,9 @@ case {'E', 'e'} [eqn, result] = checkE(eqn); otherwise - error( ... - 'MESS:control_data', ... - 'flag1 has to be ''A'' or ''E'''); + mess_err(opts, ... + 'control_data', ... + 'flag1 has to be ''A'' or ''E'''); end elseif na == 5 @@ -83,12 +82,12 @@ [eqn, resultA] = checkA(eqn); result = result && resultA; case {'E', 'e'} - [eqn, resultE]= checkE(eqn); + [eqn, resultE] = checkE(eqn); result = result && resultE; otherwise - error( ... - 'MESS:control_data', ... - 'flag2 has to be ''A'' or ''E'''); + mess_err(opts, ... + 'control_data', ... + 'flag2 has to be ''A'' or ''E'''); end case {'E', 'e'} [eqn, result] = checkE(eqn); @@ -97,17 +96,17 @@ [eqn, resultA] = checkA(eqn); result = result && resultA; case {'E', 'e'} - [eqn, resultE]= checkE(eqn); + [eqn, resultE] = checkE(eqn); result = result && resultE; otherwise - error( ... - 'MESS:control_data', ... - 'flag2 has to be ''A'' or ''E'''); + mess_err(opts, ... + 'control_data', ... + 'flag2 has to be ''A'' or ''E'''); end otherwise - error( ... - 'MESS:control_data', ... - 'flag1 has to be ''A'' or ''E'''); + mess_err(opts, ... + 'control_data', ... + 'flag1 has to be ''A'' or ''E'''); end end @@ -126,12 +125,18 @@ %% Check data for E_. function [eqn, result] = checkE(eqn) -if not(isfield(eqn, 'haveE')), eqn.haveE = 0; end +if not(isfield(eqn, 'haveE')) + eqn.haveE = false; +end if not(eqn.haveE) - result = 1; - eqn.E_= speye(size(eqn.A_, 1)); % Make sure we have an identity for - % computations in ApE functions. + result = true; + eqn.I_ = speye(size(eqn.A_, 1)); % Make sure we have an identity for + % computations in ApE functions. + % ? %%%% Davide: why eqn.I_ instead of eqn.E_? + % ? eqn.E_= speye(size(eqn.A_, 1)); % Make sure we have an identity for + % ? % computations in ApE functions. + % ? %%%% else result = isfield(eqn, 'E_'); diff --git a/usfs/state_space_transformed_default/mess_usfs_state_space_transformed_default.m b/usfs/state_space_transformed_default/mess_usfs_state_space_transformed_default.m index 6325362..5c3914a 100644 --- a/usfs/state_space_transformed_default/mess_usfs_state_space_transformed_default.m +++ b/usfs/state_space_transformed_default/mess_usfs_state_space_transformed_default.m @@ -30,7 +30,7 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % diff --git a/usfs/state_space_transformed_default/mul_A_post_state_space_transformed_default.m b/usfs/state_space_transformed_default/mul_A_post_state_space_transformed_default.m index b8fa9d3..985753f 100644 --- a/usfs/state_space_transformed_default/mul_A_post_state_space_transformed_default.m +++ b/usfs/state_space_transformed_default/mul_A_post_state_space_transformed_default.m @@ -22,22 +22,11 @@ % with A and E % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - -assert(isfield(eqn, 'Ecount'), ... - 'MESS:error_arguments', ... - 'field eqn.Scount is not defined.'); - -if eqn.Ecount > 1 - eqn.Ecount = eqn.Ecount - 1; -else - eqn = rmfield(eqn, 'Ecount'); - eqn = rmfield(eqn, 'EL'); - eqn = rmfield(eqn, 'EU'); -end +eqn = LU_E_clean(eqn, opts); diff --git a/usfs/state_space_transformed_default/mul_A_pre_state_space_transformed_default.m b/usfs/state_space_transformed_default/mul_A_pre_state_space_transformed_default.m index 64938cd..1f1d306 100644 --- a/usfs/state_space_transformed_default/mul_A_pre_state_space_transformed_default.m +++ b/usfs/state_space_transformed_default/mul_A_pre_state_space_transformed_default.m @@ -22,21 +22,11 @@ % with A and E % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - -if isfield(eqn, 'EL') && isfield(eqn, 'EU') - if isfield(eqn, 'Ecount') - eqn.Ecount = eqn.Ecount + 1; - else - eqn.Ecount = 2; - end -else - [eqn.EL, eqn.EU] = lu(eqn.E_); - eqn.Ecount = 1; -end +eqn = LU_E(eqn); diff --git a/usfs/state_space_transformed_default/mul_A_state_space_transformed_default.m b/usfs/state_space_transformed_default/mul_A_state_space_transformed_default.m index 663bbc3..83133c8 100644 --- a/usfs/state_space_transformed_default/mul_A_state_space_transformed_default.m +++ b/usfs/state_space_transformed_default/mul_A_state_space_transformed_default.m @@ -13,7 +13,7 @@ % opA character specifying the shape of A_ % opA = 'N' performs A_*opB(B) % opA = 'T' performs A_'*opB(B) -% and if eqn.haveE == 1 +% and if eqn.haveE == true % opA = 'N' performs EL\A_/EU*opB(B) % opA = 'T' performs EU'\A_'/EL'*opB(B) % @@ -22,59 +22,67 @@ % opB character specifying the shape of B % opB = 'N' performs opA(A_)*B % opB = 'T' performs opA(A_)*B' -% and if eqn.haveE == 1 +% and if eqn.haveE == true % opB = 'N' performs opA(EL\A_/EU)*B % opB = 'T' performs opA(EL\A_/EU)*B' % % Output % C = opA(A_)*opB(B) or opA(EL\A_/EU)*opB(B) -% + % This function uses another default function size_default(eqn, opts) to % obtain the number of rows of matrix A_ in structure eqn. % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% Check input parameters. -assert(ischar(opA) && ischar(opB), ... - 'MESS:error_arguments', ... - 'opA or opB is not a char'); +mess_assert(opts, ischar(opA) && ischar(opB), ... + 'error_arguments', ... + 'opA or opB is not a char'); opA = upper(opA); opB = upper(opB); -assert((opA == 'N') || (opA == 'T'), ... - 'MESS:error_arguments', ... - 'opA is not ''N'' or ''T'''); +mess_assert(opts, (opA == 'N') || (opA == 'T'), ... + 'error_arguments', ... + 'opA is not ''N'' or ''T'''); -assert((opB == 'N') || (opB == 'T'), ... - 'MESS:error_arguments', ... - 'opB is not ''N'' or ''T'''); +mess_assert(opts, (opB == 'N') || (opB == 'T'), ... + 'error_arguments', ... + 'opB is not ''N'' or ''T'''); -assert(isnumeric(B) && ismatrix(B), ... - 'MESS:error_arguments', ... - 'B has to ba a matrix'); +mess_assert(opts, isnumeric(B) && ismatrix(B), ... + 'error_arguments', ... + 'B has to ba a matrix'); %% Check data in eqn structure. -assert(isfield(eqn,'A_'), ... - 'MESS:error_arguments', ... - 'field eqn.A_ is not defined'); +mess_assert(opts, isfield(eqn, 'A_'), ... + 'error_arguments', ... + 'field eqn.A_ is not defined'); if isfield(eqn, 'haveE') && eqn.haveE - assert(isfield(eqn, 'EL'), ... - 'MESS:error_arguments', ... - 'field eqn.EL is not defined'); - assert(isfield(eqn, 'EU'), ... - 'MESS:error_arguments', ... - 'field eqn.EU is not defined'); + mess_assert(opts, isfield(eqn, 'EL'), ... + 'error_arguments', ... + 'field eqn.EL is not defined'); + mess_assert(opts, isfield(eqn, 'EU'), ... + 'error_arguments', ... + 'field eqn.EU is not defined'); + mess_assert(opts, isfield(eqn, 'Ep'), ... + 'error_arguments', ... + 'field eqn.Ep is not defined'); + mess_assert(opts, isfield(eqn, 'Eq'), ... + 'error_arguments', ... + 'field eqn.Eq is not defined'); + mess_assert(opts, isfield(eqn, 'ER'), ... + 'error_arguments', ... + 'field eqn.ER is not defined'); else - eqn.haveE = 0; + eqn.haveE = false; end rowA = size_default(eqn, opts); @@ -86,71 +94,76 @@ case 'N' switch opB case 'N' % Implement operation (EL\A_/EU)*B. - assert(colA == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of columns of A_ differs with ' ... - 'number of rows of B']); - C = eqn.EL \ (eqn.A_ * (eqn.EU \ B)); + mess_assert(opts, colA == size(B, 1), ... + 'error_arguments', ... + ['number of columns of A_ differs with ' ... + 'number of rows of B']); + tempC(eqn.Eq, :) = eqn.EU \ B; + C = eqn.EL \ (eqn.ER(:, eqn.Ep) \ (eqn.A_ * tempC)); case 'T' % Implement operation (EL\A_/EU)*B'. - assert(colA == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of columns of A_ differs with ' ... - 'number of columns of B']); - C = eqn.EL \ (eqn.A_ * (eqn.EU \ B')); + mess_assert(opts, colA == size(B, 2), ... + 'error_arguments', ... + ['number of columns of A_ differs with ' ... + 'number of columns of B']); + tempC(eqn.Eq, :) = eqn.EU \ B'; + C = eqn.EL \ (eqn.ER(:, eqn.Ep) \ (eqn.A_ * tempC)); end case 'T' switch opB case 'N' % Implement operation (EL\A_/EU)'*B. - assert(rowA == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of rows of A_ differs with ' ... - 'number rows of B']); - C = eqn.EU' \ (eqn.A_' * (eqn.EL' \ B)); + mess_assert(opts, rowA == size(B, 1), ... + 'error_arguments', ... + ['number of rows of A_ differs with ' ... + 'number rows of B']); + + tempC = eqn.A_' * (eqn.ER(:, eqn.Ep)' \ (eqn.EL' \ B)); + C = eqn.EU' \ tempC(eqn.Eq, :); case 'T' % Implement operation (EL\A_/EU)'*B'. - assert(rowA == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of rows of A_ differs with ' ... - 'number of columns of B']); - C = eqn.EU' \ (eqn.A_' * (eqn.EL' \ B')); + mess_assert(opts, rowA == size(B, 2), ... + 'error_arguments', ... + ['number of rows of A_ differs with ' ... + 'number of columns of B']); + tempC = eqn.A_' * (eqn.ER(:, eqn.Ep)' \ (eqn.EL' \ B')); + C = eqn.EU' \ tempC(eqn.Eq, :); end end -else +else % No E and thus no transformation required switch opA case 'N' switch opB case 'N' % Implement operation A_*B. - assert(colA == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of columns of A_ differs with ' ... - 'number of rows of B']); + mess_assert(opts, colA == size(B, 1), ... + 'error_arguments', ... + ['number of columns of A_ differs with ' ... + 'number of rows of B']); C = eqn.A_ * B; case 'T' % Implement operation A_*B'. - assert(colA == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of columns of A_ differs with ' ... - 'number of columns of B']); + mess_assert(opts, colA == size(B, 2), ... + 'error_arguments', ... + ['number of columns of A_ differs with ' ... + 'number of columns of B']); C = eqn.A_ * B'; end case 'T' switch opB case 'N' % Implement operation A_'*B. - assert(rowA == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of rows of A_ differs with ' ... - 'number rows of B']); + mess_assert(opts, rowA == size(B, 1), ... + 'error_arguments', ... + ['number of rows of A_ differs with ' ... + 'number rows of B']); C = eqn.A_' * B; case 'T' % Implement operation A_'*B'. - assert(rowA == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of rows of A_ differs with ' ... - 'number of columns of B']); + mess_assert(opts, rowA == size(B, 2), ... + 'error_arguments', ... + ['number of rows of A_ differs with ' ... + 'number of columns of B']); C = eqn.A_' * B'; end diff --git a/usfs/state_space_transformed_default/mul_ApE_post_state_space_transformed_default.m b/usfs/state_space_transformed_default/mul_ApE_post_state_space_transformed_default.m index 71f7239..4c85573 100644 --- a/usfs/state_space_transformed_default/mul_ApE_post_state_space_transformed_default.m +++ b/usfs/state_space_transformed_default/mul_ApE_post_state_space_transformed_default.m @@ -22,17 +22,16 @@ % with A and E % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - -assert(isfield(eqn, 'Ecount'), ... - 'MESS:error_arguments', ... - 'field eqn.Scount is not defined.'); +mess_assert(opts, isfield(eqn, 'Ecount'), ... + 'error_arguments', ... + 'field eqn.Ecount is not defined.'); if eqn.Ecount > 1 eqn.Ecount = eqn.Ecount - 1; diff --git a/usfs/state_space_transformed_default/mul_ApE_pre_state_space_transformed_default.m b/usfs/state_space_transformed_default/mul_ApE_pre_state_space_transformed_default.m index a08949e..4eecac1 100644 --- a/usfs/state_space_transformed_default/mul_ApE_pre_state_space_transformed_default.m +++ b/usfs/state_space_transformed_default/mul_ApE_pre_state_space_transformed_default.m @@ -22,21 +22,11 @@ % with A and E % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - -if isfield(eqn, 'EL') && isfield(eqn, 'EU') - if isfield(eqn, 'Ecount') - eqn.Ecount = eqn.Ecount + 1; - else - eqn.Ecount = 2; - end -else - [eqn.EL, eqn.EU] = lu(eqn.E_); - eqn.Ecount = 1; -end +eqn = LU_E(eqn); diff --git a/usfs/state_space_transformed_default/mul_ApE_state_space_transformed_default.m b/usfs/state_space_transformed_default/mul_ApE_state_space_transformed_default.m index 24e8579..17868c0 100644 --- a/usfs/state_space_transformed_default/mul_ApE_state_space_transformed_default.m +++ b/usfs/state_space_transformed_default/mul_ApE_state_space_transformed_default.m @@ -29,7 +29,7 @@ % opB = 'T' performs EL\(op(A_) + p*op(E_))/EU * B' % % Output -% C = EL\(op(A_) + p*op(E_))/EU * op(B) +% C = EL\(op(A_) + p*op(E_))/EU * op(B) % % This function uses another default function size_default(eqn, opts) to % obtain the number of rows of matrix A_ in structure eqn. @@ -37,59 +37,58 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% Check input parameters. -assert(ischar(opA) && ischar(opE) && ischar(opB), ... - 'MESS:error_arguments', ... - 'opA or opB is not a char'); +mess_assert(opts, ischar(opA) && ischar(opE) && ischar(opB), ... + 'error_arguments', ... + 'opA or opB is not a char'); opA = upper(opA); opE = upper(opE); opB = upper(opB); -assert((opA == 'N') || (opA == 'T'), ... - 'MESS:error_arguments', ... - 'opA is not ''N'' or ''T'''); +mess_assert(opts, (opA == 'N') || (opA == 'T'), ... + 'error_arguments', ... + 'opA is not ''N'' or ''T'''); -assert((opE == 'N') || (opE == 'T'), ... - 'MESS:error_arguments', ... - 'opE is not ''N'' or ''T'''); +mess_assert(opts, (opE == 'N') || (opE == 'T'), ... + 'error_arguments', ... + 'opE is not ''N'' or ''T'''); -assert((opB == 'N') || (opB == 'T'), ... - 'MESS:error_arguments', ... - 'opB is not ''N'' or ''T'''); +mess_assert(opts, (opB == 'N') || (opB == 'T'), ... + 'error_arguments', ... + 'opB is not ''N'' or ''T'''); -assert(isnumeric(p) && (length(p) == 1), ... - 'MESS:error_arguments', ... - 'p is not a numeric scalar'); +mess_assert(opts, isnumeric(p) && (length(p) == 1), ... + 'error_arguments', ... + 'p is not a numeric scalar'); -assert(isnumeric(B) && ismatrix(B), ... - 'MESS:error_arguments', ... - 'B has to ba a matrix'); +mess_assert(opts, isnumeric(B) && ismatrix(B), ... + 'error_arguments', ... + 'B has to ba a matrix'); %% Check data in eqn structure. -assert(isfield(eqn,'A_'), ... - 'MESS:error_arguments', ... - 'field eqn.A_ is not defined'); +mess_assert(opts, isfield(eqn, 'A_'), ... + 'error_arguments', ... + 'field eqn.A_ is not defined'); -assert(isfield(eqn,'E_'), ... - 'MESS:error_arguments', ... - 'field eqn.E_ is not defined'); +mess_assert(opts, isfield(eqn, 'E_'), ... + 'error_arguments', ... + 'field eqn.E_ is not defined'); if isfield(eqn, 'haveE') && eqn.haveE - assert(isfield(eqn, 'EL'), ... - 'MESS:error_arguments', ... - 'field eqn.EL is not defined'); - assert(isfield(eqn, 'EU'), ... - 'MESS:error_arguments', ... - 'field eqn.EU is not defined'); + mess_assert(opts, isfield(eqn, 'EL'), ... + 'error_arguments', ... + 'field eqn.EL is not defined'); + mess_assert(opts, isfield(eqn, 'EU'), ... + 'error_arguments', ... + 'field eqn.EU is not defined'); else - eqn.haveE = 0; + eqn.haveE = false; end rowA = size_default(eqn, opts); @@ -103,112 +102,94 @@ case 'N' switch opB case 'N' % Implement EL\(A_ + pE_)/EU*B. - assert(colA == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of columns of A_ differs ' ... - 'with number of rows of B']); - C = eqn.EL \ ((eqn.A_ + p*eqn.E_) ... - * (eqn.EU \ B)); + mess_assert(opts, colA == size(B, 1), ... + 'error_arguments', ... + ['number of columns of A_ differs ' ... + 'with number of rows of B']); + tempC(eqn.Eq, :) = eqn.EU \ B; + C = eqn.EL \ (eqn.ER(:, eqn.Ep) \ ... + ((eqn.A_ + p * eqn.E_) * tempC)); case 'T' % Implement EL\(A_ + pE_)/EU*B'. - assert(colA == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of columns of A_ differs ' ... - 'with number of columns of B']); - C = eqn.EL \ ((eqn.A_ + p*eqn.E_) ... - * (eqn.EU \ B')); + mess_assert(opts, colA == size(B, 2), ... + 'error_arguments', ... + ['number of columns of A_ differs ' ... + 'with number of columns of B']); + tempC(eqn.Eq, :) = eqn.EU \ B'; + C = eqn.EL \ (eqn.ER(:, eqn.Ep) \ ... + ((eqn.A_ + p * eqn.E_) * tempC)); end case 'T' - switch opB - case 'N' % Implement EU'\(A_ + pE_')/EL'*B. - assert(colA == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of columns of A_ differs ' ... - 'with number of rows of B']); - C = eqn.EU' \ ((eqn.A_ + p*eqn.E_') ... - * (eqn.EL' \ B)); - case 'T' % Implement EU'\(A_ + pE_')/EL'*B'. - assert(colA == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of columns of A_ differs ' ... - 'with number of columns of B']); - C = eqn.EU' \ ((eqn.A_ + p*eqn.E_') ... - * (eqn.EL' \ B')); - end + + mess_err(opts, 'missing_feature', ... + ['The cases where opA differs from opE ' ... + 'have not yet been implemented']); end case 'T' switch opE case 'N' - switch opB - case 'N' % Implement EL\(A_' + pE_)/EU*B. - assert(rowA == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of rows of A_ differs with ' ... - 'number rows of B']); - C = eqn.EL \ ((eqn.A_' + p*eqn.E_) ... - * (eqn.EU \ B)); - case 'T' % Implement EL\(A_' + pE_)/EU*B'. - assert(rowA == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of rows of A_ differs with ' ... - 'number of columns of B']); - C = eqn.EL \ ((eqn.A_' + p*eqn.E_) ... - * (eqn.EU \ B')); - end + + mess_err(opts, 'missing_feature', ... + ['The cases where opA differs from opE ' ... + 'have not yet been implemented']); case 'T' switch opB case 'N' % Implement EU'\(A_' + pE_')/EL'*B. - assert(rowA == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of rows of A_ differs with ' ... - 'number rows of B']); - C = eqn.EU' \ ((eqn.A_' + p*eqn.E_') ... - * (eqn.EL' \ B)); - case 'T' % Implement EU'\(A_' + pE_')/EL'*X = B'. - assert(rowA == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of rows of A_ differs with ' ... - 'number of columns of B']); - C = eqn.EU' \ ((eqn.A_' + p*eqn.E_') ... - * (eqn.EL' \ B')); + mess_assert(opts, rowA == size(B, 1), ... + 'error_arguments', ... + ['number of rows of A_ differs with ' ... + 'number rows of B']); + tempC = (eqn.A_' + p * eqn.E_') * (eqn.ER(:, eqn.Ep)' \ ... + (eqn.EL' \ B)); + C = eqn.EU' \ tempC(eqn.Eq, :); + + case 'T' % Implement EU'\(A_' + pE_')/EL'*B'. + mess_assert(opts, rowA == size(B, 2), ... + 'error_arguments', ... + ['number of rows of A_ differs with ' ... + 'number of columns of B']); + tempC = (eqn.A_' + p * eqn.E_') * (eqn.ER(:, eqn.Ep)' \ ... + (eqn.EL' \ B')); + C = eqn.EU' \ tempC(eqn.Eq, :); end end end -else % Case of E_ = I_n, was set by init. +else % Case of E_ = I_n uses eqn.I_ set by init and does not need + % sate space transformation switch opA case 'N' switch opB case 'N' % Implement (A_ + pI_n)*B. - assert(colA == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of columns of A_ differs with ' ... - 'number of rows of B']); - C = (eqn.A_ + p*eqn.E_) * B; + mess_assert(opts, colA == size(B, 1), ... + 'error_arguments', ... + ['number of columns of A_ differs with ' ... + 'number of rows of B']); + C = (eqn.A_ + p * eqn.I_) * B; case 'T' % Implement (A_ + pI_n)*B'. - assert(colA == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of columns of A_ differs with ' ... - 'number of columns of B']); - C = (eqn.A_ + p*eqn.E_) * B'; + mess_assert(opts, colA == size(B, 2), ... + 'error_arguments', ... + ['number of columns of A_ differs with ' ... + 'number of columns of B']); + C = (eqn.A_ + p * eqn.I_) * B'; end case 'T' switch opB case 'N' % Implement (A_' + pE_)*B. - assert(rowA == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of rows of A_ differs with ' ... - 'number rows of B']); - C = (eqn.A_' + p*eqn.E_) * B; + mess_assert(opts, rowA == size(B, 1), ... + 'error_arguments', ... + ['number of rows of A_ differs with ' ... + 'number rows of B']); + C = (eqn.A_' + p * eqn.I_) * B; case 'T' % Implement (A_' + pE_)*B'. - assert(rowA == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of rows of A_ differs with ' ... - 'number of columns of B']); - C = (eqn.A_' + p*eqn.E_) * B'; + mess_assert(opts, rowA == size(B, 2), ... + 'error_arguments', ... + ['number of rows of A_ differs with ' ... + 'number of columns of B']); + C = (eqn.A_' + p * eqn.I_) * B'; end end diff --git a/usfs/state_space_transformed_default/mul_E_state_space_transformed_default.m b/usfs/state_space_transformed_default/mul_E_state_space_transformed_default.m index 0e06a58..2b2ad41 100644 --- a/usfs/state_space_transformed_default/mul_E_state_space_transformed_default.m +++ b/usfs/state_space_transformed_default/mul_E_state_space_transformed_default.m @@ -1,104 +1,81 @@ function C = mul_E_state_space_transformed_default(eqn, opts, opE, B, opB) %% function C = mul_E_state_space_transformed_default(eqn,opts,opE,B,opB) % -% This function returns C = E_*B, where matrix E_ given by structure eqn -% and input matrix B could be transposed. -% Matrix E_ is assumed to be quadratic. +% This function returns C = B, input matrix B could be transposed. +% Matrix E_ may exist in the eqn structure, but is ignored since the +% transformed system is assumed to be in standard state space form, i.e. +% the transformed E is the identity. % % Inputs % eqn struct contains data for equations % % opts struct contains parameters for the algorithm % -% opE character specifying the shape of E_ -% opE = 'N' performs E_*opB(B) -% opE = 'T' performs E_'*opB(B) +% opE character specifying the transposition of the +% transformed E. +% unused since the transformed E acts as an identity. +% (still needs to be provided for consistency) % % B m-x-p matrix % % opB character specifying the shape of B -% opB = 'N' performs opE(E_)*B -% opB = 'T' performs opE(E_)*B' +% opB = 'N' sets C=B +% opB = 'T' sets C=B' % % Output -% C = opE(E_)*opB(B) +% C = opB(B) % -% This function uses another default function size_default(eqn, opts) to -% obtain the number of rows of matrix E_ in structure eqn. +% This function uses another user supplied function +% (size_state_space_transformed_default(eqn, opts) to obtain the number of +% rows of the transformed E matrix. % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% Check input parameters. -assert(ischar(opE) && ischar(opB), ... - 'MESS:error_arguments', ... - 'opE or opB is not a char'); +mess_assert(opts, ischar(opE) && ischar(opB), ... + 'error_arguments', ... + 'opE or opB is not a char'); opE = upper(opE); opB = upper(opB); -assert((opE == 'N') || (opE == 'T'), ... - 'MESS:error_arguments', ... - 'opE is not ''N'' or ''T'''); +mess_assert(opts, (opE == 'N') || (opE == 'T'), ... + 'error_arguments', ... + 'opE is not ''N'' or ''T'''); -assert((opB == 'N') || (opB == 'T'), ... - 'MESS:error_arguments', ... - 'opB is not ''N'' or ''T'''); +mess_assert(opts, (opB == 'N') || (opB == 'T'), ... + 'error_arguments', ... + 'opB is not ''N'' or ''T'''); -assert(isnumeric(B) && ismatrix(B), ... - 'MESS:error_arguments', ... - 'B has to ba a matrix'); +mess_assert(opts, isnumeric(B) && ismatrix(B), ... + 'error_arguments', ... + 'B has to ba a matrix'); %% Check data in eqn structure. -assert(isfield(eqn,'E_'), ... - 'MESS:error_arguments', ... - 'field eqn.E_ is not defined'); -rowE = size_default(eqn, opts); +rowE = size_state_space_transformed_default(eqn, opts); colE = rowE; %% Perform multiplication. -switch opE - case 'N' - switch opB - case 'N' % Implement operation E_*B. - assert(colE == size(B, 1), ... - 'MESS:error_arguments', ... +switch opB + case 'N' % Implement operation E_*B. + mess_assert(opts, colE == size(B, 1), ... + 'error_arguments', ... ['number of columns of E_ differs with ' ... - 'number of rows of B']); - C = eqn.E_ * B; + 'number of rows of B']); + C = B; - case 'T' % Implement operation E_*B'. - assert(colE == size(B, 2), ... - 'MESS:error_arguments', ... + case 'T' % Implement operation E_*B'. + mess_assert(opts, colE == size(B, 2), ... + 'error_arguments', ... ['number of columns of E_ differs with ' ... - 'number of columns of B']); - C = eqn.E_ * B'; - end - - case 'T' - switch opB - case 'N' % Implement operation E_'*B. - assert(rowE == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of rows of E_ differs with ' ... - 'number rows of B']); - C = eqn.E_' * B; - - case 'T' % Implement operation E_'*B'. - assert(rowE == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of rows of E_ differs with ' ... - 'number of columns of B']); - C = eqn.E_' * B'; - end - -end + 'number of columns of B']); + C = B'; end diff --git a/usfs/state_space_transformed_default/private/LU_A.m b/usfs/state_space_transformed_default/private/LU_A.m new file mode 100644 index 0000000..81c3b52 --- /dev/null +++ b/usfs/state_space_transformed_default/private/LU_A.m @@ -0,0 +1,24 @@ +function eqn = LU_A(eqn) +% LU_A computes and caches LU decomposition of eqn.A_ + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +if isfield(eqn, 'AL') && isfield(eqn, 'AU') && ... + isfield(eqn, 'Ap') && isfield(eqn, 'Aq') && ... + isfield(eqn, 'AR') + if isfield(eqn, 'Acount') + eqn.Acount = eqn.Acount + 1; + else + eqn.Acount = 2; + end +else + [eqn.AL, eqn.AU, eqn.Ap, eqn.Aq, eqn.AR] = lu(eqn.A_, 'vector'); + eqn.iAq(eqn.Aq) = 1:size(eqn.A_, 1); + eqn.Acount = 1; +end diff --git a/usfs/state_space_transformed_default/private/LU_A_clean.m b/usfs/state_space_transformed_default/private/LU_A_clean.m new file mode 100644 index 0000000..ca0416e --- /dev/null +++ b/usfs/state_space_transformed_default/private/LU_A_clean.m @@ -0,0 +1,25 @@ +function eqn = LU_A_clean(eqn, opts) +% LU_A_CLEAN removes cached LU decomposition of eqn.A_ + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% +mess_assert(opts, isfield(eqn, 'Acount'), ... + 'error_arguments', ... + 'field eqn.Acount is not defined.'); + +if eqn.Acount > 1 + eqn.Acount = eqn.Acount - 1; +else + eqn = rmfield(eqn, 'Acount'); + eqn = rmfield(eqn, 'AL'); + eqn = rmfield(eqn, 'AU'); + eqn = rmfield(eqn, 'Ap'); + eqn = rmfield(eqn, 'Aq'); + eqn = rmfield(eqn, 'iAq'); + eqn = rmfield(eqn, 'AR'); +end diff --git a/usfs/state_space_transformed_default/private/LU_E.m b/usfs/state_space_transformed_default/private/LU_E.m new file mode 100644 index 0000000..f5e9d6b --- /dev/null +++ b/usfs/state_space_transformed_default/private/LU_E.m @@ -0,0 +1,43 @@ +function eqn = LU_E(eqn) +% LU_E computes and caches LU decomposition of eqn.E_ + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +if isfield(eqn, 'haveE') && eqn.haveE + if isfield(eqn, 'EL') && isfield(eqn, 'EU') && ... + isfield(eqn, 'Ep') && isfield(eqn, 'Eq') && ... + isfield(eqn, 'ER') + if isfield(eqn, 'Ecount') + eqn.Ecount = eqn.Ecount + 1; + else + eqn.Ecount = 2; + end + else + if issymmetric(eqn.E_) + % try to compute the Cholesky factorization if E is symmetric + [eqn.EL, p, eqn.Ep] = chol(eqn.E_, 'lower', 'vector'); + else + p = 1; + end + % if E is also positive definite, p==0 + if p == 0 + eqn.EU = eqn.EL'; + eqn.Eq = eqn.Ep; + eqn.ER = speye(size(eqn.E_)); + % reorder eqn.ER already once so that when we reapply + % the reordering in + % ss_to_dss_state_space_transformed_default we get the identity + % eqn.ER = eqn.ER(eqn.Ep,:); + else + [eqn.EL, eqn.EU, eqn.Ep, eqn.Eq, eqn.ER] = lu(eqn.E_, 'vector'); + end + eqn.iEq(eqn.Eq) = 1:size(eqn.E_, 1); + eqn.Ecount = 1; + end +end diff --git a/usfs/state_space_transformed_default/private/LU_E_clean.m b/usfs/state_space_transformed_default/private/LU_E_clean.m new file mode 100644 index 0000000..348f227 --- /dev/null +++ b/usfs/state_space_transformed_default/private/LU_E_clean.m @@ -0,0 +1,28 @@ +function eqn = LU_E_clean(eqn, opts) +% LU_E_CLEAN removes cached LU decomposition of eqn.E_ + +% +% This file is part of the M-M.E.S.S. project +% (http://www.mpi-magdeburg.mpg.de/projects/mess). +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. +% All rights reserved. +% License: BSD 2-Clause License (see COPYING) +% + +if isfield(eqn, 'haveE') && eqn.haveE + mess_assert(opts, isfield(eqn, 'Ecount'), ... + 'error_arguments', ... + 'field eqn.Ecount is not defined.'); + + if eqn.Ecount > 1 + eqn.Ecount = eqn.Ecount - 1; + else + eqn = rmfield(eqn, 'Ecount'); + eqn = rmfield(eqn, 'EL'); + eqn = rmfield(eqn, 'EU'); + eqn = rmfield(eqn, 'Ep'); + eqn = rmfield(eqn, 'Eq'); + eqn = rmfield(eqn, 'iEq'); + eqn = rmfield(eqn, 'ER'); + end +end diff --git a/usfs/state_space_transformed_default/size_state_space_transformed_default.m b/usfs/state_space_transformed_default/size_state_space_transformed_default.m index 47b7061..83c6d84 100644 --- a/usfs/state_space_transformed_default/size_state_space_transformed_default.m +++ b/usfs/state_space_transformed_default/size_state_space_transformed_default.m @@ -1,4 +1,4 @@ -function n = size_state_space_transformed_default(eqn, ~) +function n = size_state_space_transformed_default(eqn, opts) %% function n = size_default(eqn, opts) % % This function returns the number of rows of matrix A_ in structure eqn. @@ -16,14 +16,13 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - -assert(isfield(eqn, 'A_'), ... - 'MESS:error_arguments', ... - 'field eqn.A_ is not defined'); +mess_assert(opts, isfield(eqn, 'A_'), ... + 'error_arguments', ... + 'field eqn.A_ is not defined'); n = size(eqn.A_, 1); diff --git a/usfs/state_space_transformed_default/sol_A_post_state_space_transformed_default.m b/usfs/state_space_transformed_default/sol_A_post_state_space_transformed_default.m index 07e70a9..a8fef7e 100644 --- a/usfs/state_space_transformed_default/sol_A_post_state_space_transformed_default.m +++ b/usfs/state_space_transformed_default/sol_A_post_state_space_transformed_default.m @@ -22,22 +22,12 @@ % with A and E % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - -assert(isfield(eqn, 'Ecount'), ... - 'MESS:error_arguments', ... - 'field eqn.Scount is not defined.'); - -if eqn.Ecount > 1 - eqn.Ecount = eqn.Ecount - 1; -else - eqn = rmfield(eqn, 'Ecount'); - eqn = rmfield(eqn, 'EL'); - eqn = rmfield(eqn, 'EU'); -end +eqn = LU_A_clean(eqn, opts); +eqn = LU_E_clean(eqn, opts); diff --git a/usfs/state_space_transformed_default/sol_A_pre_state_space_transformed_default.m b/usfs/state_space_transformed_default/sol_A_pre_state_space_transformed_default.m index 0d0f867..8f7a128 100644 --- a/usfs/state_space_transformed_default/sol_A_pre_state_space_transformed_default.m +++ b/usfs/state_space_transformed_default/sol_A_pre_state_space_transformed_default.m @@ -22,21 +22,12 @@ % with A and E % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - -if isfield(eqn, 'EL') && isfield(eqn, 'EU') - if isfield(eqn, 'Ecount') - eqn.Ecount = eqn.Ecount + 1; - else - eqn.Ecount = 2; - end -else - [eqn.EL, eqn.EU] = lu(eqn.E_); - eqn.Ecount = 1; -end +eqn = LU_E(eqn); +eqn = LU_A(eqn); diff --git a/usfs/state_space_transformed_default/sol_A_state_space_transformed_default.m b/usfs/state_space_transformed_default/sol_A_state_space_transformed_default.m index e38aa8d..b73e64a 100644 --- a/usfs/state_space_transformed_default/sol_A_state_space_transformed_default.m +++ b/usfs/state_space_transformed_default/sol_A_state_space_transformed_default.m @@ -13,7 +13,7 @@ % opA character specifying the shape of A_ % opA = 'N' solves A_*X = opB(B) % opA = 'T' solves A_'*X = opB(B) -% and if eqn.haveE == 1 +% and if eqn.haveE == true % opA = 'N' solves (EL\A_/EU)*X = opB(B) % opA = 'T' solves (EU'\A_'/EL')*X = opB(B) % @@ -22,7 +22,7 @@ % opB character specifying the shape of B % opB = 'N' solves opA(A_)*X = B % opB = 'T' solves opA(A_)*X = B' -% and if eqn.haveE == 1 +% and if eqn.haveE == true % opB = 'N' solves opA(EL\A_/EU)*X = B % opB = 'T' solves opA(EL\A_/EU)*X = B' % @@ -35,48 +35,47 @@ % obtain the number of rows of matrix A_ in structure eqn. % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% Check input parameters. -assert(ischar(opA) && ischar(opB), ... - 'MESS:error_arguments', ... - 'opA or opB is not a char'); +mess_assert(opts, ischar(opA) && ischar(opB), ... + 'error_arguments', ... + 'opA or opB is not a char'); opA = upper(opA); opB = upper(opB); -assert((opA == 'N') || (opA == 'T'), ... - 'MESS:error_arguments', ... - 'opA is not ''N'' or ''T'''); +mess_assert(opts, (opA == 'N') || (opA == 'T'), ... + 'error_arguments', ... + 'opA is not ''N'' or ''T'''); -assert((opB == 'N') || (opB == 'T'), ... - 'MESS:error_arguments', ... - 'opB is not ''N'' or ''T'''); +mess_assert(opts, (opB == 'N') || (opB == 'T'), ... + 'error_arguments', ... + 'opB is not ''N'' or ''T'''); -assert(isnumeric(B) && ismatrix(B), ... - 'MESS:error_arguments', ... - 'B has to ba a matrix'); +mess_assert(opts, isnumeric(B) && ismatrix(B), ... + 'error_arguments', ... + 'B has to ba a matrix'); %% Check data in eqn structure. -assert(isfield(eqn,'A_'), ... - 'MESS:error_arguments', ... - 'field eqn.A_ is not defined'); +mess_assert(opts, isfield(eqn, 'A_'), ... + 'error_arguments', ... + 'field eqn.A_ is not defined'); if isfield(eqn, 'haveE') && eqn.haveE - assert(isfield(eqn, 'EL'), ... - 'MESS:error_arguments', ... - 'field eqn.EL is not defined'); - assert(isfield(eqn, 'EU'), ... - 'MESS:error_arguments', ... - 'field eqn.EU is not defined'); + mess_assert(opts, isfield(eqn, 'EL'), ... + 'error_arguments', ... + 'field eqn.EL is not defined'); + mess_assert(opts, isfield(eqn, 'EU'), ... + 'error_arguments', ... + 'field eqn.EU is not defined'); else - eqn.haveE = 0; + eqn.haveE = false; end rowA = size_default(eqn, opts); @@ -88,72 +87,90 @@ case 'N' switch opB case 'N' % Implement solve (EL\A_/EU)*X = B. - assert(rowA == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of rows of A_ differs with ' ... - 'number rows of B']); - X = eqn.EU * (eqn.A_ \ (eqn.EL * B)); + mess_assert(opts, rowA == size(B, 1), ... + 'error_arguments', ... + ['number of rows of A_ differs with ' ... + 'number rows of B']); + + tempX(eqn.iEq(eqn.Aq), :) = eqn.AU \ (eqn.AL \ ... + (eqn.AR(:, eqn.Ap) \ (eqn.ER(:, eqn.Ep) * ... + (eqn.EL * B)))); + X = eqn.EU * tempX; case 'T' % Implement solve (EL\A_/EU)*X = B'. - assert(rowA == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of rows of A_ differs with ' ... - 'number of columns of B']); - X = eqn.EU * (eqn.A_ \ (eqn.EL * B')); + mess_assert(opts, rowA == size(B, 2), ... + 'error_arguments', ... + ['number of rows of A_ differs with ' ... + 'number of columns of B']); + tempX(eqn.iEq(eqn.Aq), :) = eqn.AU \ (eqn.AL \ ... + (eqn.AR(:, eqn.Ap) \ (eqn.ER(:, eqn.Ep) * ... + (eqn.EL * B')))); + X = eqn.EU * tempX; end case 'T' switch opB case 'N' % Implement solve (EL\A_'/EU)'*X = B. - assert(colA == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of columns of A_ differs with ' ... - 'number of rows of B']); - X = eqn.EL' * (eqn.A_' \ (eqn.EU' * B)); + mess_assert(opts, colA == size(B, 1), ... + 'error_arguments', ... + ['number of columns of A_ differs with ' ... + 'number of rows of B']); + + tempX(eqn.iAq(eqn.Eq), :) = eqn.EU' * B; + X = eqn.EL' * (eqn.ER(:, eqn.Ep)' * (eqn.AR(:, eqn.Ap)' \ ... + (eqn.AL' \ (eqn.AU' \ tempX)))); case 'T' % Implement solve (EL\A_'/EU)'*X = B'. - assert(colA == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of columns of A_ differs with ' ... - 'number of columns of B']); - X = eqn.EL' * (eqn.A_' \ (eqn.EU' * B')); + mess_assert(opts, colA == size(B, 2), ... + 'error_arguments', ... + ['number of columns of A_ differs with ' ... + 'number of columns of B']); + tempX(eqn.iAq(eqn.Eq), :) = eqn.EU' * B'; + X = eqn.EL' * (eqn.ER(:, eqn.Ep)' * (eqn.AR(:, eqn.Ap)' \ ... + (eqn.AL' \ (eqn.AU' \ tempX)))); end end -else +else % No E so no transformation required switch opA case 'N' switch opB case 'N' % Implement solve A_*X = B. - assert(rowA == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of rows of A_ differs with ' ... - 'number rows of B']); - X = eqn.A_ \ B; + mess_assert(opts, rowA == size(B, 1), ... + 'error_arguments', ... + ['number of rows of A_ differs with ' ... + 'number rows of B']); + + X(eqn.Aq, :) = eqn.AU \ (eqn.AL \ (eqn.AR(:, eqn.Ap) \ B)); case 'T' % Implement solve A_*X = B'. - assert(rowA == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of rows of A_ differs with ' ... - 'number of columns of B']); - X = eqn.A_ \ B'; + mess_assert(opts, rowA == size(B, 2), ... + 'error_arguments', ... + ['number of rows of A_ differs with ' ... + 'number of columns of B']); + + X(eqn.Aq, :) = eqn.AU \ (eqn.AL \ (eqn.AR(:, eqn.Ap) \ B')); + end case 'T' switch opB case 'N' % Implement solve A_'*X = B. - assert(colA == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of columns of A_ differs with ' ... - 'number of rows of B']); - X = eqn.A_' \ B; + mess_assert(opts, colA == size(B, 1), ... + 'error_arguments', ... + ['number of columns of A_ differs with ' ... + 'number of rows of B']); + + X = eqn.AR(:, eqn.Ap)' \ (eqn.AL' \ (eqn.AU' \ B(eqn.Aq, :))); case 'T' % Implement solve A_'*X = B'. - assert(colA == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of columns of A_ differs with ' ... - 'number of columns of B']); - X = eqn.A_' \ B'; + mess_assert(opts, colA == size(B, 2), ... + 'error_arguments', ... + ['number of columns of A_ differs with ' ... + 'number of columns of B']); + + X = eqn.AR(:, eqn.Ap)' \ (eqn.AL' \ (eqn.AU' \ B(:, eqn.Aq)')); + end end diff --git a/usfs/state_space_transformed_default/sol_ApE_post_state_space_transformed_default.m b/usfs/state_space_transformed_default/sol_ApE_post_state_space_transformed_default.m index 880c2e1..d5b8fe2 100644 --- a/usfs/state_space_transformed_default/sol_ApE_post_state_space_transformed_default.m +++ b/usfs/state_space_transformed_default/sol_ApE_post_state_space_transformed_default.m @@ -22,22 +22,23 @@ % with A and E % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % +if eqn.haveE + mess_assert(opts, isfield(eqn, 'Ecount'), ... + 'error_arguments', ... + 'field eqn.Ecount is not defined.'); -assert(isfield(eqn, 'Ecount'), ... - 'MESS:error_arguments', ... - 'field eqn.Scount is not defined.'); - -if eqn.Ecount > 1 - eqn.Ecount = eqn.Ecount - 1; -else - eqn = rmfield(eqn, 'Ecount'); - eqn = rmfield(eqn, 'EL'); - eqn = rmfield(eqn, 'EU'); + if eqn.Ecount > 1 + eqn.Ecount = eqn.Ecount - 1; + else + eqn = rmfield(eqn, 'Ecount'); + eqn = rmfield(eqn, 'EL'); + eqn = rmfield(eqn, 'EU'); + end end diff --git a/usfs/state_space_transformed_default/sol_ApE_pre_state_space_transformed_default.m b/usfs/state_space_transformed_default/sol_ApE_pre_state_space_transformed_default.m index 1d70d7d..e86c82c 100644 --- a/usfs/state_space_transformed_default/sol_ApE_pre_state_space_transformed_default.m +++ b/usfs/state_space_transformed_default/sol_ApE_pre_state_space_transformed_default.m @@ -22,21 +22,11 @@ % with A and E % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - -if isfield(eqn, 'EL') && isfield(eqn, 'EU') - if isfield(eqn, 'Ecount') - eqn.Ecount = eqn.Ecount + 1; - else - eqn.Ecount = 2; - end -else - [eqn.EL, eqn.EU] = lu(eqn.E_); - eqn.Ecount = 1; -end +eqn = LU_E(eqn); diff --git a/usfs/state_space_transformed_default/sol_ApE_state_space_transformed_default.m b/usfs/state_space_transformed_default/sol_ApE_state_space_transformed_default.m index 446feef..2e328f9 100644 --- a/usfs/state_space_transformed_default/sol_ApE_state_space_transformed_default.m +++ b/usfs/state_space_transformed_default/sol_ApE_state_space_transformed_default.m @@ -29,7 +29,7 @@ % opB = 'T' solves EL\(op(A_) + p*op(E_))/EU*X = B' % % Output -% X matrix fulfilling equation +% X matrix fulfilling equation % EL\(op(A_) + p*op(E_))*EU\X = opB(B) % % This function uses another default function size_default(eqn, opts) to @@ -38,59 +38,57 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% Check input parameters. -assert(ischar(opA) && ischar(opE) && ischar(opB), ... - 'MESS:error_arguments', ... - 'opA, opE or opB is not a char'); +mess_assert(opts, ischar(opA) && ischar(opE) && ischar(opB), ... + 'error_arguments', ... + 'opA, opE or opB is not a char'); opA = upper(opA); opE = upper(opE); opB = upper(opB); -assert((opA == 'N') || (opA == 'T'), ... - 'MESS:error_arguments', ... - 'opA is not ''N'' or ''T'''); +mess_assert(opts, (opA == 'N') || (opA == 'T'), ... + 'error_arguments', ... + 'opA is not ''N'' or ''T'''); -assert((opE == 'N') || (opE == 'T'), ... - 'MESS:error_arguments', ... - 'opE is not ''N'' or ''T'''); +mess_assert(opts, (opE == 'N') || (opE == 'T'), ... + 'error_arguments', ... + 'opE is not ''N'' or ''T'''); -assert((opB == 'N') || (opB == 'T'), ... - 'MESS:error_arguments', ... - 'opB is not ''N'' or ''T'''); +mess_assert(opts, (opB == 'N') || (opB == 'T'), ... + 'error_arguments', ... + 'opB is not ''N'' or ''T'''); -assert(isnumeric(p) && (length(p) == 1), ... - 'MESS:error_arguments', ... - 'p is not a numeric scalar'); +mess_assert(opts, isnumeric(p) && (length(p) == 1), ... + 'error_arguments', ... + 'p is not a numeric scalar'); -assert(isnumeric(B) && ismatrix(B), ... - 'MESS:error_arguments', ... - 'B has to ba a matrix'); +mess_assert(opts, isnumeric(B) && ismatrix(B), ... + 'error_arguments', ... + 'B has to ba a matrix'); %% Check data in eqn structure. -assert(isfield(eqn,'A_'), ... - 'MESS:error_arguments', ... - 'field eqn.A_ is not defined'); - -assert(isfield(eqn,'E_'), ... - 'MESS:error_arguments', ... - 'field eqn.E_ is not defined'); +mess_assert(opts, isfield(eqn, 'A_'), ... + 'error_arguments', ... + 'field eqn.A_ is not defined'); if isfield(eqn, 'haveE') && eqn.haveE - assert(isfield(eqn, 'EL'), ... - 'MESS:error_arguments', ... - 'field eqn.EL is not defined'); - assert(isfield(eqn, 'EU'), ... - 'MESS:error_arguments', ... - 'field eqn.EU is not defined'); + mess_assert(opts, isfield(eqn, 'E_'), ... + 'error_arguments', ... + 'field eqn.E_ is not defined'); + mess_assert(opts, isfield(eqn, 'EL'), ... + 'error_arguments', ... + 'field eqn.EL is not defined'); + mess_assert(opts, isfield(eqn, 'EU'), ... + 'error_arguments', ... + 'field eqn.EU is not defined'); else - eqn.haveE = 0; + eqn.haveE = false; end rowA = size_default(eqn, opts); @@ -103,113 +101,101 @@ switch opE case 'N' switch opB - case 'N' % Implement EL\(A_ + pE_)/EU*X = B. - assert(rowA == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of rows of A_ differs with ' ... - 'number rows of B']); - X = eqn.EU * ((eqn.A_ + p*eqn.E_) ... - \ (eqn.EL * B)); - case 'T' % Implement EL\(A_ + pE_)/EU*X = B'. - assert(rowA == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of rows of A_ differs with ' ... - 'number of columns of B']); - X = eqn.EU * ((eqn.A_ + p*eqn.E_) ... - \ (eqn.EL * B')); + case 'N' % Implement EU*(A_ + pE_)\EL*X = B. + mess_assert(opts, rowA == size(B, 1), ... + 'error_arguments', ... + ['number of rows of A_ differs from ' ... + 'number rows of B']); + Xtemp = (eqn.A_ + p * eqn.E_) \ ... + (eqn.ER(:, eqn.Ep) * (eqn.EL * B)); + X = eqn.EU * Xtemp(eqn.Eq, :); + case 'T' % Implement EU*(A_ + pE_)\EL*X = B'. + mess_assert(opts, rowA == size(B, 2), ... + 'error_arguments', ... + ['number of rows of A_ differs from ' ... + 'number of columns of B']); + Xtemp = (eqn.A_ + p * eqn.E_) \ ... + (eqn.ER(:, eqn.Ep) * (eqn.EL * B')); + X = eqn.EU * Xtemp(eqn.Eq, :); end case 'T' - switch opB - case 'N' % Implement EU'\(A_ + pE_')/EL'*X = B. - assert(rowA == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of rows of A_ differs with ' ... - 'number rows of B']); - X = eqn.EL' * ((eqn.A_ + p*eqn.E_') ... - \ (eqn.EU' * B)); - case 'T' % Implement EU'\(A_ + pE_')/EL'*X = B'. - assert(rowA == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of rows of A_ differs with ' ... - 'number of columns of B']); - X = eqn.EL' * ((eqn.A_ + p*eqn.E_') ... - \ (eqn.EU' * B)); - end + mess_err(opts, 'missing_feature', ... + ['The cases where opA differs from opE ' ... + 'have not yet been implemented']); end case 'T' switch opE case 'N' - switch opB - case 'N' % Implement EL\(A_' + pE_)/EU*X = B. - assert(colA == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of columns of A_ differs ' ... - 'with number of rows of B']); - X = eqn.EU * ((eqn.A_' + p*eqn.E_) ... - \ (eqn.EL * B)); - case 'T' % Implement EL\(A_' + pE_)/EU*X = B. - assert(colA == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of columns of A_ differs ' ... - 'with number of columns of B']); - X = eqn.EU * ((eqn.A_' + p*eqn.E_) ... - \ (eqn.EL * B')); - end + mess_err(opts, 'missing_feature', ... + ['The cases where opA differs from opE ' ... + 'have not yet been implemented']); case 'T' switch opB - case 'N' % Implement EU'\(A_' + pE_')/EL'*X = B. - assert(colA == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of columns of A_ differs ' ... - 'with number of rows of B']); - X = eqn.EL' * ((eqn.A_' + p*eqn.E_') ... - \ (eqn.EU' * B)); - case 'T' % Implement EU'\(A_' + pE_')/EL'*X = B'. - assert(colA == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of columns of A_ differs ' ... - 'with number of columns of B']); - X = eqn.EL' * ((eqn.A_' + p*eqn.E_') ... - \ (eqn.EU' * B)); - end + case 'N' % Implement EU*(A_' + pE_')\EL*X = B. + mess_assert(opts, rowA == size(B, 1), ... + 'error_arguments', ... + ['number of rows of A_ differs from ' ... + 'number rows of B']); + Xtemp(eqn.Eq, :) = eqn.EU' * B; + X = eqn.EL' * (eqn.ER(:, eqn.Ep)' * ... + ((eqn.A_' + p * eqn.E_') \ Xtemp)); + + case 'T' % Implement EU*(A_' + pE_')\EL*X = B'. + mess_assert(opts, rowA == size(B, 2), ... + 'error_arguments', ... + ['number of rows of A_ differs from ' ... + 'number of columns of B']); + Xtemp(eqn.Eq, :) = eqn.EU' * B'; + X = eqn.EL' * (eqn.ER(:, eqn.Ep)' * ... + ((eqn.A_' + p * eqn.E_') \ Xtemp)); + + end end end -else % Case of E_ = I_n, was set by init. +else % Case of E_ = I_n uses eqn.I_ set by init and does not need + % sate space transformation was set by init. switch opA case 'N' switch opB - case 'N' % Implement (A_ + pI_n)*X = B. - assert(rowA == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of rows of A_ differs with ' ... - 'number rows of B']); - X = (eqn.A_ + p*eqn.E_) \ B; - case 'T' % Implement (A_ + pI_n)*X = B'. - assert(rowA == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of rows of A_ differs with ' ... - 'number of columns of B']); - X = (eqn.A_ + p*eqn.E_) \ B'; + + case 'N' % Implement (A_ + pI_n)\X = B. + + mess_assert(opts, rowA == size(B, 1), ... + 'error_arguments', ... + ['number of rows of A_ differs from ' ... + 'number rows of B']); + X = (eqn.A_ + p * eqn.I_) \ B; + + case 'T' % Implement (A_ + pI_n)\X = B'. + + mess_assert(opts, rowA == size(B, 2), ... + 'error_arguments', ... + ['number of rows of A_ differs from ' ... + 'number of columns of B']); + X = (eqn.A_ + p * eqn.I_) \ B'; end case 'T' switch opB - case 'N' % Implement (A_' + pE_)*X = B. - assert(colA == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of columns of A_ differs ' ... - 'with number of rows of B']); - X = (eqn.A_' + p*eqn.E_) \ B; - case 'T' % Implement (A_' + pE_)*X = B'. - assert(colA == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of columns of A_ differs ' ... - 'with number of columns of B']); - X = (eqn.A_' + p*eqn.E_) \ B'; + case 'N' % Implement (A_' + pE_)\X = B. + + mess_assert(opts, colA == size(B, 1), ... + 'error_arguments', ... + ['number of columns of A_ differs ' ... + 'from number of rows of B']); + X = (eqn.A_' + p * eqn.I_) \ B; + + case 'T' % Implement (A_' + pE_)\X = B'. + + mess_assert(opts, colA == size(B, 2), ... + 'error_arguments', ... + ['number of columns of A_ differs ' ... + 'from number of columns of B']); + X = (eqn.A_' + p * eqn.I_) \ B'; end end diff --git a/usfs/state_space_transformed_default/sol_E_post_state_space_transformed_default.m b/usfs/state_space_transformed_default/sol_E_post_state_space_transformed_default.m deleted file mode 100644 index b372db7..0000000 --- a/usfs/state_space_transformed_default/sol_E_post_state_space_transformed_default.m +++ /dev/null @@ -1,43 +0,0 @@ -function [eqn, opts, oper] = ... - sol_E_post_state_space_transformed_default(eqn, opts, oper) -%% function [eqn, opts, oper] = ... -% sol_E_post_state_space_transformed_default(eqn, opts, oper) -% -% function post finalizes data and/or functions -% -% Input -% eqn struct contains data for equations -% -% opts struct contains parameters for the algorithm -% -% oper struct contains function handles for operation -% with A and E -% -% Output -% eqn struct contains data for equations -% -% opts struct contains parameters for the algorithm -% -% oper struct contains function handles for operation -% with A and E - -% -% This file is part of the M-M.E.S.S. project -% (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. -% All rights reserved. -% License: BSD 2-Clause License (see COPYING) -% - - -assert(isfield(eqn, 'Ecount'), ... - 'MESS:error_arguments', ... - 'field eqn.Scount is not defined.'); - -if eqn.Ecount > 1 - eqn.Ecount = eqn.Ecount - 1; -else - eqn = rmfield(eqn, 'Ecount'); - eqn = rmfield(eqn, 'EL'); - eqn = rmfield(eqn, 'EU'); -end diff --git a/usfs/state_space_transformed_default/sol_E_pre_state_space_transformed_default.m b/usfs/state_space_transformed_default/sol_E_pre_state_space_transformed_default.m deleted file mode 100644 index a1d7813..0000000 --- a/usfs/state_space_transformed_default/sol_E_pre_state_space_transformed_default.m +++ /dev/null @@ -1,43 +0,0 @@ -function [eqn, opts, oper] = ... - sol_E_pre_state_space_transformed_default(eqn, opts, oper) -%% function [eqn, opts, oper] = ... -% sol_E_pre_state_space_transformed_default(eqn, opts, oper) -% -% function pre initializes data and/or functions -% -% Input -% eqn struct contains data for equations -% -% opts struct contains parameters for the algorithm -% -% oper struct contains function handles for operation -% with A and E -% -% Output -% eqn struct contains data for equations -% -% opts struct contains parameters for the algorithm -% -% oper struct contains function handles for operation -% with A and E - -% -% This file is part of the M-M.E.S.S. project -% (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. -% All rights reserved. -% License: BSD 2-Clause License (see COPYING) -% - - - -if isfield(eqn, 'EL') && isfield(eqn, 'EU') - if isfield(eqn, 'Ecount') - eqn.Ecount = eqn.Ecount + 1; - else - eqn.Ecount = 2; - end -else - [eqn.EL, eqn.EU] = lu(eqn.E_); - eqn.Ecount = 1; -end diff --git a/usfs/state_space_transformed_default/sol_E_state_space_transformed_default.m b/usfs/state_space_transformed_default/sol_E_state_space_transformed_default.m index 84a3f37..dfeac25 100644 --- a/usfs/state_space_transformed_default/sol_E_state_space_transformed_default.m +++ b/usfs/state_space_transformed_default/sol_E_state_space_transformed_default.m @@ -1,105 +1,78 @@ function X = sol_E_state_space_transformed_default(eqn, opts, opE, B, opB) %% function X = sol_E_state_space_transformed_default(eqn,opts,opE,B,opB) % -% This function returns X = E_\B, where matrix E_ given by structure eqn -% and input matrix B could be transposed. -% Matrix E_ is assumed to be quadratic. +% This function returns X = B; the input matrix B could be transposed. +% The transformed matrix E is assumed to be the identity in this function +% set. A non-identity E_ may still be present in the eqn structure and will +% be used in the transformation. % % Inputs % eqn struct contains data for equations % % opts struct contains parameters for the algorithm % -% opE character specifying the shape of E_ -% opE = 'N' solves E_*X = opB(B) -% opE = 'T' solves E_'*X = opB(B) +% opE character specifying the shape of the +% transformed E. +% unused since the transformed E acts as an identity. +% (still needs to be provided for consistency) % % B m-x-p matrix % % opB character specifying the shape of B -% opB = 'N' solves opE(E_)*X = B -% opB = 'T' solves opE(E_)*X = B' +% opB = 'N' sets X = B +% opB = 'T' sets X = B' % % Output -% X matrix solving opE(E_)*X = opB(B) +% X matrix solving X = opB(B) % -% This function uses another default function size_default(eqn, opts) to -% obtain the number of rows of matrix E_ in structure eqn. +% This function uses another state_space_transformed_default function; +% size_state_space_transformed_default(eqn, opts) to obtain the number of +% rows of the transformed matrix E from structure eqn. % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - %% Check input parameters. -assert(ischar(opE) && ischar(opB), ... - 'MESS:error_arguments', ... - 'opE or opB is not a char'); +mess_assert(opts, ischar(opE) && ischar(opB), ... + 'error_arguments', ... + 'opE or opB is not a char'); opE = upper(opE); opB = upper(opB); -assert((opE == 'N') || (opE == 'T'), ... - 'MESS:error_arguments', ... - 'opE is not ''N'' or ''T'''); - -assert((opB == 'N') || (opB == 'T'), ... - 'MESS:error_arguments', ... - 'opB is not ''N'' or ''T'''); +mess_assert(opts, (opE == 'N') || (opE == 'T'), ... + 'error_arguments', ... + 'opE is not ''N'' or ''T'''); -assert(isnumeric(B) && ismatrix(B), ... - 'MESS:error_arguments', ... - 'B has to ba a matrix'); +mess_assert(opts, (opB == 'N') || (opB == 'T'), ... + 'error_arguments', ... + 'opB is not ''N'' or ''T'''); -%% Check data in eqn structure. -assert(isfield(eqn, 'EL'), ... - 'MESS:error_arguments', ... - 'field eqn.EL is not defined'); - assert(isfield(eqn, 'EU'), ... - 'MESS:error_arguments', ... - 'field eqn.EU is not defined'); +mess_assert(opts, isnumeric(B) && ismatrix(B), ... + 'error_arguments', ... + 'B has to ba a matrix'); rowE = size_default(eqn, opts); -colE = rowE; %% Perform solve operation. -switch opE - case 'N' - switch opB - case 'N' % Implement solve E_*X = B. - assert(rowE == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of rows of E_ differs with ' ... - 'number rows of B']); - X = eqn.EU \ (eqn.EL \ B); - case 'T' % Implement solve E_*X = B'. - assert(rowE == size(B, 2), ... - 'MESS:error_arguments', ... +switch opB + case 'N' % Implement solve E_*X = B. + mess_assert(opts, rowE == size(B, 1), ... + 'error_arguments', ... ['number of rows of E_ differs with ' ... - 'number of columns of B']); - X = eqn.EU \ (eqn.EL \ B'); - end - - case 'T' - switch opB - case 'N' % Implement solve E_'*X = B. - assert(colE == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of columns of E_ differs with ' ... - 'number of rows of B']); - X = eqn.EL' \ (eqn.EU' \ B); - - case 'T' % Implement solve E_'*X = B'. - assert(colE == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of columns of E_ differs with ' ... - 'number of columns of B']); - X = eqn.EL' \ (eqn.EU' \ B'); - end + 'number rows of B']); + X = B; + case 'T' % Implement solve E_*X = B'. + mess_assert(opts, rowE == size(B, 2), ... + 'error_arguments', ... + ['number of rows of E_ differs with ' ... + 'number of columns of B']); + X = B'; end diff --git a/usfs/state_space_transformed_default/ss_to_dss_post_state_space_transformed_default.m b/usfs/state_space_transformed_default/ss_to_dss_post_state_space_transformed_default.m index 939f5e1..0ae1c58 100644 --- a/usfs/state_space_transformed_default/ss_to_dss_post_state_space_transformed_default.m +++ b/usfs/state_space_transformed_default/ss_to_dss_post_state_space_transformed_default.m @@ -22,22 +22,11 @@ % with A and E % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - -assert(isfield(eqn, 'Ecount'), ... - 'MESS:error_arguments', ... - 'field eqn.Scount is not defined.'); - -if eqn.Ecount > 1 - eqn.Ecount = eqn.Ecount - 1; -else - eqn = rmfield(eqn, 'Ecount'); - eqn = rmfield(eqn, 'EL'); - eqn = rmfield(eqn, 'EU'); -end +eqn = LU_E_clean(eqn, opts); diff --git a/usfs/state_space_transformed_default/ss_to_dss_pre_state_space_transformed_default.m b/usfs/state_space_transformed_default/ss_to_dss_pre_state_space_transformed_default.m index 2745906..c23bb17 100644 --- a/usfs/state_space_transformed_default/ss_to_dss_pre_state_space_transformed_default.m +++ b/usfs/state_space_transformed_default/ss_to_dss_pre_state_space_transformed_default.m @@ -22,21 +22,11 @@ % with A and E % -% This file is part of the M-M.E.S.S. project +% This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % - -if isfield(eqn, 'EL') && isfield(eqn, 'EU') - if isfield(eqn, 'Ecount') - eqn.Ecount = eqn.Ecount + 1; - else - eqn.Ecount = 2; - end -else - [eqn.EL, eqn.EU] = lu(eqn.E_); - eqn.Ecount = 1; -end +eqn = LU_E(eqn); diff --git a/usfs/state_space_transformed_default/ss_to_dss_state_space_transformed_default.m b/usfs/state_space_transformed_default/ss_to_dss_state_space_transformed_default.m index 12d3396..b06b37f 100644 --- a/usfs/state_space_transformed_default/ss_to_dss_state_space_transformed_default.m +++ b/usfs/state_space_transformed_default/ss_to_dss_state_space_transformed_default.m @@ -1,4 +1,4 @@ -function C = ss_to_dss_state_space_transformed_default... +function C = ss_to_dss_state_space_transformed_default ... (eqn, opts, fac, opFac, B, opB) %% function C = dss_to_ss_state_space_transformed_default... % (eqn, opts, fac, opFac, B, opB) @@ -18,7 +18,7 @@ % % opFac character specifying the shape of the used factor % opFac = 'N' performs EL*op(B) or EU*op(B) -% opFac = 'T' performs EL'*op(B) or EU'*op(B) +% opFac = 'T' performs EL'*op(B) or EU'*op(B) % % B n-x-p matrix % @@ -27,7 +27,7 @@ % opB = 'T' performs op(EL)*B' or op(EU)*B' % % Output -% C = op(EL)*op(B) or op(EU)*op(B) +% C = op(EL)*op(B) or op(EU)*op(B) % % This function uses another default function size_default(eqn, opts) to % obtain the number of rows of matrix A_ in structure eqn. @@ -35,46 +35,46 @@ % % This file is part of the M-M.E.S.S. project % (http://www.mpi-magdeburg.mpg.de/projects/mess). -% Copyright © 2009-2022 Jens Saak, Martin Koehler, Peter Benner and others. +% Copyright (c) 2009-2023 Jens Saak, Martin Koehler, Peter Benner and others. % All rights reserved. % License: BSD 2-Clause License (see COPYING) % %% Check input parameters. -assert(ischar(fac) && ischar(opFac) && ischar(opB), ... - 'MESS:error_arguments', ... - 'fac, opFac or opB is not a char'); +mess_assert(opts, ischar(fac) && ischar(opFac) && ischar(opB), ... + 'error_arguments', ... + 'fac, opFac or opB is not a char'); fac = upper(fac); opFac = upper(opFac); opB = upper(opB); -assert((fac == 'L') || (fac == 'U'), ... - 'MESS:error_arguments', ... - 'fac is not ''N'' or ''T'''); +mess_assert(opts, (fac == 'L') || (fac == 'U'), ... + 'error_arguments', ... + 'fac is not ''N'' or ''T'''); -assert((opFac == 'N') || (opFac == 'T'), ... - 'MESS:error_arguments', ... - 'opFac is not ''N'' or ''T'''); +mess_assert(opts, (opFac == 'N') || (opFac == 'T'), ... + 'error_arguments', ... + 'opFac is not ''N'' or ''T'''); -assert((opB == 'N') || (opB == 'T'), ... - 'MESS:error_arguments', ... - 'opB is not ''N'' or ''T'''); +mess_assert(opts, (opB == 'N') || (opB == 'T'), ... + 'error_arguments', ... + 'opB is not ''N'' or ''T'''); -assert(isnumeric(B) && ismatrix(B), ... - 'MESS:error_arguments', ... - 'B has to ba a matrix'); +mess_assert(opts, isnumeric(B) && ismatrix(B), ... + 'error_arguments', ... + 'B has to ba a matrix'); %% Check data in eqn structure. if isfield(eqn, 'haveE') && eqn.haveE - assert(isfield(eqn, 'EL'), ... - 'MESS:error_arguments', ... - 'field eqn.EL is not defined'); - assert(isfield(eqn, 'EU'), ... - 'MESS:error_arguments', ... - 'field eqn.EU is not defined'); + mess_assert(opts, isfield(eqn, 'EL'), ... + 'error_arguments', ... + 'field eqn.EL is not defined'); + mess_assert(opts, isfield(eqn, 'EU'), ... + 'error_arguments', ... + 'field eqn.EU is not defined'); else - eqn.haveE = 0; + eqn.haveE = false; end rowE = size_default(eqn, opts); @@ -88,33 +88,34 @@ case 'N' switch opB case 'N' % Implement operation EL*B. - assert(colE == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of columns of E_ differs ' ... - 'with number of rows of B']); - C = eqn.EL * B; + mess_assert(opts, colE == size(B, 1), ... + 'error_arguments', ... + ['number of columns of E_ differs ' ... + 'with number of rows of B']); + C = eqn.ER(:, eqn.Ep) * (eqn.EL * B); + case 'T' % Implement operation EL*B'. - assert(colE == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of columns of E_ differs ' ... - 'with number of columns of B']); - C = eqn.EL * B'; + mess_assert(opts, colE == size(B, 2), ... + 'error_arguments', ... + ['number of columns of E_ differs ' ... + 'with number of columns of B']); + C = eqn.ER(:, eqn.Ep) * (eqn.EL * B'); end case 'T' switch opB case 'N' % Implement operation EL'*B. - assert(rowE == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of rows of E_ differs with ' ... - 'number rows of B']); - C = eqn.EL' * B; + mess_assert(opts, rowE == size(B, 1), ... + 'error_arguments', ... + ['number of rows of E_ differs with ' ... + 'number rows of B']); + C = eqn.EL' * (eqn.ER(:, eqn.Ep)' * B); case 'T' % Implement operation EL'*B'. - assert(rowE == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of rows of E_ differs with ' ... - 'number of columns of B']); - C = eqn.EL' * B'; + mess_assert(opts, rowE == size(B, 2), ... + 'error_arguments', ... + ['number of rows of E_ differs with ' ... + 'number of columns of B']); + C = eqn.EL' * (eqn.ER(:, eqn.Ep)' * B'); end end @@ -123,33 +124,33 @@ case 'N' switch opB case 'N' % Implement operation EU*B. - assert(colE == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of columns of E_ differs ' ... - 'with number of rows of B']); - C = eqn.EU * B; + mess_assert(opts, colE == size(B, 1), ... + 'error_arguments', ... + ['number of columns of E_ differs ' ... + 'with number of rows of B']); + C = eqn.EU * B(eqn.Eq, :); case 'T' % Implement operation EU*B'. - assert(colE == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of columns of E_ differs ' ... - 'with number of columns of B']); - C = eqn.EU * B'; + mess_assert(opts, colE == size(B, 2), ... + 'error_arguments', ... + ['number of columns of E_ differs ' ... + 'with number of columns of B']); + C = eqn.EU * B(:, eqn.Eq)'; end case 'T' switch opB case 'N' % Implement operation EU'*B. - assert(rowE == size(B, 1), ... - 'MESS:error_arguments', ... - ['number of rows of E_ differs with ' ... - 'number rows of B']); - C = eqn.EU' * B; + mess_assert(opts, rowE == size(B, 1), ... + 'error_arguments', ... + ['number of rows of E_ differs with ' ... + 'number rows of B']); + C(eqn.Eq, :) = eqn.EU' * B; case 'T' % Implement operation EU'*B'. - assert(rowE == size(B, 2), ... - 'MESS:error_arguments', ... - ['number of rows of E_ differs with ' ... - 'number of columns of B']); - C = eqn.EU' * B'; + mess_assert(opts, rowE == size(B, 2), ... + 'error_arguments', ... + ['number of rows of E_ differs with ' ... + 'number of columns of B']); + C(eqn.Eq, :) = eqn.EU' * B'; end end