source: trunk/LMDZ.COMMON/libf/evolution/criterion_pem_stop_mod.F90 @ 3136

MODULE criterion_pem_stop_mod

implicit none

contains

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!
!!! Purpose: Criterions to check if the PEM needs to call the PCM
!!! Author: RV & LL, 02/2023
!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

SUBROUTINE criterion_waterice_stop(cell_area,ini_surf,qsurf,STOPPING,ngrid,initial_h2o_ice)

use time_evol_mod, only: water_ice_criterion
use comslope_mod,  only: subslope_dist, nslope

implicit none

!=======================================================================
!
!  Routine that checks if the water ice criterion to stop the PEM is reached
!
!=======================================================================

!   arguments:
!   ----------
!   INPUT
integer,                       intent(in) :: ngrid           ! # of physical grid points
real, dimension(ngrid),        intent(in) :: cell_area       ! Area of the cells
real, dimension(ngrid,nslope), intent(in) :: qsurf           ! Actual density of water ice
real,                          intent(in) :: ini_surf        ! Initial surface of h2o ice that was sublimating
real, dimension(ngrid,nslope), intent(in) :: initial_h2o_ice ! Grid point that initialy were covered by h2o_ice
!   OUTPUT
logical, intent(out) :: STOPPING ! Is the criterion reached?
!   local:
!   ------
integer :: i, islope    ! Loop
real    :: present_surf ! Initial/Actual surface of water ice

!=======================================================================
! Initialisation to false
STOPPING = .false.

! Computation of the present surface of water ice sublimating
present_surf = 0.
do i = 1,ngrid
    do islope = 1,nslope
        !if (initial_h2o_ice(i,islope) > 0.5 .and. qsurf(i,islope) > 0.) present_surf = present_surf + cell_area(i)*subslope_dist(i,islope)
        if (initial_h2o_ice(i,islope) > 0.5) present_surf = present_surf + cell_area(i)*subslope_dist(i,islope)
    enddo
enddo

! Check of the criterion
if (present_surf < ini_surf*(1. - water_ice_criterion) .or. present_surf > ini_surf*(1. + water_ice_criterion)) then
    STOPPING = .true.
    write(*,*) "Reason of stopping: the surface of water ice sublimating reach the threshold"
    write(*,*) "Current surface of water ice sublimating =", present_surf
    write(*,*) "Initial surface of water ice sublimating =", ini_surf
    write(*,*) "Percentage of change accepted =", water_ice_criterion*100
    write(*,*) "present_surf < ini_surf*(1. - water_ice_criterion)", (present_surf < ini_surf*(1. - water_ice_criterion))
endif

if (ini_surf < 1.e-5 .and. ini_surf > -1.e-5) STOPPING = .false.

END SUBROUTINE criterion_waterice_stop

! ----------------------------------------------------------------------

SUBROUTINE criterion_co2_stop(cell_area,ini_surf,qsurf,STOPPING_ice,STOPPING_ps,ngrid,initial_co2_ice,global_ave_press_GCM,global_ave_press_new,nslope)

use time_evol_mod, only: co2_ice_criterion, ps_criterion
use comslope_mod,  only: subslope_dist

implicit none

!=======================================================================
!
!  Routine that checks if the co2 and pressure criteria to stop the PEM are reached
!
!=======================================================================

!   arguments:
!   ----------
!   INPUT
integer,                       intent(in) :: ngrid, nslope        ! # of grid physical grid points
real, dimension(ngrid),        intent(in) :: cell_area            ! Area of the cells
real, dimension(ngrid,nslope), intent(in) :: qsurf                ! Actual density of water ice
real,                          intent(in) :: ini_surf             ! Initial surface of co2 ice that was sublimating
real, dimension(ngrid,nslope), intent(in) :: initial_co2_ice      ! Grid point that initialy were covered by co2_ice
real,                          intent(in) :: global_ave_press_GCM ! Planet average pressure from the PCM start files
real,                          intent(in) :: global_ave_press_new ! Planet average pressure from the PEM computations
!   OUTPUT
logical, intent(out) :: STOPPING_ice ! Is the criterion for co2 ice reached?
logical, intent(out) :: STOPPING_ps  ! Is the criterion for pressure reached?
!   local:
!   ------
integer :: i, islope    ! Loop
real    :: present_surf ! Initial/Actual surface of water ice

!=======================================================================
! Initialisation to false
STOPPING_ice = .false.
STOPPING_ps = .false.

! Computation of the actual surface
present_surf = 0.
do i = 1,ngrid
    do islope = 1,nslope
        if (initial_co2_ice(i,islope) > 0.5 .and. qsurf(i,islope) > 0.) present_surf = present_surf + cell_area(i)*subslope_dist(i,islope)
    enddo
enddo

! Check of the criterion
if (present_surf < ini_surf*(1. - co2_ice_criterion) .or. present_surf > ini_surf*(1. + co2_ice_criterion)) then
    STOPPING_ice = .true.
    write(*,*) "Reason of stopping: the surface of co2 ice sublimating reach the threshold"
    write(*,*) "Current surface of co2 ice sublimating =", present_surf
    write(*,*) "Initial surface of co2 ice sublimating =", ini_surf
    write(*,*) "Percentage of change accepted =", co2_ice_criterion*100.
    write(*,*) "present_surf < ini_surf*(1. - co2_ice_criterion)", (present_surf < ini_surf*(1. - co2_ice_criterion))
endif

if (abs(ini_surf) < 1.e-5) STOPPING_ice = .false.

if (global_ave_press_new < global_ave_press_GCM*(1. - ps_criterion) .or. global_ave_press_new > global_ave_press_GCM*(1. + ps_criterion)) then
    STOPPING_ps = .true.
    write(*,*) "Reason of stopping: the global pressure reach the threshold"
    write(*,*) "Current global pressure =", global_ave_press_new
    write(*,*) "PCM global pressure =", global_ave_press_GCM
    write(*,*) "Percentage of change accepted =", ps_criterion*100.
    write(*,*) "global_ave_press_new < global_ave_press_GCM*(1. - ps_criterion)", (global_ave_press_new < global_ave_press_GCM*(1. - ps_criterion))
endif

END SUBROUTINE criterion_co2_stop

END MODULE