SUBROUTINE alpale_th ( dtime, lmax_th, t_seri,  &
                       cin, s2, n2,  &
                       ale_bl_trig, ale_bl_stat, ale_bl,  &
                       alp_bl, alp_bl_stat )

! **************************************************************
! *
! ALPALE_TH                                                    *
! *
! *
! written by   : Jean-Yves Grandpeix, 11/05/2016              *
! modified by :                                               *
! **************************************************************

  USE dimphy
  USE ioipsl_getin_p_mod, ONLY : getin_p
  USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level
!
  IMPLICIT NONE

!================================================================
! Auteur(s)   : Jean-Yves Grandpeix, 11/05/2016
! Objet : Contribution of the thermal scheme to Ale and Alp
!================================================================

! Input arguments
!----------------
  REAL, INTENT(IN)                                           :: dtime
  INTEGER, DIMENSION(klon), INTENT(IN)                       :: lmax_th
  REAL, DIMENSION(klon,klev), INTENT(IN)                     :: t_seri
  REAL, DIMENSION(klon), INTENT(IN)                          :: ale_bl_stat
  REAL, DIMENSION(klon), INTENT(IN)                          :: cin
  REAL, DIMENSION(klon), INTENT(IN)                          :: s2, n2
                                                                
  REAL, DIMENSION(klon), INTENT(INOUT)                       :: ale_bl_trig, ale_bl
  REAL, DIMENSION(klon), INTENT(INOUT)                       :: alp_bl
  REAL, DIMENSION(klon), INTENT(INOUT)                       :: alp_bl_stat

  include "thermcell.h"

! Local variables
!----------------
  INTEGER                                                    :: i
  LOGICAL, SAVE                                              :: first = .TRUE.
  REAL, SAVE                                                 :: random_notrig_max=1.
  REAL, DIMENSION(klon)                                      :: proba_notrig, tau_trig, random_notrig
!
    !$OMP THREADPRIVATE(random_notrig_max) 
    !$OMP THREADPRIVATE(first)
!
    IF (first) THEN
       CALL getin_p('random_notrig_max',random_notrig_max)
    ENDIF
          !cc nrlmd le 10/04/2012
          !-----------Stochastic triggering-----------
          if (iflag_trig_bl.ge.1) then
             !
             IF (prt_level .GE. 10) THEN
                print *,'cin, ale_bl_stat, alp_bl_stat ', &
                     cin, ale_bl_stat, alp_bl_stat
             ENDIF


             !----Initialisations
             do i=1,klon
                proba_notrig(i)=1.
                random_notrig(i)=1e6*ale_bl_stat(i)-int(1e6*ale_bl_stat(i))
                if ( random_notrig(i) > random_notrig_max ) random_notrig(i)=0.
                if ( ale_bl_trig(i) .lt. abs(cin(i))+1.e-10 ) then 
                   tau_trig(i)=tau_trig_shallow
                else
                   tau_trig(i)=tau_trig_deep
                endif
             enddo
             !
             IF (prt_level .GE. 10) THEN
                print *,'random_notrig, tau_trig ', &
                     random_notrig, tau_trig
                print *,'s_trig,s2,n2 ', &
                     s_trig,s2,n2
             ENDIF

             !Option pour re-activer l'ancien calcul de Ale_bl (iflag_trig_bl=2)
             IF (iflag_trig_bl.eq.1) then

                !----Tirage al\'eatoire et calcul de ale_bl_trig
                do i=1,klon
                   if ( (ale_bl_stat(i) .gt. abs(cin(i))+1.e-10) )  then
                      proba_notrig(i)=(1.-exp(-s_trig/s2(i)))** &
                           (n2(i)*dtime/tau_trig(i))
                      !        print *, 'proba_notrig(i) ',proba_notrig(i)
                      if (random_notrig(i) .ge. proba_notrig(i)) then 
                         ale_bl_trig(i)=ale_bl_stat(i)
                      else
                         ale_bl_trig(i)=0.
                      endif
                   else
                      proba_notrig(i)=1.
                      random_notrig(i)=0.
                      ale_bl_trig(i)=0.
                   endif
                enddo

             ELSE IF (iflag_trig_bl.ge.2) then

                do i=1,klon
                   if ( (Ale_bl(i) .gt. abs(cin(i))+1.e-10) )  then
                      proba_notrig(i)=(1.-exp(-s_trig/s2(i)))** &
                           (n2(i)*dtime/tau_trig(i))
                      !        print *, 'proba_notrig(i) ',proba_notrig(i)
                      if (random_notrig(i) .ge. proba_notrig(i)) then 
                         ale_bl_trig(i)=Ale_bl(i)
                      else
                         ale_bl_trig(i)=0.
                      endif
                   else
                      proba_notrig(i)=1.
                      random_notrig(i)=0.
                      ale_bl_trig(i)=0.
                   endif
                enddo

             ENDIF

             !
             IF (prt_level .GE. 10) THEN
                print *,'proba_notrig, ale_bl_trig ', &
                     proba_notrig, ale_bl_trig
             ENDIF

          endif !(iflag_trig_bl)

          !-----------Statistical closure-----------
          if (iflag_clos_bl.eq.1) then 

             do i=1,klon
                !CR: alp probabiliste
                if (ale_bl_trig(i).gt.0.) then
                   alp_bl(i)=alp_bl(i)/(1.-min(proba_notrig(i),0.999))
                endif
             enddo

          else if (iflag_clos_bl.eq.2) then

             !CR: alp calculee dans thermcell_main
             do i=1,klon
                alp_bl(i)=alp_bl_stat(i)
             enddo

          else

             alp_bl_stat(:)=0.

          endif !(iflag_clos_bl)

          IF (prt_level .GE. 10) THEN
             print *,'ale_bl_trig, alp_bl_stat ',ale_bl_trig, alp_bl_stat
          ENDIF

          !cc fin nrlmd le 10/04/2012

          ! ------------------------------------------------------------------
          ! Transport de la TKE par les panaches thermiques.
          ! FH : 2010/02/01
          !     if (iflag_pbl.eq.10) then
          !     call thermcell_dtke(klon,klev,nbsrf,pdtphys,fm_therm,entr_therm,
          !    s           rg,paprs,pbl_tke)
          !     endif
          ! -------------------------------------------------------------------
          !IM/FH: 2011/02/23 
          ! Couplage Thermiques/Emanuel seulement si T<0
          if (iflag_coupl==2) then
             IF (prt_level .GE. 10) THEN
                print*,'Couplage Thermiques/Emanuel seulement si T<0'
             ENDIF
             do i=1,klon
                if (t_seri(i,lmax_th(i))>273.) then
                   Ale_bl(i)=0.
                endif
             enddo
          endif
!
   RETURN
   END