source: trunk/LMDZ.COMMON/libf/evolution/criterion_ice_stop_mod_slope.F90 @ 2885

Last change on this file since 2885 was 2885, checked in by romain.vande, 22 months ago

Mars PCM:
Move a endif misplaced
RV

File size: 2.8 KB
Line 
1!
2! $Id $
3!
4SUBROUTINE criterion_ice_stop_slope(cell_area,ini_surf,qsurf,STOPPING,STOPPING_ps,ngrid,initial_h2o_ice,global_ave_press_GCM,global_ave_press_new,nslope)
5
6  USE temps_mod_evol, ONLY: alpha_criterion
7  use comslope_mod, ONLY: subslope_dist
8
9      IMPLICIT NONE
10
11!=======================================================================
12!
13!  Routine that checks if the criterion to stop the PEM is reached
14!
15!=======================================================================
16
17!   arguments:
18!   ----------
19
20!   INPUT
21  INTEGER, intent(in) :: ngrid,nslope                  ! # of grid physical grid points
22  REAL,    intent(in) :: cell_area(ngrid)              ! physical point field : Area of the cells
23  REAL,    intent(in) ::  qsurf(ngrid,nslope)          ! physical point field : Actual density of water ice
24  REAL,    intent(in) :: ini_surf
25  REAL,    intent(in) :: initial_h2o_ice(ngrid,nslope)
26  REAL,    intent(in) :: global_ave_press_GCM
27  REAL,    intent(in) :: global_ave_press_new
28
29!   OUTPUT
30  LOGICAL, intent(out) :: STOPPING,STOPPING_ps              ! Logical : is the criterion reached?
31
32!   local:
33!   -----
34  INTEGER :: i,islope   ! Loop
35  REAL :: present_surf  ! Initial/Actual surface of water ice
36
37!=======================================================================
38
39!   initialisation to false
40    STOPPING=.FALSE.
41    STOPPING_ps=.FALSE.
42
43!   computation of the actual surface
44  present_surf=0.
45  do i=1,ngrid
46   do islope=1,nslope
47      if (initial_h2o_ice(i,islope).GT.0.5 .and. qsurf(i,islope).GT.0.) then
48         present_surf=present_surf+cell_area(i)*subslope_dist(i,islope)
49      endif
50   enddo
51  enddo
52 
53!   check of the criterion
54  if(present_surf.LT.ini_surf*(1-alpha_criterion) .OR. &
55     present_surf.GT.ini_surf*(1+alpha_criterion)) then
56    STOPPING=.TRUE.
57    print *, "Reason of stopping : The surface of co2 ice sublimating reach the threshold:"
58    print *, "Current surface of co2 ice sublimating=", present_surf
59    print *, "Initial surface of co2 ice sublimating=", ini_surf
60    print *, "Percentage of change accepted=", alpha_criterion*100
61    print *, "present_surf<ini_surf*(1-alpha_criterion)", (present_surf.LT.ini_surf*(1-alpha_criterion))
62  endif
63
64  if (ini_surf.LT. 1E-5 .and. ini_surf.GT. -1E-5) then
65       STOPPING=.FALSE.
66  endif
67
68  if(global_ave_press_new.LT.global_ave_press_GCM*(0.9) .OR. &
69     global_ave_press_new.GT.global_ave_press_GCM*(1.1)) then
70    STOPPING_ps=.TRUE.
71    print *, "Reason of stopping : The global pressure reach the threshold:"
72    print *, "Current global pressure=", global_ave_press_new
73    print *, "GCM global pressure=", global_ave_press_GCM
74    print *, "Percentage of change accepted=", 0.1*100
75    print *, "global_ave_press_new<global_ave_press_GCM*(0.9)", (global_ave_press_new.LT.global_ave_press_GCM*(0.9))
76  endif
77
78END SUBROUTINE criterion_ice_stop_slope
79
80
Note: See TracBrowser for help on using the repository browser.