SUBROUTINE vlspltgen_loc( q,iadv,pente_max,masse,w,pbaru,pbarv,pdt,p,pk,teta)

!  Auteurs:   P.Le Van, F.Hourdin, F.Forget, F.Codron 
!
! ********************************************************************
!       Shema  d'advection " pseudo amont " .
!   + test sur humidite specifique: Q advecte< Qsat aval
!		(F. Codron, 10/99)
! ********************************************************************
!  q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
!
!  pente_max facteur de limitation des pentes: 2 en general
!					     0 pour un schema amont
!  pbaru,pbarv,w flux de masse en u ,v ,w
!  pdt pas de temps
!
!  teta temperature potentielle, p pression aux interfaces,
!  pk exner au milieu des couches necessaire pour calculer Qsat
!--------------------------------------------------------------------
  USE parallel_lmdz
  USE mod_hallo
  USE Write_Field_loc
  USE VAMPIR
  USE infotrac, ONLY : nqtot, tracers, tra
  USE vlspltgen_mod
  USE comconst_mod, ONLY: cpp
  IMPLICIT NONE

  include "dimensions.h"
  include "paramet.h"

!
! Arguments:
!----------
  REAL, DIMENSION(ijb_u:ije_u,llm,nqtot), INTENT(INOUT) :: q
  INTEGER, DIMENSION(nqtot),              INTENT(IN)    :: iadv
  REAL,                                   INTENT(IN)    :: pdt, pente_max
  REAL, DIMENSION(ijb_u:ije_u,llm),       INTENT(IN)    :: pk, pbaru, masse, w, teta
  REAL, DIMENSION(ijb_v:ije_v,llm),       INTENT(IN)    ::     pbarv
  REAL, DIMENSION(ijb_u:ije_u,llmp1),     INTENT(IN)    :: p
!
! Local 
!---------
  INTEGER :: ij, l
  REAL    :: zzpbar, zzw
  REAL, PARAMETER :: qmin = 0., qmax = 1.e33
  TYPE(tra), POINTER :: tr

!--pour rapport de melange saturant--
  REAL, PARAMETER ::   &
    r2es  = 380.11733, &
    r3les = 17.269,    &
    r3ies = 21.875,    &
    r4les = 35.86,     &
    r4ies = 7.66,      &
    retv  = 0.6077667, &
    rtt   = 273.16

  REAL    :: play, ptarg, pdelarg, foeew, zdelta, tempe(ijb_u:ije_u)
  INTEGER :: ijb,ije,iq,iq2,ichld
  LOGICAL, SAVE :: firstcall=.TRUE.
!$OMP THREADPRIVATE(firstcall)
  TYPE(request), SAVE :: MyRequest1, MyRequest2
!$OMP THREADPRIVATE     (MyRequest1, MyRequest2)

!    fonction psat(T)
  FOEEW ( PTARG,PDELARG ) = EXP ( (R3LES*(1.-PDELARG)+R3IES*PDELARG) * (PTARG-RTT) &
                         / (PTARG-(R4LES*(1.-PDELARG)+R4IES*PDELARG)) )

! Allocate variables depending on dynamic variable nqtot
  IF(firstcall) THEN
     firstcall=.FALSE.
  END IF
!-- Calcul de Qsat en chaque point
!-- approximation: au milieu des couches play(l)=(p(l)+p(l+1))/2
!   pour eviter une exponentielle.

  CALL SetTag(MyRequest1,100)
  CALL SetTag(MyRequest2,101)

  ijb=ij_begin-iip1; IF(pole_nord) ijb=ij_begin
  ije=ij_end  +iip1; IF(pole_sud)  ije=ij_end

!$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
  DO l = 1, llm
    DO ij = ijb, ije
      tempe(ij) = teta(ij,l) * pk(ij,l) /cpp
    END DO
    DO ij = ijb, ije
      zdelta = MAX( 0., SIGN(1., rtt - tempe(ij)) )
      play   = 0.5*(p(ij,l)+p(ij,l+1))
      qsat(ij,l) = MIN(0.5, r2es* FOEEW(tempe(ij),zdelta) / play )
      qsat(ij,l) = qsat(ij,l) / ( 1. - retv * qsat(ij,l) )
    END DO
  END DO
!$OMP END DO NOWAIT
!     PRINT*,'Debut vlsplt version debug sans vlyqs'

  zzpbar = 0.5 * pdt
  zzw    = pdt

  ijb=ij_begin; IF(pole_nord) ijb=ijb+iip1
  ije=ij_end;   IF(pole_sud)  ije=ije-iip1
!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
  DO l=1,llm
    DO ij = ijb,ije
      mu(ij,l)=pbaru(ij,l) * zzpbar
    END DO
  END DO
!$OMP END DO NOWAIT
      
  ijb=ij_begin-iip1; IF(pole_nord) ijb=ij_begin
  ije=ij_end;	     IF(pole_sud)  ije=ij_end-iip1
!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
  DO l=1,llm
    DO ij=ijb,ije
      mv(ij,l)=pbarv(ij,l) * zzpbar
    END DO
  END DO
!$OMP END DO NOWAIT

  ijb=ij_begin
  ije=ij_end
  DO iq=1,nqtot
!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)      
    DO l=1,llm
      DO ij=ijb,ije
        mw(ij,l,iq)=w(ij,l) * zzw
      END DO
    END DO
!$OMP END DO NOWAIT
  END DO

  DO iq=1,nqtot  
!$OMP MASTER
    DO ij=ijb,ije
      mw(ij,llm+1,iq)=0.
    END DO
!$OMP END MASTER
  END DO

!  CALL SCOPY(ijp1llm,q,1,zq,1)
!  CALL SCOPY(ijp1llm,masse,1,zm,1)

  ijb=ij_begin
  ije=ij_end
  DO iq=1,nqtot       
!$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
    DO l=1,llm
      zq(ijb:ije,l,iq)=q(ijb:ije,l,iq)
      zm(ijb:ije,l,iq)=masse(ijb:ije,l)
    END DO
!$OMP END DO NOWAIT
  END DO

#ifdef DEBUG_IO     
  CALL WriteField_u('mu',mu)
  CALL WriteField_v('mv',mv)
  CALL WriteField_u('mw',mw)
  CALL WriteField_u('qsat',qsat)
#endif

  ! verif temporaire
  ijb=ij_begin
  ije=ij_end  
  CALL check_isotopes(zq,ijb,ije,'vlspltgen_loc 191')

!$OMP BARRIER           
  DO iq=1,nqtot
    tr => tracers(iq)
    ! CRisi: on ne boucle que sur les parents = ceux qui sont transportes directement par l'air
    IF(tr%igen /= 1) CYCLE
!    write(*,*) 'vlspltgen 192: iq,iadv=',iq,iadv(iq)
#ifdef DEBUG_IO    
    CALL WriteField_u('zq',zq(:,:,iq))
    CALL WriteField_u('zm',zm(:,:,iq)) 
#endif
    !----------------------------------------------------------------------
    SELECT CASE(iadv(iq))
    !----------------------------------------------------------------------
      CASE(0); CYCLE
    !----------------------------------------------------------------------
      CASE(10)
#ifdef _ADV_HALO        
        ! CRisi: on ajoute les nombres de fils et tableaux des fils
        ! On suppose qu'on ne peut advecter les fils que par le schéma 10.  
        CALL vlx_loc(zq,pente_max,zm,mu,ij_begin,ij_begin+2*iip1-1,iq)
        CALL vlx_loc(zq,pente_max,zm,mu,ij_end-2*iip1+1,ij_end,iq)
#else
        CALL vlx_loc(zq,pente_max,zm,mu,ij_begin,ij_end,iq)
#endif
!$OMP MASTER
        CALL VTb(VTHallo)
!$OMP END MASTER
        CALL Register_Hallo_u(zq(:,:,iq),llm,2,2,2,2,MyRequest1)
        CALL Register_Hallo_u(zm(:,:,iq),llm,1,1,1,1,MyRequest1)
! CRisi
        DO ichld=1,tr%ndesc
          iq2=tr%idesc(ichld)
          CALL Register_Hallo_u(zq(:,:,iq2),llm,2,2,2,2,MyRequest1)
          CALL Register_Hallo_u(zm(:,:,iq2),llm,1,1,1,1,MyRequest1)
        END DO
!$OMP MASTER
        CALL VTe(VTHallo)
!$OMP END MASTER
    !----------------------------------------------------------------------
      CASE(14)
#ifdef _ADV_HALO           
        CALL vlxqs_loc(zq,pente_max,zm,mu,qsat,ij_begin,ij_begin+2*iip1-1,iq)
        CALL vlxqs_loc(zq,pente_max,zm,mu,qsat,ij_end-2*iip1+1,ij_end,iq)
#else
        CALL vlxqs_loc(zq,pente_max,zm,mu,qsat,ij_begin,ij_end,iq)
#endif
!$OMP MASTER
        CALL VTb(VTHallo)
!$OMP END MASTER
        CALL Register_Hallo_u(zq(:,:,iq),llm,2,2,2,2,MyRequest1)
        CALL Register_Hallo_u(zm(:,:,iq),llm,1,1,1,1,MyRequest1)
        DO ichld=1,tr%ndesc
          iq2=tr%idesc(ichld)
          CALL Register_Hallo_u(zq(:,:,iq2),llm,2,2,2,2,MyRequest1)
          CALL Register_Hallo_u(zm(:,:,iq2),llm,1,1,1,1,MyRequest1)
        END DO
!$OMP MASTER
        CALL VTe(VTHallo)
!$OMP END MASTER 
    !----------------------------------------------------------------------
      CASE DEFAULT; STOP 'vlspltgen_p : schema non parallelise'
    !----------------------------------------------------------------------
    END SELECT
    !----------------------------------------------------------------------
  END DO
!$OMP BARRIER      

!$OMP MASTER      
  CALL VTb(VTHallo)
!$OMP END MASTER
  CALL SendRequest(MyRequest1)
!$OMP MASTER
  CALL VTe(VTHallo)
!$OMP END MASTER       

!$OMP BARRIER

  ! verif temporaire
  ijb=ij_begin-2*iip1; IF(pole_nord) ijb=ij_begin
  ije=ij_end  +2*iip1; IF(pole_sud)  ije=ij_end
  CALL check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 280')

  DO iq=1,nqtot
    tr => tracers(iq)
!    write(*,*) 'vlspltgen 279: iq=',iq
    IF(tr%igen /= 1) CYCLE
    !----------------------------------------------------------------------
    SELECT CASE(iadv(iq))
    !----------------------------------------------------------------------
      CASE(0); CYCLE
    !----------------------------------------------------------------------
      CASE(10)
#ifdef _ADV_HALLO
        CALL vlx_loc(zq,pente_max,zm,mu,ij_begin+2*iip1,ij_end-2*iip1,iq)
#endif
    !----------------------------------------------------------------------
      CASE(14)
#ifdef _ADV_HALLO
        CALL vlxqs_loc(zq,pente_max,zm,mu,qsat,ij_begin+2*iip1,ij_end-2*iip1,iq)
#endif
      CASE DEFAULT; STOP 'vlspltgen_p : schema non parallelise'
    !----------------------------------------------------------------------
    END SELECT
    !----------------------------------------------------------------------
  END DO
!$OMP BARRIER      

!$OMP MASTER
  CALL VTb(VTHallo)
!$OMP END MASTER

!  CALL WaitRecvRequest(MyRequest1)
!  CALL WaitSendRequest(MyRequest1)
!$OMP BARRIER
  CALL WaitRequest(MyRequest1)


!$OMP MASTER
  CALL VTe(VTHallo)
!$OMP END MASTER
!$OMP BARRIER

  CALL check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 326')

  ijb=ij_begin-2*iip1; IF(pole_nord) ijb=ij_begin
  ije=ij_end  +2*iip1; IF(pole_sud)  ije=ij_end

  CALL check_isotopes(zq,ijb,ije,'vlspltgen_loc 336')

  DO iq=1,nqtot
    tr => tracers(iq)
!    write(*,*) 'vlspltgen 321: iq=',iq
    IF(tr%igen /= 1) CYCLE
#ifdef DEBUG_IO    
    CALL WriteField_u('zq',zq(:,:,iq))
    CALL WriteField_u('zm',zm(:,:,iq))
#endif
    !----------------------------------------------------------------------
    SELECT CASE(iadv(iq))
      CASE(0); CYCLE
      CASE(10); CALL   vly_loc(zq,pente_max,zm,mv,iq)
      CASE(14); CALL vlyqs_loc(zq,pente_max,zm,mv,qsat,iq)
      CASE DEFAULT; STOP 'vlspltgen_p : schema non parallelise'
    END SELECT
    !----------------------------------------------------------------------
  END DO

  CALL check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 357')

  DO iq=1,nqtot
    tr => tracers(iq)
!    write(*,*) 'vlspltgen 349: iq=',iq
    IF(tr%igen /= 1) CYCLE
#ifdef DEBUG_IO    
    CALL WriteField_u('zq',zq(:,:,iq))
    CALL WriteField_u('zm',zm(:,:,iq))
#endif
    !----------------------------------------------------------------------
    SELECT CASE(iadv(iq))
    !----------------------------------------------------------------------
      CASE(0); CYCLE
    !----------------------------------------------------------------------
      CASE(10,14)
!$OMP BARRIER        
#ifdef _ADV_HALLO
    	CALL vlz_loc(zq,pente_max,zm,mw,ij_begin,ij_begin+2*iip1-1,iq)
    	CALL vlz_loc(zq,pente_max,zm,mw,ij_end-2*iip1+1,ij_end,iq)
#else
        CALL vlz_loc(zq,pente_max,zm,mw,ij_begin,ij_end,iq)
#endif
!$OMP BARRIER
!$OMP MASTER
        CALL VTb(VTHallo)
!$OMP END MASTER
    	CALL Register_Hallo_u(zq(:,:,iq),llm,2,2,2,2,MyRequest2)
    	CALL Register_Hallo_u(zm(:,:,iq),llm,1,1,1,1,MyRequest2)
    	! CRisi
    	DO ichld=1,tr%ndesc
    	  iq2=tr%idesc(ichld)
    	  CALL Register_Hallo_u(zq(:,:,iq2),llm,2,2,2,2,MyRequest2)
    	  CALL Register_Hallo_u(zm(:,:,iq2),llm,1,1,1,1,MyRequest2)
    	END DO
!$OMP MASTER
        CALL VTe(VTHallo)
!$OMP END MASTER        
!$OMP BARRIER
    !----------------------------------------------------------------------
      CASE DEFAULT; STOP 'vlspltgen_p : schema non parallelise'
    !----------------------------------------------------------------------
    END SELECT
    !----------------------------------------------------------------------
  END DO
!$OMP BARRIER      


!$OMP MASTER        
  CALL VTb(VTHallo)
!$OMP END MASTER

  CALL SendRequest(MyRequest2)

!$OMP MASTER
  CALL VTe(VTHallo)
!$OMP END MASTER        

  CALL check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 429')

!$OMP BARRIER
  DO iq=1,nqtot
    tr => tracers(iq)
!    write(*,*) 'vlspltgen 409: iq=',iq
    IF(tr%igen /= 1) CYCLE
    !----------------------------------------------------------------------
    SELECT CASE(iadv(iq))
    !----------------------------------------------------------------------
      CASE(0); CYCLE
    !----------------------------------------------------------------------
      CASE(10,14)
!$OMP BARRIER        
#ifdef _ADV_HALLO
        CALL vlz_loc(zq,pente_max,zm,mw,ij_begin+2*iip1,ij_end-2*iip1,iq)
#endif
!$OMP BARRIER
    !----------------------------------------------------------------------
      CASE DEFAULT; STOP 'vlspltgen_p : schema non parallelise'
    !----------------------------------------------------------------------
    END SELECT
    !----------------------------------------------------------------------
  END DO
!  write(*,*) 'vlspltgen_loc 476'

!$OMP BARRIER
!  write(*,*) 'vlspltgen_loc 477'
!$OMP MASTER
  CALL VTb(VTHallo)
!$OMP END MASTER

!  CALL WaitRecvRequest(MyRequest2)
!  CALL WaitSendRequest(MyRequest2)
!$OMP BARRIER
  CALL WaitRequest(MyRequest2)

!$OMP MASTER
  CALL VTe(VTHallo)
!$OMP END MASTER
!$OMP BARRIER

!  write(*,*) 'vlspltgen_loc 494'
  CALL check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 461')

  DO iq=1,nqtot
    tr => tracers(iq)
!    write(*,*) 'vlspltgen 449: iq=',iq
    IF(tr%igen /= 1) CYCLE
#ifdef DEBUG_IO    
      CALL WriteField_u('zq',zq(:,:,iq))
      CALL WriteField_u('zm',zm(:,:,iq))
#endif
    !----------------------------------------------------------------------
    SELECT CASE(iadv(iq))
      CASE(0); CYCLE
      CASE(10); CALL   vly_loc(zq,pente_max,zm,mv,iq)
      CASE(14); CALL vlyqs_loc(zq,pente_max,zm,mv,qsat,iq)
      CASE DEFAULT; STOP 'vlspltgen_p : schema non parallelise'
    END SELECT
    !----------------------------------------------------------------------
  END DO

  CALL check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 493')

  DO iq=1,nqtot
    tr => tracers(iq)
!    write(*,*) 'vlspltgen 477: iq=',iq
    IF(tr%igen /= 1) CYCLE
#ifdef DEBUG_IO    
    CALL WriteField_u('zq',zq(:,:,iq))
    CALL WriteField_u('zm',zm(:,:,iq))
#endif
    !----------------------------------------------------------------------
    SELECT CASE(iadv(iq))
      CASE(0); CYCLE
      CASE(10); CALL   vlx_loc(zq,pente_max,zm,mu,     ij_begin,ij_end,iq)
      CASE(14); CALL vlxqs_loc(zq,pente_max,zm,mu,qsat,ij_begin,ij_end,iq)
      CASE DEFAULT; STOP 'vlspltgen_p : schema non parallelise'
    END SELECT
    !----------------------------------------------------------------------
  END DO

!  write(*,*) 'vlspltgen 550: apres derniere serie de call vlx'
  CALL check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 521')
 
  ijb=ij_begin
  ije=ij_end
!  write(*,*) 'vlspltgen_loc 557'
!$OMP BARRIER      

!  write(*,*) 'vlspltgen_loc 559'  
  DO iq=1,nqtot
  !  write(*,*) 'vlspltgen_loc 561, iq=',iq  
#ifdef DEBUG_IO    
    CALL WriteField_u('zq',zq(:,:,iq))
    CALL WriteField_u('zm',zm(:,:,iq))
#endif
!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)          
    DO l=1,llm
      DO ij=ijb,ije
!   	  print *,'zq-->',ij,l,iq,zq(ij,l,iq)
!   	  print *,'q-->',ij,l,iq,q(ij,l,iq)
    	q(ij,l,iq)=zq(ij,l,iq)
      END DO
    END DO
!$OMP END DO NOWAIT    
  !  write(*,*) 'vlspltgen_loc 575'      

!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    DO l=1,llm
      DO ij=ijb,ije-iip1+1,iip1
    	 q(ij+iim,l,iq)=q(ij,l,iq)
      END DO
    END DO
!$OMP END DO NOWAIT  
!  write(*,*) 'vlspltgen_loc 583'  
  END DO
        
  CALL check_isotopes(q,ij_begin,ij_end,'vlspltgen_loc 557')

!$OMP BARRIER

!!$OMP MASTER      
!      call WaitSendRequest(MyRequest1) 
!      call WaitSendRequest(MyRequest2)
!!$OMP END MASTER
!!$OMP BARRIER

!  write(*,*) 'vlspltgen 597: sortie'  

END