MODULE slopes !----------------------------------------------------------------------- ! NAME ! slopes ! ! DESCRIPTION ! Contains global parameters used for the slopes. ! ! AUTHORS & DATE ! JB Clement, 12/2025 ! ! NOTES ! !----------------------------------------------------------------------- ! DEPENDENCIES ! ------------ use numerics, only: dp, di ! DECLARATION ! ----------- implicit none ! PARAMETERS ! ---------- real(dp), dimension(:), allocatable, protected :: def_slope_mean ! Mean slople of each bin [degree] real(dp), dimension(:,:), allocatable, protected :: subslope_dist ! Distribution of the slopes integer(di), protected :: iflat ! Index of the flat slope contains !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !======================================================================= SUBROUTINE ini_slopes() !----------------------------------------------------------------------- ! NAME ! ini_slopes ! ! DESCRIPTION ! Initialize the parameters of module 'slopes'. ! ! AUTHORS & DATE ! JB Clement, 12/2025 ! ! NOTES ! !----------------------------------------------------------------------- ! DEPENDENCIES ! ------------ use geometry, only: nslope, ngrid ! DECLARATION ! ----------- implicit none ! CODE ! ---- if (.not. allocated(def_slope_mean)) allocate(def_slope_mean(nslope)) if (.not. allocated(subslope_dist)) allocate(subslope_dist(ngrid,nslope)) END SUBROUTINE ini_slopes !======================================================================= !======================================================================= SUBROUTINE end_slopes() !----------------------------------------------------------------------- ! NAME ! end_slopes ! ! DESCRIPTION ! Deallocate slopes arrays. ! ! AUTHORS & DATE ! JB Clement, 12/2025 ! ! NOTES ! !----------------------------------------------------------------------- ! DECLARATION ! ----------- implicit none ! CODE ! ---- if (allocated(def_slope_mean)) deallocate(def_slope_mean) if (allocated(subslope_dist)) deallocate(subslope_dist) END SUBROUTINE end_slopes !======================================================================= !======================================================================= SUBROUTINE set_def_slope_mean(def_slope_mean_in) !----------------------------------------------------------------------- ! NAME ! set_def_slope_mean ! ! DESCRIPTION ! Setter for 'def_slope_mean'. ! ! AUTHORS & DATE ! JB Clement, 12/2025 ! ! NOTES ! !----------------------------------------------------------------------- ! DECLARATION ! ----------- implicit none ! ARGUMENTS ! --------- real(dp), dimension(:), intent(in) :: def_slope_mean_in ! CODE ! ---- def_slope_mean(:) = def_slope_mean_in(:) END SUBROUTINE set_def_slope_mean !======================================================================= !======================================================================= SUBROUTINE set_subslope_dist(subslope_dist_in) !----------------------------------------------------------------------- ! NAME ! set_subslope_dist ! ! DESCRIPTION ! Setter for 'subslope_dist'. ! ! AUTHORS & DATE ! JB Clement, 12/2025 ! ! NOTES ! !----------------------------------------------------------------------- ! DECLARATION ! ----------- implicit none ! ARGUMENTS ! --------- real(dp), dimension(:,:), intent(in) :: subslope_dist_in ! CODE ! ---- subslope_dist(:,:) = subslope_dist_in(:,:) END SUBROUTINE set_subslope_dist !======================================================================= !======================================================================= SUBROUTINE set_iflat() !----------------------------------------------------------------------- ! NAME ! set_iflat ! ! DESCRIPTION ! Setter for 'iflat'. ! ! AUTHORS & DATE ! JB Clement, 12/2025 ! ! NOTES ! !----------------------------------------------------------------------- ! DEPENDENCIES ! ------------ use geometry, only: nslope use display, only: print_msg use utility, only: int2str, real2str ! DECLARATION ! ----------- implicit none ! LOCAL VARIABLES ! --------------- integer(di) :: islope ! CODE ! ---- iflat = 1 do islope = 2,nslope if (abs(def_slope_mean(islope)) < abs(def_slope_mean(iflat))) iflat = islope end do call print_msg('Flat slope for islope = '//int2str(iflat)) call print_msg('Corresponding criterium = '//real2str(def_slope_mean(iflat))) END SUBROUTINE set_iflat !======================================================================= END MODULE slopes