source: trunk/LMDZ.COMMON/libf/evolution/slopes.F90 @ 4074

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))
def_slope_mean(:) = 0._dp
subslope_dist(:,:) = 1._dp

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