#ifdef ISO
! $Id: isotopes_routines_mod.F90 5927 2025-12-12 16:26:10Z snguyen $
MODULE isotopes_routines_mod
  USE infotrac_phy, ONLY: niso, ntraciso=>ntiso, index_trac=>itZonIso, ntraceurs_zone=>nzone

IMPLICIT NONE

CONTAINS

SUBROUTINE iso_revap_fisrtilp(klon,klev,k, &
&            zrfl_ancien,zrfl,zrfln,zt,zxt_ancien, &
&            zxtrfl,zxtrfl_ancien,zxtrfln,zxt, &
&            paprs,dtime, &
&            zqs,zq_ancien,zqev_diag,zq)

USE isotopes_mod, ONLY: ridicule, ridicule_rain, thumxt1, no_pce,  &
&       bidouille_anti_divergence, &
&       iso_eau,iso_HDO,iso_O18
#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel
USE isotopes_verif_mod
#endif
#ifdef ISOTRAC
USE isotrac_mod, ONLY: option_revap,index_iso,izone_revap
USE isotrac_routines_mod, ONLY: ajoute_revap, &
&       compress_ilp_evap_glace_zone,compress_ilp_evap_liq_zone, &
&       uncompress_ilp_zone
#endif
USE yomcst_mod_h
IMPLICIT NONE



! inputs
INTEGER klon,klev,k
REAL zrfl_ancien(klon)
REAL zrfl(klon) ! pas necessaire, juste pour vérif
REAL zxt_ancien(ntraciso,klon) ! equivalent local de xt       
REAL zqev_diag(klon)
REAL zxtrfl_ancien(ntraciso,klon)
REAL zrfln(klon)
REAL dtime ! intervalle du temps (s)
REAL paprs(klon,klev+1) ! pression a inter-couche
REAL zt(klon)
REAL zqs(klon)
REAL zq_ancien(klon)
REAL zq(klon) ! pas necessaire, juste pour vérifs

! outputs       
REAL zxtrfln(ntraciso,klon)  
REAL zxtrfl(ntraciso,klon) ! identique à zxtrfln
REAL zxt(ntraciso,klon) 

! locals
REAL zqevfl(klon)
REAL fac_fluxtomixratio(klon)
REAL zrfl_cas(klon)       
REAL zqev_diag_cas(klon)
REAL zxtrfl_cas(niso,klon)
REAL zxtrfln_cas(niso,klon)
REAL zrfln_cas(klon)
REAL zxt_cas(niso,klon) ! zxt compress en input
REAL zxtnew_cas(niso,klon) ! zxt compresse en output       
REAL qeff(klon)
REAL zqs_cas(klon),zt_cas(klon)
REAL zq_cas(klon)
REAL delP(klon),delP_s_dt(klon)
REAL Exi(niso,klon)
REAL ztglace_kelvin
parameter (ztglace_kelvin=273) 
INTEGER frac_sublim
parameter (frac_sublim=0)
! pour le parsage
INTEGER icas_evap_tot,ncas_evap_tot
INTEGER icas_evap_liq,ncas_evap_liq
INTEGER icas_evap_glace,ncas_evap_glace
!      integer cas_evap_tot(klon)
INTEGER cas_evap_liq(klon)
INTEGER cas_evap_glace(klon)
INTEGER i,ixt

#ifdef ISOVERIF 
!integer iso_verif_aberrant_nostop
!integer iso_verif_egalite_choix_nostop
!integer iso_verif_positif_nostop
!integer iso_verif_positif_choix_nostop
INTEGER trace_cas(klon)
!real 
!integer iso_verif_egalite_nostop
!integer iso_verif_aberrant_choix_nostop
#endif
#ifdef ISOTRAC  
INTEGER iiso,ieau,izone
REAL xtrevap_tag(ntraciso,klon)
REAL ptrac(klon)
REAL hdiag(klon)
#endif

! ** parsage des cas pour isotopes
icas_evap_tot=0
icas_evap_liq=0
icas_evap_glace=0
#ifdef ISOVERIF
!     write(*,*) 'iso_routines tmp 96: entree'
! initialisation de l'outil de tracage de cas:
DO i=1,klon
  trace_cas(i)=0
  IF (iso_eau.GT.0) THEN
    CALL iso_verif_egalite_choix(zxt_ancien(iso_eau,i), &
&                  zq_ancien(i),'iso_revap_ilp 94', &
&                  errmax,errmaxrel)
    CALL iso_verif_egalite_choix( &
&                  zxtrfl_ancien(iso_eau,i), &
&                  zrfl_ancien(i),'iso_revap_ilp 99', &
&                  errmax,errmaxrel)
  ENDIF      
ENDDO !do il=1,ncum
#endif  
DO i=1,klon
IF (zrfl_ancien(i) .GT.0.) THEN
  IF (zrfln(i).GT.ridicule*1e-2) THEN          
    IF (zt(i).GE.ztglace_kelvin) THEN
      icas_evap_liq=icas_evap_liq+1    
      cas_evap_liq(icas_evap_liq)=i
#ifdef ISOVERIF
      trace_cas(i)=2               
#endif  
    ELSE !if (zt(i).ge.ztglace_kelvin) then
      icas_evap_glace=icas_evap_glace+1    
      cas_evap_glace(icas_evap_glace)=i
#ifdef ISOVERIF
      trace_cas(i)=3
#endif       
    ENDIF !if (zt(i).ge.ztglace_kelvin) then
  ELSE !if (zrfln(i).gt.ridicule*1e-2) then  
    icas_evap_tot=icas_evap_tot+1    
!               cas_evap_tot(icas_evap_tot)=i
        ! traitement à la volée
    DO ixt=1,ntraciso
      zxtrfln(ixt,i)=0.0               
      zxt(ixt,i)=zxt_ancien(ixt,i) &
&          +zxtrfl_ancien(ixt,i)*RG*dtime/(paprs(i,k)-paprs(i,k+1))
      zxt(ixt,i)=max(0.0,zxt(ixt,i))
      zxtrfl(ixt,i)=0.0
    ENDDO !do ixt=1,niso

#ifdef ISOVERIF
    trace_cas(i)=1
    IF (iso_eau.GT.0) THEN
      CALL iso_verif_egalite_choix(zxt(iso_eau,i), &
&           zq(i),'iso_revap_ilp 116',errmax,errmaxrel)
    ENDIF
    DO ixt=1,ntraciso
      CALL iso_verif_positif_choix(zxt(ixt,i),0.0,'revap_ilp 131')
    ENDDO
#ifdef ISOTRAC
    CALL iso_verif_traceur(zxtrfl_ancien(1,i), &
&           'iso_revap_fisrtilp 158: debut')
#endif
#endif
  ENDIF !if (zrfln(i).gt.ridicule*1e-2) then  
ELSE !IF (zrfl_ancien(i) .GT.0.) THEN
  ! pas de precip, rien à signaler
  DO ixt=1,ntraciso
    zxtrfln(ixt,i)=0.0               
    zxt(ixt,i)=zxt_ancien(ixt,i)
    zxt(ixt,i)=max(0.0,zxt(ixt,i))
    zxtrfl(ixt,i)=0.0
  ENDDO !do ixt=1,niso
#ifdef ISOVERIF
  trace_cas(i)=4
!     write(*,*) 'iso_routines tmp 160: i=',i
!        write(*,*) 'zrfl(i)=',zrfl(i)
!        write(*,*) 'zrfln(i)=',zrfln(i)
!        write(*,*) 'zrfl_ancien(i)=',zrfl_ancien(i)
!        write(*,*) 'zqev_diag(i)=',zqev_diag(i)
  CALL iso_verif_egalite_choix(zqev_diag(i), &
&                  0.0,'iso_revap_ilp 148a',ridicule,errmaxrel)
  CALL iso_verif_egalite_choix(zrfl(i), &
&                  0.0,'iso_revap_ilp 148b',ridicule,errmaxrel)
  CALL iso_verif_egalite_choix(zrfln(i), &
&                  0.0,'iso_revap_ilp 148c',ridicule,errmaxrel)
  IF (iso_eau.GT.0) THEN
    CALL iso_verif_egalite_choix(zxt(iso_eau,i), &
&                  zq(i),'iso_revap_ilp 149',errmax,errmaxrel)
    CALL iso_verif_egalite_choix(zxtrfln(iso_eau,i), &
&                  zrfln(i),'iso_revap_ilp 151',errmax,errmaxrel)
    CALL iso_verif_egalite_choix(zxtrfl(iso_eau,i), &
&                  zrfl(i),'iso_revap_ilp 151b',errmax,errmaxrel)
  ENDIF
  IF ((iso_HDO.GT.0).AND.(iso_O18.GT.0)) THEN
    IF (zq(i).GT.ridicule) THEN
      CALL iso_verif_aberrant_encadre(zxt(iso_HDO,i)/zq(i), &
     &                   'iso_revap_ilp 178')
      CALL iso_verif_O18_aberrant(zxt(iso_HDO,i)/zq(i), &
     &               zxt(iso_O18,i)/zq(i),'iso_revap_ilp 180')
    ENDIF !if (zq(i).gt.ridicule) then
  ENDIF !if ((iso_HDO.gt.0.and.(iso_O18.gt.0) then
#ifdef ISOTRAC
  CALL iso_verif_traceur(zxtrfl_ancien(1,i), &
&           'iso_revap_fisrtilp 201: debut quand pas de precip')
#endif
!     write(*,*) 'iso_routines tmp 184'
#endif               
ENDIF !IF (zrfl_ancien(i) .GT.0.) THEN
ENDDO !do i=1,klon   
ncas_evap_liq=icas_evap_liq
ncas_evap_glace=icas_evap_glace
ncas_evap_tot=icas_evap_tot

!      write(*,*) 'zrfln 773,k,klev,klon=',k,klev,klon
!      write(*,*) 'ncas_evap_liq=',ncas_evap_liq
!      write(*,*) 'ncas_evap_glace=',ncas_evap_glace
!      write(*,*) 'ncas_evap_tot=',ncas_evap_tot


! ** cas evap_liq=2
if (ncas_evap_liq.gt.0) then

  call compress_ilp_evap_liq( &
&       ncas_evap_liq,cas_evap_liq(1), &
&       zq_cas(1),zq_ancien(1), &
&       zqs_cas(1),zqs(1), &
&       zxt_cas(1,1),zxt_ancien(1,1),   &           
&       zxtrfl_cas(1,1),zxtrfl_ancien(1,1), &
&       zrfln_cas(1),zrfln(1),   &
&       zrfl_cas(1),zrfl_ancien(1),       &              
&       zqev_diag_cas(1),zqev_diag(1), &
&       zt_cas(1),zt(1),         &
&       delP(1),paprs,k,klon,klev)
  do i=1,ncas_evap_liq
     fac_fluxtomixratio(i)=RG*dtime/delP(i)
     delP_s_dt(i)=delP(i)/dtime 
     qeff(i)=(1-thumxt1)*zq_cas(i)+thumxt1*zqs_cas(i)
  enddo   
  do i=1,ncas_evap_liq
     zqevfl(i)=zqev_diag_cas(i)/fac_fluxtomixratio(i)
  enddo  
#ifdef ISOVERIF
 do i=1,ncas_evap_liq
  
  call iso_verif_egalite_choix((zrfln_cas(i)), &
&           zrfln(cas_evap_liq(i)), &
&          'iso_revap_fisrtilp 690; ap compress_evap_liq', &
&           errmax,errmaxrel)
  call iso_verif_egalite_choix((zrfl_cas(i)), &
&           zrfl_ancien(cas_evap_liq(i)), &
&           'iso_revap_fisrtilp 695; ap compress_evap_liq', &
&           errmax,errmaxrel)
  if (iso_eau.gt.0) then
    call iso_verif_egalite_choix(( &
&           zxtrfl_cas(iso_eau,i)),(zrfl_cas(i)), &
&           'iso_revap_fisrtilp 639; ap compress_evap_liq', &
&           errmax,errmaxrel)
  endif ! if (iso_eau.gt.0) then
  call iso_verif_egalite_choix(zqev_diag_cas(i), &
&           zqev_diag(cas_evap_liq(i)), &
&           'iso_revap_fisrtilp 692; ap compress_evap_liq', &
&           errmax,errmaxrel)
  call iso_verif_egalite_choix(zrfl_ancien(cas_evap_liq(i)) &
&           -zqev_diag(cas_evap_liq(i)) &
&           *(paprs(cas_evap_liq(i),k)-paprs(cas_evap_liq(i),k+1)) &
&                    /RG/dtime-zrfln(cas_evap_liq(i)),0.0, &
&           'iso_revap_fisrtilp 693; ap compress_evap_liq', &
&           errmax,errmaxrel)
  call iso_verif_egalite(( &
&           zrfl_cas(i)-zqevfl(i)-zrfln_cas(i)),0.0, &
&          'iso_revap_fisrtilp 691, après compress_evap_liq')
 enddo !do i=1,ncas_evap_liq
!         write(*,*) 'iso_revap_fisrtilp temp 715: qeff(1),zqs_cas(1)=',
!     :           qeff(1),zqs_cas(1)
#endif       
 if (no_pce.eq.1) then
     call stewart_sublim_nofrac_vectall( &
&        ncas_evap_liq,zq_cas(1), &
&        zxt_cas(1,1),zrfl_cas(1), &
&        zxtrfl_cas(1,1),zqevfl(1),zrfln_cas(1), &
&        zxtrfln_cas(1,1),zxtnew_cas(1,1),Exi(1,1), &
&        fac_fluxtomixratio(1))
 else !if (no_pce.eq.1) then
     
  call stewart_explicite_vectall(ncas_evap_liq, &
&           zq_cas(1),zxt_cas(1,1), &
&           zrfl_cas(1),zxtrfl_cas(1,1),zqevfl(1), &
&           zrfln_cas(1),qeff(1), &
&           zxtrfln_cas(1,1),zxtnew_cas(1,1),Exi(1,1), &
&           fac_fluxtomixratio(1), &
&           zqs_cas(1),zt_cas(1), &
&           delP_s_dt(1), &
&           delP(1) &
#ifdef ISOVERIF
&          ,0,1 &
#endif
&   )
endif !if (no_pce.eq.1) then

#ifdef ISOVERIF
  do i=1,ncas_evap_liq
   do ixt=1,niso
    call iso_verif_noNaN((zxtrfln_cas(ixt,i)), &
&           'iso_revap_fisrtilp 8283')
    call iso_verif_noNaN((zxtnew_cas(ixt,i)), &
&           'iso_revap_fisrtilp 8293')
    call iso_verif_positif_choix(( &
&           zxtnew_cas(ixt,i)),0.0,'revap_ilp 225')
   enddo
  enddo
  if (iso_eau.gt.0) then
     do i=1,ncas_evap_liq
       call iso_verif_egalite_choix( &
&                  (zxtrfln_cas(iso_eau,i)), &
&                  (zrfln_cas(i)),'il pleut 4552', &
&                  errmax,errmaxrel)               
       call iso_verif_egalite_choix( &
&                  (zxtnew_cas(iso_eau,i)), &
&                  zq(cas_evap_liq(i)), &
&                  'il pleut 4102',errmax,errmaxrel)        
      enddo !do i=1,ncas_evap_liq
   endif !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
   if (iso_HDO.gt.0) then
      do i=1,ncas_evap_liq
         if (zrfln_cas(i).gt.ridicule_rain) then
                call iso_verif_aberrant( &
&                  (zxtrfln_cas(iso_HDO,i) &
&                 /zrfln_cas(i)), 'iso_revap_fisrtilp 4562')
         endif
       enddo !do i=1,ncas_evap_liq
   endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) then
   !  write(*,*) 'iso_routines tmp 308: i=',i
   if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
        do i=1,ncas_evap_liq
        if (zq(i).gt.ridicule) then
           call iso_verif_aberrant_encadre((zxtnew_cas(iso_HDO,i))/zq(cas_evap_liq(i)), &
     &                   'iso_revap_ilp 311')
           call iso_verif_O18_aberrant((zxtnew_cas(iso_HDO,i))/zq(cas_evap_liq(i)), &
     &               (zxtnew_cas(iso_O18,i))/zq(cas_evap_liq(i)),'iso_revap_ilp 312')
        endif !if (zq(i).gt.ridicule) then
        enddo !do i=1,ncas_evap_liq
    endif !if ((iso_HDO.gt.0.and.(iso_O18.gt.0) then     
    ! write(*,*) 'iso_routines tmp 319'
#endif
  if ((bidouille_anti_divergence).and. &
&           (iso_eau.gt.0)) then
    do i=1,ncas_evap_liq
      zxtrfln_cas(iso_eau,i)=zrfln_cas(i)
      zxtnew_cas(iso_eau,i)=zq(cas_evap_liq(i))    
    enddo !do i=1,ncas_evap_liq
  endif
  
  call uncompress_ilp( &
&       ncas_evap_liq,cas_evap_liq(1), &
&       zxtrfln_cas(1,1),zxtnew_cas(1,1), &
&       zxtrfl(1,1),zxtrfln(1,1),zxt(1,1),klon)

#ifdef ISOTRAC
  do izone=1,ntraceurs_zone

  ! on compresse, mais en plus on séléctionne que la preciip
  ! correspondant à la zone izone. Par contre, la vapeur reste
  ! la vapeur totale
  
#ifdef ISOVERIF          
  write(*,*) 'iso_revap_ilp 245 tmp: izone=',izone
  write(*,*) 'avant call compress_ilp_evap_liq_zone'
!          if (ncas_evap_liq.ge.9) then
!          i=9
!          write(*,*) 'i,cas_evap_liq(i),zrfln,zrfl_ancien,zqev_diag=',
!     :              i,cas_evap_liq(i),zrfln(cas_evap_liq(i)),
!     :              zrfl_ancien(cas_evap_liq(i)),
!     :              zqev_diag(cas_evap_liq(i))
!          write(*,*) 'zxtrfl_ancien(1:ntraciso:2,i)=',
!     :           zxtrfl_ancien(1:ntraciso:2,cas_evap_liq(i))
!          write(*,*) 'ieau,zxtrfl_ancien(ieau,cas_evap_liq(i)=',
!     :           index_trac(izone,iso_eau),zxtrfl_ancien        
!     :           (index_trac(izone,iso_eau),cas_evap_liq(i))
!          endif
#endif          

  call compress_ilp_evap_liq_zone( &
&       ncas_evap_liq,cas_evap_liq(1), &
&       zxt_cas(1,1),zxt_ancien(1,1),    &          
&       zxtrfl_cas(1,1),zxtrfl_ancien(1,1), &
&       zrfln_cas(1),zrfln(1),   &
&       zrfl_cas(1),zrfl_ancien(1),         &            
&       zqev_diag_cas(1),zqev_diag(1), &
&       klon,izone,ptrac(1))
  do i=1,ncas_evap_liq
     zqevfl(i)=zqev_diag_cas(i)/fac_fluxtomixratio(i)
  enddo 

#ifdef ISOVERIF
  do i=1,ncas_evap_liq
    call iso_verif_egalite(( &
&           zrfl_cas(i)-zqevfl(i)-zrfln_cas(i)),0.0, &
&          'iso_revap_fisrtilp 286')
  enddo !do i=1,ncas_evap_liq
#endif           

  ! renormaliser les flux de precip pour que la proportion masse
  ! de liq/masse de vap soit la même pour toutes les zones
  ! on pourrait faire les choses plus proprement à l'avenir...
  do i=1,ncas_evap_liq
    ! 1er juin 2009: on remplace ridicule par ridicule*1e3
    if (ptrac(i).gt.ridicule*1e3) then
      zrfl_cas(i)=zrfl_cas(i)/ptrac(i)
      zqevfl(i)=zqevfl(i)/ptrac(i)
      zrfln_cas(i)=zrfln_cas(i)/ptrac(i)  
      do ixt=1,niso
       zxtrfl_cas(ixt,i)=zxtrfl_cas(ixt,i)/ptrac(i)
      enddo               
    else !if (ptrac(i).gt.ridicule*1e3) then
#ifdef ISOVERIF                
     call iso_verif_egalite((zrfl_cas(i)), &
&           0.0,'revap_ilp 294')  
     call iso_verif_egalite((zqevfl(i)), &
&           0.0,'revap_ilp 296')
     call iso_verif_egalite((zrfln_cas(i)), &
&           0.0,'revap_ilp 298')
#endif             
     zrfl_cas(i)=0.0
     zqevfl(i)=0.0
     zrfln_cas(i)=0.0
     do ixt=1,niso
       zxtrfl_cas(ixt,i)=0.0
     enddo
    endif !if (ptrac(i).gt.ridicule*1e3) then
  enddo !do i=1,ncas_evap_liq

#ifdef ISOVERIF
  do i=1,ncas_evap_liq
    if (iso_verif_egalite_nostop(( &
&           zrfl_cas(i)-zqevfl(i)-zrfln_cas(i)),0.0, &
&          'iso_revap_fisrtilp 314').eq.1) then
       write(*,*) 'i,zrfl_cas(i),zqevfl(i),zrfln_cas(i)=', &
&           i,zrfl_cas(i),zqevfl(i),zrfln_cas(i)
       write(*,*) 'ptrac(i),zrfl_ancien=', &
&           ptrac(i),zrfl_ancien(cas_evap_liq(i))
       stop
    endif
    if (iso_verif_aberrant_choix_nostop( &
&         (zxtrfl_cas(iso_HDO,i)), &
&         (zrfl_cas(i)), &
&         ridicule_rain,deltalimtrac, &
&         'iso_revap_ilp 342').eq.1) then
       write(*,*) 'i,ptrac(i),zrfl_cas(i)=', &
&           i,ptrac(i),zrfl_cas(i)
       stop
     endif
  enddo !do i=1,ncas_evap_liq
#endif          
  
 if (no_pce.eq.1) then
     call stewart_sublim_nofrac_vectall( &
&        ncas_evap_liq,zq_cas(1), & 
&        zxt_cas(1,1),zrfl_cas(1), &
&        zxtrfl_cas(1,1),zqevfl(1),zrfln_cas(1), &
&        zxtrfln_cas(1,1),zxtnew_cas(1,1),Exi(1,1), &
&        fac_fluxtomixratio(1))
 else !if (no_pce.eq.1) then 
  call stewart_explicite_vectall(ncas_evap_liq, &
&           zq_cas(1),zxt_cas(1,1), &
&           zrfl_cas(1),zxtrfl_cas(1,1),zqevfl(1), &
&           zrfln_cas(1),qeff(1), &
&           zxtrfln_cas(1,1),zxtnew_cas(1,1),Exi(1,1), &
&           fac_fluxtomixratio(1), &
&           zqs_cas(1),zt_cas(1), &
&           delP_s_dt(1), &
&           delP(1) &
#ifdef ISOVERIF
&          ,1,9 &
#endif
&   )
  endif !if (no_pce.eq.1) theniso_revap_fisrtilp 776

  ! renormaliser les flux de precip pour que la proportion masse
  ! de liq/masse de vap soit la même pour toutes les zones
  ! on pourrait faire les choses plus proprement à l'avenir...
  do i=1,ncas_evap_liq
     zrfl_cas(i)=zrfl_cas(i)*ptrac(i)
     zqevfl(i)=zqevfl(i)*ptrac(i)
     zrfln_cas(i)=zrfln_cas(i)*ptrac(i)
     do ixt=1,niso
       zxtrfl_cas(ixt,i)=zxtrfl_cas(ixt,i)*ptrac(i)
       Exi(ixt,i)=Exi(ixt,i)*ptrac(i)
       zxtrfln_cas(ixt,i)=zxtrfln_cas(ixt,i)*ptrac(i)
       zxtnew_cas(ixt,i)=zxt_cas(ixt,i) &
&           +(zxtnew_cas(ixt,i)-zxt_cas(ixt,i))*ptrac(i)
     enddo
     hdiag(i)=qeff(i)/zqs_cas(i)
  enddo !do i=1,ncas_evap_liq

#ifdef ISOVERIF
do i=1,ncas_evap_liq
  do iiso=1,niso
  call iso_verif_positif_choix(( &
&           zxtnew_cas(iiso,i)),0.0,'revap_ilp 394')
  ixt=index_trac(izone,iiso)
  call iso_verif_positif_choix( &
&           zxt(ixt,cas_evap_liq(i)),0.0,'revap_ilp 397')
  if (iso_verif_positif_choix_nostop( &
&           zxt(ixt,cas_evap_liq(i))+( &
&           fac_fluxtomixratio(i)*Exi(iiso,i)), &
&           0.0,'revap_ilp 401').eq.1) then
     write(*,*) 'i,iiso,iso_eau=',i,iiso,iso_eau
     write(*,*) 'zxt=',zxt(ixt,cas_evap_liq(i))
     write(*,*) 'Exi=',Exi(iiso,i)
     write(*,*) 'zxt_eau=',zxt( &
&           index_trac(izone,iso_eau),cas_evap_liq(i))
     write(*,*) 'Exi_eau=',Exi(iso_eau,i)
     write(*,*) 'fac_ftmr=',fac_fluxtomixratio(i)
     write(*,*) 'ptrac=',ptrac(i)
!             stop
  endif
  enddo !do iiso=1,niso
enddo !do i=1,ncas_evap_liq
#endif          
  
  call uncompress_ilp_zone( &
&       ncas_evap_liq,cas_evap_liq(1), &
&       zxtrfln_cas(1,1),zxtnew_cas(1,1), &
&       zxtrfl(1,1),zxtrfln(1,1),zxt(1,1),klon, &
&       izone,zqevfl(1),Exi(1,1),fac_fluxtomixratio(1), &
&       xtrevap_tag(1,1),1,hdiag(1))
        ! dans cette routine, zxtrfl reçoit zxtrfln_cas

  enddo !do izone=1,ntraceurs_zone

#ifdef ISOVERIF
do i=1,ncas_evap_liq
do ixt=1,ntraciso
    call iso_verif_positif_choix(zxt(ixt,cas_evap_liq(i)), &
&              0.0,'revap_ilp 414')
enddo
     call iso_verif_traceur(zxtrfl(1,cas_evap_liq(i)), &
&           'iso_revap_fisrtilp 470a: apres stewart_explicite_vectall')
enddo !do i=1,ncas
#endif            

  ! si on taggue la révap, alors les évaporations des
  ! différentes zones ont été stockées dans xtrevap_tag
  ! on les somme toute dans la vap au tag revap
  if (option_revap.eq.1) then
    call ajoute_revap(ncas_evap_liq,cas_evap_liq(1), &
&          klon,izone,zxt(1,1),xtrevap_tag(1,1))            
  endif !if (option_revap.eq.1) then
#ifdef ISOVERIF
  do i=1,ncas_evap_liq
     call iso_verif_traceur(zxt(1,cas_evap_liq(i)), &
&           'iso_revap_fisrtilp 282')
     call iso_verif_traceur(zxtrfl(1,cas_evap_liq(i)), &
&           'iso_revap_fisrtilp 804a')
     call iso_verif_traceur(zxtrfln(1,cas_evap_liq(i)), &
&           'iso_revap_fisrtilp 804b')
     do ixt=1,ntraciso
        call iso_verif_positif_choix(zxt(ixt,cas_evap_liq(i)), &
&                   0.0,'revap_ilp 424')
     enddo
  enddo
#endif          
#endif
! #endif ISOTRAC

endif !if (ncas_evap_liq.gt.0) then  

! ** cas evap_glace=3
if (ncas_evap_glace.gt.0) then

#ifdef ISOVERIF
!      write(*,*) ''
!      write(*,*) 'iso_revap tmp 469: traitement cas evap glace'
!      write(*,*) 'cas_evap_glace(1),zqev_diag=',
!     :           cas_evap_glace(1),zqev_diag(cas_evap_glace(1))

  if (iso_eau.gt.0) then
    do i=1,ncas_evap_glace
      call iso_verif_egalite_choix( &
&           zrfl_ancien(cas_evap_glace(i)), &
&           zxtrfl_ancien(iso_eau,cas_evap_glace(i)), &
&           'iso_revap_fisrtilp 742: zrfl_ancien=zxtrfl?', &
&           errmax,errmaxrel)
    enddo !do i=1,ncas_evap_glace
  endif !if (iso_eau.gt.0) then
#endif          
  call compress_ilp_evap_glace( &
&       ncas_evap_glace,cas_evap_glace(1), &
&       zq_cas(1),zq_ancien(1), &
&       zxt_cas(1,1),zxt_ancien(1,1),     &         
&       zxtrfl_cas(1,1),zxtrfl_ancien(1,1), &
&       zrfln_cas(1),zrfln(1),   &
&       zrfl_cas(1),zrfl_ancien(1),         &
&       zqev_diag_cas(1),zqev_diag(1), &
&       zt_cas(1),zt(1),   &
&       delP(1),paprs,k,klon,klev,frac_sublim)
#ifdef ISOVERIF
  if (iso_eau.gt.0) then
    do i=1,ncas_evap_glace
      
      call iso_verif_egalite_choix((zrfl_cas(i)), &
&           (zxtrfl_cas(iso_eau,i)), &
&           'iso_revap_fisrtilp 731: apres compress evap_glace', &
&           errmax,errmaxrel)
      call iso_verif_egalite_choix((zq_cas(i)), &
&           (zxt_cas(iso_eau,i)), &
&           'iso_revap_fisrtilp 755: apres compress evap_glace', &
&           errmax,errmaxrel)
      call iso_verif_egalite_choix(zqev_diag_cas(i), &
&           zqev_diag(cas_evap_glace(i)), &
&           'iso_revap_fisrtilp 755: apres compress evap_glace', &
&           errmax,errmaxrel)
     call iso_verif_egalite_choix(delP(i), &
&          paprs(cas_evap_glace(i),k)-paprs(cas_evap_glace(i),k+1), &
&          'iso_revap_fisrtilp 769: apres compress evap_glace', &
&           errmax,errmaxrel) 
    enddo   !do i=1,ncas_evap_glace
  endif ! if (iso_eau.gt.0) then 
#endif          
  do i=1,ncas_evap_glace
     fac_fluxtomixratio(i)=RG*dtime/delP(i)
     zqevfl(i)=zqev_diag_cas(i)/fac_fluxtomixratio(i)
  enddo !do i=1,ncas_evap_glace
!          write(*,*) 'zqev_diag,fac_fluxtomixratio=',
!     :           zqev_diag(cas_evap_glace(1)),
!     :           fac_fluxtomixratio(1)
#ifdef ISOVERIF
  do i=1,ncas_evap_glace
    call iso_verif_noNaN((fac_fluxtomixratio(i)), &
&            'iso_revap_fisrtilp 763')
!            write(*,*) 'i,cas_evap_glace(i)=',i,cas_evap_glace(i)
!            write(*,*) 'zqevfl(i),zrfl_cas(i),zrfln_cas(i)=',
!     :           zqevfl(i),zrfl_cas(i),zrfln_cas(i)
!            write(*,*) 'zqev_diag_cas(i),fac_fluxtomixratio(i)=',
!     :         zqev_diag_cas(i),fac_fluxtomixratio(i)  
    if (iso_verif_positif_nostop( &
&           (zrfl_cas(i)-zqevfl(i)),'iso_revap_fisrtilp 776') &
&           .eq.1) then
      if (zrfl_cas(i)-zqevfl(i).lt.-ridicule*1e3) then
          stop
      endif
    endif !if (iso_verif_positif_nostop
  enddo !do i=1,ncas_evap_glace
#endif     
  if (frac_sublim.eq.1) then
      call stewart_glace_vectall(ncas_evap_glace &
&                ,zq_cas(1),zxt_cas(1,1) &
&                ,zrfl_cas(1),zxtrfl_cas(1,1) &
&                ,zqevfl(1),zrfln_cas(1) &
&                ,zxtrfln_cas(1,1),zxtnew_cas(1,1),Exi(1,1) &
&                ,fac_fluxtomixratio(1),zt(1))
  else !if (frac_sublim.eq.1) then
      call stewart_sublim_nofrac_vectall(ncas_evap_glace &
&              ,zq_cas(1),zxt_cas(1,1),zrfl_cas(1),zxtrfl_cas(1,1) &
&              ,zqevfl(1),zrfln_cas(1) &
&              ,zxtrfln_cas(1,1),zxtnew_cas(1,1),Exi(1,1) &
&              ,fac_fluxtomixratio(1))
  endif  !if (frac_sublim.eq.1) then 

#ifdef ISOVERIF
        !write(*,*) 'ncas_evap_glace=',ncas_evap_glace
        !write(*,*) 'cas_evap_glace(6)=',cas_evap_glace(6)
  do i=1,ncas_evap_glace
   do ixt=1,niso
    call iso_verif_noNaN((zxtrfln_cas(ixt,i)), &
&           'iso_revap_fisrtilp 8883')
    call iso_verif_noNaN((zxtnew_cas(ixt,i)), &
&           'iso_revap_fisrtilp 8893')
    call iso_verif_positif_choix(( &
&           zxtnew_cas(ixt,i)),0.0,'revap_ilp 534')
   enddo
  enddo !do i=1,ncas_evap_glace
  if (iso_eau.gt.0) then
     do i=1,ncas_evap_glace
       call iso_verif_egalite_choix( &
&                  (zxtrfln_cas(iso_eau,i)), &
&                  (zrfln_cas(i)), &
&                  'iso_revap_fisrtilp 4553', &
&                  errmax,errmaxrel)
       if (iso_verif_egalite_choix_nostop( &
&              (zxtnew_cas(iso_eau,i)), &
&              zq(cas_evap_glace(i)), &
&              'iso_revap_fisrtilp 4103',errmax,errmaxrel) &
&              .eq.1) then
          write(*,*) 'i,cas_evap_glace(i)=',i,cas_evap_glace(i)
          write(*,*) 'zq(cas_evap_glace(i))=', &
&                   zq(cas_evap_glace(i))
          write(*,*) 'zq_cas(i)=',zq_cas(i)
          stop
       endif !if (iso_verif_egalite_choix_nostop
      enddo !do i=1,ncas_evap_glace
   endif !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
   if (iso_HDO.gt.0) then
      do i=1,ncas_evap_glace
                call iso_verif_aberrant_choix(zxtrfln_cas(iso_HDO,i), zrfln_cas(i), &
                  ridicule_rain,deltalim_snow, 'iso_revap_fisrtilp 4563')
       enddo !do i=1,ncas_evap_glace
   endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) then
   !  write(*,*) 'iso_routines tmp 667: i=',i
   if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
      do i=1,ncas_evap_glace
        if (zq(i).gt.ridicule) then
!     write(*,*) 'iso_routines tmp 679a'
!        write(*,*) 'cas_evap_glace(i)=',cas_evap_glace(i)
           call iso_verif_aberrant_encadre((zxtnew_cas(iso_HDO,i))/zq(cas_evap_glace(i)), &
     &                   'iso_revap_ilp 669')
!     write(*,*) 'iso_routines tmp 679b'
           call iso_verif_O18_aberrant((zxtnew_cas(iso_HDO,i))/zq(cas_evap_glace(i)), &
     &               (zxtnew_cas(iso_O18,i))/zq(cas_evap_glace(i)),'iso_revap_ilp 671')
!     write(*,*) 'iso_routines tmp 679c'
        endif !if (zq(i).gt.ridicule) then
        enddo ! do i=1,ncas_evap_glac
    endif !if ((iso_HDO.gt.0.and.(iso_O18.gt.0) then
!     write(*,*) 'iso_routines tmp 679d'
#endif

  if ((bidouille_anti_divergence).and. &
&           (iso_eau.gt.0)) then
    do i=1,ncas_evap_glace
      zxtrfln_cas(iso_eau,i)=zrfln_cas(i)
      zxtnew_cas(iso_eau,i)=zq(cas_evap_glace(i))    
    enddo !do i=1,ncas_evap_liq
  endif ! if ((bidouille_anti_divergence).and.

#ifdef ISOVERIF
  if (iso_eau.gt.0) then
    do i=1,ncas_evap_glace
    call iso_verif_egalite_choix( &
&            (zxtrfln_cas(iso_eau,i)), &
&            zrfln(cas_evap_glace(i)),'iso_revap_fisrtilp 810', &
&           errmax,errmaxrel)
    enddo !do i=1,ncas_evap_glace
  endif !if (iso_eau.gt.0) then
#endif          
  
  call uncompress_ilp( &
&       ncas_evap_glace,cas_evap_glace(1), &
&       zxtrfln_cas(1,1),zxtnew_cas(1,1), &
&       zxtrfl(1,1),zxtrfln(1,1),zxt(1,1),klon)      

!      write(*,*) 'iso_revap tmp 448: traitement cas evap glace traceurs'
!      write(*,*) 'zqev_diag,fac_fluxtomixratio=',
!     :           zqev_diag(cas_evap_glace(1)),
!     :           fac_fluxtomixratio(1)

#ifdef ISOTRAC
  do izone=1,ntraceurs_zone
!          write(*,*) 'iso_revap_ilp 509 tmp: izone=',izone     
  ! on compresse, mais en plus on séléctionne que la preciip
  ! correspondant à la zone izone. Par contre, la vapeur reste
  ! la vapeur totale
  call compress_ilp_evap_glace_zone( &
&       ncas_evap_glace,cas_evap_glace(1), &
&       zxt_cas(1,1),zxt_ancien(1,1),       &       
&       zxtrfl_cas(1,1),zxtrfl_ancien(1,1), &
&       zrfln_cas(1),zrfln(1),  &
&       zrfl_cas(1),zrfl_ancien(1),       &              
&       zqev_diag_cas(1),zqev_diag(1), &
&       klon,izone)
  do i=1,ncas_evap_glace
     zqevfl(i)=zqev_diag_cas(i)/fac_fluxtomixratio(i)
  enddo  

  if (frac_sublim.eq.1) then
      call stewart_glace_vectall(ncas_evap_glace &
&                ,zq_cas(1),zxt_cas(1,1) &
&                ,zrfl_cas(1),zxtrfl_cas(1,1) &
&                ,zqevfl(1),zrfln_cas(1) &
&                ,zxtrfln_cas(1,1),zxtnew_cas(1,1),Exi(1,1) &
&                ,fac_fluxtomixratio(1),zt(1))
  else
      call stewart_sublim_nofrac_vectall(ncas_evap_glace &
&              ,zq_cas(1),zxt_cas(1,1),zrfl_cas(1),zxtrfl_cas(1,1) &
&              ,zqevfl(1),zrfln_cas(1) &
&              ,zxtrfln_cas(1,1),zxtnew_cas(1,1),Exi(1,1) &
&              ,fac_fluxtomixratio(1))
  endif  
  
!          write(*,*) 'iso_revap_ilp 509 tmp: Exi,zqev_diag_cas=',
!     :           Exi(iso_eau,1),zqev_diag_cas(1)
  call uncompress_ilp_zone( &
&       ncas_evap_glace,cas_evap_glace(1), &
&       zxtrfln_cas(1,1),zxtnew_cas(1,1), &
&       zxtrfl(1,1),zxtrfln(1,1),zxt(1,1),klon, &
&       izone,zqevfl(1),Exi(1,1),fac_fluxtomixratio(1), &
&       xtrevap_tag(1,1),0,hdiag(1)) ! hdiag not used         

  enddo !do izone=1,ntraceurs_zone        

  ! si on taggue la révap, alors les évaporations des
  ! différentes zones ont été stockées dans xtrevap_tag
  ! on les somme toute dans la vap au tag revap
  if (option_revap.eq.1) then
    call ajoute_revap(ncas_evap_glace,cas_evap_glace(1), &
&          klon,izone,zxt(1,1),xtrevap_tag(1,1))            
  endif !if (option_revap.eq.1) then
#ifdef ISOVERIF
  do i=1,ncas_evap_glace
!             write(*,*) 'iso_revap_ilp 520 tmp: i=',i
!             write(*,*) 'zxt=',zxt(iso_eau:ntraciso:3,cas_evap_glace(i))
!             write(*,*) 'zxt_ancien=',zxt_ancien
!     :           (iso_eau:ntraciso:3,cas_evap_glace(i))
     call iso_verif_traceur(zxt(1,cas_evap_glace(i)), &
&           'iso_revap_fisrtilp 1033')
     call iso_verif_traceur(zxtrfl(1,cas_evap_glace(i)), &
&           'iso_revap_fisrtilp 1035a')
     call iso_verif_traceur(zxtrfln(1,cas_evap_glace(i)), &
&           'iso_revap_fisrtilp 1035b')
  enddo
#endif          
#endif
!#ifdef ISOTRAC

endif !if (ncas_evap_glace.gt.0) then 

#ifdef ISOVERIF          
  ! dernières vérifs pour l'évap
if (iso_eau.gt.0) then
do i=1,klon
if (zrfl_ancien(i).gt.0.0) then
call iso_verif_egalite_choix( &
&           zxtrfln(iso_eau,i), &
&           zrfln(i),'iso_revap_fisrtilp 801', &
&           errmax,errmaxrel)
if (iso_verif_egalite_choix_nostop( &
&         zxtrfl(iso_eau,i), &
&         zrfl(i),'iso_revap_fisrtilp 802', &
&         errmax,errmaxrel).eq.1) then
      write(*,*) 'i,k,trace_cas(i)=',i,k,trace_cas(i)
      write(*,*) 'zxtrfln(iso_eau,i),zrfln(i)=', &
&           zxtrfln(iso_eau,i),zrfln(i)
      stop  
endif ! if (iso_verif_egalite_choix_nostop(
if (iso_verif_egalite_choix_nostop( &
&         zxt(iso_eau,i),zq(i), &
&         'iso_revap_fisrtilp 807',errmax,errmaxrel).eq.1) then
  write(*,*) 'i,k,trace_cas(i)=',i,k,trace_cas(i)
  stop
endif !if (iso_verif_egalite_choix_nostop(
endif !if (zrfl_ancien(i).gt.0.0) then
enddo !do i=1,klon
endif !if (iso_eau.gt.0) then
#ifdef ISOTRAC      
! grande vérif finale
do i=1,klon          
    call iso_verif_traceur(zxt(1,i),'iso_revap_fisrtilp 532')
    call iso_verif_traceur(zxtrfln(1,i), &
&           'iso_revap_fisrtilp 533a') 
    call iso_verif_traceur(zxtrfl(1,i), &
&           'iso_revap_fisrtilp 533b')
    do ixt=1,ntraciso
        call iso_verif_positif_choix(zxt(ixt,i),0.0, &
&                   'revap_ilp 701')
    enddo
enddo !do i=1,klon
        !write(*,*) 'revap_ilp 814: sortie'
#endif       
#endif          

  end subroutine iso_revap_fisrtilp

subroutine iso_evap_sol_nu(qsol0,qevap,q10,Rsol0,R1,h,T,alphak, &
&    L, xtnu,Pveg)

USE isotopes_mod, ONLY: ridicule_qsol, ridicule, &
&       ridicule_evap,P_veg,iso_HDO,iso_eau,iso_O17,iso_O18
#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel,faccond
USE isotopes_verif_mod
#endif
implicit none

! calcul de Rsol et Revap lors de l'évaporation de l'eau du sol
! par évap nue.

! inputs:
real qsol0 ! eau du sol
real qevap  ! eau perdue par le sol
real Rsol0(niso) ! rapport iso initial dans sol
real R1(niso) ! rapport iso dans couche 1, supposé constant
real q10 ! humidité 1ère couche, en mm
real h ! humidité rel dans couche 1, supposée cosntante
real T ! température
real alphak(niso) ! coef cinétique
real L ! longueur de diffusion
real Pveg ! just pour débguage

! outputs!
real xtnu(niso) !  flux iso dans l'évap

! locals
real f ! fraction d'eau résiduelle dans le sol   
real interm(niso)        
real betaprime(niso) ! beta de stewart75
real gama(niso) ! le gama de Stewart75
real zxtalphal(niso), zxtalphai(niso) ! coeffs frac
integer ixt

! calcul de l'évap: ordre 1 (on prend l'évap en t0) ou bilan total
! (on prend l'évap tel que la 1ère couche se mette à l'équilibre
integer ordre1 ! 1: ordre 1: deltaDevap= si deltaDvap ne change pas
             ! 2: deltaDvap change
parameter (ordre1=2)

#ifdef ISOVERIF
!integer iso_verif_aberrant_nostop
!integer iso_verif_aberrant_choix_nostop
!integer iso_verif_egalite_choix_nostop
!real deltaD
real xtnu2(niso)
#endif      

! ca ne marche que si déjà de l'eau dans le sol au départ
if (qsol0.lt.ridicule_qsol) then
  do ixt=1,niso
     xtnu(ixt)=Rsol0(ixt)*qevap
  enddo
#ifdef ISOVERIF
    if (iso_HDO.gt.0) then
!                write(*,*) 'sol_nu 66: deltaDsol(iso_HDO)=',         
!     :           (Rsol(iso_HDO)/tnat(iso_HDO)-1)*1000
!                write(*,*) 'deltaDevap(iso_HDO)=',(Revap(iso_HDO)/
!     :           tnat(iso_HDO)-1)*1000
    endif !if (iso_HDO.gt.0) then
#endif
  return
endif !if (qsol0.lt.ridicule_qsol) then

! vérif des rapports isotopiques en entrée
#ifdef ISOVERIF
! provisoire, à enlever pour tests avec evap sol nu!
if (P_veg.eq.1.0) then
 call iso_verif_egalite(Pveg,1.0,'iso_evap_sol_nu 64')
endif
if (iso_eau.gt.0) then
  call iso_verif_egalite_choix(Rsol0(iso_eau),1.0, &
&           'sol_nu 83',errmax,errmaxrel)
  call iso_verif_egalite_choix(R1(iso_eau),1.0, &
&           'sol_nu 56',errmax,errmaxrel)
endif !if (iso_eau.gt.0) then
if (iso_HDO.gt.0) then 
  if (qsol0.gt.ridicule_qsol*1e2) then   
     if (iso_verif_aberrant_nostop(Rsol0(iso_HDO)/faccond, &
&           'sol_nu 58').eq.1) then
       write(*,*) 'qsol0=',qsol0
       stop
     endif !if (iso_verif_aberrant_nostop
  endif !if (qsol0.gt.ridicule*1e2) then 
  if (h.gt.0.01) then
     call iso_verif_aberrant(R1(iso_HDO),'sol_nu 59')
  endif !if (h.gt.0.01) then
endif  !if (iso_HDO.gt.0) then  
#endif

! calcul de la fraction résiduelle de liq dans sol
! cas général: f=(L-qevap)/L
! cas si qevap>L: f=0
! cas si qsol0<L -> f=(qsol0-qevap)/qsol0
f=max((min(L,qsol0)-qevap)/min(L,qsol0),0.0)
#ifdef ISOVERIF
call iso_verif_positif(1.0-f,'iso_evap_sol_nu 68')
#endif        


if (f.lt.ridicule) then
  ! il ne reste plus rien après l'évap
  ! -> evap sans frac  
  do ixt=1,niso
    xtnu(ixt)=qevap*Rsol0(ixt) 
  enddo

else !if (f.lt.ridicule) then

! 2 e cas simple: h=1
if (h.gt.0.99) then
#ifdef ISOVERIF
  write(*,*) 'sol_nu 102: h=',h
#endif                    
  do ixt=1,niso
    call fractcalk(ixt,T,zxtalphal(ixt),zxtalphai(ixt))
  enddo ! do ixt=1,niso
  if (qevap.gt.min(L,qsol0)) then
      ! évap trop rapide pour fractionner
     do ixt=1,niso
       xtnu(ixt)=qevap*Rsol0(ixt) 
     enddo ! do ixt=1,niso
  else if (qsol0.lt.L) then
      ! il ne reste plus beaucou d'eau, tout diffuse
     
     ! cas simple où q10>>qevap
     if (ordre1.eq.1) then
       do ixt=1,niso
         xtnu(ixt)=qsol0*(Rsol0(ixt)-zxtalphal(ixt)*R1(ixt)) &
&          +qevap*zxtalphal(ixt)*R1(ixt)
       enddo ! do ixt=1,niso
     else !if (ordre1.eq.1) then
       ! cas général
       do ixt=1,niso
       xtnu(ixt)=(qsol0*q10*(Rsol0(ixt)-zxtalphal(ixt)*R1(ixt)) &
&           +qevap*(qsol0*Rsol0(ixt)+zxtalphal(ixt)*q10*R1(ixt))) &
&           /(q10+qevap+(qsol0-qevap)*zxtalphal(ixt))
       enddo ! do ixt=1,niso
     endif !if (ordre1.eq.1) then
     
  else !if (qevap.gt.min(L,qsol0)) then
      ! évaporation non totale et plus d'eau que dans couche de
      ! diffusion                                  
     ! cas simple où q10>>qevap
     if (ordre1.eq.1) then
       do ixt=1,niso
        xtnu(ixt)=L*(Rsol0(ixt)-zxtalphal(ixt)*R1(ixt)) &
&          +qevap*zxtalphal(ixt)*R1(ixt)
       enddo ! do ixt=1,niso
      else !if (ordre1.eq.1) then
        ! cas général
        do ixt=1,niso
          xtnu(ixt)=(L*q10*(Rsol0(ixt)-zxtalphal(ixt)*R1(ixt)) &
&           +qevap*(L*Rsol0(ixt)+zxtalphal(ixt)*q10*R1(ixt))) &
&           /(q10+qevap+(L-qevap)*zxtalphal(ixt))
        enddo ! do ixt=1,niso
      endif !if (ordre1.eq.1) then
  endif !if (qevap.gt.min(L,qsol0)) then
  
  
#ifdef ISOVERIF
  do ixt=1,niso
    call iso_verif_noNAN(xtnu(ixt), &
&               'iso_evap_sol_nu 121')
  enddo
        if (iso_eau.gt.0) then
         if (iso_verif_egalite_choix_nostop(xtnu(iso_eau),qevap, &
&                  'sol_nu 110',errmax,errmaxrel).eq.1) then
           write(*,*) 'qevap=',qevap
           write(*,*) 'qsol0=',qsol0
           write(*,*) 'L=',L
           write(*,*) 'Rsol0(iso_eau)=',Rsol0(iso_eau)
           write(*,*) 'R1(iso_eau)=',R1(iso_eau)
           write(*,*) 'q10=',q10
           write(*,*) 'zxtalphal(iso_eau)=',zxtalphal(iso_eau)
           stop
         endif
        endif !if (iso_eau.gt.0) then
        if (iso_HDO.gt.0) then 
          if (qevap.gt.ridicule_evap*1800) then
            if (iso_verif_aberrant_nostop(xtnu(iso_HDO)/qevap, &
&                   'sol_nu 113').eq.1) then
              write(*,*) 'qevap=',qevap 
              write(*,*) 'qsol0=',qsol0
              write(*,*) 'deltaD(R1)=',deltaD(R1((iso_HDO)))
              write(*,*) 'deltaD(alpha*R1)=',deltaD &
&                   (zxtalphal(iso_HDO)*R1((iso_HDO)))
              write(*,*) 'deltaD(Rsol0)=', &
&                   deltaD(Rsol0((iso_HDO)))
              write(*,*) 'L=',L
              write(*,*) 'Pveg=',Pveg
              ! on ne plante que si ca donne lieu à des valeurs
              ! aberrante de deltaD1
              write(*,*) 'deltaD1new=',deltaD((  &
&                   xtnu(iso_HDO)+q10*R1(iso_HDO))  &
&                  /(q10+qevap))
              call iso_verif_aberrant( &
&                   (xtnu(iso_hdo)+q10*R1(iso_hdo)) &
&                   /(qevap+q10), &
&                  'sol_nu 1390')
            endif !if (iso_verif_aberrant_nosto
          endif !if (qevap.gt.ridicule_evap*1800) then
          if (iso_verif_aberrant_choix_nostop(xtnu(iso_HDO), &
&             qevap,ridicule,1e5,'sol_nu 195').eq.1) then
             write(*,*) 'h=',h
             write(*,*) 'qsol0=',qsol0
             write(*,*) 'deltaD(R1)=',deltaD(R1((iso_HDO)))
             write(*,*) 'deltaD(alpha*R1)=',deltaD &
&                   (zxtalphal(iso_HDO)*R1((iso_HDO)))
             write(*,*) 'deltaD(Rsol0)=', &
&                   deltaD(Rsol0((iso_HDO)))
             write(*,*) 'deltaD1new=',deltaD((  &
&                   xtnu(iso_HDO)+q10*R1(iso_HDO))  &
&                  /(q10+qevap))
             
             if (ordre1.eq.1) then
                 ! l'ordre 2 aurait-il amélioré?
               do ixt=1,niso
                  xtnu2(ixt)=(L*q10*(Rsol0(ixt) &
&                    -zxtalphal(ixt)*R1(ixt))+qevap &
&                    *(L*Rsol0(ixt)+zxtalphal(ixt)*q10*R1(ixt))) &
&                    /(q10+qevap+(L-qevap)*zxtalphal(ixt))
               enddo  
               write(*,*) 'si 2e ordre:deltaDevap=', &
&                   deltaD(xtnu2(iso_hdo)/qevap)
               write(*,*) 'si 2e ordre, deltaD1new=',  &
&                   deltaD((  &
&                   xtnu2(iso_HDO)+q10*R1(iso_HDO))  &
&                  /(q10+qevap)) 
             endif
             call iso_verif_aberrant((  &
&                   xtnu(iso_HDO)+q10*R1(iso_HDO))  &
&                  /(q10+qevap),'sol_nu 224')
          endif
        endif  !if (iso_HDO.gt.0) then  
        if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
          if (qevap.gt.ridicule_evap) then
            call iso_verif_aberrant_o17(xtnu(iso_O17) &
&               /qevap,xtnu(iso_O18)/qevap, &
&               'iso_evap_nu 238')
          endif !if (qevap(i).gt.ridicule_evap) then
        endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
#endif


! 3 e cas limite : f=1
else !if (h.gt.0.99) then

if (f.gt.0.95) then
#ifdef ISOVERIF          
!          write(*,*) 'sol_nu 139: f=',f
#endif          
  do ixt=1,niso
    call fractcalk(ixt,T,zxtalphal(ixt),zxtalphai(ixt))
    interm(ixt)=zxtalphal(ixt)*alphak(ixt)*(1-h)          
    betaprime(ixt)=(1.0-interm(ixt))/interm(ixt)  
    gama(ixt)=zxtalphal(ixt)*h/(1.0-interm(ixt))
!            Rsol(ixt)=(Rsol0(ixt)-gama(ixt)*R1(ixt))
!     :           *f**(betaprime(ixt))+gama(ixt)*R1(ixt)
!          Revap(ixt)=(1+betaprime(ixt))*Rsol0(ixt)
!     :           -betaprime(ixt)*gama(ixt)*R1(ixt) ! 1er ordre
!!     :          +(1-f)*(-Rsol0(ixt)*(1+betaprime(ixt))*0.5 ! 2e ordre
!!     :             +betaprime(ixt)*(0.5+gama(ixt)*R1(ixt))) ! 2e ordre 
  ! 2e ordre conserve mal la masse -> ne pas utiliser
   xtnu(ixt)= qevap*((Rsol0(ixt)/zxtalphal(ixt)-h*R1(ixt) ) &
&       /alphak(ixt)/(1-h)) ! =Revap0 <=>1er ordre               
  enddo !do ixt=1,niso

#ifdef ISOVERIF
    do ixt=1,niso
        call iso_verif_noNAN(xtnu(ixt), &
&               'iso_evap_sol_nu 169')
    enddo
    if (iso_eau.gt.0) then
      call iso_verif_egalite_choix(xtnu(iso_eau),qevap, &
&           'sol_nu 151',errmax,errmaxrel)
    endif !if (iso_eau.gt.0) then
    if (iso_HDO.gt.0) then    
        if (qevap.gt.ridicule_evap*1800) then  
          if (iso_verif_aberrant_nostop(xtnu(iso_HDO)/qevap, &
&           'sol_nu 154').eq.1) then
                write(*,*) 'deltaDRsol0=',deltaD(Rsol0(iso_HDO))
                write(*,*) 'deltaDR1=',deltaD(R1(iso_HDO))
                write(*,*) 'deltaD gama*R1=', &
&                   deltaD(gama(iso_HDO)*R1(iso_HDO))
                write(*,*) 'f=',f                        
                write(*,*) 'qevap,L=',qevap,L
                write(*,*) 'betaprime,h=',betaprime(iso_HDO),h
                write(*,*) 'alphak,zxtalphal=', &
&                           alphak(iso_HDO),zxtalphal(iso_HDO)
                ! on ne stppe que si deltaD1new devient
                ! aberrant.
                write(*,*) 'deltaD1new=',deltaD((  &
&                   xtnu(iso_HDO)+q10*R1(iso_HDO))  &
&                  /(q10+qevap))
                call iso_verif_aberrant( &
&                   (xtnu(iso_hdo)+q10*R1(iso_hdo)) &
&                   /(qevap+q10), &
&                  'sol_nu 282')
           endif !if (iso_verif_aberrant_nostop
        endif !if (qevap.gt.ridicule_evap*1800) then
        call iso_verif_aberrant_choix(xtnu(iso_HDO), &
&             qevap,ridicule,1e5,'sol_nu 269')
    endif  !if (iso_HDO.gt.0) then 
   if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
          if (qevap.gt.ridicule_evap) then
            call iso_verif_aberrant_o17(xtnu(iso_O17) &
&               /qevap,xtnu(iso_O18)/qevap, &
&               'iso_evap_nu 307')
          endif !if (qevap(i).gt.ridicule_evap) then
        endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then 
#endif
else !if (f.gt.0.90) then

! 4e cas simple: si h=0
if (h.lt.0.01) then
#ifdef ISOVERIF          
write(*,*) 'sol_nu 165: h=',h
#endif        
do ixt=1,niso
  call fractcalk(ixt,T,zxtalphal(ixt),zxtalphai(ixt))
enddo  
do ixt=1,niso
  betaprime(ixt)=1.0/alphak(ixt)/zxtalphal(ixt)-1.0
  xtnu(ixt)=qevap*Rsol0(ixt)*(1-f**(1+betaprime(ixt)))/(1.0-f)  
enddo !do ixt=1,niso

#ifdef ISOVERIF
  do ixt=1,niso            
    call iso_verif_noNAN(xtnu(ixt), &
&               'iso_evap_sol_nu 206')
  enddo
  if (iso_eau.gt.0) then
     call iso_verif_egalite_choix(xtnu(iso_eau),qevap, &
&           'sol_nu 168',errmax,errmaxrel)
  endif !if (iso_eau.gt.0) then
  if (iso_HDO.gt.0) then   
    if (qevap.gt.ridicule_qsol) then
      call iso_verif_aberrant(xtnu(iso_HDO)/qevap, &
&                   'sol_nu 171')
    endif !if (qevap.gt.ridicule_qsol) then
    call iso_verif_aberrant_choix(xtnu(iso_HDO), &
&             qevap,ridicule,1e5,'sol_nu 302')
  endif  !if (iso_HDO.gt.0) then  
  if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
       if (qevap.gt.ridicule_evap) then
            call iso_verif_aberrant_o17(xtnu(iso_O17) &
&               /qevap,xtnu(iso_O18)/qevap, &
&               'iso_evap_nu 347')
       endif !if (qevap(i).gt.ridicule_evap) then
   endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
#endif

else !if (h.lt.0.01) then     

! cas général
#ifdef ISOVERIF      
!      write(*,*) 'sol_nu 182: cas général'
#endif      
do ixt=1,niso
call fractcalk(ixt,T,zxtalphal(ixt),zxtalphai(ixt))
interm(ixt)=zxtalphal(ixt)*alphak(ixt)*(1.0-h)
betaprime(ixt)=((1.0-interm(ixt))/interm(ixt))      
gama(ixt)=zxtalphal(ixt)*h/(1.0-interm(ixt))
xtnu(ixt)=qevap*(Rsol0(ixt)*(1.0-f**(1.0+betaprime(ixt))) &
&           -f*gama(ixt)*R1(ixt)*(1.0-f**betaprime(ixt)))/(1.0-f)
enddo !do ixt=1,niso

#ifdef ISOVERIF
do ixt=1,niso
!         write(*,*) 'qevap,Rsol0(ixt),f,betaprime(ixt)=',
!     :         qevap,Rsol0(ixt),f,betaprime(ixt)  
 call iso_verif_noNAN(xtnu(ixt), &
&               'iso_evap_sol_nu 234')
enddo
if (iso_eau.gt.0) then
  call iso_verif_egalite_choix(xtnu(iso_eau),qevap,   &    
&           'sol_nu 185',errmax,errmaxrel)
endif !if (iso_eau.gt.0) then
if (iso_HDO.gt.0) then  
   if (qevap.gt.ridicule_evap*1800) then
     if (iso_verif_aberrant_nostop(xtnu(iso_HDO)/qevap, &
&           'sol_nu 189').eq.1) then
       write(*,*) 'deltaDRsol0=',deltaD(Rsol0(iso_HDO))
       write(*,*) 'deltaDR1=',deltaD(R1(iso_HDO))
       write(*,*) 'deltaD gama*R1=', &
&                   deltaD(gama(iso_HDO)*R1(iso_HDO))
       write(*,*) 'f=',f
       write(*,*) 'betaprime=',betaprime(iso_HDO)
       ! on ne stppe que si deltaD1new devient
       ! aberrant.
       write(*,*) 'deltaD1new=',deltaD((  &
&                   xtnu(iso_HDO)+q10*R1(iso_HDO))  &
&                  /(q10+qevap))
       call iso_verif_aberrant( &
&                   (xtnu(iso_hdo)+q10*R1(iso_hdo)) &
&                   /(qevap+q10), &
&                  'sol_nu 321')
     endif !if (iso_verif_aberrant_nostop
   endif !if (qevap.gt.ridicule_evap*1800) then
   call iso_verif_aberrant_choix(xtnu(iso_HDO), &
&             qevap,ridicule,1e5,'sol_nu 354')
   if (qsol0-qevap.gt.ridicule_qsol*1e2) then
     if (iso_verif_aberrant_nostop((qsol0*Rsol0(iso_HDO) &
&           -xtnu(iso_HDO))/(qsol0-qevap)/faccond, &
&         'evap_sol_nu, reste sol aberrant 375').eq.1) then
       write(*,*) 'qsol0=',qsol0
       write(*,*) 'deltaDRsol0=',deltaD(Rsol0(iso_HDO))
       write(*,*) 'deltaD gama*R1=', &
&                   deltaD(gama(iso_HDO)*R1(iso_HDO))
       write(*,*) 'deltaDevap=',deltaD(xtnu(iso_HDO)/qevap)
       write(*,*) 'f,h=',f,h
       stop
     endif
   endif
 endif  !if (iso_HDO.gt.0) then  
 if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
     if (qevap.gt.ridicule_evap) then
       call iso_verif_aberrant_o17(xtnu(iso_O17) &
&               /qevap,xtnu(iso_O18)/qevap, &
&               'iso_evap_nu 419')
     endif !if (qevap(i).gt.ridicule_evap) then
  endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
#endif
endif !if (h.lt.0.01) then
endif ! if f>0.9
endif ! if h>0.99
endif !if (f.lt.ridicule) then

#ifdef ISOVERIF
do ixt=1,niso
 call iso_verif_noNAN(xtnu(ixt), &
&               'iso_evap_sol_nu 194')
enddo
!       write(*,*) 'sol_nu tmp 252: xtnu(iso_eau),qevap=',
!     :           xtnu(iso_eau),qevap
if (iso_eau.gt.0) then
  call iso_verif_egalite_choix(xtnu(iso_eau),qevap,   &    
&           'sol_nu 244',errmax,errmaxrel)
endif !if (iso_eau.gt.0) then 
if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
  if (qevap.gt.ridicule_evap) then
     call iso_verif_aberrant_o17(xtnu(iso_O17) &
&           /qevap,xtnu(iso_O18)/qevap, &
&           'iso_evap_nu 443')
  endif !if (qevap(i).gt.ridicule_evap) then
endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
#endif       

end subroutine iso_evap_sol_nu

! subroutines traitant l'évaporation en surface

subroutine calcul_kcin(Vsurf,KCIN)
USE isotopes_mod, ONLY: tv0cin,tkcin0,tkcin1,tkcin2
implicit none
! calcul de kcin en fonction de Vsurf

! input:
real Vsurf ! vent de surface
! output:
real kcin(niso) ! coef cin
! locals      
integer ixt ! numéro d'isotope


IF ( VSURF .LT. tv0cin ) THEN
  do ixt=1,niso
      KCIN(IXT) = tkcin0(IXT)
  enddo    
ELSE
  do ixt=1,niso
      KCIN(IXT) = tkcin1(IXT)*VSURF + tkcin2(IXT)
  enddo    
ENDIF

end subroutine calcul_kcin


     subroutine fractcalk(kt, ptin, pxtfra, pfraice)
USE isotopes_mod, ONLY: talph1,talph2,talph3,pxtmin,iso_O17, &
&       fac_coeff_eq17_liq, pxtmelt, &
&       musi, lambda_sursat,tdifrel,talps1,talps2,fac_coeff_eq17_ice,pxtice, &
&       iso_eau,iso_O18,iso_HDO,iso_O17,iso_HTO
#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel
USE isotopes_verif_mod
#endif
      implicit none

!C-------------------------------------------------------------------------
!C Calculation of the fractionation coefficient of water isotopes.
!C
!C March 2003
!C Sandrine Bony (LMD/CNRS), after MPI code from Georg Hoffmann (LSCE)
!C-------------------------------------------------------------------------

!c -- inputs:
      integer kt    ! tracor number
      real ptin       ! temperature (K)

!c -- outputs:
      real pxtfra   ! fractionation factor for vapor/liquid condensation
      real pfraice  ! fractionation factor for vapor/ice condensation

!c -- local variables:
      real ZCELS, ZSATVAL
      parameter (ZCELS=273.15)
      real pt ! la température max(ptin,pxtmin)

!      integer iso_verif_noNAN_nostop ! pour debugage


!c-----------------------------------------------------------
!C FRACTIONATION OVER WATER:
!c-----------------------------------------------------------

       pt=max(ptin,pxtmin)

       if ((iso_O17.gt.0).and.(kt.eq.iso_O17)) then
         pxtfra=(EXP(talph1(kt)/(pt**2)+talph2(kt)/pt+talph3(kt))) &
     &           **fac_coeff_eq17_liq
       else
           pxtfra=EXP(talph1(kt)/(pt**2)+talph2(kt)/pt+talph3(kt))
       endif

#ifdef ISOVERIF
       if (pt.gt.pxtice) then
           if (iso_verif_noNAN_nostop(pxtfra,'iso_fractcal 33') &
     &            .eq.1) then
!             write(*,*) 'kt,pt=',kt,pt
!             write(*,*) 'talph1(kt),talph2(kt),talph3(kt)=',
!     :           talph1(kt),talph2(kt),talph3(kt)
           endif
       endif !if (pt.gt.pxtice) then
#endif       
       pxtfra=max(min(pxtfra,100.0),0.0)

!c-----------------------------------------------------------
!C FRACTIONATION OVER ICE
!c-----------------------------------------------------------

       if ((iso_HTO.gt.0).and.(kt.eq.iso_HTO)) then
          pfraice=EXP(talps1(kt)/(pt**2)+talps2(kt)/pt)

       elseif ((iso_HDO.gt.0).and.(kt.eq.iso_HDO)) then
          pfraice=EXP(talps1(kt)/(pt**2)+talps2(kt))

       elseif ((iso_O18.gt.0).and.(kt.eq.iso_O18)) then
          pfraice=EXP(talps1(kt)/pt+talps2(kt))

       elseif ((iso_O17.gt.0).and.(kt.eq.iso_O17)) then
          pfraice=(EXP(talps1(kt)/pt+talps2(kt))) &
     &           **fac_coeff_eq17_ice

       elseif ((iso_eau.gt.0).and.(kt.eq.iso_eau)) then
          pfraice=1.
       else
           write(*,*) 'iso_fractcal 1404: non prévu: kt=',kt
#ifdef ISOVERIF
           stop
#endif
       endif

#ifdef ISOVERIF       
       if (pt.lt.pxtmelt) then
           if (iso_verif_noNAN_nostop(pfraice,'iso_fractcal 55') &
     &           .eq.1) then
!              write(*,*) 'kt,pt=',kt,pt
!              write(*,*) 'talps1(kt),talps2(kt)=',
!     &                   talps1(kt),talps2(kt)
           endif
       endif !if (pt.lt.pxtmelt) then
#endif       
       pfraice=max(min(pfraice,100.0),0.0)

!c-----------------------------------------------------------
!C EFFECTIVE FRACTIONATION OVER ICE if NECESSARY
!c-----------------------------------------------------------

       if ((iso_eau.gt.0).and.(kt.eq.iso_eau)) then
         pfraice=1.
       else  !if ((iso_eau.gt.0).and.(kt.eq.iso_eau)) then
         if (pt.lt.pxtmelt) then
           ZSATVAL=musi-lambda_sursat*(pt-ZCELS)
           pfraice=pfraice*(ZSATVAL/(1.+pfraice*(ZSATVAL-1.) &
     &          *tdifrel(kt)))
         endif !if (pt.lt.pxtmelt) then
       endif !if ((kt.ne.iso_eau).or.(iso_eau.gt.0.ne.1)) then

#ifdef ISOVERIF
         if (iso_verif_noNAN_nostop(pfraice,'iso_fractcal 73')  &
     &           .eq.1) then 
!            write(*,*) 'kt,pt=',kt,pt
!            write(*,*) 'ZSATVAL,tdifrel(kt)=',ZSATVAL,tdifrel(kt)
         endif
         if ((iso_eau.gt.0).and.(kt.eq.iso_eau)) then  
             call iso_verif_egalite(pfraice,1.0,'iso_fractcal 63')
             call iso_verif_egalite(pxtfra,1.0,'iso_fractcal 67')
         endif !if ((iso_eau.gt.0).and.(kt.eq.iso_eau)) then  
#endif
       pfraice=max(min(pfraice,100.0),0.0)

      end subroutine fractcalk


      subroutine fractcalk_liq(kt, ptin, pxtfra)

      USE isotopes_mod, ONLY: pxtmin,talph1,talph2,talph3, &
&       fac_coeff_eq17_liq, pxtice, &
&       iso_eau,iso_O18,iso_HDO,iso_O17,iso_HTO
#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel
USE isotopes_verif_mod
#endif
      implicit none

!C-------------------------------------------------------------------------
!C Calculation of the fractionation coefficient of water isotopes.
!C
!C March 2003
!C Sandrine Bony (LMD/CNRS), after MPI code from Georg Hoffmann (LSCE)
!C-------------------------------------------------------------------------

!c -- inputs:
      integer kt    ! tracor number
      real ptin       ! temperature (K)

!c -- outputs:
      real pxtfra   ! fractionation factor for vapor/liquid condensation

      real pt ! la température max(ptin,pxtmin)

!      integer iso_verif_noNAN_nostop ! pour debugage
      real alpha_max
      parameter (alpha_max=10.0)


!c-----------------------------------------------------------
!C FRACTIONATION OVER WATER:
!c-----------------------------------------------------------

       pt=max(ptin,pxtmin)

       if ((iso_O17.gt.0).and.(kt.eq.iso_O17)) then
         pxtfra=(EXP(talph1(kt)/(pt**2)+talph2(kt)/pt+talph3(kt))) &
     &           **fac_coeff_eq17_liq
       else
           pxtfra=EXP(talph1(kt)/(pt**2)+talph2(kt)/pt+talph3(kt))
       endif

#ifdef ISOVERIF
       if (pt.gt.pxtice) then
           if (iso_verif_noNAN_nostop(pxtfra,'iso_fractcal 33') &
     &            .eq.1) then
!             write(*,*) 'kt,pt=',kt,pt
!             write(*,*) 'talph1(kt),talph2(kt),talph3(kt)=',
!     &           talph1(kt),talph2(kt),talph3(kt)
           endif
       endif !if (pt.gt.pxtice) then
       if ((iso_eau.gt.0).and.(kt.eq.iso_eau)) then
           call iso_verif_egalite(pxtfra,1.0,'iso_fractcal_phase 51')
       endif
#endif       
       pxtfra=max(min(pxtfra,alpha_max),0.0)

      end subroutine fractcalk_liq


      subroutine fractcalk_glace(kt, ptin, pfraice)

      use isotopes_mod, ONLY: talps1,talps2, iso_O17,fac_coeff_eq17_ice, &
        & pxtmelt,musi, lambda_sursat, tdifrel, &
        & iso_eau,iso_O18,iso_HDO,iso_O17,iso_HTO
#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel
USE isotopes_verif_mod
#endif
      implicit none

!C-------------------------------------------------------------------------
!C Calculation of the fractionation coefficient of water isotopes.
!C
!C March 2003
!C Sandrine Bony (LMD/CNRS), after MPI code from Georg Hoffmann (LSCE)
!C-------------------------------------------------------------------------

!c -- inputs:
      integer kt    ! tracor number
      real ptin       ! temperature (K)

!c -- outputs:
      real pfraice  ! fractionation factor for vapor/ice condensation

!c -- local variables:
      real ZCELS, ZSATVAL
      parameter (ZCELS=273.15)
      real Tmin ! valeur minimum de la température en K. Si elle est de
        ! l'ordre de quelques K seulement, les coeffs de fractionnement
        ! deviennent démesurément grands, et en plus ça fait planter l'execution à
        ! l'idris.
      parameter (Tmin=100.0)
      real pt ! la température max(ptin,Tmin)

!      integer iso_verif_noNAN_nostop ! pour debugage
      real alpha_max
      parameter (alpha_max=10.0)

       pt=max(ptin,Tmin)

!c-----------------------------------------------------------
!C FRACTIONATION OVER ICE
!c-----------------------------------------------------------

       if ((iso_HTO.gt.0).and.(kt.eq.iso_HTO)) then
          pfraice=EXP(talps1(kt)/(pt**2)+talps2(kt)/pt)

       elseif ((iso_HDO.gt.0).and.(kt.eq.iso_HDO)) then
          pfraice=EXP(talps1(kt)/(pt**2)+talps2(kt))

       elseif ((iso_O18.gt.0).and.(kt.eq.iso_O18)) then
          pfraice=EXP(talps1(kt)/pt+talps2(kt))
       elseif ((iso_O17.gt.0).and.(kt.eq.iso_O17)) then
          pfraice=(EXP(talps1(kt)/pt+talps2(kt)))**fac_coeff_eq17_ice
       elseif ((iso_eau.gt.0).and.(kt.eq.iso_eau)) then
          pfraice=1.
       else
           write(*,*) 'iso_fractcal 1676: non prévu: kt=',kt
#ifdef ISOVERIF
           stop
#endif
       endif

#ifdef ISOVERIF       
       if (pt.lt.pxtmelt) then
           if (iso_verif_noNAN_nostop(pfraice,'iso_fractcal 55') &
     &           .eq.1) then
!              write(*,*) 'kt,pt=',kt,pt
!              write(*,*) 'talps1(kt),talps2(kt)=',
!     :                   talps1(kt),talps2(kt)
           endif
       endif !if (pt.lt.pxtmelt) then
#endif       
       pfraice=max(min(pfraice,alpha_max),0.0)
!       write(*,*) 'fractcalk tmp 130: kt,pfraice,fac_coeff_eq17_ice=',
!     :            kt,pfraice,fac_coeff_eq17_ice

!c-----------------------------------------------------------
!C EFFECTIVE FRACTIONATION OVER ICE if NECESSARY
!c-----------------------------------------------------------

       if ((iso_eau.gt.0).and.(kt.eq.iso_eau)) then
         pfraice=1.
       else  !if ((iso_eau.gt.0).and.(kt.eq.iso_eau)) then
         if (pt.lt.pxtmelt) then
           ZSATVAL=musi-lambda_sursat*(pt-ZCELS)
           pfraice=pfraice*(ZSATVAL/(1.+pfraice*(ZSATVAL-1.) &
     &          *tdifrel(kt)))
         endif !if (pt.lt.pxtmelt) then
       endif !if ((kt.ne.iso_eau).or.(iso_eau.gt.0.ne.1)) then

#ifdef ISOVERIF
         if (iso_verif_noNAN_nostop(pfraice,'iso_fractcal 73')  &
     &           .eq.1) then 
!            write(*,*) 'kt,pt=',kt,pt
!            write(*,*) 'ZSATVAL,tdifrel(kt)=',ZSATVAL,tdifrel(kt)
         endif
         if ((iso_eau.gt.0).and.(kt.eq.iso_eau)) then  
             call iso_verif_egalite(pfraice,1.0,'iso_fractcal 63')
         endif !if ((iso_eau.gt.0).and.(kt.eq.iso_eau)) then  
#endif
       pfraice=max(min(pfraice,alpha_max),0.0)
!       write(*,*) 'fractcalk tmp 130: kt,pfraice=',kt,pfraice

      end subroutine fractcalk_glace


      subroutine fractcalk_vectall(ptin, pxtfra, pfraice,n)

        USE isotopes_mod, ONLY: talph1,talph2,talph3,tdifrel,pxtmin, &
&      iso_O17, iso_HTO, iso_eau, iso_O18, iso_HDO, musi, lambda_sursat, &
&      fac_coeff_eq17_liq,fac_coeff_eq17_ice,talps1,talps2,pxtmelt,pxtice
#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel
USE isotopes_verif_mod
#endif
      implicit none

!C-------------------------------------------------------------------------
!C Calculation of the fractionation coefficient of water isotopes.
!C
!C March 2003
!C Sandrine Bony (LMD/CNRS), after MPI code from Georg Hoffmann (LSCE)
!C-------------------------------------------------------------------------
      ! camille risi: vectorisation sur les points de grilles

!c -- inputs:
      integer n ! nombre de mailles à traiter
      real ptin(n)       ! temperature (K)

!c -- outputs:
      real pxtfra(niso,n)   ! fractionation factor for vapor/liquid condensation
      real pfraice(niso,n)  ! fractionation factor for vapor/ice condensation

!c -- local variables:
      real ZCELS, ZSATVAL(n)
      parameter (ZCELS=273.15)
      real pt(n) ! la température max(ptin,pxtmin)
      integer i ! compteur: indice des mailles
      integer ixt ! compteur: indice de l'isotope

!#ifdef ISOVERIF
!      integer iso_verif_noNAN_nostop ! pour debugage
!#endif      

      real alpha_max
      parameter (alpha_max=10.0)


!c-----------------------------------------------------------
!C FRACTIONATION OVER WATER:
!c-----------------------------------------------------------

      do i=1,n
       pt(i)=max(ptin(i),pxtmin)
      enddo

      do ixt=1,niso ! *******************************

       if ((iso_O17.gt.0).and.(ixt.eq.iso_O17)) then
         do i=1,n
         pxtfra(ixt,i)=(EXP(talph1(ixt)/(pt(i)**2) &
     &           +talph2(ixt)/pt(i)+talph3(ixt))) &
     &           **fac_coeff_eq17_liq
         enddo
       else
         do i=1,n
           pxtfra(ixt,i)=EXP(talph1(ixt)/(pt(i)**2) &
     &           +talph2(ixt)/pt(i)+talph3(ixt))
         enddo
       endif

#ifdef ISOVERIF
       do i=1,n
        if (pt(i).gt.pxtice) then
           if (iso_verif_noNAN_nostop(pxtfra(ixt,i), &
     &           'iso_fractcal 33').eq.1) then
           endif
        endif !if (pt(i).gt.pxtice) then
       enddo
#endif     
      do i=1,n  
       pxtfra(ixt,i)=max(min( &
     &           pxtfra(ixt,i),alpha_max),0.0)
      enddo !do i=1,n

!c-----------------------------------------------------------
!C FRACTIONATION OVER ICE
!c-----------------------------------------------------------

       if ((iso_HTO.gt.0).and.(ixt.eq.iso_HTO)) then
         do i=1,n 
          pfraice(ixt,i)=EXP(talps1(ixt)/(pt(i)**2) &
     &            +talps2(ixt)/pt(i))
         enddo !do i=1,n       
       elseif ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) then
         do i=1,n
          pfraice(ixt,i)=EXP(talps1(ixt)/(pt(i)**2) &
     &           +talps2(ixt))
         enddo !do i=1,n       
       elseif ((iso_O18.gt.0).and.(ixt.eq.iso_O18)) then
         do i=1,n
          pfraice(ixt,i)=EXP(talps1(ixt)/pt(i)+talps2(ixt))
         enddo !do i=1,n 
       elseif ((iso_O17.gt.0).and.(ixt.eq.iso_O17)) then
         do i=1,n
          pfraice(ixt,i)=(EXP(talps1(ixt)/pt(i) &
     &           +talps2(ixt)))**fac_coeff_eq17_ice
         enddo !do i=1,n 
       elseif ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
         do i=1,n
          pfraice(ixt,i)=1.
         enddo !do i=1,n 
       else
           write(*,*) 'iso_fractcal 1734: non prévu: ixt=',ixt
!#ifdef ISOVERIF
           CALL abort_physic('isotopes_routines_mod', 'iso_fractcal 1734', 1)
!#endif
       endif

#ifdef ISOVERIF  
       do i=1,n     
         if (pt(i).lt.pxtmelt) then
           if (iso_verif_noNAN_nostop(pfraice(ixt,i), &
     &           'iso_fractcal 55').eq.1) then
           endif
         endif !if (pt(i).lt.pxtmelt) then
       enddo !do i=1,n
#endif   
      do i=1,n    
       pfraice(ixt,i)=max(min( &
     &            pfraice(ixt,i),alpha_max),0.0)
      enddo

!c-----------------------------------------------------------
!C EFFECTIVE FRACTIONATION OVER ICE if NECESSARY
!c-----------------------------------------------------------

       if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
       else  !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
         do i=1,n   
          if (pt(i).lt.pxtmelt) then
           ZSATVAL(i)=musi-lambda_sursat*(pt(i)-ZCELS)
           pfraice(ixt,i)=pfraice(ixt,i) &
     &        *(ZSATVAL(i)/(1.+pfraice(ixt,i)*(ZSATVAL(i)-1.) &
     &        *tdifrel(ixt)))
          endif !if (pt(i).lt.pxtmelt) then
         enddo ! do i=1,n 
       endif !if ((ixt.ne.iso_eau).or.(iso_eau.gt.0.ne.1)) then

#ifdef ISOVERIF
       do i=1,n
         if (iso_verif_noNAN_nostop(pfraice(ixt,i), &
     &          'iso_fractcal 73').eq.1) then 
!            write(*,*) 'ixt,pt(i)=',ixt,pt(i)
!            write(*,*) 'ZSATVAL,tdifrel(ixt)=',ZSATVAL,tdifrel(ixt)
         endif
       enddo
         if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then  
            do i=1,n 
             call iso_verif_egalite(pfraice(ixt,i),1.0, &
     &                  'iso_fractcal 63')
             call iso_verif_egalite(pxtfra(ixt,i),1.0, &
     &           'iso_fractcal 67')
            enddo ! do i=1,n 
         endif !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then  
#endif
       do i=1,n
         pfraice(ixt,i)=max(min( &
     &           pfraice(ixt,i),alpha_max),0.0)
       enddo

       enddo ! do ixt=1,niso ****************************

      end subroutine fractcalk_vectall

! séparation entre la subroutine pour solide et celle pour liquide.

      subroutine fractcalk_vectall_liq(ptin, pxtfra, n)

      USE isotopes_mod, ONLY: pxtmin,talph1,talph2,talph3, &
&       iso_eau,iso_HDO, iso_O18, iso_O17,iso_HTO,fac_coeff_eq17_liq, &
&       pxtice
#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel
USE isotopes_verif_mod
#endif
      implicit none

!C-------------------------------------------------------------------------
!C Calculation of the fractionation coefficient of water isotopes.
!C
!C March 2003
!C Sandrine Bony (LMD/CNRS), after MPI code from Georg Hoffmann (LSCE)
!C-------------------------------------------------------------------------
      ! camille risi: vectorisation sur les points de grilles

!c -- inputs:
      integer n ! nombre de mailles à traiter
      real ptin(n)       ! temperature (K)

!c -- outputs:
      real pxtfra(niso,n)   ! fractionation factor for vapor/liquid condensation

      real pt(n) ! la température max(ptin,pxtmin)
      integer i ! compteur: indice des mailles
      integer ixt ! compteur: indice de l'isotope

!      integer iso_verif_noNAN_nostop ! pour debugage
      real alpha_max
      parameter (alpha_max=10.0)

!c-----------------------------------------------------------
!C FRACTIONATION OVER WATER:
!c-----------------------------------------------------------

      do i=1,n
       pt(i)=max(ptin(i),pxtmin)
      enddo

      do ixt=1,niso ! *******************************

       if ((iso_O17.gt.0).and.(ixt.eq.iso_O17)) then
         do i=1,n
         pxtfra(ixt,i)=(EXP(talph1(ixt)/(pt(i)**2) &
     &           +talph2(ixt)/pt(i)+talph3(ixt))) &
     &           **fac_coeff_eq17_liq
         enddo
       else
         do i=1,n
           pxtfra(ixt,i)=EXP(talph1(ixt)/(pt(i)**2) &
     &           +talph2(ixt)/pt(i)+talph3(ixt))
         enddo
       endif

#ifdef ISOVERIF
       do i=1,n
        if (pt(i).gt.pxtice) then
           if (iso_verif_noNAN_nostop(pxtfra(ixt,i), &
     &           'iso_fractcal 33').eq.1) then
           endif
        endif !if (pt(i).gt.pxtice) then
       enddo
#endif     
      do i=1,n  
       pxtfra(ixt,i)=max(min( &
     &           pxtfra(ixt,i),alpha_max),0.0)
      enddo !do i=1,n


       enddo ! do ixt=1,niso ****************************

      end subroutine fractcalk_vectall_liq

      !*****************************

      subroutine fractcalk_vectall_ice(ptin, pfraice,n)

      use isotopes_mod, ONLY: talps1,talps2, fac_coeff_eq17_ice, &
        & pxtmelt,musi, lambda_sursat, tdifrel, &
        & iso_eau, iso_HDO, iso_O18, iso_HTO, iso_O17
#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel
USE isotopes_verif_mod
#endif
      implicit none

!C-------------------------------------------------------------------------
!C Calculation of the fractionation coefficient of water isotopes.
!C
!C March 2003
!C Sandrine Bony (LMD/CNRS), after MPI code from Georg Hoffmann (LSCE)
!C-------------------------------------------------------------------------
      ! camille risi: vectorisation sur les points de grilles

!c -- inputs:
      integer n ! nombre de mailles à traiter
      real ptin(n)       ! temperature (K)

!c -- outputs:
      real pfraice(niso,n)  ! fractionation factor for vapor/ice condensation

!c -- local variables:
      real ZCELS, ZSATVAL(n)
      parameter (ZCELS=273.15)
      real Tmin ! valeur minimum de la température en K. Si elle est de
        ! l'ordre de quelques K seulement, les coeffs de fractionnement
        ! deviennent démesurément grands, et en plus ça fait planter l'execution à
        ! l'idris.
      parameter (Tmin=100.0)
      real pt(n) ! la température max(ptin,Tmin)
      integer i ! compteur: indice des mailles
      integer ixt ! compteur: indice de l'isotope

!      integer iso_verif_noNAN_nostop ! pour debugage
      real alpha_max
      parameter (alpha_max=10.0)

      do i=1,n
       pt(i)=max(ptin(i),Tmin)
      enddo

        do ixt=1,niso ! ****************

!c-----------------------------------------------------------
!C FRACTIONATION OVER ICE
!c-----------------------------------------------------------

       if ((iso_HTO.gt.0).and.(ixt.eq.iso_HTO)) then
         do i=1,n 
          pfraice(ixt,i)=EXP(talps1(ixt)/(pt(i)**2) &
     &            +talps2(ixt)/pt(i))
         enddo !do i=1,n       
       elseif ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) then
         do i=1,n
          pfraice(ixt,i)=EXP(talps1(ixt)/(pt(i)**2) &
     &           +talps2(ixt))
         enddo !do i=1,n       
       elseif ((iso_O18.gt.0).and.(ixt.eq.iso_O18)) then
         do i=1,n
          pfraice(ixt,i)=EXP(talps1(ixt)/pt(i)+talps2(ixt))
         enddo !do i=1,n 
       elseif ((iso_O17.gt.0).and.(ixt.eq.iso_O17)) then
         do i=1,n
          pfraice(ixt,i)=(EXP(talps1(ixt)/pt(i)+talps2(ixt))) &
     &           **fac_coeff_eq17_ice
         enddo !do i=1,n 
       elseif ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
         do i=1,n
          pfraice(ixt,i)=1.
         enddo !do i=1,n 
       else
           write(*,*) 'iso_fractcal 1954: non prévu: ixt=',ixt
!#ifdef ISOVERIF
          CALL abort_physic('isotopes_routines_mod', 'iso_fractcal 1954', 1)
!#endif
       endif

#ifdef ISOVERIF  
       do i=1,n     
         if (pt(i).lt.pxtmelt) then
           if (iso_verif_noNAN_nostop(pfraice(ixt,i), &
     &           'iso_fractcal 55').eq.1) then
           endif
         endif !if (pt(i).lt.pxtmelt) then
       enddo !do i=1,n
#endif   
      do i=1,n    
       pfraice(ixt,i)=max(min( &
     &            pfraice(ixt,i),alpha_max),0.0)
      enddo

!c-----------------------------------------------------------
!C EFFECTIVE FRACTIONATION OVER ICE if NECESSARY
!c-----------------------------------------------------------

       if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
       else  !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
         do i=1,n   
          if (pt(i).lt.pxtmelt) then
           ZSATVAL(i)=musi-lambda_sursat*(pt(i)-ZCELS)
           pfraice(ixt,i)=pfraice(ixt,i) &
     &        *(ZSATVAL(i)/(1.+pfraice(ixt,i)*(ZSATVAL(i)-1.) &
     &        *tdifrel(ixt)))
          endif !if (pt(i).lt.pxtmelt) then
         enddo ! do i=1,n 
       endif !if ((ixt.ne.iso_eau).or.(iso_eau.gt.0.ne.1)) then

#ifdef ISOVERIF
       do i=1,n
         if (iso_verif_noNAN_nostop(pfraice(ixt,i), &
     &          'iso_fractcal 73').eq.1) then 
!            write(*,*) 'ixt,pt(i)=',ixt,pt(i)
!            write(*,*) 'ZSATVAL,tdifrel(ixt)=',ZSATVAL,tdifrel(ixt)
         endif
       enddo
         if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then  
            do i=1,n 
             call iso_verif_egalite(pfraice(ixt,i),1.0, &
     &                  'iso_fractcal 63')
            enddo ! do i=1,n 
         endif !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then  
#endif
       do i=1,n
         pfraice(ixt,i)=max(min( &
     &           pfraice(ixt,i),alpha_max),0.0)
       enddo

       enddo ! do ixt=1,niso ****************************

      end subroutine fractcalk_vectall_ice




subroutine calcul_Rsol(qsol,evap,xtsol,xt1lay,q1lay,t1lay, &
&            i,Rsol,klon)

  USE isotopes_mod, ONLY: iso_eau, iso_HDO,ridicule, &
&        ridicule_qsol,iso_O17,iso_O18
#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel,faccond
USE isotopes_verif_mod
#endif
implicit none

! calcul de Rsol

! inputs
integer klon
integer i
real qsol(klon)
real evap(klon)
real xtsol(niso,klon)
real xt1lay(ntraciso,klon)
real q1lay(klon)
real t1lay(klon)
! outputs
real Rsol(niso)
! locals
integer ixt
real zxtalphal(niso),zxtalphai(niso)
!#ifdef ISOVERIF      
!integer iso_verif_egalite_choix_nostop
!real 
!#endif      


! verif
#ifdef ISOVERIF
if (iso_eau.gt.0) then      
  call iso_verif_egalite_choix((qsol(i)), &
&           (xtsol(iso_eau,i)), &
&           'iso_surf>calcul_Rsol 303',errmax,errmaxrel)
  call iso_verif_egalite_choix(q1lay(i),xt1lay(iso_eau,i), &
&           'iso_surf>calcul_Rsol 387',errmax,errmaxrel)
!      write(*,*) 'qsol(i)=',qsol(i)
!      write(*,*) 'xtsol(4,i)=',xtsol(4,i)
endif !if (iso_eau.gt.0) then
if (iso_HDO.gt.0) then
  if (qsol(i).gt.ridicule_qsol*1e2) then
     call iso_verif_aberrant(( &
&           xtsol(iso_HDO,i)/qsol(i))/faccond, &
&           'iso_surf>calcul_Rsol 301')
 endif ! if (qsol(i).gt.ridicule_qsol) then
endif  !if (iso_HDO.gt.0) then 
if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
    if (qsol(i).gt.ridicule_qsol) then
      call iso_verif_aberrant_o17( &
&           (xtsol(iso_O17,i) &
&           /qsol(i)),(xtsol(iso_O18,i) &
&           /qsol(i)),'iso_surf 401')
    endif !if ((qsol(i).gt.ridicule).and.(xtsol(iso_O18,i)
endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then 
#endif
! end verif 

if (qsol(i).gt.ridicule_qsol) then
do ixt=1,niso
    Rsol(ixt)=xtsol(ixt,i)/qsol(i)             
enddo !do ixt=1,niso

! verif
#ifdef ISOVERIF
  do ixt=1,niso  
    call iso_verif_noNAN(Rsol(ixt),'iso_surf>calcul_Rsol 3191')
  enddo !do ixt=1,niso
  if (iso_eau.gt.0) then
   if (iso_verif_egalite_choix_nostop(Rsol(iso_eau),1.0, &
&           'iso_surf>calcul_Rsol 312',errmax,errmaxrel*10) &
&           .eq.1) then
      write(*,*) 'xtsol(ixt,i),qsol(i),ridicule_qsol=', &
&           xtsol(ixt,i),qsol(i),ridicule_qsol
      stop
   endif !if (iso_verif_egalite_choix_nostop(Rsol(iso_eau),1.0,   
  endif !if (iso_eau.gt.0) then
  if (iso_HDO.gt.0) then   
    if (qsol(i).gt.ridicule_qsol*1e2) then
      call iso_verif_aberrant(Rsol(iso_HDO)/faccond, &
&                  'iso_surf>calcul_Rsol 3201')
    endif !if (qsol(i).gt.ridicule_qsol) then
  endif  !if (iso_HDO.gt.0) then 
 if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
    if (qsol(i).gt.ridicule_qsol) then
      call iso_verif_aberrant_o17(Rsol(iso_O17), &
&           Rsol(iso_O18),'iso_surf 437')
    endif !if ((qsol(i).gt.ridicule).and.(xtsol(iso_O18,i)
 endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then 
#endif
! end verif 

else !if (qsol(i).gt.ridicule_rain) then
#ifdef ISOVERIF
 if (evap(i)*1800.0.gt.qsol(i)) then  
 write(*,*) 'iso_surf>calcul_Rsol 2989'
 write(*,*) 'qsol(i)=',qsol(i),' mais evap(i)=',evap(i)
 endif
#endif         
 if (q1lay(i).gt.ridicule) then
       ! on suppose que
       ! deltaDsol=deltaDprecip~deltaDcond(INB)~deltaDNK
     do ixt=1,niso
      call fractcalk(ixt,t1lay(i),zxtalphal(ixt),zxtalphai(ixt))
     enddo
     if (t1lay(i).ge.0.0) then   
         do ixt=1,niso              
            Rsol(ixt)=zxtalphal(ixt)*xt1lay(ixt,i)/q1lay(i) 
         enddo !do ixt=1,niso

         ! verif
#ifdef ISOVERIF
           do ixt=1,niso        
                call iso_verif_noNAN(Rsol(ixt), &
&                   'iso_surf>calcul_Rsol 3202')
           enddo !do ixt=1,niso
           if (iso_eau.gt.0) then 
             call iso_verif_egalite_choix(Rsol(iso_eau),1.0, &
&                  'iso_surf>calcul_Rsol 467',errmax,errmaxrel)
           endif !if (iso_eau.gt.0) then
           if (iso_HDO.gt.0) then    
              if (qsol(i).gt.ridicule_qsol) then
                 call iso_verif_aberrant(Rsol(iso_HDO)/faccond, &
&                   'iso_surf>calcul_Rsol 338')
               endif !if (qsol(i).gt.ridicule_qsol) then
           endif  !if (iso_HDO.gt.0) then 
           if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
             if (qsol(i).gt.ridicule_qsol) then
               call iso_verif_aberrant_o17(Rsol(iso_O17) &
&                   ,Rsol(iso_O18),'iso_surf 480')
             endif !if ((qsol(i).gt.ridicule).and.(xtsol(iso_O18,i)
           endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then  
#endif
          ! end verif
          !
     else !if (t1lay(i).ge.0.0) then   
          do ixt=1,niso
            Rsol(ixt)=zxtalphai(ixt)*xt1lay(ixt,i)/q1lay(i)  
          enddo !do ixt=1,niso

          ! verif
#ifdef ISOVERIF
            do ixt=1,niso  
                call iso_verif_noNAN(Rsol(ixt), &
&                   'iso_surf>calcul_Rsol 3207')
            enddo !do ixt=1,niso    
            if (iso_eau.gt.0) then
                call iso_verif_egalite_choix(Rsol(iso_eau),1.0, &
&                   'iso_surf>calcul_Rsol 335',errmax,errmaxrel)
            endif !if (iso_eau.gt.0) then
            if (iso_HDO.gt.0) then          
              if (qsol(i).gt.ridicule_qsol) then
                call iso_verif_aberrant(Rsol(iso_HDO)/faccond, &
&                   'iso_surf>calcul_Rsol 338')
              endif !if (qsol(i).gt.ridicule_qsol) then
            endif  !if (iso_HDO.gt.0) then 
            if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
              if (qsol(i).gt.ridicule_qsol) then
                call iso_verif_aberrant_o17(Rsol(iso_O17) &
&                    ,Rsol(iso_O18),'iso_surf 513')
              endif !if ((qsol(i).gt.ridicule).and.(xtsol(iso_O18,i)
            endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then  
#endif
              ! end verif
     endif !if (t1lay(i).ge.0.0) then   

 else !if (q1lay(i).gt.ridicule) then
        write(*,*) 'warning: iso_surf>calcul_Rsol 3209'
        write(*,*) 'qsol(i)=',qsol(i),' mais evap(i)=',evap(i)
        write(*,*) 'q1lay(i)=',q1lay(i)
        CALL abort_physic('isotopes_routines_mod', 'iso_surf 2187', 1)
 endif !if (q1lay(i).gt.ridicule) then
endif !if (qsol(i).gt.ridicule_rain) then

! verif
#ifdef ISOVERIF
 do ixt=1,niso
   call iso_verif_noNAN(Rsol(ixt), &
&             'iso_surf>calcul_Rsol 3217, sur terre')
 enddo !do ixt=1,niso

 if (iso_eau.gt.0) then
         call iso_verif_egalite_choix(Rsol(iso_eau),1.0, &
&          'iso_surf>calcul_Rsol 371',errmax,errmaxrel*10)
 endif !if (iso_eau.gt.0) then
 if (iso_HDO.gt.0) then        
    if (qsol(i).gt.ridicule_qsol*1e2) then
        call iso_verif_aberrant(Rsol(iso_HDO)/faccond, &
&          'iso_surf>calcul_Rsol 374')
    endif !if (qsol(i).gt.ridicule_qsol) then
 endif  !if (iso_HDO.gt.0) then 
 if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
    if (qsol(i).gt.ridicule_qsol) then
      call iso_verif_aberrant_o17(Rsol(iso_O17), &
&           Rsol(iso_O18),'iso_surf 548')
    endif !if ((qsol(i).gt.ridicule).and.(xtsol(iso_O18,i)
 endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then  
#endif
          ! end verif

 return
 end subroutine calcul_Rsol

 !***************

 subroutine iso_rosee_givre(xt1lay,q1lay,tsurf,t_coup,evap, &
&          i,xtevap,klon)  

  USE isotopes_mod, ONLY: iso_eau, iso_HDO,ridicule,ridicule_rain, &
        iso_O18,iso_O17
#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel
USE isotopes_verif_mod
#endif
#ifdef ISOTRAC
USE isotrac_mod, ONLY: index_iso
#endif
 implicit none
! inputs
integer i
integer klon
real evap(klon) ! en kg d'eau/s
real xt1lay(ntraciso,klon) ! en kg d'iso/kg d'air
real q1lay(klon) ! en kg d'eau/kg d'air
real tsurf(klon)
real t_coup
!      real dtime ! en s: typiquement: 1800s
!      real Mair ! en kg d'air

! outputs
real xtevap(ntraciso,klon) ! en kg d'iso/s

! locals
integer ixt
real zxtalphal(niso),zxtalphai(niso)
real zxtliq,zxtice ! en kg d'eau /kg d'air
!      real qevap ! en kg d'eau /kg d'air
!real deltaD ! juste pour vérif
real R1eff
!#ifdef ISOVERIF
!integer iso_verif_aberrant_o17_nostop
!real deltaO,o17excess
!#endif

!      write(*,*) 'iso_surf>rosée 527: entrée dans rosée'
if (evap(i).eq.0.0) then
#ifdef ISOVERIF          
write(*,*) 'iso_surf>rosée 528: evap(i)=',evap(i)
#endif        
do ixt=1,niso
  xtevap(ixt,i)=0.0
enddo
return
endif

if (q1lay(i).gt.ridicule) then
     ! verif de R1
#ifdef ISOVERIF
         if (iso_HDO.gt.0) then
             call iso_verif_aberrant(xt1lay(iso_HDO,i)/q1lay(i), &
&                  'iso_surf>rosée 530')
         endif   !if (iso_HDO.gt.0) then
#endif
     ! end verif R1   

!             qevap=-evap(i)*dtime/Mair ! en kg d'eau par kg d'air
!             write(*,*) 'iso_surf>rosé 554: qevap=',qevap
!             write(*,*) 'evap(i),dtime,Mair,q1lay(i)=',
!     :                   evap(i),dtime,Mair,q1lay(i)            
  if (tsurf(i).ge.t_coup) then
    !write(*,*) 'iso_surf>iso_rosee_givre 3181: tsurf(i)=',tsurf(i)
    do ixt=1,niso
       ! methode 1: condensation à l'équilibre, approx 1er ordre
       R1eff= xt1lay(ixt,i)/q1lay(i)  
       call fractcalk_liq(ixt,tsurf(i),zxtalphal(ixt)) 
       xtevap(ixt,i)=evap(i)*zxtalphal(ixt)*R1eff 
       ! methode 2: condensation, approche sans approximation
!                call condiso_liq_ice(ixt,xt1lay(ixt,i),q1lay(i),
!     :           qevap,tsurf(i),0.0,zxtice,zxtliq)    
!               xtevap(ixt,i)=-zxtliq/dtime*Mair       
!                write(*,*) 'iso_surf>rosée 545: qevap=', qevap
!                write(*,*) 'q1lay(i)=',q1lay(i)
!                write(*,*) 'zxtice=',zxtice
!                write(*,*) 'zxtliq=',zxtliq               
        
    enddo !do ixt=1,niso

#ifdef ISOTRAC
   do ixt=niso+1,ntraciso
        R1eff= xt1lay(ixt,i)/q1lay(i) 
        xtevap(ixt,i)=evap(i)*R1eff*zxtalphal(index_iso(ixt))
   enddo
#endif            

#ifdef ISOVERIF
      do ixt=1,ntraciso
        call iso_verif_noNAN(xtevap(ixt,i),'iso_surf>rosée 557')
      enddo !do ixt=1,niso  
      if (iso_HDO.gt.0) then            
!                write(*,*) 'iso_surf>rosée 554: deltaD1=',
!     :                   deltaD(xt1lay(iso_HDO,i)/q1lay(i))
!                write(*,*) 'deltaDcond=',
!     :                   deltaD(xtevap(iso_HDO,i)/evap(i))
      endif ! if (iso_HDO.gt.0)) then 
#ifdef ISOTRAC
      call iso_verif_tracnps(xtevap(1,i), &
&          'iso_surf_rosée 643')
#endif              
#endif
      
  else !if (tsurf(i).ge.t_coup) then
    !write(*,*) 'iso_surf>iso_rosee_givre 3186: tsurf(i)=',tsurf(i)
    do ixt=1,niso
    ! methode 1: condensation à l'équilibre, approx 1er ordre
       R1eff= xt1lay(ixt,i)/q1lay(i)
       call fractcalk_glace(ixt,tsurf(i),zxtalphai(ixt))
       xtevap(ixt,i)=evap(i)*zxtalphai(ixt)*R1eff
     ! methode 2: condensation, approche sans approximation
!                call condiso_liq_ice(ixt,xt1lay(ixt,i),q1lay(i),
!     :           qevap,tsurf(i),1.0,zxtice,zxtliq)           
!                xtevap(ixt,i)=-zxtice/dtime*Mair
!                write(*,*) 'iso_surf>rosée 558: qevap=',qevap
!                write(*,*) 'q1lay(i)=',q1lay(i)
!                write(*,*) 'zxtice=',zxtice
!                write(*,*) 'zxtliq=',zxtliq

    enddo !do ixt=1,niso  

#ifdef ISOTRAC
   do ixt=niso+1,ntraciso
        R1eff= xt1lay(ixt,i)/q1lay(i) 
        xtevap(ixt,i)=evap(i)*R1eff*zxtalphai(index_iso(ixt))
   enddo
#endif  

#ifdef ISOVERIF            
    if (iso_HDO.gt.0) then
!             write(*,*) 'iso_surf>rosée 571: deltaD1=',
!     :                   deltaD(xt1lay(iso_HDO,i)/q1lay(i))
!             write(*,*) 'deltaDcond=',
!     :                   deltaD(xtevap(iso_HDO,i)/evap(i))    
    endif  !if (iso_HDO.gt.0) then
    if (iso_eau.gt.0) then
      call iso_verif_egalite_choix(xt1lay(iso_eau,i),q1lay(i), &
&           'iso_surf>iso_rosee_givre 621',errmax,errmaxrel)
      call iso_verif_egalite_choix(xtevap(iso_eau,i),evap(i), &
&           'iso_surf>iso_rosee_givre 622',errmax,errmaxrel)
    endif !if (iso_eau.gt.0) then
#ifdef ISOTRAC
      call iso_verif_tracnps(xtevap(1,i), &
&          'iso_surf_rosée 687')
#endif              
#endif            
  endif !if (tsurf(i).ge.0.0) then 

  
  ! verif   
#ifdef ISOVERIF
    do ixt=1,niso
      call iso_verif_noNAN(xtevap(ixt,i), &
&            'iso_surf>iso_rosee_givre 3199')
    enddo !do ixt=1,niso
#endif
#ifdef ISOVERIF
    if (iso_eau.gt.0) then
      call iso_verif_egalite_choix(xtevap(iso_eau,i),evap(i), &
&           'iso_surf>iso_rosee_givre 3192',errmax,errmaxrel)
    endif !if (iso_eau.gt.0) then
    if (abs(evap(i)).gt.ridicule_rain) then
      if (iso_HDO.gt.0) then                      
         if (iso_verif_aberrant_choix_nostop(xtevap(iso_HDO,i),evap(i), &
&           ridicule_rain,deltalim_snow,'iso_surf>iso_rosee_givre 3193').eq.1) then    
                write(*,*) 'zxtalphai(iso_HDO)=',zxtalphai(iso_HDO)
                write(*,*) 'deltaD1eff=',deltaD(xt1lay(iso_HDO,i)/q1lay(i))
                write(*,*) 'tsurf(i)=',tsurf(i)
                write(*,*) 'q1lay(i)=',q1lay(i)   
                !stop  
           endif !if (iso_verif_aberrant_nostop
      endif  !if (iso_HDO.gt.0) then  
      if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
        if (iso_verif_aberrant_o17_nostop(xtevap(iso_O17,i) &
&            /evap(i),xtevap(iso_O18,i) &
&            /evap(i),'iso_surf>iso_rosee_givre 713').eq.1) then
          write(*,*) 'tsurf(i)-t_coup=',tsurf(i)-t_coup
          write(*,*) 'deltaO18, O17excess, 1lay', &
&                  deltaO(xt1lay(iso_O18,i)/q1lay(i)),o17excess( &
&                  xt1lay(iso_O17,i)/q1lay(i), &
&                  xt1lay(iso_O18,i)/q1lay(i)) 
          write(*,*) 'zxtalphai(:)=',zxtalphai(:)
          stop
        endif
      endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
    endif !if (evap(i).gt.ridicule_rain) then
#endif
  ! end verif

else !if (q1lay(i).gt.0) then
    write(*,*) 'iso_surf>iso_rosee_givre 3189: evap=',evap(i)
    write(*,*) 'q1lay(i)=',q1lay(i)
    CALL abort_physic('isotopes_routines_mod', 'iso_surf 2416', 1)
endif !if (q1lay(i).gt.0) then

end subroutine iso_rosee_givre


! subroutine générique de traitement de l'évaporation des gouttes
! à ne pas modifier sauf si vous êtes surs de ce que vous faites.      

subroutine stewart_explicite_vectall(ncas, &
&           qp0,xtp0,Pqisup &
&           ,Pxtisup,Eqi,Pqiinf,qeff, &
&           Pxtiinf,xtnew,Exi,fac_ftmr, &
&           qs,Tevap,wt,deltaP &
#ifdef ISOVERIF
&          ,debug,il_debug &
#endif
&   )

  USE isotopes_mod, ONLY: iso_eau, iso_HDO,expb_max,tdifrel,tdifexp, &
&       ridicule,thumxt1,ridicule_rain,bidouille_anti_divergence, &
&       iso_O17,iso_O18
#ifdef ISOVERIF
!    USE isotopes_verif_mod, ONLY: O17_verif, errmax, errmaxrel
        USE isotopes_verif_mod
#endif
implicit none

! version véctorisée: sur les isotopes et sur les points de
! grille
! on s'interresse à l'isotope ixt
! on a un air de propriété (q,xt) 
! on lui apporte une goutte de flux (Pqisup,Pxtisup)
! cette goutte s'évapore avec un flux Eqi
! on cherche le flux de sortie Pxtiinf et la nouvelle
! composition de l'air xtnew, sachant que qnew=q+Eqi*fac_ftmr

! declaration des variables      
! **inputs
integer ncas
real qp0(ncas),xtp0(niso,ncas)
real Pxtisup(niso,ncas)
real Pqisup(ncas),Eqi(ncas),Pqiinf(ncas)
real qs(ncas),qeff(ncas)
real fac_ftmr(ncas)

real Tevap(ncas)
real deltaP(ncas),wt(ncas)

! **outputs
real Pxtiinf(niso,ncas)
real xtnew(niso,ncas)
real Exi(niso,ncas)
integer ixt

! **locals
! verifs
#ifdef ISOVERIF
!real deltaD,deltaO,O17excess
real Rlfin(niso),Rbfin(niso)
integer debug ! si 1: on sort à l'écran ce qui se passe en il_debug
integer il_debug
#endif        

! intermediaires
real h(ncas)
real gama(niso,ncas), beta(niso,ncas), &
&           interm(niso,ncas)
real alphap(niso,ncas)
real Rl0(niso,ncas), Rb0(niso,ncas), Rl(niso,ncas),  &
&           Rb(niso,ncas)
real m(ncas), m0(ncas), A(ncas), qp(ncas)
real J(niso,ncas),e(niso,ncas)
real r_l0qp0(ncas), r_jqp0(niso,ncas),  &
&           r_jl0(niso,ncas)
real f(ncas),g(ncas)
real Revap(niso,ncas)
real Revap0(niso,ncas)
real Revapfin(niso,ncas)
real fv(ncas)

!real  ! debugage
real real_to_double        
integer il
#ifdef ISOVERIF
!integer iso_verif_aberrant_nostop
!integer iso_verif_egalite_choix_nostop
!integer iso_verif_egalite_nostop
real Jtmp,etmp
#endif      
!integer iso_verif_noNaN_nostop
! calcul d'intégrale: métode?
! si rieman:
!#define rieman 
! sinon: gauss.


! parsage
integer trace(ncas)
integer icas_Jsimple,ncas_Jsimple
integer icas_rieman,ncas_rieman
integer cas_Jsimple(ncas)
integer cas_rieman(ncas)

real m_cas(ncas), m0_cas(ncas), &
&     qp0_cas(ncas),A_cas(ncas), &
&     beta_cas(niso,ncas),gama_cas(niso,ncas),f_cas(ncas), &
&     g_cas(ncas), &
&     Rb0_cas(niso,ncas),Rl0_cas(niso,ncas),r_l0qp0_cas(ncas), &
&     Exi_cas(niso,ncas),Pxtiinf_cas(niso,ncas), &
&     Pxtisup_cas(niso,ncas), &
&     xtnew_cas(niso,ncas),Pqiinf_cas(ncas), &
&     Eqi_cas(ncas),xtp0_cas(niso,ncas)
real fac_ftmr_cas(ncas)
!        integer ntot_cas(ncas)

!        include "dimiso.h"


! quelques verifs de bilan d'eau
#ifdef ISOVERIF   
do il=1,ncas
  do ixt=1,niso
    call iso_verif_noNaN((Pxtisup(ixt,il)), &
&         'stewart_explicite_vectall 113') 
    call iso_verif_noNaN((xtp0(ixt,il)), &
&         'stewart_explicite_vectall 115') 
  enddo
enddo !do il=1,ncas
#endif     
#ifdef ISOVERIF
!        write(*,*) 'stewart_explicite 50: entrée'
do il=1,ncas
if (iso_verif_egalite_nostop(( &
&           Pqisup(il)-Eqi(il)-Pqiinf(il)),0.0, &
&          'stewart_explicite 37' ).eq.1) then
  write(*,*) 'il,Pqisup(il),Eqi(il),Pqiinf(il)=', &
&          il,Pqisup(il),Eqi(il),Pqiinf(il) 
  CALL abort_physic('isotopes_routines_mod', 'stewart 2554', 1)
endif !if (iso_verif_egalite
enddo !do il=1,ncas 
if (iso_eau.gt.0) then
   do il=1,ncas   
   call iso_verif_egalite_choix((Pqisup(il)), &
&           (Pxtisup(iso_eau,il)), &
&          'stewart_explicite 38',errmax,errmaxrel) 
   call iso_verif_egalite_choix(( &
&           xtp0(iso_eau,il)), & 
&           (qp0(il)), &
&          'stewart_explicite 58',errmax,errmaxrel)
   enddo !do il=1,ncas 
 endif !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
#endif
 
!          write(*,*) 'stewart_explicite 88: Pqisup=',Pqisup
 do il=1,ncas 
  Pqisup(il)=max(Pqisup(il),0.0)
  do ixt=1,niso
   Pxtisup(ixt,il)=max(Pxtisup(ixt,il),0.0)           
  enddo !do ixt=1,niso
 enddo !do il=1,ncas   


! ***************** début des calculs **********

icas_Jsimple=0
icas_rieman=0
do il=1,ncas ! ******************************

!        write(*,*) 'stewart_explicite 78: il=',il
!        write(*,*) 'stewart_explicite 112: Pqisup=',Pqisup
!****** traitement rapide du cas sans pluie:
if (Pqisup(il).lt.ridicule**2) then
!            write(*,*) 'stewart_explicit 96: cas pas de goutte'
    ! pas de pluie, pas de Pqiinf, pas de changement de vap
    ! cam verif
    ! le 21 dec 2012: on change le.0 en lt.ridicule**2 pour
    ! éviter des Pqisup pathologiquement petits
#ifdef ISOVERIF
    if ((abs(Pqiinf(il)).gt.ridicule) &
&            .or.(abs(Eqi(il)).gt.ridicule)) then
        write(*,*) 'stewart_explicite 39'
        write(*,*) 'Pqisup=',Pqisup(il)
        write(*,*) 'Eqi=',Eqi(il)
        write(*,*) 'Eqi*fac_ftmr=',Eqi(il)*fac_ftmr(il)
        write(*,*) 'Pqiinf=',Pqiinf(il)
        stop
    endif     !if ((abs(Pqiinf).gt.ridicule)  
#endif 
    ! end cam verif
    do ixt=1,niso
      Pxtiinf(ixt,il)=0.0
    enddo
    if (abs(Eqi(il)*fac_ftmr(il)).gt.ridicule) then
        ! attention: pour des raisons obscures, il y a parfois
        ! de le réévaporation significative alors qu'il n'y a
        ! aucune goutte à réévaporer.
        ! Dans ce cas, on admet cette réévaporation obscure et
        ! on suppose qu'elle ne change pas la composition
        ! isotopique de la vapeur. 
        if (qp0(il).gt.ridicule) then
           do ixt=1,niso
           Rb0(ixt,il)=xtp0(ixt,il)/qp0(il)  
           enddo
        else !if (qp0.gt.ridicule) then
           ! il n'y a pas encore de vapeur dans le ddft. On est
           ! très embétté, mais on se dit que le ddft sera
           ! bientot rechargé par de la vapeur plus légitime
           do ixt=1,niso
           Rb0(ixt,il)=0.0     
           enddo ! do ixt=1,niso
           if (iso_eau.gt.0) then
                Rb0(iso_eau,il)=1.0
           endif
        endif   !if (qp0.gt.ridicule) then
        do ixt=1,niso
         Exi(ixt,il)=Rb0(ixt,il)*Eqi(il)
         xtnew(ixt,il)=xtp0(ixt,il)+Exi(ixt,il)*fac_ftmr(il)
        enddo ! do ixt=1,niso
    else !if (abs(Eqi*fac_ftmr).gt.ridicule) then
        ! ça va, tout est logique, tous les flux d'eau sont nuls
        do ixt=1,niso
          xtnew(ixt,il)=xtp0(ixt,il)
          Exi(ixt,il)=0.0
        enddo !do ixt=1,niso
    endif !if (abs(Eqi*fac_ftmr).gt.ridicule) then
#ifdef ISOVERIF
    do ixt=1,niso
     call iso_verif_noNaN((Exi(ixt,il)), &
&             'stewart_explicite_vectall 206')
     call iso_verif_noNaN((xtnew(ixt,il)), &
&             'stewart_explicite_vectall 220')
    enddo
    if (iso_eau.gt.0) then
        call iso_verif_egalite_choix( &
&              (Exi(iso_eau,il)*fac_ftmr(il)), &
&              (Eqi(il)*fac_ftmr(il)), &
&              'stewart_expilicit 125',errmax*10,errmaxrel*10)
        call iso_verif_egalite_choix( &
&                   (Pxtiinf(iso_eau,il)), &
&                   (Pqiinf(il)), &
&                  'stewart_explicite 143',errmax,errmaxrel)
        call iso_verif_egalite_choix( &
&                (xtnew(iso_eau,il)), &
&                (qp0(il)+Eqi(il)*fac_ftmr(il)), &
&                'stewart_explicite 218',errmax*10,errmaxrel*50) 
       endif !if (iso_eau.gt.0) then
       if ((iso_HDO.gt.0).and. &
&           (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule)) then
         call iso_verif_aberrant(( &
&                   xtnew(iso_HDO,il)/(qp0(il)+Eqi(il) &
&                   *fac_ftmr(il))),'stewart_explicite 214')
       endif !if ((iso_HDO.gt.0).and.

#endif              
else !if (Pqisup.eq.0) then

h(il)=qeff(il)/qs(il)       
h(il)= MAX(MIN(h(il),1.0),0.0)
#ifdef ISOVERIF
call iso_verif_positif(h(il)-thumxt1,'stewart_explicit 209') 
#endif        

! ******** cas avec eau: Pqisup>0
! cas ou pas d'évaporation -> tout reste pareil si pas de diff.
! en fait, tout reste pareil si h<1, car diff devient alors
! difficile
if ((Eqi(il)*fac_ftmr(il).lt.ridicule).and.(h(il).lt.0.99)) then
!            write(*,*) 'stewart_explicite 137: cas pas d''évap'

    do ixt=1,niso
      Pxtiinf(ixt,il)=Pqiinf(il)*(Pxtisup(ixt,il)/Pqisup(il))
      Exi(ixt,il)=0.0
      xtnew(ixt,il)=xtp0(ixt,il)
    enddo !do ixt=1,niso

    ! verif
#ifdef ISOVERIF
    do ixt=1,niso
      call iso_verif_noNAN((Pxtiinf(ixt,il)), &
&           'stewart_explicite 152') 
      call iso_verif_noNAN((xtnew(ixt,il)), &
&           'stewart_explicite 152b') 
    enddo
#endif
#ifdef ISOVERIF
    if (iso_eau.gt.0) then
      call iso_verif_egalite_choix( &
&                   (Pxtiinf(iso_eau,il)), &
&                   (Pqiinf(il)), &
&                  'stewart_explicite 143',errmax,errmaxrel)
      if (iso_verif_egalite_choix_nostop( &
&              (Exi(iso_eau,il)*fac_ftmr(il)), &
&              (Eqi(il)*fac_ftmr(il)), &
&              'stewart_explicit 283',errmax*10,errmaxrel*10) &
&              .eq.1) then
        write(*,*) 'il=',il
        write(*,*) 'Eqi(il)=',Eqi(il)
        write(*,*) 'fac_ftmr(il)=',fac_ftmr(il)
        stop
      endif
      if (Pqiinf(il).gt.ridicule) then
          call iso_verif_egalite_choix &
&               ((Pxtiinf(iso_eau,il)/Pqiinf(il)), &
&               1.,'stewart_explicite 143',errmax,errmaxrel)
      endif !if (Pqiinf.gt.ridicule) then
    endif !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
    if (iso_HDO.gt.0) then
      if (Pqiinf(il).gt.ridicule_rain) then
            call iso_verif_aberrant( &
&                (Pxtiinf(iso_HDO,il)/Pqiinf(il)), &
&                'stewart_explicie 132')   
      endif   !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO).and.
      if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
         call iso_verif_aberrant(( &
&                   xtnew(iso_HDO,il)/(qp0(il)+Eqi(il) &
&                   *fac_ftmr(il))),'stewart_explicite 268')
      endif !if ((iso_HDO.gt.0).and.
    endif !if (iso_HDO.gt.0) then
    if ((debug.eq.1).and.(il.eq.il_debug).and.(Eqi(il).gt.0.)) then
           write(*,*) 'stewart_explicit 302: cas evap~0'
           write(*,*) 'deltaDv est inchangé:',deltaD( &
&               (xtnew(iso_HDO,il)/(qp0(il) &
&               +Eqi(il)*fac_ftmr(il))))
    endif
#endif                           
     ! end verif

 else !if ((Eqi(il)*fac_ftmr(il).lt.ridicule).and.(h(il).lt.0.99)) then     

A(il)=wt(il)/deltaP(il)*fac_ftmr(il)
m0(il)=max(Pqisup(il)*deltaP(il)/wt(il),0.0)
m(il)=max(Pqiinf(il)*deltaP(il)/wt(il),0.0)      
if (qp0(il).gt.ridicule*1e-3)  then
  do ixt=1,niso
   Rb0(ixt,il)=xtp0(ixt,il)/qp0(il)
  enddo
else
  do ixt=1,niso  
   Rb0(ixt,il)=0.0 
  enddo !do ixt=1,niso
  if (iso_eau.gt.0) then
      Rb0(iso_eau,il)=1.0
  endif
endif
if (Pqisup(il).gt.ridicule*1e-3) then
  do ixt=1,niso  
   Rl0(ixt,il)=Pxtisup(ixt,il)/Pqisup(il)
  enddo !do ixt=1,niso 
else ! if (Pqisup(il).gt.ridicule*1e-3) then
  do ixt=1,niso  
   Rl0(ixt,il)=0.0
  enddo !do ixt=1,niso 
  if (iso_eau.gt.0) then
      Rl0(iso_eau,il)=1.0
  endif
endif ! if (Pqisup(il).gt.ridicule*1e-3) then
f(il)=m(il)/m0(il)    
! verifs
#ifdef ISOVERIF       
call iso_verif_positif((m(il)), &
&           'stewart_explicite 173')
call iso_verif_positif((qp0(il)), &
&           'stewart_explicite 174')
  call iso_verif_positif(1.0-(f(il)), &
&        'stewart_explicite 373')        
!          write(*,*) 'il,m0(il),m(il)=', il,m0(il),m(il)   
  call iso_verif_positif((m0(il))- &
&           (m(il)),'stewart explicite 123') 
#endif
qp0(il)=max(0.0,qp0(il))
m(il)=min(m(il),m0(il))
f(il)=min(f(il),1.0)
f(il)=max(f(il),0.0)


#ifdef ISOVERIF
do ixt=1,niso
  if ((iso_verif_noNaN_nostop((Rl0(ixt,il)), &
&          'stewart_explicit 357').eq.1).or.  &
&          (iso_verif_noNaN_nostop((Rb0(ixt,il)), &
&          'stewart_explicit 359').eq.1)) then
    write(*,*) 'Pxtisup(ixt,il)=',Pxtisup(ixt,il)
    write(*,*) 'Pqisup(il)',Pqisup(il)
    write(*,*) 'xtp0(ixt,il)=',xtp0(ixt,il)
    write(*,*) 'qp0(il)=',qp0(il)
    stop
  endif !if ((iso_verif_noNaN_nostop
enddo !do ixt=1,niso
#endif              
#ifdef ISOVERIF
  if (iso_eau.gt.0) then
    call iso_verif_egalite_choix( &
&           (xtp0(iso_eau,il)), &
&           (qp0(il)),'stewart_explicit 199', &
&           errmax,errmaxrel)  
    if (iso_verif_egalite_choix_nostop( &
&           (Rb0(iso_eau,il)),1.0, &
&           'stewart_explicit 136', &
&           errmax*10,errmaxrel*10).eq.1) then
       write(*,*) 'xtp0,qp0,Rb0=', &
&           xtp0(iso_eau,il),qp0(il),Rb0(iso_eau,il)
       stop
    endif !if (iso_verif_egalite_choix_nostop(
    call iso_verif_egalite_choix(( &
&           Pxtisup(iso_eau,il)),(Pqisup(il)), &
&           'stewart_explicit 208',errmax,errmaxrel)
    if (iso_verif_egalite_choix_nostop( &
&           (Rl0(iso_eau,il)),1.0, &
&        'stewart_explicit 209',errmax,errmaxrel).eq.1) then
      write(*,*) 'Pxtisup(iso_eau,il),Pqisup=', &
&                   Pxtisup(iso_eau,il),Pqisup(il)
      stop
    endif !if (iso_verif_egalite_choix_nostop(
    ! rajout verif 4 sept 2009
    if (iso_HDO.gt.0) then
        call iso_verif_aberrant_choix(Rl0(iso_HDO,il)*Pqisup(il),Pqisup(il), &
&                   ridicule_rain,deltalim_snow,'stewart_explicite 368')
    endif !if (iso_HDO.gt.0) then
  endif !(iso_eau.gt.0)
#endif
! end verif

        
! **** cas où m=0 <-> f=0
if ((f(il).lt.1e-9).or.(Pqiinf(il).lt.ridicule/10.)) then
    !write(*,*) 'stewart_explicit 137: cas f=0: il=',il
  do ixt=1,niso 
    Pxtiinf(ixt,il)=0.0 ! plus rien ne ressors           
!            Exi(ixt,il)=Eqi(il)*(Pxtisup(ixt,il)/Pqisup(il)) ! tout se réévapore en totalité
    Exi(ixt,il)=Eqi(il)*  Rl0(ixt,il)  ! modif le 21 dec 2012
    !Exi=max(Exi,0) 
    !xtnew=(xtp0+Rl0*m0*A) 
    xtnew(ixt,il)=xtp0(ixt,il)+Exi(ixt,il)*fac_ftmr(il)
    xtnew(ixt,il)=max(xtnew(ixt,il),0.0)
  enddo !do ixt=1,niso      
        ! cam verifs
#ifdef ISOVERIF
  do ixt=1,niso      
        call iso_verif_noNaN((Pxtiinf(ixt,il)), &
&                   'stewart_explicite 259')
        call iso_verif_noNaN((Exi(ixt,il)), &
&                   'stewart_explicite 260')
        call iso_verif_noNaN((xtnew(ixt,il)), &
&                   'stewart_explicite 271')
   enddo !do ixt=1,niso   
   if (iso_eau.gt.0) then
      call iso_verif_egalite_choix( &
&                   (Pxtiinf(iso_eau,il)), &
&                   (Pqiinf(il)), &
&                  'stewart_explicite 168',errmax,errmaxrel)
      call iso_verif_egalite_choix( &
&                  (Exi(iso_eau,il)), &
&                  (Eqi(il)),'stewart_explicite 169', &
&                  errmax,errmaxrel)
      call iso_verif_egalite_choix( &
&                  (Exi(iso_eau,il)*fac_ftmr(il)), &
&                  (Eqi(il)*fac_ftmr(il)), &
&                  'stewart_expilicit 229',errmax*10,errmaxrel*10)
      if (Pqiinf(il).gt.ridicule) then
              call iso_verif_egalite_choix &
&                 ((Pxtiinf(iso_eau,il)/Pqiinf(il)), &
&                 1.,'stewart_explicite 143',errmax,errmaxrel)
      endif !if (Pqiinf.gt.ridicule) then

      if (iso_verif_egalite_choix_nostop( &
&                   (xtnew(iso_eau,il)), &
&                   (qp0(il)+Eqi(il)*fac_ftmr(il)), &
&                   'stewart_explicite 218',errmax*10,errmaxrel*50) &
&                           .eq.1) then
                write(*,*) 'xtnew=',xtnew(iso_eau,il)
                write(*,*) 'qp=',qp0(il)+Eqi(il)*fac_ftmr(il)
                write(*,*) 'Exi=',Exi(iso_eau,il)
                write(*,*) 'Eqi(il)=',Eqi(il)
                write(*,*) 'xtp0=',xtp0(iso_eau,il), &
&                     'qp0=',qp0(il)
                write(*,*) 'Pxtisup=',Pxtisup(iso_eau,il), &
&                   ' Pqisup=',pqisup(il)
                write(*,*) 'Pxtiinf=',Pxtiinf(iso_eau,il), &
&                   ' Pqiinf=',pqiinf(il)
                stop
       endif !if (iso_verif_egalite_choix_nostop(
             ! pour meilleure conv
             !Pxtiinf=Pqiinf
             !Exi=Eqi
             !xtnew=qp0+Eqi*fac_ftmr
     endif    !if (iso_eau.gt.0).and.(ixt.eq.iso_eau) 
     if (iso_HDO.gt.0) then
       if (Pqiinf(il).gt.ridicule_rain) then
            call iso_verif_aberrant( &
&                  (Pxtiinf(iso_HDO,il)/Pqiinf(il)), &
&                   'stewart_explicie 224')   
       endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO).and.
       if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
         call iso_verif_aberrant(( &
&                   xtnew(iso_HDO,il)/(qp0(il)+Eqi(il) &
&                   *fac_ftmr(il))),'stewart_explicite 420')
       endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
     endif !if (iso_HDO.gt.0)
     if ((debug.eq.1).and.(il.eq.il_debug).and.(Eqi(il).gt.0.)) then
         write(*,*) 'stewart_explicit 442: tout se réévapore'
         write(*,*) 'Eqi(il),deltaD=',Eqi(il), &
&                   deltaD((Exi(iso_HDO,il)/Eqi(il)))
     endif
#endif
        ! end verifs                
  else !if ((f.lt.errmaxrel).or.(Pqiinf.lt.errmax)) then
            
            
do ixt=1,niso            
CALL FRACTCALK_liq(IXT, TEVAP(il), alphap(ixt,il))
enddo !do ixt=1,niso 

! **** cas où h=1 -> equilibre
! on rajoute ce cas le 8 dec 2011 pour éviter overflow errors
! dans le cas 1er ordre pour la vapeur
! on remplace aussi le alpha en gama pour être plus précis
if ((h(il).gt.0.99).or. &
&           (h(il).gt.0.98).and.(f(il).lt.1e-3)) then
    do ixt=1,niso
    interm(ixt,il)=alphap(ixt,il)*(1.0-h(il)) &
&           *tdifrel(IXT)**(tdifexp)
    gama(ixt,il)=alphap(ixt,il)*h(il)/(1.0-interm(ixt,il))
    Rb(ixt,il)=(Rb0(ixt,il)*qp0(il)+Rl0(ixt,il)*m0(il)*A(il))/ &
&        (qp0(il)+A(il)*m0(il)*(1-f(il))+A(il)*f(il)*m0(il) &
&           *gama(ixt,il))
    Rl(ixt,il)=gama(ixt,il)*Rb(ixt,il)
    Pxtiinf(ixt,il)=Pqiinf(il)*Rl(ixt,il)            
    Pxtiinf(ixt,il)=max(Pxtiinf(ixt,il),0.0)   
    !xtnew=xtp0+Exi*fac_ftmr
    xtnew(ixt,il)=Rb(ixt,il)*(qp0(il)+Eqi(il)*fac_ftmr(il))    
    xtnew(ixt,il)=max(xtnew(ixt,il),0.0)
  enddo !do ixt=1,niso 
  if (fac_ftmr(il).gt.0.0) then
     do ixt=1,niso  
       Exi(ixt,il)=(xtnew(ixt,il)-xtp0(ixt,il))/fac_ftmr(il)
     enddo !do ixt=1,niso   
  else
    do ixt=1,niso   
       Exi(ixt,il)=Pxtisup(ixt,il)-Pxtiinf(ixt,il)
    enddo !do ixt=1,niso    
  endif
    !Exi=max(Exi,0)

    ! verif
#ifdef ISOVERIF
    do ixt=1,niso 
      call iso_verif_noNAN((Pxtiinf(ixt,il)), &
&           'stewart_explicite 209')   
      call iso_verif_noNAN((Exi(ixt,il)), &
&           'stewart_explicite 259')
      call iso_verif_noNAN((xtnew(ixt,il)), &
&           'stewart_explicite 261')
    enddo !do ixt=1,niso
    if (iso_eau.gt.0) then
        call iso_verif_egalite_choix( &
&            (Rb(iso_eau,il)), &
&            1.0,'stewart_explicite 232',errmax,errmaxrel)
        call iso_verif_egalite_choix( &
&              (Pxtiinf(iso_eau,il)), &
&              (Pqiinf(il)),'stewart_explicite 232', &
&              errmax,errmaxrel)
        call iso_verif_egalite_choix( &
&            (Exi(iso_eau,il)), &
&             (Eqi(il)),'stewart_explicite 233', &
&             errmax,errmaxrel)
        call iso_verif_egalite_choix( &
&                  (Exi(iso_eau,il)*fac_ftmr(il)), &
&                  (Eqi(il)*fac_ftmr(il)), &
&                  'stewart_expilicit 291',errmax*10,errmaxrel*10)
        if (Pqiinf(il).gt.ridicule) then
            call iso_verif_egalite_choix &
&                 ((Pxtiinf(iso_eau,il)/Pqiinf(il)), &
&                 1.,'stewart_explicite 312',errmax,errmaxrel)
         endif !if (Pqiinf.gt.ridicule) then
     endif    !if (iso_eau.gt.0).and.(ixt.eq.iso_eau)  
      
     if (iso_HDO.gt.0) then 
       if (iso_verif_aberrant_choix_nostop(Pxtiinf(iso_HDO,il),Pqiinf(il), &
&                ridicule_rain,deltalim_snow,'stewart_explicite 248').eq.1) then
             write(*,*) 'cas reeq totale, il=',il
             write(*,*) 'deltaDl0=',deltaD( &
&                   (Rl0(iso_hdo,il)))
             write(*,*) 'deltaDb0=',deltaD( &
&                   (Rb0(iso_hdo,il)))
             write(*,*) 'deltaDb=',deltaD( & 
&                   (Rb(iso_hdo,il)))
             stop
       endif !if (iso_verif_aberrant_choix_nostop
       if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
         call iso_verif_aberrant(( &
&                   xtnew(iso_HDO,il)/(qp0(il)+Eqi(il) &
&                   *fac_ftmr(il))),'stewart_explicite 499')
       endif !if ((iso_HDO.gt.0).and.
     endif  !if (iso_HDO.gt.0) then
     if ((debug.eq.1).and.(il.eq.il_debug).and.(Eqi(il).gt.0.)) then
         write(*,*) 'stewart_explicit 526: cas h~1: rééq'
         write(*,*) 'Eqi(il),deltaD=',Eqi(il), &
&                   deltaD((Exi(iso_HDO,il)/Eqi(il)))
         write(*,*) 'deltaDv0,l0=',deltaD( &
&                   (Rb0(iso_hdo,il))),deltaD( &
&                   (Rl0(iso_hdo,il)))
     endif !if ((debug.eq.1).and.(il.eq.il_debug)) then
#endif
    ! end verifs

else if ((f(il).gt.0.998).and. &
&           (Eqi(il)*fac_ftmr(il).lt.1e-2*qp0(il))) then ! if ((h(il).gt.0.99).or. 

!*** cas particulier pour éviter imprécisions numériques:
    ! dans ce cas, on fait l'hypoythèse que Rl et Rb varient peu
    ! -> approx au premier ordre: Revap intégré = Revap initial
    ! f>0.998 veut dire que la goutte varie peu, tandis que
    ! Eqi<<qp0/fac_ftmr veut dire que la vapeur varie peu
   do ixt=1,niso
    Revap0(ixt,il)=tdifrel(IXT)**(tdifexp) &
&          *(Rl0(ixt,il)/alphap(ixt,il) &
&           -h(il)*Rb0(ixt,il))/(1-h(il))
    Exi(ixt,il)=Eqi(il)*Revap0(ixt,il)
    Pxtiinf(ixt,il)=Pxtisup(ixt,il)-Exi(ixt,il)          
    xtnew(ixt,il)=xtp0(ixt,il)+Exi(ixt,il)*fac_ftmr(il)
#ifdef ISOVERIF
    Rlfin(ixt)=Pxtiinf(ixt,il)/Pqiinf(il)
    Rbfin(ixt)=xtnew(ixt,il)/(qp0(il)+Eqi(il)*fac_ftmr(il))
#endif            

!            ! modif du 4 sept 2007: on simplifie
!            Revap(ixt,il)=Revap0(ixt,il)
    ! modif abandonnée
    Revapfin(ixt,il)=tdifrel(IXT)**(tdifexp) &
&         *(Pxtiinf(ixt,il)/Pqiinf(il)/alphap(ixt,il) &
&         -h(il)*xtnew(ixt,il)/(qp0(il)+Eqi(il)*fac_ftmr(il))) &
&           /(1-h(il)) 
    Revap(ixt,il)=0.5*(Revap0(ixt,il)+Revapfin(ixt,il))

    Exi(ixt,il)=Eqi(il)*Revap(ixt,il)
    Exi(ixt,il)=max(min(Exi(ixt,il),Pxtisup(ixt,il)), &
&           -xtp0(ixt,il)/fac_ftmr(il))
    Pxtiinf(ixt,il)=Pxtisup(ixt,il)-Exi(ixt,il)            
    xtnew(ixt,il)=xtp0(ixt,il)+Exi(ixt,il)*fac_ftmr(il)
   enddo !do ixt=1,niso        
    ! verifs
#ifdef ISOVERIF
   do ixt=1,niso 
    call iso_verif_noNAN((Pxtiinf(ixt,il)), &
&           'stewart_explicite 395')
    call iso_verif_noNAN((Exi(ixt,il)), &
&           'stewart_explicite 396')
    call iso_verif_noNAN((xtnew(ixt,il)), &
&           'stewart_explicite 397')
   enddo !do ixt=1,niso 
   if (iso_eau.gt.0) then
        call iso_verif_egalite_choix( &
&              (Pxtiinf(iso_eau,il)), &
&              (Pqiinf(il)),'stewart_explicite 418', &
&              errmax,errmaxrel)
        call iso_verif_egalite_choix( &
&              (Exi(iso_eau,il)), &
&              (Eqi(il)),'stewart_explicite 419', &
&              errmax,errmaxrel)
        if (iso_verif_egalite_choix_nostop( &
&                (Exi(iso_eau,il)*fac_ftmr(il)), &
&                (Eqi(il)*fac_ftmr(il)), &
&                'stewart_expilicit 344', &
&                errmax*10,errmaxrel*10).eq.1) then
          write(*,*) 'Rl0,Rb0=',Rl0(iso_eau,il),Rb0(iso_eau,il)
          write(*,*) 'Revap0=',Revap0(iso_eau,il)
          write(*,*) 'Eqi,Pqisup,Pxtisup,Pqiinf=', &
&                 Eqi(il),Pqisup(il),Pxtisup(iso_eau,il),Pqiinf(il)
          write(*,*) 'fac_ftmr,qp0,xtp0=', &
&                   fac_ftmr(il),qp0(il),xtp0(iso_eau,il)
          write(*,*) 'Revapfin=',Revapfin(iso_eau,il)
          stop
        endif
        if (Pqiinf(il).gt.ridicule) then
              call iso_verif_egalite_choix &
&                 ((Pxtiinf(iso_eau,il)/Pqiinf(il)), &
&                 1.,'stewart_explicite 143', &
&                   errmax,errmaxrel)
        endif !if (Pqiinf.gt.ridicule) then

        if (iso_verif_egalite_choix_nostop( &
&                   (xtnew(iso_eau,il)), &
&                   (qp0(il)+Eqi(il)*fac_ftmr(il)), &
&                   'stewart_explicite 380',errmax*10,errmaxrel*50) &
&                           .eq.1) then
                write(*,*) 'xtnew=',xtnew(iso_eau,il)
                write(*,*) 'qp=',qp0(il)+Eqi(il)*fac_ftmr(il)
                write(*,*) 'Exi=',Exi(iso_eau,il)
                write(*,*) 'Eqi=',Eqi(il)
                write(*,*) 'xtp0=',xtp0(iso_eau,il), &
&                   'qp0=',qp0(il)
                write(*,*) 'Pxtisup=',Pxtisup(iso_eau,il), &
&                   ' Pqisup=',pqisup(il)
                write(*,*) 'Pxtiinf=',Pxtiinf(iso_eau,il), &
&                   ' Pqiinf=',pqiinf(il)
                stop
        endif !if (iso_verif_egalite_choix_nostop(
     endif    !if (iso_eau.gt.0).and.(ixt.eq.iso_eau)
     if (iso_HDO.gt.0) then
       if (Pqiinf(il).gt.ridicule_rain) then
         call iso_verif_aberrant( &
&              (Pxtiinf(iso_HDO,il)/Pqiinf(il)), &
&             'stewart_explicie 384')   
       endif !(iso_HDO.gt.0).and.(ixt.eq.iso_HDO)
       if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
         if (iso_verif_aberrant_nostop(( &
&               xtnew(iso_HDO,il)/(qp0(il)+Eqi(il)*fac_ftmr(il))), &
&              'stewart_explicite 603').eq.1) then
           write(*,*) 'qp0(il),Eqi(il),fac_ftmr(il)=', &
&                   qp0(il),Eqi(il),fac_ftmr(il)
           write(*,*) 'Pqisup(il)=',Pqisup(il)
           write(*,*) 'Rl0(iso_HDO,il),Rb0(iso_HDO,il)=',    &    
&                  Rl0(iso_HDO,il),Rb0(iso_HDO,il) 
           write(*,*)'Revap0(iso_HDO,il),Revapfin(iso_HDO,il)=', &
&                 Revap0(iso_HDO,il),Revapfin(iso_HDO,il)  
           write(*,*) 'Revap(iso_HDO,il)=',Revap(iso_HDO,il)
           write(*,*) 'Rlfin,Rbfin=', &
&                   Rlfin(iso_HDO),Rbfin(iso_HDO)
           write(*,*) 'h(il),alphap(iso_HDO,il),(D/D'')^n=', &
&              h(il),alphap(iso_HDO,il),tdifrel(iso_HDO)**(tdifexp)
           write(*,*) 'deltaDl0,deltaDb0=', &
&               deltaD((Rl0(iso_HDO,il))), &
&                   deltaD((Rb0(iso_HDO,il)))
           write(*,*) 'deltaDe0,deltaDefin,deltaDe=', &
&               deltaD((Revap0(iso_HDO,il))), &
&               deltaD((Revapfin(iso_HDO,il))), &
&               deltaD((Revap(iso_HDO,il)))
           write(*,*) 'deltaDlfin,deltaDbfin=', &
&                   deltaD((Rlfin(iso_HDO))), &
&                   deltaD((Rbfin(iso_HDO)))       
           stop
         endif !if (iso_verif_aberrant_nostop((
       endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
     endif !!if ((iso_HDO.gt.0)
     if ((debug.eq.1).and.(il.eq.il_debug).and.(Eqi(il).gt.0.)) then
         write(*,*) 'stewart_explicit 663: cas où réévap faible'
         write(*,*) 'ordre 1 pour la vapeur et le liquide'
         write(*,*) 'Eqi(il),deltaD=',Eqi(il), &
&                   deltaD((Exi(iso_HDO,il)/Eqi(il)))
     endif
#endif
    ! end verif

else ! f.gt.0.99


  ! *** cas où pas d'air
  if ((h(il).lt.1e-3).or.(qp0(il).lt.1e-8)) then
!              write(*,*) 'stewart_explicit 349: cas pas d''air'
      !**** calcul de Rl
!                Rl=Rl0*f**beta ! on fait autrement pour éviter
!                underflow exception si f trop petit et beta >1
      do ixt=1,niso
       interm(ixt,il)=alphap(ixt,il)*tdifrel(IXT)**(tdifexp)
       beta(ixt,il)=(1.0-interm(ixt,il))/(interm(ixt,il))
!                Rl(ixt,il)=Rl0(ixt,il)*puissance_double(f,beta(ixt,il))
         ! on inline:
        Rl(ixt,il)=Rl0(ixt,il) &
&             *10.0**(min(max(beta(ixt,il)*log(f(il)), &
&             -expb_max),expb_max))
      enddo 
#ifdef ISOVERIF
      call iso_verif_egalite_choix(( &
&           Rl(iso_eau,il)),1.0, &
&          'stewart_explicit 722',errmax,errmaxrel)
#endif              
      ! **** calcul de Rb  
!                Rb=Rl0*(1-f**(beta+1))/(1-f) ! on fait autrement pour
!                éviter underflow exception:
        
        do ixt=1,niso
          Rb(ixt,il)=(A(il)*m0(il)*Rl0(ixt,il)*(1.0-exp &
&             (min(max((beta(ixt,il)+1.0)*log(f(il)), &
&             -expb_max),expb_max)))+qp0(il)*Rb0(ixt,il)) &
&                   /(qp0(il)+A(il)*m0(il)*(1.0-f(il)))
          ! correction bug 19 mars 2010: dénom était faux
          Pxtiinf(ixt,il)=Pqiinf(il)*Rl(ixt,il)
          Pxtiinf(ixt,il)=max(Pxtiinf(ixt,il),0.0)
          xtnew(ixt,il)=Rb(ixt,il) &
&                   *(qp0(il)+Eqi(il)*fac_ftmr(il))
        enddo
        if (fac_ftmr(il).gt.0.0) then
            do ixt=1,niso
                Exi(ixt,il)=(xtnew(ixt,il)-xtp0(ixt,il)) &
&                   /fac_ftmr(il)
            enddo    
        else !if (fac_ftmr.gt.0.0) then
            do ixt=1,niso
                Exi(ixt,il)=Pxtisup(ixt,il)-Pxtiinf(ixt,il)
            enddo ! do ixt=1,niso    
        endif !if (fac_ftmr.gt.0.0) then
        !Exi=max(Exi,0) 

        ! cam verifs
#ifdef ISOVERIF
        do ixt=1,niso     
          call iso_verif_noNAN((Pxtiinf(ixt,il)), &
&                   'stewart_explicite 282b')
          call iso_verif_noNAN((Exi(ixt,il)), &
&                   'stewart_explicite 283b')
          call iso_verif_noNAN((xtnew(ixt,il)), &
&                   'stewart_explicite 284b')
        enddo !do ixt=1,niso       
#endif
#ifdef ISOVERIF
          if (iso_eau.gt.0) then
            call iso_verif_egalite_choix( &
&                   (Pxtiinf(iso_eau,il)), &
&                   (Pqiinf(il)), &
&                  'stewart_explicite 305',errmax,errmaxrel)
            call iso_verif_egalite_choix( &
&                   (Exi(iso_eau,il)), &
&                  (Eqi(il)),'stewart_explicite 306', &
&                   errmax,errmaxrel)
            call iso_verif_egalite_choix( &
&                  (Exi(iso_eau,il)*fac_ftmr(il)), &
&                  (Eqi(il)*fac_ftmr(il)), &
&                  'stewart_expilicit 419',errmax*10,errmaxrel*10)
            if (Pqiinf(il).gt.ridicule) then
              call iso_verif_egalite_choix &
&                 ((Pxtiinf(iso_eau,il)/Pqiinf(il)), &
&                 1.,'stewart_explicite 143',errmax,errmaxrel)
            endif !if (Pqiinf.gt.ridicule) then  
          endif !(iso_eau.gt.0).and.(ixt.eq.iso_eau)
          if (iso_HDO.gt.0) then
            if (Pqiinf(il).gt.ridicule_rain) then
              call iso_verif_aberrant( &
&                  (Pxtiinf(iso_HDO,il)/Pqiinf(il)), &
&                   'stewart_explicie 484')   
            endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO).and.
            if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
              call iso_verif_aberrant(( &
&                   xtnew(iso_HDO,il)/(qp0(il)+Eqi(il) &
&                   *fac_ftmr(il))),'stewart_explicite 214')
             endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
          endif !if ((iso_HDO.gt.0)
     if ((debug.eq.1).and.(il.eq.il_debug).and.(Eqi(il).gt.0.)) then
         write(*,*) 'stewart_explicit 767: cas de réévap sèche'
         write(*,*) 'distill de Rayleigh'
         write(*,*) 'Eqi(il),deltaD=',Eqi(il), &
&                   deltaD((Exi(iso_HDO,il)/Eqi(il)))
     endif
#endif
        ! end verifs

    !else if (fac_ftmr(il).gt.1e18) then
    else if (fac_ftmr(il).gt.1e24) then

        ! *** cas où flux de masse nul
        do ixt=1,niso
        interm(ixt,il)=alphap(ixt,il)*(1.0-h(il)) &
&           *tdifrel(IXT)**(tdifexp)
        beta(ixt,il)=(1.0-interm(ixt,il))/(interm(ixt,il))
        enddo
#ifdef ISOVERIF
        do ixt=1,niso
        call iso_verif_noNaN((beta(ixt,il)), &
&            'stewart_explicit 269')
        enddo !do ixt=1,niso 
#endif


!                write(*,*) 'stewart_explicit 349: cas Mp=0'
      do ixt=1,niso 
        Rl(ixt,il)=Rl0(ixt,il)*f(il)**beta(ixt,il)
        Pxtiinf(ixt,il)=Pqiinf(il)*Rl(ixt,il)
        Pxtiinf(ixt,il)=max(Pxtiinf(ixt,il),0.0)
        Exi(ixt,il)=Pxtisup(ixt,il)-Pxtiinf(ixt,il)
        !Exi=max(Exi,0) 
        xtnew(ixt,il)=xtp0(ixt,il)
      enddo ! do ixt=1,niso   

        ! cam verifs
#ifdef ISOVERIF
    do ixt=1,niso     
      call iso_verif_noNAN((Pxtiinf(ixt,il)), &
&                   'stewart_explicite 463')
      call iso_verif_noNAN((Exi(ixt,il)), &
&                   'stewart_explicite 465')
      call iso_verif_noNAN((xtnew(ixt,il)), &
&                   'stewart_explicite 467')
    enddo !do ixt=1,niso    
          if (iso_eau.gt.0) then
            call iso_verif_egalite_choix( &
&                  (Pxtiinf(iso_eau,il)), &
&                   (Pqiinf(il)), &
&                   'stewart_explicite 471',errmax,errmaxrel)
            call iso_verif_egalite_choix( &
&                   (Exi(iso_eau,il)), &
&                  (Eqi(il)),'stewart_explicite 472', &
&                   errmax,errmaxrel)
            if (iso_verif_egalite_choix_nostop( &
&                  (Exi(iso_eau,il)*fac_ftmr(il)), &
&                  (Eqi(il)*fac_ftmr(il)), &
&                  'stewart_expilicit 472b',errmax*10,errmaxrel*10) &
&                  .eq.1) then
                write(*,*) 'il=',il
                write(*,*) 'f,h=',f(il),h(il)
                write(*,*) 'fac_ftmr,Eqi=',fac_ftmr(il),Eqi(il)
                write(*,*) 'Pqisup,Pqiinf=', &
&                           Pqisup(il),Pqiinf(il)
                write(*,*) 'Pxtisup,Pxtiinf', &
&                     Pxtisup(iso_eau,il),Pxtiinf(iso_eau,il)
                stop
            endif !if (iso_verif_egalite_choix_nostop(
            if (Pqiinf(il).gt.ridicule) then
              call iso_verif_egalite_choix &
&                  ((Pxtiinf(iso_eau,il)/Pqiinf(il)), &
&                  1.,'stewart_explicite 143',errmax,errmaxrel)
            endif !if (Pqiinf.gt.ridicule) then 
          endif !(iso_eau.gt.0).and.(ixt.eq.iso_eau)
          if (iso_HDO.gt.0) then
            if (Pqiinf(il).gt.ridicule_rain) then
            call iso_verif_aberrant( &
&                  (Pxtiinf(iso_HDO,il)/Pqiinf(il)), &
&                   'stewart_explicie 484')   
            endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO).and.
            if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
             call iso_verif_aberrant(( &
&                   xtnew(iso_HDO,il)/(qp0(il)+Eqi(il) &
&                   *fac_ftmr(il))),'stewart_explicite 759')
            endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
          endif !if (iso_HDO.gt.0)
      if ((debug.eq.1).and.(il.eq.il_debug).and.(Eqi(il).gt.0.)) then
         write(*,*) 'stewart_explicit 831: flux de masse vap~0'
         write(*,*) 'Eqi(il),deltaD=',Eqi(il), &
&                   deltaD((Exi(iso_HDO,il)/Eqi(il)))
      endif
#endif
        ! end verifs

    else ! else if (fac_ftmr(il).gt.1e18) then


    !**** cas général

!            write(*,*) 'stewart_explicit 403: cas général'
    do ixt=1,niso
      interm(ixt,il)=alphap(ixt,il)*(1.0-h(il)) &
&           *tdifrel(IXT)**(tdifexp)
      beta(ixt,il)=(1.0-interm(ixt,il))/(interm(ixt,il))
      gama(ixt,il)=alphap(ixt,il)*h(il)/(1-interm(ixt,il))
    enddo

    ! modif le 13 juin 2012: seuil 1e-2 -> 5e-2
    ! le 15 juin: on revient à 1e-2 car sinon, vapeur varie trop
    if (Eqi(il)*fac_ftmr(il)/qp0(il).lt.1e-2) then
                ! premier ordre pour la vapeur
                ! cas ajouté le 7 dec 2011 car le cas général
                ! compliqué donne des choses aberrantes pour
                ! l'O17excess
            ! distinction ajoutee le 8 dec 2011 pour eviter les
            ! underflow exceptions quand f**beta fait dans les
            ! 1e-300.    
       if (-h(il)/(1-h(il))*log(f(il)).gt.30.0) then
        do ixt=1,niso
           Rl(ixt,il) = Rl0(ixt,il)*f(il)**beta(ixt,il) &
&              +gama(ixt,il)*Rb0(ixt,il)*(1.0-f(il)**beta(ixt,il))
        enddo
       else !if (-h(il)/(1-h(il))*log(f(il)).gt.30.0) then
        do ixt=1,niso
           Rl(ixt,il) = gama(ixt,il)*Rb0(ixt,il)
        enddo   
       endif !if (-h(il)/(1-h(il))*log(f(il)).gt.30.0) then
        do ixt=1,niso
        Rb(ixt,il)=((Rl0(ixt,il)-Rl(ixt,il)*f(il)) &
&                  *Pqisup(il)*fac_ftmr(il) &
&                   +Rb0(ixt,il)*qp0(il)) &
&                   /(qp0(il)+Eqi(il)*fac_ftmr(il))
        Pxtiinf(ixt,il)=Pqiinf(il)*Rl(ixt,il)
        Pxtiinf(ixt,il)=max(Pxtiinf(ixt,il),0.0)  
        xtnew(ixt,il)=Rb(ixt,il)*(qp0(il)+Eqi(il)*fac_ftmr(il)) 
        xtnew(ixt,il)=max(xtnew(ixt,il),0.0)              
        if (fac_ftmr(il).gt.0.0) then
         Exi(ixt,il)=(xtnew(ixt,il)-xtp0(ixt,il))/fac_ftmr(il)
        else
         Exi(ixt,il)=Pxtisup(ixt,il)-Pxtiinf(ixt,il)
        endif
        !Exi=max(Exi,0) 
        Pxtiinf(ixt,il)=max(Pxtiinf(ixt,il),0.0)
       enddo !do ixt=1,niso

#ifdef ISOVERIF
        do ixt=1,niso     
          call iso_verif_noNaN((Pxtiinf(ixt,il)), &
&                   'stewart_explicite 913')
          call iso_verif_noNaN((Exi(ixt,il)), &
&                   'stewart_explicite 915')
          call iso_verif_noNaN((xtnew(ixt,il)), &
&                   'stewart_explicite 917')
        enddo !do ixt=1,niso    
#endif
#ifdef ISOVERIF
          if (iso_eau.gt.0) then
            call iso_verif_egalite_choix( &
&                   (Pxtiinf(iso_eau,il)), &
&                   (Pqiinf(il)), &
&                  'stewart_explicite 923',errmax,errmaxrel)
            call iso_verif_egalite_choix( &
&                   (Exi(iso_eau,il)), &
&                  (Eqi(il)),'stewart_explicite 926', &
&                   errmax,errmaxrel)
            call iso_verif_egalite_choix( &
&                  (Exi(iso_eau,il)*fac_ftmr(il)), &
&                  (Eqi(il)*fac_ftmr(il)), &
&                  'stewart_expilicit 931',errmax*10,errmaxrel*10)
            if (Pqiinf(il).gt.ridicule) then
              call iso_verif_egalite_choix &
&                 ((Pxtiinf(iso_eau,il)/Pqiinf(il)), &
&                 1.,'stewart_explicite 935',errmax,errmaxrel)
            endif !if (Pqiinf.gt.ridicule) then  
          endif !(iso_eau.gt.0).and.(ixt.eq.iso_eau)
          if (iso_HDO.gt.0) then
            if (Pqiinf(il).gt.ridicule_rain) then
              call iso_verif_aberrant( &
&                  (Pxtiinf(iso_HDO,il)/Pqiinf(il)), &
&                   'stewart_explicie 484')   
            endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO).and.
            if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
                if (iso_verif_aberrant_nostop(( &
&                   xtnew(iso_HDO,il)/(qp0(il)+Eqi(il) &
&                   *fac_ftmr(il))),'stewart_explicite 947') &
&                   .eq.1) then
                   write(*,*) 'Eqi(il)*fac_ftmr(il)/qp0(il)=', &
&                          Eqi(il)*fac_ftmr(il)/qp0(il) 
                   write(*,*) 'f,h=',f(il),h(il)
                   write(*,*) 'Eqi(il)= ',Eqi(il)
                   write(*,*) 'Pqisup(il)= ',Pqisup(il)
                   write(*,*) 'fac_ftmr(il)= ',fac_ftmr(il)
                   write(*,*) 'qp0(il)= ',qp0(il)
                   write(*,*) 'beta(iso_HDO,il)= ', &
&                        beta(iso_HDO,il)
                   write(*,*) 'gama(iso_HDO,il)= ', &
&                        gama(iso_HDO,il)
                   write(*,*) 'deltaDl0,b0=',deltaD( &
&                        (Rl0(iso_HDO,il))),deltaD( &
&                        (Rb0(iso_HDO,il)))
                   write(*,*) 'deltaDl,b=',deltaD( &
&                        (Rl(iso_HDO,il))),deltaD( &
&                        (Rb(iso_HDO,il)))
                   write(*,*) 'deltaDe=',deltaD( &
&                        (Exi(iso_HDO,il)/Eqi(il)))
                   write(*,*) 'deltaDgamaRb0=',deltaD( &
&                        (gama(iso_HDO,il) &
&                        *Rb0(iso_HDO,il))) 
                   write(*,*) 'deltaDalphaRb0=',deltaD( &
&                        (alphap(iso_HDO,il) &
&                        *Rb0(iso_HDO,il)))
                   stop
                endif
             endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
          endif !if ((iso_HDO.gt.0)
          if ((iso_O17.gt.0).and.(iso_O18.gt.0).and. &
&               (O17_verif)) then
             if (Pqiinf(il).gt.ridicule_rain) then
              call iso_verif_aberrant_o17( &
&                  (Pxtiinf(iso_O17,il)/Pqiinf(il)), &
&                  (Pxtiinf(iso_O18,il)/Pqiinf(il)), &
&                  'stewart_explicie 955')   
            endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO).and.
          endif  ! if ((iso_O17.gt.0).and.(iso_O18.gt.0).and.
     if ((debug.eq.1).and.(il.eq.il_debug)) then
        write(*,*) 'stewart_explicit 951: 1er ordre pour la vap'
     endif !if ((debug.eq.1).and.(il.eq.il_debug)) then
#endif              

    else if ((A(il)*m0(il)/qp0(il).gt.10.0).and. &
&                (1.0-f(il).lt.1e-5)) then
        ! beaucoup de liquide se réévaporant très peu dans un
        ! tout petit peu de vapeur. Ca peut donner des cas
        ! pathologiques avec des vapeurs abérrantes -> on fait
        ! une approx de compo constante du liquide et on se
        ! concentre sur l'évolution de la compo de la vapeur.

        fv(il)=1.0+Eqi(il)*fac_ftmr(il)/qp0(il)
        do ixt=1,niso
          Rb(ixt,il)=(1+beta(ixt,il))/(1+beta(ixt,il) &
&                 *gama(ixt,il))*Rl0(ixt,il) &
&                 *(1-fv(il)**(-(1+beta(ixt,il)*gama(ixt,il)))) &
&                 +Rb0(ixt,il)*fv(il) &
&                 **(-(1+beta(ixt,il)*gama(ixt,il)))
          Rl(ixt,il)=(Rl0(ixt,il)*A(il)*m0(il) &
&                 +Rb0(ixt,il)*qp0(il) &
&                 -fv(il)*qp0(il)*Rb(ixt,il)) &
&                 /(A(il)*m0(il)+qp0(il)*(1-fv(il)))
          Pxtiinf(ixt,il)=Pqiinf(il)*Rl(ixt,il)
          xtnew(ixt,il)=Rb(ixt,il)* &
&                 (qp0(il)+Eqi(il)*fac_ftmr(il)) 
          Pxtiinf(ixt,il)=max(Pxtiinf(ixt,il),0.0)
          xtnew(ixt,il)=max(xtnew(ixt,il),0.0)          
          if (fac_ftmr(il).gt.0.0) then
             Exi(ixt,il)=(xtnew(ixt,il) &
&                 -xtp0(ixt,il))/fac_ftmr(il)
          else
             Exi(ixt,il)=Pxtisup(ixt,il)-Pxtiinf(ixt,il)
          endif
        enddo !do ixt=1,niso

        ! vérifs
#ifdef ISOVERIF
        do ixt=1,niso     
          call iso_verif_noNaN((Pxtiinf(ixt,il)), &
                   'stewart_explicite 1092')
          call iso_verif_noNaN((Exi(ixt,il)), &
&                   'stewart_explicite 1095')
          call iso_verif_noNaN((xtnew(ixt,il)), &
&                   'stewart_explicite 1097')
        enddo !do ixt=1,niso 
#endif
#ifdef ISOVERIF   
          if (iso_eau.gt.0) then
            call iso_verif_egalite_choix( &
&                   (Pxtiinf(iso_eau,il)), &
&                   (Pqiinf(il)), &
&                  'stewart_explicite 1103',errmax,errmaxrel)
            call iso_verif_egalite_choix( &
&                   (Exi(iso_eau,il)), &
&                  (Eqi(il)),'stewart_explicite 926', &
&                   errmax,errmaxrel)
            call iso_verif_egalite_choix( &
&                  (Exi(iso_eau,il)*fac_ftmr(il)), &
&                  (Eqi(il)*fac_ftmr(il)), &
&                  'stewart_expilicit 1111',errmax*10,errmaxrel*10)
            if (Pqiinf(il).gt.ridicule) then
              call iso_verif_egalite_choix &
&                 ((Pxtiinf(iso_eau,il)/Pqiinf(il)), &
&                 1.,'stewart_explicite 1115',errmax,errmaxrel)
            endif !if (Pqiinf.gt.ridicule) then  
          endif !(iso_eau.gt.0).and.(ixt.eq.iso_eau)
          if (iso_HDO.gt.0) then
            if (Pqiinf(il).gt.ridicule_rain) then
              call iso_verif_aberrant( &
&                  (Pxtiinf(iso_HDO,il)/Pqiinf(il)), &
&                   'stewart_explicie 1122')   
            endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO).and.
            if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
                if (iso_verif_aberrant_nostop(( &
&                   xtnew(iso_HDO,il)/(qp0(il)+Eqi(il) &
&                   *fac_ftmr(il))),'stewart_explicite 1127') &
&                   .eq.1) then
                   write(*,*) 'Eqi(il)*fac_ftmr(il)/qp0(il)=', &
&                          Eqi(il)*fac_ftmr(il)/qp0(il) 
                   write(*,*) 'f,h=',f(il),h(il)
                   write(*,*) 'deltaDl0,b0=',deltaD( &
&                        (Rl0(iso_HDO,il))),deltaD( &
&                        (Rb0(iso_HDO,il)))
                   write(*,*) 'deltaDl,b=',deltaD( &
&                        (Rl(iso_HDO,il))),deltaD( &
&                        (Rb(iso_HDO,il)))
                   write(*,*) 'deltaDe=',deltaD( &
&                        (Exi(iso_HDO,il)/Eqi(il)))
                   write(*,*) 'deltaDgamaRb0=',deltaD( &
&                        (gama(iso_HDO,il) &
&                        *Rb0(iso_HDO,il))) 
                   write(*,*) 'deltaDalphaRb0=',deltaD( &
&                        (alphap(iso_HDO,il) &
&                        *Rb0(iso_HDO,il)))
                   stop
                endif
             endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
          endif !if ((iso_HDO.gt.0)
          if ((iso_O17.gt.0).and.(iso_O18.gt.0).and. &
&               (O17_verif)) then
             if (Pqiinf(il).gt.ridicule_rain) then
              call iso_verif_aberrant_o17( &
&                  (Pxtiinf(iso_O17,il)/Pqiinf(il)), &
&                  (Pxtiinf(iso_O18,il)/Pqiinf(il)), &
&                  'stewart_explicite 1156')   
            endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO).and.
          endif  ! if ((iso_O17.gt.0).and.(iso_O18.gt.0).and.
     if ((debug.eq.1).and.(il.eq.il_debug)) then
      write(*,*) 'stewart_explicit 1160: 1er ordre pour le liq'
     endif !if ((debug.eq.1).and.(il.eq.il_debug)) then
#endif              

    else !if (Eqi(il)*fac_ftmr(il)/qp0(il).lt.5e-2) then

    !**** cas général
#ifdef ISOVERIF
!        write(*,*) 'stewart_explicit 1170: cas général: il=',il
do ixt=1,niso
  call iso_verif_noNaN((beta(ixt,il)), &
&            'stewart_explicit 269')
enddo !do ixt=1,niso 
#endif            

!            if ((allow_ordre1v).and.
!     :           (Eqi(il)*fac_ftmr(il).lt.1e-2*qp0(il)).and.
!     :            (h.lt.0.97)) then
!               ! peu d'apport d'évap dans la vapeur, et peu diffusf ->
!               ! peu de modif de la vapeur -> on utilse l'ordre 1 pour
!               ! la vapeur
!            endif

    g(il)=(qp0(il)-A(il)*(m(il)-m0(il)))/qp0(il)

    ! encore un cas particulier!
    ! quand f très petit et surtout f**beta très petit, on
    ! traite à part.
    r_l0qp0(il)=A(il)*m0(il)/qp0(il)            
!            if (  ((f.lt.0.005).and.(h.gt.0.5)) ! orig: beta.gt.7
!     :           .or.((f.lt.0.01).and.(h.gt.0.85)) ! orig: beta.gt.8
!     :           .or.((f.lt.0.1).and.(h.gt.0.9))
!     :           .or.((f.lt.0.15).and.(h.gt.0.95))            
!     :           .or.((f.lt.0.2).and.(h.gt.0.98))) then 
    if ((h(il).gt.0.5).and.(f(il).lt.0.2).and. &
&           (f(il).lt.0.005+3*(h(il)-0.5)**4)) then
        ! la fonction flimite(h(il))=0.005+3*(h(il)-0.5)**4 est
        ! une courbe qui colle aux points de repères utilisés
        ! précédemment. Elle est testée das GCMiso/tests_offline/integrale/gnuplot_cas_f_petit.plot

    do ixt=1,niso
       Rl(ixt,il) = gama(ixt,il) &
&           * (Rl0(ixt,il)*r_l0qp0(il)+Rb0(ixt,il))  &
&             / (1+r_l0qp0(il)) &
&              * (1-f(il)*r_l0qp0(il)) &
&           /(1-f(il)*r_l0qp0(il)*gama(ixt,il))          
       Rb(ixt,il)= (Rl0(ixt,il)*r_l0qp0(il)+Rb0(ixt,il)) &
&           / (1+r_l0qp0(il))

       Pxtiinf(ixt,il)=Pqiinf(il)*Rl(ixt,il) 
       Pxtiinf(ixt,il)=max(Pxtiinf(ixt,il),0.0)  
       xtnew(ixt,il)=Rb(ixt,il)*(qp0(il)+Eqi(il)*fac_ftmr(il)) 
       xtnew(ixt,il)=max(xtnew(ixt,il),0.0)
      
       if (fac_ftmr(il).gt.0.0) then
         Exi(ixt,il)=(xtnew(ixt,il)-xtp0(ixt,il))/fac_ftmr(il)
       else
         Exi(ixt,il)=Pxtisup(ixt,il)-Pxtiinf(ixt,il)
       endif
       !Exi=max(Exi,0) 
       Pxtiinf(ixt,il)=max(Pxtiinf(ixt,il),0.0)
       xtnew(ixt,il)=max(xtnew(ixt,il),0.0) 
       
     enddo !do ixt=1,niso

      ! cam verifs
#ifdef ISOVERIF
    do ixt=1,niso  
       call iso_verif_noNAN((Pxtiinf(ixt,il)), &
&                   'stewart_explicite 518')
        call iso_verif_noNAN((Exi(ixt,il)), &
&                   'stewart_explicite 520')
        call iso_verif_noNAN((xtnew(ixt,il)), &
&                   'stewart_explicite 522')
    enddo  !do ixt=1,niso    
#endif
#ifdef ISOVERIF
      if (iso_eau.gt.0) then
         call iso_verif_egalite_choix( &
&            (Rl(iso_eau,il)), &
&            1.0,'stewart_explicite 591', &
&            errmax*50,errmaxrel*10) 
         call iso_verif_egalite_choix( &
&            (Rb(iso_eau,il)), &
&            1.0,'stewart_explicite 592', &
&            errmax*50,errmaxrel*10)
         call iso_verif_egalite_choix( &
&            (Pxtiinf(iso_eau,il)), &
&            (Pqiinf(il)),'stewart_explicite 593', &
&            errmax*50,errmaxrel*10)
         call iso_verif_egalite_choix( &
&            (xtnew(iso_eau,il)), &
&            (qp0(il)+Eqi(il)*fac_ftmr(il)), &
&            'stewart_explicite 594', &
&            errmax*50,errmaxrel*10)
         if (iso_verif_egalite_choix_nostop( &
&            (Exi(iso_eau,il)), &
&            (Eqi(il)),'stewart_explicite 595', &
&            errmax*50,errmaxrel*10).eq.1) then
           write(*,*) 'il,fac_ftmr(il)=',il,fac_ftmr(il)
           write(*,*) 'xtnew(iso_eau,il),qp(il)=', &
&                 xtnew(iso_eau,il),qp0(il)+Eqi(il)*fac_ftmr(il)
           write(*,*) 'xtp0(iso_eau,il),qp0(il)=', &
&                   xtp0(iso_eau,il),qp0(il)
           write(*,*) 'il=',il
           write(*,*) 'xtp0(iso_eau,7),qp0(7)=', &
&                   xtp0(iso_eau,7),qp0(7)
           stop
         endif
         if (iso_verif_egalite_choix_nostop( &
&            (Exi(iso_eau,il)*fac_ftmr(il)), &
&            (Eqi(il)*fac_ftmr(il)), &
&            'stewart_expilicit 521',errmax*10,errmaxrel*10) &
&            .eq.1) then
           write(*,*) 'il=',il
           stop
         endif !if (iso_verif_egalite_choix_nostop
         if (Pqiinf(il).gt.ridicule) then
           call iso_verif_egalite_choix &
&                ((Pxtiinf(iso_eau,il)/Pqiinf(il)), &
&                1.,'stewart_explicite 143',errmax,errmaxrel)
         endif !if (Pqiinf.gt.ridicule) then 
        ! pour meilleure convergence numérique
        !Pxtiinf=Pqiinf
        !Exi=Eqi
        if (iso_verif_egalite_choix_nostop( &
&                   (xtnew(iso_eau,il)), &
&                   (qp0(il)+Eqi(il)*fac_ftmr(il)), &
&                   'stewart_explicite 605',errmax*10,errmaxrel*50) &
&                           .eq.1) then
                write(*,*) 'xtnew=',xtnew(iso_eau,il)
                write(*,*) 'qp=',qp0(il)+Eqi(il)*fac_ftmr(il)
                write(*,*) 'errrel=', & 
&                   (xtnew(iso_eau,il)- &
&                    (qp0(il)+Eqi(il)*fac_ftmr(il))) &
&                     /(qp0(il)+Eqi(il)*fac_ftmr(il))
                write(*,*) 'Rb=',Rb(iso_eau,il)
                write(*,*) 'Rl=',Rl(iso_eau,il)
                stop
       endif !if (iso_verif_egalite_choix_nostop(
       ! pour meilleure convergence numérique:
       !xtnew=qp0+Eqi*fac_ftmr
   endif   ! if (iso_eau.gt.0).and.(ixt.eq.iso_eau)  
   if (iso_HDO.gt.0) then
     if (Pqiinf(il).gt.ridicule_rain) then
        if (iso_verif_aberrant_nostop( &
&                  (Pxtiinf(iso_HDO,il)/Pqiinf(il)), &
&                   'stewart_explicie 675').eq.1) then
          write(*,*) 'cas général f petit: il=',il
          write(*,*) 'Rl,deltaDRl=',Rl(iso_HDO,il), &
&                   deltaD((Rl(iso_HDO,il)))
          write(*,*) 'gama,h=',gama(iso_HDO,il),h(il)
          write(*,*) 'Rl0,Rb0,deltaDRl0,RbO=',Rl0(iso_HDO,il), &
&                   Rb0(iso_HDO,il), &
&                   deltaD((Rl0(iso_HDO,il))), &
&                   deltaD((Rb0(iso_HDO,il)))
          write(*,*) 'r_l0qp0/(1+r_l0qp0),1/(1+r_l0qp0)=', &
&               r_l0qp0(il)/(1.0+r_l0qp0(il)),1.0/(1.0+r_l0qp0(il))
          write(*,*) 'f,r_l0qp0=',f(il),r_l0qp0(il)
          write(*,*) 'fac=',(1-f(il)*r_l0qp0(il)) &
&                  /(1-f(il)*r_l0qp0(il)*gama(iso_HDO,il)) 
          write(*,*) 'Rl=gama*(RlO*r_l0qp0+rb0)/(1+r_l0qp0)*fac'
          stop
        endif   !if iso_verif_aberrant_nostop(
       endif !if (Pqiinf(il).gt.ridicule_rain) then
       if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
             call iso_verif_aberrant(( &
&                   xtnew(iso_HDO,il)/(qp0(il)+Eqi(il) &
&                   *fac_ftmr(il))),'stewart_explicite 912')
       endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
       if ((debug.eq.1).and.(il.eq.il_debug).and.(Eqi(il).gt.0.)) then
         write(*,*) 'stewart_explicit 991: fcas général'
         write(*,*) 'mais avec formule simplifiée'
         write(*,*) 'il,Eqi(il)=',il,Eqi(il)
         write(*,*) 'deltaD=',deltaD((Exi(iso_HDO,il)/Eqi(il)))
       endif
      endif !if (iso_HDO.gt.0)  
#endif
  ! end verifs  
    
else if (abs((g(il)**((1-2*h(il))/(1-h(il))))-1.0).lt.1e-2) then
        ! dans ce cas, le premier facteur de func (la fonction a
        ! intégrer) est environ constant et égal à 1. on a alors
        ! func=(x/m)**(-beta-1), intégrable analytiquement:
!                write(*,*) 'stewart_explicite 684:calcul analytique'
        icas_Jsimple=icas_Jsimple+1
        cas_Jsimple(icas_Jsimple)=il
#ifdef ISOVERIF
!               write(*,*) 'stewart_expl 894 tmp: '//
!     :             'icas_jsimple,il=',icas_jsimple,il
       trace(il)=2532
#endif                
                
else !if ((g**(1-beta*gama))-1.0.lt.errmaxrel*10) then
        ! dans ce cas, la fonction est trop compliqué à intégrer
        ! analytiquement. On intègre donc numériquement.
!                write(*,*) 'stewart_explicite 684:calcul numérique'
        ! on traitera ce cas en vectoriel:
        icas_rieman=icas_rieman+1
        cas_rieman(icas_rieman)=il
#ifdef ISOVERIF
!                write(*,*) 'stewart_expl 895 tmp: '//
!     :             'icas_rieman,il=',icas_rieman,il
        trace(il)=2533
#endif                
  endif !if ((g**(1-beta*gama))-1.0.lt.errmaxrel*10) then

    
  ! end verifs
endif !if (Eqi(il)*fac_ftmr(il)/qp0(il).lt.5e-2) then
endif !if ((h.lt.1e-3).or.(qp0.lt.1e-8)) then   
endif !if (h(il).gt.0.99) then
endif !if ((f(il).lt.1e-9).or.(Pqiinf(il).lt.ridicule/10.)) then
endif !!if ((Eqi(il)*fac_ftmr(il).lt.ridicule).and.(h(il).lt.0.99)) then 
endif ! Pqisup.le.0
enddo ! do il=1,ncas


ncas_rieman=icas_rieman
ncas_Jsimple=icas_Jsimple
!#ifdef ISOVERIF
!      write(*,*) 'stewart_explicite_vectall 812: ncas=',ncas
!      write(*,*) 'ncas_rieman=',ncas_rieman
!      write(*,*) 'ncas_Jsimple=',ncas_Jsimple      
!#endif      

!******** traitement vectoriel des cas Rieman et Jsimple:
! compression
if (ncas_Jsimple+ncas_rieman.gt.0) then
!#ifdef ISOVERIF         
!        write(*,*) 'stewart_explicite_vectall 873:compression_calculJ' 
!#endif        
call compress_calculJ(ncas,ncas_Rieman,ncas_Jsimple,  &
&           cas_rieman,cas_Jsimple, &
&           m_cas,m, m0_cas,m0,  &
&           qp0_cas,qp0, A_cas,A, &
&           xtp0_cas,xtp0,    &
&           beta_cas,beta,gama_cas,gama, &
!     :           f_cas,f, g_cas,g,ntot_cas,h,
&           f_cas,f, g_cas,g,h, &
&           Rb0_cas,Rb0, &
&           Rl0_cas,Rl0, &
&           r_l0qp0_cas,r_l0qp0,   & 
&           Eqi_cas,Eqi, &
&           fac_ftmr_cas,fac_ftmr, &
&           Pxtisup_cas,Pxtisup, &
&           Pqiinf_cas,Pqiinf)

#ifdef ISOVERIF
! vérif de la compression:
do icas_Jsimple=1,ncas_Jsimple
  call iso_verif_egalite_choix( &
&           (Pqiinf_cas(icas_Jsimple)), &
&           (Pqiinf(cas_Jsimple(icas_Jsimple))), &
&           'stewart_explicit 912',errmax,errmaxrel)
  call iso_verif_egalite_choix( &
&           (qp0_cas(icas_Jsimple)), &
&           (qp0(cas_Jsimple(icas_Jsimple))), &
&           'stewart_explicit 913',errmax,errmaxrel)
  call iso_verif_egalite_choix( &
&           (Eqi_cas(icas_Jsimple)), &
&           (Eqi(cas_Jsimple(icas_Jsimple))), &
&           'stewart_explicit 913',errmax,errmaxrel) 
  call iso_verif_egalite_choix( &
&           (fac_ftmr_cas(icas_Jsimple)), &
&           (fac_ftmr(cas_Jsimple(icas_Jsimple))), &
&           'stewart_explicit 913',errmax,errmaxrel) 
  call iso_verif_egalite_choix &
&           ((f_cas(icas_Jsimple)), &
&        (m_cas(icas_Jsimple)/m0_cas(icas_Jsimple)), &
&        'stewart_explicite_vectall 953 apres compression', &
&        errmax,errmaxrel)
enddo !do icas_Jsimple=1,ncas_Jsimple
do icas_Jsimple=1,ncas_rieman
  call iso_verif_egalite_choix( &
&           (Pqiinf_cas(icas_Jsimple+ncas_Jsimple)), &
&           (Pqiinf(cas_rieman(icas_Jsimple))), &
&           'stewart_explicit 918',errmax,errmaxrel)
  if (iso_verif_egalite_choix_nostop( &
&        (f_cas(icas_Jsimple+ncas_Jsimple)), &
&        (m_cas(icas_Jsimple+ncas_Jsimple) &
&        /m0_cas(icas_Jsimple+ncas_Jsimple)), &
&       'stewart_explicite_vectall 953b apres compression', &
&        errmax,errmaxrel).eq.1) then
      write(*,*) 'icas_Jsimple,cas_rieman(icas_Jsimple)=', &
&           icas_Jsimple,cas_rieman(icas_Jsimple)
      stop
  endif
enddo !do icas_Jsimple=1,ncas_Jsimple
#endif        

! ************ traitement vectoriel du cas J simplifié
if (ncas_Jsimple.gt.0) then
!#ifdef ISOVERIF
!          write(*,*) 'traitement vectoriel J simple: x',ncas_Jsimple
!#endif          
do il=1,ncas_Jsimple
  do ixt=1,niso
    J(ixt,il)=m_cas(il)*(1.0-10.0 &
&           **(min(max(beta_cas(ixt,il)*log(f_cas(il))/log(10.0), &
&             -expb_max),expb_max)))/beta_cas(ixt,il)            
    e(ixt,il)=0.0
#ifdef ISOVERIF
    call iso_verif_noNAN((J(ixt,il)), &
&                   'stewart_explicit 691') 
    call iso_verif_egalite_choix((J(ixt,il)), &
&       (m_cas(il)/beta_cas(ixt,il) &
&           *(1.0-f_cas(il)**(beta_cas(ixt,il)))), &
&       'stewart_explicite 998: vérif de fonction puissance', &
&       errmax,errmaxrel)      
#endif                                      
  enddo  !do ixt=1,niso  
enddo !do il=1,ncas_Jsimple
endif !if (ncas_Jsimple.gt.0) then
      

    ! ******* traitement vectoriel du cas Rieman (=2533)
if (ncas_rieman.gt.0) then
            
   icas_rieman=1+ncas_Jsimple

   call integrale_gauss_vectall &
&       (ncas_rieman,m_cas(icas_rieman), &
&       J(1,icas_rieman), &
&       qp0_cas(icas_rieman),A_cas(icas_rieman), &
&       m0_cas(icas_rieman),beta_cas(1,icas_rieman), &
&       gama_cas(1,icas_rieman), &
!     :       g_cas(icas_rieman),ntot_cas(icas_rieman))
&       g_cas(icas_rieman))      

  endif !if (ncas_rieman.gt.0) then


! ******* traitement vectoriel commun du cas Rieman et Jsimple           
#ifdef ISOVERIF
!          write(*,*) 'traitement vectoriel commun rieman/Jsimple'
#endif          
   do il=1,ncas_Jsimple+ncas_rieman          
    do ixt=1,niso 
    r_jqp0(ixt,il)=A_cas(il)*J(ixt,il)/qp0_cas(il)
    r_jl0(ixt,il)=J(ixt,il)/m0_cas(il)                
    Rl(ixt,il)=Rl0_cas(ixt,il)*((f_cas(il)**beta_cas(ixt,il)) &
&          *(g_cas(il)**(-beta_cas(ixt,il)*gama_cas(ixt,il))) &
&          +beta_cas(ixt,il)*gama_cas(ixt,il)*r_jqp0(ixt,il) &
&                   /f_cas(il)/g_cas(il)) &
&          +Rb0_cas(ixt,il)*gama_cas(ixt,il)*beta_cas(ixt,il) &
&                   *r_jl0(ixt,il)/f_cas(il)/g_cas(il)
    Rb(ixt,il)=Rb0_cas(ixt,il)*(1/g_cas(il)  &
&           - 1/g_cas(il)/g_cas(il)  &
&          * gama_cas(ixt,il)*beta_cas(ixt,il)*r_jqp0(ixt,il)) &
&          +Rl0_cas(ixt,il)*r_l0qp0_cas(il)* (1.0/g_cas(il) &
&          -(f_cas(il)**(beta_cas(ixt,il)+1.0)) &
&          *(g_cas(il)**(-beta_cas(ixt,il)*gama_cas(ixt,il)-1.0))  &
&          -beta_cas(ixt,il)*gama_cas(ixt,il)*r_jqp0(ixt,il) &
&                   /g_cas(il)/g_cas(il))

    Pxtiinf_cas(ixt,il)=Pqiinf_cas(il)*Rl(ixt,il) 
    Pxtiinf_cas(ixt,il)=max(Pxtiinf_cas(ixt,il),0.0)   

    xtnew_cas(ixt,il)=Rb(ixt,il)*(qp0_cas(il)+Eqi_cas(il) &
&           *fac_ftmr_cas(il))    
    xtnew_cas(ixt,il)=max(xtnew_cas(ixt,il),0.0)
    
    if ((fac_ftmr_cas(il).gt.0.0).and. &
&           (Pqiinf_cas(il).gt.(Eqi_cas(il)+qp0_cas(il) &
&                   /fac_ftmr_cas(il)))) then 
        ! méthode (1)
!                write(*,*) 'stewart_explicite 739: methode 1'
        Exi_cas(ixt,il)=(xtnew_cas(ixt,il)-xtp0_cas(ixt,il)) &
&                   /fac_ftmr_cas(il)
    else
       ! méthode (2): 
!               write(*,*) 'stewart_explicite 743: methode 2'
       Exi_cas(ixt,il)=Pxtisup_cas(ixt,il)-Pxtiinf_cas(ixt,il)
    endif
    enddo !do ixt=1,niso 
#ifdef ISOVERIF
    do ixt=1,niso
      if ((iso_verif_noNaN_nostop(Exi_cas(ixt,il), &
&           'stewart_explicite 1345').eq.1).or. &
&           (iso_verif_noNaN_nostop(Pxtiinf_cas(ixt,il), &
&           'stewart_explicite 1348').eq.1).or. &
&           (iso_verif_noNaN_nostop(xtnew_cas(ixt,il), &
&           'stewart_explicite 1348b').eq.1)) then
       write(*,*) 'ixt,ncas_Jsimple,il=',ixt,ncas_Jsimple,il
       write(*,*) 'Exi_cas(ixt,il)=',Exi_cas(ixt,il)
       write(*,*) 'Pxtiinf_cas(ixt,il)=',Pxtiinf_cas(ixt,il)
       write(*,*) 'xtnew_cas(ixt,il)=',xtnew_cas(ixt,il)
       write(*,*) 'xtp0_cas(ixt,il)=',xtp0_cas(ixt,il)
       write(*,*) 'Pxtisup_cas(ixt,il)=',Pxtisup_cas(ixt,il)
       write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
       write(*,*) 'Eqi_cas(il)=',Eqi_cas(il)
       write(*,*) 'Pqiinf_cas(il)=',Pqiinf_cas(il)
       write(*,*) 'qp0_cas(il)=',qp0_cas(il)
       write(*,*) 'm0_cas(il)=',m0_cas(il)
       write(*,*) 'Rb(ixt,il)=',Rb(ixt,il)
       write(*,*) 'Rl(ixt,il)=',Rl(ixt,il)
       write(*,*) 'r_jqp0(ixt,il)=',r_jqp0(ixt,il)
       write(*,*) 'r_jl0(ixt,il)=',r_jl0(ixt,il)
       write(*,*) 'J(ixt,il)=',J(ixt,il)
       write(*,*) 'A_cas(il)=',A_cas(il)
       write(*,*) 'f_cas(il)=',f_cas(il)
       write(*,*) 'g_cas(il)=',g_cas(il)
       write(*,*) 'beta_cas(ixt,il)=',beta_cas(ixt,il)
       write(*,*) 'gama_cas(ixt,il)=',gama_cas(ixt,il)
       write(*,*) 'f**beta=',f_cas(il)**beta_cas(ixt,il)
       write(*,*) 'f**(beta+1)=',f_cas(il)**(beta_cas(ixt,il)+1)
       write(*,*) 'g*(-beta*gama)=',g_cas(il)** &
&          (-beta_cas(ixt,il)*gama_cas(ixt,il))
       write(*,*) 'g*(-beta*gama-1)=',g_cas(il)** &
&          (-beta_cas(ixt,il)*gama_cas(ixt,il)-1.0)
       stop
      endif
    enddo
#endif
#ifdef ISOVERIF         
    if (iso_eau.gt.0) then
      if (iso_verif_egalite_choix_nostop( &
&           (Pxtiinf_cas(iso_eau,il)), &
&           (Pqiinf_cas(il)),'stewart_explicite 451', &
&           errmax*50,errmaxrel*50).eq.1) then 
         write(*,*) 'il=',il
         if (il.le.ncas_Jsimple) then
            write(*,*) 'cas_Jsimple(il)=',cas_Jsimple(il)
         else !if (il.le.ncas_Jsimple) then
            write(*,*) 'cas_rieman(il)=',cas_rieman(il)
         endif !if (il.le.ncas_Jsimple) then
         write(*,*) 'Rl=',Rl(iso_eau,il),' Rb=',Rb(iso_eau,il)
         write(*,*) 'g**(1-beta*gama)=',g_cas(il)** &
&                 (1-beta_cas(iso_eau,il)*gama_cas(iso_eau,il))
         write(*,*) 'j=',j(iso_eau,il)
!#ifdef rieman                 
!                 write(*,*) 'e=',e(iso_eau,il)
!#endif                 
!                 write(*,*) 'ntot_cas(il)=',ntot_cas(il)
         write(*,*) 'gama=',gama_cas(iso_eau,il), &
&                   ' beta=',beta_cas(iso_eau,il)
         if (il.le.ncas_Jsimple) then
           write(*,*) 'h=',h(cas_Jsimple(il)), &
&                   ' Tevap=',Tevap(cas_Jsimple(il))
         else !if (il.le.ncas_Jsimple) then
             write(*,*) 'h=',h(cas_rieman(il)), &
&                   ' Tevap=',Tevap(cas_rieman(il))
         endif !if (il.le.ncas_Jsimple) then
         write(*,*) 'f=',f_cas(il),' g=',g_cas(il)
         write(*,*) 'r_jl0=',r_jl0(iso_eau,il), &
&                   ' r_jqp0=',r_jqp0(iso_eau,il)
         write(*,*) 'r_l0qp0=',r_l0qp0_cas(il)
         write(*,*) 'm0=',m0_cas(il),' m=',m_cas(il), &
&                           ' m0-m=',m0_cas(il)-m_cas(il)
         write(*,*) 'A=',A_cas(il),' qp0=',qp0_cas(il)
         write(*,*) 'Rl0=',Rl0_cas(iso_eau,il), &
&           ' Rb0=',Rb0_cas(iso_eau,il)
         write(*,*) 'pond Rl0=',(f_cas(il) &
&               **beta_cas(iso_eau,il)) &
&                   *(g_cas(il)**(-beta_cas(iso_eau,il) &
&                   *gama_cas(iso_eau,il))) &
&                 +beta_cas(iso_eau,il)*gama_cas(iso_eau,il) &
&              *r_jqp0(iso_eau,il)/f_cas(il)/g_cas(il)
         write(*,*) 'pond Rb0=', &
&              gama_cas(iso_eau,il)*beta_cas(iso_eau,il) &
&              *r_jl0(iso_eau,il)/f_cas(il)/g_cas(il)
         write(*,*) 'fac1=', &
&                  f_cas(il)**beta_cas(iso_eau,il)
         write(*,*) 'fac2=',g_cas(il) &
&             **(-beta_cas(iso_eau,il)*gama_cas(iso_eau,il)) 
         write(*,*) 't3=',beta_cas(iso_eau,il) &
&               *gama_cas(iso_eau,il)*r_jqp0(iso_eau,il) &
&           /f_cas(il)/g_cas(il)    
         stop   
       endif !if (iso_verif_egalite_choix_nostop(
       if (iso_verif_egalite_choix_nostop( &
&           (xtnew_cas(iso_eau,il)), &
&           (qp0_cas(il)+Eqi_cas(il) &
&           *fac_ftmr_cas(il)),'stewart_explicite 1026', &
&           errmax*50,errmaxrel*50).eq.1) then 
         write(*,*) 'il=',il                 
         if (il.le.ncas_Jsimple) then
            write(*,*) 'cas_Jsimple(il)=',cas_Jsimple(il)
         else !if (il.le.ncas_Jsimple) then
            write(*,*) 'cas_rieman(il)=',cas_rieman(il)
         endif !if (il.le.ncas_Jsimple) then
         write(*,*) 'Rl=',Rl(iso_eau,il),' Rb=',Rb(iso_eau,il)
         write(*,*) 'g**(1-beta*gama)=',g_cas(il)** &
&                 (1-beta_cas(iso_eau,il)*gama_cas(iso_eau,il))
         write(*,*) 'J=',J(iso_eau,il)
!#ifdef rieman                 
!                 write(*,*) 'e=',e(iso_eau,il)
!#endif                   
!                 write(*,*) 'ntot_cas(il)=',ntot_cas(il)
         write(*,*) 'gama=',gama_cas(iso_eau,il), &
&                   ' beta=',beta_cas(iso_eau,il)
         if (il.le.ncas_Jsimple) then
           write(*,*) 'h=',h(cas_Jsimple(il)), &
&                   ' Tevap=',Tevap(cas_Jsimple(il))
         else !if (il.le.ncas_Jsimple) then
             write(*,*) 'h=',h(cas_rieman(il)), &
&                   ' Tevap=',Tevap(cas_rieman(il))
         endif !if (il.le.ncas_Jsimple) then
         write(*,*) 'f=',f_cas(il),' g=',g_cas(il)
         write(*,*) 'r_jl0=',r_jl0(iso_eau,il), &
&                   ' r_jqp0=',r_jqp0(iso_eau,il)
         write(*,*) 'r_l0qp0=',r_l0qp0_cas(il)
         write(*,*) 'm0=',m0_cas(il),' m=',m_cas(il)
         write(*,*) 'A=',A_cas(il),' qp0=',qp0_cas(il)
         write(*,*) 'Rl0=',Rl0_cas(iso_eau,il), &
&           ' Rb0=',Rb0_cas(iso_eau,il)
         write(*,*) 'pond Rl0=',r_l0qp0_cas(il)* (1/g_cas(il) &
&              -(f_cas(il)**(beta_cas(iso_eau,il)+1)) &
&              *(g_cas(il)**(-beta_cas(iso_eau,il) &
&                   *gama_cas(iso_eau,il)-1))  &
&              -beta_cas(iso_eau,il)*gama_cas(iso_eau,il) &
&                   *r_jqp0(iso_eau,il) &
&                   /g_cas(il)/g_cas(il))
         write(*,*) 'pond Rb0=',(1/g_cas(il)  &
&              - 1/g_cas(il)/g_cas(il) * gama_cas(iso_eau,il) &
&             *beta_cas(iso_eau,il)*r_jqp0(iso_eau,il))
         stop   
       endif !if (iso_verif_egalite_choix_nostop(
       if ((iso_verif_egalite_choix_nostop( &
&            (Exi_cas(iso_eau,il)), &
&            (Eqi_cas(il)),'stewart_explicite 777', &
&            errmax*800,errmaxrel*800).eq.1).or. &
&            (iso_verif_egalite_choix_nostop( &
&            (Exi_cas(iso_eau,il)*fac_ftmr_cas(il)), &
&            (Eqi_cas(il)*fac_ftmr_cas(il)), &
&           'stewart_explicite 586', &
&            errmax*3000,errmaxrel*800).eq.1)) then  
          write(*,*) 'il=',il                 
         if (il.le.ncas_Jsimple) then
            write(*,*) 'cas_Jsimple(il)=',cas_Jsimple(il)
         else !if (il.le.ncas_Jsimple) then
            write(*,*) 'cas_rieman(il)=',cas_rieman(il)
         endif !if (il.le.ncas_Jsimple) then
          write(*,*) 'g**(1-beta*gama)=',g_cas(il) &
&                **(1-beta_cas(iso_eau,il)*gama_cas(iso_eau,il))
          write(*,*) 'Eqi,Exi,fac_ftmr,Pqiinf=',Eqi_cas(il), &
&             Exi_cas(iso_eau,il),fac_ftmr_cas(il),Pqiinf_cas(il)
          write(*,*) 'xtnew(iso_eau,il),xtp0(iso_eau,il)=', &
&              xtnew_cas(iso_eau,il),xtp0_cas(iso_eau,il)     
          stop
     endif
    endif  !if (iso_eau.gt.0) then
    if (iso_HDO.gt.0) then
       if (qp0_cas(il)+Eqi_cas(il)*fac_ftmr_cas(il) &
&                   .gt.ridicule) then
         if (iso_verif_aberrant_nostop(( &
&                xtnew_cas(iso_HDO,il)/(qp0_cas(il)+Eqi_cas(il) &
&                *fac_ftmr_cas(il))), &
&                'stewart_explicite 1316').eq.1) then
           write(*,*) 'il,fac_ftmr_cas(il)=',il,fac_ftmr_cas(il)
           write(*,*) 'h(il)=',h(il)
           write(*,*) 'alphap(iso_HDO,il)=',alphap(iso_HDO,il)
           write(*,*) 'Di/D)^n=',tdifrel(iso_HDO)**(tdifexp)
           write(*,*) 'qp0_cas(il)=',qp0_cas(il)   
           write(*,*) 'Eqi_cas(il)=',Eqi_cas(il)   
           write(*,*) 'Pqiinf_cas(il)=',Pqiinf_cas(il) 
           write(*,*) 'm0_cas(il)=',m0_cas(il)
           write(*,*) 'deltaD(Rb0(iso_HDO,il))=', &
&               deltaD(Rb0(iso_HDO,il))
           write(*,*) 'deltaD(Rl0(iso_HDO,il))=', &
&               deltaD(Rl0(iso_HDO,il))
           write(*,*) 'deltaD(Rb(iso_HDO,il))=', &
&               deltaD(Rb(iso_HDO,il))
           write(*,*) 'deltaD(Rl(iso_HDO,il))=', &
&               deltaD(Rl(iso_HDO,il))
           write(*,*) 'r_jqp0(iso_HDO,il)=',r_jqp0(iso_HDO,il)
           write(*,*) 'r_jl0(iso_HDO,il)=',r_jl0(iso_HDO,il)
           write(*,*) 'J(iso_HDO,il)=',J(iso_HDO,il)
           write(*,*) 'A_cas(il)=',A_cas(il)
           write(*,*) 'f_cas(il)=',f_cas(il)
           write(*,*) 'g_cas(il)=',g_cas(il)
           write(*,*) 'beta_cas(iso_HDO,il)=', &
&               beta_cas(iso_HDO,il)
           write(*,*) 'gama_cas(iso_HDO,il)=', &
&               gama_cas(iso_HDO,il)
           stop
         endif
        endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
      endif !if (iso_HDO.gt.0)
#endif            
  enddo !do il=1,ncas_Jsimple+ncas_rieman 

  call uncompress_calculJ(ncas,ncas_rieman,ncas_Jsimple, &
&          cas_rieman,cas_Jsimple,Exi_cas,Exi, &
&           xtnew_cas,xtnew,Pxtiinf_cas,Pxtiinf)


#ifdef ISOVERIF
! vérif de la décompression:        
do icas_Jsimple=1,ncas_Jsimple
 do ixt=1,niso
  call iso_verif_egalite_choix( &
&           (xtnew_cas(ixt,icas_Jsimple)), &
&           (xtnew(ixt,cas_Jsimple(icas_Jsimple))), &
&           'stewart_explicit 1046',errmax,errmaxrel)
  call iso_verif_egalite_choix( &
&           (Exi_cas(ixt,icas_Jsimple)), &
&           (Exi(ixt,cas_Jsimple(icas_Jsimple))), &
&           'stewart_explicit 1047',errmax,errmaxrel)
 enddo !do ixt=1,niso
enddo !do icas_Jsimple=1,ncas_Jsimple
do icas_Jsimple=1,ncas_rieman
 do ixt=1,niso
  call iso_verif_egalite_choix( &
&        (xtnew_cas(ixt,icas_Jsimple+ncas_Jsimple)), &
&        (xtnew(ixt,cas_rieman(icas_Jsimple))), &
&        'stewart_explicit 1054',errmax,errmaxrel)
  call iso_verif_egalite_choix( &
&        (Exi_cas(ixt,icas_Jsimple+ncas_Jsimple)), &
&        (Exi(ixt,cas_rieman(icas_Jsimple))), &
&        'stewart_explicit 1055',errmax,errmaxrel)
 enddo !do ixt=1,niso 
enddo !do icas_Jsimple=1,ncas_Jsimple
#endif   


    ! cam verifs
#ifdef ISOVERIF
 do icas_Jsimple=1,ncas_Jsimple+ncas_rieman    
   if (icas_Jsimple.le.ncas_Jsimple) then
     il=cas_Jsimple(icas_Jsimple)
   else
     il=cas_rieman(icas_Jsimple-ncas_Jsimple)
   endif
   do ixt=1,niso
    if ((iso_verif_noNaN_nostop((Pxtiinf(ixt,il)), &
&         'stewart_explicite 618').eq.1).or. &
&         (iso_verif_noNaN_nostop((Exi(ixt,il)), &
&         'stewart_explicite 620').eq.1).or. &
&         (iso_verif_noNaN_nostop((xtnew(ixt,il)), &
&         'stewart_explicite 622').eq.1)) then
       write(*,*) 'ixt,il=',ixt,il
       write(*,*) 'icas_Jsimple,ncas_Jsimple=', &
&                  icas_Jsimple,ncas_Jsimple
       stop
     endif !if ((iso_verif_noNaN_nostop
   enddo  !do ixt=1,niso  
 enddo !do icas_Jsimple=1,ncas_Jsimple+ncas_rieman  
#endif           
#ifdef ISOVERIF
 do icas_Jsimple=1,ncas_Jsimple+ncas_rieman    
   if (icas_Jsimple.le.ncas_Jsimple) then
     il=cas_Jsimple(icas_Jsimple)
   else
     il=cas_rieman(icas_Jsimple-ncas_Jsimple)
   endif           
   if (iso_eau.gt.0) then
       if (iso_verif_egalite_choix_nostop( &
&           (Pxtiinf(iso_eau,il)), &
&           (Pqiinf(il)),'stewart_explicite 1105', &
&           errmax*50,errmaxrel*50).eq.1) then 
          write(*,*) 'icas_Jsimple,il,trace(il)=', &
&                    icas_Jsimple,il,trace(il) 
          write(*,*) 'Pqiinf_cas(icas_Jsimple)=', &
&                   Pqiinf_cas(icas_Jsimple)
          write(*,*) 'Pxtiinf_cas(iso_eau,icas_Jsimple)=', &
&                   Pxtiinf_cas(iso_eau,icas_Jsimple)
          stop
     endif
     !Pxtiinf=Pqiinf
     if ((iso_verif_egalite_choix_nostop( &
&            (Exi(iso_eau,il)), &
&            (Eqi(il)),'stewart_explicite 778', &
&            errmax*800,errmaxrel*800).eq.1).or. &
&            (iso_verif_egalite_choix_nostop( &
&            (Exi(iso_eau,il)*fac_ftmr(il)), &
&            (Eqi(il)*fac_ftmr(il)), &
&           'stewart_explicite 587', &
&            errmax*3000,errmaxrel*800).eq.1)) then  
          write(*,*) 'il,icas_Jsimple=',il,icas_Jsimple
          write(*,*) 'g**(1-beta*gama)=', &
&                   g(il)**(1-beta(iso_eau,il)*gama(iso_eau,il))
          write(*,*) 'Eqi,Exi,fac_ftmr=', &
&                   Eqi(il),Exi(iso_eau,il),fac_ftmr(il)
          stop
     endif

     ! le 6 dec 2011: on relache ridicule en ridicule*2
     if (Pqiinf(il).gt.ridicule*2) then
       if (iso_verif_egalite_choix_nostop &
&           ((Pxtiinf(iso_eau,il)/Pqiinf(il)),1., &
&           'stewart_explicite 716', &
&            errmax*10,errmaxrel*50).eq.1) then
         write(*,*) 'il=',il
         write(*,*) 'Pqiinf,Pxtiinf=', &
&                 Pqiinf(il),Pxtiinf(iso_eau,il)
         write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
         write(*,*) 'f,h(il)=',f(il),h(il)
         write(*,*) 'Eqi(il)*fac_ftmr(il)/qp0(il)=', &
&                 Eqi(il)*fac_ftmr(il)/qp0(il)        
         write(*,*) 'g(il)=',g(il)           
         stop
       endif !if (iso_verif_egalite_choix_nostop
     endif !if (Pqiinf.gt.ridicule) then
     
     if (iso_verif_egalite_choix_nostop( &
&                   (xtnew(iso_eau,il)), &
&                   (qp0(il)+Eqi(il)*fac_ftmr(il)), &
&                   'stewart_explicite 732',errmax*10,errmaxrel*50) &
&                           .eq.1) then
                write(*,*) 'icas_Jsimple,il,trace(il)=', &
&                    icas_Jsimple,il,trace(il) 
                write(*,*) 'xtnew_cas(iso_eau,icas_Jsimple)=', &
&                   xtnew_cas(iso_eau,icas_Jsimple)
                write(*,*) 'xtnew(iso_eau,il)=', &
&                           xtnew(iso_eau,il)
                write(*,*) 'qp0(il)=',qp0(il)
                write(*,*) 'qp0_cas(icas_Jsimple)=', &
&                           qp0(icas_Jsimple)
                write(*,*) 'Eqi(il)=',Eqi(il)
                write(*,*) 'Eqi_cas(icas_Jsimple)=', &
&                           Eqi(icas_Jsimple)
                write(*,*) 'fac_ftmr(il)=',fac_ftmr(il)
                write(*,*) 'fac_ftmr_cas(icas_Jsimple)=', &
&                           fac_ftmr_cas(icas_Jsimple)
                stop
     endif
     ! pour meilleure convergence numérique:
     if (bidouille_anti_divergence) then
         Exi(iso_eau,il)=Eqi(il)
         xtnew(iso_eau,il)=qp0(il)+Eqi(il)*fac_ftmr(il)
         Pxtiinf(iso_eau,il)=Pqiinf(il)
     endif   

   endif   ! if if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) the       

   if (iso_HDO.gt.0) then
    if (Pqiinf(il).gt.ridicule_rain) then
      if (iso_verif_aberrant_choix_nostop(Pxtiinf(iso_HDO,il),Pqiinf(il),ridicule_rain,deltalim_snow, &
&                   'stewart_explicite 871').eq.1)  then
      write(*,*) 'deltaDl0=',deltaD( &
&           (Rl0(iso_HDO,il)))
        write(*,*) 'deltaDb0=',deltaD( &
&           (Rb0(iso_HDO,il)))
        stop
      endif  !if (iso_verif_aberrant_nostop(
     endif !if (Pqiinf(il).gt.ridicule_rain) then
     if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
         call iso_verif_aberrant(( &
&               xtnew(iso_HDO,il)/(qp0(il)+Eqi(il) &
&               *fac_ftmr(il))),'stewart_explicite 1461')
     endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
    endif !if (iso_HDO.gt.0)

    if ((debug.eq.1).and.(il.eq.il_debug).and.(Eqi(il).gt.0.)) then
          write(*,*) 'stewart_explicit 1558: cas avec calcul J'
          write(*,*) 'Eqi(il),deltaD=',Eqi(il), &
&                   deltaD((Exi(iso_HDO,il)/Eqi(il)))
          if (icas_Jsimple.le.ncas_Jsimple) then
               write(*,*) 'calcul J par simple'
          else
               write(*,*) 'calcul J par Rieman'
          endif
          write(*,*) 'stewart_explict 1051: h(il)=',h(il)
          write(*,*) 'f(il)=',f(il)
          write(*,*) 'Eqi(il)*fac_ftmr(il)/qp0(il)=', &
&              Eqi(il)*fac_ftmr(il)/qp0(il)
          write(*,*) 'Pqisup,deltaD=',Pqisup(il),deltaD( &
&             (Pxtisup(iso_HDO,il)/Pqisup(il)))
          write(*,*) 'qp0,deltaD=',qp0(il),deltaD( &
&             (xtp0(iso_HDO,il)/qp0(il)))
          write(*,*) 'f_cas(icas)=',f_cas(icas_Jsimple)
          write(*,*) 'g_cas(icas)=',g_cas(icas_Jsimple)
          write(*,*) 'beta_cas(icas)=', &
&                   beta_cas(iso_HDO,icas_Jsimple)
          write(*,*) 'gama_cas(icas)=', &
&                   gama_cas(iso_HDO,icas_Jsimple)
          write(*,*) 'r_jqp0(icas)=', &
&                   r_jqp0(iso_HDO,icas_Jsimple)
          write(*,*) 'r_jl0(icas)=',r_jl0(iso_HDO,icas_Jsimple)
          write(*,*) 'r_l0qp0(icas)=', &
&                   r_l0qp0_cas(icas_Jsimple)
          write(*,*) 'J(icas)=',J(iso_HDO,icas_Jsimple)
          write(*,*) 'deltaDl0(icas)=',deltaD &
&                 ((Rl0_cas(iso_HDO,icas_Jsimple)))
          write(*,*) 'deltaDb0(icas)=',deltaD &
&                 ((Rb0_cas(iso_HDO,icas_Jsimple)))
          write(*,*) 'deltaDl(icas)=',deltaD &
&                 ((Rl(iso_HDO,icas_Jsimple)))
          write(*,*) 'deltaDb(icas)=',deltaD &
&                 ((Rb(iso_HDO,icas_Jsimple)))
          write(*,*) 'Pqiinf_cas(icas)=', &
&                   Pqiinf_cas(icas_Jsimple)
          write(*,*) 'Eqi_cas(icas)=',Eqi_cas(icas_Jsimple)
          write(*,*) 'qp0_cas(icas)=',qp0_cas(icas_Jsimple)
          write(*,*) 'fac_ftmr_cas(icas)=', &
&                   fac_ftmr_cas(icas_Jsimple)
    endif !if ((debug.eq.1).and.(il.eq.il_debug)) then

    enddo !do il=1,ncas_Jsimple+ncas_rieman    
#endif  
endif !if (ncas_rieman+ncas_Jsimple.gt.0) then 

#ifdef ISOVERIF
          write(*,*) 'stewart_explicite vectall 1179: fin'
#endif         

end subroutine stewart_explicite_vectall
        
subroutine stewart_glace_vectall(ncas,q,xt,Pqisup &
&           ,Pxtisup,Eqi,Pqiinf &
&          ,Pxtiinf,xtnew,Exi,fac_ftmr, &
&           Tevap) 

  USE isotopes_mod, ONLY: iso_eau, iso_HDO,bidouille_anti_divergence, &
&       ridicule,ridicule_rain
#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel
USE isotopes_verif_mod
#endif
implicit none

! idem que stewart_loop, mais pour la rrévap de la glace.
! On n'applique donc pas la formule de stewart, on applique
! juste le bilan de masse et une réévap sans effets cinétaiques

  ! declaration des variables      
! **inputs
integer ncas
real q(ncas),xt(niso,ncas)
real Pxtisup(niso,ncas)
real Pqisup(ncas)
real Eqi(ncas),Pqiinf(ncas)
real fac_ftmr(ncas)       
real Tevap(ncas)    

       ! **outputs
real xtnew(niso,ncas)
real Pxtiinf(niso,ncas)
real Exi(niso,ncas)

! **locals
real zxtalphai(niso,ncas)
real f(ncas)
integer ixt,il        

!        write(*,*) 'sttewart_glace 39: entrée'


! quelques verifs de bilan d'eau
#ifdef ISOVERIF
do il=1,ncas
  call iso_verif_egalite( &
&           (Pqisup(il)-Eqi(il)-Pqiinf(il)),0.0, &
&           'stewart_glace 37')
  if (iso_eau.gt.0) then
      call iso_verif_egalite((Pqisup(il)), &
&           (Pxtisup(iso_eau,il)),'stewart_loop 52')
      call iso_verif_egalite((xt(iso_eau,il)), &
&           (q(il)),'stewart_loop 58')
  endif !if  ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
enddo !do il=1,ncas
#endif
! fin des verifs

! ***************** début des calculs **********
do il=1,ncas
! traitement rapide de quelques cas particuliers:
if (Pqisup(il).eq.0) then
    ! pas de pluie, pas de Pqiinf, pas de changement de vap
    ! cam verif
#ifdef ISOVERIF
    if ((abs(Pqiinf(il)).gt.ridicule) &
&            .or.(abs(Eqi(il)).gt.ridicule)) then
        write(*,*) 'stewart_loop 39'
        write(*,*) 'Pqisup=',Pqisup(il)
        write(*,*) 'Eqi=',Eqi(il)
        write(*,*) 'Pqiinf=',Pqiinf(il)
        stop
    endif  
#endif    
    ! end cam verif
    do ixt=1,niso
      xtnew(ixt,il)=xt(ixt,il)
      Pxtiinf(ixt,il)=0.0
      Exi(ixt,il)=0.0
    enddo !do ixt=1,niso
else !if (Pqisup(il).eq.0) then

! calcul du coeff de fractionnement
do ixt=1,niso
  call fractcalk_glace(ixt,Tevap(il),zxtalphai(ixt,il))
enddo

! calcul de f=la fraction résiduelle
f(il)=Pqiinf(il)/Pqisup(il)

! calcul de Pxtiinf et Exi
! séparation en 2 cas pour une meilleure convergence numérique        
if (f(il).lt.0.9) then
 do ixt=1,niso   
    Pxtiinf(ixt,il)=Pxtisup(ixt,il)*Pqiinf(il)*zxtalphai(ixt,il) &
&           /(Eqi(il)+Pqiinf(il)*zxtalphai(ixt,il))
    Exi(ixt,il)=Pxtisup(ixt,il)-Pxtiinf(ixt,il)
 enddo !do ixt=1,niso  
else
 do ixt=1,niso     
    Exi(ixt,il)=Eqi(il)*Pxtisup(ixt,il) &
&           /(Eqi(il)+Pqiinf(il)*zxtalphai(ixt,il))
    Pxtiinf(ixt,il)=Pxtisup(ixt,il)-Exi(ixt,il)
 enddo !do ixt=1,niso
endif !if (f.lt.0.9) then

! verif
#ifdef ISOVERIF
do ixt=1,niso
    call iso_verif_noNAN((Exi(ixt,il)), &
&           'stewart_glace 102')
    call iso_verif_noNAN((Pxtiinf(ixt,il)), &
&           'stewart_glace 111')
 enddo !do ixt=1,niso   
 if (iso_eau.gt.0) then
   call iso_verif_egalite((Exi(iso_eau,il)), &
&                   (Eqi(il)),'stewart_glace 101')
   call iso_verif_egalite((Pxtiinf(iso_eau,il)), &
&           (Pqiinf(il)),'stewart_glace 110')
 endif !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
#endif
if ((bidouille_anti_divergence).and. &
&            (iso_eau.gt.0)) then
  ! assurer la convergence numérique pour ixt=4:
  Exi(iso_eau,il)=Eqi(il)
  Pxtiinf(iso_eau,il)=Pqiinf(il)
 endif !if ((bidouille_anti_divergence).and.(iso_eau.gt.0)
  

! calcul de xtnew
do ixt=1,niso
  xtnew(ixt,il)=xt(ixt,il)+Exi(ixt,il)*fac_ftmr(il)
  xtnew(ixt,il)=max(0.0,xtnew(ixt,il))
enddo

! verif
#ifdef ISOVERIF
do ixt=1,niso
  call iso_verif_noNaN((xtnew(ixt,il)), &
&           'stewart_glace 140')
enddo !do ixt=1,niso  
  if ((iso_HDO.gt.0).and. &
&            (Pqisup(il).gt.ridicule_rain)) then
    call iso_verif_aberrant(( &
&           Pxtiinf(iso_HDO,il)/Pqiinf(il)),'stewart_glace 175')  
  endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) then
#endif
! end verif
endif !if (Pqisup(il).eq.0) then
enddo !do il=1,ncas

! ************ fin des calculs ***************

!        write(*,*) 'sttewart_glace 155: sortie'
end subroutine stewart_glace_vectall

!        subroutine stewart_glace_vectiso -> supprimée, pas utilisée nullepart

subroutine stewart_sublim_nofrac_vectall(ncas,q &
&           ,xt,Pqisup,Pxtisup &
&           ,Eqi,Pqiinf &
&           ,Pxtiinf,xtnew,Exi &
&           ,fac_ftmr)

  USE isotopes_mod, ONLY: iso_eau, iso_HDO,bidouille_anti_divergence, &
&       Rdefault,ridicule,ridicule_rain
#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel
USE isotopes_verif_mod
#endif
implicit none

! rrévap de la glace.
! on suppose que pas de ractionnement lors de la sublimation de
! la glace

  ! declaration des variables      
! **inputs
integer ncas
real q(ncas),xt(niso,ncas)
real Pxtisup(niso,ncas)
real Pqisup(ncas)
real Eqi(ncas),Pqiinf(ncas)
real fac_ftmr(ncas)      

       ! **outputs
real xtnew(niso,ncas)
real Pxtiinf(niso,ncas)
real Exi(niso,ncas)

! **locals
integer il
!real  ! debuggage
real Rb0(niso,ncas)
real real_to_double
integer ixt
!#ifdef ISOVERIF
!integer iso_verif_egalite_nostop
!integer iso_verif_egalite_choix_nostop
!#endif        

!        write(*,*) 'sttewart_glace 39: entrée'

! quelques verifs de bilan d'eau
#ifdef ISOVERIF
do il=1,ncas
if (iso_verif_egalite_nostop(( &
&           Pqisup(il)-Eqi(il)-Pqiinf(il)),0.0, &
&           'stewart_sublim_nofrac 37').eq.1) then
  write(*,*) 'il,Pqisup(il),Eqi(il),Pqiinf(il)=', &
&          il,Pqisup(il),Eqi(il),Pqiinf(il)         
  stop
endif
if (iso_eau.gt.0) then
   call iso_verif_egalite((Pqisup(il)), &
&           (Pxtisup(iso_eau,il)), &
&           'stewart_sublim_nofrac 38') 
   call iso_verif_egalite((xt(iso_eau,il)), &
&           (q(il)), &
&           'stewart_sublim_nofrac 39')              
endif !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
if (iso_HDO.gt.0) then ! Camille 9 mars 2023: moins stricte pour condensat
    call iso_verif_aberrant_choix(Pxtisup(iso_HDO,il),Pqisup(il), &
&           ridicule_rain,deltalim_snow, 'stewart_sublim_nofrac 40') 
endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO).and.
enddo !do il=1,ncas
#endif
! fin des verifs

! ***************** début des calculs **********

do il=1,ncas
! traitement rapide de quelques cas particuliers:
if (Pqisup(il).le.0) then
    ! pas de pluie, pas de Pqiinf, pas de changement de vap
    ! cam verif
#ifdef ISOVERIF
     if ((abs(Pqiinf(il)).gt.ridicule) &
&            .or.(abs(Eqi(il)).gt.ridicule)) then
        write(*,*) 'stewart_sublim 57'
        write(*,*) 'Pqisup=',Pqisup(il)
        write(*,*) 'Eqi=',Eqi(il)
        write(*,*) 'Pqiinf=',Pqiinf(il)
        stop
     endif   
#endif     
    ! end cam verif 
    do ixt=1,niso               
      Pxtiinf(ixt,il)=0.0
    enddo
    if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) then
        Pxtiinf(iso_eau,il)=Pqiinf(il)
    endif
    if (abs(Eqi(il)*fac_ftmr(il)).gt.ridicule) then
        ! attention: pour des raisons obscures, il y a parfois
        ! de le réévaporation significative alors qu'il n'y a
        ! aucun cristal à réévaporer.
        ! Dans ce cas, on admet cette réévaporation obscure et
        ! on suppose qu'elle ne change pas la composition
        ! isotopique de la vapeur. 
        if (q(il).gt.ridicule) then
           do ixt=1,niso
             Rb0(ixt,il)=xt(ixt,il)/q(il)
                   enddo
                else !if (qp0.gt.ridicule) then
                   ! il n'y a pas encore de vapeur dans le ddft. On est
                   ! très embétté, mais on se dit que le ddft sera
                   ! bientot rechargé par de la vapeur plus légitime
                   do ixt=1,niso
                     Rb0(ixt,il)=0.0                        
                   enddo !do ixt=1,niso  
                   if (iso_eau.gt.0) then
                        Rb0(iso_eau,il)=1.0 
                   endif      
                endif   !if (qp0.gt.ridicule) then
                do ixt=1,niso
                  Exi(ixt,il)=Rb0(ixt,il)*Eqi(il)
                  xtnew(ixt,il)=xt(ixt,il)+Exi(ixt,il)*fac_ftmr(il)
                enddo !do ixt=1,niso
            else !if (abs(Eqi*fac_ftmr).gt.ridicule) then
                ! ça va, tout est logique, tous les flux d'eau sont nuls
                do ixt=1,niso
                  xtnew(ixt,il)=xt(ixt,il)
                  Exi(ixt,il)=0.0
                enddo !do ixt=1,niso
            endif !if (abs(Eqi*fac_ftmr).gt.ridicule) then
#ifdef ISOVERIF
              if (iso_eau.gt.0) then
                call iso_verif_egalite_choix( &
     &             (Exi(iso_eau,il)*fac_ftmr(il)), &
     &             (Eqi(il)*fac_ftmr(il)), &
     &             'stewart_sublim_nofrac 125',errmax*10,errmaxrel*10)
                call iso_verif_egalite_choix( &
     &           (Pxtiinf(iso_eau,il)), &
     &               (Pqiinf(il)), &
     &              'stewart_sublim_nofrac 143',errmax,errmaxrel)
                call iso_verif_egalite_choix( &
     &              (xtnew(iso_eau,il)), &
     &              (q(il)+Eqi(il)*fac_ftmr(il)), &
     &              'stewart_sublim_nofrac 218',errmax*10,errmaxrel*50)
               endif
#endif
        else !if (Pqisup(il).le.0) then

        ! dorénavant, Pqisup est différenent de 0
        

        ! calcul de Pxtiinf et Exi; pas de fractionnement
        do ixt=1,niso
            Pxtiinf(ixt,il)=Pxtisup(ixt,il)/Pqisup(il)*Pqiinf(il)
            Exi(ixt,il)=Pxtisup(ixt,il)/Pqisup(il)*Eqi(il)
        enddo ! do ixt=1,niso    

        ! verif
#ifdef ISOVERIF
        do ixt=1,niso
          call iso_verif_noNAN((Exi(ixt,il)), &
     &           'stewart_sublim 102')
          call iso_verif_noNAN((Pxtiinf(ixt,il)), &
     &           'stewart_sublim 102')
        enddo !do ixt=1,niso
          if (iso_eau.gt.0) then
           call iso_verif_egalite_choix((Exi(iso_eau,il)), &
     &                   (Eqi(il)), &
     &           'stewart_sublim 101',errmax*1e-2,errmaxrel*1e-2) 
           call iso_verif_egalite((Pxtiinf(iso_eau,il)), &
     &           (Pqiinf(il)),'stewart_sublim 110')
          endif !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
#endif

         if ((bidouille_anti_divergence).and. &
     &           (iso_eau.gt.0)) then
          ! assurer la convergence numérique pour ixt=4:
          Exi(iso_eau,il)=Eqi(il)          
          Pxtiinf(iso_eau,il)=Pqiinf(il)
        endif !if  if ((bidouille_anti_divergence).and.(iso_eau.gt.0)
        
        ! calcul de xtnew

        do ixt=1,niso
          xtnew(ixt,il)=xt(ixt,il)+Exi(ixt,il)*fac_ftmr(il)
          xtnew(ixt,il)=max(0.0,xtnew(ixt,il))
        enddo !do ixt=1,niso

        ! verif
#ifdef ISOVERIF
        do ixt=1,niso
          call iso_verif_noNAN( &
     &           (xtnew(ixt,il)),'stewart_sublim 140')
        enddo ! do ixt=1,niso
        ! verif que deltaD(Pqiinf) raisonable
        if (iso_HDO.gt.0) then
            call iso_verif_aberrant_choix(Pxtiinf(iso_HDO,il),Pqiinf(il), &
     &           ridicule_rain,deltalim_snow, 'stewart_sublim 175')
        endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO).and.
        if (iso_eau.gt.0) then
            if (q(il)+Eqi(il)*fac_ftmr(il).ge.0.0) then
            if (iso_verif_egalite_choix_nostop( &
     &                  (xtnew(iso_eau,il)), &
     &                  (q(il)+Eqi(il)*fac_ftmr(il)), &
     &                  'stewart_sublim 108', &
     &                  errmax,errmaxrel).eq.1) then
              write(*,*) 'q(il)=',q(il)
              write(*,*) 'Eqi(il)=',Eqi(il)
              write(*,*) 'fac_ftmr(il)=',fac_ftmr(il)
              stop
            endif !if (iso_verif_egalite_choix_nostop
            endif !if (q(il)+Eqi(il)*fac_ftmr(il).ge.0.0) then
            if (iso_verif_egalite_choix_nostop( &
     &                  (Pxtiinf(iso_eau,il)), &
     &                  (Pqiinf(il)),'stewart_sublim 204', &
     &                  errmax,errmaxrel).eq.1) then
              write(*,*) 'Pqisup(il)=',Pqisup(il)
              stop
            endif !if (iso_verif_egalite_choix_nostop
        endif !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
#endif
        ! end verif
        endif ! if pqisup.gt.0
        enddo ! do il=1,ncas

        ! en verif
        
        ! ************ fin des calculs ***************

!        write(*,*) 'sttewart_sublim 155: sortie'
        end subroutine stewart_sublim_nofrac_vectall


      subroutine compress_calculJ(ncas,ncas_Rieman,ncas_Jsimple, &
     &           cas_rieman,cas_Jsimple, & 
     &           m_cas,m, m0_cas,m0,  &
     &           qp0_cas,qp0, A_cas,A, &
     &           xtp0_cas,xtp0,    &
     &           beta_cas,beta,gama_cas,gama, &
!     &           f_cas,f, g_cas,g,ntot_cas,h,
     &           f_cas,f, g_cas,g,h, &
     &           Rb0_cas,Rb0, &
     &           Rl0_cas,Rl0, &
     &           r_l0qp0_cas,r_l0qp0, &
     &           Eqi_cas,Eqi, &
     &           fac_ftmr_cas,fac_ftmr, &
     &           Pxtisup_cas,Pxtisup, &
     &           Pqiinf_cas,Pqiinf)

  USE isotopes_mod, ONLY: iso_eau, iso_HDO

#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel
USE isotopes_verif_mod
#endif
         implicit none

         ! compression des variables en tableaux spécifiques pour le
         ! calcul d'intégral soit simple, soit par Rieman.
  
         integer ncas ! dimension officielle des variables
         integer ncas_rieman,ncas_Jsimple ! nombre de variables à compresser
         integer cas_rieman(ncas),cas_Jsimple(ncas) ! tableaux d'index
         real m_cas(ncas),m(ncas), &
     & m0_cas(ncas),m0(ncas), &
     & qp0_cas(ncas),qp0(ncas), &
     & xtp0_cas(niso,ncas),xtp0(niso,ncas),  &   
     & A_cas(ncas),A(ncas), &
     & beta_cas(niso,ncas),beta(niso,ncas), &
     & gama_cas(niso,ncas),gama(niso,ncas), &
     & f_cas(ncas),f(ncas), &
     & g_cas(ncas),g(ncas), &
     & Rb0_cas(niso,ncas),Rb0(niso,ncas), &
     & Rl0_cas(niso,ncas),Rl0(niso,ncas), &
     & r_l0qp0_cas(ncas),r_l0qp0(ncas), &
     & Eqi_cas(ncas),Eqi(ncas), &
     & Pxtisup_cas(niso,ncas),Pxtisup(niso,ncas), &
     & Pqiinf_cas(ncas),Pqiinf(ncas), &
     & fac_ftmr_cas(ncas),fac_ftmr(ncas)
         real h(ncas)
!         integer ntot_cas(ncas)
         integer il,ixt        


         ! méthode de calcul d'intégrale
         ! si rieman:
!#define rieman
        ! sinon: méthode de gauss         

!#ifdef ISOVERIF         
!        real       
!#endif         

#ifdef ISOVERIF
!         write(*,*) 'compress_stewart 45: entrée compress_calculJ'
!         write(*,*) 'ncas_Jsimple=',ncas_Jsimple
#endif      
        if (ncas_Jsimple.gt.0) then   
         do il=1,ncas_Jsimple
!           write(*,*) 'compress_stewart 50: il=',il
           m0_cas(il)=m0(cas_Jsimple(il))
!           write(*,*) 'compress_stewart 51: il=',il
           m_cas(il)=m(cas_Jsimple(il))
           qp0_cas(il)=qp0(cas_Jsimple(il))
!           write(*,*) 'compress_stewart 54: il=',il
           A_cas(il)=A(cas_Jsimple(il))                     
           f_cas(il)=f(cas_Jsimple(il))
#ifdef ISOVERIF           
           call iso_verif_egalite_choix((f_cas(il)), &
     &          (m_cas(il)/m0_cas(il)), &
     &          'compress_stewart 66',errmax,errmaxrel)
#endif           
!           write(*,*) 'compress_stewart 56: il=',il
           g_cas(il)=g(cas_Jsimple(il))
           r_l0qp0_cas(il)=r_l0qp0(cas_Jsimple(il))
           Eqi_cas(il)=Eqi(cas_Jsimple(il))
!           write(*,*) 'compress_stewart 60: il=',il
           fac_ftmr_cas(il)=fac_ftmr(cas_Jsimple(il))
           Pqiinf_cas(il)=Pqiinf(cas_Jsimple(il))
!           write(*,*) 'compress_stewart 61: il=',il
           do ixt=1,niso
!             write(*,*) 'il,ixt=',il,ixt
             xtp0_cas(ixt,il)=xtp0(ixt,cas_Jsimple(il))
             beta_cas(ixt,il)=beta(ixt,cas_Jsimple(il))
             gama_cas(ixt,il)=gama(ixt,cas_Jsimple(il))
             Rb0_cas(ixt,il)=Rb0(ixt,cas_Jsimple(il))
             Rl0_cas(ixt,il)=Rl0(ixt,cas_Jsimple(il))
             Pxtisup_cas(ixt,il)=Pxtisup(ixt,cas_Jsimple(il))
           enddo !do ixt=1,niso
         enddo !do il=1,ncas_Jsimple
        endif !if (ncas_Jsimple.gt.0) then   

        if (ncas_rieman.gt.0) then 
         do il=1,ncas_rieman
           m0_cas(il+ncas_Jsimple)=m0(cas_rieman(il))
           m_cas(il+ncas_Jsimple)=m(cas_rieman(il))
           qp0_cas(il+ncas_Jsimple)=qp0(cas_rieman(il))
           A_cas(il+ncas_Jsimple)=A(cas_rieman(il))          
           f_cas(il+ncas_Jsimple)=f(cas_rieman(il))
           r_l0qp0_cas(il+ncas_Jsimple)=r_l0qp0(cas_rieman(il))
#ifdef ISOVERIF          
           call iso_verif_egalite_choix( &
     &         (f_cas(il+ncas_Jsimple)), &
     &         (m_cas(il+ncas_Jsimple) &
     &         /m0_cas(il+ncas_Jsimple)),'compress_stewart 66', &
     &         errmax,errmaxrel)
#endif           

           g_cas(il+ncas_Jsimple)=g(cas_rieman(il))
           Eqi_cas(il+ncas_Jsimple)=Eqi(cas_rieman(il))
           fac_ftmr_cas(il+ncas_Jsimple)=fac_ftmr(cas_rieman(il))
           Pqiinf_cas(il+ncas_Jsimple)=Pqiinf(cas_rieman(il))
           do ixt=1,niso
             xtp0_cas(ixt,il+ncas_Jsimple)=xtp0(ixt,cas_rieman(il))
             beta_cas(ixt,il+ncas_Jsimple)=beta(ixt,cas_rieman(il))
             gama_cas(ixt,il+ncas_Jsimple)=gama(ixt,cas_rieman(il))
             Rb0_cas(ixt,il+ncas_Jsimple)=Rb0(ixt,cas_rieman(il))
             Rl0_cas(ixt,il+ncas_Jsimple)=Rl0(ixt,cas_rieman(il))
             Pxtisup_cas(ixt,il+ncas_Jsimple)= &
     &           Pxtisup(ixt,cas_rieman(il))
           enddo !do ixt=1,niso
!#ifdef rieman           
!           ntot_cas(il+ncas_Jsimple)=10
!     :           +int((1-0.5*f(cas_rieman(il)))
!     :           *0.02*(exp(2*h(cas_rieman(il))))**6)
!#else
!           ntot_cas(il+ncas_Jsimple)=300
!     :         +35*(1-f(cas_rieman(il)))**3
!     :         +2.1e4*(h(cas_rieman(il))-0.9)**3
!     :         +2.5e5*((1-f(cas_rieman(il)))**6)
!     :                   *((h(cas_rieman(il))-0.9)**3)

!#endif     
!#ifdef ISOVERIF           
!!           write(*,*) ' f,h,ntot_cas=',f(cas_rieman(il)),
!!     :           h(cas_rieman(il)),ntot_cas(il+ncas_Jsimple)     
!           call iso_verif_positif(float(ntot_cas(il+ncas_Jsimple))-1.0,
!     :           'compress_stewart 136: ntot faux')
!#endif           
         enddo !do il=1,ncas_rieman
       endif !if (ncas_rieman.gt.0) then 
                
#ifdef ISOVERIF
        ! vérif de la compression:
        do il=1,ncas_Jsimple
          call iso_verif_egalite_choix( &
     &           (Pqiinf_cas(il)), &
     &           (Pqiinf(cas_Jsimple(il))), &
     &           'compress_stewart 111',errmax,errmaxrel)
        enddo !do icas_Jsimple=1,ncas_Jsimple
        
        do il=1,ncas_rieman
          call iso_verif_egalite_choix( &
     &           (Pqiinf_cas(ncas_Jsimple+il)), &
     &           (Pqiinf(cas_rieman(il))), &
     &           'compress_stewart  117',errmax,errmaxrel)
        enddo !do icas_Jsimple=1,ncas_Jsimple
!       write(*,*) 'compress_stewart 91: fin compress_calculJ'   
#endif  
       
         end subroutine compress_calculJ

         !*******************

         subroutine uncompress_calculJ(ncas,ncas_rieman,ncas_Jsimple, &
     &          cas_rieman,cas_Jsimple,Exi_cas,Exi, &
     &           xtnew_cas,xtnew,Pxtiinf_cas,Pxtiinf)

  USE isotopes_mod, ONLY: iso_eau, iso_HDO
#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel
USE isotopes_verif_mod
#endif
         implicit none 

         ! des compressions des cas de calcul de J dans stewart_explicit
         integer ncas,ncas_rieman,ncas_Jsimple
         integer cas_rieman(ncas),cas_Jsimple(ncas)
         real Exi_cas(niso,ncas),Exi(niso,ncas), &
     &       xtnew_cas(niso,ncas),xtnew(niso,ncas), &
     &       Pxtiinf_cas(niso,ncas),Pxtiinf(niso,ncas)
         integer il,ixt


         do il=1,ncas_Jsimple
          do ixt=1,niso
           Exi(ixt,cas_Jsimple(il))=Exi_cas(ixt,il)
           xtnew(ixt,cas_Jsimple(il))=xtnew_cas(ixt,il)
           Pxtiinf(ixt,cas_Jsimple(il))=Pxtiinf_cas(ixt,il)
          enddo
         enddo

         do il=1,ncas_rieman
          do ixt=1,niso
           Exi(ixt,cas_rieman(il))=Exi_cas(ixt,il+ncas_Jsimple)
           xtnew(ixt,cas_rieman(il))=xtnew_cas(ixt,il+ncas_Jsimple)
           Pxtiinf(ixt,cas_rieman(il))=Pxtiinf_cas(ixt,il+ncas_Jsimple)
          enddo
         enddo

         end subroutine uncompress_calculJ

         ! ****************


         subroutine uncompress_commun(ncas, cas, &
     &   xtp_cas,xtp,xtwater_cas,xtwater,xtevap_cas,xtevap, &
#ifdef ISOVERIF
     &           Exi_cas,Exi,   & 
#endif
     &           ncum)

  USE isotopes_mod, ONLY: iso_eau, iso_HDO

#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel
USE isotopes_verif_mod
#endif
         implicit none 

         ! decompression des outputs communs à tous les cas dans
         ! appel_stewart

         integer ncas,ncum
         integer cas(ncum)
         real xtevap_cas(niso,ncum)
         real xtp_cas(niso,ncum)
         real xtwater_cas(niso,ncum)

         ! outputs
         real xtwater(ntraciso,ncum)
         real xtp(ntraciso,ncum)
         real xtevap(ntraciso,ncum)

         ! locals
         integer il,ixt
#ifdef ISOVERIF
         real Exi_cas(niso,ncum)
         real Exi(ntraciso,ncum)
#endif         


         do il=1,ncas
          do ixt=1,niso
           xtevap(ixt,cas(il))=xtevap_cas(ixt,il)
           xtp(ixt,cas(il))=xtp_cas(ixt,il)
           xtwater(ixt,cas(il))=xtwater_cas(ixt,il)
#ifdef ISOVERIF
           Exi(ixt,cas(il))=Exi_cas(ixt,il)
#endif           
          enddo
         enddo

         end subroutine uncompress_commun


         !**************

         subroutine compress_cond_facftmr( &
     &    ncas,  cas, &
     &    Eqi_prime_cas,Eqi_prime, &
     &    Pqisup_cas,Pqisup,  &
     &    Pxtisup_cas,Pxtisup,   &
     &    T_cas,T, & 
     &    fac_ftmr_cas,fac_ftmr,  &
     &    qp_avantevap_cas,qp_avantevap, &
     &    xtp_avantevap_cas,xtp_avantevap,  &
     &    xtevapsup_cas,xtevap, &
     &    water_cas,water, &
     &    delP_cas,Ph, &
     &    sigd_cas,sigd, &
#ifdef ISOVERIF        
     &    evap_cas,evap,qp_cas,qp,    &
#endif           
     &    nloc,ncum,nd,i)

  USE isotopes_mod, ONLY: iso_eau, iso_HDO

#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel
USE isotopes_verif_mod
#endif
         implicit none

         ! compression dans le cas condensation_facftmr
         integer nd,ncum,nloc
         integer ncas
         integer cas(ncum)
         integer i
         real T_cas(ncum),T(ncum), &
     &    xtevapsup_cas(niso,ncum),xtevap(ntraciso,ncum), &
     &    water_cas(ncum),water(ncum), &
     &    delP_cas(ncum),Ph(nloc,ND), &
     &    sigd_cas(ncum),sigd(ncum)
         real Eqi_prime_cas(ncum),Eqi_prime(ncum), &
     &    Pqisup_cas(ncum),Pqisup(ncum),  &
     &    Pxtisup_cas(niso,ncum),Pxtisup(ntraciso,ncum),  &
     &    qp_avantevap_cas(ncum),qp_avantevap(ncum), &
     &    xtp_avantevap_cas(niso,ncum),xtp_avantevap(ntraciso,ncum), &
     &    fac_ftmr_cas(ncum),fac_ftmr(ncum)
         real evap_cas(ncum),evap(ncum),qp_cas(ncum),qp(ncum)
         integer il,ixt

          do il=1,ncas
            Eqi_prime_cas(il)=Eqi_prime(cas(il))
            Pqisup_cas(il)=Pqisup(cas(il))
            T_cas(il)=T(cas(il))
            fac_ftmr_cas(il)=fac_ftmr(cas(il))
            qp_avantevap_cas(il)=qp_avantevap(cas(il))
            water_cas(il)=water(cas(il))
            delP_cas(il)=Ph(cas(il),i) &
     &         -Ph(cas(il),i+1)
            sigd_cas(il)=sigd(cas(il))
#ifdef ISOVERIF              
            evap_cas(il)=evap(cas(il))
            qp_cas(il)=qp(cas(il))
            if (iso_verif_positif_nostop(sigd_cas(il)-1e-3, &
      &         'compress_cond_facftmr 5215').eq.1) then
                write(*,*) 'il,cas(il),sigd_cas(il)=',il,cas(il),sigd_cas(il)
                CALL abort_physic('isotopes_routines_mod', 'compress_cond_facftmr 5215: sigd_cas<1e3', 1)
            endif !if (iso_verif_positif_nostop
#endif            
            do ixt=1,niso
              Pxtisup_cas(ixt,il)=Pxtisup(ixt,cas(il))
              xtp_avantevap_cas(ixt,il)=xtp_avantevap(ixt,cas(il))
              xtevapsup_cas(ixt,il)=xtevap(ixt,cas(il))
            enddo
          enddo !do il=1,ncas

         end subroutine compress_cond_facftmr

         ! **************

        subroutine compress_cond_nofftmr( &
     &    ncas,  cas, &
     &    Eqi_prime_cas,Eqi_prime, &
     &    Pqisup_cas,Pqisup,  &
     &    Pxtisup_cas,Pxtisup, &
     &    water_cas,water,   &
     &    T_cas,T,         &
     &    qp_avantevap_cas,qp_avantevap,& 
     &    xtp_avantevap_cas,xtp_avantevap,& 
     &    xt_cas,xt,q_cas,q,  &
     &    xtevapsup_cas,xtevap, &
     &    delP_cas,Ph, & 
     &    sigd_cas,sigd, &
#ifdef ISOVERIF
     &    evap_cas,evap,qp_cas,qp, &
#endif      
     &    nloc,ncum,nd,i)

  USE isotopes_mod, ONLY: iso_eau, iso_HDO

#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel
USE isotopes_verif_mod
#endif
         implicit none

         ! compression dans le cas condensation_facftmr
         integer nloc,nd,ncum
         integer ncas
         integer cas(ncum)
         integer i
         real T_cas(ncum),T(ncum),  &
     &    xt_cas(niso,ncum),q_cas(ncum),xt(ntraciso,ncum),q(ncum),  &
     &    xtevapsup_cas(niso,ncum),xtevap(ntraciso,ncum), &
     &    water_cas(ncum),water(ncum),      &     
     &    delP_cas(ncum),Ph(nloc,ND), &     
     &    sigd_cas(ncum), sigd(ncum)
         real Eqi_prime_cas(ncum),Eqi_prime(ncum), &
     &    Pqisup_cas(ncum),Pqisup(ncum),  &
     &    Pxtisup_cas(niso,ncum),Pxtisup(ntraciso,ncum), &
     &    qp_avantevap_cas(ncum),qp_avantevap(ncum), &
     &    xtp_avantevap_cas(niso,ncum),xtp_avantevap(ntraciso,ncum)
#ifdef ISOVERIF         
         real evap_cas(ncum),evap(ncum),qp_cas(ncum),qp(ncum)
#endif         
         integer il,ixt

          do il=1,ncas
            Eqi_prime_cas(il)=Eqi_prime(cas(il))
            Pqisup_cas(il)=Pqisup(cas(il))
            water_cas(il)=water(cas(il))
            T_cas(il)=T(cas(il))
            qp_avantevap_cas(il)=qp_avantevap(cas(il))
            q_cas(il)=q(cas(il))
            delP_cas(il)=Ph(cas(il),i) &
     &         -Ph(cas(il),i+1)
            sigd_cas(il)=sigd(cas(il))
#ifdef ISOVERIF
            qp_cas(il)=qp(cas(il))
            evap_cas(il)=evap(cas(il))
            if (iso_verif_positif_nostop(sigd_cas(il)-1e-3, &
      &         'compress_cond_nofftmr 5294').eq.1) then
                write(*,*) 'il,cas(il),sigd_cas(il)=',il,cas(il),sigd_cas(il)
                CALL abort_physic('isotopes_routines_mod', 'compress_cond_nofftmr 5294: sigd_cas<1e3', 1)
            endif !if (iso_verif_positif_nostop
#endif            
            do ixt=1,niso              
              Pxtisup_cas(ixt,il)=Pxtisup(ixt,cas(il))
              xtp_avantevap_cas(ixt,il)=xtp_avantevap(ixt,cas(il))
              xt_cas(ixt,il)=xt(ixt,cas(il))
              xtevapsup_cas(ixt,il)=xtevap(ixt,cas(il))
            enddo
          enddo 

         end subroutine compress_cond_nofftmr

         ! **************         

         subroutine compress_noevap( &
     &    ncas,  cas, &
     &    Pqisup_cas,Pqisup,  &
     &    Pxtisup_cas,Pxtisup,   &
     &    xtp_avantevap_cas,xtp_avantevap, &
     &    xtevapsup_cas,xtevap, &
     &    water_cas,water, &
     &    delP_cas,Ph,  &
#ifdef ISOVERIF        
     &    evap_cas,evap,qp_cas,qp, &
#endif 
     &    nloc,ncum,nd,i)

  USE isotopes_mod, ONLY: iso_eau, iso_HDO

#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel
USE isotopes_verif_mod
#endif
         implicit none

         ! compression dans le cas condensation_facftmr
         integer nloc,nd,ncum
         integer ncas
         integer cas(ncum)
         integer i
         real xtevapsup_cas(niso,ncum),xtevap(ntraciso,ncum), &
     &    water_cas(ncum),water(ncum), &
     &    delP_cas(ncum),Ph(nloc,ND)
         real Pqisup_cas(ncum),Pqisup(ncum),  &
     &    Pxtisup_cas(niso,ncum),Pxtisup(ntraciso,ncum),  & 
     &    xtp_avantevap_cas(niso,ncum),xtp_avantevap(ntraciso,ncum)
#ifdef ISOVERIF         
         real evap_cas(ncum),evap(ncum),qp_cas(ncum),qp(ncum)
#endif         
         integer il,ixt

          do il=1,ncas
            Pqisup_cas(il)=Pqisup(cas(il))
            water_cas(il)=water(cas(il))
            delP_cas(il)=Ph(cas(il),i) &
     &         -Ph(cas(il),i+1)
#ifdef ISOVERIF 
            evap_cas(il)=evap(cas(il))
            qp_cas(il)=qp(cas(il))        
#endif            
            do ixt=1,niso              
              Pxtisup_cas(ixt,il)=Pxtisup(ixt,cas(il))
              xtp_avantevap_cas(ixt,il)=xtp_avantevap(ixt,cas(il))
              xtevapsup_cas(ixt,il)=xtevap(ixt,cas(il))
            enddo
          enddo 

         end subroutine compress_noevap

         ! **************   

         subroutine compress_evap_liq(iflag_con, &
     &    ncas,  & 
     &    cas,  &
     &    Pqisup_cas,Pqisup,  &
     &    Pxtisup_cas,Pxtisup,   &
     &    qp_avantevap_cas,qp_avantevap,& 
     &    xtp_avantevap_cas,xtp_avantevap, &
     &    xtevapsup_cas,xtevap, &
     &    water_cas,water, &
     &    qs_cas,qs, &
     &    Eqi_stewart,Pqiinf_stewart,Eqi_prime_cas,& 
     &    Pqiinf,Eqi_par,Pqiinf_par,Eqi_prime,  &
     &    Eqi,Eqi_cas, & 
     &    fac_ftmr_cas,fac_ftmr, &
     &    T_cas,T, &
     &    wt_cas,wt, &
     &    INB_cas,INB,   &        
     &    delP_cas,Ph, &
     &    qp_cas,qp, &
     &    sigd_cas,sigd, &
#ifdef ISOVERIF         
     &    evap_cas,evap, &
#endif         
     &    nloc,ncum,nd,i)

  USE isotopes_mod, ONLY: iso_eau, iso_HDO,ridicule

#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel
USE isotopes_verif_mod
#endif
         implicit none

         ! compression dans le cas condensation_facftmr
        ! inputs et outputs  
         integer iflag_con   
         integer nloc,nd,ncum
         integer ncas
         integer cas(ncum)
         integer i
         real xtevapsup_cas(niso,ncum),xtevap(ntraciso,ncum), &
     &    water_cas(ncum),water(ncum), &
     &    qs_cas(ncum),qs(ncum), &
     &    T_cas(ncum),T(ncum), & 
     &    wt_cas(ncum),wt(ncum), &
     &    delP_cas(ncum),Ph(nloc,ND), &
     &    sigd_cas(ncum),sigd(ncum)
         real qp_cas(ncum),qp(ncum)
#ifdef ISOVERIF
         real evap_cas(ncum),evap(ncum)
!         real 
!         integer iso_verif_positif_nostop
#endif         
         real  &
     &    qp_avantevap_cas(ncum),qp_avantevap(ncum), &
     &    xtp_avantevap_cas(niso,ncum),xtp_avantevap(ntraciso,ncum), &
     &    Eqi_stewart(ncum),Pqiinf_stewart(ncum),Eqi_prime_cas(ncum), &
     &    Pqiinf(ncum),Eqi_par(ncum),Pqiinf_par(ncum), &
     &    Eqi_prime(ncum),Pqisup(ncum),Pqisup_cas(ncum), &
     &    Pxtisup(ntraciso,ncum),Pxtisup_cas(niso,ncum), &
     &    fac_ftmr_cas(ncum),fac_ftmr(ncum), &
     &    Eqi(ncum),Eqi_cas(ncum)
         integer INB_cas(ncum),INB(ncum)
         ! locals
         integer il,ixt

          do il=1,ncas
            Pqisup_cas(il)=Pqisup(cas(il))
            water_cas(il)=water(cas(il))
            qp_avantevap_cas(il)=qp_avantevap(cas(il))
            qs_cas(il)=qs(cas(il))
            Eqi_prime_cas(il)=Eqi_prime(cas(il))
            Eqi_cas(il)=Eqi(cas(il))
            fac_ftmr_cas(il)=fac_ftmr(cas(il))
            T_cas(il)=T(cas(il))
            qp_cas(il)=qp(cas(il))
            sigd_cas(il)=sigd(cas(il))
#ifdef ISOVERIF              
            evap_cas(il)=evap(cas(il))
#endif            
            wt_cas(il)=wt(cas(il))
            INB_cas(il)=INB(cas(il))
            delP_cas(il)=Ph(cas(il),i)-Ph(cas(il),i+1)
            do ixt=1,niso              
              Pxtisup_cas(ixt,il)=Pxtisup(ixt,cas(il))
              xtp_avantevap_cas(ixt,il)=xtp_avantevap(ixt,cas(il))
              xtevapsup_cas(ixt,il)=xtevap(ixt,cas(il))
            enddo !do ixt=1,niso  
          enddo 

          ! calculs des flux de masses à mettre en argument de stewart:
      ! comme l'eau n'est pas bien concervée dans les ddfts, on est
      ! obligé de bidouillé.
      ! 1) soit on considère Pqisup, Eqi, et Pqiinf_par=Pqisup-Eqi
      !    et on suppose que dans la réalité les compositions de
      !    Pqiinf sont les même que Pqiinf_par
      ! 2) soit on considère Pqisup, Eqi_par=Pqisup-Pqiinf, et Pqiinf,
      !    et on suppose que dans la réalité les compositions de
      !    Eqi_prime sont les même que Eqi_par
          do il=1,ncas
            if ((water(cas(il)).gt.ridicule/100).and. &
     &            (Pqiinf_par(cas(il)).le.0.0)) then
             ! on ne peut pas utiliser la méthode 1, car KE prédit de l'eau
             ! alors que le bilan de masse n'enprédit pas.
             ! Peut-on utiliser la méthode 2?
             Pqiinf_stewart(il)=Pqiinf(cas(il))
             Eqi_stewart(il)=Eqi_par(cas(il))
           else !if ((water(il,i).gt.ridicule/100).and.(Pqiinf_par.le.0.0)) then
             ! il n'y a pas d'obstacles à l'utilisation de 1)
             Pqiinf_stewart(il)=Pqiinf_par(cas(il))
             if (iflag_con.eq.30) then
                Eqi_stewart(il)=Eqi_prime(cas(il))
             else !if (iflag_con.eq.30) then
                if (Eqi(cas(il)).ge.0.0) then
                   Eqi_stewart(il)=Eqi(cas(il))
                else !if (Eqi(cas(il)).gt.0.0) then
                    ! cas ajouté le 7 dec 2012: si Eqi est négatif,
                    ! alors on plante dans compress_stewart 977b
                    ! Parfois, Eqi' est positif grace à Eqi+1 qui est
                    ! positif, mais Eqi est faiblement négatif (même si
                    ! très faible)
                   Eqi_stewart(il)=Eqi_prime(cas(il))
                endif !if (Eqi(cas(il)).gt.0.0) then
             endif !if (iflag_con.eq.30) then
           endif !if ((water(il,i).gt.ridicule/100).and.(Pqiinf_par.le.0.0)) then
         enddo !do il=1,ncas

         ! petite vérif
#ifdef ISOVERIF
         do il=1,ncas 
          if ((iso_verif_positif_nostop(( &
     &        Eqi_stewart(il)),'compress_stewart 977a').eq.1) &
     &        .or.(iso_verif_positif_nostop(( &
     &        Eqi_stewart(il))*fac_ftmr_cas(il), &
     &        'compress_stewart 977b').eq.1)) then
              write(*,*) 'Pqiinf=',Pqiinf(cas(il))
              write(*,*) 'Pqisup=',Pqisup(cas(il))
              write(*,*) 'Pqiinf_par=',Pqiinf_par(cas(il))
              write(*,*) 'Eqi=',Eqi(cas(il))
              write(*,*) 'Eqi_par=',Eqi_par(cas(il))
              write(*,*) 'Eqi_prime=',Eqi_prime(cas(il))
              write(*,*) 'Eqi_stewart=',Eqi_stewart(il)
              write(*,*) 'il,cas=',il,cas(il)
              write(*,*) 'fac_ftmr_cas=',fac_ftmr_cas(il)
              write(*,*) 'qp_avantevap_cas=',qp_avantevap_cas(il)
              write(*,*) 'qp_cas=',qp_cas(il)
              stop
          endif
          do ixt=1,niso  
           call iso_verif_noNaN((Pxtisup_cas(ixt,il)), &
     &           'compress_stewart 976')
          enddo !do ixt=1,niso  
         enddo
#endif  
#ifdef ISOVERIF
        do il=1,ncas
          if ((abs(water_cas(il)).ge.ridicule/10.) &
     &           .and.(Pqiinf_stewart(il).le.0.0)) then
              write(*,*) 'compress_stewart 498: evap liq:'
              write(*,*) 'water(il,i)=', water_cas(il)
              write(*,*) 'Pqiinf=',Pqiinf(cas(il))
              write(*,*) 'Pqiinf_par=',Pqiinf_par(cas(il))
              write(*,*) 'Pqiinf_stewart=',Pqiinf_stewart(il)
              stop                   
          endif
        enddo !do il=1,ncas_evap_glace
#endif

         end subroutine compress_evap_liq


         ! **************

         subroutine compress_evap_glace(iflag_con, &
     &    ncas, cas, &
     &    water_cas,water,     &
     &    Pqisup_cas,Pqisup,  &
     &    Pxtisup_cas,Pxtisup,  &
     &    T_cas,T,  &
     &    fac_ftmr_cas,fac_ftmr,   &   
     &    qp_avantevap_cas,qp_avantevap, &
     &    xtp_avantevap_cas,xtp_avantevap, &
     &    xtevapsup_cas,xtevap, &
     &    Eqi_stewart,Pqiinf_stewart,Eqi_prime_cas,Eqi_cas, &
     &    Pqiinf,Eqi_par,Pqiinf_par,Eqi_prime,Eqi, &
     &    INB_cas,INB,     &
     &    delP_cas,Ph,   &
     &    qp_cas,qp, &
     &    sigd_cas,sigd, &
#ifdef ISOVERIF            
     &    evap_cas,evap, &
#endif         
     &    nloc,ncum,nd,i,frac_sublim)

  USE isotopes_mod, ONLY: iso_eau, iso_HDO,ridicule

#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel
USE isotopes_verif_mod
#ifdef ISOTRAC
use isotrac_routines_mod, only: iso_verif_traceur_pbidouille
#endif
#endif
         implicit none

         ! compression dans le cas condensation_facftmr
         integer iflag_con      
         integer nloc,nd,ncum
         integer ncas
         integer cas(ncum)
         integer i
         real T_cas(ncum),T(ncum), &
     &    delP_cas(ncum),Ph(nloc,ND), &
     &    water_cas(ncum),water(ncum), &
     &    xtevapsup_cas(niso,ncum),xtevap(ntraciso,ncum)
         real qp_cas(ncum),qp(ncum)
         real sigd_cas(ncum),sigd(ncum)
#ifdef ISOVERIF  
         real evap_cas(ncum),evap(ncum)
#endif         
         real  fac_ftmr_cas(ncum),fac_ftmr(ncum), &
     &    Pqisup_cas(ncum),Pqisup(ncum),  &
     &    Pxtisup_cas(niso,ncum),Pxtisup(ntraciso,ncum),  & 
     &    qp_avantevap_cas(ncum),qp_avantevap(ncum),     &
     &    xtp_avantevap_cas(niso,ncum),xtp_avantevap(ntraciso,ncum), &
     &    Eqi_stewart(ncum),Pqiinf_stewart(ncum),Eqi_prime_cas(ncum), &
     &    Pqiinf(ncum),Eqi_par(ncum),Pqiinf_par(ncum),Eqi_prime(ncum), &
     &    Eqi(ncum),Eqi_cas(ncum)
          integer frac_sublim
          integer INB_cas(ncum),INB(ncum)
          integer il,ixt

          do il=1,ncas
            Pqisup_cas(il)=Pqisup(cas(il))            
            qp_avantevap_cas(il)=qp_avantevap(cas(il))
            Eqi_prime_cas(il)=Eqi_prime(cas(il))
            Eqi_cas(il)=Eqi(cas(il))
            fac_ftmr_cas(il)=fac_ftmr(cas(il)) 
            water_cas(il)=water(cas(il))
            INB_cas(il)=INB(cas(il)) 
            qp_cas(il)=qp(cas(il))
            sigd_cas(il)=sigd(cas(il))    
#ifdef ISOVERIF              
            evap_cas(il)=evap(cas(il))
#endif            
            delP_cas(il)=Ph(cas(il),i) &
     &         -Ph(cas(il),i+1)
            do ixt=1,niso              
              Pxtisup_cas(ixt,il)=Pxtisup(ixt,cas(il))
              xtp_avantevap_cas(ixt,il)=xtp_avantevap(ixt,cas(il))
              xtevapsup_cas(ixt,il)=xtevap(ixt,cas(il))
            enddo
          enddo  !do il=1,ncas  

!       write(*,*) 'qp_avantevap_cas(1),qp_avantevap(cas(1))=',
!     :   qp_avantevap_cas(1),qp_avantevap(cas(1))   

          if (frac_sublim.eq.1) then
            do il=1,ncas           
             T_cas(il)=T(cas(il))           
            enddo !do il=1,ncas     
          endif !if (frac_sublim) then

          ! calculs des flux de masses à mettre en argument de stewart:
      ! comme l'eau n'est pas bien concervée dans les ddfts, on est
      ! obligé de bidouillé.
      ! 1) soit on considère Pqisup, Eqi, et Pqiinf_par=Pqisup-Eqi
      !    et on suppose que dans la réalité les compositions de
      !    Pqiinf sont les même que Pqiinf_par
      ! 2) soit on considère Pqisup, Eqi_par=Pqisup-Pqiinf, et Pqiinf,
      !    et on suppose que dans la réalité les compositions de
      !    Eqi_prime sont les même que Eqi_par
          do il=1,ncas
            if ((water(cas(il)).gt.ridicule/100).and. &
     &            (Pqiinf_par(cas(il)).le.0.0)) then
             ! on ne peut pas utiliser la méthode 1, car KE prédit de l'eau
             ! alors que le bilan de masse n'enprédit pas.
             ! Peut-on utiliser la méthode 2?
             Pqiinf_stewart(il)=Pqiinf(cas(il))
             Eqi_stewart(il)=Eqi_par(cas(il))
           else !if ((water(il,i).gt.ridicule/100).and.(Pqiinf_par.le.0.0)) then
             ! il n'y a pas d'obstacles à l'utilisation de 1)
             Pqiinf_stewart(il)=Pqiinf_par(cas(il))
             if (iflag_con.eq.30) then
                Eqi_stewart(il)=Eqi_prime(cas(il))
             else !if (iflag_con.eq.30) then
                ! pour quoi avait-on fait un traitement différent dans
                ! le cas  iflag_con=3?? C'est vraiment le bordel ici!
                if ((Eqi_prime(cas(il)).gt.0.0).and. &
     &               (Pqiinf(cas(il)).ge.Pqisup(cas(il))).and. &
     &               (Pqisup(cas(il)).gt.0.0).and. &
     &               (Pqisup(cas(il))-Eqi_prime(cas(il)).gt.0.0)) then
                     ! rustine au cas patho en 1D pour -90hPa/d   
                     Eqi_stewart(il)=Eqi_prime(cas(il))
                else !if (Eqi_prime(il).gt.0.0).and.
                     Eqi_stewart(il)=Eqi(cas(il))
                endif !if (Eqi_prime(il).gt.0.0).and.
             endif !if (iflag_con.eq.30) then
           endif !if ((water(il,i).gt.ridicule/100).and.(Pqiinf_par.le.0.0)) then
         enddo !do il=1,ncas_evap_glace 

        ! petite vérif
#ifdef ISOVERIF        
!        il=1  
!        write(*,*) 'compress_stewart 1249& il=',il
!        write(*,*) 'Pqiinf_stewart(il)=',Pqiinf_stewart(il)
!        write(*,*) 'Eqi_stewart(il)=',Eqi_stewart(il)
!        write(*,*) 'Pqisup_cas=',Pqisup_cas(il)
        do il=1,ncas
          if ((abs(water_cas(il)).ge.ridicule/10.) &
     &           .and.(Pqiinf_stewart(il).le.0.0)) then
              write(*,*) 'compress_stewart 498: evap glace:'
              write(*,*) 'water(il,i)=', water_cas(il)
              write(*,*) 'Pqiinf=',Pqiinf(cas(il))
              write(*,*) 'Pqiinf_par=',Pqiinf_par(cas(il))
              write(*,*) 'Pqiinf_stewart=',Pqiinf_stewart(il)
              stop                   
          endif
        enddo !do il=1,ncas_evap_glace
#endif             

         end subroutine compress_evap_glace


         ! **************

         subroutine uncompress_ilp( &
     &       ncas,cas, &
     &       zxtrfln_cas,zxt_cas,zxtrfl,zxtrfln,zxt,klon)

  USE isotopes_mod, ONLY: iso_eau, iso_HDO

         implicit none

        ! inputs         
         integer ncas
         integer cas(ncas)
         integer klon         
         real zxt_cas(niso,ncas),zxtrfln_cas(niso,ncas)

         ! outputs
         real zxt(ntraciso,klon)
         real zxtrfl(ntraciso,klon),zxtrfln(ntraciso,klon)

         ! locals
         integer il,ixt

         do il=1,ncas
          do ixt=1,niso
            zxt(ixt,cas(il))=zxt_cas(ixt,il)
            zxtrfln(ixt,cas(il))=zxtrfln_cas(ixt,il)
            zxtrfl(ixt,cas(il))=zxtrfln_cas(ixt,il)
          enddo
         enddo


         end subroutine uncompress_ilp

         ! **************

         subroutine compress_ilp_evap_tot( &
     &       ncas,cas, &
     &       zxt_cas,zxt,zxtrfl_cas,zxtrfl, &
     &       delP,paprs,k,klon,klev)

  USE isotopes_mod, ONLY: iso_eau, iso_HDO
         implicit none

         integer ncas
         integer cas(ncas)
         integer klon,klev
         real zxt(niso,klon)
         real zxtrfl(niso,klon)
         real delP(ncas),paprs(klon,klev+1)
         real zxt_cas(niso,ncas), zxtrfl_cas(niso,ncas)
         integer k
         integer il,ixt

         do il=1,ncas
          do ixt=1,niso
            zxt_cas(ixt,il)=zxt(ixt,cas(il))
            zxtrfl_cas(ixt,il)=zxtrfl(ixt,cas(il))
          enddo
          delP(il)=paprs(cas(il),k)-paprs(cas(il),k+1)
         enddo

         end subroutine compress_ilp_evap_tot

         ! **************

         subroutine compress_ilp_evap_liq( &
     &       ncas,cas, &
     &       zq_cas,zq, &
     &       zqs_cas,zqs,        &
     &       zxt_cas,zxt, &
     &       zxtrfl_cas,zxtrfl_ancien, &
     &       zrfln_cas,zrfln,   &
     &       zrfl_cas,zrfl_ancien,     &
     &       zqev_diag_cas,zqev_diag,  &
     &       zt_cas,zt,   &
     &       delP,paprs,k,klon,klev)

  USE isotopes_mod, ONLY: iso_eau, iso_HDO
         implicit none

         integer ncas
         integer cas(ncas)
         integer klon,klev
         real zq(klon), zxt(ntraciso,klon)
         real zq_cas(ncas),zxt_cas(niso,ncas)         
         real zxtrfl_cas(niso,ncas)
         real zxtrfl_ancien(ntraciso,klon)
         real delP(ncas),paprs(klon,klev+1)
         real zqs(klon),zqs_cas(ncas)
         real zt_cas(ncas),zt(klon) 
         real zqev_diag_cas(ncas),zqev_diag(klon)
         real zrfln_cas(ncas)
         real zrfln(klon)
         real zrfl_cas(ncas)
         real zrfl_ancien(klon)
         integer k
         integer il,ixt

         do il=1,ncas
          do ixt=1,niso
            zxt_cas(ixt,il)=zxt(ixt,cas(il))
            zxtrfl_cas(ixt,il)=zxtrfl_ancien(ixt,cas(il))
          enddo
          zqs_cas(il)=zqs(cas(il))
          zrfln_cas(il)=zrfln(cas(il))
          zrfl_cas(il)=zrfl_ancien(cas(il))
          zq_cas(il)=zq(cas(il))
          zqev_diag_cas(il)=zqev_diag(cas(il))
          zt_cas(il)=zt(cas(il))
          delP(il)=paprs(cas(il),k)-paprs(cas(il),k+1)
         enddo

         end subroutine compress_ilp_evap_liq

! **************

         subroutine compress_ilp_evap_glace( &
     &       ncas,cas, &
     &       zq_cas,zq,     &
     &       zxt_cas,zxt, &
     &       zxtrfl_cas,zxtrfl_ancien, &
     &       zrfln_cas,zrfln,   &
     &       zrfl_cas,zrfl_ancien,    & 
     &       zqev_diag_cas,zqev_diag,  &
     &       zt_cas,zt,   &
     &       delP,paprs,k,klon,klev,frac_sublim)

  USE isotopes_mod, ONLY: iso_eau, iso_HDO
#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel
USE isotopes_verif_mod
#endif
         implicit none

        ! inputs         
         integer ncas
         integer cas(ncas)
         integer klon
         real zq(klon), zxt(ntraciso,klon)
         real zxtrfl_ancien(ntraciso,klon)
         real zt(klon) 
         real zqev_diag(klon)
         real zrfln(klon)
         integer k,klev
         real paprs(klon,klev+1)
         integer frac_sublim

         ! outputs
         real zq_cas(ncas),zxt_cas(niso,ncas)         
         real zxtrfl_cas(niso,ncas)         
         real zt_cas(ncas)
         real zqev_diag_cas(ncas)
         real zrfln_cas(ncas)         
         real zrfl_cas(ncas)
         real zrfl_ancien(klon)
         real delP(ncas)
         
         ! locals
         integer il,ixt 
!#ifdef ISOVERIF
!         real 
!#endif        

         do il=1,ncas
          do ixt=1,niso
            zxt_cas(ixt,il)=zxt(ixt,cas(il))
            zxtrfl_cas(ixt,il)=zxtrfl_ancien(ixt,cas(il))
          enddo
          delP(il)=paprs(cas(il),k)-paprs(cas(il),k+1)
          zrfln_cas(il)=zrfln(cas(il))
          zrfl_cas(il)=zrfl_ancien(cas(il))
          zq_cas(il)=zq(cas(il))
          zqev_diag_cas(il)=zqev_diag(cas(il))   
          if (frac_sublim.eq.1) then
            zt_cas(il)=zt(cas(il))
          endif
         enddo
         
#ifdef ISOVERIF
        if (iso_eau.gt.0) then
            do il=1,ncas
!              write(*,*) 'il=',il
              call iso_verif_egalite_choix(zrfl_ancien(cas(il)), &
     &           zxtrfl_ancien(iso_eau,cas(il)), &
     &           'compress 1655a: compress evap_glace pour ilp', &
     &           errmax,errmaxrel)
              call iso_verif_egalite_choix((zrfl_cas(il)), &
     &           (zxtrfl_cas(iso_eau,il)), &
     &           'compress 1655b: compress evap_glace pour ilp', &
     &           errmax,errmaxrel)
            enddo
        endif  !if (iso_eau.gt.0) then
#endif


         end subroutine compress_ilp_evap_glace     

! **************

          subroutine integrale_gauss_vectall(ncas,m,I, &
!     :          qp0,A,m0,beta,gama,g0,ntot) 
     &          qp0,A,m0,beta,gama,g0)  

  USE isotopes_mod, ONLY: iso_eau, iso_HDO,ntot
#ifdef ISOVERIF
  USE isotopes_verif_mod
#endif
        implicit none

        ! version vectorisée en ncas. La vesrion _bak23fev2008 était
        ! vectorisée en ntot

        ! calcul d'intégral par méthode de gauss
        ! on vectorise sur toutes les intégrales à calculer
        ! ***declarations: 

        ! **inputs:
        integer ncas
        ! arguments de la fonction à intégrer:
        real qp0(ncas)
        real A(ncas),m(ncas),m0(ncas),beta(niso,ncas), &
     &           gama(niso,ncas),f0(ncas),g0(ncas) 
!        integer ntot(ncas) 
!        integer ntot
!        parameter (ntot=40)        
        
        ! ** output
        real I(niso,ncas) ! integrale
        
        ! **locals
        ! ! nombre max d'itération dans integrale rieman
        integer j
        integer il,ixt,k
        real dxj(ncas)
        integer ndeg ! degrès du polynome de Legendre 
        parameter (ndeg=5)   
        real w(ndeg),z(ndeg)
        real fj
            
!        real xj        

         ! verifs
!#ifdef ISOVERIF         
!        real 
!#endif        
        
        ! *** verifs
!        write(*,*) 'ntot=',ntot
        
#ifdef ISOVERIF     
      do il=1,ncas   
        if (m0(il).lt.m(il)) then
            write(*,*) 'integrale_rieman 25'
            write(*,*) 'binf=',m(il),' bsup=',m0(il)
            stop
        endif
      enddo
#endif        

!        write(*,*) 'binf=',binf,' bsup=',bsup
        
        !*** calculs

        if (ndeg.eq.1) then
           z(1)=0.0
           w(1)=2.0
         else if (ndeg.eq.2) then
           z(1)=-0.577350269189
           z(2)=0.577350269189
           w(1)=1.0
           w(2)=1.0
        else if (ndeg.eq.3) then
           z(1)=-0.774596669241
           z(2)=0.0
           z(3)=0.774596669241
           w(1)=0.5555555555555
           w(2)=0.8888888888888
           w(3)=0.5555555555555
        else if (ndeg.eq.4) then
           z(1)=-0.861136311594
           z(2)=-0.3399810435848
           z(3)=0.3399810435848
           z(4)=0.861136311594
           w(1)=0.34785484513745
           w(2)=0.6521451548625 
           w(3)=0.6521451548625
           w(4)=0.34785484513745 
        else if (ndeg.eq.5) then
           z(1)=-0.90617984593866399280
           z(2)=-0.53846931010568309104
           z(3)=0.0
           z(4)=0.53846931010568309104
           z(5)=0.90617984593866399280
           w(1)=0.23692688505618908751
           w(2)=0.47862867049936646804 
           w(3)=0.568888888888888888889
           w(4)=0.47862867049936646804
           w(5)=0.23692688505618908751
        else
            write(*,*) 'integrale gauss: non prévu: ndeg=',ndeg
            stop
        endif  
        
        do il=1,ncas
!          dxj(il)=(m0(il)-m(il))/float(ntot(il))
          dxj(il)=(m0(il)-m(il))/float(ntot)
          do ixt=1,niso
            I(ixt,il)=0.0
          enddo
        enddo !do il=1,ncas   
        
        do j=1,ntot
          fj=float(j)
          do il=1,ncas      
            do ixt=1,niso
!                I(ixt,il)=I(ixt,il)
!     :            +w(k)*(
!     :                   ((((qp0(il)-A(il)
!     :           *((m(il)+0.5*(z(k)+2*float(j)-1.0)*dxj(il))-m0(il)))
!     :           /qp0(il))/g0(il))
!     :           **(beta(ixt,il)*gama(ixt,il)-1))
!     :           *((((m(il)+0.5*(z(k)+2*float(j)-1.0)*dxj(il))/m(il)))
!     :           **(-beta(ixt,il)-1))  ) 
              I(ixt,il)=I(ixt,il)+w(1)*( &
     &                   ((((qp0(il)-A(il) &
     &           *((m(il)+0.5*(z(1)+2*fj-1.0)*dxj(il))-m0(il))) &
     &           /qp0(il))/g0(il)) &
     &           **(beta(ixt,il)*gama(ixt,il)-1)) &
     &           *((((m(il)+0.5*(z(1)+2*fj-1.0)*dxj(il))/m(il))) &
     &           **(-beta(ixt,il)-1))  ) &
     &         +w(2)*( &
     &                   ((((qp0(il)-A(il) &
     &           *((m(il)+0.5*(z(2)+2*fj-1.0)*dxj(il))-m0(il))) &
     &           /qp0(il))/g0(il)) &
     &           **(beta(ixt,il)*gama(ixt,il)-1)) &
     &           *((((m(il)+0.5*(z(2)+2*fj-1.0)*dxj(il))/m(il))) &
     &           **(-beta(ixt,il)-1))  ) &
     &         +w(3)*( &
     &                   ((((qp0(il)-A(il) &
     &           *((m(il)+0.5*(z(3)+2*fj-1.0)*dxj(il))-m0(il))) &
     &           /qp0(il))/g0(il)) &
     &           **(beta(ixt,il)*gama(ixt,il)-1)) &
     &           *((((m(il)+0.5*(z(3)+2*fj-1.0)*dxj(il))/m(il))) &
     &           **(-beta(ixt,il)-1))  )& 
     &         +w(4)*( &
     &                   ((((qp0(il)-A(il) &
     &           *((m(il)+0.5*(z(4)+2*fj-1.0)*dxj(il))-m0(il))) &
     &           /qp0(il))/g0(il)) &
     &           **(beta(ixt,il)*gama(ixt,il)-1)) &
     &           *((((m(il)+0.5*(z(4)+2*fj-1.0)*dxj(il))/m(il))) &
     &           **(-beta(ixt,il)-1))  ) &
     &         +w(5)*(  &
     &                   ((((qp0(il)-A(il) &
     &           *((m(il)+0.5*(z(5)+2*fj-1.0)*dxj(il))-m0(il))) &
     &           /qp0(il))/g0(il)) &
     &           **(beta(ixt,il)*gama(ixt,il)-1)) &
     &           *((((m(il)+0.5*(z(5)+2*fj-1.0)*dxj(il))/m(il))) &
     &           **(-beta(ixt,il)-1))  )
            enddo  !do ixt=1,niso
!           enddo !do k=1,ndeg   
          enddo !do j=2,ntot(il)
        enddo
        
       ! integrale avec valeur au début de l'intervalle (en m)
       do il=1,ncas
        do ixt=1,niso
           I(ixt,il)=I(ixt,il)*0.5*dxj(il)
         enddo !do ixt=1,niso
       enddo !do il=1,ncas 

       ! verif
#ifdef ISOVERIF  
       do il=1,ncas 
       do ixt=1,niso     
       call iso_verif_noNaN((I(ixt,il)),'integrale 68')
       enddo
       enddo
#endif       
       ! end verif
            
!       write(*,*) 'I=',I
!       write(*,*) 'Imax=',Imax,'Imin=',Imin
!       write(*,*) 'e=',e

       end SUBROUTINE integrale_gauss_vectall

      subroutine appel_stewart_vectall(lwork,ncum, &
     &          PH,T,EVAP,XTWDTRAIN, &
     &                  WDTRAIN, &
     &           WATER,Q,XT, QS,QP,MP,WT, & ! inputs physiques
     &           XTWATER,XTP,  &   ! outputs indispensables
     &          XTEVAP, &     ! diagnostiques
     &         sigd, &  ! inputs tunables
     &         i,INB, & ! altitude: car cas particulier en INB 
     &         NA,ND,nloc,cvflag_grav,ginv,Mpmin) ! dimensions  
 

  USE isotopes_mod, ONLY: iso_eau, iso_HDO,thumxt1, &
&       bidouille_anti_divergence,ridicule
#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel
USE isotopes_verif_mod
#endif
#ifdef ISOTRAC
USE isotrac_mod, ONLY: index_iso, index_zone,option_revap,izone_revap, &
&        ridicule_trac
USE isotrac_routines_mod, ONLY:  &
&       iso_verif_traceur_jbidouille,uncompress_commun_zone_revap, &
&       compress_evap_glace_zone,compress_evap_liq_zone, &
&       uncompress_commun_zone,compress_noevap_zone, &
&       compress_cond_facftmr_zone,compress_cond_nofftmr_zone
#ifdef ISOVERIF
USE isotrac_routines_mod, only: iso_verif_traceur_pbidouille
#endif
#endif
      implicit none

      !*inputs et outputs
      integer ncum ! dimension horiz effective
      logical lwork(nloc)
      integer NA,ND,nloc ! dimensions officielles
      real PH(nloc,ND),T(nloc,ND),EVAP(nloc,NA)
      real XTWDTRAIN(ntraciso,nloc),WDTRAIN(nloc), &
     &      WATER(nloc,NA), Q(nloc,NA), XT(ntraciso,nloc,ND), &
     &           QS(nloc,ND),QP(nloc,NA), &
     &      XTWATER(ntraciso,nloc,NA),XTP(ntraciso,nloc,NA), &
     &    XTEVAP(ntraciso,nloc,NA), &
     &      WT(nloc,NA), MP(nloc,NA)
      real sigd
      integer i,INB(nloc)
      logical cvflag_grav
      real ginv
      real Mpmin

      !* variables intermediaires
      integer ixt,j,il
      real qeff(ncum)
      real xtp_avantevap(ntraciso,ncum),qp_avantevap(ncum)
!      real Exi(niso,ncum) ! equivalent à Eqi_prime
      real Pqisup(ncum),Pqiinf(ncum),Eqi(ncum) 
      real Pqiinf_par(ncum), Eqi_prime(ncum),  &
     &           Eqi_plus1(ncum), Eqi_par(ncum)
      real Pqiinf_stewart(ncum), Eqi_stewart(ncum)
      real Exi_prime(ntraciso,ncum)
      real Pxtiinf_stewart(niso,ncum),  &
     &          Exi_stewart(niso,ncum)
      real Exi_plus1(niso,ncum)
      real Pxtisup(ntraciso,ncum), Pxtiinf(niso,ncum)
      real xtnew(niso,ncum)
      real fac_ftmr(ncum) ! facteur de conversion des flux en mixing ratio
!      real Risup(ntraciso,ncum), Rcond(ntraciso,ncum), 
!     :           Renv(ntraciso,ncum) 
!      real  Revap(ntraciso,ncum), Riinf(ntraciso,ncum)
!      real xtice(ntraciso,ncum), xtliq(ntraciso,ncum)
!      real xtp0(ntraciso,ncum), qp0(ncum)
!     real fcond(ncum), fice(ncum), cond(ncum)
!      real zxtalphal(niso,ncum), zxtalphai(niso,ncum)
      real g
      real rat(ncum)
      real ztglace_kelvin
      parameter (ztglace_kelvin=273.15)

      integer frac_sublim
      !real      
      !real real_to_double

      ! compteurs de parsage
      integer icas_condensation_facftmr,ncas_condensation_facftmr
      integer icas_condensation_nofacftmr,ncas_condensation_nofacftmr
      integer icas_noevap,ncas_noevap
      integer icas_evap_liq,ncas_evap_liq
      integer icas_evap_glace,ncas_evap_glace
      integer ncas_tot

      ! tableaux d'indice issus du parsage
      integer cas_condensation_facftmr(ncum)
      integer cas_condensation_nofacftmr(ncum)
      integer cas_noevap(ncum)
      integer cas_evap_liq(ncum)
      integer cas_evap_glace(ncum)

#ifdef ISOVERIF
      ! tracage des cas
      integer trace_cas(ncum)
!      integer iso_verif_positif_nostop
!      integer iso_verif_positif_choix_nostop
!      integer iso_verif_aberrant_nostop
!      integer iso_verif_traceur_nostop
!      integer iso_verif_egalite_nostop
!      integer iso_verif_egalite_choix_nostop
!      real deltaD
      real Exi_cas(niso,ncum),Exi(ntraciso,ncum)
#endif      

      ! outputs des calculs, compressés
      real xtevap_cas(niso,ncum),xtp_cas(niso,ncum), &
     &           xtwater_cas(niso,ncum)

      ! inputs des calculs, compréssés
      real T_cas(ncum),delP_cas(ncum), &
     &          xtevapsup_cas(niso,ncum),evap_cas(ncum), &
     &          qp_cas(ncum),wt_cas(ncum), &
     &          xt_cas(niso,ncum),q_cas(ncum), &
     &          qs_cas(ncum),water_cas(ncum), &
     &          sigd_cas(ncum)          
        real sigd_vec(ncum)
      real  qp_avantevap_cas(ncum), &
     &  xtp_avantevap_cas(niso,ncum), &
     &  Pqisup_cas(ncum), Pxtisup_cas(niso,ncum),  &
     &  Eqi_prime_cas(ncum),fac_ftmr_cas(ncum),  &
     &  Eqi_cas(ncum)
#ifdef ISOTRAC      
      real  qp_avantevaptrac_cas(ncum), &
     &  xtp_avantevaptrac_cas(niso,ncum) 
        integer izone ,iiso
      real xtaddp_tag(niso,ncum)
      real ptrac(ncum)
      real hdiag(ncum)
#endif      
      integer INB_cas(ncum)
              

!      write(*,*) 'appel stewart 48: entrée, i=',i

      ! definition de quelques constantes:

      !gravité:
      if (cvflag_grav) then
          g=1/ginv
      else
          g=10.
      endif

        ! rendre sigd vecteur pour homogénéiser par rapport au cas np:
        do il=1,ncum
          sigd_vec(il)=sigd
        enddo

      ! fractionne-t-on lors de la sublimation?
      frac_sublim=0 ! -> on ne fractionne pas
      !frac_sublim=1 ! -> oui, on fractionne
      

      ! ***** verification des inputs ************
      
#ifdef ISOVERIF
      if (iso_eau.gt.0) then
        do il=1,ncum 
         if (i.le.inb(il) .and. lwork(il)) then
          call iso_verif_egalite_choix(xt(iso_eau,il,i),q(il,i), &
     &           'appel stewart 58',errmax,errmaxrel)
         endif !if (i.le.inb(il) .and. lwork(il)) then
        enddo !do il=1,ncum    
      endif !if (iso_eau.gt.0) then
#ifdef ISOTRAC
      do il=1,ncum
         call iso_verif_traceur(xt(1,il,i), &
     &        'appel_stewart_vectall 141')
      enddo  
#endif      
#endif
      if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) then
         do il=1,ncum 
             if (i.le.inb(il) .and. lwork(il)) then   
                xt(iso_eau,il,i)=  q(il,i)
             endif !if (i.le.inb(il) .and. lwork(il)) then
           enddo !do il=1,ncum     
      endif !if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) then
      
      ! verif que les vapeurs du ddft plus haut sont bonnes
      ! si i=INB, on ne verifie rien car pas de vapeur au dessus de INB
#ifdef ISOVERIF
       do il=1,ncum 
         if (i.lt.inb(il) .and. lwork(il)) then
          do j=i+1,INB(il)
            if (iso_eau.gt.0) then
              call iso_verif_egalite_choix(xtp(iso_eau,il,j),qp(il,j), &
     &           'appel_stewart 66',errmax,errmaxrel)          
            endif !if (iso_eau.gt.0) then
            do ixt=1,ntraciso
              call iso_verif_noNAN(xtevap(ixt,il,j), &
     &        'appel_stewart 96')
            enddo
#ifdef ISOTRAC
            call iso_verif_traceur(xtp(1,il,j), &
     &         'appel_stewart_vectall 167')
#endif  
         enddo !do j=i+1,INB
        endif ! (i.lt.inb(il) .and. lwork(il)) then
       enddo !do il=1,ncum 
#endif

      if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) then
       do il=1,ncum 
        if (i.lt.inb(il) .and. lwork(il)) then
         do j=i+1,INB(il)
          xtp(iso_eau,il,j)=qp(il,j)          
         enddo !do j=i+1,INB
        endif ! (i.lt.inb(il) .and. lwork(il)) then
       enddo !do il=1,ncum 
      endif !if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) then
      ! end verif des inputs 


      ! ****** calcul du facteur de conversion des flux en mixing ratio
      
      do il=1,ncum 
       if (i.le.inb(il) .and. lwork(il)) then
        if (Mp(il,i).gt.Mp(il,i+1)) then
          ! cas entrainant
          fac_ftmr(il)=1.0/Mp(il,i)
        else !if (Mp(il,i).gt.Mp(il,i+1)) then
          if (Mp(il,i+1).gt.Mpmin) then
              ! cas non entrainant, mais flux existe
              fac_ftmr(il)=1.0/Mp(il,i+1)
          else !if (Mp(il,i+1).gt.Mpmin) then
              ! pas de flux de masse, XTP reste constant
              fac_ftmr(il)=0.0
          endif !if (Mp(il,i+1).gt.Mpmin) then
        endif !if (Mp(il,i).gt.Mp(il,i+1)) then
       endif ! (i.le.inb(il) .and. lwork(il)) then
      enddo !do il=1,ncum

      ! ****** calcul de la vapeur dans le ddft avant réévap
            
      do il=1,ncum 
       if (i.le.inb(il) .and. lwork(il)) then      
        if (i.lt.INB(il)) then      
         if (Mp(il,i).gt.Mp(il,i+1)) then
          ! cas entrainant
          rat(il)=Mp(il,i+1)/Mp(il,i)
          qp_avantevap(il)=qp(il,i+1)*rat(il)+q(il,i)*(1-rat(il))
          do ixt=1,ntraciso
             xtp_avantevap(ixt,il)=xtp(ixt,il,i+1)*rat(il) &
     &           +xt(ixt,il,i)*(1-rat(il))
          enddo
         else !if (Mp(il,i).gt.Mp(il,i+1)) then
           if (Mp(il,i+1).gt.Mpmin) then
              ! cas non entrainant, mais flux existe
              qp_avantevap(il)=qp(il,i+1)
              do ixt=1,ntraciso
                xtp_avantevap(ixt,il)=xtp(ixt,il,i+1)
              enddo
              
           else    !if (Mp(il,i+1).gt.0) then    
              
              ! pas de flux de masse, on ne calcule rien
              ! on garde le qp calculé dans cv3_unsat, original
              ! on suppose que le deltaD dans le ddft est celui de
              ! l'environnement
              qp_avantevap(il)=qp(il,i)
              if (qp(il,i).gt.0) then
#ifdef ISOVERIF
                call iso_verif_positif_strict(q(il,i), &
     &                'appel_stewart 226')
#endif                  
                do ixt=1,ntraciso
                 xtp_avantevap(ixt,il)=xt(ixt,il,i)/q(il,i)*qp(il,i)
                enddo
              else !if (qp(il,i).gt.0) then
                  ! si qp est négatif, on met les isos dedans à 0
                do ixt=1,ntraciso
                 xtp_avantevap(ixt,il)=0.0
                enddo
              endif !if (qp(il,i).gt.0) then
               
          endif !if (Mp(il,i+1).gt.0) then
          
         endif  !if (Mp(il,i).gt.Mp(il,i+1)) then
      
        else ! if i.lt.INB
          ! cas ou i=inb
          ! on garde le qp calculé dans cv3_unsat, original
          ! on suppose que le deltaD dans le ddft est celui de
          ! l'environnement
          qp_avantevap(il)=qp(il,i)
          if (qp(il,i).gt.0) then
            do ixt=1,ntraciso
             xtp_avantevap(ixt,il)=xt(ixt,il,i)/q(il,i)*qp(il,i)
            enddo
          else !if (qp(il,i).gt.0) then
              ! si qp négatif, on met les isotopes dedans à 0
            do ixt=1,ntraciso
             xtp_avantevap(ixt,il)=0.0
            enddo
          endif !if (qp(il,i).gt.0) then
        endif ! if i.lt.INB(il)
       endif ! (i.le.inb(il) .and. lwork(il)) then
      enddo !do il=1,ncum

#ifdef ISOVERIF
      if (iso_eau.gt.0) then
        do il=1,ncum 
          if (i.le.inb(il) .and. lwork(il)) then      
            call iso_verif_egalite_choix( &
     &          (xtp_avantevap(iso_eau,il)), &
     &          (qp_avantevap(il)), &
     &           'appel stewart 95',errmax,errmaxrel)
          endif ! (i.le.inb(il) .and. lwork(il)) then
        enddo !do il=1,ncum
      endif !if (iso_eau.gt.0) then
#endif

           
      ! ********* calculs des flux
      
      do il=1,ncum 
       if (i.le.inb(il) .and. lwork(il)) then
        Pqisup(il)=sigd_vec(il)/g*wt(il,i)*water(il,i+1)+wdtrain(il)/g
        Pqiinf(il)=sigd_vec(il)/g*wt(il,i)*water(il,i) ! ce qu'on aurait dans si ce
       ! ce qu s'évapore en i ne vient que de i, comme dans le schéma de
       ! KE original.      
        Eqi_prime(il)=(evap(il,i)+evap(il,i+1))/2 &
     &           *100.*(PH(il,i)-PH(il,I+1))*sigd_vec(il)/g
        Eqi(il)=evap(il,i)*100.*(PH(il,i)-PH(il,I+1))*sigd_vec(il)/g
        Eqi_plus1(il)=evap(il,i+1)*100.*(PH(il,i)-PH(il,I+1))*sigd_vec(il)/g
        Pqiinf_par(il)=Pqisup(il)-Eqi_prime(il)
        Eqi_par(il)=Pqisup(il)-Pqiinf(il)
        do ixt=1,ntraciso
          Pxtisup(ixt,il)=sigd_vec(il)/g*wt(il,i+1)*xtwater(ixt,il,i+1) &
     &           +xtwdtrain(ixt,il)/g
        enddo
       endif !if (i.le.inb(il) .and. lwork(il)) then
      enddo !do il=1,ncum 

#ifdef ISOVERIF      
      do il=1,ncum 
       if (i.le.inb(il) .and. lwork(il)) then
         call iso_verif_egalite_choix((Pqiinf(il)),  &
     &         (Pqiinf_par(il)),'appel_setwart 218', &
     &         errmax,errmaxrel)
       endif
!#ifdef ISOTRAC
!        if ((option_traceurs.eq.17).or.
!     :           (option_traceurs.eq.18)) then
!        if (iso_verif_positif_nostop((        
!     :          Pxtisup(index_trac(izone_cond,iso_eau),il)
!     :          -Pxtisup(iso_eau,il)),
!     :          'appel_stewart 332').eq.1) then
!          write(*,*) 'Pxtisup(:,il)=',Pxtisup(:,il)
!          write(*,*) 'xtwater(:,il,i+1)=',xtwater(:,il,i+1)
!          write(*,*) 'xtwdtrain(:,il)=',xtwdtrain(:,il)
!          stop
!        endif !if (iso_verif_positif_nostop(Pxtisup(iso_eau,il)-
!        endif !if ((option_traceurs.eq.17).or.    
!#endif       
      enddo !do il=1,ncum 
        
!      il=370 
!      write(*,*) 'appel_stewart 327: il=',il
!      write(*,*) 'Pqisup,Pqiinf,Eqi_prime,Eqi,Pqiinf_par,Eqi_par=',
!     :     Pqisup(il),Pqiinf(il),Eqi_prime(il),Eqi(il),
!     :     Pqiinf_par(il),Eqi_par(il)
!      write(*,*) 'fac_ftmr=',fac_ftmr(il)
!      write(*,*) 'qp_avantevap,qp=',qp_avantevap(il),qp(il,i)
#endif      

      ! petite vérif sur les flux
      do il=1,ncum 
       if (i.le.inb(il) .and. lwork(il)) then
         if ((Eqi_par(il).lt.0.0) &
     &          .and.(Pqiinf_par(il).le.0.0) &
     &         .and.(water(il,i).gt.ridicule/10.)) then
            ! dans ce cas, on a de l'eau sortant dont il faut déterminer la
            ! composition, mais pourtant le bilan de masse indique qu'il
            ! n'y a pas d'eau sortant. Et si on recalcule l'évap pour avoir de 
            ! l'eau sortant, Eqi_par<0 -> condensation! On est donc très
            ! embétté car Eqi_prime indique qu'il y a évaporation...   
!            write(*,*) 'appel_stewart 239: cas génant'  

            if (Eqi_prime(il)*fac_ftmr(il).lt. &
     &          qp_avantevap(il)*1e-2) then
                ! ouf: Eqi_prime a peut d'effet sur la vapeur du ddft.
                ! on peut donc condenser tranquillement pour obtenir de
                ! l'eau en sortie, ça ne changera pas grand chose sur la
                ! vapeur.
                Eqi_prime(il)=Eqi_par(il)
            else
             write(*,*) 'appel_stewart 222: ce cas est très génant'
             stop
            endif
          endif
        endif !if (i.le.inb(il) .and. lwork(il)) then
      enddo !do il=1,ncum

      if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) then
          do il=1,ncum
            xtp_avantevap(iso_eau,il)=qp_avantevap(il)
            Pxtisup(iso_eau,il)=Pqisup(il)
          enddo
      endif


      ! ******** parsage des différents cas + quelques vérifs
      icas_condensation_facftmr=0
      icas_condensation_nofacftmr=0
      icas_noevap=0
      icas_evap_glace=0
      icas_evap_liq=0
#ifdef ISOVERIF
      ! initialisation de l'outil de tracage de cas:
      do il=1,ncum
        if (i.le.inb(il) .and. lwork(il)) then
          trace_cas(il)=0
        else
          trace_cas(il)=-1
        endif
      enddo !do il=1,ncum
!      if (ncum.ge.602) then
!          write(*,*) 'appel_stewart tmp 379: avant parsage'
!          il=602
!          write(*,*) 'il,Eqi_prime(il)=',il,Eqi_prime(il)
!          write(*,*) 'fac_ftmr(il)=',fac_ftmr(il)
!          write(*,*) 'ridicule,errmax=',ridicule,errmax
!      endif
#endif      
      do il=1,ncum 
       if (i.le.inb(il) .and. lwork(il)) then 
!        write(*,*) 'tmp 417: il,Eqi_prime=',il,Eqi_prime(il)   
        if ((Eqi_prime(il).lt.-ridicule*1e-3).or. &
     &        (Eqi_prime(il)*fac_ftmr(il).lt.-ridicule*10)) then
            ! modif le 10 mai 2009: si Eqi_prime très petit, on le
            ! traite comme du 0
            ! modif 15 mai 2009: on rajoute condition sur Eqi*fac_ftmr
            ! modif le 5 dec 2012: on change les seuils pour homo avec
            ! noevap
          ! 1: Eqi_prime<0: condensation
!          write(*,*) 'tmp 426: condensation'
          if (fac_ftmr(il).gt.ridicule/100.) then
            ! si fac_ftmr très petit, on le traite comme du 0
            ! 1.1: si Mpi>0
            icas_condensation_facftmr=icas_condensation_facftmr+1    
            cas_condensation_facftmr(icas_condensation_facftmr)=il
#ifdef ISOVERIF
            trace_cas(il)=11
#endif            
          else !if (fac_ftmr.gt.0.0) then
            ! 1.2: si Mpi=0
            icas_condensation_nofacftmr=icas_condensation_nofacftmr+1  
            cas_condensation_nofacftmr(icas_condensation_nofacftmr)=il
#ifdef ISOVERIF
            trace_cas(il)=12
#endif
          endif !if (fac_ftmr.gt.0.0) then
!        else if ((abs(Eqi_prime(il)).lt.ridicule*1e-3).and.
!     :      (abs(Eqi_prime(il)*fac_ftmr(il)).lt.ridicule*10)) then 
        else if ((Eqi_prime(il).lt.ridicule*1e-3).and. & 
     &     (Eqi_prime(il)*fac_ftmr(il).lt.ridicule*10)) then 
            ! 2: Eqi_prime est compris entre 1e-14 et -1e-14: rien 
!            ! 27 mai 2009: on remplace le seuil pour Eqi_prime(il)*fac_ftmr(il)
!            ! de errmax/10 par ridicule*10  
            ! 18 sept 2009: on remplace  ridicule*1e-2 par ridicule*1e-3 
            !pour éviter Eqi_prime=-1.87e-15, Pqisup=0 et water=1.44e-12
            ! correction le 5 décembre 2012: il y a incohérence entre
            ! conditions condensation et noevap: ex de cas patho:
            ! Eqi'=-5e-15 et Eqi'*facftmr=-4e-10. Dans ce cas, tombe
            ! dans le trou entre condensation et noevap, et ça part dans
            ! l'évap positive! -> on enlève la valeur absolue.
!            write(*,*) 'tmp 457: noevap'
            icas_noevap=icas_noevap+1  
            cas_noevap(icas_noevap)=il
#ifdef ISOVERIF
            trace_cas(il)=2
            if ((Pqisup(il).le.0.0).and. &
     &          (water(il,i).gt.ridicule)) then
            write(*,*) 'appel_stewart 420: water=',water(il,i)
            write(*,*) 'Pqisup,Eqi_prime,fac_ftmr=',Pqisup(il), &
     &           Eqi_prime(il),fac_ftmr(il)
            stop
         endif
#endif
        else    !if (Eqi_prime.lt.0.0) then
        ! 3: Eqi_prime>0 
#ifdef ISOVERIF  
!        write(*,*) 'tmp 473: evap'
        ! quelques vérifs du bilan de masse d'eau 
             if (iso_verif_positif_nostop(( &
     &           Pqisup(il)-Eqi_prime(il)), &
     &           'appel_stewart 388').eq.1) then
               write(*,*) 'Pqisup=',Pqisup(il)
               write(*,*) 'Eqi_prime=',Eqi_prime(il)
               write(*,*) 'Pqiinf=',Pqiinf(il)
!               write(*,*) 'stop temporaire, à enlever'
!               stop
              endif
              if (iso_verif_positif_choix_nostop(( &
     &          Pqisup(il)-Pqiinf_par(il)),errmax, &
     &          'appel_stewart 442').eq.1) then
                write(*,*) 'appel_stewart 174'
                write(*,*) 'Pqisup=',Pqisup(il), &
     &          ' Pqiinf_par=',Pqiinf_par(il)
                stop
              endif               
              if (iso_verif_positif_nostop((Eqi_par(il)), &
     &          'appel_stewart 559b').eq.1) then
                write(*,*) 'Eqi(il),Eqi_plus1(il),Eqi_prime(il)=', &
     &                 Eqi(il),Eqi_plus1(il),Eqi_prime(il) 
                write(*,*) 'Pqisup(il),Pqiinf(il),Eqi_par(il)=', &
     &                  Pqisup(il),Pqiinf(il),Eqi_par(il)
              endif
#endif              
              if (T(il,i).ge.ztglace_kelvin) then
                ! 3.1: evap des gouttes
                icas_evap_liq=icas_evap_liq+1  
                cas_evap_liq(icas_evap_liq)=il
#ifdef ISOVERIF
                trace_cas(il)=31
#endif
              else !if (T(il,i).ge.ztglace_kelvin) then
                ! 3.2: evap de la glace
                icas_evap_glace=icas_evap_glace+1  
                cas_evap_glace(icas_evap_glace)=il
#ifdef ISOVERIF
                trace_cas(il)=32
#endif  
              endif !if (T(il,i).ge.ztglace_kelvin) then
          endif ! !if (Eqi_prime.lt.0.0) then
       endif !if (i.le.inb(il) .and. lwork(il)) then 
      enddo  !do il=1,ncum 

      ncas_condensation_facftmr=icas_condensation_facftmr
      ncas_condensation_nofacftmr=icas_condensation_nofacftmr  
      ncas_noevap=icas_noevap
      ncas_evap_liq=icas_evap_liq
      ncas_evap_glace=icas_evap_glace

#ifdef ISOVERIF
!      write(*,*) 'appel_stewart vectoriel 355: parsage des cas:'
!      if (ncum.ge.602) then
!          write(*,*) 'trace_cas(602)=',trace_cas(602)
!      endif  
      ncas_tot=0
      do il=1,ncum
        if (i.le.inb(il) .and. lwork(il)) then 
            ncas_tot=ncas_tot+1
        endif
      enddo
!      write(*,*) 'i,ncum,ncas_tot=',i,ncum,ncas_tot
!      write(*,*) 'ncas_condensation_facftmr=',ncas_condensation_facftmr
!      write(*,*) 'ncas_condensation_nofacftmr=',
!     :            ncas_condensation_nofacftmr
!      write(*,*) 'ncas_noevap=',ncas_noevap
!      write(*,*) 'ncas_evap_liq_=',ncas_evap_liq
!      write(*,*) 'ncas_evap_glace=',ncas_evap_glace
      if (ncas_tot.ne.ncas_condensation_facftmr &
     &         +ncas_condensation_nofacftmr& 
     &         +ncas_noevap& 
     &         +ncas_evap_liq &
     &         +ncas_evap_glace) then
         write(*,*) 'mauvais parsage'
         stop
       endif !if (ncas_tot.ne.ncas_condensation_facftmr
#endif      


      ! ****** traitement vectoriel du cas 1.1

      if (ncas_condensation_facftmr.gt.0) then

      call compress_cond_facftmr(ncas_condensation_facftmr,   &
     &   cas_condensation_facftmr, &
     &   Eqi_prime_cas,Eqi_prime, &
     &   Pqisup_cas,Pqisup,  &
     &   Pxtisup_cas,Pxtisup,   &
     &   T_cas,T(1,i),  &
     &   fac_ftmr_cas,fac_ftmr,  &
     &   qp_avantevap_cas,qp_avantevap, &
     &   xtp_avantevap_cas,xtp_avantevap,  &
     &   xtevapsup_cas,xtevap(1,1,i+1),& 
     &   water_cas,water(1,i),& 
     &   delP_cas,Ph,  &
     &   sigd_cas,sigd_vec, &
#ifdef ISOVERIF        
     &   evap_cas(1),evap(1,i),qp_cas(1),qp(1,i),    &
#endif        
     &   nloc,ncum,nd,i)

#ifdef ISOVERIF
      ! vérif de la compression
      write(*,*) 'appel_stewart tmp 506: ', &
     &          'après compress_condensation_facftmr'
      write(*,*) 'cas_condensation_facftmr(1)=', &
     &          cas_condensation_facftmr(1)      
      write(*,*) 'sigd_cas(1:3)=',sigd_cas(1:3)  
      do il=1,ncas_condensation_facftmr
        call iso_verif_egalite_choix((Pqisup_cas(il)), &
     &        (Pqisup(cas_condensation_facftmr(il))), &
     &        'appel_stewart 457: compression condensation_facftmr', &
     &          errmax,errmax)
        call iso_verif_egalite_choix(water_cas(il), &
     &        water(cas_condensation_facftmr(il),i), &
     &        'appel_stewart 460: compression condensation_facftmr', &
     &        errmax,errmax)
        if (iso_eau.gt.0) then
         call iso_verif_egalite_choix( &
     &        (xtp_avantevap_cas(iso_eau,il)), &
     &        (qp_avantevap_cas(il)),& 
     &        'appel_stewart 520: compression condensation_facftmr',& 
     &        errmax,errmax)
        endif ! if (iso_eau.gt.0) then
      enddo ! do il=1,ncas_condensation_facftmr
#endif                  
        call make_condensation_facftmr(ncas_condensation_facftmr, &
     &        Eqi_prime_cas(1),Pqisup_cas(1),Pxtisup_cas(1,1), &
     &        fac_ftmr_cas(1),T_cas(1),& 
     &        qp_avantevap_cas(1),xtp_avantevap_cas(1,1),water_cas(1),& 
     &        delP_cas(1),xtevapsup_cas(1,1),ztglace_kelvin, &
     &        xtp_cas(1,1),xtwater_cas(1,1),xtevap_cas(1,1),g,sigd_cas(1) &
#ifdef ISOVERIF        
     &         ,evap_cas,qp_cas,1 & 
#endif
     &          )  

#ifdef ISOVERIF
        do   il=1,ncas_condensation_facftmr
          do ixt=1,niso
            call iso_verif_noNaN(xtwater_cas(ixt,il), &
     &          'appel_stewart 539')
          enddo
        enddo      
#endif        

       call uncompress_commun(ncas_condensation_facftmr, &
     &    cas_condensation_facftmr, &
     &  xtp_cas,xtp(1,1,i),xtwater_cas,xtwater(1,1,i), &
     &          xtevap_cas,xtevap(1,1,i), &
#ifdef ISOVERIF
     &          Exi_cas(1,1),Exi,  &  
#endif
     &          ncum)


#ifdef ISOTRAC
       do izone=1,ntraceurs_zone

!#ifdef ISOVERIF     
!       write(*,*) 'appel_stewart tmp 538: condensation_facftmr, izone=',
!     &         izone
!#endif      

        call compress_cond_facftmr_zone( &
     &   ncas_condensation_facftmr,   &
     &   cas_condensation_facftmr, &
     &   Eqi_prime_cas,Eqi_prime,& 
     &   Pqisup_cas,Pqisup, & 
     &   Pxtisup_cas,Pxtisup,   &
     &   qp_avantevap_cas,qp_avantevap,& 
     &   xtp_avantevap_cas,xtp_avantevap, & 
     &   xtevapsup_cas,xtevap(1,1,i+1),& 
     &   water_cas,water(1,i),& 
#ifdef ISOVERIF        
     &   evap_cas(1),evap(1,i),  & 
#endif        
     &   nloc,ncum,nd,i,izone)

#ifdef ISOVERIF 
        if (iso_eau.gt.0) then
          do il=1,ncas_condensation_facftmr
            call iso_verif_egalite_choix( &
     &          (qp_avantevap_cas(il)), &
     &          (xtp_avantevap_cas(iso_eau,il)), &
     &          'appel_stewart 558',errmax,errmaxrel)
          enddo !do il=1,ncas_condensation_nofacftmr
        endif !if (iso_eau.gt.0) then
#endif
        call make_condensation_facftmr(ncas_condensation_facftmr, &
     &        Eqi_prime_cas(1),Pqisup_cas(1),Pxtisup_cas(1,1), &
     &        fac_ftmr_cas(1),T_cas(1), &
     &        qp_avantevap_cas(1),xtp_avantevap_cas(1,1),water_cas(1),& 
     &        delP_cas(1),xtevapsup_cas(1,1),ztglace_kelvin, &
     &        xtp_cas(1,1),xtwater_cas(1,1),xtevap_cas(1,1),g,sigd_cas(1) &
#ifdef ISOVERIF        
     &           ,evap_cas(1),qp_cas(1),1 & 
#endif
     &          )

#ifdef ISOVERIF
        do   il=1,ncas_condensation_facftmr
          do ixt=1,niso
            call iso_verif_noNaN(xtwater_cas(ixt,il), &
     &          'appel_stewart 588')
          enddo
        enddo      
#endif
        !#ifdef ISOVERIF

       call uncompress_commun_zone(ncas_condensation_facftmr, &
     &    cas_condensation_facftmr, &
     &  xtp_cas,xtp(1,1,i),xtwater_cas,xtwater(1,1,i), &
     &          xtevap_cas,xtevap(1,1,i), &
     &          ncum,izone)
        
      enddo !do izone=1,ntraceurs_zone

#ifdef ISOVERIF
!        write(*,*) 'appel_stewart tmp 574: ',
!     :           'fin cas condensation_facftmr'
            do il=1,ncas_condensation_facftmr
!               write(*,*) 'il,cas_condensation_facftmr(il)=',
!     :           il,cas_condensation_facftmr(il)
!               write(*,*) 'xtp(1:ntraciso:3)=',xtp(1:ntraciso:3,
!     :           cas_condensation_facftmr(il),i)
!               write(*,*) 'xtp_avantevap(1:ntraciso:3)=',
!     :           xtp_avantevap(1:ntraciso:3,
!     :           cas_condensation_facftmr(il))
!               if (il.eq.cas_condensation_facftmr(602)) then
!                write(*,*) 'appel_stewart 638: il=602'
!                write(*,*) 'xtp(iso_eau:ntraciso:3,il,i)=',
!     :           xtp(iso_eau:ntraciso:3,cas_condensation_facftmr(il),i)
!               endif
               call iso_verif_traceur(xtp &
     &          (1,cas_condensation_facftmr(il),i), &
     &          'appel_stewart_vectall 557')
               call iso_verif_traceur(xtwater &
     &          (1,cas_condensation_facftmr(il),i), &
     &          'appel_stewart_vectall 560')
               call iso_verif_traceur_justmass(xtevap &
     &          (1,cas_condensation_facftmr(il),i),& 
     &          'appel_stewart_vectall 563')
            enddo !do il=1,ncas_condensation_nofacftmr 
#endif     
         !#ifdef ISOVERIF   
#endif    
        !#ifdef ISOTRAC    

           endif !if (ncas_condensation_facftmr.gt.0) then


        ! ****** traitement vectoriel du cas 1.2

      if (ncas_condensation_nofacftmr.gt.0) then

      call compress_cond_nofftmr(ncas_condensation_nofacftmr, &
     &   cas_condensation_nofacftmr, &
     &   Eqi_prime_cas,Eqi_prime(1), & 
     &   Pqisup_cas,Pqisup(1), &
     &   Pxtisup_cas,Pxtisup(1,1), &
     &   water_cas,water(1,i),  &
     &   T_cas,T(1,i),  &
     &   qp_avantevap_cas,qp_avantevap(1), &
     &   xtp_avantevap_cas,xtp_avantevap(1,1), &
     &   xt_cas,xt(1,1,i),q_cas,q(1,i),  &
     &   xtevapsup_cas,xtevap(1,1,i+1),& 
     &   delP_cas,Ph,  &
     &   sigd_cas,sigd_vec, &
#ifdef ISOVERIF
     &   evap_cas(1),evap(1,i),qp_cas(1),qp(1,i), &
#endif      
     &   nloc,ncum,nd,i)

#ifdef ISOVERIF
      ! vérif de la compression
!      write(*,*) 'appel_stewart tmp 616: ', &
!     &           'après compress condensation_nofacftmr'
!      write(*,*) 'iso_routines 6854: sigd_cas(1:3)=', sigd_cas(1:3)
      do il=1,ncas_condensation_nofacftmr
        call iso_verif_egalite_choix((Pqisup_cas(il)), &
     &        (Pqisup(cas_condensation_nofacftmr(il))), &
     &        'appel_stewart 594: compression condensation_nofacftmr', &
     &          errmax,errmax)
        call iso_verif_egalite_choix(T_cas(il), &
     &        T(cas_condensation_nofacftmr(il),i), &
     &        'appel_stewart 597: compression condensation_nofacftmr',& 
     &          errmax,errmax)
      enddo
#endif    

      call make_condensation_nofacftmr(ncas_condensation_nofacftmr, &
     &    Eqi_prime_cas(1),Pqisup_cas(1), & 
     &    Pxtisup_cas(1,1),water_cas(1),T_cas(1), &
     &    qp_avantevap_cas(1), xtp_avantevap_cas(1,1), &
     &    q_cas(1),xt_cas(1,1),  &
     &    xtevapsup_cas(1,1) ,delP_cas(1),    &
     &    ztglace_Kelvin, g,sigd_cas(1), & 
     &    xtevap_cas(1,1),xtp_cas(1,1),xtwater_cas(1,1) &
#ifdef ISOVERIF
     &    ,evap_cas(1),qp_cas(1),0 &
#endif
     &  )     

      call uncompress_commun(ncas_condensation_nofacftmr, &
     &    cas_condensation_nofacftmr, &
     &  xtp_cas,xtp(1,1,i),xtwater_cas,xtwater(1,1,i), &
     &          xtevap_cas,xtevap(1,1,i), &
#ifdef ISOVERIF
     &          Exi_cas(1,1),Exi,    &
#endif
     &          ncum)
                
#ifdef ISOTRAC
       do izone=1,ntraceurs_zone
!         write(*,*) 'appel_stewart 718: izone=',izone

         call compress_cond_nofftmr_zone( &
     &   ncas_condensation_nofacftmr, &
     &   cas_condensation_nofacftmr, &
     &   Eqi_prime_cas,Eqi_prime(1),& 
     &   Pqisup_cas,Pqisup(1),  &
     &   Pxtisup_cas,Pxtisup(1,1), &
     &   water_cas,water(1,i),  &
     &   qp_avantevap_cas,qp_avantevap(1), &
     &   xtp_avantevap_cas,xtp_avantevap(1,1), &
     &   xt_cas,xt(1,1,i),q_cas,q(1,i), & 
     &   xtevapsup_cas,xtevap(1,1,i+1), & 
#ifdef ISOVERIF
     &   evap_cas(1),evap(1,i), &
#endif      
     &   nloc,ncum,nd,i,izone)

         call make_condensation_nofacftmr(ncas_condensation_nofacftmr, &
     &    Eqi_prime_cas(1),Pqisup_cas(1), &
     &    Pxtisup_cas(1,1),water_cas(1),T_cas(1), &
     &    qp_avantevap_cas(1), xtp_avantevap_cas(1,1), &
     &    q_cas(1),xt_cas(1,1), &
     &    xtevapsup_cas(1,1) ,delP_cas(1),    &
     &    ztglace_Kelvin, g,sigd_cas(1), &
     &    xtevap_cas(1,1),xtp_cas(1,1),xtwater_cas(1,1) &
#ifdef ISOVERIF
     &    ,evap_cas(1),qp_cas(1),1 &
#endif
     &  )
 

            call uncompress_commun_zone(ncas_condensation_nofacftmr, &
     &          cas_condensation_nofacftmr, &
     &          xtp_cas,xtp(1,1,i),xtwater_cas,xtwater(1,1,i), &
     &          xtevap_cas,xtevap(1,1,i), &
     &          ncum,izone)

       enddo !do izone=1,ntraceurs_zone
#ifdef ISOVERIF
!       write(*,*) 'appel_stewart tmp 690: ',
!     :           'fin du cas condensation_nofacftmr'
            do il=1,ncas_condensation_nofacftmr
               call iso_verif_traceur(xtp &
     &          (1,cas_condensation_nofacftmr(il),i), &
     &          'appel_stewart_vectall 651')
               call iso_verif_traceur(xtwater &
     &          (1,cas_condensation_nofacftmr(il),i), &
     &          'appel_stewart_vectall 653')
               call iso_verif_traceur_justmass(xtevap &
     &          (1,cas_condensation_nofacftmr(il),i), &
     &          'appel_stewart_vectall 655')
            enddo !do il=1,ncas_condensation_nofacftmr 
       
#endif  
#endif            
       
        endif !if (ncas_condensation_nofacftmr.gt.0) then

        
        ! ****** traitement vectoriel du cas 2

      if (ncas_noevap.gt.0) then
      call compress_noevap(ncas_noevap, &
     &   cas_noevap, &
     &   Pqisup_cas,Pqisup,  &
     &   Pxtisup_cas,Pxtisup,   &
     &   xtp_avantevap_cas,xtp_avantevap,  &
     &   xtevapsup_cas,xtevap(1,1,i+1), &
     &   water_cas,water(1,i),& 
     &   delP_cas,Ph, & 
#ifdef ISOVERIF        
     &   evap_cas(1),evap(1,i),qp_cas(1),qp(1,i), &
#endif 
     &   nloc,ncum,nd,i) 

#ifdef ISOVERIF
      ! vérif de la compression
!      write(*,*) 'appel stewart 719: après compression iso noevap'
      do il=1,ncas_noevap
        call iso_verif_egalite_choix((Pqisup_cas(il)), &
     &          (Pqisup(cas_noevap(il))), &
     &          'appel_stewart 692: compression',errmax,errmaxrel)
        call iso_verif_egalite_choix(water_cas(il), &
     &          water(cas_noevap(il),i), &
     &          'appel_stewart 693: compression',errmax,errmaxrel)
        if (iso_eau.gt.0) then
        call iso_verif_egalite_choix( &
     &          (Pxtisup_cas(iso_eau,il)), &
     &          (Pqisup_cas(il)), &
     &          'appel_stewart 759',errmax,errmaxrel)
        call iso_verif_egalite_choix( &
     &          (xtp_avantevap(iso_eau,cas_noevap(il))), &
     &          qp(cas_noevap(il),i), &
     &          'appel_stewart 739',errmax,errmaxrel)
        call iso_verif_egalite_choix( &
     &          (xtp_avantevap_cas(iso_eau,il)), &
     &          qp_cas(il), &
     &          'appel_stewart 735',errmax,errmaxrel)        
        endif !if (iso_eau.gt.0) then
      enddo !do il=1,ncas_noevap
#endif      

      call make_cas_noevap(ncas_noevap, &
     &         xtp_avantevap_cas(1,1),xtevapsup_cas(1,1), &
     &         Pxtisup_cas(1,1),Pqisup_cas(1),water_cas(1), &
     &         xtevap_cas(1,1),xtp_cas(1,1),xtwater_cas(1,1) &
#ifdef ISOVERIF
     &         ,evap_cas(1),qp_cas(1),0  &
#endif         
     &         )      

       call uncompress_commun(ncas_noevap,cas_noevap, &
     &  xtp_cas,xtp(1,1,i),xtwater_cas,xtwater(1,1,i), &
     &          xtevap_cas,xtevap(1,1,i), &
#ifdef ISOVERIF
     &          Exi_cas(1,1),Exi,   & 
#endif
     &          ncum)

#ifdef ISOTRAC
       do izone=1,ntraceurs_zone
        call compress_noevap_zone(ncas_noevap, &
     &   cas_noevap, &
     &   Pqisup_cas,Pqisup,  &
     &   Pxtisup_cas,Pxtisup,   &
     &   xtp_avantevap_cas,xtp_avantevap,  &
     &   xtevapsup_cas,xtevap(1,1,i+1), &
     &   water_cas,water(1,i), &
#ifdef ISOVERIF        
     &   evap_cas(1),evap(1,i), &
#endif 
     &   nloc,ncum,nd,i,izone)

#ifdef ISOVERIF
!        write(*,*) 'appel stewart 765: après compression isotrac'
        do il=1,ncas_noevap
          call iso_verif_egalite_choix( &
     &          (Pxtisup_cas(iso_eau,il)), &
     &          (Pqisup_cas(il)), &
     &          'appel_stewart 759',errmax,errmaxrel)
        enddo !do il=1,ncas_noevap
#endif        
        
        call make_cas_noevap(ncas_noevap, &
     &         xtp_avantevap_cas(1,1),xtevapsup_cas(1,1), &
     &         Pxtisup_cas(1,1),Pqisup_cas(1),water_cas(1), &
     &         xtevap_cas(1,1),xtp_cas(1,1),xtwater_cas(1,1) &
#ifdef ISOVERIF
     &         ,evap_cas(1),qp_cas(1),1& 
#endif        
     &         )

        call uncompress_commun_zone(ncas_noevap,cas_noevap, &
     &  xtp_cas,xtp(1,1,i),xtwater_cas,xtwater(1,1,i), &
     &          xtevap_cas,xtevap(1,1,i), &
     &          ncum,izone)
        enddo !do izone=1,ntraceurs_zone

#ifdef ISOVERIF
!        write(*,*) 'appel_stewart tmp 806: ',
!     :           'fin du cas noevap'
       do il=1,ncas_noevap
           call iso_verif_traceur(xtp(1,cas_noevap(il),i), &
     &          'appel_stewart_vectall 734')
           call iso_verif_traceur(xtevap(1,cas_noevap(il),i), &
     &          'appel_stewart_vectall 736')
           call iso_verif_traceur(xtwater(1,cas_noevap(il),i), &
     &          'appel_stewart_vectall 738')
       enddo !do il=1,ncas_noevap
#endif
       
#endif       

        endif !if (ncas_noevap.gt.0) then


        ! ****** traitement vectoriel du cas 3.1

      if (ncas_evap_liq.gt.0) then
          

      call compress_evap_liq(30,ncas_evap_liq, &
     &   cas_evap_liq, &
     &   Pqisup_cas,Pqisup,  &
     &   Pxtisup_cas,Pxtisup,   &
     &   qp_avantevap_cas,qp_avantevap, &
     &   xtp_avantevap_cas,xtp_avantevap,  &
     &   xtevapsup_cas,xtevap(1,1,i+1), &
     &   water_cas,water(1,i),  &
     &   qs_cas,qs(1,i), &
     &   Eqi_stewart,Pqiinf_stewart,Eqi_prime_cas, &
     &   Pqiinf,Eqi_par,Pqiinf_par,Eqi_prime,   &
     &   Eqi,Eqi_cas,  &
     &   fac_ftmr_cas,fac_ftmr,  &
     &   T_cas,T(1,i), &
     &   wt_cas,wt(1,i), &
     &   INB_cas,INB(1), &
     &   delP_cas,Ph, &
     &   qp_cas,qp(1,i), &
     &   sigd_cas,sigd_vec, &
#ifdef ISOVERIF         
     &   evap_cas,evap(1,i), &
#endif      
     &   nloc,ncum,nd,i)

#ifdef ISOVERIF
      ! vérif de la compression
!      write(*,*) 'appel_stewart tmp 899: ',
!     :           'après compress_evap_liq'
      do il=1,ncas_evap_liq
!       write(*,*) 'il=',il
!      write(*,*) 'qp_avantevap_cas(il),xtp_avantevap_cas(iso_eau,il)=',
!     :    qp_avantevap_cas(il),xtp_avantevap_cas(iso_eau,il) 
        call iso_verif_egalite_choix((Pqisup_cas(il)), &
     &          (Pqisup(cas_evap_liq(il))), &
     &          'appel_stewart 822: compression evap_liq', &
     &          errmax,errmax)
        call iso_verif_egalite_choix(water_cas(il), &
     &          water(cas_evap_liq(il),i), &
     &          'appel_stewart 825: compression evap_liq', &
     &          errmax,errmax)
        call iso_verif_egalite_choix( &
     &        (qp_avantevap_cas(il)), &
     &        (qp_avantevap(cas_evap_liq(il))), &
     &        'appel_stewart 783: compression evap_liq', &
     &          errmax,errmax)
        if (iso_eau.gt.0) then
        call iso_verif_egalite_choix( &
     &        (xtp_avantevap_cas(iso_eau,il)), &
     &        (qp_avantevap_cas(il)), &
     &        'appel_stewart 789: compression evap_liq', &
     &         errmax,errmax) 
        endif             
      enddo !do il=1,ncas_evap_liq
#endif       
      do il=1,ncas_evap_liq     
        qeff(il)=thumxt1*Qs_cas(il) &
     &    +(1.0-thumxt1)*qp_avantevap_cas(il)
      enddo   !do il=1,ncas_evap_liq

!      write(*,*) 'appel tmp 802: xtp_avantevap_cas(iso_eau,2)=',
!     :           xtp_avantevap_cas(iso_eau,2)
!      write(*,*) 'appel tmp 1490: qp_avantevap_cas(2)=',
!     :           qp_avantevap_cas(2)
!       write(*,*) 'appel_stewart 933: make_cas_evap_liq pr eau normale'

       ! ici, ptrac ne sera pas utilisé
       call make_cas_evap_liq(ncas_evap_liq, &
     &          water_cas(1), &
     &          xtp_avantevap_cas(1,1),qp_avantevap_cas(1), &
     &          xtp_avantevap_cas(1,1),qp_avantevap_cas(1), &
     &          Pxtisup_cas(1,1),Pqisup_cas(1), &
     &          Eqi_stewart(1),Pqiinf_stewart(1),fac_ftmr_cas(1), &
     &          qs_cas(1), T_cas(1),wt_cas(1),  delP_cas(1), &
     &          xtevapsup_cas(1,1),qeff(1),g,sigd_cas(1), Eqi_prime_cas(1), &
     &          qp_cas(1), INB_cas(1),i,0, &
#ifdef ISOTRAC       
     &          ptrac(1),hdiag(1), &
#endif                
#ifdef ISOVERIF
     &          evap_cas(1),Exi_cas(1,1),    &   
#endif       
     &          xtp_cas(1,1),xtwater_cas(1,1),xtevap_cas(1,1))

       call uncompress_commun(ncas_evap_liq,cas_evap_liq, &
     &  xtp_cas,xtp(1,1,i),xtwater_cas,xtwater(1,1,i), &
     &          xtevap_cas,xtevap(1,1,i), &
#ifdef ISOVERIF
     &          Exi_cas(1,1),Exi,    &
#endif
     &          ncum)

#ifdef ISOTRAC

       ! initialisation dans le cas où la revap est taggée:
       if (option_revap.eq.1) then
         do il=1,ncas_evap_liq  
           do iiso=1,niso
             ixt=index_trac(izone_revap,iiso)
             xtevap(ixt,cas_evap_liq(il),i)=0.0
             xtp(ixt,cas_evap_liq(il),i)= &
     &          xtp_avantevap(ixt,cas_evap_liq(il)) 
             enddo  !do iiso=1,niso  
         enddo !do il=1,ncas_evap_glace  
       endif !if (option_revap.eq.1) th



      do izone=1,ntraceurs_zone      
      
!       write(*,*) 'appel_stewart 924 tmp: cas liq: izone=',izone 
!       write(*,*) 'appel 924: xtp_avantevap(c,cas(2))=',
!     :           xtp_avantevap(1:ntraciso:3,cas_evap_liq(2))
!       write(*,*) 'Pxtisup(1:ntraciso:3,cas(2))=',
!     :           Pxtisup(1:ntraciso:3,cas_evap_liq(2))
       call compress_evap_liq_zone(30,ncas_evap_liq, &
     &   cas_evap_liq, &
     &   Pqisup_cas,Pqisup,  &
     &   Pxtisup_cas,Pxtisup,   &
     &   xtp_avantevap_cas,xtp_avantevap, &
     &   xtp_avantevaptrac_cas, qp_avantevaptrac_cas, &
     &   xtevapsup_cas,xtevap(1,1,i+1), &
     &   water_cas,water(1,i),  &
     &   Eqi_stewart,Pqiinf_stewart,Eqi_prime_cas, &
     &   Pqiinf,Eqi_par,Pqiinf_par,Eqi_prime,ptrac, &
     &   Eqi,Eqi_cas,  &
!     &   qp_cas,
#ifdef ISOVERIF       
     &   evap_cas,evap(1,i), & 
#endif       
     &   nloc,ncum,nd,izone)


#ifdef ISOVERIF
!       write(*,*) 'appel_stewart tmp 941'
!       if (ncas_evap_liq.ge.162) then
!          write(*,*) 'Eqi_prime_cas=',Eqi_prime_cas(162)
!           write(*,*) 'Pqisup=',Pqisup(cas_evap_liq(162))
!           write(*,*) 'Eqi_prime=',Eqi_prime(cas_evap_liq(162))
!           write(*,*) 'Pxtisup=',
!     :           Pxtisup(iso_eau:ntraciso:3,cas_evap_liq(162))
!       endif
!        write(*,*) 'qp_avantevap_cas(2)=',
!     :           qp_avantevap_cas(2)
!       write(*,*) 'xtp_avantevap(iso_eau,cas_evap_liq(1))=',
!     :           xtp_avantevap(iso_eau,cas_evap_liq(1))
!       write(*,*) 'xtp_avantevap_cas(iso_eau,2)=',
!     :           xtp_avantevap_cas(iso_eau,2)
!       write(*,*) 'xtp_avantevaptrac_cas(iso_eau,2)=',
!     :           xtp_avantevaptrac_cas(iso_eau,2)
       if (iso_eau.gt.0) then
           do il=1,ncas_evap_liq
!             write(*,*) 'appel_stewart tmp 943: il=',il
             call iso_verif_egalite_choix( &
     &        (qp_avantevap(cas_evap_liq(il))), &
     &        (xtp_avantevap(iso_eau,cas_evap_liq(il))), &
     &        'appel_stewart 944', &
     &        errmax,errmaxrel)
             call iso_verif_egalite_choix( &
     &        (qp_avantevap(cas_evap_liq(il))), &
     &        (qp_avantevap_cas(il)), &
     &        'appel_stewart 951', &
     &        errmax,errmaxrel)
             call iso_verif_egalite_choix( &
     &        (xtp_avantevap(iso_eau,cas_evap_liq(il))), &
     &        (xtp_avantevap_cas(iso_eau,il)), &
     &        'appel_stewart 956', &
     &        errmax,errmaxrel)
             call iso_verif_egalite_choix( &
     &          (qp_avantevap_cas(il)), &
     &          (xtp_avantevap_cas(iso_eau,il)), &
     &          'appel_stewart 961',  &
     &          errmax,errmaxrel)
!             if ((option_traceurs.eq.17).or.
!     :           (option_traceurs.eq.18)) then
!               if (izone.eq.izone_cond) then
!                call iso_verif_positif((
!     :           Pxtisup_cas(iso_eau,il)
!     :           -Pxtisup(iso_eau,cas_evap_liq(il))),
!     :           'appel_stewart_vectall 1114')
!               else !if (izone.eq.izone_cond) then
!                call iso_verif_positif((
!     :           -Pxtisup_cas(iso_eau,il)),
!     :           'appel_stewart_vectall 1118')
!               endif !if (izone.eq.izone_cond) then
!             endif   !if ((option_traceurs.eq.17).or.
           enddo !do il=1,ncas_evap_liq
       endif !if (iso_eau.gt.0) then
#endif       

       call make_cas_evap_liq(ncas_evap_liq, &
     &          water_cas(1), &
     &          xtp_avantevap_cas(1,1),qp_avantevap_cas(1), &
     &          xtp_avantevaptrac_cas(1,1),qp_avantevaptrac_cas(1), &
     &          Pxtisup_cas(1,1),Pqisup_cas(1), &
     &          Eqi_stewart(1),Pqiinf_stewart(1),fac_ftmr_cas(1), &
     &          qs_cas(1), T_cas(1),wt_cas(1),  delP_cas(1), &
     &          xtevapsup_cas(1,1),qeff(1),  g,sigd_cas(1),Eqi_prime_cas(1),& 
     &          qp_cas(1),INB_cas(1),i,1, &
     &          ptrac(1),hdiag(1), &
#ifdef ISOVERIF
     &          evap_cas(1),Exi_cas(1,1), &
#endif          
     &          xtp_cas(1,1),xtwater_cas(1,1),xtevap_cas(1,1))

      ! verif
#ifdef ISOVERIF
      do il=1,ncas_evap_liq
        do ixt=1,niso
         call iso_verif_noNAN(xtp_cas(ixt,il),'appel stewart 198')
         call iso_verif_noNAN(xtevap_cas(ixt,il), &
     &        'appel stewart 745')
        enddo !do ixt=1,niso
!        if ((option_traceurs.eq.17).or.(option_traceurs.eq.18)) then
!            if (izone.eq.izone_cond) then
!              call iso_verif_positif(xtwater_cas(iso_eau,il)
!     :           -xtwater(iso_eau,cas_evap_liq(il),i),
!     :           'appel_stewart_vectall 1138')
!            else !if (izone.eq.izone_cond) then
!                call iso_verif_positif(-xtwater_cas(iso_eau,il),
!     :           'appel_stewart_vectall 1147')
!            endif !if (izone.eq.izone_cond) then
!        endif !if ((option_traceurs.eq.17).or.        
      enddo !do il=1,ncas_evap_liq
#endif       

       call uncompress_commun_zone_revap(ncas_evap_liq,cas_evap_liq, &
     &  xtp_cas,xtp(1,1,i),xtwater_cas,xtwater(1,1,i), &
     &          xtevap_cas,xtevap(1,1,i), &
     &          ncum,izone,Eqi_stewart,fac_ftmr_cas, &
#ifdef ISOVERIF
     &          Exi_cas(1,1),Exi(1,1), &
#endif       
     &          xtp_avantevaptrac_cas,1,hdiag(1))
        
      enddo ! do izone=ntraceurs_zone

#ifdef ISOVERIF
       do il=1,ncas_evap_liq
           
           if (iso_verif_traceur_nostop(xtp(1,cas_evap_liq(il),i), &
     &          'appel_stewart_vectall 1256').eq.1) then
             write(*,*) 'il,cas_evap_liq(il)=',il,cas_evap_liq(il)
             write(*,*) 'trace_cas(cas_evap_liq(il))=', &
     &          trace_cas(cas_evap_liq(il))
             if (trace_cas(cas_evap_liq(il)).eq.31) then
                 write(*,*) 'cas evap_liq'
                 write(*,*) 'xtp(:,cas_evap_liq(il),i)=', &
     &             xtp(:,cas_evap_liq(il),i)
                 write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
                 write(*,*) 'Eqi_stewart(il),Eqi_prime=', &
     &                  Eqi_stewart(il),Eqi_prime(cas_evap_liq(il))
                 write(*,*) 'Pxtisup(:,cas_evap_liq(il))=', &
     &                  Pxtisup(:,cas_evap_liq(il))
                 write(*,*) 'xtp_avantevap(:,cas_evap_liq(il))=', &
     &                 xtp_avantevap(:,cas_evap_liq(il))
                 write(*,*) 'Exi(:,cas_evap_liq(il))=', &
     &                 Exi(:,cas_evap_liq(il))
                 write(*,*) 'T_cas(il)=',T_cas(il)
                 write(*,*) 'h(il)=',thumxt1+(1.0-thumxt1)* &
     &                  qp_avantevap_cas(il)/qs_cas(il) 
             endif !if (trace_cas(il).eq.31) then
                ! en cas de problème ci, activer l'option débug de
                ! stewart_explicit
!                stop
                ! le 22 aout: on replace errmaxrel*20 par errmaxrel*25
                ! pour que ça marche à l'idris
             call iso_verif_traceur_choix(xtp(1,cas_evap_liq(il),i), &
     &          'appel_stewart_vectall 1154', &
     &           errmax,errmaxrel*25,ridicule_trac,deltalimtrac) 
           endif !if (iso_verif_traceur_nostop
           ! dans le test suivant, c'est errmaxrel*50
           call iso_verif_traceur_pbidouille( &
     &          xtp(1,cas_evap_liq(il),i), &
     &          'appel_stewart_vectall 1124')
           call iso_verif_traceur_justmass(xtevap(1,cas_evap_liq(il),i), &
     &          'appel_stewart_vectall 1258') 
!           write(*,*) 'appel_stewart tmp 1172: il,i=',il,i          
           call iso_verif_traceur(xtwater(1,cas_evap_liq(il),i), & 
     &          'appel_stewart_vectall 1260')           
       enddo !do il=1,ncas_evap_liq
#endif
#endif

        endif !if (ncas_evap_liq.gt.0) then

       
        

                ! ****** traitement vectoriel du cas 3.2

      if (ncas_evap_glace.gt.0) then


      call compress_evap_glace(30, &
     &   ncas_evap_glace,cas_evap_glace, &
     &   water_cas,water(1,i),  &
     &   Pqisup_cas,Pqisup,  &
     &   Pxtisup_cas,Pxtisup,  &
     &   T_cas,T(1,i),   &
     &   fac_ftmr_cas,fac_ftmr,  &
     &   qp_avantevap_cas,qp_avantevap, &
     &   xtp_avantevap_cas,xtp_avantevap,  &
     &   xtevapsup_cas,xtevap(1,1,i+1), &
     &   Eqi_stewart,Pqiinf_stewart,Eqi_prime_cas,Eqi_cas, &
     &   Pqiinf,Eqi_par,Pqiinf_par,Eqi_prime,Eqi, &
     &   INB_cas,INB(1), & 
     &   delP_cas,Ph, & 
     &   qp_cas,qp(1,i),& 
     &   sigd_cas,sigd_vec, &
#ifdef ISOVERIF      
     &   evap_cas,evap(1,i),& 
#endif      
     &   nloc,ncum,nd,i,frac_sublim)

#ifdef ISOVERIF
!      write(*,*) 'appel_stewart tmp 898 après compress glace'
!      write(*,*) 'qp_avantevap_cas(1),qp_avantevap(cas(1))=',
!     :    qp_avantevap_cas(1),qp_avantevap(cas_evap_glace(1))   
      ! vérif de la compression
      do il=1,ncas_evap_glace
!       write(*,*) 'il=',il
!      write(*,*) 'qp_avantevap_cas(il),qp_avantevap(cas(il))=',
!     &   qp_avantevap_cas(il),qp_avantevap(cas_evap_glace(il)) 
        call iso_verif_egalite_choix((Pqisup_cas(il)), &
     &        (Pqisup(cas_evap_glace(il))), &
     &        'appel_stewart 1096: compression evap_glace', &
     &          errmax,errmax)
        call iso_verif_egalite_choix(water_cas(il), &
     &        water(cas_evap_glace(il),i), &
     &        'appel_stewart 1099: compression evap_glace',& 
     &          errmax,errmax)
        call iso_verif_egalite_choix(evap_cas(il), &
     &        evap(cas_evap_glace(il),i), &
     &        'appel_stewart 910: compression evap_glace', &
     &          errmax,errmax)
        
        call iso_verif_egalite_choix(xtevapsup_cas(iso_eau,il),& 
     &        xtevap(iso_eau,cas_evap_glace(il),i+1), &
     &        'appel_stewart 1106: compression evap_glace', &
     &          errmax,errmax) 
        call iso_verif_egalite_choix( & 
     &        (qp_avantevap_cas(il)), &
     &        (qp_avantevap(cas_evap_glace(il))), &
     &        'appel_stewart 914: compression evap_glace', &
     &          errmax,errmax)
        if (iso_eau.gt.0) then
        call iso_verif_egalite_choix( &
     &        (xtp_avantevap_cas(iso_eau,il)), &
     &        (qp_avantevap_cas(il)), &
     &        'appel_stewart 919: compression evap_glace',& 
     &         errmax,errmax) 
        endif   !if (iso_eau.gt.0) then   
      enddo !do il=1,ncas_evap_glace
!       write(*,*) 'appel_stewart tmp 1054 appel make_cas_evap_glace'
#endif   
      
        call make_cas_evap_glace(ncas_evap_glace, &
     &          water_cas(1), &
     &          xtp_avantevap_cas(1,1),qp_avantevap_cas(1), &
     &          xtp_avantevap_cas(1,1),qp_avantevap_cas(1), &
     &          Pxtisup_cas(1,1),Pqisup_cas(1), &
     &          Eqi_stewart(1),Eqi_prime_cas(1), &
     &          Pqiinf_stewart(1),fac_ftmr_cas(1),& 
     &          qs_cas(1), T_cas(1),wt_cas(1),  delP_cas(1), &
     &          xtevapsup_cas(1,1),g,sigd_cas(1),INB_cas(1),i, &
     &          frac_sublim,qp_cas(1), &
#ifdef ISOVERIF        
     &          evap_cas(1),0,Exi_cas(1,1), &
#endif        
     &          xtp_cas(1,1),xtwater_cas(1,1),xtevap_cas(1,1))

!#ifdef ISOVERIF    
!        write(*,*) 'appel_stewart tmp 1073 après make_cas_evap_glace'
!#endif

       call uncompress_commun(ncas_evap_glace,cas_evap_glace, &
     &  xtp_cas,xtp(1,1,i),xtwater_cas,xtwater(1,1,i), &
     &          xtevap_cas,xtevap(1,1,i), &
#ifdef ISOVERIF
     &          Exi_cas(1,1),Exi,    &
#endif
     &          ncum)

#ifdef ISOTRAC

       ! initialisation dans le cas où la revap est taggée:
       if (option_revap.eq.1) then
         do il=1,ncas_evap_glace   
           do iiso=1,niso
             ixt=index_trac(izone_revap,iiso)
             xtevap(ixt,cas_evap_glace(il),i)=0.0
             xtp(ixt,cas_evap_glace(il),i)= &
     &          xtp_avantevap(ixt,cas_evap_glace(il)) 
           enddo  !do iiso=1,niso  
         enddo !do il=1,ncas_evap_glace  
       endif !if (option_revap.eq.1) then

       do izone=1,ntraceurs_zone
!       write(*,*) 'tmp appel_stewart 1284: izone=',izone

       call compress_evap_glace_zone(30, &
     &   ncas_evap_glace,cas_evap_glace, &
     &   water_cas,water(1,i), & 
     &   Pqisup_cas,Pqisup,  &
     &   Pxtisup_cas,Pxtisup,  &
     &   xtp_avantevap_cas,xtp_avantevap,  & 
     &   xtp_avantevaptrac_cas,qp_avantevaptrac_cas,  &
     &   xtevapsup_cas,xtevap(1,1,i+1),& 
     &   Eqi_stewart,Pqiinf_stewart,Eqi_prime_cas,Eqi_cas, &
     &   Pqiinf,Eqi_par,Pqiinf_par,Eqi_prime,Eqi, &
!     &   qp_cas,
#ifdef ISOVERIF       
     &   evap_cas,evap(1,i), &
#endif       
     &   nloc,ncum,nd,i,frac_sublim,izone)

!#ifdef ISOVERIF    
!        write(*,*) 'appel_stewart tmp 1101 call make_cas_evap_glace'
!#endif       
       call make_cas_evap_glace(ncas_evap_glace, &
     &          water_cas(1), &
     &          xtp_avantevap_cas(1,1),qp_avantevap_cas(1), &
     &          xtp_avantevaptrac_cas(1,1),qp_avantevaptrac_cas(1), &
     &          Pxtisup_cas(1,1),Pqisup_cas(1), &
     &          Eqi_stewart(1),Eqi_prime_cas(1), &
     &          Pqiinf_stewart(1),fac_ftmr_cas(1), &
     &          qs_cas(1), T_cas(1),wt_cas(1),  delP_cas(1), &
     &          xtevapsup_cas(1,1),g,sigd_cas(1),INB_cas(1),i, &
     &          frac_sublim,qp_cas(1), &
#ifdef ISOVERIF       
     &          evap_cas(1),1,Exi_cas(1,1), &
#endif       
     &          xtp_cas(1,1),xtwater_cas(1,1),xtevap_cas(1,1))

!#ifdef ISOVERIF    
!        write(*,*) 'appel_stewart tmp 1134 après make_cas_evap_glace'
!        write(*,*) 'izone,xtp_avantevap_cas(1)=',izone,
!     :            xtp_avantevap_cas(1:niso,1)
!        write(*,*) 'izone,xtp_avantevaptrac_cas(1)=',izone,
!     &           xtp_avantevaptrac_cas(1:niso,1)
!#endif          
       call uncompress_commun_zone_revap(ncas_evap_glace,cas_evap_glace, &
     &  xtp_cas,xtp(1,1,i),xtwater_cas,xtwater(1,1,i), &
     &          xtevap_cas,xtevap(1,1,i), &
     &          ncum,izone,Eqi_stewart,fac_ftmr_cas, &
#ifdef ISOVERIF
     &          Exi_cas(1,1),Exi(1,1), &
#endif       
     &          xtp_avantevaptrac_cas,0,hdiag(1)) ! hdiag ne sera pas utilisé

       enddo ! do izone=1,ntraceurs_zone

#ifdef ISOVERIF    
!        write(*,*) 'appel_stewart tmp 1117: ',
!     :           'fin du cas evap_glace'   
        do il=1,ncas_evap_glace
!           write(*,*) 'appel_stewart tmp 1146: il=',il            
!           write(*,*) 'xtp_avantevap=',xtp_avantevap
!     :           (1:ntraciso,cas_evap_glace(il))
!           write(*,*) 'xtp=',xtp(1:ntraciso,cas_evap_glace(il),i)
           if (iso_verif_traceur_nostop(xtp(1,cas_evap_glace(il),i), &
     &          'appel_stewart_vectall 1314').eq.1) then
             write(*,*) 'il,cas_evap_glace(il)=',il,cas_evap_glace(il)
             write(*,*) 'trace_cas(cas_evap_glace(il))=', &
     &          trace_cas(cas_evap_glace(il))
             write(*,*) 'cas evap_glace'
             write(*,*) 'xtp(:,cas_evap_glace(il),i)=', &
     &             xtp(:,cas_evap_glace(il),i)
             write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
             write(*,*) 'Eqi_stewart(il)=',Eqi_stewart(il)
             write(*,*) 'Pxtisup(:,cas_evap_glace(il))=', &
     &                  Pxtisup(:,cas_evap_glace(il))
             write(*,*) 'xtp_avantevap(:,cas_evap_glace(il))=', &
     &                 xtp_avantevap(:,cas_evap_glace(il))
             write(*,*) 'Exi(:,cas_evap_glace(il))=', &
     &                 Exi(:,cas_evap_glace(il))
             ! on laisse quand même une chance
             call iso_verif_traceur_pbidouille( &
     &          xtp(1,cas_evap_glace(il),i), &
     &          'appel_stewart_vectall 1331')
           endif
           call iso_verif_traceur(xtevap(1,cas_evap_glace(il),i), &
     &          'appel_stewart_vectall 2150')
           call iso_verif_traceur(xtwater(1,cas_evap_glace(il),i), &
     &          'appel_stewart_vectall 2152')
        enddo !do il=1,ncas_evap_glace        
#endif
#endif

        endif !if (ncas_evap_glace.gt.0) then


       ! ****** dernières vérifs et bidouilles


#ifdef ISOVERIF
        do il=1,ncum 
           if (i.le.inb(il) .and. lwork(il)) then
!             write(*,*) 'appel_stewart 1380 temp: il,trace_cas(il)=',
!     &          il,trace_cas(il)  
             do ixt=1,ntraciso
               call iso_verif_noNAN(xtp(ixt,il,i), &
     &        'appel_stewart 1382')
               call iso_verif_noNAN(xtwater(ixt,il,i), &
     &                  'appel_stewart 1381')
               call iso_verif_noNAN(xtevap(ixt,il,i), &
     &                  'appel_stewart 1661')
             enddo !do ixt=1,ntraciso
             if (iso_eau.gt.0) then
              if (iso_verif_egalite_choix_nostop(xtwater(iso_eau,il,i), &
     &        water(il,i),'appel stewart 1277, fin, water', &
     &        errmax,errmaxrel).eq.1) then 
               write(*,*) 'il,i,trace_cas=',il,i,trace_cas(il)
               stop 
              endif  !if (iso_verif_egalite_choix_nostop(  
              if (iso_verif_egalite_choix_nostop( &
     &        xtp(iso_eau,il,i),qp(il,i),'appel stewart 1278', &
     &        errmax,errmaxrel*50).eq.1) then 
               write(*,*) 'il,i,trace_cas=',il,i,trace_cas(il)
               stop 
              endif  !if (iso_verif_egalite_choix_nostop(
              if (iso_verif_egalite_choix_nostop( &
     &        xtevap(iso_eau,il,i),evap(il,i), &
     &        'appel stewart 1279', &
     &        errmax,errmaxrel).eq.1) then 
               write(*,*) 'il,i,trace_cas=',il,i,trace_cas(il)
               stop 
              endif  !if (iso_verif_egalite_choix_nostop(
             endif !if (iso_eau.gt.0) then
             if ((iso_HDO.gt.0).and. &
     &          (qp(il,i).gt.ridicule)) then
                call iso_verif_aberrant( &
     &          xtp(iso_HDO,il,i)/qp(il,i), &
     &          'appel_stewart 1498')
             endif  ! if (iso_HDO.gt.0) then
#ifdef ISOTRAC
!           if (il.eq.602) then
!              write(*,*) 'appel_stewart 1334: il,i=',il,i
!              write(*,*) 'xtp(iso_eau:ntraciso:3,il,i)=',
!     :          xtp(iso_eau:ntraciso:3,il,i) 
!           endif
           call iso_verif_traceur(xtp(1,il,i), &
     &          'appel_stewart_vectall 1632')
           call iso_verif_traceur_justmass(xtevap(1,il,i), &
     &          'appel_stewart_vectall 1634')
           call iso_verif_traceur(xtwater(1,il,i), &
     &          'appel_stewart_vectall 1636')
!           if ((option_traceurs.eq.17).or.
!     &          (option_traceurs.eq.18)) then
!            if (iso_verif_positif_nostop(xtwater(
!     &          index_trac(izone_cond,iso_eau),il,i)
!     &          -xtwater(iso_eau,il,i),
!     &          'appel_stewart_vectall 1457').eq.1) then
!             write(*,*) 'il,trace_cas=',il,trace_cas(il)
!             stop
!            endif !if (iso_verif_positif_nostop(xtwater(iso_eau,il,i)-
!           endif !if ((option_traceurs.eq.17).or.
#endif  
           endif !if (i.le.inb(il) .and. lwork(il)) then 
        enddo !do il=1,ncum 
#endif

       if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) then 
         do il=1,ncum 
           if (i.le.inb(il) .and. lwork(il)) then 
             xtwater(iso_eau,il,i)= water(il,i)
             xtp(iso_eau,il,i)=qp(il,i) 
             xtevap(iso_eau,il,i)= evap(il,i) 
#ifdef ISOTRAC       
#ifdef ISOVERIF
             call iso_verif_traceur_pbidouille(xtp(1,il,i), &
     &          'appel_stewart_vectall 1362') 
             call iso_verif_traceur_pbidouille( &
     &          xtwater(1,il,i), &
     &          'appel_stewart_vectall 1381')                       
#else
             call iso_verif_traceur_jbidouille(xtp(1,il,i))
             call iso_verif_traceur_jbidouille(xtwater(1,il,i))
#endif            
#endif             
           endif !if (i.le.inb(il) .and. lwork(il)) then     
          enddo !do il=1,ncum  
        endif !if (bidouille_anti_divergence) then

!#ifdef ISOVERIF
!        write(*,*) 'appel_stewart tmp 1197: sortie'
!#endif

        end subroutine appel_stewart_vectall


        subroutine make_condensation_facftmr(ncas, &
     &           Eqi_prime_cas,Pqisup_cas,Pxtisup_cas, &
     &           fac_ftmr_cas,T_cas, &
     &           qp_avantevap_cas,xtp_avantevap_cas,water_cas, &
     &           delP_cas,xtevapsup_cas,ztglace_kelvin, &
     &           xtp_cas,xtwater_cas,xtevap_cas,g,sigd &
#ifdef ISOVERIF        
     &           ,evap_cas,qp_cas,oktrac &
#endif
     &          )    

  USE isotopes_mod, ONLY: iso_eau, iso_HDO, Rdefault, ridicule
#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel
USE isotopes_verif_mod
#endif
        implicit none

        ! inputs
        integer ncas
        real ztglace_kelvin
        real T_cas(ncas),delP_cas(ncas), &
     &          xtevapsup_cas(niso,ncas),water_cas(ncas)
        real  qp_avantevap_cas(ncas), &
     &  xtp_avantevap_cas(niso,ncas), &
     &  Pqisup_cas(ncas), Pxtisup_cas(niso,ncas),  &
     &  Eqi_prime_cas(ncas),fac_ftmr_cas(ncas)
         real g,sigd(ncas)                  
#ifdef ISOVERIF
         real evap_cas(ncas),qp_cas(ncas)
         integer oktrac
#endif         

        ! outputs
        real xtevap_cas(niso,ncas),xtp_cas(niso,ncas), &
     &           xtwater_cas(niso,ncas)

        ! locals
        real Risup(niso,ncas), Rcond(niso,ncas)
        real xtice(ntraciso,ncas), xtliq(ntraciso,ncas)
        real xtp0(ntraciso,ncas), qp0(ncas)
        ! rq: xtice,xtliq,xtp0 sont de dimension ntraciso car condiso_liq_ice_vectall prend des choses de dimension ntraciso. Mais c'est une perte de mémoire. Seuls les premiers niso sont utilisés
        real fcond(ncas), fice(ncas), cond(ncas)
        real Exi_prime(niso,ncas)
        integer il,ixt
        real zxtalphal,zxtalphai
!#ifdef ISOVERIF
!        real 
!        integer iso_verif_egalite_choix_nostop
!        integer iso_verif_noNaN_nostop
!        integer iso_verif_positif_nostop
!#endif

!        write(*,*) 'ncas=',ncas
       do il=1,ncas
#ifdef ISOVERIF
         if (iso_eau.gt.0) then
             call iso_verif_egalite_choix( &
     &          (xtp_avantevap_cas(iso_eau,il)), &
     &          (qp_avantevap_cas(il)), &
     &          'appel_stewart 1349',errmax,errmaxrel)
         endif
         call iso_verif_noNaN((Eqi_prime_cas(il)), &
     &          'appel_stewart 1357a')
         if (iso_verif_noNaN_nostop((fac_ftmr_cas(il)), &
     &          'appel_stewart 1357b').eq.1) then
            write(*,*) 'il=',il
         endif
!         if (il.eq.1) then
!         write(*,*) 'Eqi_prime_cas=',Eqi_prime_cas(il)
!         write(*,*) 'fac_ftmr_cas=',fac_ftmr_cas(il)
!         write(*,*) 'Pqisup_cas=',Pqisup_cas(il)
!         write(*,*) 'qp_avantevap_cas=',qp_avantevap_cas(il)
!         endif
#endif   
        
        if ((Eqi_prime_cas(il).gt.-ridicule*1e-2).and.    & 
     &     (Eqi_prime_cas(il)*fac_ftmr_cas(il).gt.-ridicule*10).and. &
     &     (Pqisup_cas(il).le.0.0)) then
          fcond(il)=1.0
          cond(il)=0.0
!#ifdef ISOVERIF          
!         write(*,*) 'tmp 1399: il,cond,Eqi,fac_ftmr_cas=', &
!     &         il,cond(il),Eqi_prime_cas(il),fac_ftmr_cas(il)
!#endif          
        else !if ((Eqi_prime_cas(il).gt.-ridicule*1e-2).and.    
         fcond(il)=-Eqi_prime_cas(il)/(Pqisup_cas(il)-Eqi_prime_cas(il))
         cond(il)=-Eqi_prime_cas(il)*fac_ftmr_cas(il)
#ifdef ISOVERIF             
!         write(*,*) 'tmp 1404: il,cond,Eqi,fac_ftmr_cas=',
!     :          il,cond(il),Eqi_prime_cas(il),fac_ftmr_cas(il)
!         write(*,*) 'Pqisup_cas,qp_cas=',Pqisup_cas(il),qp_cas(il)
#endif         
        endif

         if (T_cas(il).ge.ztglace_kelvin) then
               fice(il)=0.0
         else
               fice(il)=1.0
         endif 

         if (cond(il).gt.qp_avantevap_cas(il)) then
             ! dans ce cas, qp doit être nul. on vérifie et si oui, on
             ! met cond=qp_avantevap_cas
             ! cas ajouté le 11 dec 2011
#ifdef ISOVERIF
             call iso_verif_egalite(qp_cas(il),0.0,'appel_stewart 1626')
#endif             
             cond(il)=qp_avantevap_cas(il)
             ! ajouté le 10 juin 2012:
             qp0(il)=qp_avantevap_cas(il)
              do ixt=1,niso
                 xtp0(ixt,il)=xtp_avantevap_cas(ixt,il)
              enddo !do ixt=1,niso  
         else ! if (cond(il).gt.qp_avantevap_cas(il)) then    
           if (cond(il).lt.1e-11) then
              ! pour des raisons numériques, ça ne marchera pas
              cond(il)=cond(il)*1e4
              qp0(il)=qp_avantevap_cas(il)*1e4
              do ixt=1,niso
                 xtp0(ixt,il)=xtp_avantevap_cas(ixt,il)*1e4
              enddo !do ixt=1,niso  
           else !if (cond(il).lt.1e-11) then
              qp0(il)=qp_avantevap_cas(il)  
              do ixt=1,niso
               xtp0(ixt,il)=xtp_avantevap_cas(ixt,il)
              enddo                             
           endif !if (cond(il).lt.1e-11) then
         endif ! if (cond(il).gt.qp0(il)) then
#ifdef ISOVERIF
!        write(*,*) 'appel_stewart 1378 tmp: il=',il
!         write(*,*) 'cond(il),qp0(il)=',cond(il),qp0(il)
         call iso_verif_noNaN(qp0(il),'appel_stewart 1384a')  
         call iso_verif_noNaN(cond(il),'appel_stewart 1384b') 
         do ixt=1,niso
          call iso_verif_noNaN(xtp0(ixt,il),'appel_stewart 1384c')  
         enddo            
#endif
#ifdef ISOVERIF     
         if (iso_verif_positif_nostop(qp0(il)-cond(il), &
     &          'appel_stewart 1664').eq.1) then
           write(*,*) 'il,qp0,cond=',il,qp0(il),cond(il)
           write(*,*) 'qp_avantevap_cas,qp_cas=', &
     &          qp_avantevap_cas(il),qp_cas(il)
           write(*,*) 'Eqi_prime_cas,Pqisup_cas=', &
     &          Eqi_prime_cas,Pqisup_cas
           write(*,*) 'fac_ftmr_cas=',fac_ftmr_cas(il)
           stop
         endif
         if (iso_eau.gt.0) then
             call iso_verif_egalite_choix(xtp0(iso_eau,il), &
     &          qp0(il),'appel_stewart 1353',errmax,errmaxrel)
         endif
#endif       
        enddo !do il=1,ncas_condensation_facftmr
        
        call condiso_liq_ice_vectall(xtp0(1,1), qp0(1), &
     &        cond(1),T_cas(1),fice(1),xtice(1,1),xtliq(1,1), &
     &          ncas)

        do il=1,ncas
          if (cond(il).gt.ridicule*1e-2) then              
            do ixt=1,niso
              Rcond(ixt,il)=(xtice(ixt,il)+xtliq(ixt,il))/cond(il)
            enddo !do ixt=1,niso
          else if ((cond(il).gt.0.0).and.(qp0(il).gt.ridicule)) then  
            do ixt=1,niso
              call fractcalk(ixt,T_cas(il),zxtalphal,zxtalphai) 
              Rcond(ixt,il)=xtp0(ixt,il)/qp0(il)* &
     &             (fice(il)*zxtalphai+(1.0-fice(il))*zxtalphal)
            enddo !do ixt=1,niso   
          else !if (cond(il).gt.ridicule*1e-2) then   
            do ixt=1,niso
              Rcond(ixt,il)=Rdefault(ixt)
            enddo !do ixt=1,niso
          endif !Eqi_prime_cas(il)          
        enddo !do il=1,ncas_condensation_facftmr


#ifdef ISOVERIF 
        if (iso_eau.gt.0) then
         do il=1,ncas
!           write(*,*) 'tmp il,cond(il)=',il ,cond(il)
          if (cond(il).gt.errmax/50) then                   
              call iso_verif_egalite_choix( &
     &         (Rcond(iso_eau,il)),1.0, &
     &         'appel_stewart 257',errmax,errmaxrel*50)  
          endif !if (cond.gt.errmax/50) then
         enddo
        endif !if (iso_eau.gt.0) then
#endif
        do il=1,ncas
          ! le 30 avril 2012: on remplace 0 par ridicule*1e-2
          ! le 2 juillet 2012: on remplace ridicule*1e-2 par ridicule*1e-4
          if (Pqisup_cas(il).gt.ridicule*1e-4) then
             do ixt=1,niso
               Risup(ixt,il)=Pxtisup_cas(ixt,il)/Pqisup_cas(il)
             enddo !do ixt=1,niso
          else !if (Pqisup.gt.0.0) then
              ! il n'y avait pas d'eau au dessus
              ! on vérifie que toute l'eau en i provient de la rosée: on
              ! vérifie que fcond=1.0
!#ifdef ISOVERIF
!              call iso_verif_egalite_choix(fcond(il),1.0,
!     :            'appel_stewart 548',errmax,errmaxrel)
              ! il y a des cas pathos: ex: facftmr=8e7
              ! Eqi_prime=-3e-15 -> qp varie de 2e-7 -> pas négligeable
              ! Pqisup=1e-15 -> fcond=70% 
!#endif
              ! c'est bon, Risup n'a pas d'importance
              ! ou alors, le flux Pqiinf n'a pas d'importance
             do ixt=1,niso
               Risup(ixt,il)=Rdefault(ixt)
             enddo !do ixt=1,niso
          endif  !if (Pqisup.gt.0.0) then 
         enddo  !do il=1,ncas_condensation_facftmr
#ifdef ISOVERIF
         do il=1,ncas
!          write(*,*) 'tmp 1487: il,cond,Eqi,fac_ftmr_cas=',
!     :          il,cond(il),Eqi_prime_cas(il),fac_ftmr_cas(il)

          do ixt=1,niso
            if ((iso_verif_noNaN_nostop((Rcond(ixt,il)), &
     &         'appel_stewart 1482, cas 1.1, Rcond').eq.1).or. &
     &         (iso_verif_noNaN_nostop((Risup(ixt,il)), &
     &         'appel_stewart 1484, cas 1.1, Risup').eq.1)) then
               write(*,*) 'ixt,il=',ixt,il
               write(*,*) 'Pxtisup_cas(ixt,il)=',Pxtisup_cas(ixt,il)
               write(*,*) 'Pqisup_cas(il)=',Pqisup_cas(il)
               write(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
               write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
               write(*,*) 'T_cas(il)=',T_cas(il)
               write(*,*) 'fcond(il)=',fcond(il)
               write(*,*) 'cond(il)=',cond(il)
               write(*,*) 'qp_avantevap_cas(il)=',qp_avantevap_cas(il)
               write(*,*) 'fice(il)=',fice(il)
               write(*,*) 'xtice(ixt,il)=',xtice(ixt,il)
               write(*,*) 'xtliq(ixt,il)=',xtliq(ixt,il)
               stop
            endif
          enddo
          call iso_verif_noNAN(water_cas(il), &
     &           'appel_stewart 1469')
          call iso_verif_noNAN(fcond(il), &
     &           'appel_stewart 1471')
         enddo
#endif
         do il=1,ncas
!#ifdef ISOVERIF   
!          if (iso_eau.gt.0) then      
!             write(*,*) 'appel_stewart 1489: il,fac_ftmr_cas(il)=',
!     :           il,fac_ftmr_cas(il)
!             write(*,*) 'xtp_avantevap_cas(iso_eau,il)=',
!     :           xtp_avantevap_cas(iso_eau,il)
!             write(*,*) 'Eqi_prime_cas(il),Rcond(iso_eau,il)=',
!     :           Eqi_prime_cas(il),Rcond(iso_eau,il)
!          endif
!#endif          
          do ixt=1,niso             
                 Exi_prime(ixt,il)=Rcond(ixt,il)*Eqi_prime_cas(il)
                 xtevap_cas(ixt,il)=2*Exi_prime(ixt,il) &
     &                  /100.0/delP_cas(il)/sigd(il)*g &
     &                  -xtevapsup_cas(ixt,il)
                 xtwater_cas(ixt,il)=water_cas(il) &
     &                 *(Rcond(ixt,il)*fcond(il) &
     &                 +Risup(ixt,il)*(1.0-fcond(il)))
                 xtp_cas(ixt,il)=xtp_avantevap_cas(ixt,il)+ &
     &                  fac_ftmr_cas(il)*Exi_prime(ixt,il)
                 xtp_cas(ixt,il)=max(0.0,xtp_cas(ixt,il))
           enddo !do ixt=1,niso
          enddo !do il=1,ncas_condensation_facftmr
!          il=1
!          write(*,*) 'appel_stewart 1745: il=',il 
!          write(*,*) 'xtp_cas(iso_eau,il)=',xtp_cas(iso_eau,il)
!          write(*,*) 'xtp_avantevap_cas(iso_eau,il)=',
!     :        xtp_avantevap_cas(iso_eau,il)
!          write(*,*) 'qp_cas(il)=',qp_cas(il)
!          write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
!          write(*,*) 'Exi_prime(iso_eau,il)=',Exi_prime(iso_eau,il)
!          write(*,*) 'oktrac=',oktrac

#ifdef ISOVERIF
          do il=1,ncas
             do ixt=1,niso
              if (iso_verif_noNaN_nostop(xtwater_cas(ixt,il), &
     &          'appel_stewart 1487').eq.1) then
                write(*,*) 'ixt,il=',ixt,il
                write(*,*) 'water_cas(il)=',water_cas(il)
                write(*,*) 'Rcond(ixt,il)=',Rcond(ixt,il)
                write(*,*) 'fcond(il)=',fcond(il)
                write(*,*) 'Risup(ixt,il)=',Risup(ixt,il)
                write(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
                write(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
                write(*,*) 'T_cas(il)=',T_cas(il)
                write(*,*) 'cond(il)=',cond(il)
                write(*,*) 'Pqisup_cas(il)=',Pqisup_cas(il)
                write(*,*) 'qp_avantevap_cas(il)=',qp_avantevap_cas(il)
                stop
              endif
             enddo
          enddo
#endif
#ifdef ISOVERIF
          if (iso_eau.gt.0) then
            do il=1,ncas
              call iso_verif_egalite_choix(xtwater_cas(iso_eau,il), &
     &          water_cas(il),'appel_stewart 262, cas 1.1', &
     &          errmax,errmaxrel)
              if ((xtwater_cas(iso_eau,il).eq.0.0).and. &
     &          (water_cas(il).gt.ridicule)) then
               write(*,*) 'appel_stewart 1535, cas 1.1, il=',il
               write(*,*) 'xtwater(iso_eau,il,i)=', &
     &                  xtwater_cas(iso_eau,il)
               write(*,*) 'water(il,i)=',water_cas(il)
               write(*,*) 'Rcond(iso_eau,il)=',Rcond(iso_eau,il)
               write(*,*) 'Risup(iso_eau,il)=',Risup(iso_eau,il)
               write(*,*) 'fcond(il)=',fcond(il)
               write(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
               write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
               stop
              endif
              if (oktrac.eq.0) then
             call iso_verif_egalite_choix(xtp_cas(iso_eau,il), &
     &          qp_cas(il), &
     &          'appel_stewart 269, cas 1.1', &
     &          errmax,errmaxrel)
              if (iso_verif_egalite_choix_nostop(xtevap_cas(iso_eau,il), &
     &          evap_cas(il), &
     &          'appel_stewart 275, cas 1.1', &
     &          errmax,errmaxrel).eq.1) then
!                write(*,*) 'il,cas_condensation_facftmr(il)=',
!     &                  il,cas_condensation_facftmr(il)
                write(*,*) 'xtevapsup_cas(iso_eau,il)=', &
     &                  xtevapsup_cas(iso_eau,il)
!                write(*,*) 'evap(cas_condensation_facftmr(il),i+1)=',
!     &                 evap(cas_condensation_facftmr(il),i+1)
                write(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
                write(*,*) 'Exi_prime(iso_eau,il)=', &
     &                  Exi_prime(iso_eau,il)
                stop
              endif !if (iso_verif_egalite_choix_nostop(xtevap_cas(iso_eau,il),
              endif ! if (oktrac.eq.0) then
             enddo !do il=1,ncas_condensation_facftmr  
            endif ! if (iso_eau.gt.0) then  
            if (oktrac.eq.0) then
            if (iso_HDO.gt.0) then
             do il=1,ncas 
              if (qp_cas(il).gt.ridicule) then
                call iso_verif_aberrant(xtp_cas(iso_HDO,il)/ &
     &          qp_cas(il), 'appel_stewart 613')
              endif !if (qp(cas_condensation_facftmr(il),i).gt.ridicule) then
             enddo !do il=1,ncas
            endif  ! if (iso_HDO.gt.0) then 
           else !if (oktrac.eq.0) then
             if ((iso_HDO.gt.0).and.(iso_eau.gt.0)) then
              do il=1,ncas
               if (xtp_cas(iso_eau,il).gt.ridicule) then
                call iso_verif_aberrant(xtp_cas(iso_HDO,il)/ &
     &          xtp_cas(iso_eau,il), &
     &          'appel_stewart 1569')
                endif !if (qp(cas_condensation_nofacftmr(il),i)
               enddo ! do il=1,ncas
              endif  ! if (iso_HDO.gt.0) then
           endif  !if (oktrac.eq.0) then
#endif   

        end subroutine make_condensation_facftmr

        subroutine make_condensation_nofacftmr(ncas, &
     &    Eqi_prime_cas,Pqisup_cas,Pxtisup_cas,water_cas,T_cas, &
     &    qp_avantevap_cas, xtp_avantevap_cas,q_cas,xt_cas,  &
     &    xtevapsup_cas ,delP_cas,    &
     &    ztglace_Kelvin, g,sigd_cas,xtevap_cas,xtp_cas,xtwater_cas &
#ifdef ISOVERIF
     &    ,evap_cas,qp_cas,oktrac &
#endif
     &  ) 

  USE isotopes_mod, ONLY: iso_eau, iso_HDO, Rdefault,ridicule
#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel
USE isotopes_verif_mod
#endif
        implicit none

        ! inputs
        integer ncas
        real ztglace_kelvin
        real T_cas(ncas),delP_cas(ncas), &
     &          xtevapsup_cas(niso,ncas),water_cas(ncas), &
     &          q_cas(ncas),xt_cas(niso,ncas)
        real  qp_avantevap_cas(ncas), &
     &  xtp_avantevap_cas(niso,ncas), &
     &  Pqisup_cas(ncas), Pxtisup_cas(niso,ncas),  &
     &  Eqi_prime_cas(ncas)
         real g,sigd_cas(ncas)
         
#ifdef ISOVERIF
         integer oktrac
         real evap_cas(ncas),qp_cas(ncas)
#endif
        ! outputs
        real xtevap_cas(niso,ncas),xtp_cas(niso,ncas), &
     &           xtwater_cas(niso,ncas)

        ! locals
        real Risup(niso,ncas), Rcond(niso,ncas), &
     &          Renv(niso,ncas)
        real zxtalphal(niso,ncas), zxtalphai(niso,ncas)
        real fcond(ncas)
        real Exi_prime(niso,ncas)
        integer il,ixt
        !real 

        call fractcalk_vectall(T_cas,zxtalphal,zxtalphai,ncas)
        do il=1,ncas
          if (Pqisup_cas(il)-Eqi_prime_cas(il).gt.0.0) then
            fcond(il)=-Eqi_prime_cas(il) &
     &          /(Pqisup_cas(il)-Eqi_prime_cas(il))
          else
              fcond(il)=1.0
          endif
          if (qp_avantevap_cas(il).gt.0) then
             do ixt=1,niso  
               Renv(ixt,il)=xtp_avantevap_cas(ixt,il) &
     &          /qp_avantevap_cas(il)
             enddo !do ixt=1,niso  
          else if (q_cas(il).gt.0.0) then !if (qp_avantevap_cas(il).gt.0) then
             do ixt=1,niso  
               Renv(ixt,il)=xt_cas(ixt,il)/q_cas(il)
             enddo !do ixt=1,niso
          else
              ! aucune vapeur dispo pour condenser ensuite. On vérifie
              ! que la condensation est nulle
#ifdef ISOVERIF              
              call iso_verif_egalite((Eqi_prime_cas(il)), &
     &          0.0,'appel_stewart 1641')
#endif              
              do ixt=1,niso  
               Renv(ixt,il)=Rdefault(ixt)
             enddo !do ixt=1,niso 
           endif !if (qp_avantevap_cas(il).gt.0) then
         enddo !do il=1,ncas
         do il=1,ncas
           if (T_cas(il).ge.ztglace_Kelvin) then
             do ixt=1,niso
              Rcond(ixt,il)=zxtalphal(ixt,il)*Renv(ixt,il)
             enddo ! do ixt=1,niso
           else !if (T(il).ge.ztglace_Kelvin) then
               do ixt=1,niso
                Rcond(ixt,il)=zxtalphai(ixt,il)*Renv(ixt,il)
               enddo ! do ixt=1,niso               
           endif !if (T(il).ge.ztglace_Kelvin) then 
         enddo !do il=1,ncas
        do il=1,ncas
          if (Pqisup_cas(il).gt.0.0) then
             do ixt=1,niso
               Risup(ixt,il)=Pxtisup_cas(ixt,il)/Pqisup_cas(il)
             enddo !do ixt=1,niso
          else !if (Pqisup.gt.0.0) then
#ifdef ISOVERIF
              call iso_verif_egalite_choix(fcond(il),1.0, &
     &           'appel_stewart 1988',errmax,errmaxrel)
#endif              
             do ixt=1,niso
               Risup(ixt,il)=Rdefault(ixt)
             enddo !do ixt=1,niso
          endif  !if (Pqisup.gt.0.0) then 
         enddo !do il=1,ncas
#ifdef ISOVERIF
        if (iso_eau.gt.0) then
          do il=1,ncas
             call iso_verif_egalite_choix( &
     &          (Rcond(iso_eau,il)), &
     &          1.0,'appel_stewart 658, cas 1.2, Rcond', &
     &          errmax,errmaxrel)
             call iso_verif_egalite_choix( &
     &          (Risup(iso_eau,il)), &
     &          1.0,'appel_stewart 661, cas 1.2, Risup', &
     &          errmax,errmaxrel)
          enddo !do il=1,ncas
        endif !if (iso_eau.gt.0) then
        do il=1,ncas
          call iso_verif_noNAN((Eqi_prime_cas(il)), &
     &                  'appel stewart 1678a')
          do ixt=1,niso   
            call iso_verif_noNAN((Rcond(ixt,il)), &
     &                  'appel stewart 1678b')    
            call iso_verif_noNAN(xtevapsup_cas(ixt,il), &
     &                  'appel stewart 1678c')
         enddo
        enddo
#endif         
         do il=1,ncas
          do ixt=1,niso             
                 Exi_prime(ixt,il)=Rcond(ixt,il)*Eqi_prime_cas(il)   
                 xtevap_cas(ixt,il)=2.0*Exi_prime(ixt,il) &
     &                  /100.0/delP_cas(il)/sigd_cas(il)*g &
     &                  -xtevapsup_cas(ixt,il)    
                 xtwater_cas(ixt,il)=water_cas(il) &
     &                 *(Rcond(ixt,il)*fcond(il) &
     &                 +Risup(ixt,il)*(1.0-fcond(il)))
                 xtp_cas(ixt,il)=xtp_avantevap_cas(ixt,il)
           enddo !do ixt=1,niso
          enddo !do il=1,ncas

#ifdef ISOVERIF
          do il=1,ncas
            do ixt=1,niso   
              call iso_verif_noNAN(xtp_cas(ixt,il), &
     &                  'appel stewart 265.12: cas 1.2')
              if (iso_verif_noNAN_nostop(xtevap_cas(ixt,il), &
     &          'appel_stewart 286.12: cas 1.2, xtevap').eq.1) then
                write(*,*) 'ixt,il=',ixt,il
                write(*,*) 'Exi_prime(ixt,il)=',Exi_prime(ixt,il)
                write(*,*) 'delP_cas(il)=',delP_cas(il)
                write(*,*) 'sigd_cas(il)=',sigd_cas(il)
                write(*,*) 'xtevapsup_cas(ixt,il)=',xtevapsup_cas(ixt,il)
                CALL abort_physic('isotopes_routines_mod', 'appel_stewart 286.12: cas 1.2, xtevap', 1)
              endif !if (iso_verif_noNAN_nostop(xtevap_cas(ixt,il)
              call iso_verif_noNAN(xtwater_cas(ixt,il), &
     &          'appel_stewart 287.12: cas 1.2, xtwater')
            enddo !do ixt=1,niso   
          enddo !do il=1,ncas    
          if (iso_eau.gt.0) then
            do il=1,ncas 
              call iso_verif_egalite_choix(xtwater_cas(iso_eau,il), &
     &          water_cas(il), &
     &          'appel_stewart 262.12, cas 1.2', &
     &          errmax,errmaxrel)
              if ((xtwater_cas(iso_eau,il).eq.0).and. &
     &          (water_cas(il).gt.ridicule)) then
               write(*,*) 'appel_stewart 263.12, cas 1.2'
               write(*,*) 'xtwater(iso_eau,il,i)=', &
     &          xtwater_cas(iso_eau,il)
               write(*,*) 'water_cas(il)=',water_cas(il)
               stop
              endif
              if (oktrac.eq.0) then
              call iso_verif_egalite_choix(xtp_cas(iso_eau,il), &
     &          qp_cas(il) &
     &          ,'appel_stewart 269.12, cas 1.2',errmax,errmaxrel)
              call iso_verif_egalite_choix(xtevap_cas(iso_eau,il), &
     &          evap_cas(il),'appel_stewart 275.12, cas 1.2', &
     &          errmax,errmaxrel)
              endif !if (oktrac.eq.0) then              
             enddo !do il=1,ncas
            endif ! if (iso_eau.gt.0) then 
            if (oktrac.eq.0) then
            if (iso_HDO.gt.0) then                
             do il=1,ncas
              if (qp_cas(il).gt.ridicule) then
                call iso_verif_aberrant(xtp_cas(iso_HDO,il)/ &
     &          qp_cas(il), &
     &          'appel_stewart 763')
               endif !if (qp(cas_condensation_nofacftmr(il),i)
              enddo ! do il=1,ncas
            endif  ! if (iso_HDO.gt.0) then
           else !if (oktrac.eq.0) then
             if ((iso_HDO.gt.0).and.(iso_eau.gt.0)) then
              do il=1,ncas
               if (xtp_cas(iso_eau,il).gt.ridicule) then
                call iso_verif_aberrant(xtp_cas(iso_HDO,il)/ &
     &          xtp_cas(iso_eau,il), &
     &          'appel_stewart 1731')
                endif !if (qp(cas_condensation_nofacftmr(il),i)
               enddo ! do il=1,ncas
              endif  ! if (iso_HDO.gt.0) then
           endif !if (oktrac.eq.0) then
#endif

        end subroutine make_condensation_nofacftmr

        subroutine make_cas_noevap(ncas, &
     &         xtp_avantevap_cas,xtevapsup_cas, &
     &         Pxtisup_cas,Pqisup_cas,water_cas, &
     &         xtevap_cas,xtp_cas,xtwater_cas &
#ifdef ISOVERIF
     &         ,evap_cas,qp_cas,oktrac  &
#endif        
     &          ) 

  USE isotopes_mod, ONLY: iso_eau, iso_HDO, Rdefault,ridicule
#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel
USE isotopes_verif_mod
#endif
        implicit none

        ! inputs
        integer ncas
        real xtevapsup_cas(niso,ncas),water_cas(ncas)
        real  xtp_avantevap_cas(niso,ncas), &
     &  Pqisup_cas(ncas), Pxtisup_cas(niso,ncas)
#ifdef ISOVERIF        
        real evap_cas(ncas),qp_cas(ncas)
        integer oktrac ! si traceurs, certaines verifs ne sont pas
                !valides
#endif
        ! outputs
        real xtevap_cas(niso,ncas),xtp_cas(niso,ncas), &
     &           xtwater_cas(niso,ncas)

        ! locals
        real Risup(niso,ncas)
        integer il,ixt
        !real 

!        write(*,*) 'appel_stewart tmp 1530: Pxtisup_cas(iso_eau,2)=',
!     :           Pxtisup_cas(iso_eau,2)
!        write(*,*) 'Pqisup_cas(2)=',Pqisup_cas(2)
        do il=1,ncas
         do ixt=1,niso
             xtp_cas(ixt,il)=xtp_avantevap_cas(ixt,il)
             xtevap_cas(ixt,il)=-xtevapsup_cas(ixt,il)
         enddo  !do ixt=1,niso 
       enddo !do il=1,ncas_noevap
#ifdef ISOVERIF       
       do il=1,ncas
        if ((Pqisup_cas(il).le.0.0).and. &
     &          (water_cas(il).gt.ridicule*10)) then
            ! 27 mai 2009: on est plus laxiste dans le cas des traceurs
            ! d'eau: on met ridicule*10
            write(*,*) 'appel_stewart 372: water(il,i)=', &
     &        water_cas(il)
            write(*,*) 'appel_stewart 372: Pqisup=',Pqisup_cas(il)
            stop
         endif
         if (iso_eau.gt.0) then
             call iso_verif_egalite_choix( &
     &          (Pxtisup_cas(iso_eau,il)), &
     &          (Pqisup_cas(il)), &
     &          'appel_stewart 1548',errmax,errmaxrel)
         endif
         call iso_verif_noNAN(water_cas(il), &
     &                   'appel_stewart 1583')
        enddo !do il=1,ncas_noevap
#endif        
        do il=1,ncas
         if (Pqisup_cas(il).gt.0.0) then
            do ixt=1,niso  
              Risup(ixt,il)=Pxtisup_cas(ixt,il)/Pqisup_cas(il)
              xtwater_cas(ixt,il)=water_cas(il)*Risup(ixt,il)
            enddo !do ixt=1,niso
         else !if (Pqisup.gt.0.0) then
           do ixt=1,niso
            xtwater_cas(ixt,il)=water_cas(il)*Rdefault(ixt)
           enddo !do ixt=1,niso  
         endif  !if (Pqisup.gt.0.0) then  
        enddo !do il=1,ncas_noevap 

#ifdef ISOVERIF
          do il=1,ncas
            do ixt=1,niso   
              call iso_verif_noNAN(xtp_cas(ixt,il), &
     &                  'appel stewart 265.2: cas 1.1')
              call iso_verif_noNAN(xtevap_cas(ixt,il), &
     &            'appel_stewart 286')
              call iso_verif_noNAN(xtwater_cas(ixt,il), &
     &            'appel_stewart 1594')
            enddo !do ixt=1,niso   
          enddo !do il=1,ncas_noevap     
          if (iso_eau.gt.0) then
            do il=1,ncas
              call iso_verif_egalite_choix(xtwater_cas(iso_eau,il), &
     &          water_cas(il),'appel_stewart 262.2, cas 1.1', &
     &          errmax,errmaxrel)
              if ((xtwater_cas(iso_eau,il).eq.0).and. &
     &          (water_cas(il).gt.ridicule)) then
               write(*,*) 'appel_stewart 263.2, cas 1.1'
               write(*,*) 'xtwater(iso_eau,il)=',xtwater_cas(iso_eau,il)
               write(*,*) 'water(il)=',water_cas(il)
               stop
              endif
              if (oktrac.eq.0) then
!                  write(*,*) 'appel_stewart 1743 noevap tmp: il=',il
             call iso_verif_egalite_choix(xtp_cas(iso_eau,il), &
     &          qp_cas(il) &
     &          ,'appel_stewart 269.2, cas 1.1',errmax,errmaxrel)
              call iso_verif_egalite_choix(xtevap_cas(iso_eau,il), &
     &          evap_cas(il), &
     &          'appel_stewart 275.2, cas 1.1', &
     &          errmax,errmaxrel)
             endif !if (oktrac.eq.0) then
             enddo !do il=1,ncas
            endif ! if (iso_eau.gt.0) then
            if (oktrac.eq.0) then
            if (iso_HDO.gt.0) then
              do il=1,ncas
                if (qp_cas(il).gt.ridicule) then              
                call iso_verif_aberrant( &
     &          xtp_cas(iso_HDO,il)/qp_cas(il), &
     &          'appel_stewart 613')
                endif !if (qp(cas_noevap(il),i).gt.ridicule) then   
              enddo !do il=1,ncas 
            endif  ! if (iso_HDO.gt.0) then
            endif !if (oktrac.eq.0) then
#endif           

        end subroutine make_cas_noevap

        subroutine make_cas_evap_liq(ncas, &
     &          water_cas, &
     &          xtp_avantevap_cas,qp_avantevap_cas, &
     &          xtp_avantevaptrac_cas,qp_avantevaptrac_cas, &
     &          Pxtisup_cas,Pqisup_cas, &
     &          Eqi_stewart,Pqiinf_stewart,fac_ftmr_cas, &
     &          qs_cas, T_cas,wt_cas,  delP_cas, &
     &          xtevapsup_cas,qeff, g,sigd,Eqi_prime_cas, &
     &          qp_cas,INB_cas,i,oktrac &
#ifdef ISOTRAC        
     &          ,ptrac,hdiag &
#endif                
#ifdef ISOVERIF
     &          ,evap_cas,Exi_stewart &
#endif        
     &          ,xtp_cas,xtwater_cas,xtevap_cas) 

  USE isotopes_mod, ONLY: iso_eau, iso_HDO,no_pce, Rdefault,ridicule       
#ifdef ISOVERIF
USE isotopes_verif_mod
#endif
#ifdef ISOTRAC
USE isotrac_mod, only: ridicule_trac
#endif
        implicit none

        ! inputs
        integer ncas
        real xtp_avantevap_cas(niso,ncas), &
     &          qp_avantevap_cas(ncas)
        real xtp_avantevaptrac_cas(niso,ncas), &
     &          qp_avantevaptrac_cas(ncas)
        ! dans le cas des traceurs: xtp_avantevaptrac_cas est la
        ! quantité de traceur izone dans la vapeur
        ! alors que xtp_avantevap_cas est le total de toutes les zone
        ! on rééquilibre la goutte avec le total de toutes les zones,
        ! mais c'est xtp_avantevaptrac_cas qui recoit l'évap
        real Pqisup_cas(ncas), Pxtisup_cas(niso,ncas)
        real Pqiinf_stewart(ncas), Eqi_stewart(ncas)
        real fac_ftmr_cas(ncas),Eqi_prime_cas(ncas)
        real T_cas(ncas),delP_cas(ncas), &
     &          xtevapsup_cas(niso,ncas), &
     &          wt_cas(ncas),qeff(ncas), &
     &          qs_cas(ncas),water_cas(ncas), &
     &          qp_cas(ncas)  
        integer oktrac      
#ifdef ISOTRAC        
        real ptrac(ncas)  
        real hdiag(ncas)
#endif        
#ifdef ISOVERIF        
        real evap_cas(ncas)   
#endif        
        integer INB_cas(ncas),i
        real g,sigd(ncas)
        ! outputs
        real  xtp_cas(niso,ncas),xtwater_cas(niso,ncas), &
     &          xtevap_cas(niso,ncas)        

        ! locals        
        integer il,ixt        
        real Pxtiinf_stewart(niso,ncas),  &
     &          Exi_stewart(niso,ncas) 
        real xtnew(niso,ncas)
!#ifdef ISOVERIF
!        integer iso_verif_egalite_choix_nostop
!        integer iso_verif_aberrant_nostop
!        real 
!        real deltaD
!        integer iso_verif_aberrant_choix_nostop
!#endif        

#ifdef ISOVERIF
!        if (ncas.ge.162) then
!        write(*,*) 'appel tmp 1975: xtp_avantevap_cas(iso_eau,162)=',
!     :           xtp_avantevap_cas(iso_eau,162)
!        write(*,*) 'appel tmp 1975b: qp_avantevap_cas(162)=',
!     :           qp_avantevap_cas(162)
!        endif !if (ncas_evap_liq.ge.162) then
      if (iso_eau.gt.0) then
          do il=1,ncas
!            write(*,*) 'appel tmp 1492: il=',il
            call iso_verif_egalite_choix( &
     &       (xtp_avantevap_cas(iso_eau,il)), &
     &       (qp_avantevap_cas(il)), &
     &       'appel_stewart 473', &
     &       errmax,errmaxrel)
            call iso_verif_egalite_choix( &
     &       (xtp_avantevaptrac_cas(iso_eau,il)), &
     &       (qp_avantevaptrac_cas(il)), &
     &       'appel_stewart 473b',errmax,errmaxrel)
            call iso_verif_egalite_choix( &
     &       (Pxtisup_cas(iso_eau,il)), &
     &       (Pqisup_cas(il)),'appel_stewart 475', &
     &       errmax,errmaxrel)
           enddo !do il=1,ncas
       endif !if (iso_eau.gt.0) then
#endif   

#ifdef ISOTRAC       
       ! à l'avenir, il faudra faire les choses plus proprement!
       if (oktrac.eq.1) then
           ! on renormalise le flux de précip et d'évap
           ! on suppose que la seule différence entre les différentes
           ! zones, c'est la compo du liquide
           do il=1,ncas
            if (ptrac(il).gt.1e-20) then
             Pqisup_cas(il)=Pqisup_cas(il)/ptrac(il)
             Eqi_stewart(il)=Eqi_stewart(il)/ptrac(il)
             Pqiinf_stewart(il)=Pqiinf_stewart(il)/ptrac(il)
             do ixt=1,niso
               Pxtisup_cas(ixt,il)=Pxtisup_cas(ixt,il)/ptrac(il)
             enddo
            else !if (ptrac(il).gt.0.0) then
#ifdef ISOVERIF                
             call iso_verif_egalite((Pqisup_cas(il)), &
     &          0.0,'appel 2104')  
             call iso_verif_egalite((Eqi_stewart(il)), &
     &          0.0,'appel 2105')
             call iso_verif_egalite((Pqiinf_stewart(il)), &
     &          0.0,'appel 2106')
#endif             
             Pqisup_cas(il)=0.0
             Eqi_stewart(il)=0.0
             Pqiinf_stewart(il)=0.0
             do ixt=1,niso
               Pxtisup_cas(ixt,il)=0.0
             enddo   
            endif !if (ptrac(il).gt.0.0) then
           enddo !do il=1,ncas
       endif !if (oktrac.eq.1) then
#endif       
        

        if (no_pce.eq.1) then
            call stewart_sublim_nofrac_vectall( &
     &       ncas,qp_avantevap_cas(1), &
     &       xtp_avantevap_cas(1,1),Pqisup_cas(1), &
     &       Pxtisup_cas(1,1),Eqi_stewart(1),Pqiinf_stewart(1), &
     &       Pxtiinf_stewart(1,1),xtnew(1,1),Exi_stewart(1,1), &
     &       fac_ftmr_cas(1))
        else !if (no_pce.eq.1) then
      call stewart_explicite_vectall(ncas, &
     &       qp_avantevap_cas(1),xtp_avantevap_cas(1,1), &
     &       Pqisup_cas,Pxtisup_cas(1,1),Eqi_stewart(1), &
     &          Pqiinf_stewart(1),qeff(1), &
     &       Pxtiinf_stewart(1,1),xtnew(1,1),Exi_stewart(1,1), &
     &          fac_ftmr_cas(1), &
     &       qs_cas(1),T_cas(1),wt_cas(1),delP_cas(1) &
#ifdef ISOVERIF
     &         ,0,73 &
#endif
     &  )
         endif !if (no_pce.eq.1) then

#ifdef ISOTRAC      
      ! à l'avenir, il faudra faire les choses plus proprement!
      if (oktrac.eq.1) then
           ! on renormalise le flux de précip et d'évap
           ! on suppose que la seule différence entre les différentes
           ! zones, c'est la compo du liquide
           do il=1,ncas
             Pqisup_cas(il)=Pqisup_cas(il)*ptrac(il)
             Eqi_stewart(il)=Eqi_stewart(il)*ptrac(il)
             Pqiinf_stewart(il)=Pqiinf_stewart(il)*ptrac(il)
             do ixt=1,niso
               Pxtisup_cas(ixt,il)=Pxtisup_cas(ixt,il)*ptrac(il)
               Exi_stewart(ixt,il)=Exi_stewart(ixt,il)*ptrac(il)
               Pxtiinf_stewart(ixt,il)=Pxtiinf_stewart(ixt,il)*ptrac(il)
               xtnew(ixt,il)=xtp_avantevap_cas(ixt,il) &
     &          +(xtnew(ixt,il)-xtp_avantevap_cas(ixt,il))*ptrac(il)
             enddo
             hdiag(il)=qeff(il)/qs_cas(il)
           enddo !do il=1,ncas
       endif !if (oktrac.eq.1) then
#endif

#ifdef ISOVERIF
       if (iso_eau.gt.0) then
          do il=1,ncas     
                call iso_verif_egalite_choix( &
     &           (Exi_stewart(iso_eau,il) &
     &           *fac_ftmr_cas(il)), &
     &           (Eqi_stewart(il)*fac_ftmr_cas(il)), &
     &           'appel stewart 520',errmax*80,errmaxrel*80)
                call iso_verif_egalite_choix( &
     &          (Pxtiinf_stewart(iso_eau,il)), &
     &          (Pqiinf_stewart(il)), &
     &          'appel_stewart 586', &
     &          errmax,errmaxrel)
                if (Pqiinf_stewart(il).gt.ridicule) then
                  call iso_verif_egalite_choix(( &
     &             Pxtiinf_stewart(iso_eau,il)/Pqiinf_stewart(il)), &
     &             1.,'appel_setwart 575a', errmax*10, errmaxrel*10)
                endif !if (Pqiinf_par.gt.ridicule) then
           enddo !do il=1,ncas     
        endif !if (iso_eau.gt.0) then  
        do il=1,ncas 
           call iso_verif_noNAN(water_cas(il),  &
     &          'appel_stewart 2009') 
           call iso_verif_noNAN((Pqiinf_stewart(il)),  &
     &          'appel_stewart 2011')
           do ixt=1,niso
           call iso_verif_noNAN(( &
     &          Pxtiinf_stewart(ixt,il)),'appel_stewart 2014')
           enddo
        enddo      
#endif 
           
        ! deduction de XTWATER à partir de Pxtiinf:
! hypothèse: l'eau en i a la même composition que le flux d'eau
        ! qui sort de la boite i (Pqiinf_par)
        do il=1,ncas
          if (abs(water_cas(il)).lt.ridicule/10.) then
            do ixt=1,niso
               xtwater_cas(ixt,il)=0.0
            enddo !do ixt=1,niso
          else !if (water(il,i).eq.0.0) then
             if (Pqiinf_stewart(il).gt.0.0) then  !if (Pxtiinf_par(iso_eau).gt.0.0) then 
               do ixt=1,niso 
                 xtwater_cas(ixt,il)=water_cas(il) &
     &             *Pxtiinf_stewart(ixt,il)/Pqiinf_stewart(il)
               enddo
             else !if (Pxtiinf_stewart(iso_eau).gt.0.0) then
                 ! normalement, ce cas a déjà été interdit dans
                 ! compress_evp_glace
                do ixt=1,niso
                  xtwater_cas(ixt,il)=water_cas(il)*Rdefault(ixt)
                enddo !do ixt=1,niso
             endif
           endif !if (water(il,i).eq.0.0) then
         enddo !do il=1,ncas
        
#ifdef ISOVERIF
       do il=1,ncas
        do ixt=1,niso
          call iso_verif_noNAN(xtwater_cas(ixt,il),  &
     &         'appel_stewart 566')
        enddo !do ixt=1,niso
        if (iso_eau.gt.0) then
         call iso_verif_egalite_choix(xtwater_cas(iso_eau,il), &
     &          water_cas(il),'appel_stewart 568',errmax,errmaxrel)
         if (water_cas(il).gt.ridicule*10) then
             if (iso_verif_egalite_choix_nostop( &
     &          xtwater_cas(iso_eau,il)/water_cas(il),1.0, &
     &          'appel stewart 155',errmax*10,errmaxrel*10).eq.1) then
!               write(*,*) 'i=',i
               write(*,*) 'Tevap=',T_cas(il)
               write(*,*) 'xtwater(iso_eau,il,i)=', &
     &                  xtwater_cas(iso_eau,il)
               write(*,*) 'water(il,i)=',water_cas(il)
               write(*,*) 'Pxtiinf_stewart(iso_eau)=', &
     &                   Pxtiinf_stewart(iso_eau,il)
!               write(*,*) 'Pqiinf_par,Pqiinf_stewart=',
!     &             Pqiinf_par(cas_evap_liq(il)),Pqiinf_stewart(il)
               stop
             endif  !if (iso_verif_egalite_nostop(
         endif !if (water(il,i).gt.ridicule) then
        endif !if (iso_eau.gt.0) then
       enddo !do il=1,ncas
#endif

      
        ! rappel, le Eqi_prime qu'on a mis en argument dans stewart est en
        ! fait égal à 0.5*(Eqi+Eqi+1) -> en tenir compte quand on
        ! calcule xtevapi.    
       do il=1,ncas
        if (Eqi_stewart(il).gt.0.0) then
         do ixt=1,niso          
          xtevap_cas(ixt,il)=Eqi_prime_cas(il) &
     &          *Exi_stewart(ixt,il)/Eqi_stewart(il) &
     &          /100/delP_cas(il)/sigd(il)*g*2 &
     &           -xtevapsup_cas(ixt,il)        
         enddo ! do ixt=1,niso
        else !if (Eqi_stewart.gt.0.0) then
            ! il peut quand même y a voir de la diffusion
            do ixt=1,niso
            xtevap_cas(ixt,il)=Exi_stewart(ixt,il) &
     &          /100.0/delP_cas(il)/sigd(il)*g*2.0 &
     &           -xtevapsup_cas(ixt,il)
            enddo !do ixt=1,niso    
        endif !if (Eqi_stewart.gt.0.0) then
       enddo !do il=1,ncas
      
#ifdef ISOVERIF
      do il=1,ncas
        do ixt=1,niso
          call iso_verif_noNAN(xtevap_cas(ixt,il),'appel stewart 131')
        enddo ! do ixt=1,nisio
        if (oktrac.eq.0) then 
            ! dans le cas traceur, le calcul de evap_cas est plus
            ! compliqué: il faut le faire plus proprement dans
            ! compress_stewart
        if (iso_eau.gt.0) then
            if (iso_verif_egalite_choix_nostop(xtevap_cas(iso_eau,il), &
     &           evap_cas(il),'appel stewart 142', &
     &          errmax,errmaxrel).eq.1) then
              write(*,*) 'il=',il
              write(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
              write(*,*) 'Eqi_stewart(il)=',Eqi_stewart(il)
              write(*,*) 'Exi_stewart(iso_eau,il)=', &
     &          Exi_stewart(iso_eau,il)
              write(*,*) '1/100/delP_cas(il)/sigd(il)*g*2=', &
     &           1.0/100.0/delP_cas(il)/sigd(il)*g*2.0
              write(*,*) 'xtevapsup_cas(iso_eau,il)=', &
     &          xtevapsup_cas(iso_eau,il)
              stop
            endif
        endif !if (iso_eau.gt.0) then
        endif !if (oktrac.eq.0) then 
#ifdef ISOTRAC
        if (oktrac.eq.1) then 
        if ((iso_eau.gt.0).and.(iso_HDO.gt.0)) then
             call iso_verif_aberrant_choix( &
     &          (xtp_avantevaptrac_cas(iso_HDO,il)), &
     &          (xtp_avantevaptrac_cas(iso_eau,il)), &
     &          ridicule_trac,deltalimtrac, &
     &          'appel_stewart 2053')
        endif !if ((iso_eau.gt.0).and.(iso_HDO.gt.0)) then
        endif
#endif
      enddo !do il=1,ncas 
#endif

      ! deduction de XTP partir de Exi
      
      do il=1,ncas
       if (i.lt.INB_cas(il)) then
          if (fac_ftmr_cas(il).gt.0.0) then
             if (Eqi_stewart(il)*fac_ftmr_cas(il).gt.ridicule) then 
               do ixt=1,niso               
               !   xtp(ixt,il,i)=xtnew(ixt)*qp(il,i)/xtnew(4)
                  xtp_cas(ixt,il)=max(xtp_avantevaptrac_cas(ixt,il)  &
     &                 +fac_ftmr_cas(il)*Eqi_prime_cas(il) &
     &                 *Exi_stewart(ixt,il)/Eqi_stewart(il),0.0)
               enddo !do ixt=1,niso
             else ! if (Eqi_stewart.gt.ridicule) then
                if (qp_cas(il).gt.0.0) then 

                    if (Eqi_prime_cas(il)*fac_ftmr_cas(il).gt.ridicule) &
     &                   then 
                        ! il va manquer quelque chose: il faut augmenter
                        ! xtp en lui ajoutant l'évap du niveau d'eau
                        ! dessus
                        ! pour l'instant, on bidouille:
                        write(*,*) 'appel_stewart 2487: il=',il
                        do ixt=1,niso               
                        xtnew(ixt,il)=xtnew(ixt,il) &
     &                   *(qp_avantevap_cas(il) &
     &                   +Eqi_prime_cas(il)*fac_ftmr_cas(il)) &
     &                   /(qp_avantevap_cas(il) &
     &                   +Eqi_stewart(il)*fac_ftmr_cas(il))
                        enddo
                    endif !if (Eqi_prime_cas(il)*fac_ftmr_cas(il).gt.ridicule)

                    do ixt=1,niso               
!                      xtp_cas(ixt,il)=xtnew(ixt,il)
                      xtp_cas(ixt,il)=(xtp_avantevaptrac_cas(ixt,il) &
     &                          +(xtnew(ixt,il) &
     &                          -xtp_avantevap_cas(ixt,il)))
                      ! modif 1 mai 2009, pour le cas des traceurs
                    enddo !do ixt=1,niso
!                    write(*,*) 'appel_stewart 1963 tmp: ',
!     :                  'xtp_cas(iso_eau,il)=',xtp_cas(iso_eau,il)
                else !if (qp(il,i).gt.0.0) then 
                  do ixt=1,niso               
                    xtp_cas(ixt,il)=0.0
                  enddo !do ixt=1,niso
                endif  !if (qp(il,i).gt.0.0) then 
            endif !if (Eqi_stewart.gt.ridicule) then 

#ifdef ISOVERIF       
!            if (il.eq.87) then
!                write(*,*) 'appel_stewart 2244: tmp, après calcul xtp'
!                write(*,*) 'xtnew(:,il)=',xtnew(:,il)
!                write(*,*) 'Pxtiinf_stewart(:,il)=',
!     :             Pxtiinf_stewart(:,il)
!            endif  !if (il.eq.87) then    
            do ixt=1,niso
                call iso_verif_noNAN(xtp_cas(ixt,il), &
     &                 'appel stewart 684')
            enddo ! do ixt=1,niso
#ifdef ISOTRAC
            if (oktrac.eq.1) then
            if ((iso_HDO.gt.0).and.(iso_eau.gt.0)) then
                ! le 10 mai 2009: on remonte le seuil de vérif de deltaD
                ! aberrant car dans le cas des traceurs, des très
                ! petites concentrations sont très facilement
                ! influencées par des évaps qui peuvent être aberantes
                ! si ces evaps sont petites
                if (iso_verif_aberrant_choix_nostop( &
     &          xtp_cas(iso_HDO,il),xtp_cas(iso_eau,il), &
     &          ridicule_trac,deltalimtrac, &
     &          'appel_stewart 2090').eq.1) then
                  write(*,*) 'xtp_avantevaptrac_cas(iso_eau),deltaD=', &
     &             xtp_avantevaptrac_cas(iso_eau,il),deltaD &
     &             ((xtp_avantevaptrac_cas(iso_HDO,il)) &
     &             /(xtp_avantevaptrac_cas(iso_eau,il)))
                  write(*,*) 'xtp_avantevap_cas(iso_eau),deltaD=', &
     &             xtp_avantevap_cas(iso_eau,il),deltaD &
     &             ((xtp_avantevap_cas(iso_HDO,il)) &
     &             /(xtp_avantevap_cas(iso_eau,il)))
                  write(*,*) 'xtnew(iso_eau),deltaD=', &
     &             xtnew(iso_eau,il),deltaD &
     &             ((xtnew(iso_HDO,il)) &
     &             /(xtnew(iso_eau,il)))
                  write(*,*) 'xtp_cas(iso_eau),deltaD=', &
     &             xtp_cas(iso_eau,il),deltaD &
     &             (xtp_cas(iso_HDO,il)/xtp_cas(iso_eau,il))
                  write(*,*) 'Eqi_stewart(il),fac_ftmr_cas(il)=', &
     &                  Eqi_stewart(il),fac_ftmr_cas(il)
                  write(*,*) 'Eqi_prime_cas(il)=', &
     &                  Eqi_prime_cas(il)
                  write(*,*) 'deltaD_Eqi_stewart=', &
     &                  deltaD(( &
     &                  Exi_stewart(iso_HDO,il)/Eqi_stewart(il)))
                  write(*,*) 'xtnew-xtp_avantevap_cas,deltaD=', &
     &                xtnew(iso_eau,il)-xtp_avantevap_cas(iso_eau,il), &
     &                deltaD(((xtnew(iso_HDO,il) &
     &                -xtp_avantevap_cas(iso_HDO,il))/ &
     &                (xtnew(iso_eau,il) &
     &                -xtp_avantevap_cas(iso_eau,il))))  
                  write(*,*) 'Pqisup,deltaD=', &
     &                  Pqisup_cas(il),deltaD(( &
     &                  Pxtisup_cas(iso_HDO,il)/Pqisup_cas(il)))
                  stop
                endif
        endif !if (iso_HDO.gt.0) then
       endif !if (oktrac.eq.1) then
#endif
! #ifdef ISOTRAC
          if (oktrac.eq.0) then
            if (iso_eau.gt.0) then
             call iso_verif_egalite_choix(xtp_cas(iso_eau,il), &
     &        qp_cas(il),'appel stewart 688', &
     &          errmax,errmaxrel*30)
           endif !if (iso_eau.gt.0) then

           if ((iso_HDO.gt.0).and. &
     &          (qp_cas(il).gt.ridicule)) then
             if (iso_verif_aberrant_nostop(xtp_cas(iso_HDO,il)/ &
     &        qp_cas(il), &
     &        'appel_stewart_vectall 1079').eq.1) then
               write(*,*) 'i,qp(cas_evap_liq(il),i)=', &
     &                  i,qp_cas(il) 
               write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
               write(*,*) 'deltaDxtnew=',deltaD(( &
     &          xtnew(iso_HDO,il))/qp_cas(il))
               stop
             endif
           endif !if (iso_HDO.gt.0) then 
        endif ! if (oktrac.eq.0) then
#endif              

          else !if (fac_ftmr.gt.0.0) then
              ! ca veut dire que Mp=0, xtp pas définit
             do ixt=1,niso
               xtp_cas(ixt,il)=xtp_avantevaptrac_cas(ixt,il)
             enddo !do ixt=1,niso
         endif !if (fac_ftmr.gt.0.0) then
      else !if (i.lt.INB) then
          ! si i=inb, on ne change rien au calcul original, et on
          ! suppose que la composition du ddft est égale à celle de
          ! l'env. Ceci a déjà été calculé plus haut
                  do ixt=1,niso
                    xtp_cas(ixt,il)=xtp_avantevaptrac_cas(ixt,il)
                    !xtp_avantevap(ixt) a déjà été définit proprement
                    !dans ce cas là
                  enddo
      endif !if (i.lt.INB) then
      enddo !do il=1,ncas

      ! verif
#ifdef ISOVERIF
      do il=1,ncas
        do ixt=1,niso
         call iso_verif_noNAN(xtp_cas(ixt,il),'appel stewart 198')
         call iso_verif_noNAN(xtevap_cas(ixt,il),'appel stewart 745')
        enddo !do ixt=1,niso
#ifdef ISOTRAC
        if ((iso_HDO.gt.0).and.(iso_eau.gt.0)) then
          if (oktrac.eq.1) then
              call iso_verif_aberrant_choix( &
     &          xtp_cas(iso_HDO,il),xtp_cas(iso_eau,il), &
     &          ridicule,deltalim,'appel_stewart 2138')
          endif
        endif !if (iso_HDO.gt.0) then
#endif
      enddo !do il=1,ncas  
      
!#ifdef ISOTRAC
      if (oktrac.eq.0) then
      if (iso_eau.gt.0) then
       do il=1,ncas       
        if (iso_verif_egalite_choix_nostop( &
     &           xtp_cas(iso_eau,il), &
     &           qp_cas(il), &
     &          'appel stewart 197', &
     &          errmax,errmaxrel*50).eq.1) then   
          write(*,*) 'i=',i,' INB=',INB_cas(il)
          write(*,*) 'Tevap=',T_cas(il)
          write(*,*) 'xtp(iso_eau,il,i)=',xtp_cas(iso_eau,il)
          write(*,*) 'qp(il,i)=',qp_cas(il)
          write(*,*) 'xtnew(iso_eau)=',xtnew(iso_eau,il)
          write(*,*) 'fac_ftmr=',fac_ftmr_cas(il)
!          write(*,*) 'Mp(il,i)=',Mp(cas_evap_liq(il),i)
          write(*,*) 'xtp_avantevap(iso_eau)=', &
     &          xtp_avantevap_cas(iso_eau,il)
          write(*,*) 'qp_avantevap=',qp_avantevap_cas(il)
!          write(*,*) 'Exi_prime(iso_eau)=',Exi_prime(iso_eau,il)
!          write(*,*) 'Eqi_prime=',Eqi_prime(il)       
          write(*,*) 'Pxtiinf_stewart(iso_eau)=', &
     &           Pxtiinf_stewart(iso_eau,il)
!          write(*,*) 'Pqiinf_par=',Pqiinf_par(cas_evap_liq(il))
          write(*,*) 'Pxtisup(iso_eau)=',Pxtisup_cas(iso_eau,il)
          write(*,*) 'Pqisup=',Pqisup_cas(il)
          stop
         endif !if iso_verif_egalite_choix_nostop
        enddo !do il=1,ncas
      endif !if (iso_eau.gt.0) then
      if (iso_HDO.gt.0) then            
       do il=1,ncas
!        write(*,*) 'appel_stewart 2166: fin make_cas_evap_liq, ',
!     &       'il,deltaDqp=',il,deltaD(xtp_cas(iso_HDO,il)/qp_cas(il))
        if (qp_cas(il).gt.ridicule) then
          call iso_verif_aberrant( &
     &          xtp_cas(iso_HDO,il)/qp_cas(il), &
     &          'appel_stewart 1130')
        endif !if (qp(cas_evap_liq(il),i).gt.ridicule) then
       enddo !do il=1,ncas     
      endif 
      endif ! if (oktrac.eq.0) then
!#endif
! ISOTRAC
#endif

      end subroutine make_cas_evap_liq

      subroutine make_cas_evap_glace(ncas, &
     &          water_cas, &
     &          xtp_avantevap_cas,qp_avantevap_cas, &
     &          xtp_avantevaptrac_cas,qp_avantevaptrac_cas, &
     &          Pxtisup_cas,Pqisup_cas, &
     &          Eqi_stewart,Eqi_prime_cas, &
     &          Pqiinf_stewart,fac_ftmr_cas, &
     &          qs_cas, T_cas,wt_cas,  delP_cas, &
     &          xtevapsup_cas,g,sigd,INB_cas,i, &
     &          frac_sublim,qp_cas &
#ifdef ISOVERIF      
     &          ,evap_cas,oktrac,Exi_stewart &
#endif
     &          ,xtp_cas,xtwater_cas,xtevap_cas) 

  USE isotopes_mod, ONLY: iso_eau, iso_HDO, Rdefault, ridicule
#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel
USE isotopes_verif_mod
#endif
      implicit none

        ! inputs
        integer ncas
        real xtp_avantevap_cas(niso,ncas), &
     &          qp_avantevap_cas(ncas)
        real xtp_avantevaptrac_cas(niso,ncas), &
     &          qp_avantevaptrac_cas(ncas)
        real Pqisup_cas(ncas), Pxtisup_cas(niso,ncas)
        real Pqiinf_stewart(ncas), Eqi_stewart(ncas)
        real fac_ftmr_cas(ncas),Eqi_prime_cas(ncas)
        real T_cas(ncas),delP_cas(ncas), &
     &          xtevapsup_cas(niso,ncas), &
     &          wt_cas(ncas),qeff(ncas), &
     &          qs_cas(ncas),water_cas(ncas)
        real qp_cas(ncas)      
#ifdef ISOVERIF
        real evap_cas(ncas)
        integer oktrac
#endif        
        real g,sigd(ncas)
        integer frac_sublim
        integer INB_cas(ncas),i
        ! outputs
        real  xtp_cas(niso,ncas),xtwater_cas(niso,ncas), &
     &          xtevap_cas(niso,ncas)
        ! locals        
        integer il,ixt
        real Pxtiinf_stewart(niso,ncas),  &
     &          Exi_stewart(niso,ncas)   
        real xtnew(niso,ncas)     
!#ifdef ISOVERIF
!        real 
!        integer iso_verif_egalite_choix_nostop
!        integer iso_verif_aberrant_nostop
!        real deltaD
!#endif        

#ifdef ISOVERIF  
!      write(*,*) 'appel_stewart 2052: entrée dans make_cas_evap_glace'
      if (iso_eau.gt.0) then
          do il=1,ncas
            call iso_verif_egalite_choix( &
     &       (xtp_avantevap_cas(iso_eau,il)), &
     &       (qp_avantevap_cas(il)), &
     &          'appel_stewart 473b', &
     &       errmax,errmaxrel)
            call iso_verif_egalite_choix( &
     &       (Pxtisup_cas(iso_eau,il)), &
     &       (Pqisup_cas(il)),'appel_stewart 475b', &
     &       errmax,errmaxrel)
           enddo !do il=1,ncas 
       endif !if (iso_eau.gt.0) then
#endif    
     

      ! calculs des flux de masses à mettre en argument de stewart:
      ! comme l'eau n'est pas bien concervée dans les ddfts, on est
      ! obligé de bidouillé.
      ! 1) soit on considère Pqisup, Eqi, et Pqiinf_par=Pqisup-Eqi
      !    et on suppose que dans la réalité les compositions de
      !    Pqiinf sont les même que Pqiinf_par
      ! 2) soit on considère Pqisup, Eqi_par=Pqisup-Pqiinf, et Pqiinf,
      !    et on suppose que dans la réalité les compositions de
      !    Eqi_prime sont les même que Eqi_par

      if (frac_sublim.eq.1) then
            call stewart_glace_vectall(ncas, &
     &       qp_avantevap_cas(1),xtp_avantevap_cas(1,1),Pqisup_cas(1), &
     &       Pxtisup_cas(1,1),Eqi_stewart(1),Pqiinf_stewart(1), &
     &       Pxtiinf_stewart(1,1),xtnew(1,1),Exi_stewart(1,1), &
     &       fac_ftmr_cas(1), &
     &       T_cas(1))
      else !if (frac_sublim.eq.1) then
!#ifdef ISOVERIF
!            write(*,*) 'appel_stewart_explicite 2736'
!#endif          
            call stewart_sublim_nofrac_vectall( &
     &       ncas,qp_avantevap_cas(1), &
     &       xtp_avantevap_cas(1,1),Pqisup_cas(1), &
     &       Pxtisup_cas(1,1),Eqi_stewart(1),Pqiinf_stewart(1), &
     &       Pxtiinf_stewart(1,1),xtnew(1,1),Exi_stewart(1,1), &
     &       fac_ftmr_cas(1))
      endif !if (frac_sublim.eq.1) then
      

#ifdef ISOVERIF
!       write(*,*) 'appel_stewart 2096: dans make_cas_evap_glace'
       if (iso_eau.gt.0) then
          do il=1,ncas       
             call iso_verif_egalite_choix( &
     &       (Exi_stewart(iso_eau,il)*fac_ftmr_cas(il)), &
     &       (Eqi_stewart(il)*fac_ftmr_cas(il)), &
     &       'appel stewart 520b',errmax*80,errmaxrel*80)
             call iso_verif_egalite_choix( &
     &         (Pxtiinf_stewart(iso_eau,il)), &
     &         (Pqiinf_stewart(il)), &
     &          'appel_stewart 586', &
     &         errmax,errmaxrel)
             if (Pqiinf_stewart(il).gt.ridicule) then
                if (iso_verif_egalite_choix_nostop(( &
     &          Pxtiinf_stewart(iso_eau,il)/Pqiinf_stewart(il)), &
     &          1.,'appel_setwart 575b', errmax*10, errmaxrel*10) &
     &           .eq.1) then
                   write(*,*) 'Pqiinf_stewart(il)=',Pqiinf_stewart(il)
!                   write(*,*) 'Pqiinf_par(il)=',Pqiinf_par(il)
                   write(*,*) 'Pxtiinf_stewart(iso_eau,il)=', &
     &                  Pxtiinf_stewart(iso_eau,il)
                   stop
                endif
             endif !if (Pqiinf_par.gt.ridicule) then
           enddo !do il=1,ncas       
        endif !if (iso_eau.gt.0) then
#endif     

        ! deduction de XTWATER à partir de Pxtiinf:
! hypothèse: l'eau en i a la même composition que le flux d'eau
        ! qui sort de la boite i (Pqiinf_par)
        do il=1,ncas
          if (abs(water_cas(il)).lt.ridicule/10.) then
            do ixt=1,niso
               xtwater_cas(ixt,il)=water_cas(il)*Rdefault(ixt)
            enddo !do ixt=1,niso
          else !if (water(il,i).eq.0.0) then
             if (Pqiinf_stewart(il).gt.0.0) then  !if (Pxtiinf_par(iso_eau).gt.0.0) then 
               do ixt=1,niso 
                 xtwater_cas(ixt,il)=water_cas(il) &
     &             *Pxtiinf_stewart(ixt,il)/Pqiinf_stewart(il)
               enddo
             else !if (Pxtiinf_stewart(iso_eau).gt.0.0) then
                 ! normalement, ce cas a déjà été interdit dans
                 ! compress_evp_glace
                do ixt=1,niso
                  xtwater_cas(ixt,il)=water_cas(il)*Rdefault(ixt)
                enddo !do ixt=1,niso
             endif
           endif !if (water(il,i).eq.0.0) then
         enddo !do il=1,ncas
        
#ifdef ISOVERIF
!       write(*,*) 'appel_stewart 2563: dans make_cas_evap_glace'
       do il=1,ncas
        do ixt=1,niso
         call iso_verif_noNAN(xtwater_cas(ixt,il),  &
     &          'appel_stewart 566b')
        enddo !do ixt=1,niso
        if (iso_eau.gt.0) then
         call iso_verif_egalite_choix(xtwater_cas(iso_eau,il), &
     &          water_cas(il),'appel_stewart 568b',errmax,errmaxrel)
         if (water_cas(il).gt.ridicule*10) then
             if (iso_verif_egalite_choix_nostop( &
     &          xtwater_cas(iso_eau,il)/water_cas(il),1.0, &
     &          'appel stewart 155b',errmax*10,errmaxrel*10).eq.1) then
               write(*,*) 'i=',i
               write(*,*) 'Tevap=',T_cas(il)
               write(*,*) 'xtwater(iso_eau,il,i)=', &
     &                  xtwater_cas(iso_eau,il)
               write(*,*) 'water(il,i)=',water_cas(il)
               write(*,*) 'Pxtiinf_stewart(iso_eau)=', &
     &                   Pxtiinf_stewart(iso_eau,il)
!               write(*,*) 'Pqiinf_par,Pqiinf_stewart=',
!     &                  Pqiinf_par(il),Pqiinf_stewart(il)
               stop
             endif  !if (iso_verif_egalite_nostop(
         endif !if (water(il,i).gt.ridicule) then
        endif !if (iso_eau.gt.0) then
       enddo !do il=1,ncas
#endif

      
        ! rappel, le Eqi_prime qu'on a mis en argument dans stewart est en
        ! fait égal à 0.5*(Eqi+Eqi+1) -> en tenir compte quand on
        ! calcule xtevapi.    
       do il=1,ncas
        if (Eqi_stewart(il).gt.0.0) then
         do ixt=1,niso          
          xtevap_cas(ixt,il)=Eqi_prime_cas(il) &
     &          *Exi_stewart(ixt,il)/Eqi_stewart(il) &
     &          /100.0/delP_cas(il)/sigd(il)*g*2.0 &
     &           -xtevapsup_cas(ixt,il)        
         enddo ! do ixt=1,niso
        else !if (Eqi_stewart.gt.0.0) then
            ! il peut quand même y a voir de la diffusion
            do ixt=1,niso
            xtevap_cas(ixt,il)=Exi_stewart(ixt,il) &
     &          /100.0/delP_cas(il)/sigd(il)*g*2.0 &
     &           -xtevapsup_cas(ixt,il)
            enddo !do ixt=1,niso    
        endif !if (Eqi_stewart.gt.0.0) then
       enddo !do il=1,ncas
      
#ifdef ISOVERIF
      do il=1,ncas
        do ixt=1,niso
          call iso_verif_noNAN(xtevap_cas(ixt,il),'appel stewart 131b')
        enddo ! do ixt=1,niso
        if (oktrac.eq.0) then 
            ! dans le cas traceur, le calcul de evap_cas est plus
            ! compliqué: il faut le faire plus proprement dans
            ! compress_stewart
        if (iso_eau.gt.0) then
            if (iso_verif_egalite_choix_nostop(xtevap_cas(iso_eau,il), &
     &        evap_cas(il), &
     &        'appel stewart 142b',errmax,errmaxrel).eq.1) then
                write(*,*) 'i,il=',i,il
                write(*,*) 'Exi_stewart(iso_eau,il),Eqi_stewart(il)=', &
     &                  Exi_stewart(iso_eau,il),Eqi_stewart(il) 
                write(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
                write(*,*) 'xtevapsup_cas(iso_eau,il)=', &
     &            xtevapsup_cas(iso_eau,il)
!                write(*,*) 'evap,evapsup=',evap(cas_evap_glace(il),i),
!     &            evap(cas_evap_glace(il),i+1)
              stop 
            endif !if (iso_verif_egalite_choix_nostop(xtevap_cas(iso_eau,il),
        endif !if (iso_eau.gt.0) then
       endif ! if (oktrac.eq.0) then
      enddo !do il=1,ncas 
#endif

!      write(*,*) 'appel_stewart tmp 2243: Eqi_stewart(1)=',
!     &          Eqi_stewart(1)
!      write(*,*) 'Eqi_prime_cas=',Eqi_prime_cas(1)
      ! deduction de XTP partir de Exi
      do il=1,ncas
       if (i.lt.INB_cas(il)) then
          if (fac_ftmr_cas(il).gt.0.0) then
            if (Eqi_stewart(il)*fac_ftmr_cas(il).gt.ridicule) then 
               do ixt=1,niso     
               !   xtp(ixt,il,i)=xtnew(ixt)*qp(il,i)/xtnew(4)           
                  xtp_cas(ixt,il)=max(xtp_avantevaptrac_cas(ixt,il)  &
     &               +fac_ftmr_cas(il)*Eqi_prime_cas(il) &
     &               *Exi_stewart(ixt,il)/Eqi_stewart(il),0.0)  
               enddo !do ixt=1,niso
             else ! if (Eqi_stewart.gt.ridicule) then
                if (qp_cas(il).gt.0.0) then 

                    if (Eqi_prime_cas(il)*fac_ftmr_cas(il).gt.ridicule) &
     &                   then 
                        ! il va manquer quelque chose: il faut augmenter
                        ! xtp en lui ajoutant l'évap du niveau d'eau
                        ! dessus
                        ! pour l'instant, on bidouille:
                        write(*,*) 'appel_stewart 2930: il=',il
                        do ixt=1,niso               
                        xtnew(ixt,il)=xtnew(ixt,il) &
     &                   *(qp_avantevap_cas(il) &
     &                   +Eqi_prime_cas(il)*fac_ftmr_cas(il)) &
     &                   /(qp_avantevap_cas(il) &
     &                   +Eqi_stewart(il)*fac_ftmr_cas(il))
                        enddo
                    endif !if (Eqi_prime_cas(il)*fac_ftmr_cas(il).gt.ridicule)

                    do ixt=1,niso               
                      xtp_cas(ixt,il)=xtnew(ixt,il) &
     &                   +(xtp_avantevaptrac_cas(ixt,il)  &
     &                  -xtp_avantevap_cas(ixt,il))                  
                    enddo !do ixt=1,niso
                else !if (qp(il,i).gt.0.0) then 
                  do ixt=1,niso               
                    xtp_cas(ixt,il)=0.0
                  enddo !do ixt=1,niso
                endif  !if (qp(il,i).gt.0.0) then 
             endif !if (Eqi_stewart.gt.ridicule) then 

#ifdef ISOVERIF
               do ixt=1,niso
                call iso_verif_noNAN(xtp_cas(ixt,il), &
     &                 'appel stewart 684b')
                enddo ! do ixt=1,niso
             if (oktrac.eq.0) then
                if (iso_eau.gt.0) then
                  if (iso_verif_egalite_choix_nostop( &
     &              xtp_cas(iso_eau,il),qp_cas(il), &
     &              'appel stewart 688b',errmax,errmaxrel*30) &
     &              .eq.1) then
                    write(*,*) 'il=',il
                    write(*,*) 'xtp_avantevaptrac_cas(iso_eau,il)=', &
     &                  xtp_avantevaptrac_cas(iso_eau,il)
                    write(*,*) 'qp_avantevap_cas(il)=', &
     &                  qp_avantevap_cas(il)
                    write(*,*) 'fac_ftmr_cas(il),Eqi_prime_cas(il)=', &
     &                  fac_ftmr_cas(il),Eqi_prime_cas(il)
                    write(*,*) 'Exi_stewart(iso_eau,il),Eqi_stewart=', &
     &                  Exi_stewart(iso_eau,il),Eqi_stewart(il)
                    stop
                  endif
               endif !if (iso_eau.gt.0) then 
              if ((iso_HDO.gt.0).and. &
     &          (qp_cas(il).gt.ridicule)) then
                call iso_verif_aberrant( &
     &          xtp_cas(iso_HDO,il)/qp_cas(il), &
     &          'appel_stewart 1384')
              endif  ! if (iso_HDO.gt.0) then
            endif ! if (oktrac.eq.0) then
#endif 

          else !if (fac_ftmr.gt.0.0) then
              ! ca veut dire que Mp=0, xtp pas définit
             do ixt=1,niso
               xtp_cas(ixt,il)=xtp_avantevaptrac_cas(ixt,il)
             enddo !do ixt=1,niso
         endif !if (fac_ftmr.gt.0.0) then
      else !if (i.lt.INB) then
          ! si i=inb, on ne change rien au calcul original, et on
          ! suppose que la composition du ddft est égale à celle de
          ! l'env. Ceci a déjà été calculé plus haut
                  do ixt=1,niso
                    xtp_cas(ixt,il)=xtp_avantevaptrac_cas(ixt,il)
                    !xtp_avantevap(ixt) a déjà été définit proprement
                    !dans ce cas là
                  enddo
      endif !if (i.lt.INB) then      
      enddo !do il=1,ncas

      ! verif
#ifdef ISOVERIF
        do il=1,ncas
         do ixt=1,niso
         call iso_verif_noNAN(xtp_cas(ixt,il),'appel stewart 198b')
         call iso_verif_noNAN(xtevap_cas(ixt,il),'appel stewart 745b')
         enddo !do ixt=1,niso
        enddo ! do il=1,ncas
        if (oktrac.eq.0) then
        if (iso_eau.gt.0) then
        do il=1,ncas
        if (iso_verif_egalite_choix_nostop( &
     &           xtp_cas(iso_eau,il), &
     &           qp_cas(il), &
     &          'appel stewart 197b: cas_evap_glace', &
     &          errmax,errmaxrel*50).eq.1) then   
          write(*,*) 'i,il=',i,il,' INB(il)=',INB_cas(il)
!     &          ,' cas(il)=',cas_evap_glace(il)
          write(*,*) 'Tevap=',T_cas(il)
          write(*,*) 'xtp(iso_eau,il,i)=',xtp_cas(iso_eau,il)
          write(*,*) 'qp(il,i)=',qp_cas(il)
          write(*,*) 'xtnew(iso_eau)=',xtnew(iso_eau,il)
          write(*,*) 'fac_ftmr=',fac_ftmr_cas(il)
!          write(*,*) 'Mp(il,i)=',Mp(cas_evap_glace(il),i)
          write(*,*) 'xtp_avantevap(iso_eau)=', &
     &          xtp_avantevap_cas(iso_eau,il)
          write(*,*) 'qp_avantevap=',qp_avantevap_cas(il)
          write(*,*) 'Exi_stewart(iso_eau)=',Exi_stewart(iso_eau,il)
          write(*,*) 'Eqi_stewart=',Eqi_stewart(il)
!          write(*,*) 'Eqi_prime=',Eqi_prime_cas(il)        
          write(*,*) 'Pxtiinf_stewart(iso_eau)=', &
     &           Pxtiinf_stewart(iso_eau,il)
!          write(*,*) 'Pqiinf_par=',Pqiinf_par(cas_evap_glace(il))
          write(*,*) 'Pxtisup(iso_eau)=',Pxtisup_cas(iso_eau,il)
          write(*,*) 'Pqisup=',Pqisup_cas(il)
          stop
         endif !if iso_verif_egalite_choix_nostop
         enddo !do il=1,ncas
        endif
        if (iso_HDO.gt.0) then
          do il=1,ncas
            if (qp_cas(il).gt.ridicule) then
                call iso_verif_aberrant( &
     &          xtp_cas(iso_HDO,il)/qp_cas(il), &
     &          'appel_stewart 1449')
            endif !if (qp_cas(il).gt.ridicule) then
          enddo !do il=1,ncas
        endif  ! if (iso_HDO.gt.0) then
       endif ! if (oktrac.eq.0) then
!       write(*,*) 'appel_stewart 2331: sortie de make_cas_evap_glace'
#endif

      end subroutine make_cas_evap_glace
      
! subroutine traitant l'évaporation des gouttes spécfiquement pour
! schéma de KE
! à modifier à la moindre modif du schéma de KE


      subroutine appel_stewart_vectall_np(lwork,ncum, &
     &          PH,T,EVAP,XTWDTRAIN, &
     &                  WDTRAIN, &
     &           WATER,Q,XT, QS,QP,MP,WT, & ! inputs physiques
     &           XTWATER,XTP,  &   ! outputs indispensables
     &          XTEVAP,  &    ! diagnostiques
     &         sigd, &  ! inputs tunables
     &         i,INB, & ! altitude: car cas particulier en INB 
     &         NA,ND,nloc,cvflag_grav,ginv,Mpmin) ! dimensions  
 

  USE isotopes_mod, ONLY: iso_eau, iso_HDO,bidouille_anti_divergence, &
&       thumxt1, ridicule
#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel
USE isotopes_verif_mod
#endif
#ifdef ISOTRAC
USE isotrac_mod, ONLY: izone_revap, option_revap,ridicule_trac
USE isotrac_routines_mod, only: &
&       iso_verif_traceur_jbidouille,uncompress_commun_zone_revap, &
&       compress_evap_glace_zone,compress_evap_liq_zone, &
&       uncompress_commun_zone,compress_noevap_zone, &
&       compress_cond_facftmr_zone,compress_cond_nofftmr_zone
#ifdef ISOVERIF
USE isotrac_routines_mod, only: iso_verif_traceur_pbidouille
#endif
#endif
      implicit none

      !*inputs et outputs
      integer ncum ! dimension horiz effective
      logical lwork(nloc)
      integer NA,ND,nloc ! dimensions officielles
      real PH(nloc,ND),T(nloc,ND),EVAP(nloc,NA)
      real XTWDTRAIN(ntraciso,nloc),WDTRAIN(nloc), &
     &      WATER(nloc,NA), Q(nloc,NA), XT(ntraciso,nloc,ND), &
     &           QS(nloc,ND),QP(nloc,NA), &
     &      XTWATER(ntraciso,nloc,NA),XTP(ntraciso,nloc,NA), &
     &    XTEVAP(ntraciso,nloc,NA), &
     &      WT(nloc,NA), MP(nloc,NA)
      real sigd(nloc)
      integer i,INB(nloc)
      logical cvflag_grav
      real ginv
      real Mpmin

      !* variables intermediaires
      integer ixt,j,il
      real qeff(ncum)
      real xtp_avantevap(ntraciso,ncum),qp_avantevap(ncum)
!      real Exi(niso,ncum) ! equivalent à Eqi_prime
      real Pqisup(ncum),Pqiinf(ncum),Eqi(ncum) 
      real Pqiinf_par(ncum), Eqi_prime(ncum),  &
     &           Eqi_plus1(ncum), Eqi_par(ncum)
      real Pqiinf_stewart(ncum), Eqi_stewart(ncum)
      real Exi_prime(ntraciso,ncum)
      real Pxtiinf_stewart(niso,ncum),  &
     &          Exi_stewart(niso,ncum)
      real Exi_plus1(niso,ncum)
      real Pxtisup(ntraciso,ncum), Pxtiinf(niso,ncum)
      real xtnew(niso,ncum)
      real fac_ftmr(ncum) ! facteur de conversion des flux en mixing ratio
!      real Risup(ntraciso,ncum), Rcond(ntraciso,ncum), 
!     :           Renv(ntraciso,ncum) 
!      real  Revap(ntraciso,ncum), Riinf(ntraciso,ncum)
!      real xtice(ntraciso,ncum), xtliq(ntraciso,ncum)
!      real xtp0(ntraciso,ncum), qp0(ncum)
!     real fcond(ncum), fice(ncum), cond(ncum)
!      real zxtalphal(niso,ncum), zxtalphai(niso,ncum)
      real g
      real rat(ncum)
      real ztglace_kelvin
      parameter (ztglace_kelvin=273.15)

      integer frac_sublim
      !real      
      !real real_to_double

      ! compteurs de parsage
      integer icas_condensation_facftmr,ncas_condensation_facftmr
      integer icas_condensation_nofacftmr,ncas_condensation_nofacftmr
      integer icas_noevap,ncas_noevap
      integer icas_evap_liq,ncas_evap_liq
      integer icas_evap_glace,ncas_evap_glace
      integer ncas_tot

      ! tableaux d'indice issus du parsage
      integer cas_condensation_facftmr(ncum)
      integer cas_condensation_nofacftmr(ncum)
      integer cas_noevap(ncum)
      integer cas_evap_liq(ncum)
      integer cas_evap_glace(ncum)

      integer trace_cas(ncum)
#ifdef ISOVERIF
      ! tracage des cas
        ! -1: ce n'est pas un point de travail
        ! 0: initialisation des points de travail
        ! 11: condensation_facftmr
        ! 12: condensation_nofacftmr
        ! 2: noevap
        ! 31: evap_liq
        ! 32: evap_glace
!      integer iso_verif_positif_nostop
!      integer iso_verif_positif_choix_nostop
!      integer iso_verif_aberrant_nostop
!      integer iso_verif_traceur_nostop
!      integer iso_verif_egalite_nostop
!      integer iso_verif_egalite_choix_nostop
!      real deltaD
      real Exi_cas(niso,ncum),Exi(ntraciso,ncum)
#endif    
!      integer iso_verif_noNAN_nostop


      ! outputs des calculs, compressés
      real xtevap_cas(niso,ncum),xtp_cas(niso,ncum), &
     &           xtwater_cas(niso,ncum)

      ! inputs des calculs, compréssés
      real T_cas(ncum),delP_cas(ncum), &
     &          xtevapsup_cas(niso,ncum),evap_cas(ncum), &
     &          qp_cas(ncum),wt_cas(ncum), &
     &          xt_cas(niso,ncum),q_cas(ncum), &
     &          qs_cas(ncum),water_cas(ncum),    &
     &          sigd_cas(ncum)        
      real  qp_avantevap_cas(ncum), &
     &  xtp_avantevap_cas(niso,ncum), &
     &  Pqisup_cas(ncum), Pxtisup_cas(niso,ncum),  &
     &  Eqi_prime_cas(ncum),fac_ftmr_cas(ncum) ,  &
     &  Eqi_cas(ncum)
#ifdef ISOTRAC      
      real  qp_avantevaptrac_cas(ncum), &
     &  xtp_avantevaptrac_cas(niso,ncum) 
        integer izone ,iiso
      real xtaddp_tag(niso,ncum)
      real ptrac(ncum)
      real hdiag(ncum)
#endif      
      integer INB_cas(ncum)
              

!      write(*,*) 'appel_stewart_np 48: entrée, i=',i

      ! definition de quelques constantes:

      !gravité:
      if (cvflag_grav) then
          g=1/ginv
      else
          g=10.
      endif

      ! fractionne-t-on lors de la sublimation?
      frac_sublim=0 ! -> on ne fractionne pas
      !frac_sublim=1 ! -> oui, on fractionne
      

      ! ***** verification des inputs ************
      
#ifdef ISOVERIF
      if (iso_eau.gt.0) then
        do il=1,ncum 
         if (i.le.inb(il) .and. lwork(il)) then
          call iso_verif_egalite_choix(xt(iso_eau,il,i),q(il,i), &
     &           'appel_stewart_np 58',errmax,errmaxrel)
         endif !if (i.le.inb(il) .and. lwork(il)) then
        enddo !do il=1,ncum    
      endif !if (iso_eau.gt.0) then
#ifdef ISOTRAC
      do il=1,ncum
         call iso_verif_traceur(xt(1,il,i), &
     &        'appel_stewart_np 141')
      enddo  
#endif      
#endif
      if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) then
         do il=1,ncum 
             if (i.le.inb(il) .and. lwork(il)) then   
                xt(iso_eau,il,i)=  q(il,i)
             endif !if (i.le.inb(il) .and. lwork(il)) then
           enddo !do il=1,ncum     
      endif !if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) then
      
      ! verif que les vapeurs du ddft plus haut sont bonnes
      ! si i=INB, on ne verifie rien car pas de vapeur au dessus de INB
#ifdef ISOVERIF
       do il=1,ncum 
         if (i.lt.inb(il) .and. lwork(il)) then
          do j=i+1,INB(il)
            do ixt=1,ntraciso
              call iso_verif_noNAN(xtevap(ixt,il,j), &
     &        'appel_stewart_np 96')
            enddo
         enddo !do j=i+1,INB
        endif ! (i.lt.inb(il) .and. lwork(il)) then
       enddo !do il=1,ncum 
#endif
#ifdef ISOVERIF
       do il=1,ncum 
         if (i.lt.inb(il) .and. lwork(il)) then
          do j=i+1,INB(il)
            if (iso_eau.gt.0) then
              call iso_verif_egalite_choix(xtp(iso_eau,il,j),qp(il,j), &
     &           'appel_stewart_np 66',errmax,errmaxrel)          
            endif !if (iso_eau.gt.0) then
#ifdef ISOTRAC
            call iso_verif_traceur(xtp(1,il,j), &
     &         'appel_stewart_np 167')
#endif  
         enddo !do j=i+1,INB
        endif ! (i.lt.inb(il) .and. lwork(il)) then
       enddo !do il=1,ncum 
#endif

      if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) then
       do il=1,ncum 
        if (i.lt.inb(il) .and. lwork(il)) then
         do j=i+1,INB(il)
          xtp(iso_eau,il,j)=qp(il,j)          
         enddo !do j=i+1,INB
        endif ! (i.lt.inb(il) .and. lwork(il)) then
       enddo !do il=1,ncum 
      endif !if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) then
      ! end verif des inputs 


      ! ****** calcul du facteur de conversion des flux en mixing ratio
      
      do il=1,ncum 
       if (i.le.inb(il) .and. lwork(il)) then
        if ((Mp(il,i).gt.Mp(il,i+1)).and.(Mp(il,i).gt.Mpmin)) then
          ! cas entrainant
          fac_ftmr(il)=1.0/Mp(il,i)
        else !if ((Mp(il,i).gt.Mp(il,i+1))
          if (Mp(il,i+1).gt.Mpmin) then
              ! cas non entrainant, mais flux existe
              fac_ftmr(il)=1.0/Mp(il,i+1)
          else
              ! pas de flux de masse, XTP reste constant
              fac_ftmr(il)=0.0
          endif
        endif !if ((Mp(il,i).gt.Mp(il,i+1))
#ifdef ISOVERIF
        
#endif        
       endif ! (i.le.inb(il) .and. lwork(il)) then
      enddo !do il=1,ncum

      ! ****** calcul de la vapeur dans le ddft avant réévap
            
      do il=1,ncum 
       if (i.le.inb(il) .and. lwork(il)) then      
        if (i.lt.INB(il)) then      
         if ((Mp(il,i).gt.Mp(il,i+1)).and.(Mp(il,i).gt.Mpmin)) then
          ! cas entrainant
          rat(il)=Mp(il,i+1)/Mp(il,i)
          qp_avantevap(il)=qp(il,i+1)*rat(il)+q(il,i)*(1-rat(il)) 
          do ixt=1,ntraciso
             xtp_avantevap(ixt,il)=xtp(ixt,il,i+1)*rat(il) &
     &          +xt(ixt,il,i)*(1-rat(il))
          enddo
         else !if (Mp(il,i).gt.Mp(il,i+1)) then
           if (Mp(il,i+1).gt.Mpmin) then
              ! cas non entrainant, mais flux existe
              qp_avantevap(il)=qp(il,i+1)
              do ixt=1,ntraciso
                xtp_avantevap(ixt,il)=xtp(ixt,il,i+1)
              enddo
              
           else    !if (Mp(il,i+1).gt.0) then    
              
              ! pas de flux de masse, on ne calcule rien
              ! on garde le qp calculé dans cv3_unsat, original
              ! on suppose que le deltaD dans le ddft est celui de
              ! l'environnement
              qp_avantevap(il)=qp(il,i)
              if (qp(il,i).gt.0) then
#ifdef ISOVERIF
                call iso_verif_positif_strict(q(il,i), &
     &               'appel_stewart_np 226')
#endif                  
                do ixt=1,ntraciso
                 xtp_avantevap(ixt,il)=xt(ixt,il,i)/q(il,i)*qp(il,i)
                enddo
              else !if (qp(il,i).gt.0) then
                  ! si qp est négatif, on met les isos dedans à 0
                do ixt=1,ntraciso
                 xtp_avantevap(ixt,il)=0.0
                enddo
              endif !if (qp(il,i).gt.0) then
               
          endif !if (Mp(il,i+1).gt.0) then
          
         endif  !if (Mp(il,i).gt.Mp(il,i+1)) then
      
        else ! if i.lt.INB
          ! cas ou i=inb
          ! on garde le qp calculé dans cv3_unsat, original
          ! on suppose que le deltaD dans le ddft est celui de
          ! l'environnement
          qp_avantevap(il)=qp(il,i)
          if (qp(il,i).gt.0) then
            do ixt=1,ntraciso
             xtp_avantevap(ixt,il)=xt(ixt,il,i)/q(il,i)*qp(il,i)
            enddo
          else !if (qp(il,i).gt.0) then
              ! si qp négatif, on met les isotopes dedans à 0
            qp_avantevap(il)=0.0  
            do ixt=1,ntraciso
             xtp_avantevap(ixt,il)=0.0
            enddo
          endif !if (qp(il,i).gt.0) then
        endif ! if i.lt.INB(il)
       endif ! (i.le.inb(il) .and. lwork(il)) then
      enddo !do il=1,ncum

#ifdef ISOVERIF
      if (iso_eau.gt.0) then
        do il=1,ncum 
          if (i.le.inb(il) .and. lwork(il)) then      
            call iso_verif_egalite_choix( &
     &           (xtp_avantevap(iso_eau,il)), &
     &           (qp_avantevap(il)), &
     &            'appel_stewart_np 95',errmax,errmaxrel)
          endif ! (i.le.inb(il) .and. lwork(il)) then
        enddo !do il=1,ncum
      endif !if (iso_eau.gt.0) then
#endif

           
      ! ********* calculs des flux
      
      do il=1,ncum 
       if (i.le.inb(il) .and. lwork(il)) then
        Pqisup(il)=sigd(il)/g*wt(il,i)*water(il,i+1)+wdtrain(il)/g
        Pqiinf(il)=sigd(il)/g*wt(il,i)*water(il,i) ! ce qu'on aurait dans si ce
       ! ce qu s'évapore en i ne vient que de i, comme dans le schéma de
       ! KE original.      
        Eqi_prime(il)=(evap(il,i)+evap(il,i+1))/2 &
     &           *100.*(PH(il,i)-PH(il,I+1))*sigd(il)/g
        Eqi(il)=evap(il,i)*100.*(PH(il,i)-PH(il,I+1))*sigd(il)/g
        Eqi_plus1(il)=evap(il,i+1)*100.*(PH(il,i)-PH(il,I+1))*sigd(il)/g
        ! avant le 15 juillet 2012, on avait juste Pqiinf_par(il)=Pqisup(il)-Eqi(il)
        ! mais donne pbs en 1D. On met une rustine, mais c'est pas bien
        ! justifié. Il faudrait reprendre ça proprement un jour.
        if ((Eqi_prime(il).gt.0.0).and. &
     &      (Pqiinf(il).ge.Pqisup(il)).and. &
     &      (Pqisup(il).gt.0.0).and. &
     &      (Pqisup(il)-Eqi_prime(il).gt.0.0)) then
                ! rustine au cas patho en 1D pour -90hPa/d
                Pqiinf_par(il)=Pqisup(il)-Eqi_prime(il)
        else
                Pqiinf_par(il)=Pqisup(il)-Eqi(il)
        endif
        Eqi_par(il)=Pqisup(il)-Pqiinf(il)
        do ixt=1,ntraciso
          Pxtisup(ixt,il)=sigd(il)/g*wt(il,i+1)*xtwater(ixt,il,i+1) &
     &           +xtwdtrain(ixt,il)/g
        enddo
       endif !if (i.le.inb(il) .and. lwork(il)) then
      enddo !do il=1,ncum 

#ifdef ISOVERIF 
!      write(*,*) 'appel_stewart_np 335 nostop' 
!      il=1
!      write(*,*) 'Pqisup=',Pqisup(il)
!      write(*,*) 'Pqiinf=',Pqiinf(il)
!      write(*,*) 'Eqi_prime=',Eqi_prime(il)
!      write(*,*) 'Eqi=',Eqi(il)
!      write(*,*) 'Eqi_plus1=',Eqi_plus1(il)
!      write(*,*) 'Pqiinf_par=',Pqiinf_par(il)
!      write(*,*) 'Eqi_par=',Eqi_par(il)
!      write(*,*) 'qp=',qp(il,i)
!      write(*,*) 'qp_avantevap=',qp_avantevap(il)
      do il=1,ncum 
       if (i.le.inb(il) .and. lwork(il)) then
         do ixt=1,niso
          if (iso_verif_noNaN_nostop((Pxtisup(ixt,il)), &
     &        'appel_setwart_vectall_np 338').eq.1) then
            write(*,*) 'il,i,ixt=',il,i,ixt
            write(*,*) 'xtwater(ixt,il,i+1)=',xtwater(ixt,il,i+1)
            write(*,*) 'xtwdtrain(ixt,il)=',xtwdtrain(ixt,il)
            write(*,*) 'wt(il,i+1)=',wt(il,i+1)
            write(*,*) 'water(il,i+1)=',water(il,i+1)
            write(*,*) 'wdtrain(il)=',wdtrain(il)
            stop
          endif
         enddo !do ixt=1,niso
       endif !if (i.le.inb(il) .and. lwork(il)) then
      enddo !do il=1,ncum 
#endif

#ifdef ISOVERIF   
!      il =243
!      write(*,*) 'appel_stewart 327: il=',il
!      write(*,*) 'Pqisup,Pqiinf,Eqi_prime,Eqi,Pqiinf_par,Eqi_par=',
!     :     Pqisup(il),Pqiinf(il),Eqi_prime(il),Eqi(il),
!     :     Pqiinf_par(il),Eqi_par(il)
      do il=1,ncum 
       if (i.le.inb(il) .and. lwork(il)) then
         call iso_verif_egalite_choix((Pqiinf(il)), &
     &        (Pqiinf_par(il)),'appel_stewart_np 218', &
     &         errmax,errmaxrel)
       endif
!#ifdef ISOTRAC
!        if ((option_traceurs.eq.17).or.
!     :           (option_traceurs.eq.18)) then
!        if (iso_verif_positif_nostop((        
!     :          Pxtisup(index_trac(izone_cond,iso_eau),il)
!     :          -Pxtisup(iso_eau,il)),
!     :          'appel_stewart_np 332').eq.1) then
!          write(*,*) 'Pxtisup(:,il)=',Pxtisup(:,il)
!          write(*,*) 'xtwater(:,il,i+1)=',xtwater(:,il,i+1)
!          write(*,*) 'xtwdtrain(:,il)=',xtwdtrain(:,il)
!          stop
!        endif !if (iso_verif_positif_nostop(Pxtisup(iso_eau,il)-
!        endif !if ((option_traceurs.eq.17).or.    
!#endif       
      enddo !do il=1,ncum 
!      il=243     
!         write(*,*) 'il,Pqisup,Pqiinf,Pqiinf_par=',
!     ;         il,Pqisup(il),Pqiinf(il),Pqiinf_par(il)
!         write(*,*) 'Eqi_prime,Eqi,Eqi_plus1,Eqi_par=',
!     ;         Eqi_prime(il),Eqi(il),Eqi_plus1(il),Eqi_par(il)
!         write(*,*) 'evap(il,i:i+1)=',evap(il,i:i+1)
#endif      

      ! petite vérif sur les flux
      do il=1,ncum 
       if (i.le.inb(il) .and. lwork(il)) then
         if ((Eqi_par(il).lt.0.0) &
     &          .and.(Pqiinf_par(il).le.0.0) &
     &         .and.(water(il,i).gt.ridicule/10.)) then
            ! dans ce cas, on a de l'eau sortant dont il faut déterminer la
            ! composition, mais pourtant le bilan de masse indique qu'il
            ! n'y a pas d'eau sortant. Et si on recalcule l'évap pour avoir de 
            ! l'eau sortant, Eqi_par<0 -> condensation! On est donc très
            ! embétté car Eqi_prime indique qu'il y a évaporation... 
#ifdef ISOVERIF  
            write(*,*) 'appel_stewart_np 239: cas génant'  
#endif                

            if (Eqi_prime(il)*fac_ftmr(il).lt. &
     &          qp_avantevap(il)*1e-2) then
                ! ouf: Eqi_prime a peut d'effet sur la vapeur du ddft.
                ! on peut donc condenser tranquillement pour obtenir de
                ! l'eau en sortie, ça ne changera pas grand chose sur la
                ! vapeur.
                Eqi_prime(il)=Eqi_par(il)
#ifdef ISOVERIF
                write(*,*) 'appel_stewart 409: Eqi_prime=Eqi_par'
#endif                
            else
             write(*,*) 'appel_stewart_np 222: ce cas est très génant'
             stop
            endif
          endif
        endif !if (i.le.inb(il) .and. lwork(il)) then
      enddo !do il=1,ncum

      if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) then
          do il=1,ncum
            xtp_avantevap(iso_eau,il)=qp_avantevap(il)
            Pxtisup(iso_eau,il)=Pqisup(il)
          enddo
      endif !if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) then


      ! ******** parsage des différents cas + quelques vérifs
      icas_condensation_facftmr=0
      icas_condensation_nofacftmr=0
      icas_noevap=0
      icas_evap_glace=0
      icas_evap_liq=0
!#ifdef ISOVERIF
      ! initialisation de l'outil de tracage de cas:
      do il=1,ncum
        if (i.le.inb(il) .and. lwork(il)) then
          trace_cas(il)=0
        else
          trace_cas(il)=-1
        endif
      enddo !do il=1,ncum
!      if (ncum.ge.602) then
!          write(*,*) 'appel_stewart_np tmp 379: avant parsage'
!          il=602
!          write(*,*) 'fac_ftmr(il)=',fac_ftmr(il)
!          write(*,*) 'ridicule,errmax=',ridicule,errmax
!      endif
!#endif      
      do il=1,ncum 
       if (i.le.inb(il) .and. lwork(il)) then 
        if ((Eqi_prime(il).lt.-ridicule*1e-3).or. &
     &        (Eqi_prime(il)*fac_ftmr(il).lt.-ridicule*10)) then
            ! modif le 10 mai 2009: si Eqi_prime très petit, on le
            ! traite comme du 0
            ! modif 15 mai 2009: on rajoute condition sur Eqi*fac_ftmr
            ! 1: Eqi_prime<0: condensation
          if (fac_ftmr(il).gt.ridicule/100.) then
            ! si fac_ftmr très petit, on le traite comme du 0
            ! 1.1: si Mpi>0
            icas_condensation_facftmr=icas_condensation_facftmr+1    
            cas_condensation_facftmr(icas_condensation_facftmr)=il
!#ifdef ISOVERIF
            trace_cas(il)=11
!#endif            
          else !if (fac_ftmr.gt.0.0) then
            ! 1.2: si Mpi=0
            icas_condensation_nofacftmr=icas_condensation_nofacftmr+1  
            cas_condensation_nofacftmr(icas_condensation_nofacftmr)=il
!#ifdef ISOVERIF
            trace_cas(il)=12
!#endif
          endif !if (fac_ftmr.gt.0.0) then
        else if ((Eqi_prime(il).lt.ridicule*1e-3).and. &
     &     (Eqi_prime(il)*fac_ftmr(il).lt.ridicule*10)) then 
            ! 2: Eqi_prime est compris entre 1e-14 et -1e-14: rien 
!            ! 27 mai 2009: on remplace le seuil pour Eqi_prime(il)*fac_ftmr(il)
!            ! de errmax/10 par ridicule*10  
            ! 18 sept 2009: on remplace  ridicule*1e-2 par ridicule*1e-3 
            !pour éviter Eqi_prime=-1.87e-15, Pqisup=0 et water=1.44e-12
            icas_noevap=icas_noevap+1  
            cas_noevap(icas_noevap)=il
!#ifdef ISOVERIF
            trace_cas(il)=2
!#endif
            qp_avantevap(il)=max(0.0,qp_avantevap(il))            
            qp(il,i)=max(0.0,qp(il,i))
            do ixt=1,ntraciso
            xtp_avantevap(ixt,il)=max(0.0,xtp_avantevap(ixt,il))
            enddo
#ifdef ISOVERIF
            if ((Pqisup(il).le.0.0).and. &
     &          (water(il,i).gt.ridicule)) then
              write(*,*) 'appel_stewart_np 420: water=',water(il,i)
              write(*,*) 'Pqisup,Eqi_prime,fac_ftmr=',Pqisup(il), &
     &           Eqi_prime(il),fac_ftmr(il)
              stop
            endif    
            if (iso_eau.gt.0) then
             if (iso_verif_egalite_choix_nostop( &
     &          (qp_avantevap(il)), &
     &          qp(il,i),'appel_stewart_np 521', &
     &          errmax,errmaxrel).eq.1) then
               write(*,*) 'Mp(il,i)=',Mp(il,i)
               write(*,*) 'Mp(il,i+1)=',Mp(il,i+1)
               write(*,*) 'qp(il,i)=',qp(il,i)
               write(*,*) 'qp(il,i+1)=',qp(il,i+1)
               write(*,*) 'q(il,i)=',q(il,i)
               write(*,*) 'evap(il,i)=',evap(il,i)
               write(*,*) 'evap(il,i+1)=',evap(il,i+1)
               write(*,*) 'Eqi_prime(il)=',Eqi_prime(il)
               write(*,*) 'fac_ftmr(il)=',fac_ftmr(il)
               stop
             endif
            endif !if (iso_eau.gt.0) then
#endif
        else    !if (Eqi_prime.lt.0.0) then
        ! 3: Eqi_prime>0 
#ifdef ISOVERIF  
!        ! quelques vérifs du bilan de masse d'eau 
!             if (iso_verif_positif_nostop((
!     :            Pqisup(il)-Eqi_prime(il)),
!     :            'appel_stewart_np 388 nostop').eq.1) then
!               write(*,*) 'il,Pqisup=',il,Pqisup(il)
!               write(*,*) 'Eqi_prime=',Eqi_prime(il)
!               write(*,*) 'Pqiinf=',Pqiinf(il)
!!               write(*,*) 'stop temporaire, à enlever'
!!               stop
!              endif
              if (iso_verif_positif_choix_nostop(( &
     &          Pqisup(il)-Pqiinf_par(il)),errmax, &
     &          'appel_stewart_np 442').eq.1) then
                write(*,*) 'appel_stewart_np 174'
                write(*,*) 'Pqisup=',Pqisup(il), &
     &          ' Pqiinf_par=',Pqiinf_par(il)
                stop
              endif               
              if (iso_verif_positif_nostop((Eqi_par(il)), &
     &          'appel_stewart_np 559b').eq.1) then
                write(*,*) 'Eqi(il),Eqi_plus1(il),Eqi_prime(il)=', &
     &                 Eqi(il),Eqi_plus1(il),Eqi_prime(il) 
                write(*,*) 'Pqisup(il),Pqiinf(il),Eqi_par(il)=', &
     &                  Pqisup(il),Pqiinf(il),Eqi_par(il)
              endif
#endif              
              if (T(il,i).ge.ztglace_kelvin) then
                ! 3.1: evap des gouttes
                icas_evap_liq=icas_evap_liq+1  
                cas_evap_liq(icas_evap_liq)=il
!#ifdef ISOVERIF
                trace_cas(il)=31
!#endif
              else !if (T(il,i).ge.ztglace_kelvin) then
                ! 3.2: evap de la glace
                icas_evap_glace=icas_evap_glace+1  
                cas_evap_glace(icas_evap_glace)=il
!#ifdef ISOVERIF
                trace_cas(il)=32
!#endif  
              endif !if (T(il,i).ge.ztglace_kelvin) then
          endif ! !if (Eqi_prime.lt.0.0) then
       endif !if (i.le.inb(il) .and. lwork(il)) then 
      enddo  !do il=1,ncum 

      ncas_condensation_facftmr=icas_condensation_facftmr
      ncas_condensation_nofacftmr=icas_condensation_nofacftmr  
      ncas_noevap=icas_noevap
      ncas_evap_liq=icas_evap_liq
      ncas_evap_glace=icas_evap_glace

#ifdef ISOVERIF
!      write(*,*) 'appel_stewart_np vectoriel 355: parsage des cas:'
!      if (ncum.ge.602) then
!          write(*,*) 'trace_cas(602)=',trace_cas(602)
!      endif  
      ncas_tot=0
      do il=1,ncum
        if (i.le.inb(il) .and. lwork(il)) then 
            ncas_tot=ncas_tot+1
        endif
      enddo
!      write(*,*) 'i,ncum,ncas_tot=',i,ncum,ncas_tot
!      write(*,*) 'ncas_condensation_facftmr=',ncas_condensation_facftmr
!      write(*,*) 'ncas_condensation_nofacftmr=',
!     &           ncas_condensation_nofacftmr
!      write(*,*) 'ncas_noevap=',ncas_noevap
!      write(*,*) 'ncas_evap_liq_=',ncas_evap_liq
!      write(*,*) 'ncas_evap_glace=',ncas_evap_glace
      if (ncas_tot.ne.ncas_condensation_facftmr &
     &         +ncas_condensation_nofacftmr &
     &         +ncas_noevap &
     &         +ncas_evap_liq &
     &         +ncas_evap_glace) then
         write(*,*) 'mauvais parsage'
         stop
       endif
#endif      


      ! ****** traitement vectoriel du cas 1.1

      if (ncas_condensation_facftmr.gt.0) then
!#ifdef ISOVERIF        
!      write(*,*) 'cas_condensation_facftmr(1)=', &
!     &          cas_condensation_facftmr(1)
!#endif
      call compress_cond_facftmr(ncas_condensation_facftmr,   &
     &   cas_condensation_facftmr, &
     &   Eqi_prime_cas,Eqi_prime, &
     &   Pqisup_cas,Pqisup,  &
     &   Pxtisup_cas,Pxtisup,   &
     &   T_cas,T(1,i),  &
     &   fac_ftmr_cas,fac_ftmr,  &
     &   qp_avantevap_cas,qp_avantevap, &
     &   xtp_avantevap_cas,xtp_avantevap,  &
     &   xtevapsup_cas,xtevap(1,1,i+1), &
     &   water_cas,water(1,i), &
     &   delP_cas,Ph,  &
     &   sigd_cas,sigd(1), &
#ifdef ISOVERIF        
     &   evap_cas(1),evap(1,i),qp_cas(1),qp(1,i),    &
#endif        
     &   nloc,ncum,nd,i)

#ifdef ISOVERIF
      ! vérif de la compression
!      write(*,*) 'appel_stewart_np tmp 506: ', &
!     &          'après compress_condensation_facftmr'
!      write(*,*) 'sigd_cas(1:3)=',sigd_cas(1:3)
!      if (ncas_condensation_facftmr.ge.4) then
!          write(*,*) 'cas_condensation_facftmr(4)=', &
!     &          cas_condensation_facftmr(4)
!      endif
      do il=1,ncas_condensation_facftmr
        call iso_verif_egalite_choix((Pqisup_cas(il)), &
     &        (Pqisup(cas_condensation_facftmr(il))), &
     &        'appel_stewart_np 457: compress condensation_facftmr', &
     &        errmax,errmax)
        call iso_verif_egalite_choix(water_cas(il), &
     &        water(cas_condensation_facftmr(il),i), &
     &        'appel_stewart_np 460: compress condensation_facftmr', &
     &        errmax,errmax)
        if (iso_eau.gt.0) then
         call iso_verif_egalite_choix( &
     &        (xtp_avantevap_cas(iso_eau,il)), &
     &        (qp_avantevap_cas(il)), &
     &        'appel_stewart_np 520: compress condensation_facftmr', &
     &        errmax,errmax)
        endif ! if (iso_eau.gt.0) then
      enddo
#endif                  
        call make_condensation_facftmr(ncas_condensation_facftmr, &
     &        Eqi_prime_cas(1),Pqisup_cas(1),Pxtisup_cas(1,1), &
     &        fac_ftmr_cas(1),T_cas(1), &
     &        qp_avantevap_cas(1),xtp_avantevap_cas(1,1),water_cas(1), &
     &        delP_cas(1),xtevapsup_cas(1,1),ztglace_kelvin, &
     &        xtp_cas(1,1),xtwater_cas(1,1),xtevap_cas(1,1),g,sigd_cas(1) &
#ifdef ISOVERIF        
     &         ,evap_cas(1),qp_cas(1),1 &
#endif
     &          )  

#ifdef ISOVERIF
        do   il=1,ncas_condensation_facftmr
          do ixt=1,niso
            call iso_verif_noNaN(xtwater_cas(ixt,il), &
     &          'appel_stewart_np 539')
          enddo          
        enddo     
#endif        

       call uncompress_commun(ncas_condensation_facftmr, &
     &    cas_condensation_facftmr, &
     &  xtp_cas,xtp(1,1,i),xtwater_cas,xtwater(1,1,i), &
     &          xtevap_cas,xtevap(1,1,i), &
#ifdef ISOVERIF
     &          Exi_cas(1,1),Exi,    &
#endif
     &          ncum)


#ifdef ISOTRAC
       do izone=1,ntraceurs_zone

!#ifdef ISOVERIF     
!       write(*,*) 'appel_stewart_np tmp 538: condensation_facftmr, izone=',
!     :          izone
!#endif      

        call compress_cond_facftmr_zone( &
     &   ncas_condensation_facftmr,   &
     &   cas_condensation_facftmr, &
     &   Eqi_prime_cas,Eqi_prime, &
     &   Pqisup_cas,Pqisup,  &
     &   Pxtisup_cas,Pxtisup,   &
     &   qp_avantevap_cas,qp_avantevap, &
     &   xtp_avantevap_cas,xtp_avantevap,  &
     &   xtevapsup_cas,xtevap(1,1,i+1), &
     &   water_cas,water(1,i), &
#ifdef ISOVERIF        
     &   evap_cas(1),evap(1,i),   &
#endif        
     &   nloc,ncum,nd,i,izone)

#ifdef ISOVERIF 
        if (iso_eau.gt.0) then
          do il=1,ncas_condensation_facftmr
            call iso_verif_egalite_choix( &
     &          (qp_avantevap_cas(il)), &
     &          (xtp_avantevap_cas(iso_eau,il)), &
     &          'appel_stewart_np 558',errmax,errmaxrel)
          enddo !do il=1,ncas_condensation_nofacftmr
        endif !if (iso_eau.gt.0) then
#endif
        call make_condensation_facftmr(ncas_condensation_facftmr, &
     &        Eqi_prime_cas(1),Pqisup_cas(1),Pxtisup_cas(1,1), &
     &        fac_ftmr_cas(1),T_cas(1), &
     &        qp_avantevap_cas(1),xtp_avantevap_cas(1,1),water_cas(1), &
     &        delP_cas(1),xtevapsup_cas(1,1),ztglace_kelvin, &
     &        xtp_cas(1,1),xtwater_cas(1,1),xtevap_cas(1,1),g,sigd_cas(1) &
#ifdef ISOVERIF        
     &           ,evap_cas(1),qp_cas(1),1 &
#endif
     &          )

#ifdef ISOVERIF
        do   il=1,ncas_condensation_facftmr
          do ixt=1,niso
            call iso_verif_noNaN(xtwater_cas(ixt,il), &
     &          'appel_stewart_np 588')
          enddo
        enddo      
#endif
        !#ifdef ISOVERIF

       call uncompress_commun_zone(ncas_condensation_facftmr, &
     &    cas_condensation_facftmr, &
     &  xtp_cas,xtp(1,1,i),xtwater_cas,xtwater(1,1,i), &
     &          xtevap_cas,xtevap(1,1,i), &
     &          ncum,izone)
        
      enddo !do izone=1,ntraceurs_zone

#ifdef ISOVERIF
!        write(*,*) 'appel_stewart_np tmp 574: ',
!     :           'fin cas condensation_facftmr'
            do il=1,ncas_condensation_facftmr
!               write(*,*) 'il,cas_condensation_facftmr(il)=',
!     :           il,cas_condensation_facftmr(il)
!               write(*,*) 'xtp(1:ntraciso:3)=',xtp(1:ntraciso:3,
!     :           cas_condensation_facftmr(il),i)
!               write(*,*) 'xtp_avantevap(1:ntraciso:3)=',
!     :           xtp_avantevap(1:ntraciso:3,
!     :           cas_condensation_facftmr(il))
!               if (il.eq.cas_condensation_facftmr(602)) then
!                write(*,*) 'appel_stewart_np 638: il=602'
!                write(*,*) 'xtp(iso_eau:ntraciso:3,il,i)=',
!     :           xtp(iso_eau:ntraciso:3,cas_condensation_facftmr(il),i)
!               endif
               call iso_verif_traceur(xtp &
     &          (1,cas_condensation_facftmr(il),i), &
     &          'appel_stewart_np 557')
               call iso_verif_traceur(xtwater &
     &          (1,cas_condensation_facftmr(il),i), &
     &          'appel_stewart_np 560')
               call iso_verif_traceur_justmass(xtevap &
     &          (1,cas_condensation_facftmr(il),i), &
     &          'appel_stewart_np 563')
            enddo !do il=1,ncas_condensation_nofacftmr 
#endif     
         !#ifdef ISOVERIF   
#endif    
        !#ifdef ISOTRAC    

           endif !if (ncas_condensation_facftmr.gt.0) then


        ! ****** traitement vectoriel du cas 1.2

      if (ncas_condensation_nofacftmr.gt.0) then

      call compress_cond_nofftmr(ncas_condensation_nofacftmr, &
     &   cas_condensation_nofacftmr, &
     &   Eqi_prime_cas,Eqi_prime(1), &
     &   Pqisup_cas,Pqisup(1),  &
     &   Pxtisup_cas,Pxtisup(1,1), &
     &   water_cas,water(1,i),  &
     &   T_cas,T(1,i),  &
     &   qp_avantevap_cas,qp_avantevap(1), &
     &   xtp_avantevap_cas,xtp_avantevap(1,1), &
     &   xt_cas,xt(1,1,i),q_cas,q(1,i),  &
     &   xtevapsup_cas,xtevap(1,1,i+1), &
     &   delP_cas,Ph,  &
     &   sigd_cas,sigd(1), &
#ifdef ISOVERIF
     &   evap_cas(1),evap(1,i),qp_cas(1),qp(1,i), &
#endif      
     &   nloc,ncum,nd,i)

#ifdef ISOVERIF
      ! vérif de la compression
!      write(*,*) 'appel_stewart_np tmp 616: ', &
!     &          'apres compress condensation_nofacftmr'
!      write(*,*) 'iso_routines 10153: sigd_cas(1:3)=', sigd_cas(1:3)
      do il=1,ncas_condensation_nofacftmr
        call iso_verif_egalite_choix((Pqisup_cas(il)), &
     &        (Pqisup(cas_condensation_nofacftmr(il))), &
     &        'appel_stewart_np 594: compress condensation_nofacftmr', &
     &          errmax,errmax)
        call iso_verif_egalite_choix(T_cas(il), &
     &        T(cas_condensation_nofacftmr(il),i), &
     &        'appel_stewart_np 597: compress condensation_nofacftmr', &
     &          errmax,errmax)
      enddo
#endif    

      call make_condensation_nofacftmr(ncas_condensation_nofacftmr, &
     &    Eqi_prime_cas(1),Pqisup_cas(1), &
     &    Pxtisup_cas(1,1),water_cas(1),T_cas(1), &
     &    qp_avantevap_cas(1), xtp_avantevap_cas(1,1), &
     &    q_cas(1),xt_cas(1,1),  &
     &    xtevapsup_cas(1,1) ,delP_cas(1),  &  
     &    ztglace_Kelvin, g,sigd_cas(1), &
     &    xtevap_cas(1,1),xtp_cas(1,1),xtwater_cas(1,1) &
#ifdef ISOVERIF
     &    ,evap_cas(1),qp_cas(1),0 &
#endif
     &  )    

#ifdef ISOVERIF
        do   il=1,ncas_condensation_nofacftmr
          do ixt=1,niso
            call iso_verif_noNaN(xtwater_cas(ixt,il), &
     &          'appel_stewart_np 803')
          enddo          
        enddo      
#endif

      call uncompress_commun(ncas_condensation_nofacftmr, &
     &    cas_condensation_nofacftmr, &
     &  xtp_cas,xtp(1,1,i),xtwater_cas,xtwater(1,1,i), &
     &          xtevap_cas,xtevap(1,1,i), &
#ifdef ISOVERIF
     &          Exi_cas(1,1),Exi,    &
#endif
     &          ncum)
                
#ifdef ISOTRAC
       do izone=1,ntraceurs_zone
!         write(*,*) 'appel_stewart_np 718: izone=',izone

         call compress_cond_nofftmr_zone( &
     &   ncas_condensation_nofacftmr, &
     &   cas_condensation_nofacftmr, &
     &   Eqi_prime_cas,Eqi_prime(1), &
     &   Pqisup_cas,Pqisup(1),  &
     &   Pxtisup_cas,Pxtisup(1,1), &
     &   water_cas,water(1,i),  &
     &   qp_avantevap_cas,qp_avantevap(1), &
     &   xtp_avantevap_cas,xtp_avantevap(1,1), &
     &   xt_cas,xt(1,1,i),q_cas,q(1,i),  &
     &   xtevapsup_cas,xtevap(1,1,i+1),  &
#ifdef ISOVERIF
     &   evap_cas(1),evap(1,i), &
#endif      
     &   nloc,ncum,nd,i,izone)

         call make_condensation_nofacftmr(ncas_condensation_nofacftmr, &
     &    Eqi_prime_cas(1),Pqisup_cas(1), &
     &    Pxtisup_cas(1,1),water_cas(1),T_cas(1), &
     &    qp_avantevap_cas(1), xtp_avantevap_cas(1,1), &
     &    q_cas(1),xt_cas(1,1),  &
     &    xtevapsup_cas(1,1) ,delP_cas(1),    &
     &    ztglace_Kelvin, g,sigd_cas(1), &
     &    xtevap_cas(1,1),xtp_cas(1,1),xtwater_cas(1,1) &
#ifdef ISOVERIF
     &    ,evap_cas(1),qp_cas(1),1 &
#endif
     &  )
 

            call uncompress_commun_zone(ncas_condensation_nofacftmr, &
     &          cas_condensation_nofacftmr, &
     &          xtp_cas,xtp(1,1,i),xtwater_cas,xtwater(1,1,i), &
     &          xtevap_cas,xtevap(1,1,i), &
     &          ncum,izone)

       enddo !do izone=1,ntraceurs_zone
#ifdef ISOVERIF
!       write(*,*) 'appel_stewart_np tmp 690: ', &
!     &          'fin du cas condensation_nofacftmr'
            do il=1,ncas_condensation_nofacftmr
               call iso_verif_traceur(xtp &
     &          (1,cas_condensation_nofacftmr(il),i), &
     &          'appel_stewart_np 651')
               call iso_verif_traceur(xtwater &
     &          (1,cas_condensation_nofacftmr(il),i), &
     &          'appel_stewart_np 653')
               call iso_verif_traceur_justmass(xtevap &
     &          (1,cas_condensation_nofacftmr(il),i), &
     &          'appel_stewart_np 655')
            enddo !do il=1,ncas_condensation_nofacftmr 
       
#endif  
#endif            
       
        endif !if (ncas_condensation_nofacftmr.gt.0) then

        
        ! ****** traitement vectoriel du cas 2

      if (ncas_noevap.gt.0) then

      call compress_noevap(ncas_noevap, &
     &   cas_noevap, &
     &   Pqisup_cas,Pqisup,  &
     &   Pxtisup_cas,Pxtisup,   &
     &   xtp_avantevap_cas,xtp_avantevap,  &
     &   xtevapsup_cas,xtevap(1,1,i+1), &
     &   water_cas,water(1,i), &
     &   delP_cas,Ph,  &
#ifdef ISOVERIF        
     &   evap_cas(1),evap(1,i),qp_cas(1),qp(1,i), &
#endif 
     &   nloc,ncum,nd,i) 

#ifdef ISOVERIF
      ! vérif de la compression
!      write(*,*) 'appel_stewart_np 719: apres compression iso noevap'
      do il=1,ncas_noevap
        call iso_verif_egalite_choix((Pqisup_cas(il)), &
     &          (Pqisup(cas_noevap(il))), &
     &          'appel_stewart_np 692: compression',errmax,errmaxrel)
        call iso_verif_egalite_choix(water_cas(il), &
     &          water(cas_noevap(il),i), &
     &          'appel_stewart_np 693: compression',errmax,errmaxrel)
        if (iso_eau.gt.0) then
        call iso_verif_egalite_choix( &
     &          (Pxtisup_cas(iso_eau,il)), &
     &          (Pqisup_cas(il)), &
     &          'appel_stewart_np 759',errmax,errmaxrel)
        if (iso_verif_egalite_choix_nostop( &
     &          (xtp_avantevap(iso_eau,cas_noevap(il))), &
     &          qp(cas_noevap(il),i), &
     &          'appel_stewart_np 739',errmax,errmaxrel).eq.1) then
           write(*,*) 'il,cas_noevap=',il,cas_noevap(il)
           stop
        endif
        call iso_verif_egalite_choix( &
     &          (xtp_avantevap_cas(iso_eau,il)), &
     &          qp_cas(il), &
     &          'appel_stewart_np 735',errmax,errmaxrel)        
        endif !if (iso_eau.gt.0) then
      enddo !do il=1,ncas_noevap
#endif      

      call make_cas_noevap_np(ncas_noevap, &
     &         xtp_avantevap_cas(1,1),xtevapsup_cas(1,1), &
     &         Pxtisup_cas(1,1),Pqisup_cas(1),water_cas(1), &
     &         xtevap_cas(1,1),xtp_cas(1,1),xtwater_cas(1,1) &
#ifdef ISOVERIF
     &         ,evap_cas(1),qp_cas(1),0  &
#endif        
     &         )
   
#ifdef ISOVERIF
        do   il=1,ncas_noevap
          do ixt=1,niso
            call iso_verif_noNaN(xtwater_cas(ixt,il), &
     &          'appel_stewart_np 935')
          enddo          
        enddo      
#endif    

       call uncompress_commun(ncas_noevap,cas_noevap, &
     &  xtp_cas,xtp(1,1,i),xtwater_cas,xtwater(1,1,i), &
     &          xtevap_cas,xtevap(1,1,i), &
#ifdef ISOVERIF
     &          Exi_cas(1,1),Exi,  &  
#endif
     &          ncum)

#ifdef ISOTRAC
       do izone=1,ntraceurs_zone
        call compress_noevap_zone(ncas_noevap, &
     &   cas_noevap, &
     &   Pqisup_cas,Pqisup,  &
     &   Pxtisup_cas,Pxtisup,   &
     &   xtp_avantevap_cas,xtp_avantevap,  &
     &   xtevapsup_cas,xtevap(1,1,i+1), &
     &   water_cas,water(1,i), &
#ifdef ISOVERIF        
     &   evap_cas(1),evap(1,i), &
#endif 
     &   nloc,ncum,nd,i,izone)

#ifdef ISOVERIF
!        write(*,*) 'appel_stewart_np 765: après compression isotrac'
        do il=1,ncas_noevap
          call iso_verif_egalite_choix( &
     &          (Pxtisup_cas(iso_eau,il)), &
     &          (Pqisup_cas(il)), &
     &          'appel_stewart_np 759',errmax,errmaxrel)
        enddo !do il=1,ncas_noevap
#endif        
        
        call make_cas_noevap_np(ncas_noevap, &
     &         xtp_avantevap_cas(1,1),xtevapsup_cas(1,1), &
     &         Pxtisup_cas(1,1),Pqisup_cas(1),water_cas(1), &
     &         xtevap_cas(1,1),xtp_cas(1,1),xtwater_cas(1,1) &
#ifdef ISOVERIF
     &         ,evap_cas(1),qp_cas(1),1 &
#endif        
     &         )

        call uncompress_commun_zone(ncas_noevap,cas_noevap, &
     &  xtp_cas,xtp(1,1,i),xtwater_cas,xtwater(1,1,i), &
     &          xtevap_cas,xtevap(1,1,i), &
     &          ncum,izone)
        enddo !do izone=1,ntraceurs_zone

#ifdef ISOVERIF
!        write(*,*) 'appel_stewart_np tmp 806: ',
!     &          'fin du cas noevap'
       do il=1,ncas_noevap
           call iso_verif_traceur(xtp(1,cas_noevap(il),i), &
     &          'appel_stewart_np 734')
           call iso_verif_traceur(xtevap(1,cas_noevap(il),i), &
     &          'appel_stewart_np 736')
           call iso_verif_traceur(xtwater(1,cas_noevap(il),i), &
     &          'appel_stewart_np 738')
       enddo !do il=1,ncas_noevap
#endif
       
#endif       

        endif !if (ncas_noevap.gt.0) then


        ! ****** traitement vectoriel du cas 3.1

      if (ncas_evap_liq.gt.0) then
          

      call compress_evap_liq(3,ncas_evap_liq, &
     &   cas_evap_liq, &
     &   Pqisup_cas,Pqisup,  &
     &   Pxtisup_cas,Pxtisup,   &
     &   qp_avantevap_cas,qp_avantevap, &
     &   xtp_avantevap_cas,xtp_avantevap,  &
     &   xtevapsup_cas,xtevap(1,1,i+1), &
     &   water_cas,water(1,i),  &
     &   qs_cas,qs(1,i), &
     &   Eqi_stewart,Pqiinf_stewart,Eqi_prime_cas, &
     &   Pqiinf,Eqi_par,Pqiinf_par,Eqi_prime,   &
     &   Eqi,Eqi_cas,  &
     &   fac_ftmr_cas,fac_ftmr,  &
     &   T_cas,T(1,i), &
     &   wt_cas,wt(1,i), &
     &   INB_cas,INB(1), &
     &   delP_cas,Ph, &
     &   qp_cas,qp(1,i), &
     &   sigd_cas,sigd(1), &
#ifdef ISOVERIF         
     &   evap_cas,evap(1,i), &
#endif      
     &   nloc,ncum,nd,i)

#ifdef ISOVERIF
      ! vérif de la compression
!      write(*,*) 'appel_stewart_np tmp 899: ',
!     :           'apres compress_evap_liq'
!      write(*,*) 'cas_evap_liq(1)=',cas_evap_liq(1)
!      if (ncas_evap_liq.ge.85) then
!      write(*,*) 'cas_evap_liq(85)=',cas_evap_liq(85)
!      endif
!      write(*,*) 'Eqi_stewart,Pqiinf_stewart,Eqi_prime_cas,Eqi_cas',
!     :    Eqi_stewart(1),Pqiinf_stewart(1),
!     :    Eqi_prime_cas(1),Eqi_cas(1)
      do il=1,ncas_evap_liq
!       write(*,*) 'il=',il
!      write(*,*) 'qp_avantevap_cas(il),xtp_avantevap_cas(iso_eau,il)=',
!     :    qp_avantevap_cas(il),xtp_avantevap_cas(iso_eau,il) 
        call iso_verif_egalite_choix((Pqisup_cas(il)), &
     &          (Pqisup(cas_evap_liq(il))), &
     &          'appel_stewart_np 822: compression evap_liq', &
     &          errmax,errmax)
        call iso_verif_egalite_choix(water_cas(il), &
     &          water(cas_evap_liq(il),i), &
     &          'appel_stewart_np 825: compression evap_liq', &
     &          errmax,errmax)
        call iso_verif_egalite_choix( &
     &        (qp_avantevap_cas(il)), &
     &        (qp_avantevap(cas_evap_liq(il))), &
     &        'appel_stewart_np 783: compression evap_liq', &
     &          errmax,errmax)
        if (iso_eau.gt.0) then
        call iso_verif_egalite_choix( &
     &        (xtp_avantevap_cas(iso_eau,il)), &
     &        (qp_avantevap_cas(il)), &
     &        'appel_stewart_np 789: compression evap_liq', &
     &         errmax,errmax) 
        endif ! if (iso_eau.gt.0) then  
        call iso_verif_positif((Eqi_stewart(il)), &
     &          'appel_stewart_np 1124: compression evap_liq') 
      enddo !do il=1,ncas_evap_liq
#endif       
      do il=1,ncas_evap_liq     
        qeff(il)=thumxt1*Qs_cas(il) &
     &     +(1.0-thumxt1)*qp_avantevap_cas(il)
      enddo   !do il=1,ncas_evap_liq

!      write(*,*) 'appel tmp 802: xtp_avantevap_cas(iso_eau,2)=',
!     :           xtp_avantevap_cas(iso_eau,2)
!      write(*,*) 'appel tmp 1490: qp_avantevap_cas(2)=',
!     :           qp_avantevap_cas(2)
!       write(*,*) 'appel_stewart_np 933: make_cas_evap_liq_np pr eau normale'

       ! ici, ptrac ne sera pas utilisé
       call make_cas_evap_liq_np(ncas_evap_liq, &
     &          water_cas(1), &
     &          xtp_avantevap_cas(1,1),qp_avantevap_cas(1), &
     &          xtp_avantevap_cas(1,1),qp_avantevap_cas(1), &
     &          Pxtisup_cas(1,1),Pqisup_cas(1), &
     &          Eqi_stewart(1),Pqiinf_stewart(1),fac_ftmr_cas(1), &
     &          qs_cas(1), T_cas(1),wt_cas(1),  delP_cas(1), &
     &          xtevapsup_cas(1,1),qeff(1),g,sigd_cas(1), Eqi_prime_cas(1), &
     &          Eqi_cas(1), &
     &          qp_cas(1), INB_cas(1),i,0, &
#ifdef ISOTRAC       
     &          ptrac(1),hdiag(1), &
#endif                
#ifdef ISOVERIF
     &          evap_cas(1),Exi_cas(1,1), &      
#endif       
     &          xtp_cas(1,1),xtwater_cas(1,1),xtevap_cas(1,1))


#ifdef ISOVERIF
        do   il=1,ncas_evap_liq
          do ixt=1,niso
            call iso_verif_noNaN(xtwater_cas(ixt,il), &
     &          'appel_stewart_np 1105')
          enddo          
        enddo      
#endif        

       call uncompress_commun(ncas_evap_liq,cas_evap_liq, &
     &  xtp_cas,xtp(1,1,i),xtwater_cas,xtwater(1,1,i), &
     &          xtevap_cas,xtevap(1,1,i), &
#ifdef ISOVERIF
     &          Exi_cas(1,1),Exi,    &
#endif
     &          ncum)

#ifdef ISOTRAC

       ! initialisation dans le cas où la revap est taggée:
       if (option_revap.eq.1) then
         do il=1,ncas_evap_liq  
           do iiso=1,niso
             ixt=index_trac(izone_revap,iiso)
             xtevap(ixt,cas_evap_liq(il),i)=0.0
             xtp(ixt,cas_evap_liq(il),i)= &
     &          xtp_avantevap(ixt,cas_evap_liq(il)) 
             enddo  !do iiso=1,niso  
         enddo !do il=1,ncas_evap_glace  
       endif



      do izone=1,ntraceurs_zone      
      
!       write(*,*) 'appel_stewart_np 924 tmp: cas liq: izone=',izone 
!       write(*,*) 'appel 924: xtp_avantevap(c,cas(2))=',
!     &          xtp_avantevap(1:ntraciso:3,cas_evap_liq(2))
!       write(*,*) 'Pxtisup(1:ntraciso:3,cas(2))=',
!     &          Pxtisup(1:ntraciso:3,cas_evap_liq(2))
       call compress_evap_liq_zone(3,ncas_evap_liq, &
     &   cas_evap_liq, &
     &   Pqisup_cas,Pqisup,  &
     &   Pxtisup_cas,Pxtisup,   &
     &   xtp_avantevap_cas,xtp_avantevap, &
     &   xtp_avantevaptrac_cas, qp_avantevaptrac_cas, &
     &   xtevapsup_cas,xtevap(1,1,i+1), &
     &   water_cas,water(1,i),  &
     &   Eqi_stewart,Pqiinf_stewart,Eqi_prime_cas, &
     &   Pqiinf,Eqi_par,Pqiinf_par,Eqi_prime,ptrac, &
     &   Eqi,Eqi_cas,  &
#ifdef ISOVERIF       
     &   evap_cas,evap(1,i),  &
#endif       
     &   nloc,ncum,nd,izone)

#ifdef ISOVERIF
!       write(*,*) 'appel_stewart_np tmp 941'
!       if (ncas_evap_liq.ge.162) then
!          write(*,*) 'Eqi_prime_cas=',Eqi_prime_cas(162)
!           write(*,*) 'Pqisup=',Pqisup(cas_evap_liq(162))
!           write(*,*) 'Eqi_prime=',Eqi_prime(cas_evap_liq(162))
!           write(*,*) 'Pxtisup=',
!     :           Pxtisup(iso_eau:ntraciso:3,cas_evap_liq(162))
!       endif
!        write(*,*) 'qp_avantevap_cas(2)=',
!     :           qp_avantevap_cas(2)
!       write(*,*) 'xtp_avantevap(iso_eau,cas_evap_liq(1))=',
!     :           xtp_avantevap(iso_eau,cas_evap_liq(1))
!       write(*,*) 'xtp_avantevap_cas(iso_eau,2)=',
!     :           xtp_avantevap_cas(iso_eau,2)
!       write(*,*) 'xtp_avantevaptrac_cas(iso_eau,2)=',
!     :           xtp_avantevaptrac_cas(iso_eau,2)
       if (iso_eau.gt.0) then
           do il=1,ncas_evap_liq
!             write(*,*) 'appel_stewart_np tmp 943: il=',il
             call iso_verif_egalite_choix( &
     &        (qp_avantevap(cas_evap_liq(il))), &
     &        (xtp_avantevap(iso_eau,cas_evap_liq(il))), &
     &        'appel_stewart_np 944', &
     &        errmax,errmaxrel)
             call iso_verif_egalite_choix( &
     &        (qp_avantevap(cas_evap_liq(il))), &
     &        (qp_avantevap_cas(il)), &
     &        'appel_stewart_np 951', &
     &        errmax,errmaxrel)
             call iso_verif_egalite_choix( &
     &        (xtp_avantevap(iso_eau,cas_evap_liq(il))), &
     &        (xtp_avantevap_cas(iso_eau,il)), &
     &        'appel_stewart_np 956', &
     &        errmax,errmaxrel)
             call iso_verif_egalite_choix( &
     &          (qp_avantevap_cas(il)), &
     &          (xtp_avantevap_cas(iso_eau,il)), &
     &          'appel_stewart_np 961', &
     &          errmax,errmaxrel)
!             if ((option_traceurs.eq.17).or.
!     :           (option_traceurs.eq.18)) then
!               if (izone.eq.izone_cond) then
!                call iso_verif_positif((
!     :           Pxtisup_cas(iso_eau,il)
!     :           -Pxtisup(iso_eau,cas_evap_liq(il))),
!     :           'appel_stewart_np 1114')
!               else !if (izone.eq.izone_cond) then
!                call iso_verif_positif((
!     :           -Pxtisup_cas(iso_eau,il)),
!     :           'appel_stewart_np 1118')
!               endif !if (izone.eq.izone_cond) then
!             endif   !if ((option_traceurs.eq.17).or.
           enddo !do il=1,ncas_evap_liq
       endif !if (iso_eau.gt.0) then
#endif       

       call make_cas_evap_liq_np(ncas_evap_liq, &
     &          water_cas(1), &
     &          xtp_avantevap_cas(1,1),qp_avantevap_cas(1), &
     &          xtp_avantevaptrac_cas(1,1),qp_avantevaptrac_cas(1), &
     &          Pxtisup_cas(1,1),Pqisup_cas(1), &
     &          Eqi_stewart(1),Pqiinf_stewart(1),fac_ftmr_cas(1), &
     &          qs_cas(1), T_cas(1),wt_cas(1),  delP_cas(1), &
     &          xtevapsup_cas(1,1),qeff(1),  g,sigd_cas(1),Eqi_prime_cas(1), &
     &          Eqi_cas(1),   &
     &          qp_cas(1),INB_cas(1),i,1, &
     &          ptrac(1),hdiag(1), &
#ifdef ISOVERIF
     &          evap_cas(1),Exi_cas(1,1), &
#endif          
     &          xtp_cas(1,1),xtwater_cas(1,1),xtevap_cas(1,1))

      ! verif
#ifdef ISOVERIF
      do il=1,ncas_evap_liq
        do ixt=1,niso
         call iso_verif_noNaN(xtp_cas(ixt,il),'appel_stewart_np 198')
         call iso_verif_noNaN(xtevap_cas(ixt,il), &
     &        'appel_stewart_np 745')
         call iso_verif_noNaN(xtwater_cas(ixt,il), &
     &        'appel_stewart_np 745')
        enddo !do ixt=1,niso
      enddo !do il=1,ncas_evap_liq
#endif       

       call uncompress_commun_zone_revap(ncas_evap_liq,cas_evap_liq, &
     &  xtp_cas,xtp(1,1,i),xtwater_cas,xtwater(1,1,i), &
     &          xtevap_cas,xtevap(1,1,i), &
     &          ncum,izone,Eqi_stewart,fac_ftmr_cas, &
#ifdef ISOVERIF
     &          Exi_cas(1,1),Exi(1,1), &
#endif       
     &          xtp_avantevaptrac_cas,1,hdiag(1))
        
      enddo ! do izone=ntraceurs_zone

#ifdef ISOVERIF
       do il=1,ncas_evap_liq
           
           if (iso_verif_traceur_nostop(xtp(1,cas_evap_liq(il),i), &
     &          'appel_stewart_np 1256').eq.1) then
             write(*,*) 'il,cas_evap_liq(il)=',il,cas_evap_liq(il)
             write(*,*) 'trace_cas(cas_evap_liq(il))=', &
     &          trace_cas(cas_evap_liq(il))
             if (trace_cas(cas_evap_liq(il)).eq.31) then
                 write(*,*) 'cas evap_liq'
                 write(*,*) 'xtp(:,cas_evap_liq(il),i)=', &
     &             xtp(:,cas_evap_liq(il),i)
                 write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
                 write(*,*) 'Eqi_stewart(il),Eqi_prime=', &
     &                  Eqi_stewart(il),Eqi_prime(cas_evap_liq(il))
                 write(*,*) 'Pxtisup(:,cas_evap_liq(il))=', &
     &                  Pxtisup(:,cas_evap_liq(il))
                 write(*,*) 'xtp_avantevap(:,cas_evap_liq(il))=', &
     &                 xtp_avantevap(:,cas_evap_liq(il))
                 write(*,*) 'Exi(:,cas_evap_liq(il))=', &
     &                 Exi(:,cas_evap_liq(il))
                 write(*,*) 'T_cas(il)=',T_cas(il)
                 write(*,*) 'h(il)=',thumxt1+(1.0-thumxt1)* &
     &                  qp_avantevap_cas(il)/qs_cas(il) 
             endif !if (trace_cas(il).eq.31) then
                ! en cas de problème ci, activer l'option débug de
                ! stewart_explicit
!                stop
                ! le 22 aout: on replace errmaxrel*20 par errmaxrel*25
                ! pour que ça marche à l'idris
             call iso_verif_traceur_choix(xtp(1,cas_evap_liq(il),i), &
     &          'appel_stewart_np 1154', &
     &           errmax,errmaxrel*25,ridicule_trac,deltalimtrac) 
           endif !if (iso_verif_traceur_nostop
           ! dans le test suivant, c'est errmaxrel*50
           call iso_verif_traceur_pbidouille( &
     &          xtp(1,cas_evap_liq(il),i), &
     &          'appel_stewart_np 1124')
           call iso_verif_traceur_justmass(xtevap(1,cas_evap_liq(il),i), &
     &          'appel_stewart_np 1258') 
!           write(*,*) 'appel_stewart_np tmp 1172: il,i=',il,i          
           call iso_verif_traceur(xtwater(1,cas_evap_liq(il),i), &
     &          'appel_stewart_np 1260')           
       enddo !do il=1,ncas_evap_liq
#endif
       
#endif

        endif !if (ncas_evap_liq.gt.0) then

       
        

                ! ****** traitement vectoriel du cas 3.2

      if (ncas_evap_glace.gt.0) then


      call compress_evap_glace(3, &
     &   ncas_evap_glace,cas_evap_glace, &
     &   water_cas,water(1,i),  &
     &   Pqisup_cas,Pqisup,  &
     &   Pxtisup_cas,Pxtisup,  &
     &   T_cas,T(1,i),   &
     &   fac_ftmr_cas,fac_ftmr,  &
     &   qp_avantevap_cas,qp_avantevap, &
     &   xtp_avantevap_cas,xtp_avantevap,  &
     &   xtevapsup_cas,xtevap(1,1,i+1), &
     &   Eqi_stewart,Pqiinf_stewart,Eqi_prime_cas,Eqi_cas, &
!     &   Pqiinf,Eqi_par,Pqiinf_par,Eqi_prime,
     &   Pqiinf,Eqi_par,Pqiinf_par,Eqi_prime,Eqi, & ! modif 22 dec 2011
     &   INB_cas,INB(1),  &
     &   delP_cas,Ph,  &
     &   qp_cas,qp(1,i), &
     &   sigd_cas,sigd(1), &
#ifdef ISOVERIF      
     &   evap_cas,evap(1,i), &
#endif      
     &   nloc,ncum,nd,i,frac_sublim)

#ifdef ISOVERIF
!      write(*,*) 'appel_stewart_np tmp 898 apres compress glace'
!      write(*,*) 'qp_avantevap_cas(1),qp_avantevap(cas(1))=',
!     &   qp_avantevap_cas(1),qp_avantevap(cas_evap_glace(1))   
      !write(*,*) 'Pqiinf_stewart(1)=',Pqiinf_stewart(1)
      ! vérif de la compression
      do il=1,ncas_evap_glace
!       write(*,*) 'il=',il
!      write(*,*) 'qp_avantevap_cas(il),qp_avantevap(cas(il))=',
!     :    qp_avantevap_cas(il),qp_avantevap(cas_evap_glace(il)) 
        call iso_verif_egalite_choix((Pqisup_cas(il)), &
     &        (Pqisup(cas_evap_glace(il))), &
     &        'appel_stewart_np 1096: compression evap_glace', &
     &          errmax,errmax)
        call iso_verif_egalite_choix(water_cas(il), &
     &        water(cas_evap_glace(il),i), &
     &        'appel_stewart_np 1099: compression evap_glace', &
     &          errmax,errmax)
        call iso_verif_egalite_choix(evap_cas(il), &
     &        evap(cas_evap_glace(il),i), &
     &        'appel_stewart_np 910: compression evap_glace', &
     &          errmax,errmax)
        
        call iso_verif_egalite_choix(xtevapsup_cas(iso_eau,il), &
     &        xtevap(iso_eau,cas_evap_glace(il),i+1), &
     &        'appel_stewart_np 1106: compression evap_glace', &
     &          errmax,errmax) 
        call iso_verif_egalite_choix( &
     &        (qp_avantevap_cas(il)), &
     &        (qp_avantevap(cas_evap_glace(il))), &
     &        'appel_stewart_np 914: compression evap_glace', &
     &          errmax,errmax)
        if (iso_eau.gt.0) then
        call iso_verif_egalite_choix( &
     &        (xtp_avantevap_cas(iso_eau,il)), &
     &        (qp_avantevap_cas(il)), &
     &        'appel_stewart_np 919: compression evap_glace', &
     &         errmax,errmax) 
        endif      
      enddo
!       write(*,*) 'appel_stewart_np tmp 1054:',
!     :   ' appel make_cas_evap_glace_np'
!       write(*,*) 'cas_evap_glace(1)=',cas_evap_glace(1)
!       write(*,*) 'Pqiinf_stewart(1)=',Pqiinf_stewart(1)
#endif   
      
        call make_cas_evap_glace_np(ncas_evap_glace, &
     &          water_cas(1), &
     &          xtp_avantevap_cas(1,1),qp_avantevap_cas(1), &
     &          xtp_avantevap_cas(1,1),qp_avantevap_cas(1), &
     &          Pxtisup_cas(1,1),Pqisup_cas(1), &
     &          Eqi_stewart(1),Eqi_prime_cas(1),Eqi_cas(1), &
     &          Pqiinf_stewart(1),fac_ftmr_cas(1), &
     &          qs_cas(1), T_cas(1),wt_cas(1),  delP_cas(1), &
     &          xtevapsup_cas(1,1),g,sigd_cas(1),INB_cas(1),i, &
     &          frac_sublim,qp_cas(1), &
#ifdef ISOVERIF        
     &          evap_cas(1),0,Exi_cas(1,1), &
#endif        
     &          xtp_cas(1,1),xtwater_cas(1,1),xtevap_cas(1,1))

!#ifdef ISOVERIF    
!        write(*,*) 'appel_stewart_np tmp 1073 après make_cas_evap_glace_np'
!#endif

#ifdef ISOVERIF
        do   il=1,ncas_evap_glace
          do ixt=1,niso
            call iso_verif_noNaN(xtwater_cas(ixt,il), &
     &          'appel_stewart_np 1402')
          enddo          
        enddo      
#endif         

       call uncompress_commun(ncas_evap_glace,cas_evap_glace, &
     &  xtp_cas,xtp(1,1,i),xtwater_cas,xtwater(1,1,i), &
     &          xtevap_cas,xtevap(1,1,i), &
#ifdef ISOVERIF
     &          Exi_cas(1,1),Exi,    &
#endif
     &          ncum)

#ifdef ISOTRAC

       ! initialisation dans le cas où la revap est taggée:
       if (option_revap.eq.1) then
         do il=1,ncas_evap_glace   
           do iiso=1,niso
             ixt=index_trac(izone_revap,iiso)
             xtevap(ixt,cas_evap_glace(il),i)=0.0
             xtp(ixt,cas_evap_glace(il),i)= &
     &          xtp_avantevap(ixt,cas_evap_glace(il)) 
           enddo  !do iiso=1,niso  
         enddo !do il=1,ncas_evap_glace  
       endif

       do izone=1,ntraceurs_zone
!       write(*,*) 'tmp appel_stewart_np 1284: izone=',izone

       call compress_evap_glace_zone(3, &
     &   ncas_evap_glace,cas_evap_glace, &
     &   water_cas,water(1,i),  &
     &   Pqisup_cas,Pqisup,  &
     &   Pxtisup_cas,Pxtisup,  &
     &   xtp_avantevap_cas,xtp_avantevap,   &
     &   xtp_avantevaptrac_cas,qp_avantevaptrac_cas,  &
     &   xtevapsup_cas,xtevap(1,1,i+1), &
     &   Eqi_stewart,Pqiinf_stewart,Eqi_prime_cas,Eqi_cas, &
     &   Pqiinf,Eqi_par,Pqiinf_par,Eqi_prime,Eqi, &
!     &   qp_cas,
#ifdef ISOVERIF       
     &   evap_cas,evap(1,i), &
#endif       
     &   nloc,ncum,nd,i,frac_sublim,izone)

!#ifdef ISOVERIF    
!        write(*,*) 'appel_stewart_np tmp 1101 call make_cas_evap_glace_np'
!#endif       
       call make_cas_evap_glace_np(ncas_evap_glace, &
     &          water_cas(1), &
     &          xtp_avantevap_cas(1,1),qp_avantevap_cas(1), &
     &          xtp_avantevaptrac_cas(1,1),qp_avantevaptrac_cas(1), &
     &          Pxtisup_cas(1,1),Pqisup_cas(1), &
     &          Eqi_stewart(1),Eqi_prime_cas(1),Eqi_cas(1), &
     &          Pqiinf_stewart(1),fac_ftmr_cas(1), &
     &          qs_cas(1), T_cas(1),wt_cas(1),  delP_cas(1), &
     &          xtevapsup_cas(1,1),g,sigd_cas(1),INB_cas(1),i, &
     &          frac_sublim,qp_cas(1), &
#ifdef ISOVERIF       
     &          evap_cas(1),1,Exi_cas(1,1), &
#endif       
     &          xtp_cas(1,1),xtwater_cas(1,1),xtevap_cas(1,1))


       call uncompress_commun_zone_revap(ncas_evap_glace,cas_evap_glace, &
     &  xtp_cas,xtp(1,1,i),xtwater_cas,xtwater(1,1,i), &
     &          xtevap_cas,xtevap(1,1,i), &
     &          ncum,izone,Eqi_stewart,fac_ftmr_cas, &
#ifdef ISOVERIF
     &          Exi_cas(1,1),Exi(1,1), &
#endif       
     &          xtp_avantevaptrac_cas,0,hdiag(1)) ! hdiag ne sera pas utilise

       enddo ! do izone=1,ntraceurs_zone

#ifdef ISOVERIF    
!        write(*,*) 'appel_stewart_np tmp 1117: ',
!     :           'fin du cas evap_glace'   
        do il=1,ncas_evap_glace
!           write(*,*) 'appel_stewart_np tmp 1146: il=',il            
!           write(*,*) 'xtp_avantevap=',xtp_avantevap
!     :           (1:ntraciso,cas_evap_glace(il))
!           write(*,*) 'xtp=',xtp(1:ntraciso,cas_evap_glace(il),i)
           if (iso_verif_traceur_nostop(xtp(1,cas_evap_glace(il),i), &
     &          'appel_stewart_np 1314').eq.1) then
             write(*,*) 'il,cas_evap_glace(il)=',il,cas_evap_glace(il)
             write(*,*) 'trace_cas(cas_evap_glace(il))=', &
     &          trace_cas(cas_evap_glace(il))
             write(*,*) 'cas evap_glace'
             write(*,*) 'xtp(:,cas_evap_glace(il),i)=', &
     &             xtp(:,cas_evap_glace(il),i)
             write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
             write(*,*) 'Eqi_stewart(il)=',Eqi_stewart(il)
             write(*,*) 'Pxtisup(:,cas_evap_glace(il))=', &
     &                  Pxtisup(:,cas_evap_glace(il))
             write(*,*) 'xtp_avantevap(:,cas_evap_glace(il))=', &
     &                 xtp_avantevap(:,cas_evap_glace(il))
             write(*,*) 'Exi(:,cas_evap_glace(il))=', &
     &                 Exi(:,cas_evap_glace(il))
             ! on laisse quand même une chance
             call iso_verif_traceur_pbidouille( &
     &          xtp(1,cas_evap_glace(il),i), &
     &          'appel_stewart_np 1331')
           endif
           call iso_verif_traceur(xtevap(1,cas_evap_glace(il),i), &
     &          'appel_stewart_np 2150')
           call iso_verif_traceur(xtwater(1,cas_evap_glace(il),i), &
     &          'appel_stewart_np 2152')
        enddo !do il=1,ncas_evap_glace        
#endif
#endif

        endif !if (ncas_evap_glace.gt.0) then


       ! ****** dernières vérifs et bidouilles


#ifdef ISOVERIF
        do il=1,ncum 
           if (i.le.inb(il) .and. lwork(il)) then
             do ixt=1,ntraciso
               if ((iso_verif_noNAN_nostop(xtevap(ixt,il,i), &
     &            'appel_stewart_np 1661').eq.1).or. &
     &            (iso_verif_noNAN_nostop(xtp(ixt,il,i), &
     &            'appel_stewart_np 1382').eq.1).or. &
     &            (iso_verif_noNAN_nostop(xtwater(ixt,il,i), &
     &            'appel_stewart_np 1381').eq.1)) then
                 write(*,*) 'il,i,trace_cas=',il,i,trace_cas(il)
                 stop
               endif
             enddo
         endif !if (i.le.inb(il) .and. lwork(il)) then
       enddo !do il=1,ncum 
#endif  
#ifdef ISOVERIF
        do il=1,ncum 
           if (i.le.inb(il) .and. lwork(il)) then
             if (iso_eau.gt.0) then
              if (iso_verif_egalite_choix_nostop(xtwater(iso_eau,il,i), &
     &        water(il,i),'appel_stewart_np 1277, fin, water', &
     &        errmax,errmaxrel).eq.1) then 
               write(*,*) 'il,i,trace_cas=',il,i,trace_cas(il)
               stop 
              endif  !if (iso_verif_egalite_choix_nostop(  
              if (iso_verif_egalite_choix_nostop( &
     &        xtp(iso_eau,il,i),qp(il,i),'appel_stewart_np 1278', &
     &        errmax,errmaxrel*50).eq.1) then 
               write(*,*) 'il,i,trace_cas=',il,i,trace_cas(il)
               stop 
              endif  !if (iso_verif_egalite_choix_nostop(
              if (iso_verif_egalite_choix_nostop( &
     &        xtevap(iso_eau,il,i),evap(il,i), &
     &        'appel_stewart_np 1279', &
     &        errmax,errmaxrel).eq.1) then 
               write(*,*) 'il,i,trace_cas=',il,i,trace_cas(il)
               stop 
              endif  !if (iso_verif_egalite_choix_nostop(
             endif !if (iso_eau.gt.0) then
             if ((iso_HDO.gt.0).and. &
     &          (qp(il,i).gt.ridicule)) then
                call iso_verif_aberrant( &
     &          xtp(iso_HDO,il,i)/qp(il,i), &
     &          'appel_stewart_np 1498')
             endif  ! if (iso_HDO.gt.0) then
#ifdef ISOTRAC
!           if (il.eq.602) then
!              write(*,*) 'appel_stewart_np 1334: il,i=',il,i
!              write(*,*) 'xtp(iso_eau:ntraciso:3,il,i)=',
!     :          xtp(iso_eau:ntraciso:3,il,i) 
!           endif
           call iso_verif_traceur(xtp(1,il,i), &
     &          'appel_stewart_np 1632')
           call iso_verif_traceur_justmass(xtevap(1,il,i), &
     &          'appel_stewart_np 1634')
           call iso_verif_traceur(xtwater(1,il,i), &
     &          'appel_stewart_np 1636')
!           if ((option_traceurs.eq.17).or.
!     :           (option_traceurs.eq.18)) then
!            if (iso_verif_positif_nostop(xtwater(
!     :           index_trac(izone_cond,iso_eau),il,i)
!     :           -xtwater(iso_eau,il,i),
!     :           'appel_stewart_np 1457').eq.1) then
!             write(*,*) 'il,trace_cas=',il,trace_cas(il)
!             stop
!            endif !if (iso_verif_positif_nostop(xtwater(iso_eau,il,i)-
!           endif !if ((option_traceurs.eq.17).or.
#endif  
           endif !if (i.le.inb(il) .and. lwork(il)) then 
        enddo !do il=1,ncum 
#endif

       if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) then 
         do il=1,ncum 
           if (i.le.inb(il) .and. lwork(il)) then 
             xtwater(iso_eau,il,i)= water(il,i)
             xtp(iso_eau,il,i)=qp(il,i) 
             xtevap(iso_eau,il,i)= evap(il,i) 
#ifdef ISOTRAC       
#ifdef ISOVERIF
             call iso_verif_traceur_pbidouille(xtp(1,il,i), &
     &          'appel_stewart_np 1362') 
             call iso_verif_traceur_pbidouille( &
     &          xtwater(1,il,i), &
     &          'appel_stewart_np 1381')                       
#else
             call iso_verif_traceur_jbidouille(xtp(1,il,i))
             call iso_verif_traceur_jbidouille(xtwater(1,il,i))
#endif            
#endif             
           endif !if (i.le.inb(il) .and. lwork(il)) then     
          enddo !do il=1,ncum  
        endif !if (bidouille_anti_divergence) then

!#ifdef ISOVERIF
!        write(*,*) 'appel_stewart_np tmp 1197: sortie'
!#endif

        end subroutine appel_stewart_vectall_np

         
        subroutine make_cas_noevap_np(ncas, &
     &         xtp_avantevap_cas,xtevapsup_cas, &
     &         Pxtisup_cas,Pqisup_cas,water_cas, &
     &         xtevap_cas,xtp_cas,xtwater_cas &
#ifdef ISOVERIF
     &         ,evap_cas,qp_cas,oktrac  &
#endif        
     &          ) 

  USE isotopes_mod, ONLY: iso_eau, iso_HDO,Rdefault,ridicule
#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel
USE isotopes_verif_mod
#endif
        implicit none

        ! inputs
        integer ncas
        real xtevapsup_cas(niso,ncas),water_cas(ncas)
        real  xtp_avantevap_cas(niso,ncas), &
     &  Pqisup_cas(ncas), Pxtisup_cas(niso,ncas)
#ifdef ISOVERIF        
        real evap_cas(ncas),qp_cas(ncas)
        integer oktrac ! si traceurs, certaines verifs ne sont pas
                !valides
#endif
!        integer iso_verif_noNaN_nostop
        ! outputs
        real xtevap_cas(niso,ncas),xtp_cas(niso,ncas), &
     &           xtwater_cas(niso,ncas)

        ! locals
        real Risup(niso,ncas)
        integer il,ixt
        !real 

!        write(*,*) 'appel_stewart_np tmp 1530: Pxtisup_cas(iso_eau,2)=',
!     &          Pxtisup_cas(iso_eau,2)
!        write(*,*) 'Pqisup_cas(2)=',Pqisup_cas(2)
        do il=1,ncas
         do ixt=1,niso
             xtp_cas(ixt,il)=xtp_avantevap_cas(ixt,il)
             xtevap_cas(ixt,il)=0.0
         enddo  !do ixt=1,niso 
       enddo !do il=1,ncas_noevap
#ifdef ISOVERIF       
       do il=1,ncas
        if ((Pqisup_cas(il).le.0.0).and. &
     &          (water_cas(il).gt.ridicule*10)) then
            ! 27 mai 2009: on est plus laxiste dans le cas des traceurs
            ! d'eau: on met ridicule*10
            write(*,*) 'appel_stewart_np 372: water(il,i)=', &
     &        water_cas(il)
            write(*,*) 'appel_stewart_np 372: Pqisup=',Pqisup_cas(il)
            stop
         endif
         if (iso_eau.gt.0) then
             call iso_verif_egalite_choix( &
     &          (Pxtisup_cas(iso_eau,il)), &
     &          (Pqisup_cas(il)), &
     &          'appel_stewart_np 1548',errmax,errmaxrel)
         endif
         call iso_verif_noNaN(water_cas(il), &
     &                  'appel_stewart_np 1583')
        enddo !do il=1,ncas_noevap
#endif        
        do il=1,ncas
         ! changement: >0 -> >ridicule*1e-2
         if (Pqisup_cas(il).gt.ridicule*1e-2) then
            do ixt=1,niso  
              Risup(ixt,il)=Pxtisup_cas(ixt,il)/Pqisup_cas(il)
              xtwater_cas(ixt,il)=water_cas(il)*Risup(ixt,il)
            enddo !do ixt=1,niso
         else !if (Pqisup.gt.0.0) then
           do ixt=1,niso
            xtwater_cas(ixt,il)=water_cas(il)*Rdefault(ixt)
           enddo !do ixt=1,niso  
         endif  !if (Pqisup.gt.0.0) then  
        enddo !do il=1,ncas_noevap 

#ifdef ISOVERIF
          do il=1,ncas
            do ixt=1,niso   
              call iso_verif_noNaN(xtp_cas(ixt,il), &
     &                  'appel stewart 265.2: cas 1.1')
              call iso_verif_noNaN(xtevap_cas(ixt,il), &
     &            'appel_stewart_np 286')
              if (iso_verif_noNaN_nostop(xtwater_cas(ixt,il), &
     &            'appel_stewart_np 1594').eq.1) then
                 write(*,*) 'il,ixt=',il,ixt
                 write(*,*) 'water_cas(il)=',water_cas(il)
                 write(*,*) 'Pxtisup_cas(ixt,il),Pqisup_cas(il)=', &
     &            Pxtisup_cas(ixt,il),Pqisup_cas(il)
                 stop
              endif
            enddo !do ixt=1,niso   
          enddo !do il=1,ncas_noevap  
#endif
#ifdef ISOVERIF   
          if (iso_eau.gt.0) then
            do il=1,ncas
              call iso_verif_egalite_choix(xtwater_cas(iso_eau,il), &
     &          water_cas(il),'appel_stewart_np 262.2, cas 1.1', &
     &          errmax,errmaxrel)
              if ((xtwater_cas(iso_eau,il).eq.0).and. &
     &          (water_cas(il).gt.ridicule)) then
               write(*,*) 'appel_stewart_np 263.2, cas 1.1'
               write(*,*) 'xtwater(iso_eau,il)=',xtwater_cas(iso_eau,il)
               write(*,*) 'water(il)=',water_cas(il)
               stop
              endif
              if (oktrac.eq.0) then
!                  write(*,*) 'appel_stewart_np 1743 noevap tmp: il=',il
             call iso_verif_egalite_choix(xtp_cas(iso_eau,il), &
     &          qp_cas(il) &
     &          ,'appel_stewart_np 269.2, cas 1.1',errmax,errmaxrel)
              call iso_verif_egalite_choix(xtevap_cas(iso_eau,il), &
     &          evap_cas(il), &
     &          'appel_stewart_np 275.2, cas 1.1', &
     &          errmax,errmaxrel)
             endif !if (oktrac.eq.0) then
             enddo !do il=1,ncas
            endif ! if (iso_eau.gt.0) then
            if (oktrac.eq.0) then
            if (iso_HDO.gt.0) then
              do il=1,ncas
                if (qp_cas(il).gt.ridicule) then              
                call iso_verif_aberrant( &
     &          xtp_cas(iso_HDO,il)/qp_cas(il), &
     &          'appel_stewart_np 613')
                endif !if (qp(cas_noevap(il),i).gt.ridicule) then   
              enddo !do il=1,ncas 
            endif  ! if (iso_HDO.gt.0) then
            endif !if (oktrac.eq.0) then
#endif           

        end subroutine make_cas_noevap_np



      subroutine make_cas_evap_liq_np(ncas, &
     &          water_cas, &
     &          xtp_avantevap_cas,qp_avantevap_cas, &
     &          xtp_avantevaptrac_cas,qp_avantevaptrac_cas, &
     &          Pxtisup_cas,Pqisup_cas, &
     &          Eqi_stewart,Pqiinf_stewart,fac_ftmr_cas, &
     &          qs_cas, T_cas,wt_cas,  delP_cas, &
     &          xtevapsup_cas,qeff, g,sigd,Eqi_prime_cas, &
     &          Eqi_cas, &
     &          qp_cas,INB_cas,i,oktrac &
#ifdef ISOTRAC        
     &          ,ptrac,hdiag &
#endif                
#ifdef ISOVERIF
     &          ,evap_cas,Exi_stewart &
#endif        
     &          ,xtp_cas,xtwater_cas,xtevap_cas) 

  USE isotopes_mod, ONLY: iso_eau, iso_HDO,Rdefault,no_pce,ridicule
#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel
USE isotopes_verif_mod
#ifdef ISOTRAC
  USE isotrac_mod, only: ridicule_trac
#endif
#endif
        implicit none

        ! inputs
        integer ncas
        real xtp_avantevap_cas(niso,ncas), &
     &          qp_avantevap_cas(ncas)
        real xtp_avantevaptrac_cas(niso,ncas), &
     &          qp_avantevaptrac_cas(ncas)
        ! dans le cas des traceurs: xtp_avantevaptrac_cas est la
        ! quantité de traceur izone dans la vapeur
        ! alors que xtp_avantevap_cas est le total de toutes les zone
        ! on rééquilibre la goutte avec le total de toutes les zones,
        ! mais c'est xtp_avantevaptrac_cas qui recoit l'évap
        real Pqisup_cas(ncas), Pxtisup_cas(niso,ncas)
        real Pqiinf_stewart(ncas), Eqi_stewart(ncas)
        real fac_ftmr_cas(ncas),Eqi_prime_cas(ncas)
        real Eqi_cas(ncas)
        real T_cas(ncas),delP_cas(ncas), &
     &          xtevapsup_cas(niso,ncas), &
     &          wt_cas(ncas),qeff(ncas), &
     &          qs_cas(ncas),water_cas(ncas), &
     &          qp_cas(ncas)  
        integer oktrac      
#ifdef ISOTRAC        
        real ptrac(ncas)  
        real hdiag(ncas)
#endif        
#ifdef ISOVERIF        
        real evap_cas(ncas)   
#endif        
        integer INB_cas(ncas),i
        real g,sigd(ncas)
        ! outputs
        real  xtp_cas(niso,ncas),xtwater_cas(niso,ncas), &
     &          xtevap_cas(niso,ncas)        

        ! locals        
        integer il,ixt        
        real Pxtiinf_stewart(niso,ncas),  &
     &          Exi_stewart(niso,ncas) 
        real xtnew(niso,ncas)
!#ifdef ISOVERIF
!        integer iso_verif_egalite_choix_nostop
!        integer iso_verif_aberrant_nostop
!        real deltaD
!        integer iso_verif_aberrant_choix_nostop
!#endif        
!        real 
!        integer iso_verif_noNaN_nostop

#ifdef ISOVERIF
!        if (ncas.ge.162) then
!        write(*,*) 'appel tmp 1975: xtp_avantevap_cas(iso_eau,162)=',
!     :           xtp_avantevap_cas(iso_eau,162)
!        write(*,*) 'appel tmp 1975b: qp_avantevap_cas(162)=',
!     :           qp_avantevap_cas(162)
!        endif !if (ncas_evap_liq.ge.162) then
      if (iso_eau.gt.0) then
          do il=1,ncas
!            write(*,*) 'appel tmp 1492: il=',il
            call iso_verif_egalite_choix( &
     &       (xtp_avantevap_cas(iso_eau,il)), &
     &       (qp_avantevap_cas(il)), &
     &       'appel_stewart_np 473', &
     &       errmax,errmaxrel)
            call iso_verif_egalite_choix( &
     &       (xtp_avantevaptrac_cas(iso_eau,il)), &
     &       (qp_avantevaptrac_cas(il)), &
     &       'appel_stewart_np 473b',errmax,errmaxrel)
            call iso_verif_egalite_choix( &
     &       (Pxtisup_cas(iso_eau,il)), &
     &       (Pqisup_cas(il)),'appel_stewart_np 475', &
     &       errmax,errmaxrel)
            call iso_verif_positif( &
     &       (Eqi_stewart(il)),'appel_stewart_np 1908')
           enddo !do il=1,ncas
       endif !if (iso_eau.gt.0) then
       do il=1,ncas
          call iso_verif_positif((Eqi_stewart(il)), &
     &       'appel_stewart_np 1913')
       enddo !do il=1,ncas
#endif   

#ifdef ISOTRAC       
       ! à l'avenir, il faudra faire les choses plus proprement!
       if (oktrac.eq.1) then
           ! on renormalise le flux de précip et d'évap
           ! on suppose que la seule différence entre les différentes
           ! zones, c'est la compo du liquide
           do il=1,ncas
            if (ptrac(il).gt.1e-20) then
             Pqisup_cas(il)=Pqisup_cas(il)/ptrac(il)
             Eqi_stewart(il)=Eqi_stewart(il)/ptrac(il)
             Pqiinf_stewart(il)=Pqiinf_stewart(il)/ptrac(il)
             do ixt=1,niso
               Pxtisup_cas(ixt,il)=Pxtisup_cas(ixt,il)/ptrac(il)
             enddo
            else !if (ptrac(il).gt.0.0) then
#ifdef ISOVERIF                
             call iso_verif_egalite((Pqisup_cas(il)), &
     &          0.0,'appel 2104')  
             call iso_verif_egalite((Eqi_stewart(il)), &
     &          0.0,'appel 2105')
             call iso_verif_egalite((Pqiinf_stewart(il)), &
     &          0.0,'appel 2106')
#endif             
             Pqisup_cas(il)=0.0
             Eqi_stewart(il)=0.0
             Pqiinf_stewart(il)=0.0
             do ixt=1,niso
               Pxtisup_cas(ixt,il)=0.0
             enddo   
            endif !if (ptrac(il).gt.0.0) then
           enddo !do il=1,ncas
       endif !if (oktrac.eq.1) then
#endif       
        

        if (no_pce.eq.1) then
            call stewart_sublim_nofrac_vectall( &
     &       ncas,qp_avantevap_cas(1), &
     &       xtp_avantevap_cas(1,1),Pqisup_cas(1), &
     &       Pxtisup_cas(1,1),Eqi_stewart(1),Pqiinf_stewart(1), &
     &       Pxtiinf_stewart(1,1),xtnew(1,1),Exi_stewart(1,1), &
     &       fac_ftmr_cas(1))
        else !if (no_pce.eq.1) then
            
      call stewart_explicite_vectall(ncas, &
     &       qp_avantevap_cas(1),xtp_avantevap_cas(1,1), &
     &       Pqisup_cas, &
     &          Pxtisup_cas(1,1),Eqi_stewart(1), &
     &          Pqiinf_stewart(1),qeff(1), &
     &       Pxtiinf_stewart(1,1),xtnew(1,1),Exi_stewart(1,1), &
     &          fac_ftmr_cas(1), &
     &       qs_cas(1),T_cas(1),wt_cas(1),delP_cas(1) &
#ifdef ISOVERIF
     &         ,0,73 &
#endif
     &  )
         endif !if (no_pce.eq.1) then

#ifdef ISOTRAC      
      ! à l'avenir, il faudra faire les choses plus proprement!
      if (oktrac.eq.1) then
           ! on renormalise le flux de précip et d'évap
           ! on suppose que la seule différence entre les différentes
           ! zones, c'est la compo du liquide
           do il=1,ncas
             Pqisup_cas(il)=Pqisup_cas(il)*ptrac(il)
             Eqi_stewart(il)=Eqi_stewart(il)*ptrac(il)
             Pqiinf_stewart(il)=Pqiinf_stewart(il)*ptrac(il)
             do ixt=1,niso
               Pxtisup_cas(ixt,il)=Pxtisup_cas(ixt,il)*ptrac(il)
               Exi_stewart(ixt,il)=Exi_stewart(ixt,il)*ptrac(il)
               Pxtiinf_stewart(ixt,il)=Pxtiinf_stewart(ixt,il)*ptrac(il)
               xtnew(ixt,il)=xtp_avantevap_cas(ixt,il) &
     &          +(xtnew(ixt,il)-xtp_avantevap_cas(ixt,il))*ptrac(il)
             enddo
             hdiag(il)=qeff(il)/qs_cas(il)
           enddo !do il=1,ncas
       endif !if (oktrac.eq.1) then
#endif

#ifdef ISOVERIF
       if (iso_eau.gt.0) then
          do il=1,ncas     
                call iso_verif_egalite_choix( &
     &           (Exi_stewart(iso_eau,il) &
     &           *fac_ftmr_cas(il)), &
     &           (Eqi_stewart(il)*fac_ftmr_cas(il)), &
     &           'appel stewart 520',errmax*80,errmaxrel*80)
                call iso_verif_egalite_choix( &
     &          (Pxtiinf_stewart(iso_eau,il)), &
     &          (Pqiinf_stewart(il)), &
     &          'appel_stewart_np 586', &
     &          errmax,errmaxrel)
                if (Pqiinf_stewart(il).gt.ridicule) then
                  call iso_verif_egalite_choix(( &
     &             Pxtiinf_stewart(iso_eau,il)/Pqiinf_stewart(il)), &
     &             1.,'appel_setwart 575a', errmax*10, errmaxrel*10)
                endif !if (Pqiinf_par.gt.ridicule) then
           enddo !do il=1,ncas     
        endif !if (iso_eau.gt.0) then  
#endif  
#ifdef ISOVERIF
        do il=1,ncas 
           call iso_verif_noNAN(water_cas(il),  &
     &          'appel_stewart_np 2009') 
           call iso_verif_noNAN((Pqiinf_stewart(il)),  &
     &          'appel_stewart_np 2011')
           do ixt=1,niso
           call iso_verif_noNAN(( &
     &          Pxtiinf_stewart(ixt,il)),'appel_stewart_np 2014')
           call iso_verif_noNAN(( &
     &          xtnew(ixt,il)),'appel_stewart_np 2014')
           enddo
        enddo      
#endif 
           
        ! deduction de XTWATER à partir de Pxtiinf:
! hypothèse: l'eau en i a la même composition que le flux d'eau
        ! qui sort de la boite i (Pqiinf_par)
        do il=1,ncas
          if (abs(water_cas(il)).lt.ridicule/10.) then
            do ixt=1,niso
               xtwater_cas(ixt,il)=0.0
            enddo !do ixt=1,niso
          else !if (water(il,i).eq.0.0) then
             if (Pqiinf_stewart(il).gt.0.0) then  !if (Pxtiinf_par(iso_eau).gt.0.0) then 
               do ixt=1,niso 
                 xtwater_cas(ixt,il)=water_cas(il) &
     &             *Pxtiinf_stewart(ixt,il)/Pqiinf_stewart(il)
               enddo
             else !if (Pxtiinf_stewart(iso_eau).gt.0.0) then
                 ! normalement, ce cas a déjà été interdit dans
                 ! compress_evp_glace
                do ixt=1,niso
                  xtwater_cas(ixt,il)=water_cas(il)*Rdefault(ixt)
                enddo !do ixt=1,niso
             endif
           endif !if (water(il,i).eq.0.0) then
         enddo !do il=1,ncas
        
#ifdef ISOVERIF
       do il=1,ncas
        do ixt=1,niso
          call iso_verif_noNAN(xtwater_cas(ixt,il),  &
     &         'appel_stewart_np 566')
        enddo !do ixt=1,niso
        if (iso_eau.gt.0) then
         call iso_verif_egalite_choix(xtwater_cas(iso_eau,il), &
     &          water_cas(il),'appel_stewart_np 568',errmax,errmaxrel)
         if (water_cas(il).gt.ridicule*10) then
             if (iso_verif_egalite_choix_nostop( &
     &          xtwater_cas(iso_eau,il)/water_cas(il),1.0, &
     &          'appel stewart 155',errmax*10,errmaxrel*10).eq.1) then
!               write(*,*) 'i=',i
               write(*,*) 'Tevap=',T_cas(il)
               write(*,*) 'xtwater(iso_eau,il,i)=', &
     &                  xtwater_cas(iso_eau,il)
               write(*,*) 'water(il,i)=',water_cas(il)
               write(*,*) 'Pxtiinf_stewart(iso_eau)=', &
     &                   Pxtiinf_stewart(iso_eau,il)
!               write(*,*) 'Pqiinf_par,Pqiinf_stewart=',
!     :              Pqiinf_par(cas_evap_liq(il)),Pqiinf_stewart(il)
               stop
             endif  !if (iso_verif_egalite_nostop(
         endif !if (water(il,i).gt.ridicule) then
        endif !if (iso_eau.gt.0) then
       enddo !do il=1,ncas
#endif

      
        ! rappel, le Eqi_prime qu'on a mis en argument dans stewart est en
        ! fait égal à 0.5*(Eqi+Eqi+1) -> en tenir compte quand on
        ! calcule xtevapi.    
       do il=1,ncas
        if (Eqi_stewart(il)*fac_ftmr_cas(il).gt.ridicule) then
            ! changement le 20avril 2012: >0 -> >ridicule
         do ixt=1,niso          
          xtevap_cas(ixt,il)=Eqi_cas(il) &
     &          *Exi_stewart(ixt,il)/Eqi_stewart(il) &
     &          /100/delP_cas(il)/sigd(il)*g
         enddo ! do ixt=1,niso
        else !if (Eqi_stewart.gt.0.0) then
            ! il peut quand même y a voir de la diffusion
            do ixt=1,niso
            xtevap_cas(ixt,il)=Exi_stewart(ixt,il) &
     &          /100.0/delP_cas(il)/sigd(il)*g
            enddo !do ixt=1,niso    
        endif !if (Eqi_stewart.gt.0.0) then
       enddo !do il=1,ncas
      
#ifdef ISOVERIF
      do il=1,ncas
        do ixt=1,niso
         if ((iso_verif_noNAN_nostop(xtevap_cas(ixt,il), &
     &    'appel stewart 131').eq.1).or. &
     &     (iso_verif_noNAN_nostop(xtnew(ixt,il), &
     &    'appel stewart 131b').eq.1)) then
           write(*,*) 'Exi_stewart(ixt,il)=',Exi_stewart(ixt,il)
           write(*,*) 'Eqi_stewart(il)=',Eqi_stewart(il)     
           write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)    
           write(*,*) 'Eqi_cas(il)=',Eqi_cas(il)     
           write(*,*) 'xtevap_cas(ixt,il)=',xtevap_cas(ixt,il)
           stop
         endif
        enddo ! do ixt=1,nisio
      enddo
#endif      
#ifdef ISOVERIF
      do il=1,ncas
        if (oktrac.eq.0) then 
            ! dans le cas traceur, le calcul de evap_cas est plus
            ! compliqué: il faut le faire plus proprement dans
            ! compress_stewart
        if (iso_eau.gt.0) then
            if (iso_verif_egalite_choix_nostop(xtevap_cas(iso_eau,il), &
     &           evap_cas(il),'appel stewart 142', &
     &          errmax,errmaxrel).eq.1) then
              write(*,*) 'il=',il
              write(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
              write(*,*) 'Eqi_stewart(il)=',Eqi_stewart(il)
              write(*,*) 'Exi_stewart(iso_eau,il)=', &
     &          Exi_stewart(iso_eau,il)
              write(*,*) '1/100/delP_cas(il)/sigd(il)*g*2=', &
     &           1.0/100.0/delP_cas(il)/sigd(il)*g*2.0
              write(*,*) 'xtevapsup_cas(iso_eau,il)=', &
     &          xtevapsup_cas(iso_eau,il)
              stop
            endif
        endif !if (iso_eau.gt.0) then
        endif !if (oktrac.eq.0) then 
#ifdef ISOTRAC
        if (oktrac.eq.1) then 
        if ((iso_eau.gt.0).and.(iso_HDO.gt.0)) then
             call iso_verif_aberrant_choix( &
     &          (xtp_avantevaptrac_cas(iso_HDO,il)), &
     &          (xtp_avantevaptrac_cas(iso_eau,il)), &
     &          ridicule_trac,deltalimtrac, &
     &          'appel_stewart_np 2053')
        endif !if ((iso_eau.gt.0).and.(iso_HDO.gt.0)) then
        endif
#endif
      enddo !do il=1,ncas 
#endif

      ! deduction de XTP partir de Exi
      
      do il=1,ncas
       if (i.lt.INB_cas(il)) then
          if (fac_ftmr_cas(il).gt.0.0) then
             if (Eqi_stewart(il)*fac_ftmr_cas(il).gt.ridicule) then 
               do ixt=1,niso               
               !   xtp(ixt,il,i)=xtnew(ixt)*qp(il,i)/xtnew(4)
                  xtp_cas(ixt,il)=max(xtp_avantevaptrac_cas(ixt,il)  &
     &               +fac_ftmr_cas(il)*Eqi_prime_cas(il) &
     &               *Exi_stewart(ixt,il)/Eqi_stewart(il),0.0)
               enddo !do ixt=1,niso
             else ! if (Eqi_stewart.gt.ridicule) then
                if (qp_cas(il).gt.0.0) then 

                    if (Eqi_prime_cas(il)*fac_ftmr_cas(il).gt.ridicule) &
     &                   then 
                        ! il va manquer quelque chose: il faut augmenter
                        ! xtp en lui ajoutant l'évap du niveau d'eau
                        ! dessus
                        ! pour l'instant, on bidouille:
!                        write(*,*) 'appel_stewart_np 2041: il=',il
                        do ixt=1,niso               
                        xtnew(ixt,il)=xtnew(ixt,il) &
     &                   *(qp_avantevap_cas(il) &
     &                   +Eqi_prime_cas(il)*fac_ftmr_cas(il)) &
     &                   /(qp_avantevap_cas(il) &
     &                   +Eqi_stewart(il)*fac_ftmr_cas(il))
                        enddo
                    endif !if (Eqi_prime_cas(il)*fac_ftmr_cas(il).gt.ridicule)

                    do ixt=1,niso               
!                      xtp_cas(ixt,il)=xtnew(ixt,il)
                      xtp_cas(ixt,il)=(xtp_avantevaptrac_cas(ixt,il) &
     &                          +(xtnew(ixt,il) &
     &                          -xtp_avantevap_cas(ixt,il)))
                      ! modif 1 mai 2009, pour le cas des traceurs
                    enddo !do ixt=1,niso
!                    write(*,*) 'appel_stewart_np 1963 tmp: ',
!     :                  'xtp_cas(iso_eau,il)=',xtp_cas(iso_eau,il)
                else !if (qp(il,i).gt.0.0) then 
                  do ixt=1,niso               
                    xtp_cas(ixt,il)=0.0
                  enddo !do ixt=1,niso
                endif  !if (qp(il,i).gt.0.0) then 
            endif !if (Eqi_stewart.gt.ridicule) then 

#ifdef ISOVERIF       
!            if (il.eq.87) then
!                write(*,*) 'appel_stewart_np 2244: tmp, après calcul xtp'
!                write(*,*) 'xtnew(:,il)=',xtnew(:,il)
!                write(*,*) 'Pxtiinf_stewart(:,il)=',
!     :             Pxtiinf_stewart(:,il)
!            endif  !if (il.eq.87) then    
            do ixt=1,niso
              if (iso_verif_noNAN_nostop(xtp_cas(ixt,il), &
     &                 'appel stewart 684').eq.1) then
                write(*,*) 'i,INB_cas(il)=',i,INB_cas(il)
                write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
                write(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
                write(*,*) 'Eqi_stewart(il)=',Eqi_stewart(il)
                write(*,*) 'xtp_avantevaptrac_cas(ixt,il)=', &
     &                 xtp_avantevaptrac_cas(ixt,i)
                write(*,*) 'Exi_stewart(ixt,il)=',Exi_stewart(ixt,il)
                write(*,*) 'xtnew(ixt,il)=',xtnew(ixt,il)
                write(*,*) 'xtp_avantevap_cas(ixt,il)=', &
     &                 xtp_avantevap_cas(ixt,il)
                write(*,*) 'qp_cas(il)=',qp_cas(il)
                stop
              endif !if (iso_verif_noNAN(xtp_cas(ixt,il),
            enddo ! do ixt=1,niso
#endif
#ifdef ISOVERIF  
#ifdef ISOTRAC 
            if (oktrac.eq.1) then
            if ((iso_HDO.gt.0).and.(iso_eau.gt.0)) then
                ! le 10 mai 2009: on remonte le seuil de vérif de deltaD
                ! aberrant car dans le cas des traceurs, des très
                ! petites concentrations sont très facilement
                ! influencées par des évaps qui peuvent être aberantes
                ! si ces evaps sont petites
                if (iso_verif_aberrant_choix_nostop( &
     &          xtp_cas(iso_HDO,il),xtp_cas(iso_eau,il), &
     &          ridicule_trac,deltalimtrac, &
     &          'appel_stewart_np 2090').eq.1) then
                  write(*,*) 'xtp_avantevaptrac_cas(iso_eau),deltaD=', &
     &             xtp_avantevaptrac_cas(iso_eau,il),deltaD &
     &             ((xtp_avantevaptrac_cas(iso_HDO,il)) &
     &             /(xtp_avantevaptrac_cas(iso_eau,il)))
                  write(*,*) 'xtp_avantevap_cas(iso_eau),deltaD=', &
     &             xtp_avantevap_cas(iso_eau,il),deltaD &
     &             ((xtp_avantevap_cas(iso_HDO,il)) &
     &             /(xtp_avantevap_cas(iso_eau,il)))
                  write(*,*) 'xtnew(iso_eau),deltaD=', &
     &             xtnew(iso_eau,il),deltaD &
     &             ((xtnew(iso_HDO,il)) &
     &             /(xtnew(iso_eau,il)))
                  write(*,*) 'xtp_cas(iso_eau),deltaD=', &
     &             xtp_cas(iso_eau,il),deltaD &
     &             (xtp_cas(iso_HDO,il)/xtp_cas(iso_eau,il))
                  write(*,*) 'Eqi_stewart(il),fac_ftmr_cas(il)=', &
     &                  Eqi_stewart(il),fac_ftmr_cas(il)
                  write(*,*) 'Eqi_prime_cas(il)=', &
     &                  Eqi_prime_cas(il)
                  write(*,*) 'deltaD_Eqi_stewart=', &
     &                  deltaD(( &
     &                  Exi_stewart(iso_HDO,il)/Eqi_stewart(il)))
                  write(*,*) 'xtnew-xtp_avantevap_cas,deltaD=', &
     &                xtnew(iso_eau,il)-xtp_avantevap_cas(iso_eau,il), &
     &                deltaD(((xtnew(iso_HDO,il) &
     &                -xtp_avantevap_cas(iso_HDO,il))/ &
     &                (xtnew(iso_eau,il) &
     &                -xtp_avantevap_cas(iso_eau,il))))  
                  write(*,*) 'Pqisup,deltaD=', &
     &                  Pqisup_cas(il),deltaD(( &
     &                  Pxtisup_cas(iso_HDO,il)/Pqisup_cas(il)))
                  stop
                endif
        endif !if (iso_HDO.gt.0) then
       endif !if (oktrac.eq.1) then
#endif
!#ifdef ISOTRAC
          if (oktrac.eq.0) then
            if (iso_eau.gt.0) then
              if (iso_verif_egalite_choix_nostop(xtp_cas(iso_eau,il), &
     &        qp_cas(il),'appel stewart 688', &
     &          errmax,errmaxrel*30).eq.1) then    
                  write(*,*) 'il=',il                   
                  write(*,*) 'q,xtp_avantevap_cas(iso_eau)=', &
     &             qp_avantevap_cas(il), &
     &             xtp_avantevap_cas(iso_eau,il)
                  write(*,*) 'xtnew,qp,xtpcas=', &
     &             xtnew(iso_eau,il),qp_cas(il),xtp_cas(iso_eau,il)
                  write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
                  write(*,*) 'Eqi_prime_cas(il)=', &
     &                  Eqi_prime_cas(il)
                  write(*,*) 'Eqi_stewart, Exi_stewart=', &
     &                  Eqi_stewart(il), &
     &                  Exi_stewart(iso_eau,il)
                  write(*,*) 'Pqisup=',Pqisup_cas(il)
                 stop
              endif !if (iso_verif_egalite_choix_nostop(xtp_cas(iso_eau,il),
           endif !if (iso_eau.gt.0) then

           if ((iso_HDO.gt.0).and. &
     &          (qp_cas(il).gt.ridicule)) then
             if (iso_verif_aberrant_nostop(xtp_cas(iso_HDO,il)/ &
     &        qp_cas(il), &
     &        'appel_stewart_np 1079').eq.1) then
               write(*,*) 'i,qp(cas_evap_liq(il),i)=', &
     &                  i,qp_cas(il) 
               write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
               write(*,*) 'deltaDxtnew=',deltaD(( &
     &          xtnew(iso_HDO,il))/qp_cas(il))
               stop
             endif
           endif !if (iso_HDO.gt.0) then 
        endif ! if (oktrac.eq.0) then
#endif              

          else !if (fac_ftmr.gt.0.0) then
              ! ca veut dire que Mp=0, xtp pas définit
             do ixt=1,niso
               xtp_cas(ixt,il)=xtp_avantevaptrac_cas(ixt,il)
             enddo !do ixt=1,niso
         endif !if (fac_ftmr.gt.0.0) then
      else !if (i.lt.INB) then
          ! si i=inb, on ne change rien au calcul original, et on
          ! suppose que la composition du ddft est égale à celle de
          ! l'env. Ceci a déjà été calculé plus haut
                  do ixt=1,niso
                    xtp_cas(ixt,il)=xtp_avantevaptrac_cas(ixt,il)
                    !xtp_avantevap(ixt) a déjà été définit proprement
                    !dans ce cas là
                  enddo
      endif !if (i.lt.INB) then
      enddo !do il=1,ncas

      ! verif
#ifdef ISOVERIF
      do il=1,ncas
        do ixt=1,niso
         call iso_verif_noNAN(xtp_cas(ixt,il),'appel stewart 198')
         call iso_verif_noNAN(xtevap_cas(ixt,il),'appel stewart 745')
        enddo !do ixt=1,niso
        enddo !do il=1,ncas  
#endif
#ifdef ISOVERIF
      do il=1,ncas
#ifdef ISOTRAC
        if ((iso_HDO.gt.0).and.(iso_eau.gt.0)) then
          if (oktrac.eq.1) then
              call iso_verif_aberrant_choix( &
     &          xtp_cas(iso_HDO,il),xtp_cas(iso_eau,il), &
     &          ridicule_trac,deltalimtrac,'appel_stewart_np 2138')
          endif
        endif !if (iso_HDO.gt.0) then
#endif
      enddo !do il=1,ncas  
      
      if (oktrac.eq.0) then
      if (iso_eau.gt.0) then
       do il=1,ncas       
        if (iso_verif_egalite_choix_nostop( &
     &           xtp_cas(iso_eau,il), &
     &           qp_cas(il), &
     &          'appel stewart 197', &
     &          errmax,errmaxrel*50).eq.1) then   
          write(*,*) 'i=',i,' INB=',INB_cas(il)
          write(*,*) 'Tevap=',T_cas(il)
          write(*,*) 'xtp(iso_eau,il,i)=',xtp_cas(iso_eau,il)
          write(*,*) 'qp(il,i)=',qp_cas(il)
          write(*,*) 'xtnew(iso_eau)=',xtnew(iso_eau,il)
          write(*,*) 'fac_ftmr=',fac_ftmr_cas(il)
!          write(*,*) 'Mp(il,i)=',Mp(cas_evap_liq(il),i)
          write(*,*) 'xtp_avantevap(iso_eau)=', &
     &          xtp_avantevap_cas(iso_eau,il)
          write(*,*) 'qp_avantevap=',qp_avantevap_cas(il)
!          write(*,*) 'Exi_prime(iso_eau)=',Exi_prime(iso_eau,il)
!          write(*,*) 'Eqi_prime=',Eqi_prime(il)       
          write(*,*) 'Pxtiinf_stewart(iso_eau)=', &
     &           Pxtiinf_stewart(iso_eau,il)
!          write(*,*) 'Pqiinf_par=',Pqiinf_par(cas_evap_liq(il))
          write(*,*) 'Pxtisup(iso_eau)=',Pxtisup_cas(iso_eau,il)
          write(*,*) 'Pqisup=',Pqisup_cas(il)
          stop
         endif !if iso_verif_egalite_choix_nostop
        enddo !do il=1,ncas
      endif !if (iso_eau.gt.0) then
      if (iso_HDO.gt.0) then            
       do il=1,ncas
!        write(*,*) 'appel_stewart_np 2166: fin make_cas_evap_liq_np, ',
!     :        'il,deltaDqp=',il,deltaD(xtp_cas(iso_HDO,il)/qp_cas(il))
        if (qp_cas(il).gt.ridicule) then
          call iso_verif_aberrant( &
     &          xtp_cas(iso_HDO,il)/qp_cas(il), &
     &          'appel_stewart_np 1130')
        endif !if (qp(cas_evap_liq(il),i).gt.ridicule) then
       enddo !do il=1,ncas     
      endif 
      endif ! if (oktrac.eq.0) then
#endif

      end subroutine make_cas_evap_liq_np

      

      subroutine make_cas_evap_glace_np(ncas, &
     &          water_cas, &
     &          xtp_avantevap_cas,qp_avantevap_cas, &
     &          xtp_avantevaptrac_cas,qp_avantevaptrac_cas, &
     &          Pxtisup_cas,Pqisup_cas, &
     &          Eqi_stewart,Eqi_prime_cas,Eqi_cas, &
     &          Pqiinf_stewart,fac_ftmr_cas, &
     &          qs_cas, T_cas,wt_cas,  delP_cas, &
     &          xtevapsup_cas,g,sigd,INB_cas,i, &
     &          frac_sublim,qp_cas &
#ifdef ISOVERIF      
     &          ,evap_cas,oktrac,Exi_stewart &
#endif
     &          ,xtp_cas,xtwater_cas,xtevap_cas) 

  USE isotopes_mod, ONLY: iso_eau, iso_HDO, Rdefault, ridicule
#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel
USE isotopes_verif_mod
#endif
      implicit none

        ! inputs
        integer ncas
        real xtp_avantevap_cas(niso,ncas), &
     &          qp_avantevap_cas(ncas)
        real xtp_avantevaptrac_cas(niso,ncas), &
     &          qp_avantevaptrac_cas(ncas)
        real Pqisup_cas(ncas), Pxtisup_cas(niso,ncas)
        real Pqiinf_stewart(ncas), Eqi_stewart(ncas)
        real fac_ftmr_cas(ncas),Eqi_prime_cas(ncas), &
     &          Eqi_cas(ncas)
        real T_cas(ncas),delP_cas(ncas), &
     &          xtevapsup_cas(niso,ncas), &
     &          wt_cas(ncas),qeff(ncas), &
     &          qs_cas(ncas),water_cas(ncas)
        real qp_cas(ncas)      
#ifdef ISOVERIF
        real evap_cas(ncas)
        integer oktrac
#endif        
        real g,sigd(ncas)
        integer frac_sublim
        integer INB_cas(ncas),i
        ! outputs
        real  xtp_cas(niso,ncas),xtwater_cas(niso,ncas), &
     &          xtevap_cas(niso,ncas)
        ! locals        
        integer il,ixt
        real Pxtiinf_stewart(niso,ncas),  &
     &          Exi_stewart(niso,ncas)   
        real xtnew(niso,ncas)     
!#ifdef ISOVERIF
!        real 
!        integer iso_verif_egalite_choix_nostop
!        integer iso_verif_aberrant_nostop
!        real deltaD
!#endif        

#ifdef ISOVERIF  
!      write(*,*) 'appel_stewart_np 2052: entrée dans make_cas_evap_glace'
      if (iso_eau.gt.0) then
          do il=1,ncas
            call iso_verif_egalite_choix( &
     &       (xtp_avantevap_cas(iso_eau,il)), &
     &       (qp_avantevap_cas(il)), &
     &          'appel_stewart_np 473b', &
     &       errmax,errmaxrel)
            call iso_verif_egalite_choix( &
     &       (Pxtisup_cas(iso_eau,il)), &
     &       (Pqisup_cas(il)),'appel_stewart_np 475b', &
     &       errmax,errmaxrel)
           enddo !do il=1,ncas 
       endif !if (iso_eau.gt.0) then
#endif    
     

      ! calculs des flux de masses à mettre en argument de stewart:
      ! comme l'eau n'est pas bien concervée dans les ddfts, on est
      ! obligé de bidouillé.
      ! 1) soit on considère Pqisup, Eqi, et Pqiinf_par=Pqisup-Eqi
      !    et on suppose que dans la réalité les compositions de
      !    Pqiinf sont les même que Pqiinf_par
      ! 2) soit on considère Pqisup, Eqi_par=Pqisup-Pqiinf, et Pqiinf,
      !    et on suppose que dans la réalité les compositions de
      !    Eqi_prime sont les même que Eqi_par

      if (frac_sublim.eq.1) then
            call stewart_glace_vectall(ncas, &
     &       qp_avantevap_cas(1),xtp_avantevap_cas(1,1),Pqisup_cas(1), &
     &       Pxtisup_cas(1,1),Eqi_stewart(1),Pqiinf_stewart(1), &
     &       Pxtiinf_stewart(1,1),xtnew(1,1),Exi_stewart(1,1), &
     &       fac_ftmr_cas(1), &
     &       T_cas(1))
      else !if (frac_sublim.eq.1) then
!#ifdef ISOVERIF
!            write(*,*) 'appel_stewart_explicite_np 2269'
!            write(*,*) 'Pqiinf_stewart(1)=',Pqiinf_stewart(1) 
!            write(*,*) 'Pqisup_cas(1)=',Pqisup_cas(1) 
!            write(*,*) 'Eqi_cas(1)=',Eqi_cas(1) 
!            write(*,*) 'Eqi_prime_cas(1)=',Eqi_prime_cas(1) 
!            write(*,*) 'Eqi_stewart(1)=',Eqi_stewart(1)
!#endif          
            call stewart_sublim_nofrac_vectall( &
     &        ncas,qp_avantevap_cas(1), &
     &        xtp_avantevap_cas(1,1),Pqisup_cas(1), &
     &        Pxtisup_cas(1,1), &
     &        Eqi_stewart(1),Pqiinf_stewart(1), &
     &        Pxtiinf_stewart(1,1),xtnew(1,1),Exi_stewart(1,1), &
     &        fac_ftmr_cas(1))
      endif !if (frac_sublim.eq.1) then
      

#ifdef ISOVERIF
!       write(*,*) 'appel_stewart_np 2096: dans make_cas_evap_glace'
       if (iso_eau.gt.0) then
          do il=1,ncas       
             call iso_verif_egalite_choix( &
     &       (Exi_stewart(iso_eau,il)*fac_ftmr_cas(il)), &
     &       (Eqi_stewart(il)*fac_ftmr_cas(il)), &
     &       'appel stewart 520b',errmax*80,errmaxrel*80)
             call iso_verif_egalite_choix( &
     &         (Pxtiinf_stewart(iso_eau,il)), &
     &         (Pqiinf_stewart(il)), &
     &          'appel_stewart_np 586', &
     &         errmax,errmaxrel)
             if (Pqiinf_stewart(il).gt.ridicule) then
                if (iso_verif_egalite_choix_nostop(( &
     &          Pxtiinf_stewart(iso_eau,il)/Pqiinf_stewart(il)), &
     &          1.,'appel_setwart 575b', errmax*10, errmaxrel*10) &
     &           .eq.1) then
                   write(*,*) 'Pqiinf_stewart(il)=',Pqiinf_stewart(il)
!                   write(*,*) 'Pqiinf_par(il)=',Pqiinf_par(il)
                   write(*,*) 'Pxtiinf_stewart(iso_eau,il)=', &
     &                  Pxtiinf_stewart(iso_eau,il)
                   stop
                endif
             endif !if (Pqiinf_par.gt.ridicule) then
           enddo !do il=1,ncas       
        endif !if (iso_eau.gt.0) then
#endif     

        ! deduction de XTWATER à partir de Pxtiinf:
! hypothèse: l'eau en i a la même composition que le flux d'eau
        ! qui sort de la boite i (Pqiinf_par)
        do il=1,ncas
          if (abs(water_cas(il)).lt.ridicule/10.) then
            do ixt=1,niso
               xtwater_cas(ixt,il)=water_cas(il)*Rdefault(ixt)
            enddo !do ixt=1,niso
          else !if (water(il,i).eq.0.0) then
             if (Pqiinf_stewart(il).gt.0.0) then  !if (Pxtiinf_par(iso_eau).gt.0.0) then 
               do ixt=1,niso 
                 xtwater_cas(ixt,il)=water_cas(il) &
     &             *Pxtiinf_stewart(ixt,il)/Pqiinf_stewart(il)
               enddo
             else !if (Pxtiinf_stewart(iso_eau).gt.0.0) then
                 ! normalement, ce cas a déjà été interdit dans
                 ! compress_evp_glace
                do ixt=1,niso
                  xtwater_cas(ixt,il)=water_cas(il)*Rdefault(ixt)
                enddo !do ixt=1,niso
             endif
           endif !if (water(il,i).eq.0.0) then
         enddo !do il=1,ncas
        
#ifdef ISOVERIF
!       write(*,*) 'appel_stewart_np 2563: dans make_cas_evap_glace'
       do il=1,ncas
        do ixt=1,niso
         call iso_verif_noNAN(xtwater_cas(ixt,il),  &
     &          'appel_stewart_np 566b')
        enddo !do ixt=1,niso
        if (iso_eau.gt.0) then
         call iso_verif_egalite_choix(xtwater_cas(iso_eau,il), &
     &          water_cas(il),'appel_stewart_np 568b',errmax,errmaxrel)
         if (water_cas(il).gt.ridicule*10) then
             if (iso_verif_egalite_choix_nostop( &
     &          xtwater_cas(iso_eau,il)/water_cas(il),1.0, &
     &          'appel stewart 155b',errmax*10,errmaxrel*10).eq.1) then
               write(*,*) 'i=',i
               write(*,*) 'Tevap=',T_cas(il)
               write(*,*) 'xtwater(iso_eau,il,i)=', &
     &                  xtwater_cas(iso_eau,il)
               write(*,*) 'water(il,i)=',water_cas(il)
               write(*,*) 'Pxtiinf_stewart(iso_eau)=', &
     &                   Pxtiinf_stewart(iso_eau,il)
!               write(*,*) 'Pqiinf_par,Pqiinf_stewart=',
!     &                  Pqiinf_par(il),Pqiinf_stewart(il)
               stop
             endif  !if (iso_verif_egalite_nostop(
         endif !if (water(il,i).gt.ridicule) then
        endif !if (iso_eau.gt.0) then
       enddo !do il=1,ncas
#endif

      
        ! rappel, le Eqi_prime qu'on a mis en argument dans stewart est en
        ! fait égal à 0.5*(Eqi+Eqi+1) -> en tenir compte quand on
        ! calcule xtevapi.    
       do il=1,ncas
        if (Eqi_stewart(il)*fac_ftmr_cas(il).gt.0.0) then
         do ixt=1,niso          
          xtevap_cas(ixt,il)=Eqi_cas(il) &
     &          *Exi_stewart(ixt,il)/Eqi_stewart(il) &
     &          /100.0/delP_cas(il)/sigd(il)*g    
         enddo ! do ixt=1,niso
        else !if (Eqi_stewart.gt.0.0) then
            ! il peut quand même y a voir de la diffusion
            do ixt=1,niso
            xtevap_cas(ixt,il)=Exi_stewart(ixt,il) &
     &          /100.0/delP_cas(il)/sigd(il)*g
            enddo !do ixt=1,niso    
        endif !if (Eqi_stewart.gt.0.0) then
       enddo !do il=1,ncas
      
#ifdef ISOVERIF
      do il=1,ncas
        do ixt=1,niso
          call iso_verif_noNAN(xtevap_cas(ixt,il),'appel stewart 131b')
        enddo ! do ixt=1,niso
        if (oktrac.eq.0) then 
            ! dans le cas traceur, le calcul de evap_cas est plus
            ! compliqué: il faut le faire plus proprement dans
            ! compress_stewart
        if (iso_eau.gt.0) then
            if (iso_verif_egalite_choix_nostop(xtevap_cas(iso_eau,il), &
     &        evap_cas(il), &
     &        'appel stewart 142b',errmax,errmaxrel).eq.1) then
                write(*,*) 'i,il=',i,il
                write(*,*) 'Exi_stewart(iso_eau,il),Eqi_stewart(il)=', &
     &                  Exi_stewart(iso_eau,il),Eqi_stewart(il) 
                write(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
                write(*,*) 'xtevapsup_cas(iso_eau,il)=', &
     &            xtevapsup_cas(iso_eau,il)
!                write(*,*) 'evap,evapsup=',evap(cas_evap_glace(il),i),
!     &            evap(cas_evap_glace(il),i+1)
              stop 
            endif !if (iso_verif_egalite_choix_nostop(xtevap_cas(iso_eau,il),
        endif !if (iso_eau.gt.0) then
       endif ! if (oktrac.eq.0) then
      enddo !do il=1,ncas 
#endif

!      write(*,*) 'appel_stewart_np tmp 2243: Eqi_stewart(1)=',
!     :           Eqi_stewart(1)
!      write(*,*) 'Eqi_prime_cas=',Eqi_prime_cas(1)
      ! deduction de XTP partir de Exi
        ! temporaire:
!        il=2
!        ixt=iso_eau
!        write(*,*) 'tmp 2619: Eqi_stewart(il)=',Eqi_stewart(il)
!        write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
!        write(*,*) 'xtp_avantevaptrac_cas(ixt,il)=',
!     :                xtp_avantevaptrac_cas(ixt,il)
!        write(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
!        write(*,*) 'Exi_stewart(ixt,il)=',Exi_stewart(ixt,il)
!        write(*,*) 'tmp 2625: xtnew(ixt,il)=',xtnew(ixt,il)

      do il=1,ncas
       if (i.lt.INB_cas(il)) then
          if (fac_ftmr_cas(il).gt.0.0) then
!           if (Eqi_stewart(il).gt.ridicule) then 
            if (Eqi_stewart(il)*fac_ftmr_cas(il).gt.ridicule) then
!               write(*,*) 'appel_stewart_v_np 2633 tmp: il=',il 
               do ixt=1,niso     
               !   xtp(ixt,il,i)=xtnew(ixt)*qp(il,i)/xtnew(4)           
                  xtp_cas(ixt,il)=max(xtp_avantevaptrac_cas(ixt,il) & 
     &               +fac_ftmr_cas(il)*Eqi_prime_cas(il) &
     &               *Exi_stewart(ixt,il)/Eqi_stewart(il),0.0)  
               enddo !do ixt=1,niso
               
#ifdef ISOVERIF
               if (iso_eau.gt.0) then
                 call iso_verif_egalite_choix( &
     &              xtp_cas(iso_eau,il),qp_cas(il), &
     &              'appel stewart 2643a',errmax,errmaxrel*30)
               endif
#endif

             else ! if (Eqi_stewart.gt.ridicule) then
                if (qp_cas(il).gt.0.0) then 

!                    if (Eqi_prime_cas(il)*fac_ftmr_cas(il).gt.ridicule)
!     &                   then 
                        if ((Eqi_prime_cas(il)-Eqi_stewart(il)) &
     &                 *fac_ftmr_cas(il).gt.ridicule) then
                        ! il va manquer quelque chose: il faut augmenter
                        ! xtp en lui ajoutant l'évap du niveau d'eau
                        ! dessus
                        ! pour l'instant, on bidouille:

                        if (qp_avantevap_cas(il)+Eqi_stewart(il) &
     &                   *fac_ftmr_cas(il).gt.ridicule) then
                        !write(*,*) 'appel_stewart_np 2500: il=',il
                        do ixt=1,niso               
                        xtnew(ixt,il)=xtnew(ixt,il) &
     &                   *(qp_avantevap_cas(il) &
     &                   +Eqi_prime_cas(il)*fac_ftmr_cas(il))  &
     &                   /(qp_avantevap_cas(il) &
     &                   +Eqi_stewart(il)*fac_ftmr_cas(il))
                        enddo
                        else
#ifdef ISOVERIF
                          write(*,*) 'appel_stewart_np 2672: on stoppe'
                          stop
#endif                            
                        endif !if ((Eqi_prime_cas(il)-Eqi_stewart(il))

                    endif !if (Eqi_prime_cas(il)*fac_ftmr_cas(il).gt.ridicule)

                    do ixt=1,niso               
                      xtp_cas(ixt,il)=xtnew(ixt,il) &
     &                   +(xtp_avantevaptrac_cas(ixt,il)  &
     &                  -xtp_avantevap_cas(ixt,il))                  
                    enddo !do ixt=1,niso
#ifdef ISOVERIF
                    if (iso_eau.gt.0) then
                      call iso_verif_egalite_choix( &
     &              xtp_cas(iso_eau,il),qp_cas(il), &
     &              'appel stewart 2643c',errmax,errmaxrel*30)
                    endif !if (iso_eau.gt.0) then
#endif                       
                else !if (qp(il,i).gt.0.0) then 
                  do ixt=1,niso               
                    xtp_cas(ixt,il)=0.0
                  enddo !do ixt=1,niso
                endif  !if (qp(il,i).gt.0.0) then 
             endif !if (Eqi_stewart.gt.ridicule) then 

#ifdef ISOVERIF
             do ixt=1,niso
                call iso_verif_noNAN(xtp_cas(ixt,il), &
     &                  'appel stewart 684b')
             enddo ! do ixt=1,niso
#endif
#ifdef ISOVERIF
             if (oktrac.eq.0) then
                if (iso_eau.gt.0) then
                  if (iso_verif_egalite_choix_nostop( &
     &              xtp_cas(iso_eau,il),qp_cas(il), &
     &              'appel stewart 688b',errmax,errmaxrel*30) &
     &              .eq.1) then
                    write(*,*) 'il=',il
                    write(*,*) 'xtp_avantevaptrac_cas(iso_eau,il)=', &
     &                  xtp_avantevaptrac_cas(iso_eau,il)
                    write(*,*) 'qp_avantevap_cas(il)=', &
     &                  qp_avantevap_cas(il)
                    write(*,*) 'fac_ftmr_cas(il),Eqi_prime_cas(il)=', &
     &                  fac_ftmr_cas(il),Eqi_prime_cas(il)
                    write(*,*) 'Exi_stewart(iso_eau,il),Eqi_stewart=', &
     &                  Exi_stewart(iso_eau,il),Eqi_stewart(il)
                    stop
                  endif
               endif !if (iso_eau.gt.0) then 
              if ((iso_HDO.gt.0).and. &
     &          (qp_cas(il).gt.ridicule)) then
                call iso_verif_aberrant( &
     &          xtp_cas(iso_HDO,il)/qp_cas(il), &
     &          'appel_stewart_np 1384')
              endif  ! if (iso_HDO.gt.0) then
            endif ! if (oktrac.eq.0) then
#endif 

          else !if (fac_ftmr.gt.0.0) then
              ! ca veut dire que Mp=0, xtp pas définit
             do ixt=1,niso
               xtp_cas(ixt,il)=xtp_avantevaptrac_cas(ixt,il)
             enddo !do ixt=1,niso
         endif !if (fac_ftmr.gt.0.0) then
      else !if (i.lt.INB) then
          ! si i=inb, on ne change rien au calcul original, et on
          ! suppose que la composition du ddft est égale à celle de
          ! l'env. Ceci a déjà été calculé plus haut
                  do ixt=1,niso
                    xtp_cas(ixt,il)=xtp_avantevaptrac_cas(ixt,il)
                    !xtp_avantevap(ixt) a déjà été définit proprement
                    !dans ce cas là
                  enddo
      endif !if (i.lt.INB) then      
      enddo !do il=1,ncas

      ! verif
#ifdef ISOVERIF
        do il=1,ncas
         do ixt=1,niso
         call iso_verif_noNAN(xtp_cas(ixt,il),'appel stewart 198b')
         call iso_verif_noNAN(xtevap_cas(ixt,il),'appel stewart 745b')
         enddo !do ixt=1,niso
        enddo ! do il=1,ncas
#endif
#ifdef ISOVERIF
        if (oktrac.eq.0) then
        if (iso_eau.gt.0) then
        do il=1,ncas
        if (iso_verif_egalite_choix_nostop( &
     &           xtp_cas(iso_eau,il), &
     &           qp_cas(il), &
     &          'appel stewart 197b: cas_evap_glace', &
     &          errmax,errmaxrel*50).eq.1) then   
          write(*,*) 'i,il=',i,il,' INB(il)=',INB_cas(il)
!     &          ,' cas(il)=',cas_evap_glace(il)
          write(*,*) 'Tevap=',T_cas(il)
          write(*,*) 'xtp(iso_eau,il,i)=',xtp_cas(iso_eau,il)
          write(*,*) 'qp(il,i)=',qp_cas(il)
          write(*,*) 'xtnew(iso_eau)=',xtnew(iso_eau,il)
          write(*,*) 'fac_ftmr=',fac_ftmr_cas(il)
!          write(*,*) 'Mp(il,i)=',Mp(cas_evap_glace(il),i)
          write(*,*) 'xtp_avantevap(iso_eau)=', &
     &          xtp_avantevap_cas(iso_eau,il)
          write(*,*) 'qp_avantevap=',qp_avantevap_cas(il)
          write(*,*) 'Exi_stewart(iso_eau)=',Exi_stewart(iso_eau,il)
          write(*,*) 'Eqi_stewart=',Eqi_stewart(il)
!          write(*,*) 'Eqi_prime=',Eqi_prime_cas(il)        
          write(*,*) 'Pxtiinf_stewart(iso_eau)=', &
     &           Pxtiinf_stewart(iso_eau,il)
!          write(*,*) 'Pqiinf_par=',Pqiinf_par(cas_evap_glace(il))
          write(*,*) 'Pxtisup(iso_eau)=',Pxtisup_cas(iso_eau,il)
          write(*,*) 'Pqisup=',Pqisup_cas(il)
          stop
         endif !if iso_verif_egalite_choix_nostop
         enddo !do il=1,ncas
        endif
        if (iso_HDO.gt.0) then
          do il=1,ncas
            if (qp_cas(il).gt.ridicule) then
                call iso_verif_aberrant( &
     &          xtp_cas(iso_HDO,il)/qp_cas(il), &
     &          'appel_stewart_np 1449')
            endif !if (qp_cas(il).gt.ridicule) then
          enddo !do il=1,ncas
        endif  ! if (iso_HDO.gt.0) then
       endif ! if (oktrac.eq.0) then
!       write(*,*) 'appel_stewart_np 2331: sortie de make_cas_evap_glace'
#endif

      end subroutine make_cas_evap_glace_np     
     

            subroutine condiso_liq_ice_vectiso(xt,qt,cond, &
     &          tcond,zfice,zxtice,zxtliq)

    USE isotopes_mod, ONLY: iso_eau,iso_HDO,essai_convergence, &
&       bidouille_anti_divergence,ridicule
#ifdef ISOVERIF
!    USE isotopes_verif_mod, ONLY: Tmin_verif, faccond, errmax,errmaxrel
    USE isotopes_verif_mod
#endif 
        implicit none

        ! version vectorisée de condiso_liq_ice
        ! on fait d'un coup tous les iso de 1 à niso
        !d'un point de grille donnée
        
        ! déclarations
        ! **inputs
        real xt(ntraciso),qt,cond,tcond,zfice ! tcond en K        
        ! **outputs
        real zxtice(ntraciso),zxtliq(ntraciso)
        ! Rq: on met ntraciso au cas où on passe direct en argument les
        ! tableaux comportant les traceurs. Mais on ne fait que des
        ! isotopes normaux ici.
        ! **locals
        real zxtalphal(niso),zxtalphai(niso)
        real t_coup
        parameter (t_coup=273.15)
        integer ixt
        real zcond
!#ifdef ISOVERIF    
!        integer iso_verif_aberrant_nostop ! debugage
!        integer iso_verif_aberrant_choix_nostop
!        real deltaD
!#endif    
        
        ! ********* début des calculs *********

        ! traitement rapide du cas où cond=0
        if (cond.eq.0) then
          do ixt=1,niso
            zxtliq(ixt)=0
            zxtice(ixt)=0
          enddo
          return
        endif

        ! verif que qt n'est pas nul
        if (qt.eq.0) then
            if (cond.lt.ridicule) then
              do ixt=1,niso  
                zxtliq(ixt)=0
                zxtice(ixt)=0
              enddo
              return
            else !if (cond.lt.ridicule) then
                ! c'est impossible de condenser qi pas d'eau au départ
                write(*,*) 'condiso_liq_ice_vectiso 35'
                write(*,*) 'qt=',qt
                write(*,*) 'cond=',cond
                stop
            endif
        endif !if (cond.lt.ridicule) then

        ! verif xt et qt
#ifdef ISOVERIF
          if (iso_eau.gt.0) then
              call iso_verif_egalite_choix(qt,xt(iso_eau), &
     &         'condiso_liq_ice_vectiso 62',errmax,errmaxrel)
          endif  !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then  
          call iso_verif_positif(qt-cond, &
     &          'condiso_liq_ice_vectiso 56: cond>qt')     
          call iso_verif_positif(tcond-Tmin_verif, &
     &          'condiso_liq_ice_vectiso 70')        
          call iso_verif_positif(300.0-tcond, &
     &          'condiso_liq_ice_vectiso 70')     
#endif
          zcond=max(0.0,min(cond,qt))
          if (essai_convergence) then
          else  
                cond=min(cond,qt)
          endif
            
        ! maintenant, qt et cond ne sont pas nuls:
            
        do ixt=1,niso
          call fractcalk(ixt,tcond,zxtalphal(ixt),zxtalphai(ixt))
        enddo
#ifdef ISOVERIF
        do ixt=1,niso
            call iso_verif_noNAN(zxtalphal(ixt), &
     &           'condiso_liq_ice_vectiso 65')
            call iso_verif_noNAN(zxtalphai(ixt), &
     &          'condiso_liq_ice_vectiso 66')
        enddo
        if (iso_eau.gt.0) then
            call iso_verif_egalite_choix(zxtalphal(iso_eau),1.0, &
     &          'condiso 21',errmax,errmaxrel)
            call iso_verif_egalite_choix(zxtalphai(iso_eau),1.0, &
     &          'condiso 21',errmax,errmaxrel)
        endif !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
        if (iso_HDO.gt.0) then
            if (qt.gt.ridicule) then
               if (iso_verif_aberrant_nostop(xt(iso_HDO) &
     &           /qt*zxtalphai(iso_HDO)/faccond, &
     &           'condiso_liq_ice_vectiso 64').eq.1) then
!                write(*,*) 'deltaDt=',(xt/qt/tnat(iso_HDO)-1)*1000
!                write(*,*) 'tcond,fcond,zxtalphai=',
!     :                   tcond,cond/qt,zxtalphai
!                stop
              endif !if (iso_verif_aberrant_nostop(xt/qt*zxtalphai/faccond,
            endif !if (qt.gt.ridicule) then
          endif !if (iso_HDO.gt.0) then
#endif
        
        do ixt=1,niso
          zxtliq(ixt)=zxtalphal(ixt)*xt(ixt)*zcond &
     &         /(qt+zcond*(zxtalphal(ixt)-1))
        enddo
        if (zcond/qt.lt.1e-5) then
           ! cas particulier pour éviter FI quand cond/qt->0  
           do ixt=1,niso
             zxtice(ixt)=xt(ixt)/qt*zcond*zxtalphai(ixt)
           enddo

        else if (1.0-zcond/qt.lt.ridicule) then
           ! condensation totale
           ! on ajoute ce cas particulier le 9 avril 2012 car sur vargas
           ! en batch, 0**alpha est NaN
           do ixt=1,niso
             zxtice(ixt)=xt(ixt)  
           enddo !do ixt=1,niso

         else            ! cas général
           do ixt=1,niso
             zxtice(ixt)=xt(ixt)*(1.0-(1.0-(zcond/qt))**zxtalphai(ixt))
           enddo
        endif !if (zcond/qt.lt.1e-5) then
        

        ! verif
        ! verif egalité pour ixt=4 et eau normale:
#ifdef ISOVERIF
          if (zfice.lt.1) then  
            do ixt=1,niso  
              call iso_verif_noNAN(zxtliq(ixt), &
     &          'condiso_liq_ice_vectiso 91')
            enddo
            if (iso_eau.gt.0) then   
              call iso_verif_egalite_choix(zxtliq(iso_eau),cond, &
     &          'condiso_liq_ice_vectiso 30',errmax,errmaxrel)
            endif ! if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then  
            if (iso_HDO.gt.0) then 
                if (cond.gt.ridicule) then
                    call iso_verif_aberrant(zxtliq(iso_HDO)/cond, &
     &                   'condiso_liq_ice_vectiso 32')
                endif !if (cond.gt.ridicule) then 
            endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) then      
          endif !if (zfice.lt.1) then
          if (zfice.gt.0) then 
            do ixt=1,niso    
            call iso_verif_noNAN(zxtice(ixt),'condiso_liq_ice_vectiso 149')
            enddo
            if (iso_eau.gt.0) then      
              call iso_verif_egalite_choix(zxtice(iso_eau),cond, &
     &                  'condiso_liq_ice_vectiso 31',errmax,errmaxrel)
            endif ! if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then  
            if (iso_HDO.gt.0) then 
              if (cond.gt.ridicule) then
                if (iso_verif_aberrant_nostop(zxtice(iso_HDO)/cond &
     &            /faccond,'condiso_liq_ice_vectiso 33').eq.1) then
                  write(*,*) 'debug condiso 88: zfice=',zfice 
                  write(*,*) 'cond/qt=',cond/qt
                  write(*,*) 'xt(iso_HDO)/qt=',xt(iso_HDO)/qt
                  write(*,*) 'deltaD(xt(iso_HDO)/qt)=', &
     &                          deltaD(xt(iso_HDO)/qt)
                  write(*,*) 'zxtalphai(iso_HDO)=',zxtalphai(iso_HDO)
                  write(*,*) 'Rice/Rv0=',qt/cond* &
     &             (1-(1-cond/qt)**zxtalphai(iso_HDO))/(1-(1-cond/qt))
                  write(*,*) 'tcond=',tcond-t_coup,'°C' 
                  if (tcond-t_coup.gt.-40.0) then
                      ! au dessus de -40, il y a de quoi s'inquiéter
                      ! en dessous, on ne sait pas ce que valent les alphas
                     stop
                  endif !if (tcond(i).gt.100.0) then
                  endif
                endif !if (cond.gt.ridicule) then 
            endif !if (iso_HDO.gt.0) then
          endif !if (zfice.gt.0) then       
        ! verif que deltaD n'est pas abberant:
          
#endif
        ! end verif

        do ixt=1,ntraciso
          zxtliq(ixt)=(1-zfice)*zxtliq(ixt)
          zxtice(ixt)=zfice*zxtice(ixt)
        enddo
        
        ! cam verif
#ifdef ISOVERIF
        do ixt=1,niso
          call iso_verif_noNAN(zxtliq(ixt), &
     &          'condiso_liq_ice_vectiso 132')
          call iso_verif_noNAN(zxtice(ixt), &
     &          'condiso_liq_ice_vectiso 193')
        enddo
          if (iso_eau.gt.0) then
            call iso_verif_egalite_choix( &
     &          zxtice(iso_eau)+zxtliq(iso_eau),cond, &
     &          'condiso_liq_ice_vectiso 79',errmax,errmaxrel)
          endif ! if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
#endif

        if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) then
            ! assurer convergence
            if (zfice.eq.1.0) then
                zxtice(iso_eau)=cond
            endif !if (zfice.eq.1.0) then
       endif !if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) then
        
        do ixt=1,ntraciso
          zxtice(ixt)=max(0.0,zxtice(ixt))
          zxtliq(ixt)=max(0.0,zxtliq(ixt))
        enddo
        ! end verif
        
        ! *********** fin des calculs *********
        
        end subroutine condiso_liq_ice_vectiso




        subroutine condiso_liq_ice_vectall(xt,qt,cond, &
     &          tcond,zfice,zxtice,zxtliq,n)

    USE isotopes_mod, ONLY: iso_eau,iso_HDO,iso_O18,bidouille_anti_divergence, &
&       ridicule
#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel,deltalim,Tmin_verif, &
!        deltalim_snow,faccond
USE isotopes_verif_mod
#ifdef ISOTRAC
USE isotrac_mod, only: ridicule_trac
#endif
#endif
        implicit none

        ! version vectorisée de condiso_liq_ice
        ! on fait d'un coup tous les lieux i de 1 à n
        ! et tous les iso de 1 à niso
        
        ! déclarations
        ! **inputs
        integer n
        real xt(ntraciso,n),qt(n),cond(n),tcond(n),zfice(n) ! tcond en K        
        ! **outputs
        real zxtice(ntraciso,n),zxtliq(ntraciso,n)
        ! Rq: on met ntraciso au cas où on passe direct en argument les
        ! tableaux comportant les traceurs. Mais on ne fait que des
        ! isotopes normaux ici.
        ! **locals
        real zxtalphal(niso,n),zxtalphai(niso,n)
        real t_coup        
        parameter (t_coup=273.15)
        real zcond(n)
        integer ixt, i ! compteurs
#ifdef ISOVERIF
!        integer iso_verif_aberrant_nostop ! debugage
!        integer iso_verif_aberrant_choix_nostop
!        integer iso_verif_noNaN_nostop
!        integer iso_verif_positif_nostop
!        real deltaD
        real xtv(niso,n),qv(n)
#endif 

        ! verif xt et qt
#ifdef ISOVERIF
       do i=1,n
        call iso_verif_noNaN(qt(i),'condiso_liq_ice_vectall 270')
        do ixt=1,niso
         call iso_verif_noNaN(xt(ixt,i),'condiso_liq_ice_vectall 271')
        enddo
       enddo !do i=1,n
#endif
#ifdef ISOVERIF   
!          write(*,*) 'condiso 253: entrée dans condiso'     
          if (iso_eau.gt.0) then
            do i=1,n
              call iso_verif_egalite_choix &
     &         (qt(i),xt(iso_eau,i), &
     &         'condiso_liq_ice_vectall 251',errmax,errmaxrel)
              enddo !do i=1,no
          endif  !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then  
          if (iso_HDO.gt.0) then
            do i=1,n
!             if (qt(i).gt.ridicule) then
#ifdef ISOTRAC            
              call iso_verif_aberrant_choix(xt(iso_hdo,i),qt(i), &
     &           ridicule_trac,deltalimtrac,'condiso_liq_ice 256')
#else
              call iso_verif_aberrant_choix(xt(iso_hdo,i),qt(i), &
     &           ridicule,deltalim,'condiso_liq_ice 256b') 
#endif              
              ! on met deltalim*2 car les traceurs sont plus capricieux
!             endif
            enddo !do i=1,n
          endif
          
          do i=1,n
!            write(*,*) 'condiso_liq_ice_vect 292: i,qt(i),cond(i)=',
!     &          i,qt(i),cond(i)
#ifdef VERIFNEGATIF
            call iso_verif_positif(qt(i), &
     &          'condiso_liq_ice_vectall 268: qt<0')
#endif
            if ((iso_verif_positif_nostop(qt(i)-cond(i), &
     &       'condiso_liq_ice_vectall 269: cond>qt').eq.1).or. &
     &       (iso_verif_positif_nostop(tcond(i)-Tmin_verif, &
     &       'condiso_liq_ice_vectall 284').eq.1).or.      &   
     &       (iso_verif_positif_nostop(370.0-tcond(i), &
     &       'condiso_liq_ice_vectall 286').eq.1).or.  &
     &       ((qt(i).eq.0).and.(cond(i).gt.ridicule))) then
              ! c'est impossible de condenser qi pas d'eau au départ
                write(*,*) 'condiso_liq_ice_vectall 315'
                write(*,*) 'i=',i
                write(*,*) 'qt(i)=',qt(i)
                write(*,*) 'cond(i)=',cond(i)
                write(*,*) 'tcond=',tcond(i)
                stop
            endif
          enddo !do i=1,n
#endif
          do i=1,n
             zcond(i)=max(0.0,min(cond(i),qt(i)))
          enddo
          ! paragraphe enlevé le 29 avril 2012 car redondant.
          !if (essai_convergence) then
          !else  
          !    do i=1,n
          !      cond(i)=min(cond(i),qt(i))
          !    enddo
          !endif
            
        ! calculs des coefs de fracs

        call fractcalk_vectall(tcond(1),zxtalphal(1,1),zxtalphai(1,1),n)

#ifdef ISOVERIF
       do i=1,n  
        do ixt=1,niso
            call iso_verif_noNAN(zxtalphal(ixt,i), &
     &          'condiso_liq_ice_vectall 65')
            call iso_verif_noNAN(zxtalphai(ixt,i), &
     &          'condiso_liq_ice_vectall 66')
        enddo
        if (iso_eau.gt.0) then
            call iso_verif_egalite_choix(zxtalphal(iso_eau,i),1.0, &
     &          'condiso 21',errmax,errmaxrel)
            call iso_verif_egalite_choix(zxtalphai(iso_eau,i),1.0, &
     &          'condiso 21',errmax,errmaxrel)
        endif !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
        if (iso_HDO.gt.0) then
            if (qt(i).gt.ridicule) then
               if (iso_verif_aberrant_nostop(xt(iso_HDO,i) &
     &           /qt(i)*zxtalphai(iso_HDO,i)/faccond, &
     &           'condiso_liq_ice_vectall 64').eq.1) then
!                write(*,*) 'deltaDt=',(xt/qt/tnat(iso_HDO)-1)*1000
!                write(*,*) 'tcond,fcond,zxtalphai=',
!     :                   tcond,cond/qt,zxtalphai
!                stop
              endif !if (iso_verif_aberrant_nostop(xt/qt*zxtalphai/faccond,
            endif !if (qt.gt.ridicule) then
          endif !if (iso_HDO.gt.0) then
         enddo !do i=1,n  
!         write(*,*) 'condiso 320: après calculs alpha' 
#endif
        
        ! calculs du condensat

       do i=1,n
       ! on change les seuils
        if ((zcond(i).le.1e-15).or. &
     &          ((qt(i).le.1e-15).and.(zcond(i).lt.ridicule))) then
          do ixt=1,niso
            zxtliq(ixt,i)=0.0
            zxtice(ixt,i)=0.0
          enddo
        else !if ((cond(i).le.0.0).or.
                        
         do ixt=1,niso
          zxtliq(ixt,i)=zxtalphal(ixt,i) &
     &          *xt(ixt,i)*zcond(i) &
     &         /(qt(i)+zcond(i)*(zxtalphal(ixt,i)-1.0))
         enddo

         if (zcond(i)/qt(i).lt.1e-5) then
           ! cas particulier pour éviter FI quand cond/qt->0  
           do ixt=1,niso
             zxtice(ixt,i)=xt(ixt,i)/ &
     &          qt(i)*zcond(i)*zxtalphai(ixt,i)
           enddo !do ixt=1,niso

        else if (1.0-zcond(i)/qt(i).lt.ridicule) then
           ! condensation totale
           ! on ajoute ce cas particulier le 9 avril 2012 car sur vargas
           ! en batch, 0**alpha est NaN
           do ixt=1,niso
             zxtice(ixt,i)=xt(ixt,i)  
           enddo !do ixt=1,niso

         else  !if (cond(i)/qt(i).lt.1e-5) then
           ! cas général
           do ixt=1,niso
             zxtice(ixt,i)=xt(ixt,i) &
     &         *(1.0-(1.0-zcond(i)/qt(i))**zxtalphai(ixt,i))
           enddo !do ixt=1,niso
        endif !if (cond(i)/qt(i).lt.1e-5) then

        endif  !if ((cond(i).le.0.0).or.
       enddo !do i=1,n
        

        ! verif
        ! verif egalité pour ixt=4 et eau normale:
#ifdef ISOVERIF
        do i=1,n
            do ixt=1,niso  
              if ((iso_verif_noNaN_nostop(zxtliq(ixt,i), &
     &          'condiso_liq_ice_vectall 91').eq.1).or. &
     &          (iso_verif_noNaN_nostop(zxtice(ixt,i), &
     &          'condiso_liq_ice_vectall 92').eq.1)) then
                 write(*,*) 'zxtalphal(ixt,i)=',zxtalphal(ixt,i)
                 write(*,*) 'xt(ixt,i)=',xt(ixt,i)
                 write(*,*) 'zcond(i)=',zcond(i)
                 write(*,*) 'qt(i)=',qt(i)
                 stop
              endif
            enddo !do ixt=1,niso 
 
          if (zfice(i).lt.1.0) then  
            do ixt=1,niso  
              call iso_verif_noNaN(zxtliq(ixt,i), &
     &          'condiso_liq_ice_vectall 91')
            enddo
            if (iso_eau.gt.0) then   
              call iso_verif_egalite_choix(zxtliq(iso_eau,i),cond(i), &
     &          'condiso_liq_ice_vectall 30',errmax,errmaxrel)
            endif ! if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then  
            if (iso_HDO.gt.0) then 
              if (cond(i).gt.ridicule) then
#ifdef ISOTRAC
                  call iso_verif_aberrant_choix( &
     &               zxtliq(iso_HDO,i),cond(i), &
     &               ridicule_trac,deltalimtrac, &
     &               'condiso_liq_ice_vectall 32')
#else
                  if (iso_verif_aberrant_choix_nostop( &
     &               zxtliq(iso_HDO,i),cond(i), &
     &               ridicule,deltalim_snow, &
     &               'condiso_liq_ice_vectall 32b').eq.1) then
                    write(*,*) 'deltaDvap=',deltaD(xt(iso_hdo,i)/qt(i))
                    write(*,*) 'T,alphal=', &
     &                  tcond(i)-t_coup,zxtalphal(iso_hdo,i)
                    write(*,*) 'qt(i)=',qt(i)
                    stop
                  endif !if (iso_verif_aberrant_nostop(
                  
                    if (iso_O18.gt.0) then
                    if (iso_verif_O18_aberrant_nostop( &
     &              zxtliq(iso_HDO,i)/cond(i), &
     &              zxtliq(iso_O18,i)/cond(i), &
     &              'condiso_liq_ice_vectall 12546').eq.1) then
                        write(*,*) 'debug condiso_liq_ice_vect 12364: i,zfice=',i,zfice (i)
                        write(*,*) 'cond,qt,cond/qt=',cond(i),qt(i),cond(i)/qt(i)
                        write(*,*) 'deltaD(xt(iso_HDO)/qt)=',deltaD(xt(iso_HDO,i)/qt(i))
                        write(*,*) 'deltaD(zxtliq/cond)=',deltaD(zxtliq(iso_HDO,i)/cond(i))
                        write(*,*) 'deltaO18(xt(iso_HDO)/qt)=',deltaO(xt(iso_O18,i)/qt(i))
                        write(*,*) 'deltaO18(zxtliq/cond)=',deltaO(zxtliq(iso_O18,i)/cond(i))
                        write(*,*) 'tcond(i)=',tcond(i)-t_coup,'°C'
                        !stop ! Camille 9 mars 2023: trop strict
                    endif  !if (iso_verif_O18_aberrant_nostop(     
                    endif ! if (iso_O18.gt.0) then      
#endif                                     

                endif !if (cond(i).gt.ridicule) then
            endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) then 

        endif !if (zfice.lt.1) then

          if (zfice(i).gt.0) then 
            do ixt=1,niso    
              if (iso_verif_noNAN_nostop(zxtice(ixt,i), &
     &          'condiso_liq_ice_vectall 417').eq.1) then
                write(*,*) 'ixt,i=',ixt,i
                write(*,*) 'xt(ixt,i)=',xt(ixt,i)
                write(*,*) 'qt(i)=',qt(i)
                write(*,*) 'zcond(i),zcond/qt=',zcond(i),zcond(i)/qt(i)
                write(*,*) 'zxtalphai(ixt,i)=',zxtalphai(ixt,i)
                stop
              endif
            enddo !do ixt=1,niso    
            if (iso_eau.gt.0) then      
              call iso_verif_egalite_choix(zxtice(iso_eau,i),cond(i), &
     &                  'condiso_liq_ice_vectall 31',errmax,errmaxrel)
            endif ! if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then  
            if (iso_HDO.gt.0) then 
              if (cond(i).gt.ridicule) then
                if (iso_verif_aberrant_nostop( &
     &              zxtice(iso_HDO,i)/cond(i)/faccond, &
     &              'condiso_liq_ice_vectall 414').eq.1) then
                  write(*,*) 'debug condiso_liq_ice_vect 13364: i,zfice=', &
     &                  i,zfice (i)
                  write(*,*) 'cond,qt,cond/qt=',cond(i)/qt(i), &
     &                  cond(i),qt(i)
                  write(*,*) 'xt(iso_HDO)/qt=', &
     &                  xt(iso_HDO,i)/qt(i)
                  write(*,*) 'deltaD(xt(iso_HDO)/qt)=', &
     &              deltaD(xt(iso_HDO,i)/qt(i))
                  write(*,*) 'zxtalphai(iso_HDO)=', &
     &                  zxtalphai(iso_HDO,i)
                  write(*,*) 'Rice/Rv0=',qt(i)/cond(i)* &
     &                  (1.0-(1.0-cond(i)/qt(i))**zxtalphai(iso_HDO,i))
                  write(*,*) 'deltaD(zxtice/cond)=', &
     &                  deltaD(zxtice(iso_HDO,i)/cond(i))
                  write(*,*) 'tcond(i)=',tcond(i)-t_coup,'°C'

                  if (tcond(i)-t_coup.gt.-40.0) then 
                     ! sinon, c'est pas grave, il y aura juste une
                     ! abérrance dans les zones très froides. 
#ifdef ISOTRAC                     
                     ! on est plus indulgent
                     call iso_verif_aberrant_choix( &
     &               zxtice(iso_HDO,i),cond(i), &
     &               ridicule_trac,deltalimtrac, &
     &               'condiso_liq_ice_vectall 441')
#else
                    stop 
#endif 
                  endif !if (tcond(i)-t_coup.gt.-40.0) then
                  endif !if (iso_verif_aberrant_nostop

                    if (iso_O18.gt.0) then
                    if (iso_verif_O18_aberrant_nostop( &
     &              zxtice(iso_HDO,i)/cond(i), &
     &              zxtice(iso_O18,i)/cond(i), &
     &              'condiso_liq_ice_vectall 12601').eq.1) then
                        write(*,*) 'debug condiso_liq_ice_vect 364: i,zfice=',i,zfice (i)
                        write(*,*) 'cond,qt,cond/qt=',cond(i),qt(i),cond(i)/qt(i)
                        write(*,*) 'deltaD(xt(iso_HDO)/qt)=',deltaD(xt(iso_HDO,i)/qt(i))
                        write(*,*) 'deltaD(zxtice/cond)=',deltaD(zxtice(iso_HDO,i)/cond(i))
                        write(*,*) 'deltaO18(xt(iso_HDO)/qt)=',deltaO(xt(iso_O18,i)/qt(i))
                        write(*,*) 'deltaO18(zxtice/cond)=',deltaO(zxtice(iso_O18,i)/cond(i))
                        write(*,*) 'dexcess vap=',deltaD(xt(iso_HDO,i)/qt(i)) &
&                                -8*deltaO(xt(iso_O18,i)/qt(i))
                        write(*,*) 'tcond(i)=',tcond(i)-t_coup,'°C'
                        write(*,*) 'zxtalphai(iso_O18,i)=',zxtalphai(iso_O18,i)
                        write(*,*) 'xt(1:niso,i)=',xt(1:niso,i)
                        !stop ! Camille 9 mars 2023: trop strict
                    endif  !if (iso_verif_O18_aberrant_nostop(     
                    endif ! if (iso_O18.gt.0) then
                endif !if (cond.gt.ridicule) then

                if ((zcond(i)/max(qt(i),1e-15).gt.0.95).and. &
     &               (zfice(i).eq.1).and.(qt(i).gt.5e-4)) then
                   ! verif que la vapeur est très pauvre
                   do ixt=1,niso
                     xtv(ixt,i)=xt(ixt,i)-zxtice(ixt,i)        
                   enddo
#ifdef ISOVERIF
                   call iso_verif_noNaN(qt(i), &
     &               'condiso_liq_ice_vect 467b')
                   call iso_verif_noNaN(zcond(i), &
     &               'condiso_liq_ice_vect 467c')
                   do ixt=1,niso
                     call iso_verif_noNaN(xtv(ixt,i), &
     &               'condiso_liq_ice_vect 475a')    
                     call iso_verif_noNaN(xt(ixt,i), &
     &               'condiso_liq_ice_vect 475b')   
                     call iso_verif_noNaN(zxtice(ixt,i), &
     &               'condiso_liq_ice_vect 475c')   
                   enddo !do ixt=1,niso
#endif                   
                   qv(i)=qt(i)-zcond(i)
                   if (qv(i).gt.ridicule) then
                   if (deltaD(xtv(iso_HDO,i)/qv(i)).gt.-200.0) then
                        write(*,*) 'condiso 454: deltaDv trop fort'
                        write(*,*) 'tcond(i)-t_coup=',tcond(i)-t_coup
                        write(*,*) 'xt(:,i)=',xt(:,i)
                        write(*,*) 'zxtice(:,i)=',zxtice(:,i)
                        write(*,*) 'xtv(:,i)=',xtv(:,i)
                        write(*,*) 'zxtalphai(:,i)=',zxtalphai(:,i)
                        write(*,*) 'qt(i),zcond(i)=',qt(i),zcond(i)
                        stop
                   endif  !if (deltaD((xt(ixt,i)-zxtice(ixt,i))/
                   endif !if (qv(i).gt.ridicule) then
                endif !if (zcond(i)/qt(i).gt.0.95) then
            endif !if (iso_HDO.gt.0) then
          endif !if (zfice.gt.0) then             
          enddo ! do i=1,n    
        
#endif
        ! #ifdef ISOVERIF
#ifdef ISOVERIF       
        ! ajout temporaire le 28 oct:
        if (iso_HDO.gt.0) then
         do i=1,n
          if (zfice(i).gt.0.9) then
              if (iso_verif_aberrant_choix_nostop( &
     &          zxtice(iso_HDO,i),cond(i),ridicule,deltalim_snow, & 
                ! Camille 9 mars 2023: pour le condensat, on laisse plus de
                ! marge
     &          'condiso_liq_ice_vect 412').eq.1) then
                write(*,*) 'debug condiso_liq_ice_vect 449: i,zfice=', &
     &                  i,zfice (i)
                  write(*,*) 'cond/qt=',cond(i)/qt(i)
                  write(*,*) 'deltaD(xt(iso_HDO)/qt)=', &
     &              deltaD(xt(iso_HDO,i)/qt(i))
                  write(*,*) 'zxtalphai(iso_HDO)=', &
     &                  zxtalphai(iso_HDO,i)
                  write(*,*) 'Rice/Rv0=',qt(i)/cond(i)* &
     &                  (1.0-(1.0-cond(i)/qt(i))**zxtalphai(iso_HDO,i))
                  write(*,*) 'deltaD(zxtice/cond)=', &
     &                  deltaD(zxtice(iso_HDO,i)/cond(i))   
                  write(*,*) 'tcond(i)=',tcond(i)-t_coup,'°C'
                  if (tcond(i)-t_coup.gt.-40.0) then 
                     ! sinon, c'est pas grave, il y aura juste une
                     ! abérrance dans les zones très froides. 
#ifdef ISOTRAC                     
                     ! on est plus indulgent
                     call iso_verif_aberrant_choix( &
     &               zxtice(iso_HDO,i),cond(i), &
     &               ridicule_trac,deltalimtrac, &
     &               'condiso_liq_ice_vectall 480')
#else
                    stop 
#endif    
                  endif
              endif
          endif
         enddo
        endif !if (iso_HDO.gt.0) then 
#endif 
        ! end verif
        do i=1,n
         do ixt=1,niso
          zxtliq(ixt,i)=(1-zfice(i))*zxtliq(ixt,i)
          zxtice(ixt,i)=zfice(i)*zxtice(ixt,i)
         enddo
        enddo
        
        ! cam verif
#ifdef ISOVERIF
      do i=1,n  
        do ixt=1,niso
          call iso_verif_noNAN(zxtliq(ixt,i), &
     &          'condiso_liq_ice_vectall 132')
          call iso_verif_noNAN(zxtice(ixt,i), &
     &          'condiso_liq_ice_vectall 537')
        enddo !do ixt=1,niso
      enddo !do i=1,n  
          if (iso_eau.gt.0) then
            do i=1,n    
            call iso_verif_egalite_choix(zxtice(iso_eau,i) &
     &          +zxtliq(iso_eau,i),cond(i), &
     &          'condiso_liq_ice_vectall 79',errmax,errmaxrel)
            enddo !do i=1,n  
          endif ! if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
!          write(*,*) 'condiso 477: fin de condiso' 
#endif

      if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) then
            ! assurer convergence
           do i=1,n
            if (zfice(i).eq.1.0) then
                zxtice(iso_eau,i)=cond(i)
            endif !if (zfice.eq.1.0) then
           enddo
       endif !if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) then
        
        do i=1,n
         do ixt=1,niso        
          zxtice(ixt,i)=max(0.0,zxtice(ixt,i))
          zxtliq(ixt,i)=max(0.0,zxtliq(ixt,i))
         enddo
        enddo
        ! end verif
        
        ! *********** fin des calculs *********
        
        end subroutine condiso_liq_ice_vectall

          subroutine condiso_liq_ice(ixt,xt,qt,cond, &
     &          tcond,zfice,zxtice,zxtliq)

    USE isotopes_mod, ONLY: iso_eau,iso_HDO,bidouille_anti_divergence, &
&       ridicule,iso_O18
#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel,faccond
USE isotopes_verif_mod
#endif
        implicit none

        ! on s'interresse à l'isotope ixt.
        ! de l'air de propriétés (qt,xt) condense cond, à la température
        ! tcond, donc zfice*cond est sous forme de glace.
        ! on cherche alors les isotopes contenus dans les phases liquide
        ! et glace: zxtliq et zxtice
        
        ! déclarations
        ! **inputs
        real xt,qt,cond,tcond,zfice ! tcond en K
        integer ixt
        ! **outputs
        real zxtice,zxtliq
        ! **locals
        real zxtalphal,zxtalphai
!        integer iso_verif_aberrant_nostop ! debugage
        
        ! ********* début des calculs *********

        ! traitement rapide du cas où cond=0
        if (cond.eq.0) then
            zxtliq=0
            zxtice=0
            return
        endif

        ! verif que qt n'est pas nul
        if (qt.eq.0) then
            if (cond.lt.ridicule) then
                zxtliq=0
                zxtice=0
                return
            else
                ! c'est impossible de condenser qi pas d'eau au départ
                write(*,*) 'condiso_liq_ice 35'
                write(*,*) 'qt=',qt
                write(*,*) 'cond=',cond
                stop
            endif
        endif

        ! verif xt et qt
#ifdef ISOVERIF
          if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
              call iso_verif_egalite_choix &
     &         (qt,xt,'condiso_liq_ice 51',errmax,errmaxrel)
          endif  !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then  
          call iso_verif_positif(qt-cond,'condiso_liq_ice 56: cond>qt')     
#endif
        cond=min(cond,qt)
            
        ! maintenant, qt et cond ne sont pas nuls:

        call fractcalk(ixt,tcond,zxtalphal,zxtalphai)
#ifdef ISOVERIF
            call iso_verif_noNAN(zxtalphal,'condiso_liq_ice 65')
            call iso_verif_noNAN(zxtalphai,'condiso_liq_ice 66')
            if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
                call iso_verif_egalite(zxtalphal,1.0,'condiso 21')
                call iso_verif_egalite(zxtalphai,1.0,'condiso 21')
            endif !if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
#endif

#ifdef ISOVERIF
          if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) then
            if (qt.gt.ridicule) then
               if (iso_verif_aberrant_nostop(xt/qt*zxtalphai/faccond, &
     &          'condiso_liq_ice 64').eq.1) then
!                write(*,*) 'deltaDt=',(xt/qt/tnat(iso_HDO)-1)*1000
!                write(*,*) 'tcond,fcond,zxtalphai=',
!     :                   tcond,cond/qt,zxtalphai
!                stop
              endif !if (iso_verif_aberrant_nostop(xt/qt*zxtalphai/faccond,
            endif !if (qt.gt.ridicule) then
          endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) then
#endif
        
        
        zxtliq=zxtalphal*xt*cond/(qt+cond*(zxtalphal-1))
        if (cond/qt.lt.1e-5) then
           ! cas particulier pour éviter FI quand cond/qt->0  
           zxtice=xt/qt*cond*zxtalphai 

        else if (1.0-cond/qt.lt.ridicule) then
           ! condensation totale
           ! on ajoute ce cas particulier le 9 avril 2012 car sur vargas
           ! en batch, 0**alpha est NaN
             zxtice=xt

        else  
           ! cas général 
           zxtice=xt*(1-(1-cond/qt)**zxtalphai)
        endif

        ! verif
        ! verif egalité pour ixt=4 et eau normale:
#ifdef ISOVERIF
          if (zfice.lt.1) then  
            call iso_verif_noNAN(zxtliq,'condiso_liq_ice 91')
            if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then            
              call iso_verif_egalite(zxtliq,cond,'condiso_liq_ice 30')
            endif ! if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then  
            if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) then 
                if (cond.gt.ridicule) then
                    call iso_verif_aberrant(zxtliq/cond, &
     &                   'condiso_liq_ice 32')
                endif !if (cond.gt.ridicule) then 
            endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) then      
          endif !if (zfice.lt.1) then
          if (zfice.gt.0) then  
            call iso_verif_noNAN(zxtice,'condiso_liq_ice 92')
            if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then      
              call iso_verif_egalite(zxtice,cond,'condiso_liq_ice 31')             
            endif ! if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then  
            if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) then 
              if (cond.gt.ridicule) then
                if (iso_verif_aberrant_nostop(zxtice/cond, &
     &                 'condiso_liq_ice 33').eq.1) then
                  write(*,*) 'debug condiso 88: zfice=',zfice 
                  write(*,*) 'cond/qt=',cond/qt
                  write(*,*) 'xt/qt=',xt/qt
                  write(*,*) 'zxtalphai=',zxtalphai
                  write(*,*) 'qt/cond*(1-(1-cond/qt)**zxtalphai)=', &
     &                  (qt/cond)*1-(1-cond/qt)**zxtalphai
                  write(*,*) 'zxtice/cond=',zxtice/cond 
                  stop
                  endif
                endif !if (cond.gt.ridicule) then 
            endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) then
          endif !if (zfice.gt.0) then       
        ! verif que deltaD n'est pas abberant:
          
#endif
        ! end verif

        zxtliq=(1-zfice)*zxtliq
        zxtice=zfice*zxtice
        
        ! cam verif
#ifdef ISOVERIF
          call iso_verif_noNAN(zxtliq,'condiso_liq_ice 132')
          call iso_verif_noNAN(zxtice,'condiso_liq_ice 92')
          if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
            call iso_verif_egalite(zxtice+zxtliq,cond, &
     &          'condiso_liq_ice 79')
          endif ! if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
          call iso_verif_noNAN(zxtice+zxtliq,'condiso_liq_ice 108')     
#endif

        if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) then
          if (ixt.eq.iso_eau) then
            ! assurer convergence
            if (zfice.eq.1.0) then
                zxtice=cond
            endif !if (zfice.eq.1.0) then
        endif !if (ixt.eq.iso_eau) then
       endif !if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) then
        
        zxtice=max(0.0,zxtice)
        zxtliq=max(0.0,zxtliq)
        ! end verif
        
        ! *********** fin des calculs *********
        
        end subroutine condiso_liq_ice


        !************
        subroutine calcul_zfice(T,zfice)

    USE isotopes_mod, ONLY: pxtmelt,pxtice
        implicit none

        ! inputs
        real T ! température en K
        ! output:
        real zfice ! fraction de condensation en glace

        zfice = 1.0-(T-pxtice)/(pxtmelt-pxtice)
        zfice = MIN(MAX(zfice,0.0),1.0)    

        end subroutine calcul_zfice   


        subroutine gestion_neige(klon,knon,snow,xtsnow, &
     &           snow_prec,xtsnow_prec,dtime, &
     &           precip_snow,xtprecip_snow,xtprecip_rain,fq_fonte_neige,fqfonte_neige, &
     &           fqcalving,snow_evap,xtsnow_evap,fxt_fonte_neige,fxtfonte_neige,fxtcalving, &
     &           xt1lay,q1lay,tsurf,t_coup,nisurf,Rland_ice)

    USE isotopes_mod, ONLY: Rdefault,iso_eau,iso_HDO, &
&       bidouille_anti_divergence, ridicule,ridicule_snow, &
&       tcorr,toce,alpha_liq_sol
    USE indice_sol_mod    
#ifdef ISOVERIF
!    USE isotopes_verif_mod, ONLY: errmax,errmaxrel,errmax_sol,deltalim_snow
    USE isotopes_verif_mod
#endif
#ifdef ISOTRAC
    USE isotrac_mod, ONLY: izone_cont,index_zone,index_iso
#endif
USE yoethf_mod_h
        USE yomcst_mod_h
USE dimensions_mod, ONLY: iim, jjm, llm, ndm
implicit none

        ! gestion de la neige: on precipte dessus, sublime, effondre,
        ! fond, etc...
        ! commun aux dfférentes sous-surfaces.

INCLUDE "FCTTRE.h"
!
!INCLUDE "paramet.h"

         ! inputs
        integer, intent(in) :: klon,knon
        real, intent(in) :: dtime
        real, intent(in) :: snow(klon),snow_prec(klon)
        real, intent(in) :: xtsnow_prec(niso,klon)
        real, intent(in) :: precip_snow(klon),xtprecip_snow(ntraciso,klon),xtprecip_rain(ntraciso,klon)
        real, intent(in) :: snow_evap(klon)
        real, intent(in) :: fq_fonte_neige(klon)
        real, intent(in) :: fqfonte_neige(klon)
        real, intent(in) :: fqcalving(klon)
        real, intent(in) :: t_coup
        real, intent(in) ::  q1lay(klon)
        real, intent(in) :: xt1lay(ntraciso,klon)
        real, intent(in) ::  tsurf(klon)
        INTEGER, INTENT(IN)                  :: nisurf
        real, dimension(niso,klon), INTENT(IN) :: Rland_ice
        
        ! inouts
        real, intent(inout) ::  xtsnow(niso,klon)

        ! outputs
        real, DIMENSION(ntraciso,klon), INTENT(OUT) :: xtsnow_evap
        real, DIMENSION(niso,klon), INTENT(OUT) ::  fxt_fonte_neige
        real, DIMENSION(niso,klon), INTENT(OUT) ::  fxtfonte_neige
        real, DIMENSION(niso,klon), INTENT(OUT) ::  fxtcalving

        ! locals
        real snow_apres_precip(klon),xtsnow_apres_precip(niso,klon)
        real snow_avant_evap(klon),xtsnow_avant_evap(niso,klon)
        real Rsnow_apres_precip(niso,klon), Rsnow_avant_evap(niso,klon)
        real snow_avant_calving(klon)
        real fqfonte_neige_add
        integer i,ixt,j
#ifdef ISOVERIF
!        integer iso_verif_aberrant_O17_nostop ! juste debug
!        real o17excess        
        real dqdiag        
        real snow_max
        parameter (snow_max=3000.)
#endif        
!#ifdef ISOVERIF
!        integer iso_verif_aberrant_nostop ! juste debug        
!        integer iso_verif_aberrant_choix_nostop
!        integer iso_verif_egalite_choix_nostop
!        integer iso_verif_positif_nostop
!        integer iso_verif_egalite_nostop
!        integer iso_verif_positif_choix_nostop
!        real deltaD
!#endif  
!#ifdef ISOVERIF
!        integer iso_verif_noNaN_nostop
!#endif  

#ifdef ISOVERIF  
       if (iso_eau.gt.0) then  
        do i=1,knon
          call iso_verif_egalite_choix( &
     &          xtsnow(iso_eau,i),snow_prec(i),  &
     &         'calcul_iso_surf_vectall 2157',errmax,errmaxrel)
        enddo
      endif
#endif
        ! on precipe sur la neige
        do i=1,knon        
        snow_apres_precip(i)=snow_prec(i)+precip_snow(i)*dtime
        do ixt=1,niso
         xtsnow_apres_precip(ixt,i)=xtsnow_prec(ixt,i) &
     &           +xtprecip_snow(ixt,i)*dtime
#ifdef ISOVERIF
         if (iso_verif_noNaN_nostop(xtsnow_apres_precip(ixt,i),  &
     &         'calcul_iso_surf_vectall 2260').eq.1) then
            write(*,*) 'xtsnow_prec(ixt,i)=',xtsnow_prec(ixt,i)
            write(*,*) 'xtprecip_snow(ixt,i)=',xtprecip_snow(ixt,i)
            stop
         endif
#endif        
        enddo      
        ! peu importe la compo en traceurs de la neige, car de toute
        ! façon la nege est évaporée avec un certain tagging: izone_cont
      enddo !do i=1,knon

#ifdef ISOVERIF  
      do i=1,knon         
        if (iso_eau.gt.0) then  
            if (iso_verif_egalite_choix_nostop( &
     &               xtsnow_apres_precip(iso_eau,i), &
     &               snow_apres_precip(i),'calcul_iso_surf_ter 1028', &
     &               errmax,errmaxrel).eq.1) then
              write(*,*) 'snow_prec(i),xtsnow_prec(iso_eau,i)=', &
     &           snow_prec(i),xtsnow_prec(iso_eau,i)
              write(*,*) 'precip_snow(i),xtprecip_snow(iso_eau,i)=', &
     &           precip_snow(i),xtprecip_snow(iso_eau,i)
              stop
            endif
        endif !if (iso_eau.gt.0) then
        if (iso_HDO.gt.0) then                   
             call iso_verif_aberrant_choix( &
     &             xtsnow_apres_precip(iso_hdo,i), &
     &             snow_apres_precip(i),ridicule_snow,deltalim_snow, &
     &             'calcul_iso_surf_ter 1931')
         endif !if (iso_eau.gt.0) then
       enddo
#endif

        ! on ajoute éventuellement du givre sur la neige        
        ! C Risi: juin 2020: on ajoute le givre ici car sinon, on ne sait pas
        ! quoi fondre.
        do i=1,knon
          if (snow_evap(i).lt.0.0) then
            snow_apres_precip(i)=snow_apres_precip(i)-snow_evap(i)*dtime
            call iso_rosee_givre(xt1lay,q1lay,tsurf,t_coup,snow_evap,i, &
     &            xtsnow_evap,klon)    
            do ixt=1,niso
               xtsnow_apres_precip(ixt,i)=xtsnow_apres_precip(ixt,i) &
     &           -xtsnow_evap(ixt,i)*dtime
            enddo !do ixt=1,niso
          endif !if (snow_evap(i).lt.0.0) then
        enddo !do i=1,knon
             
#ifdef ISOVERIF  
      do i=1,knon         
        if (iso_eau.gt.0) then  
            if (iso_verif_egalite_choix_nostop( &
     &               xtsnow_apres_precip(iso_eau,i), &
     &               snow_apres_precip(i),'calcul_iso_surf_ter 1028', &
     &               errmax,errmaxrel).eq.1) then
              write(*,*) 'snow_prec(i),xtsnow_prec(iso_eau,i)=', &
     &           snow_prec(i),xtsnow_prec(iso_eau,i)
              write(*,*) 'precip_snow(i),xtprecip_snow(iso_eau,i)=', &
     &           precip_snow(i),xtprecip_snow(iso_eau,i)
              stop
            endif
        endif !if (iso_eau.gt.0) then
        if (iso_HDO.gt.0) then                   
             call iso_verif_aberrant_choix( &
     &             xtsnow_apres_precip(iso_hdo,i), &
     &             snow_apres_precip(i),ridicule_snow,deltalim_snow, &
     &             'calcul_iso_surf_ter 1931')
         endif !if (iso_eau.gt.0) then
       enddo
#endif

        ! on fond la neige
      do i=1,knon  
        if (fq_fonte_neige(i).gt.ridicule) then
          if (snow_apres_precip(i).gt.ridicule) then
            do ixt=1,niso
              Rsnow_apres_precip(ixt,i)=xtsnow_apres_precip(ixt,i)/ &
     &                   snow_apres_precip(i)
            ! (H) pas de frac pendant la fonte neige
              fxt_fonte_neige(ixt,i)=fq_fonte_neige(i) &
     &           *Rsnow_apres_precip(ixt,i)
#ifdef ISOVERIF
              if ((iso_verif_noNaN_nostop(Rsnow_apres_precip(ixt,i), &
     &           'calcul_iso_surf_ter 2294a').eq.1).or. &
     &           (iso_verif_noNaN_nostop(fxt_fonte_neige(ixt,i), &
     &           'calcul_iso_surf_ter 2294b').eq.1)) then
                write(*,*) 'ixt,i=',ixt,i
                write(*,*) 'xtsnow_apres_precip,snow_apres_precip=', &
     &                   xtsnow_apres_precip(ixt,i), &
     &                   snow_apres_precip(i)
                write(*,*) 'fq_fonte_neige(i)=',fq_fonte_neige(i)
                stop
              endif
#endif
            enddo !do ixt=1,niso
          else !if (snow_apres_precip(i).gt.0) then
                ! fonte de quoi? pas de neige!!
              write(*,*) 'calcul_iso_surf_ter 588: fq_fonte_neige(i)=', &
     &           fq_fonte_neige(i)
              write(*,*) 'snow_apres_precip(i)=',snow_apres_precip(i)
              write(*,*) 'i=',i
              write(*,*) 'snow_prec(i)=',snow_prec(i)
              write(*,*) 'precip_snow(i)*dtime=',precip_snow(i)*dtime
              stop
          endif !if (snow_apres_precip(i).gt.0) then
        else !endif !if (fq_fonte_neige(i).gt.0.0) then
           do ixt=1,niso
              fxt_fonte_neige(ixt,i)=0.0
           enddo !do ixt=1,niso          
        endif !if (fq_fonte_neige(i).gt.0.0) then
      enddo !do i=1,knon   
#ifdef ISOVERIF
      do i=1,knon
        do ixt=1,niso
          call iso_verif_noNaN(xtsnow_apres_precip(ixt,i), &
     &           'calcul_iso_surf_ter 2312')
          call iso_verif_noNaN(fxt_fonte_neige(ixt,i), &
     &           'calcul_iso_surf_ter 2315')
        enddo !do ixt=1,niso
       enddo !do i=1,knon  
#endif

      do i=1,knon
        snow_avant_evap(i)=snow_apres_precip(i)-fq_fonte_neige(i)
        do ixt=1,niso
          xtsnow_avant_evap(ixt,i)=xtsnow_apres_precip(ixt,i) &
     &           -fxt_fonte_neige(ixt,i)
#ifdef ISOVERIF
          if (iso_verif_noNaN_nostop(xtsnow_avant_evap(ixt,i), &
     &          'calcul_iso_surf_ter 2363').eq.1) then
                  write(*,*) 'xtsnow_apres_precip(ixt,i)=', &
     &                  xtsnow_apres_precip(ixt,i)
                  write(*,*) 'fxt_fonte_neige(ixt,i)=', &
     &                  fxt_fonte_neige(ixt,i)
                  stop
          endif
#endif          
        enddo !do ixt=1,niso
       enddo !do i=1,knon                  

         ! calcul de xtsnow_evap et du nouveau xtsnow:
        ! a condition que snow_evap > 0, car le givre a déjà été traité plus
        ! haut
#ifdef ISOVERIF
       do i=1,knon   
         ! on verifie que snow_avant_evap-snow_evap-fqcalving=snow
         if (iso_verif_egalite_choix_nostop(snow_avant_evap(i) &
     &           -max(snow_evap(i),0.0)*dtime-fqcalving(i)*dtime,snow(i), &
     &           'calcul_iso_surf_ter 224',errmax_sol*max(snow(i),1.0), &
     &            errmaxrel).eq.1) then
             write(*,*) 'snow(i)=',snow(i)
             write(*,*) 'snow_prec(i)=',snow_prec(i)
             write(*,*) 'precip_snow(i)*dt=',precip_snow(i)*dtime
             write(*,*) 'fq_fonte_neige(i)=',fq_fonte_neige(i)
             write(*,*) 'snow_evap(i)*dt=',snow_evap(i)*dtime
             write(*,*) 'fqcalving(i)=',fqcalving(i)*dtime
             write(*,*) 'snow_avant_evap(i)=',snow_avant_evap(i)
             write(*,*) 'snow_apres_precip(i)=',snow_apres_precip(i)
             stop
         endif
         if (iso_eau.gt.0) then  
                 call iso_verif_egalite_choix( &
     &               xtsnow_avant_evap(iso_eau,i), &
     &               snow_avant_evap(i),'calcul_iso_surf_ter 1082', &
     &               errmax,errmaxrel)
          endif !if (iso_eau.gt.0) then
           if (iso_HDO.gt.0) then                   
             call iso_verif_aberrant_choix(xtsnow_avant_evap(iso_hdo,i), &
     &                  snow_avant_evap(i),ridicule_snow,deltalim_snow, &
     &                  'calcul_iso_surf_ter 1991')
          endif !if (iso_eau.gt.0) then
       enddo !do i=1,knon  
#endif            

        do i=1,knon   
         snow_avant_calving(i)=snow_avant_evap(i)-max(0.0,snow_evap(i))*dtime
        enddo !do i=1,knon    

        do i=1,knon
         if (snow_evap(i).gt.ridicule**2) then
            ! CRisi 9 juin 2021: on met un seuil plus strict.
            ! sublimation positive, sans fractionnement            
            if (snow_avant_evap(i).gt.ridicule**2) then    
              ! on sublime sans fractionnement une partie de la neige.
              ! on en profite pour en effonfrer aussi éventuellement une
              ! partie.  
              do ixt=1,niso
               Rsnow_avant_evap(ixt,i)=xtsnow_avant_evap(ixt,i)/ &
     &           snow_avant_evap(i)
               xtsnow(ixt,i)=Rsnow_avant_evap(ixt,i) &
     &                   *snow_avant_calving(i)
               xtsnow_evap(ixt,i)=snow_evap(i)*Rsnow_avant_evap(ixt,i)
              enddo   !do ixt=1,niso 
#ifdef ISOVERIF
             do ixt=1,niso 
!              call iso_verif_noNaN(xtsnow_evap(ixt,i),
!     &          'calcul_iso_surf_ter 2543')
               if (iso_verif_noNaN_nostop(xtsnow_evap(ixt,i), &
     &          'calcul_iso_surf_ter 2543').eq.1) then
                  write(*,*) 'xtsnow_avant_evap(ixt,i)=', &
     &                  xtsnow_avant_evap(ixt,i)
                  write(*,*) 'snow_avant_evap(i)=',snow_avant_evap(i)
                  write(*,*) 'Rsnow_avant_evap(ixt,i)=', &
     &                  Rsnow_avant_evap(ixt,i)
                  write(*,*) 'snow_evap(i)=',snow_evap(i)
                  write(*,*) 'ixt,i=',ixt,i
                  stop
               endif !if (iso_verif_noNaN_nostop(xtsnow_evap(ixt,i),
             enddo !do ixt=1,niso    
#endif
             
            else !if (snow_avant_evap(i).gt.0.0) then  
#ifdef ISOVERIF                
                write(*,*) 'iso_surf_lic 952: quoi evaporer?'
                write(*,*) 'snow_evap(i),snow_avant_evap(i)=', &
     &                   snow_evap(i),snow_avant_evap(i)
                write(*,*) 'snow(i)=',snow(i)
                write(*,*) 'snow_apres_precip(i)=',snow_apres_precip(i)
                write(*,*) 'Rsnow_apres_precip(:,i)=',Rsnow_apres_precip(:,i)
                write(*,*) 'i=',i
!                stop                
#endif               
                if (snow_apres_precip(i).gt.ridicule) then
                   ! on évapore la snow apres precip
                  do ixt=1,niso
                    xtsnow(ixt,i)=Rsnow_apres_precip(ixt,i)*snow_avant_calving(i)
                    xtsnow_evap(ixt,i)=snow_evap(i) &
     &                  *Rsnow_apres_precip(ixt,i) 
#ifdef ISOVERIF
          call iso_verif_noNaN(xtsnow_evap(ixt,i), &
     &          'calcul_iso_surf_ter 2414')   
#endif              
                  enddo
                else  !if (snow_apres_precip(i).gt.0.0) then
#ifdef ISOVERIF                
                  write(*,*) 'iso_surf_lic 967: quoi evaporer? '// &
     &                   'sans espoir'
                  write(*,*) 'snow_apres_precip(i)=', &
     &                   snow_apres_precip(i)
                  stop                
#endif                       
                    ! on prend la compo par défaut
                    do ixt=1,niso
                     Rsnow_avant_evap(ixt,i)=Rdefault(ixt)
                     xtsnow(ixt,i)=Rsnow_avant_evap(ixt,i) &
     &                   *snow_avant_calving(i)
                     xtsnow_evap(ixt,i)=snow_evap(i) &
     &                   *Rsnow_avant_evap(ixt,i)  
#ifdef ISOVERIF
          call iso_verif_noNaN(xtsnow_evap(ixt,i), &
     &          'calcul_iso_surf_ter 2430')   
#endif              
                    enddo
                endif !if (snow_apres_precip(i).gt.0.0) then
              
                
            endif !if (snow_avant_evap(i).gt.0.0) then  

        ! C Risi juin 2020: on supprime la rosée ici car ça a déjà été traité
        ! plus haut
        else if (snow_evap(i).lt.-ridicule**2) then ! if (snow_evap(i).gt.0.0) then
!            ! on a de la rosée
!            call iso_rosee_givre(xt1lay,q1lay,tsurf, &
!     &            t_coup,snow_evap,i,xtsnow_evap,klon)
!            ! les traceurs d'isotopes sont déjà dans la rosée
            do ixt=1,niso
              !xtsnow(ixt,i)=xtsnow_avant_evap(ixt,i)-xtsnow_evap(ixt,i)
              xtsnow(ixt,i)=xtsnow_avant_evap(ixt,i)  
            enddo
        else ! if (snow_evap(i).lt.-ridicule**2) then
            ! évaporation nulle 
            do ixt=1,ntraciso
              xtsnow_evap(ixt,i)=0.0
            enddo  
            do ixt=1,niso  
              xtsnow(ixt,i)=xtsnow_avant_evap(ixt,i)            
            enddo
        endif !if (snow_evap(i).gt.0.0) then

#ifdef ISOTRAC
              do ixt=niso+1,ntraciso
                if (index_zone(ixt).eq.izone_cont) then
                  xtsnow_evap(ixt,i)=xtsnow_evap(index_iso(ixt),i)
                else
                  xtsnow_evap(ixt,i)=0.0
                endif
             enddo
#endif   

      enddo !do i=1,knon    

        ! calving de la neige
#ifdef ISOVERIF
       do i=1,knon        
        do ixt=1,ntraciso
          call iso_verif_noNaN(xtsnow_evap(ixt,i), &
     &          'calcul_iso_surf_ter 2167')
        enddo   
       enddo
        ! on verifie que snow_avant_evap-snow_evap-fqcalving=snow
       do i=1,knon   
        if (iso_verif_egalite_choix_nostop(snow_avant_calving(i) &
     &           -fqcalving(i)*dtime,snow(i), &
     &           'gestion_neige 1087',errmax_sol*max(snow(i),1.0), &
     &           errmaxrel).eq.1) then
             write(*,*) 'snow(i)=',snow(i)
             write(*,*) 'snow_prec(i)=',snow_prec(i)
             write(*,*) 'precip_snow(i)*dt=',precip_snow(i)*dtime
             write(*,*) 'fq_fonte_neige(i)=',fq_fonte_neige(i)
             write(*,*) 'snow_evap(i)*dt=',snow_evap(i)*dtime
             write(*,*) 'fqcalving(i)*dt=',fqcalving(i)*dtime
             write(*,*) 'snow_avant_evap(i)=',snow_avant_evap(i)
             write(*,*) 'snow_apres_precip(i)=',snow_apres_precip(i)
             write(*,*) 'snow_avant_calving(i)=',snow_avant_calving(i)
             stop
         endif
         if (iso_eau.gt.0) then  
                 call iso_verif_egalite_choix(xtsnow(iso_eau,i), &
     &               snow_avant_calving(i),'gestion_neige 1172', &
     &               errmax,errmaxrel)
                 call iso_verif_egalite_choix(xtsnow_evap(iso_eau,i), &
     &               snow_evap(i),'gestion_neige 1198', &
     &               errmax,errmaxrel)
          endif !if (iso_eau.gt.0) then
          if (iso_HDO.gt.0) then                   
             call iso_verif_aberrant_choix(xtsnow(iso_hdo,i), &
     &           snow_avant_calving(i),ridicule_snow,deltalim_snow, &
     &           'gestion_neige 2090')
          endif !if (iso_eau.gt.0) then
#ifdef ISOTRAC
!          call iso_verif_traceur(xtsnow_evap(1,i), &
!     &           'gestion neige 2146') ! attention car snow_evap parfois
!     négatif -> il ne faut pas passer dans les verifs de positivité.
          call iso_verif_traceur_justmass(xtsnow_evap(1,i), &
     &           'gestion neige 2146')
#endif          
        enddo !do i=1,knon  
#endif         
       do i=1,knon   
        if (fqcalving(i).gt.0.0) then
#ifdef ISOVERIF   
            call iso_verif_positif_strict(snow_avant_calving(i), &
     &           'calcul_iso_surf_ter 1092')
#endif            
          do ixt=1,niso
            xtsnow(ixt,i)=xtsnow(ixt,i) &
     &           /snow_avant_calving(i)*snow(i)
            fxtcalving(ixt,i)=xtsnow(ixt,i) &
     &           /snow_avant_calving(i)*fqcalving(i)
          enddo !do ixt=1,niso
        else
            do ixt=1,niso
              ! xtsnow(ixt,i) non modifié
              fxtcalving(ixt,i)=0.0
            enddo
        endif !if (fqcalving(i).gt.0.0) then

      enddo ! do i=1,knon

      
      ! bidouille anti-divergence: utile pour éviter propagation des
      ! erreurs numériques
      if ((iso_eau.gt.0).and.(bidouille_anti_divergence)) then
          do i=1,knon
            xtsnow(iso_eau,i)=snow(i)
          enddo
      endif !if ((iso_eau.gt.0).and.(bidouille_anti_divergence)) then  

      ! verif cons masse de la neige
#ifdef ISOVERIF      
        do i=1,knon
         dqdiag=min(precip_snow(i)*dtime-fq_fonte_neige(i) &
     &            -snow_evap(i)*dtime-fqcalving(i)*dtime, &
     &             snow_max-snow_prec(i))
         if (iso_verif_egalite_choix_nostop(dqdiag, &
     &           snow(i)-snow_prec(i),'ter 2128', &
     &           errmax_sol*max(snow(i),1.0),errmaxrel).eq.1) then
             write(*,*) 'calcul_iso_surf_ter 2086: bilan qsnow'
             write(*,*) 'snow(i)=',snow(i)
             write(*,*) 'snow_prec(i)=',snow_prec(i)
             write(*,*) 'precip_snow(i)*dt=',precip_snow(i)*dtime
             write(*,*) 'fq_fonte_neige(i)=',fq_fonte_neige(i)
             write(*,*) 'snow_evap(i)*dt=',snow_evap(i)*dtime
             write(*,*) 'fqcalving(i)=',fqcalving(i)*dtime
             stop
         endif
         if (snow(i).lt.snow_max) then
         do ixt=1,niso
            dqdiag=xtprecip_snow(ixt,i)*dtime-fxt_fonte_neige(ixt,i) &
     &            -xtsnow_evap(ixt,i)*dtime-fxtcalving(ixt,i)
            if (iso_verif_egalite_choix_nostop(dqdiag, &
     &           xtsnow(ixt,i)-xtsnow_prec(ixt,i),'ter 2144', &
     &           errmax_sol*max(snow(i),1.0),errmaxrel).eq.1) then
             write(*,*) 'calcul_iso_surf_ter 2101: bilan xtsnow, ixt=', &
     &           ixt
             write(*,*) 'i=',i
             write(*,*) 'snow(i)=',snow(i)
             write(*,*) 'snow_prec(i)=',snow_prec(i)
             write(*,*) 'precip_snow(i)*dt=',precip_snow(i)*dtime
             write(*,*) 'fq_fonte_neige(i)=',fq_fonte_neige(i)
             write(*,*) 'snow_evap(i)*dt=',snow_evap(i)*dtime
             write(*,*) 'fqcalving(i)=',fqcalving(i)*dtime
             write(*,*) 'xtsnow(ixt,i)=',xtsnow(ixt,i)
             write(*,*) 'xtsnow_prec(i)=',xtsnow_prec(ixt,i)
             write(*,*) 'xtprecip_snow(i)*dt=',xtprecip_snow(ixt,i) &
     &                   *dtime
             write(*,*) 'fxt_fonte_neige(i)=',fxt_fonte_neige(ixt,i)
             write(*,*) 'xtsnow_evap(i)*dt=',xtsnow_evap(ixt,i)*dtime
             write(*,*) 'fxtcalving(i)=',fxtcalving(ixt,i)
             stop
           endif    
           enddo ! do ixt=1,niso
         endif ! if (snow(i).lt.snow_max) then
      enddo !do i=1,knon      
#endif

        ! calcul de fxtfonte_neige, équivalent de fqfonte
        ! attention, il est différent de fq_fonte
        ! fqfonte=fq_fonte/dtime+terme additionel de fonte de la banquise ou de
        ! la glace
        ! cette partie est ajoutée le 31 juillet 2017
        do i=1,knon
           if (fqfonte_neige(i).gt.fq_fonte_neige(i)/dtime) then
                ! on font la banquise ou la land ice.
                fqfonte_neige_add=fqfonte_neige(i)-fq_fonte_neige(i)/dtime
                if (nisurf == is_sic) then
                  do ixt=1,niso
                     fxtfonte_neige(ixt,i)=fxt_fonte_neige(ixt,i)/dtime &
     &                  +fqfonte_neige_add*tcorr(ixt)*toce(ixt)*alpha_liq_sol(ixt)
                  enddo
                else if (nisurf == is_lic) then
                   do ixt=1,niso
                     fxtfonte_neige(ixt,i)=fxt_fonte_neige(ixt,i)/dtime &
     &                  +fqfonte_neige_add*Rland_ice(ixt,i)
                  enddo
                else     
#ifdef ISOVERIF
                   write(*,*) 'iso_routines > gestion_neige 13480: nisurf=',nisurf
                   write(*,*) 'i,dtime=',i,dtime
                   write(*,*) 'fqfonte_neige(i),fq_fonte_neige(i)=',fqfonte_neige(i),fq_fonte_neige(i)
                   stop
#endif             
                   do ixt=1,niso
                     fxtfonte_neige(ixt,i)=fxt_fonte_neige(ixt,i)/dtime &
     &                  +fqfonte_neige_add*Rdefault(ixt)
                  enddo
                endif
           else !if (fqfonte_neige(i).gt.fq_fonte_neige(i)/dtime) then
#ifdef ISOVERIF
                call iso_verif_egalite(fqfonte_neige(i),fq_fonte_neige(i)/dtime, &
     &                  'iso_routines > gestion_neige 13469')
#endif
                do ixt=1,niso
                  fxtfonte_neige(ixt,i)=fxt_fonte_neige(ixt,i)/dtime
                enddo
           endif !if (fqfonte_neige(i).gt.fq_fonte_neige(i)/dtime) then
#ifdef ISOVERIF
           if (iso_eau.gt.0) then
                call iso_verif_egalite(fqfonte_neige(i),fxtfonte_neige(iso_eau,i), &
      &                 'iso_routines > gestion_neige 13479')
           endif
#endif
        enddo ! do i=1,knon

        end subroutine gestion_neige


      ! ***** subroutines permettant de calculer les flux de surface pour
        ! les isos

        subroutine calcul_iso_surf_oce_vectall(klon, knon,t_coup, &
     &    ps,tsurf,q1lay,u1lay, v1lay, xt1lay, &
     &    evap, Roce,xtevap,h1 &
#ifdef ISOTRAC
     &    ,knindex &
#endif
     &   )

    USE isotopes_mod, ONLY: iso_eau,iso_HDO,cste_surf_cond, &
&       rh_cste_surf_cond,Rdefault,T_cste_surf_cond,iso_O17,iso_O18, &
&       ridicule_evap,tnat
#ifdef ISOVERIF
!    USE isotopes_verif_mod, ONLY: deltaDfaible, faible_evap,errmax,errmaxrel
    USE isotopes_verif_mod
#endif
#ifdef ISOTRAC
    USE isotrac_mod, ONLY: option_traceurs,izone_oce,index_zone,index_iso, &
&       bassin_map
#endif
    USE yoethf_mod_h
    USE yomcst_mod_h

    IMPLICIT NONE

    INCLUDE "FCTTRE.h"

        
        ! inputs
        integer, intent(in) :: klon,knon ! dimensions
        real, intent(in) :: ps(klon) ! surface pressure
        real, intent(in) :: tsurf(klon) ! SST
        real, intent(in) :: q1lay(klon) ! near-surface specific humidity
        real, intent(in) :: u1lay(klon), v1lay(klon) ! near surface wind
        real, intent(in) :: xt1lay(ntraciso,klon) ! isotopes in near surface water vapor
        real, intent(in) :: evap(klon) ! evaporation flux
        !real, intent(in) ::  tsurf(klon)
        real, intent(in) ::  Roce(niso,klon) ! isotopic ratio in surface ocean
        !real, intent(in) ::  dtime
        real, intent(in) ::  t_coup ! limit temperature between ice/liquid when calculating saturation humidity

        ! output
        real, intent(out) ::  xtevap(ntraciso,klon) ! isotopic evaporation flux
        real, intent(out) :: h1(klon) ! only diagnostic, not useful

        ! locals
        integer ixt
        real VSURF
        real kcin(niso,klon)
        real zqs(klon)
        real R1(niso)
        real Revap(niso)
        real zxtalphal(niso,klon), zxtalphai(niso)        
        integer i
        integer ncas_evap,ncas_noevap,ncas_rosee
        integer cas_evap(klon),cas_noevap(klon),cas_rosee(klon)
        integer icas
        real zxtalphal_tmp
#ifdef ISOVERIF
!        real deltaD,O17excess,deltaO
        integer trace_cas(klon)
!        integer iso_verif_aberrant_nostop ! juste debug
!        integer iso_verif_aberrant_o17_nostop
#endif
#ifdef ISOTRAC
        integer, DIMENSION(klon), INTENT(IN)     :: knindex
        ! locals
        integer izone_recoit  
#endif

        ! vérif préliminaire
        !write(*,*) 'calcul_iso_surf_oce 41'
#ifdef ISOVERIF
        do i=1,knon
          if (iso_eau.gt.0) then            
                 call iso_verif_egalite_choix(Roce(iso_eau,i),1.0, &
     &                  'calcul_iso_surf_oce 47',errmax,errmaxrel) 
                 call iso_verif_egalite_choix(xt1lay(iso_eau,i), &
     &                  q1lay(i),'calcul_iso_surf_oce 69', &
     &                  errmax,errmaxrel) 
           endif !if (iso_eau.gt.0) then
           if (iso_HDO.gt.0) then 
              call iso_verif_positif(deltaD(Roce(iso_HDO,i))+100.0, &
     &           'calcul_iso_surf_oce 54')
            endif !if (iso_eau.gt.0) then      

            call iso_verif_noNaN(tsurf(i),'calcul_iso_surf_ice 62')
         enddo  
#endif        

         ! parsage des cas
         ncas_evap=0
         ncas_noevap=0
         ncas_rosee=0
         do i=1,knon
          if (evap(i).gt.0.0) then
           ncas_evap=ncas_evap+1
           cas_evap(ncas_evap)=i 
#ifdef ISOVERIF
           trace_cas(i)=1
#endif
          else if (evap(i).eq.0.0) then
           ncas_noevap=ncas_noevap+1
           cas_noevap(ncas_noevap)=i
#ifdef ISOVERIF
           trace_cas(i)=2
#endif           
          else
           ncas_rosee=ncas_rosee+1
           cas_rosee(ncas_rosee)=i
#ifdef ISOVERIF
           trace_cas(i)=3
#endif           
          endif          
         enddo !do i=1,knon

        !write(*,*) 'calcul_iso_surf_oce 13703'
         ! traitement vectoriel du cas d'évaporation
         do icas=1,ncas_evap
            i=cas_evap(icas)
            !write(*,*) 'icas, i, ncas_evap=',icas, i, ncas_evap
            if (tsurf(i).lt.t_coup) then
             zqs(i)=qsats(tsurf(i))/ps(i)
#ifdef ISOVERIF             
             call iso_verif_positif(zqs(i),'calcul_iso_surf 183')
             call iso_verif_positif(0.1-zqs(i),'calcul_iso_surf 184')
#endif             
           else
             zqs(i)=qsatl(tsurf(i))/ps(i)
#ifdef ISOVERIF             
             call iso_verif_positif(zqs(i),'calcul_iso_surf 187')
             call iso_verif_positif(0.1-zqs(i),'calcul_iso_surf 188')
#endif             
           endif       
           h1(i)=q1lay(i)/zqs(i)
           h1(i)=min(1.0,max(0.0,h1(i)))
           if (cste_surf_cond.eq.2) then
               ! on suppose la température de surface constante dans le
               ! calcul des coefs de frac, pour faire un test de
               ! sensibilité
            do ixt=1,niso
              call fractcalk_liq(ixt,T_cste_surf_cond, &
     &                   zxtalphal(ixt,i)) 
            enddo
           else !if (cste_surf_cond.eq.2) then
            do ixt=1,niso
              call fractcalk_liq(ixt,tsurf(i), &
     &                   zxtalphal(ixt,i)) 
            enddo
           endif !if (cste_surf_cond.eq.2) then
            if (q1lay(i).gt.0.0) then
              do ixt=1,niso  
                R1(ixt)=xt1lay(ixt,i)/q1lay(i)
              enddo
            else
#ifdef ISOVERIF
                write(*,*) 'calcul_iso_surf 124: q1lay=',q1lay(i)
                stop
#endif
                do ixt=1,niso  
                  R1(ixt)=Rdefault(ixt)           
                enddo                
            endif
          VSURF=sqrt(u1lay(i)**2+v1lay(i)**2)
          call calcul_kcin(vsurf,kcin(1,i))   
          if (cste_surf_cond.eq.0) then
            if (h1(i).lt.0.98) then              
              do ixt=1,niso
                xtevap(ixt,i)=evap(i)* &
     &           (Roce(ixt,i)/zxtalphal(ixt,i)-h1(i)*R1(ixt)) &
     &           /(1.0-h1(i))*(1.0-kcin(ixt,i))
               enddo !do ixt=1,niso
            else !if (h1(i).lt.0.98) then
              do ixt=1,niso
                xtevap(ixt,i)=evap(i)*Roce(ixt,i)/zxtalphal(ixt,i)
              enddo
            endif !if (h1(i).lt.0.98) then
          else !if (cste_surf_cond.eq.0) then
              do ixt=1,niso
                xtevap(ixt,i)=evap(i)* &
     &           (Roce(ixt,i)/zxtalphal(ixt,i) &
     &           -rh_cste_surf_cond*R1(ixt)) &
     &           /(1.0-rh_cste_surf_cond)*(1.0-kcin(ixt,i))
              enddo !do ixt=1,niso
          endif !if (cste_surf_cond.eq.0) then

        !write(*,*) 'calcul_iso_surf_oce 13772'
        !write(*,*) 'knindex(i),klon=',knindex(i),klon
#ifdef ISOTRAC
          if ((option_traceurs.eq.3).or. &
     &           (option_traceurs.eq.20)) then 
             izone_recoit=bassin_map(knindex(i))
         else
             izone_recoit=izone_oce 
          endif     

        !write(*,*) 'calcul_iso_surf_oce 13781, izone_recoit=',izone_recoit
          do ixt=niso+1,ntraciso
            if (index_zone(ixt).eq.izone_recoit) then
               xtevap(ixt,i)=xtevap(index_iso(ixt),i)
            else
               xtevap(ixt,i)=0.0
            endif
          enddo   !do ixt=niso+1,ntraciso        
#endif      
        !write(*,*) 'calcul_iso_surf_oce 13786'    

#ifdef ISOVERIF
         do ixt=1,ntraciso
           call iso_verif_noNAN(xtevap(ixt,i), &
     &           'calcul_iso_surf_oce 3038, sur océan')
         enddo       
#endif          
#ifdef ISOVERIF
          if (iso_eau.gt.0) then
              call iso_verif_egalite_choix(xtevap(iso_eau,i),evap(i), &
     &           'calcul_iso_surf_oce 3309: sur ocean', &
     &            errmax,errmaxrel)
          endif !if (iso_eau.gt.0) then
          if (iso_HDO.gt.0) then    
           if (abs(evap(i)).gt.ridicule_evap) then
             if (iso_verif_aberrant_nostop(xtevap(iso_HDO,i)/evap(i), &
     &           'calcul_iso_surf_oce 3308: sur ocean').eq.1) then
               write(*,*) 'h1(i),kcin(iso_HDO,i)=',h1(i),kcin(iso_HDO,i)
               write(*,*) 'deltaD(R1)=',deltaD(R1(iso_HDO))
               write(*,*) 'deltaD(Roce/alpha)=', &
     &               deltaD(Roce(iso_HDO,i)/zxtalphal(iso_HDO,i))
               ! si deltaD vap très faible, c'est normale d'avoir deltaD
               ! très fort dans l'évap
               if ((evap(i).gt.faible_evap).and. &
     &                   (deltaD(R1(iso_HDO)).gt.deltaDfaible)) then
                 stop
               endif
             endif
           endif !if (abs(evap(i)).gt.ridicule_evap) then
           if ((xtevap(iso_HDO,i)/evap(i).lt.R1(iso_HDO)-20.0) &
     &           .and.(evap(i).gt.ridicule_evap)) then
               write(*,*) 'calcul_iso_surf_oce 106, i=',i
               write(*,*) 'deltaDevap=', &
     &           deltaD(xtevap(iso_HDO,i)/evap(i))
               write(*,*) 'deltaDv1=',deltaD(R1(iso_HDO))
               write(*,*) 'tsurf, kcin(iso_HDO,i)=',tsurf(i)-273.5,  &
     &                   kcin(iso_HDO,i)
               write(*,*) 'deltaD(Roce/alpha)=', &
     &                   deltaD(Roce(iso_HDO,i)/zxtalphal(iso_HDO,i))
               write(*,*) 'h1(i),evap(i)=',h1(i),evap(i)
               stop
           endif ! if (xtevap(iso_HDO,i)/evap(i).lt.R1(iso_HDO)) then
          endif  !if (iso_HDO.gt.0) then 
          if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
            if (abs(evap(i)).gt.ridicule_evap) then
                if (iso_verif_aberrant_o17_nostop(xtevap(iso_O17,i) &
     &           /evap(i),xtevap(iso_O18,i) &
     &           /evap(i),'calcul_iso_surf > oce 232').eq.1) then
                  write(*,*) 'deltaO18,O17excess v1=',deltaO( &
     &                   R1(iso_O18)),O17excess( &
     &                   R1(iso_O17),R1(iso_O18))
                  write(*,*) 'tsurf, kcin(iso_O17,i)=', &
     &                   tsurf(i)-273.5, kcin(iso_O17,i)
                  write(*,*) 'deltaO18,O17excess(Roce/alpha)=', &
     &                   deltaO(Roce(iso_O18,i)/zxtalphal(iso_O18,i)), &
     &                   O17excess(Roce(iso_O17,i)/zxtalphal(iso_O17,i), &
     &                           Roce(iso_O18,i)/zxtalphal(iso_O18,i))
                  write(*,*) 'h1(i),evap(i)=',h1(i),evap(i)
                  if (xtevap(iso_O18,i)/evap(i).lt.tnat(iso_O18)) then
                     stop
                  endif
                endif !if (iso_verif_aberrant_o17_nostop(xtevap(iso_O17,i)
            endif !if (abs(evap(i)).gt.ridicule_evap) then
          endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
#ifdef ISOTRAC
          call iso_verif_traceur_justmass(xtevap(1,i), &
     &           'calcul_iso_surf_oce 213')
#endif          
#endif
        !write(*,*) 'calcul_iso_surf_oce 13858'

         enddo !do icas_evap=1,ncas_evap

        !write(*,*) 'calcul_iso_surf_oce 13859'
        ! traitement vectoriel du cas pas d'évap
        do icas=1,ncas_noevap
          i=cas_noevap(icas)
          do ixt=1,ntraciso
            xtevap(ixt,i)=0.0
          enddo !do ixt=1,niso
        enddo !do icas_evap=1,ncas_evap

        !write(*,*) 'calcul_iso_surf_oce 13868'
        ! traitement vectoriel du cas rosée
        do icas=1,ncas_rosee
          i=cas_rosee(icas)          
          call iso_rosee_givre(xt1lay,q1lay,tsurf,t_coup,evap,i,  &
     &            xtevap,klon)
          ! traceurs d'eau et d'isos mis directement dans iso_rosee_givre      
        enddo !do icas_evap=1,ncas_evap
        
        
        !write(*,*) 'calcul_iso_surf_oce tmp 13876'
#ifdef ISOVERIF
        do i=1,knon
           if (iso_eau.gt.0) then  
              call iso_verif_egalite_choix(xtevap(iso_eau,i),evap(i), &
     &                  'calcul_iso_surf_oce 115',errmax,errmaxrel)
           endif !if (iso_eau.gt.0) then
           if (iso_HDO.gt.0) then  
              if (evap(i).gt.ridicule_evap) then 
                if (deltaD(R1(iso_HDO)).gt.200.0) then   
                call iso_verif_aberrant(xtevap(iso_HDO,i)/evap(i), &
     &                  'calcul_iso_surf_oce 119')
                endif
              endif  !if (evap.gt.ridicule_evap) then   
           endif !if (iso_eau.gt.0) then
        enddo !do i=1,knon
!        write(*,*) 'calcul_iso_surf 274: stop temporaire'
!        stop
#endif


        return
        end subroutine calcul_iso_surf_oce_vectall

        !*****************************


        subroutine calcul_iso_surf_sic_vectall(klon,knon,  &
     &           evap,snow_evap,tsurf,Roce,snow,  &
     &           fq_fonte_neige,fqfonte_neige,dtime, t_coup, &
     &           precip_snow,xtprecip_snow,xtprecip_rain, snow_prec,xtsnow_prec,  &
     &           xt1lay,q1lay,ps,   &
     &           xtevap,xtsnow,fqcalving, &
     &           knindex,nisurf,run_off_lic_diag,coeff_rel_diag,Rland_ice &
     &   )

    USE isotopes_mod, ONLY: tcorr, toce, alpha_liq_sol,ridicule_evap, &
        iso_eau,iso_HDO
USE fonte_neige_mod, ONLY: gestion_neige_besoin_varglob_fonte_neige
#ifdef ISOVERIF
!        use isotopes_verif_mod, ONLY: deltalim, errmax, errmaxrel
    USE isotopes_verif_mod
#endif     
#ifdef ISOTRAC
    USE isotrac_mod, ONLY: izone_poubelle,index_iso,index_zone, &
&       option_traceurs,izone_oce,izone_oce, &
&       bassin_map
#endif
        implicit none

        ! inputs
        integer, intent(in) :: klon,knon
        real, intent(in) :: snow(klon),snow_prec(klon)
        real, intent(inout) :: xtsnow(niso,klon)
        real, intent(in) :: xtsnow_prec(niso,klon)
        real, intent(in) :: precip_snow(klon),xtprecip_snow(ntraciso,klon),xtprecip_rain(ntraciso,klon)
        real, intent(in) :: evap(klon), snow_evap(klon)
        real, intent(in) ::  fq_fonte_neige(klon)
        real, intent(in) ::  fqfonte_neige(klon)
        real, intent(in) :: xt1lay(ntraciso,klon),ps(klon),q1lay(klon)
        real, intent(in) :: tsurf(klon)
        real, intent(in) :: Roce(niso,klon)
        real, intent(in) :: dtime
        real, intent(in) :: t_coup
        real, intent(in) :: fqcalving(klon)
    INTEGER, INTENT(IN)                  :: nisurf
    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
    real, DIMENSION(klon), INTENT(IN) :: run_off_lic_diag
    real, INTENT(IN) :: coeff_rel_diag
    REAL, DIMENSION(niso,klon), INTENT(IN)        :: Rland_ice

        ! output
        real, intent(out) :: xtevap(ntraciso,klon)

        ! locals
        real fxtfonte_neige(niso,klon)
        real fxt_fonte_neige(niso,klon)
        real fxtcalving(niso,klon)
!        real zxtalphals
        real sol_evap(klon)
        real xtsol_evap(ntraciso,klon)
        real xtsnow_evap(ntraciso,klon)
        integer i,ixt
        integer ncas_evap,ncas_noevap,ncas_rosee
        integer cas_evap(klon),cas_noevap(klon),cas_rosee(klon)
        integer icas        
#ifdef ISOVERIF
!        real deltaD
        integer trace_cas(klon)
!        integer iso_verif_egalite_nostop
#endif        
#ifdef ISOTRAC
        ! locals
        integer izone_recoit
#endif   

#ifdef ISOVERIF
        do i=1,knon
         do ixt=1,ntraciso
           call iso_verif_noNaN(xtprecip_snow(ixt,i), &
     &           'calcul_iso_surf 365')
         enddo
        enddo
#endif        
        ! gestion de la neige
        call gestion_neige(klon,knon,snow,xtsnow, &
     &           snow_prec,xtsnow_prec,dtime, &
     &           precip_snow,xtprecip_snow,xtprecip_rain,fq_fonte_neige,fqfonte_neige, &
     &           fqcalving,snow_evap,xtsnow_evap,fxt_fonte_neige,fxtfonte_neige,fxtcalving, &
     &           xt1lay,q1lay,tsurf,t_coup,nisurf,Rland_ice) 
        call gestion_neige_besoin_varglob_fonte_neige(klon,knon, &
     &           xtprecip_snow,xtprecip_rain, &
     &           fxtfonte_neige,fxtcalving, &
     &           knindex,nisurf,run_off_lic_diag,coeff_rel_diag)

#ifdef ISOVERIF
       if (iso_eau.gt.0) then  
        do i=1,knon
          call iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i),  &
     &         'calcul_iso_surf_sic_vectall 363',errmax,errmaxrel)
        enddo
      endif
#endif             

      ! les traceurs d'isotopes sont déjà dans gestion neige
      ! on suppose que l'évaporation de la neige est taggée "continent"
      ! en fait, il n'y a pas de neige sur sea-ice de toutes façon.
        
       do i=1,knon  
         sol_evap(i)=evap(i)-snow_evap(i)
       enddo !do i=1,knon  

        ! parsage des cas
         ncas_evap=0
         ncas_noevap=0
         ncas_rosee=0
         do i=1,knon
         ! modif 2 octobre 2008
         ! c'est sol_evap plutot que evap
!          if (evap(i).gt.0.0) then
         if (sol_evap(i).gt.0.0) then
           ncas_evap=ncas_evap+1
           cas_evap(ncas_evap)=i 
#ifdef ISOVERIF
           trace_cas(i)=1
#endif
          else if (sol_evap(i).eq.0.0) then
           ncas_noevap=ncas_noevap+1
           cas_noevap(ncas_noevap)=i
#ifdef ISOVERIF
           trace_cas(i)=2
#endif           
          else
           ncas_rosee=ncas_rosee+1
           cas_rosee(ncas_rosee)=i
#ifdef ISOVERIF
           trace_cas(i)=3
#endif           
          endif          
         enddo !do i=1,knon
   

        ! traitement vectoriel du cas d'évaporation
         do icas=1,ncas_evap
            i=cas_evap(icas)   
            do ixt=1,niso       
!          call fractcalk_liq_sol(ixt,tsurf(i),zxtalphals)
!             xtsol_evap(ixt,i)=sol_evap(i)*Roce(ixt,i)
!     :           *alpha_liq_sol(ixt)
            ! non car Roce n'est lu que sur les océans et par sur les
            ! zones de sea ice
               xtsol_evap(ixt,i)=sol_evap(i)*tcorr(ixt)*toce(ixt) &
     &           *alpha_liq_sol(ixt) 
            enddo !do ixt=1,niso 

#ifdef ISOTRAC
          if (option_traceurs.eq.3) then  
            izone_recoit=izone_poubelle
          else if (option_traceurs.eq.3) then  
              izone_recoit=bassin_map(knindex(i))
          else
            izone_recoit=izone_oce
          endif            

          do ixt=niso+1,ntraciso
            if (index_zone(ixt).eq.izone_recoit) then
             xtsol_evap(ixt,i)=xtsol_evap(index_iso(ixt),i)
            else
                xtsol_evap(ixt,i)=0.0
            endif
          enddo

#endif            
#ifdef ISOVERIF
          if (iso_HDO.gt.0) then
              if (deltaD(xtsol_evap(iso_HDO,i)/sol_evap(i)).lt.0.0) then
                write(*,*) 'calcul_iso_surf_lic 255'
                write(*,*) 'sol_evap(i),xtsol_evap(iso_HDO,i)=', &
     &               sol_evap(i),xtsol_evap(iso_HDO,i) 
                stop  
              endif
              call iso_verif_egalite_choix(deltaD &
     &          (xtsol_evap(iso_HDO,i)/sol_evap(i)),25.2847, &
     &           'calcul_iso_surf_sic 398',0.5,0.5)
          endif
#endif 
#ifdef ISOVERIF
         do ixt=1,niso
          call iso_verif_noNaN(xtsol_evap(ixt,i), &
     &           'calcul_iso_surf_lic 142')
         enddo !do ixt=1,niso
#endif          
        enddo !!do icas_evap=1,ncas_evap


        ! traitement vectoriel du cas pas d'évap
!#ifdef ISOVERIF
!        write(*,*) 'calcul_iso_surf_sic 455: pas d''evap'
!#endif
        do icas=1,ncas_noevap
          i=cas_noevap(icas)
          do ixt=1,ntraciso
          xtsol_evap(ixt,i)=0.0
          enddo !do ixt=1,niso
        enddo !do icas_evap=1,ncas_evap

        ! traitement vectoriel du cas rosée
!#ifdef ISOVERIF
!        write(*,*) 'calcul_iso_surf_sic 465: cas rosee'
!#endif
        do icas=1,ncas_rosee
          i=cas_rosee(icas)         
        ! evap<0 -> on condense.
        !write(*,*) 'calcul_iso_surf_oce 3176: on condense: evap(i)=',evap(i)
          call iso_rosee_givre(xt1lay,q1lay,tsurf, &
     &            t_coup,sol_evap,i,xtsol_evap,klon) 
#ifdef ISOVERIF  
        if (iso_HDO.gt.0) then
            call iso_verif_aberrant_choix(-xtsol_evap(iso_HDO,i), &
     &           sol_evap(i),ridicule_evap,deltalim_snow, &
     &           'calcul_iso_surf_sic 257_sol_evap')
        endif
#endif            
          
        enddo !do icas=1,ncas_rosee

        do i=1,knon
          do ixt=1,ntraciso
            xtevap(ixt,i)=xtsol_evap(ixt,i)+xtsnow_evap(ixt,i)
          enddo !do ixt=1,niso
        enddo

        ! verif
#ifdef ISOVERIF
        do i=1,knon
              if (iso_eau.gt.0) then  
                 call iso_verif_egalite_choix(xtevap(iso_eau,i),evap(i), &
     &                  'calcul_iso_surf_sic 248',errmax,errmaxrel)
              endif !if (iso_eau.gt.0) then
              if (iso_HDO.gt.0) then
                   call iso_verif_aberrant_choix(xtevap(iso_HDO,i),evap(i), &
     &                  ridicule_evap,deltalim_snow,'calcul_iso_surf_sic 257_evap')
              endif !if (iso_eau.gt.0) then
#ifdef ISOTRAC
           call iso_verif_tracnps(xtevap(1,i), &
     &          'calcul_iso_surf_sic 431')
#endif              
           enddo  
!        write(*,*) 'calcul_iso_surf_sic 507: sortie'    
#endif   
           ! end verif


      return
      end subroutine calcul_iso_surf_sic_vectall


      !*****************************


        subroutine calcul_iso_surf_lic_vectall(klon,knon,  &
     &           evap,snow_evap,tsurf,snow,  &
     &           fq_fonte_neige,fqfonte_neige,dtime, t_coup,  &
     &           precip_snow,xtprecip_snow,precip_rain,xtprecip_rain, snow_prec,xtsnow_prec,  &
     &           xt1lay,q1lay,ps,Rland_ice, &
     &           xtevap,xtsnow,fqcalving, &
     &           knindex,nisurf,run_off_lic_diag,coeff_rel_diag &
     &   )

    USE isotopes_mod, ONLY: h_land_ice, ridicule,ridicule_snow,ridicule_evap, &
        iso_eau,iso_HDO,iso_O18
USE fonte_neige_mod, ONLY: gestion_neige_besoin_varglob_fonte_neige
#ifdef ISOVERIF
!    USE isotopes_verif_mod, ONLY: deltalim_snow, errmax, errmaxrel,deltalim
    USE isotopes_verif_mod
#endif
#ifdef ISOTRAC
    USE isotrac_mod, ONLY: index_zone,index_iso, option_traceurs,izone_cont, &
&       bassin_map
#endif
        implicit none

        ! inputs
        integer klon,knon
        real snow(klon),snow_prec(klon)
        real xtsnow(niso,klon),xtsnow_prec(niso,klon)
        real precip_snow(klon),xtprecip_snow(ntraciso,klon)
        real xtprecip_rain(ntraciso,klon),precip_rain(klon)
        real evap(klon), snow_evap(klon)
        real fq_fonte_neige(klon)
        real fqfonte_neige(klon)
        real xt1lay(ntraciso,klon),ps(klon),q1lay(klon)
        real, intent(in) :: tsurf(klon)
        real Rland_ice(niso,klon)
!        real run_off_lic_0(klon)
        real dtime
        real t_coup
        real fqcalving(klon)
    INTEGER, INTENT(IN)                  :: nisurf
    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
    real, DIMENSION(klon), INTENT(IN) :: run_off_lic_diag
    real, INTENT(IN) :: coeff_rel_diag

        ! output
        real xtevap(ntraciso,klon)
!        real xtrun_off_lic_0(niso,klon)

        ! locals
        real fxt_fonte_neige(niso,klon)
        real fxtfonte_neige(niso,klon)
        real fxtcalving(niso,klon)
        real sol_evap(klon)
        real xtsol_evap(ntraciso,klon)
        real xtsnow_evap(ntraciso,klon)
        integer i,ixt,j
        integer ncas_evap,ncas_noevap,ncas_rosee
        integer cas_evap(klon),cas_noevap(klon),cas_rosee(klon)
        integer icas
#ifdef ISOVERIF        
        integer trace_cas(klon)
!        real deltaD 
!        integer iso_verif_positif_strict_nostop
        real Rland_ice_prec(niso,klon)
!        integer iso_verif_egalite_choix_nostop
#endif
#ifdef ISOTRAC
        ! locals
        integer izone_recoit
#endif        
!        real mair ! masse d'air en kg concernée par rosée

#ifdef ISOVERIF
        write(*,*) 'calcul_iso_surf_lic 306'
        do i=1,knon
         do ixt=1,ntraciso
           call iso_verif_noNaN(xtprecip_snow(ixt,i), &
     &           'calcul_iso_surf 609')
         enddo
        enddo
#endif   
        ! initialisation:
        xtevap=0.
!        xtrun_off_lic_0=0.

! gestion de la neige
        call gestion_neige(klon,knon,snow,xtsnow, &
     &           snow_prec,xtsnow_prec,dtime, &
     &           precip_snow,xtprecip_snow,xtprecip_rain,fq_fonte_neige,fqfonte_neige, &
     &           fqcalving,snow_evap,xtsnow_evap,fxt_fonte_neige,fxtfonte_neige,fxtcalving, &
     &           xt1lay,q1lay,tsurf,t_coup,nisurf,Rland_ice)
        ! les traceurs d'isotopes sont déjà dans gestion neige
      ! on suppose que l'évaporation de la neige est taggée "continent"
        call gestion_neige_besoin_varglob_fonte_neige(klon,knon, &
     &           xtprecip_snow,xtprecip_rain, &
     &           fxtfonte_neige,fxtcalving, &
     &           knindex,nisurf,run_off_lic_diag,coeff_rel_diag)

        ! on incorpore la composition neige à celle du glacier
        ! on suppose que l'épaisseur caractéristique du glacier est hland_ice
       do i=1,knon
#ifdef ISOVERIF
        do ixt=1,niso
          Rland_ice_prec(ixt,i)=Rland_ice(ixt,i)
        enddo !do ixt=1,niso
#endif        
        if (precip_snow(i).gt.ridicule) then
           do ixt=1,niso
              Rland_ice(ixt,i)=(h_land_ice*Rland_ice(ixt,i) &
     &           +xtprecip_snow(ixt,i)*dtime)/ &
     &           (h_land_ice+precip_snow(i)*dtime)
           enddo     
        endif
        enddo !do i=1,knon

#ifdef ISOVERIF     
        ! vérifier que Rland_ice a bien été modifié. A l'état initiale,
            ! Rland_ice vaut -150 permil pour le deltaD
        if (iso_HDO.gt.0) then
        do i=1,knon        
        if (precip_snow(i).gt.1e-5) then
           if (abs(deltaD(xtprecip_snow(iso_hdo,i)/precip_snow(i)) &
     &                   +150).gt.5.0) then
           if (iso_verif_positif_strict_nostop &
     &           (abs(deltaD(Rland_ice(iso_hdo,i))+150.0)  &
     &         -1e-6,'calcul_iso_surf_lic 565').eq.1) then
              write(*,*) 'calcul_iso_surf_lic 575 tmp: i=',i
              write(*,*) 'h_land_ice,precip_snow(i)*dtime=' , &
     &             h_land_ice,precip_snow(i)*dtime
              write(*,*) 'deltaDsnow=',deltaD(xtprecip_snow(iso_hdo,i) &
     &                   /precip_snow(i))
              write(*,*) 'deltaDland_ice=',deltaD(Rland_ice(iso_hdo,i))
              write(*,*) 'deltaDland_ice_prec=',deltaD( &
     &           Rland_ice_prec(iso_hdo,i))
!             stop
           endif
           endif
        endif !if (precip_snow(i).gt.0.0) then        
        enddo !do i=1,knon
        endif !if (iso_HDO.gt.0) then
            
        do i=1,knon
        if (iso_eau.gt.0) then
          call iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i),  &
     &         'calcul_iso_surf_lic_vectall 587a',errmax,errmaxrel)
        endif
        if (iso_HDO.gt.0) then
          call iso_verif_aberrant_choix(xtsnow(iso_HDO,i), &
     &               snow(i),ridicule_snow,deltalim_snow, &
     &               'calcul_iso_surf_lic 587b')
        endif
        enddo !do i=1,knon
#endif             
        
       do i=1,knon  
         sol_evap(i)=evap(i)-snow_evap(i)
       enddo !do i=1,knon   

      ! évaporation du sol

        ! parsage des cas
         ncas_evap=0
         ncas_noevap=0
         ncas_rosee=0
         do i=1,knon
!          if (evap(i).gt.0.0) then
           if (sol_evap(i).gt.0.0) then
               ! modif le 2 octobre 2008: c'est le signe de sol_evap qui
               ! doit être important ici
           ncas_evap=ncas_evap+1
           cas_evap(ncas_evap)=i 
#ifdef ISOVERIF
           trace_cas(i)=1
#endif
!          else if (evap(i).eq.0.0) then
           else if (sol_evap(i).eq.0.0) then
           ncas_noevap=ncas_noevap+1
           cas_noevap(ncas_noevap)=i
#ifdef ISOVERIF
           trace_cas(i)=2
#endif           
          else
           ncas_rosee=ncas_rosee+1
           cas_rosee(ncas_rosee)=i
#ifdef ISOVERIF
           trace_cas(i)=3
#endif           
          endif          
         enddo !do i=1,knon


        ! traitement vectoriel du cas d'évaporation
         do icas=1,ncas_evap
            i=cas_evap(icas)  
              
#ifdef ISOVERIF
              if (iso_eau.gt.0) then  
               call iso_verif_egalite_choix(Rland_ice(iso_eau,i),1.0, &
     &                  'calcul_iso_surf_lic 740',errmax,errmaxrel)
              endif !if (iso_eau.gt.0) then  
#endif
          do ixt=1,niso       
            xtsol_evap(ixt,i)=sol_evap(i)*Rland_ice(ixt,i)   
          enddo !do ixt=1,niso  

#ifdef ISOTRAC
        if (option_traceurs.eq.20) then
            izone_recoit=bassin_map(knindex(i))
        else
            izone_recoit=izone_cont
        endif

        do ixt=niso+1,ntraciso
            if (index_zone(ixt).eq.izone_recoit) then
               xtsol_evap(ixt,i)=xtsol_evap(index_iso(ixt),i)
            else
               xtsol_evap(ixt,i)=0.0
            endif
        enddo 
#endif          

#ifdef ISOVERIF
              if (iso_eau.gt.0) then  
               call iso_verif_egalite_choix(sol_evap(i), &
     &           xtsol_evap(iso_eau,i), &
     &           'calcul_iso_surf_lic 365',errmax,errmaxrel)
              endif !if (iso_eau.gt.0) then  
#endif 

        enddo !!do icas_evap=1,ncas_evap


        ! traitement vectoriel du cas pas d'évap
        do icas=1,ncas_noevap
          i=cas_noevap(icas)
          do ixt=1,ntraciso
            xtsol_evap(ixt,i)=0.0
          enddo !do ixt=1,niso

        enddo !do icas_evap=1,ncas_evap

        ! traitement vectoriel du cas rosée
        do icas=1,ncas_rosee
          i=cas_rosee(icas)        
        ! evap<0 -> on condense.
        !write(*,*) 'calcul_iso_surf_oce 3176: on condense: evap(i)=',evap(i)
!        write(*,*) 'calcul_iso_surf_lic 391: dtime=',dtime
!          Mair=100*100/9.8
          call iso_rosee_givre(xt1lay,q1lay,tsurf,t_coup,sol_evap,i, &
     &            xtsol_evap,klon) 

#ifdef ISOVERIF
              if (iso_eau.gt.0) then  
               call iso_verif_egalite_choix(sol_evap(i), &
     &           xtsol_evap(iso_eau,i), &
     &           'calcul_iso_surf_lic 365',errmax,errmaxrel)
              endif !if (iso_eau.gt.0) then
              if (iso_HDO.gt.0) then 
                  call iso_verif_aberrant_choix(-xtsol_evap(iso_hdo,i), &
     &             -sol_evap(i),ridicule_evap,deltalim, &
     &              'calcul_iso_surf_lic 747')
              endif !if (iso_eau.gt.0) then  
#endif   
        enddo  !do icas=1,ncas_rosee

        ! fin du calcul de xtsol_evap

        do i=1,knon
         do ixt=1,ntraciso
           xtevap(ixt,i)=xtsol_evap(ixt,i)+xtsnow_evap(ixt,i)
         enddo
        enddo !do i=1,knon
!        do i=1,knon
!        j = knindex(i)
!         do ixt=1,niso
!           xtrun_off_lic_0(ixt,j)=run_off_lic_0(j)*Rland_ice(ixt,i) ! peu importe
!         enddo !do ixt=1,niso
!#ifdef ISOVERIF
!        if (iso_eau.gt.0) then  
!         if ((j.eq.291).or.(j.eq.231).or.(j.eq.418).or. &
!     &                 (j.eq.38).or.(j.eq.60)) then
!           write(*,*) 'calcul_iso_surf 776 tmp& i,j,klon,knon,', &
!     &           'run_off_lic_0,xt=',i,j,klon,knon,       &
!     &           run_off_lic_0(j),xtrun_off_lic_0(iso_eau,j)
!         endif
!        endif
!#endif
!        enddo !do i=1,knon

        ! verif
#ifdef ISOVERIF
        do i=1,knon
              if (iso_eau.gt.0) then  
                 call iso_verif_egalite_choix(evap(i),xtevap(iso_eau,i), &
     &                  'calcul_iso_surf_lic 361',errmax,errmaxrel)
                 call iso_verif_egalite_choix(snow(i),xtsnow(iso_eau,i), &
     &                  'calcul_iso_surf_lic 363',errmax,errmaxrel)  
              endif !if (iso_eau.gt.0) then
              if (iso_HDO.gt.0) then   
                call iso_verif_aberrant_choix(xtsnow(iso_HDO,i), &
     &               snow(i),ridicule_snow,deltalim_snow, &
     &               'calcul_iso_surf_lic 797') 
                call iso_verif_aberrant_choix(xtevap(iso_HDO,i),evap(i), &
     &                  ridicule_evap,deltalim_snow, 'calcul_iso_surf_lic 369')
              endif !if (iso_eau.gt.0) then
#ifdef ISOTRAC
           call iso_verif_tracnps(xtevap(1,i), &
     &          'calcul_iso_surf_lic 723')
#endif               
          enddo !do i=1,knon 
!          if (iso_eau.gt.0) then  
!            do i=1,klon 
!             if (iso_verif_egalite_choix_nostop(run_off_lic_0(i), &
!     &         xtrun_off_lic_0(iso_eau,i),'calcul_iso_surf_lic 783', &
!     &         errmax,errmaxrel).eq.1) then
!               write(*,*) 'i,knon,klon=',i,knon,klon
!               stop
!             endif
!            enddo !do i=1,klon 
!          endif ! if (iso_eau.gt.0) then 
! déjà vérifié dans gestion_neige
#endif


        return
        end subroutine calcul_iso_surf_lic_vectall



!*****************************


        subroutine calcul_iso_surf_ter_vectall(klon,knon, &
     &           evap,snow_evap,snow,  &
     &           fq_fonte_neige,fqfonte_neige,dtime, precip_rain,xtprecip_rain, &
     &           precip_snow,xtprecip_snow, snow_prec,xtsnow_prec,  &
     &           tsurf,xt1lay,ps,q1lay,t_coup,u1lay,v1lay,p1lay, &
     &           qsol,xtsol,qsol_prec,xtsol_prec, &
     &           max_eau_sol,            &
     &           xtevap,xtsnow,h1,run_off,xtrun_off,fqcalving, &
     &           knindex,nisurf,run_off_lic_diag,coeff_rel_diag,Rland_ice &
     &   )

USE isotopes_mod, ONLY: tdifrel,tdifexp_sol, iso_eau, iso_HDO, &
&       bidouille_anti_divergence,ruissellement_pluie, Rdefault,Kd, &
&       ridicule_rain,tnat, iso_O18,evap_cont_cste,alphak_stewart, &
&       deltaP_BL,iso_O18,iso_O17,deltaO18_evap_cont,d_evap_cont, &
&       iso_HTO, ridicule_qsol, ridicule, ridicule_snow,P_veg,  &
&       ridicule_evap
USE fonte_neige_mod, ONLY: gestion_neige_besoin_varglob_fonte_neige
#ifdef ISOVERIF
!USE isotopes_verif_mod, ONLY: errmax,errmaxrel,errmax_sol,deltalim_snow, &
!        faccond
USE isotopes_verif_mod
#endif
#ifdef ISOTRAC
    USE isotrac_mod, ONLY: index_zone,index_iso,option_traceurs,izone_cont, &
&       bassin_map
#endif

USE yoethf_mod_h
        USE dimensions_mod, ONLY: iim, jjm, llm, ndm
USE paramet_mod_h
USE yomcst_mod_h

IMPLICIT NONE

INCLUDE "FCTTRE.h"

!
!
        
        ! inputs
        integer klon,knon
        real snow(klon),snow_prec(klon)
        real xtsnow(niso,klon),xtsnow_prec(niso,klon)
        real precip_snow(klon),xtprecip_snow(ntraciso,klon)
        real precip_rain(klon),xtprecip_rain(ntraciso,klon)
        real qsol(klon),qsol_prec(klon) ! hauteur d'eau, en mm.
        real xtsol(niso,klon),xtsol_prec(niso,klon)
        real evap(klon), snow_evap(klon)
        real fq_fonte_neige(klon)
        real fqfonte_neige(klon)
        real xt1lay(ntraciso,klon),q1lay(klon)
        real u1lay(klon),v1lay(klon)
        real p1lay(klon)
        real ps(klon)
        real, intent(in) :: tsurf(klon)
        real dtime
        real t_coup
        real max_eau_sol
        real run_off(klon)
        real fqcalving(klon)
    INTEGER, INTENT(IN)                  :: nisurf
    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
    REAL, DIMENSION(klon), INTENT(IN) :: run_off_lic_diag
    REAL, INTENT(IN) :: coeff_rel_diag
    REAL, DIMENSION(niso,klon), INTENT(IN)        :: Rland_ice
        

        ! output
        real xtevap(ntraciso,klon)
        real xtrun_off(niso,klon)     

        ! locals
        real sol_evap(klon)
        real xtsol_evap(ntraciso,klon)
        real xtnu(niso,klon)
        real L
        real xtsnow_evap(ntraciso,klon)
        real qsol_avant_evap(klon), &
     &          xtsol_avant_evap(niso,klon)
        real fxt_fonte_neige(niso,klon)
        real fxtfonte_neige(niso,klon)
        real fxtcalving(niso,klon)
        real VSURF
        real kcin(niso)
        real alphak(niso)
!        integer alphak_stewart
!        parameter (alphak_stewart=1)
                ! si 1: alphak=(D/Diso)^nsol
                ! si 0: alphak=1/(1-kcin(vsurf))
             ! 31 aout: ce param est maintenant dans wateriso
!        real tdifexp_sol
!        parameter (tdifexp_sol=0.8)
                ! tdifexp_sol est l'exposant de D/Diso. Il paramétrise
                ! la turbulence. D'abitude, il est de 0.58. Mais d'après
                ! Mathieu et Bariac, il est entre 0.67 et 1: 0.67 pour
                ! les sols secs et 1 pour les sols saturés.
               ! 31 aout: ce param est maintenant dans wateriso 
        real h1(klon)
        real zqs(klon)
        real R1(niso)
        real Revap(niso)
        real zxtalphal(niso), zxtalphai(niso)        
        real qevap(klon)
        real q10 ! humidité 1ère couche en mm
        real rowl ! densité eau en kg/m3
        parameter (rowl=1000.0)
        real Pveg
        integer i,ixt,j
        real Rsol_new(niso), Rsol(niso)
        real qsol_avant_deversement(klon)

        ! qu'est-ce qui ruisselle?
!        integer ruissellement_pluie
!        parameter (ruissellement_pluie=0)
                ! si 1: c'est la pluie qui ruisselle. elle ne s'infiltre
                ! donc jamais dans un sol saturé.
                ! si 0: c'est le sol qui ruisselle. La pluie s'inglitre
                ! donc dans le sol saturé.
           ! 31 aout: ce param est maintenant dans wateriso    
        real precip_rain_eff(klon),fq_fonte_neige_eff(klon)
        real sol_evap_eff(klon)
        real xtsol_evap_eff(niso,klon)
        real xtprecip_rain_eff(niso,klon), &
     &          fxt_fonte_neige_eff(niso,klon)
        integer ncas_evap,ncas_noevap,ncas_rosee
        integer cas_evap(klon),cas_noevap(klon),cas_rosee(klon)
        integer icas
        real runoff_tmp(knon)
#ifdef ISOVERIF
        integer trace_cas(klon)
!        integer iso_verif_aberrant_nostop ! juste debug
!        integer iso_verif_aberrant_O17_nostop ! juste debug
!        integer iso_verif_aberrant_choix_nostop
!        integer iso_verif_egalite_choix_nostop
!        integer iso_verif_positif_nostop
!        integer iso_verif_egalite_nostop
!        integer iso_verif_positif_choix_nostop
!        real deltaD,o17excess
        real dqdiag
#endif       
!#ifdef ISOVERIF
!        integer iso_verif_noNaN_nostop
!#endif       
#ifdef ISOTRAC
        ! locals   
        integer izone_recoit
#endif

#ifdef ISOVERIF   
!      write(*,*) 'calcul_iso_surf_ter 494'
      do i=1,knon         
        if (iso_eau.gt.0) then  
           call iso_verif_egalite_choix( &
     &               xtsnow_prec(iso_eau,i), &
     &               snow_prec(i),'calcul_iso_surf_ter 1019',& 
     &               errmax,errmaxrel)
           call iso_verif_egalite_choix( &
     &               xtprecip_snow(iso_eau,i), &
     &               precip_snow(i),'calcul_iso_surf_ter 1023', &
     &               errmax,errmaxrel)
         endif !if (iso_eau.gt.0) then
         do ixt=1,ntraciso
           call iso_verif_noNaN(xtprecip_snow(ixt,i), &
     &           'calcul_iso_surf 1025')
         enddo
        enddo
#endif   

        ! gestion de la neige
        call gestion_neige(klon,knon,snow,xtsnow, &
     &           snow_prec,xtsnow_prec,dtime, &
     &           precip_snow,xtprecip_snow,xtprecip_rain,fq_fonte_neige,fqfonte_neige, &
     &           fqcalving,snow_evap,xtsnow_evap,fxt_fonte_neige,fxtfonte_neige,fxtcalving,& 
     &           xt1lay,q1lay,tsurf,t_coup,nisurf,Rland_ice)   
        ! les traceurs d'isotopes sont déjà dans gestion neige
        ! on suppose que l'évaporation de la neige est taggée "continent"
      
        call gestion_neige_besoin_varglob_fonte_neige(klon,knon, &
     &           xtprecip_snow,xtprecip_rain, &
     &           fxtfonte_neige,fxtcalving, &
     &           knindex,nisurf,run_off_lic_diag,coeff_rel_diag)

       ! calcul de la partition entre snow_evap et sol_evap
       do i=1,knon   
         sol_evap(i)=evap(i)-snow_evap(i)
       enddo !do i=1,knon
        
        ! bilan du sol avant evap
        ! verif    
#ifdef ISOVERIF
      do i=1,knon         
      do ixt=1,niso
        call iso_verif_noNaN(xtsol_prec(ixt,i),'surf_ter 974')
      enddo
      enddo
#endif      
#ifdef ISOVERIF
!        write(*,*) 'calcul_iso_surf_ter 910'
        do i=1,knon
          if (iso_eau.gt.0) then
            call iso_verif_egalite_choix(qsol_prec(i), &
     &          xtsol_prec(iso_eau,i),'calcul_iso_surf_ter 504', &
     &          errmax,errmaxrel)
            call iso_verif_egalite_choix( &
     &               xtsnow(iso_eau,i),snow(i),  &
     &               'calcul_iso_surf_tic_vectall 964', &
     &               errmax,errmaxrel)
          endif          
          if (iso_HDO.gt.0) then
           if (qsol_prec(i).gt.ridicule_qsol*1e2) then
            call iso_verif_aberrant(xtsol_prec(iso_HDO,i)/ &
     &            qsol_prec(i)/faccond,'calcul_iso_surf_ter 506')
           endif  !if (qsol_prec(i).gt.ridicule_qsol) 
          endif !if (iso_eau.gt.0) then
          if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
            if (qsol_prec(i).gt.ridicule_qsol) then
              call iso_verif_aberrant_o17(xtsol_prec(iso_O17,i) &
     &           /qsol_prec(i),xtsol_prec(iso_O18,i) &
     &           /qsol_prec(i),'iso_surf_ter 1035')
            endif !if ((qsol_prec(i).gt.ridicule).and.(xtsol_prec(iso_O18,i)
          endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
       enddo !do i=1,knon
#endif
#ifdef ISOVERIF
        do i=1,knon
         do ixt=1,niso
          call iso_verif_noNaN(xtsol_prec(ixt,i), &
     &           'iso_surf_ter 1061')
         enddo !do ixt=1,niso
       enddo !do i=1,knon
#endif     
        ! end verif


      do i=1,knon 

        ! flux efficaces, en tenant compte du ruissellement  
        precip_rain_eff(i)=precip_rain(i)
        fq_fonte_neige_eff(i)=fq_fonte_neige(i)
        sol_evap_eff(i)=sol_evap(i)
        do ixt=1,niso
          xtprecip_rain_eff(ixt,i)=max(xtprecip_rain(ixt,i),0.0)
          fxt_fonte_neige_eff(ixt,i)=fxt_fonte_neige(ixt,i)
        enddo
#ifdef ISOVERIF
        call iso_verif_positif(precip_rain(i),'calcul_iso_surf_ter 655')
        call iso_verif_positif(fq_fonte_neige(i), &
     &                   'calcul_iso_surf_ter 656')
        call iso_verif_positif(max_eau_sol-qsol_prec(i), &
     &           'calcul_iso_surf_ter 882')
        if (iso_eau.gt.0) then
          call iso_verif_positif(xtprecip_rain(iso_eau,i), &
     &           'calcul_iso_surf_ter 655b')
        endif
#endif        
      enddo !do i=1,knon    
              
        !write(*,*) 'surf_ter 14041'
        if (ruissellement_pluie.eq.1) then   
          do i=1,knon
             ! c'est la pluie que l'on fait ruisseller
!             write(*,*) ''
!             write(*,*) 'calcul_iso_surf_ter 676, tmp:'
!             write(*,*) 'qsol,qsol_prec',qsol(i),qsol_prec(i)
!             write(*,*) 'precip_rain*dtime=',precip_rain(i)*dtime
!             write(*,*) 'sol_evap*dtime=',sol_evap(i)*dtime
!             write(*,*) 'fq_fonte_neige=',fq_fonte_neige(i)
!             write(*,*) 'max_eau_sol=',max_eau_sol
             do ixt=1,niso
               xtrun_off(ixt,i)=0.0               
             enddo
             runoff_tmp(i)=0.0
             if (qsol_prec(i) &
     &           +(precip_rain(i)-sol_evap(i))*dtime &
     &           +fq_fonte_neige(i).gt.max_eau_sol) then
                ! ça déborde
                ! on réduit l'infiltration de la pluie:
                precip_rain_eff(i)=min(sol_evap(i) &
     &            +(max_eau_sol-qsol_prec(i)-fq_fonte_neige(i))/dtime, &
     &             precip_rain(i)) 
                if (precip_rain_eff(i).lt.0.0) then
                       ! ça déborderait même sans pluie
                    ! on réduit donc la fonte
                    precip_rain_eff(i)=0.0
                    fq_fonte_neige_eff(i)=min(sol_evap(i)*dtime &
     &                   +max_eau_sol-qsol_prec(i),fq_fonte_neige(i))  
                    if (fq_fonte_neige_eff(i).lt.0.0) then
                      ! ca déborderait même sans precip ni fonte car il
                      ! y a de la rosée
#ifdef ISOVERIF                      
                      call iso_verif_positif(-sol_evap(i), &
     &                   'calcul_iso_surf_ter 912')
#endif                      
                      fq_fonte_neige_eff(i)=0.0
                      sol_evap_eff(i)=(qsol_prec(i)-max_eau_sol)/dtime
                    endif !if (fq_fonte_neige_eff(i).lt.0.0) then   
                  endif !if (precip_rain_eff(i).lt.0.0) then      
            endif !if (qsol_prec(i)

#ifdef ISOVERIF    
!            write(*,*) 'calcul_iso_surf_ter 706 tmp:'     
!            write(*,*) 'precip_rain_eff(i)*dtime=',
!     :           precip_rain_eff(i)*dtime
!            write(*,*) 'fq_fonte_neige_eff(i)*dtime=',
!     :           fq_fonte_neige_eff(i)*dtime
!            write(*,*) 'sol_evap(i)*dtime=',    
!     :           sol_evap(i)*dtime
!            write(*,*) 'sol_evap_eff(i)*dtime=',    
!     :           sol_evap_eff(i)*dtime
!            write(*,*) 'max_eau_sol,qsol_prec(i)=',    
!     :           max_eau_sol,qsol_prec(i)
            call iso_verif_positif_choix(max_eau_sol- &
     &           (qsol_prec(i)+ &
     &           (precip_rain_eff(i)-sol_evap_eff(i)*dtime &
     &           +fq_fonte_neige_eff(i))),ridicule_qsol*10, &
     &           'calcul iso_surf_ter 669')
            ! 12 mai 2009: ridicule_qsol*10 car erreurs nums en 32 bits
            call iso_verif_positif((fq_fonte_neige_eff(i)), &
     &           'calcul iso_surf_ter 702')
            call iso_verif_positif((precip_rain_eff(i)), &
     &           'calcul iso_surf_ter 703')
            if (sol_evap(i).ge.0.0) then
                call iso_verif_egalite_choix( &
     &             sol_evap(i), &
     &             (sol_evap_eff(i)), &
     &             'calcul iso_surf_ter 724',errmax,errmaxrel)
            endif
#endif  
            ! pour les isostopes:
            if (abs(precip_rain(i)-precip_rain_eff(i)) &
     &           .gt.ridicule*1e-2) then
             ! *  pour precip_rain_eff:            
             if (precip_rain_eff(i).gt.ridicule_rain) then 
               if (precip_rain(i).gt.ridicule_rain) then 
                do ixt=1,niso
                  xtprecip_rain_eff(ixt,i)=xtprecip_rain(ixt,i) &
     &                   /precip_rain(i)*precip_rain_eff(i)
                enddo 
               else !if (precip_rain(i).gt.ridicule_rain) then 
                  write(*,*) 'calcul_iso_surf_ter 723'
                  stop
               endif !if (precip_rain(i).gt.ridicule_rain) then 
             else !if (precip_rain_eff(i).gt.ridicule_rain) then 
                do ixt=1,niso
                  xtprecip_rain_eff(ixt,i)=0.0
                enddo
                if ((bidouille_anti_divergence).and. &
     &           (iso_eau.gt.0))  then
                  xtprecip_rain_eff(iso_eau,i)=precip_rain_eff(i)
                endif
             endif !if (precip_rain_eff(i).gt.ridicule_rain) then 
             runoff_tmp(i)=runoff_tmp(i) &
     &           +(precip_rain(i)-precip_rain_eff(i))*dtime
             do ixt=1,niso
               xtrun_off(ixt,i)=xtrun_off(ixt,i) &
     &            +(xtprecip_rain(ixt,i)-xtprecip_rain_eff(ixt,i))*dtime
             enddo
            endif !if (abs(precip_rain(i)-precip_rain_eff(i)).gt.ridicule) then
           
#ifdef ISOVERIF            
            if (iso_eau.gt.0) then  
              call iso_verif_egalite_choix( &
     &           runoff_tmp(i),xtrun_off(iso_eau,i), &
     &           'calcul_iso_surf_ter 1142', &
     &           errmax,errmaxrel)
            endif !if (iso_eau.gt.0) then  
#endif   

            if (abs(fq_fonte_neige_eff(i)-fq_fonte_neige(i)) &
     &           .gt.ridicule) then
             ! *  pour fq_fonte_neige_eff:
             if (fq_fonte_neige_eff(i).gt.ridicule_rain) then 
               if (fq_fonte_neige(i).gt.ridicule_rain) then 
                do ixt=1,niso
                  fxt_fonte_neige_eff(ixt,i)=fxt_fonte_neige(ixt,i) &
     &                    /fq_fonte_neige(i)*fq_fonte_neige_eff(i)
                enddo 
               else !if (fq_fonte_neige(i).gt.ridicule_rain) then 
                  write(*,*) 'calcul_iso_surf_ter 723'
                  stop
               endif !if (fq_fonte_neige(i).gt.ridicule_rain) then 
             else !if (fq_fonte_neige_eff(i).gt.ridicule_rain) then 
                do ixt=1,niso
                  fxt_fonte_neige_eff(ixt,i)=0.0
                enddo
             endif !if (fq_fonte_neige_eff(i).gt.ridicule_rain) then 
             runoff_tmp(i)=runoff_tmp(i) &
     &           +(fq_fonte_neige(i)-fq_fonte_neige_eff(i))
             do ixt=1,niso
               xtrun_off(ixt,i)=xtrun_off(ixt,i) &
     &            +(fxt_fonte_neige(ixt,i)-fxt_fonte_neige_eff(ixt,i))
             enddo
           endif !if (abs(fq_fonte_neige_eff(i)-fq_fonte_neige(i))

#ifdef ISOVERIF            
            if (iso_eau.gt.0) then    
              call iso_verif_egalite_choix(( &
     &           fq_fonte_neige_eff(i)), &
     &           (fxt_fonte_neige_eff(iso_eau,i)), &
     &           'calcul_iso_surf_ter 705', &
     &           errmax,errmaxrel)
              call iso_verif_egalite_choix( &
     &           (precip_rain_eff(i)), &
     &           (xtprecip_rain_eff(iso_eau,i)), &
     &           'calcul_iso_surf_ter 711', &
     &           errmax,errmaxrel)
              call iso_verif_egalite_choix( &
     &           runoff_tmp(i),xtrun_off(iso_eau,i), &
     &           'calcul_iso_surf_ter 1179', &
     &           errmax,errmaxrel)
            endif
#endif    
          enddo !do i=1,knon   
        endif   !if (ruissellement_pluie) then

        ! on ajoute les flux entrants dans le sol
        ! attention, c'est facile si qsol>=0.
        ! mais par contre, si qsol<0, on est obligé de mettre
        ! Rsol=Rflux_entrants, sinon on a des aberrances.
        ! la conservation de la masse d'iso dans le sol ne sera donc pas
        ! vérifiée... Donc prudence!
       do i=1,knon  
        qsol_avant_evap(i)=qsol_prec(i) &
     &        +precip_rain_eff(i)*dtime+fq_fonte_neige_eff(i)
       enddo !do i=1,knon 
       do i=1,knon
        if (qsol_prec(i).ge.0.0) then            
          do ixt=1,niso
           xtsol_avant_evap(ixt,i)=xtsol_prec(ixt,i) &
     &        +xtprecip_rain_eff(ixt,i)*dtime+fxt_fonte_neige_eff(ixt,i)
          enddo !do ixt=1,niso
        else !if (qsol_prec(i).ge.0.0) then  
            if (precip_rain_eff(i)*dtime+fq_fonte_neige_eff(i) &
     &           .gt.ridicule_qsol) then  
              do ixt=1,niso
               xtsol_avant_evap(ixt,i)=qsol_avant_evap(i)* &
     &        (xtprecip_rain_eff(ixt,i)*dtime+fxt_fonte_neige_eff(ixt,i)) &
     &         /(precip_rain_eff(i)*dtime+fq_fonte_neige_eff(i))
              enddo !do ixt=1,niso  
            else
                ! il n'y a pas de flux entrants
                ! on a donc qsol_avant_evap(i)=qsol_prec(i)
                do ixt=1,niso
                 xtsol_avant_evap(ixt,i)=xtsol_prec(ixt,i)
                enddo !do ixt=1,niso
            endif
        endif !if (qsol_prec(i).ge.0.0) then 
       enddo !do i=1,knon  

        ! verif
#ifdef ISOVERIF
      do i=1,knon         
      do ixt=1,niso
        if (iso_verif_noNaN_nostop(( &
     &    xtsol_avant_evap(ixt,i)),'surf_ter 1239').eq.1) then
          write(*,*) 'qsol_prec(i)=',qsol_prec(i)
          write(*,*) 'xtsol_prec(ixt,i)=',xtsol_prec(ixt,i)
          write(*,*) 'xtprecip_rain_eff(ixt,i)=', &
     &          xtprecip_rain_eff(ixt,i)
          write(*,*) 'fxt_fonte_neige_eff(ixt,i)=', &
     &          fxt_fonte_neige_eff(ixt,i)
          write(*,*) 'precip_rain_eff(i)=',precip_rain_eff(i)
          write(*,*) 'fq_fonte_neige_eff(i)=',fq_fonte_neige_eff(i)
          write(*,*) 'qsol_avant_evap(i)=',qsol_avant_evap(i)
          write(*,*) 'xtsol_avant_evap(ixt,i)=',xtsol_avant_evap(ixt,i)
          write(*,*) 'dtime=',dtime
          stop
        endif
      enddo
      enddo
#endif      
#ifdef ISOVERIF
        do i=1,knon
          if (iso_eau.gt.0) then
!            write(*,*) 'qsol_prec=',qsol_prec(i)
!            write(*,*) 'xtsol_prec=',xtsol_prec(iso_eau,i)
!            write(*,*) 'precip_rain_eff=',precip_rain_eff(i)
!            write(*,*) 'fq_fonte_neige_eff=',fq_fonte_neige_eff(i)
!            write(*,*) 'qsol_avant_evap=',qsol_avant_evap(i)
!            write(*,*) 'xtsol_avant_evap=',xtsol_avant_evap(iso_eau,i) 
!            write(*,*) 'xtprecip_rain_eff=',xtprecip_rain_eff(iso_eau,i)
!            write(*,*) 'fxt_fonte_neige_eff=',
!     :                   fxt_fonte_neige_eff(iso_eau,i)
            call iso_verif_egalite_choix( &
     &           (qsol_avant_evap(i)), &
     &            (xtsol_avant_evap(iso_eau,i)), &
     &           'calcul_iso_surf_ter 527',errmax,errmaxrel)
          endif          
          if (iso_HDO.gt.0) then
           if (qsol_avant_evap(i).gt.ridicule_qsol*1e2) then   
             if (iso_verif_aberrant_nostop(( &
     &           xtsol_avant_evap(iso_HDO,i)/qsol_avant_evap(i)) &
     &           /faccond,'calcul_iso_surf_ter 5032').eq.1) then
               write(*,*) 'qsol_avant_evap(i)=',qsol_avant_evap(i)
               write(*,*) 'ridicule_qsol=',ridicule_qsol
               write(*,*) 'qsol_prec(i)=',qsol_prec(i)
               write(*,*) 'precip_rain_eff(i)*dtime=', &
     &           precip_rain_eff(i)*dtime
               write(*,*) 'fq_fonte_neige_eff(i)=',fq_fonte_neige_eff(i)
               write(*,*) 'deltaD_sol_prec=', &
     &           deltaD(xtsol_prec(iso_HDO,i)/qsol_prec(i))
               write(*,*) 'deltaDprecip_rain_eff=',& 
     &           deltaD(( &
     &           xtprecip_rain_eff(iso_HDO,i)/precip_rain_eff(i)))
               write(*,*) 'deltaD_finte_neige_eff=', &
     &           deltaD(( &
     &           fxt_fonte_neige_eff(iso_HDO,i)/fq_fonte_neige_eff(i)))
               write(*,*) 'precip_rain(i)*dtime=', &
     &           precip_rain(i)*dtime
               write(*,*) 'fq_fonte_neige(i)=',fq_fonte_neige(i)
               stop
             endif !if (iso_verif_aberrant_nostop(
           endif ! if ( qsol_avant_evap(i).gt.ridicule_qsol)  
          endif !if (iso_eau.gt.0) then
          if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
            if (qsol_avant_evap(i).gt.ridicule_qsol) then
              call iso_verif_aberrant_o17(( &
     &           xtsol_avant_evap(iso_O17,i)/qsol_avant_evap(i)), &
     &           (xtsol_avant_evap(iso_O18,i) &
     &           /qsol_avant_evap(i)),'iso_surf_ter 1263')
            endif !if ((qsol_prec(i).gt.ridicule).and.(xtsol_prec(iso_O18,i)
          endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
        enddo !do i=1,knon   
#endif
        ! end verif
        
        do i=1,knon
        qsol_avant_deversement(i)=qsol_avant_evap(i) &
     &                   -sol_evap_eff(i)*dtime
        enddo !do i=1,knon 

        ! verif du bilan du sol
#ifdef ISOVERIF       
!        write(*,*) 'calcul_iso_surf_ter 1200'
        do i=1,knon      
            call iso_verif_egalite_choix(min(( &
     &         qsol_avant_deversement(i)),max_eau_sol), &
     &          qsol(i), &
     &         'calcul_iso_surf_ter 587',errmax,errmaxrel)
           if (ruissellement_pluie.eq.1) then
             if (iso_verif_positif_choix_nostop( &
     &           max_eau_sol-(qsol_avant_deversement(i)), &
     &           ridicule_qsol,'calcul_iso_surf_ter 843').eq.1) then
               write(*,*) 'qsol_avant_evap(i)=',qsol_avant_evap(i)
               write(*,*) 'qsol_avant_deversement(i)=', &
     &           qsol_avant_deversement(i)
               write(*,*) 'sol_evap_eff(i)*dtime=',sol_evap_eff(i)*dtime
               stop
             endif
           endif
         enddo ! do i=1,knon    
#endif

          ! parsage des cas
         ncas_evap=0
         ncas_noevap=0
         ncas_rosee=0
         do i=1,knon
         ! modif 2 octobre! sol_evap au lie de evap
         ! modif 5 oct: gt au lieu de ge.
          if (sol_evap(i).gt.0.0) then
           ncas_evap=ncas_evap+1
           cas_evap(ncas_evap)=i 
#ifdef ISOVERIF
           trace_cas(i)=1
#endif
          else if (sol_evap(i).lt.0.0) then
           ncas_rosee=ncas_rosee+1
           cas_rosee(ncas_rosee)=i
#ifdef ISOVERIF
           trace_cas(i)=3
#endif           
          else !if (sol_evap(i).gt.0.0) then
           ncas_noevap=ncas_noevap+1
           cas_noevap(ncas_noevap)=i
#ifdef ISOVERIF
           trace_cas(i)=2
#endif
          endif !if (sol_evap(i).gt.0.0) then       
         enddo !do i=1,knon

        ! évaporation du sol:        
        ! traitement vectoriel du cas d'évaporation
        ! calcul longueur de diffusion
         L=1e3*sqrt(dtime*Kd) ! en mm
         do icas=1,ncas_evap
            i=cas_evap(icas)   
          
          ! verif du sol
#ifdef ISOVERIF
              do ixt=1,niso
                call iso_verif_noNAN(xtsol(ixt,i), &
     &                   'calcul_iso_surf_ter 2960')
              enddo !do ixt=1,niso
#endif           
#ifdef ISOVERIF
!              write(*,*) 'calcul_iso_surf_ter 767: i,sol_evap=',
!     :           i,sol_evap(i)
!              write(*,*) 'xtsol_avant_evap,qsol_avant_evap=',
!     :           xtsol_avant_evap(iso_eau,i),qsol_avant_evap(i) 
          if  (iso_verif_egalite_nostop(sol_evap(i), &
     &         (sol_evap_eff(i)), &
     &          'calcul_iso_surf_ter 1100').eq.1) then
            write(*,*) 'calcul_iso_surf_ter 543: qsol(',i,')=',qsol(i)
            write(*,*) 'qsol_avant_evap(',i,')=',qsol_avant_evap(i)
            write(*,*) 'sol_evap(',i,')*dtime=',sol_evap(i)*dtime
            write(*,*) 'qsol_prec(',i,')=',qsol_prec(i)
            write(*,*) 'precip_rain(',i,')*dtime=',precip_rain(i)*dtime
            write(*,*) 'fq_fonte_neige(',i,')=',fq_fonte_neige(i)
            stop
            endif 
              if (iso_eau.gt.0) then
                call iso_verif_egalite_choix(( &
     &           xtsol_avant_evap(iso_eau,i)) &
     &                  ,(qsol_avant_evap(i)), &
     &           'calcul_iso_surf_ter 2952', &
     &                   errmax,errmaxrel)
                if (qsol_avant_evap(i).gt.ridicule_qsol) then
                  if (iso_verif_egalite_choix_nostop(( &
     &              xtsol_avant_evap(iso_eau,i)/qsol_avant_evap(i)), &
     &              1.0,'calcul_iso_surf_ter 2952', &
     &              errmax,errmaxrel*10).eq.1) then 
                      write(*,*) 'xtsol_avant_evap(iso_eau,i)=', &
     &                   xtsol_avant_evap(iso_eau,i)       
                      write(*,*) 'qsol_avant_evap(i)=', &
     &                   qsol_avant_evap(i)   
                      write(*,*) 'xtsol_prec(iso_eau,i)=', &
     &                   xtsol_prec(iso_eau,i)       
                      write(*,*) 'qsol_prec(i)=', &
     &                   qsol_prec(i)       
                      write(*,*) 'xtprecip_rain_eff(iso_eau,i)=', &
     &                   xtprecip_rain_eff(iso_eau,i)  
                      write(*,*) 'precip_rain_eff(i)=',& 
     &                   precip_rain_eff(i)
                      write(*,*) 'fxt_fonte_neige_eff(iso_eau,i)=', &
     &                   fxt_fonte_neige_eff(iso_eau,i)         
                      write(*,*) 'fq_fonte_neige_eff(i)=', &
     &                   fq_fonte_neige_eff(i)     
                      stop                 
                  endif !if (iso_verif_egalite_choix(
                endif !if (qsol(i).gt.ridicule_qsol) then
              endif !if (iso_eau.gt.0) then  
              if (iso_HDO.gt.0) then  
                if (qsol_avant_evap(i).gt.ridicule_qsol*1e2) then
                  call iso_verif_aberrant(( &
     &           xtsol_avant_evap(iso_HDO,i)/qsol_avant_evap(i)) &
     &                  /faccond ,'calcul_iso_surf_ter 3181')
                endif !if (qsol(i).gt.ridicule_qsol) then
              endif  !if (iso_HDO.gt.0) then
              if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
               if (qsol_avant_evap(i).gt.ridicule_qsol) then
                   call iso_verif_aberrant_o17(( &
     &              xtsol_avant_evap(iso_O17,i)/qsol_avant_evap(i)), &
     &              (xtsol_avant_evap(iso_O18,i) &
     &              /qsol_avant_evap(i)),'iso_surf_ter 1390')
                endif !if ((qsol_prec(i).gt.ridicule).and.(xtsol_prec(iso_O18,i)
              endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then  
#endif
           ! end verif du sol
       
       ! calcul de h1
       if (tsurf(i).lt.t_coup) then
           zqs(i)=qsats(tsurf(i))/ps(i)
#ifdef ISOVERIF            
           call iso_verif_positif(zqs(i),'calcul_iso_surf 1183')
           call iso_verif_positif(0.1-zqs(i),'calcul_iso_surf 1184')
#endif           
       else
           zqs(i)=qsatl(tsurf(i))/ps(i)
#ifdef ISOVERIF            
           call iso_verif_positif(zqs(i),'calcul_iso_surf 1187')   
           if (iso_verif_positif_nostop(0.15-zqs(i),& 
     &            'calcul_iso_surf 1188').eq.1) then
                write(*,*) 'tsurf(i)=',tsurf(i)-t_coup,'°C'
                if (tsurf(i)-t_coup.lt.50.0) then
                   stop
                endif
           endif
#endif           
       endif       
       h1(i)=q1lay(i)/zqs(i)
       h1(i)=min(1.0,max(0.0,h1(i)))

       ! calcul de Rsol
       call calcul_Rsol(qsol_avant_evap, &
     &         sol_evap,xtsol_avant_evap, &
     &         xt1lay, q1lay,tsurf, i,Rsol,klon)       
       
#ifdef ISOVERIF
         do ixt=1,niso
            call iso_verif_noNAN(Rsol(ixt), &
     &                   'calcul_iso_surf_ter 3217, sur terre')
         enddo !do ixt=1,niso
#endif  
#ifdef ISOVERIF       
         if (iso_eau.gt.0) then
          call iso_verif_egalite_choix(Rsol(iso_eau),1.0, &
     &           'calcul_iso_surf_ter 700',errmax*10,errmaxrel*10)
         endif !if (iso_eau.gt.0) then
         if ((iso_HDO.gt.0).and. &
     &           (qsol_avant_evap(i).gt.ridicule_qsol*1e2)) then     
          call iso_verif_aberrant(Rsol(iso_HDO)/faccond, &
     &           'calcul_iso_surf_ter 703')
         endif
         if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
            if (qsol_avant_evap(i).gt.ridicule_qsol) then
              call iso_verif_aberrant_o17(Rsol(iso_o17),Rsol(iso_o18), &
     &           'iso_surf_ter 1447')
            endif !if ((qsol_prec(i).gt.ridicule).and.(xtsol_prec(iso_O18,i)
          endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
#endif
        if ((bidouille_anti_divergence).and. &
     &           (iso_eau.gt.0))  then
            Rsol(iso_eau)=1.0
        endif


        ! CALCUL de R1
             
#ifdef ISOVERIF
          do ixt=1,niso
                call iso_verif_noNAN(xt1lay(ixt,i), &
     &                  'calcul_iso_surf_ter 3222')
                call iso_verif_noNAN(q1lay(i), &
     &                   'calcul_iso_surf_ter 3223')
          enddo   
#endif
          if (q1lay(i).gt.0.0) then
              do ixt=1,niso  
                R1(ixt)=xt1lay(ixt,i)/q1lay(i)
              enddo
          else
#ifdef ISOVERIF              
              write(*,*) 'calcul_iso_surf 1415: q1lay=',q1lay(i)
              stop  
#endif              
              do ixt=1,niso  
                R1(ixt)=Rdefault(ixt)              
              enddo  
           endif

           ! calcul humidité de la couche 1, en mm
           ! cela servira en cas de réévaporation en h=1, pour éviter
           ! instabilités.
           ! deltaP=2.0*(ps(i)-p1lay(i))
!            q10=1.0e3*2.0*(ps(i)-p1lay(i))*q1lay(i)/rowl/RG
           q10=1.0e3*deltaP_BL*q1lay(i)/rowl/RG
           ! modif 31 aout 2008


#ifdef ISOVERIF
           do ixt=1,niso
             call iso_verif_noNAN(R1(ixt), &
     &          'calcul_iso_surf_ter 3227, sur terre')   
           enddo !do ixt=1,niso
#endif

         ! calcul de l'évap
         if (alphak_stewart.eq.1) then
             ! calcul de alphak en accord avec stewart, mathieu et
             ! Bariac
            do ixt=1,niso
             alphak(ixt)=tdifrel(ixt)**tdifexp_sol
            enddo !do ixt=1,niso 
        else
            ! calcul de alphak comme une surfacae ouvert, fonction du
            ! vent
            VSURF=sqrt(u1lay(i)**2+v1lay(i)**2)
            call calcul_kcin(vsurf,kcin) 
            do ixt=1,niso
              alphak(ixt)=1.0/(1-kcin(ixt))
            enddo !do ixt=1,niso   
        endif            
         
         qevap(i)=sol_evap(i)*dtime ! quantité d'eau du sol perdue par evap
         if (tsurf(i).gt.t_coup) then
             ! Pveg est la fraction d'eau évaporée sans fractionnement
             Pveg=P_veg
         else !if (tsurf(i).gt.t_coup) then
             ! à 0°C, on sublime, donc on révap tout sans fractionnement
             Pveg=1.0
         endif !if (tsurf(i).gt.t_coup) then

         ! calcul de ce que donnerait l'évap du sol nu
         
#ifdef ISOVERIF         
         if (P_veg.eq.1.0) then
         call iso_verif_egalite(Pveg,1.0,'calcul_iso_surf_ter 1314')
        endif
#endif         
        if (Pveg.gt.1.0-1e-3) then
            do ixt=1,niso
              xtnu(ixt,i)=0.0
            enddo
        else
         call iso_evap_sol_nu((qsol_avant_evap(i)), &
     &           qevap(i),q10,Rsol,R1,h1(i), &
     &      tsurf(i),alphak, L, xtnu(1,i),Pveg)  
#ifdef ISOVERIF
         if (iso_eau.gt.0) then        
           call iso_verif_egalite_choix(xtnu(iso_eau,i),qevap(i),& 
     &           'calcul_iso_surf_ter 1253',errmax,errmaxrel)
         endif
         if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
            if (qevap(i).gt.ridicule_evap) then
              call iso_verif_aberrant_o17(xtnu(iso_O17,i) &
     &           /qevap(i),xtnu(iso_O18,i)/qevap(i), &
     &           'iso_surf_ter 1623')
          endif !if (qevap(i).gt.ridicule_evap) then
        endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then

#endif                  
        endif     
!         call iso_evap_sol((qsol_avant_evap(i)),
!     &           qevap,Pveg,Rsol,R1,h1(i),
!     &      tsurf(i),alphak, Rsol_new,Revap)

         ! bilan de masse
         do ixt=1,niso         
!            xtsol_evap(ixt,i)=sol_evap(i)*Revap(ixt)
!            xtsol(ixt,i)=qsol_avant_deversement(i)*Rsol_new(ixt)
            xtsol_evap(ixt,i)=(1.0-Pveg)*xtnu(ixt,i) &
     &          +Pveg*Rsol(ixt)*qevap(i) ! mm
            xtsol(ixt,i)=xtsol_avant_evap(ixt,i)-xtsol_evap(ixt,i) ! mm
            xtsol_evap(ixt,i)=xtsol_evap(ixt,i)/dtime ! mm/s
         enddo !do ixt=1,niso

         if (evap_cont_cste.eq.1) then
             ! on fixe la compo de l'évap continentale
             if (iso_eau.gt.0) then
                 xtsol_evap(iso_eau,i)=sol_evap(i)
             endif
             if (iso_O18.gt.0) then
                 xtsol_evap(iso_O18,i)=sol_evap(i) &
     &             *(deltaO18_evap_cont/1000.+1.)*tnat(iso_O18)
             endif
             if (iso_HDO.gt.0) then 
                 xtsol_evap(iso_HDO,i)=sol_evap(i) &
     &            *((d_evap_cont+8*deltaO18_evap_cont)/1000.+1.) &
     &            *tnat(iso_HDO)
             endif
             if (iso_O17.gt.0) then
                 xtsol_evap(iso_O17,i)=0.0
             endif
             if (iso_HTO.gt.0) then
                 xtsol_evap(iso_HTO,i)=0.0
             endif
         endif

#ifdef ISOTRAC
        if (option_traceurs.eq.20) then
           izone_recoit=bassin_map(knindex(i))
        else
           izone_recoit=izone_cont
        endif

        do ixt=niso+1,ntraciso
           if (index_zone(ixt).eq.izone_recoit) then
             xtsol_evap(ixt,i)=xtsol_evap(index_iso(ixt),i)
           else
             xtsol_evap(ixt,i)=0.0
           endif
        enddo !do ixt=niso+1,ntraciso
#endif         
         

         ! verif
#ifdef ISOVERIF
           do ixt=1,niso
             call iso_verif_noNAN(xtsol_evap(ixt,i), &
     &               'calcul_iso_surf_ter 3002, sur terre')
             call iso_verif_noNAN(xtsol(ixt,i), &
     &           'calcul_iso_surf_ter 680')
           enddo !do ixt=1,niso
#endif           
#ifdef ISOVERIF
           if (iso_eau.gt.0) then 
             call iso_verif_egalite_choix( &
     &           xtsol_evap(iso_eau,i), &
     &           sol_evap(i), &
     &           'calcul_iso_surf_ter 741',errmax,errmaxrel)
             call iso_verif_egalite_choix(xtsol(iso_eau,i), &
     &           (qsol_avant_deversement(i)), &
     &           'calcul_iso_surf_ter 2976',errmax,errmaxrel)
           endif !if (iso_eau.gt.0) then  
           if (iso_HDO.gt.0) then
             if (abs(sol_evap(i)).gt.ridicule_evap) then
              if (iso_verif_aberrant_nostop( &
     &           xtsol_evap(iso_HDO,i)/sol_evap(i), &
     &           'calcul_iso_surf_ter 3273: sur terre').eq.1) then  
!                   write(*,*) 'deltaDsol=',deltaD(Rsol(ixt))
                   ! on ne plante que si ca donne lieu à des valeurs
                   ! aberrante de deltaD1
                   write(*,*) 'deltaD1new=',deltaD( &
     &                   (xtsol_evap(iso_hdo,i)*dtime+q10*R1(iso_hdo)) &
     &                   /(sol_evap(i)*dtime+q10))
                   call iso_verif_aberrant( &
     &                   (xtsol_evap(iso_hdo,i)*dtime+q10*R1(iso_hdo)) &
     &                   /(sol_evap(i)*dtime+q10), &
     &                  'calcul_iso_surf_ter 1390')
              endif  !if (iso_verif_aberrant  
             endif !if (abs(evap(i)).gt.ridicule_rain*1e-2) then
             if (iso_verif_aberrant_choix_nostop(xtsol_evap(iso_HDO,i), &
     &           sol_evap(i),ridicule,1e5, &
     &           'calcul_iso_surf_ter 1403').eq.1) then
                call iso_verif_aberrant( &
     &                   (xtsol_evap(iso_hdo,i)*dtime+q10*R1(iso_hdo)) &
     &                   /(sol_evap(i)*dtime+q10), &
     &                  'calcul_iso_surf_ter 1390')
              endif
              if (qsol_avant_deversement(i).gt.ridicule_qsol*1e2) then
                if (iso_verif_aberrant_nostop(xtsol(iso_HDO,i)& 
     &                   /(qsol_avant_deversement(i)) &
     &                 /faccond, 'calcul_iso_surf_ter 1542').eq.1) then
                  write(*,*) 'i, qsol(i)=',i, qsol(i)
                  write(*,*) 'qsol_avant_evap,qevap,L=', &
     &                   qsol_avant_evap(i),qevap(i),L
                  write(*,*) 'deltaDsol_avant_evap',deltaD( &
     &                 (xtsol_avant_evap(iso_HDO,i) &
     &                  /qsol_avant_evap(i)))
                  write(*,*) 'deltaDRsol=',deltaD(Rsol(iso_HDO))
                  write(*,*) 'deltaDsol_evap=',deltaD( &
     &                 xtnu(iso_HDO,i)/qevap(i))
                  write(*,*) 'h1(i),f=',h1(i),max((min(L, &
     &                   (qsol_avant_evap(i)))-qevap(i)) &
     &                   /min(L,(qsol_avant_evap(i))),0.0)
                  stop
                endif
              endif !if (qsol(i).gt.ridicule_qsol) then
           endif  !if (iso_HDO.gt.0) then 
           if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
             if (qevap(i).gt.ridicule_evap) then 
               call iso_verif_aberrant_o17(xtnu(iso_O17,i) &
     &           /qevap(i),xtnu(iso_O18,i)/qevap(i), &
     &           'iso_surf_ter 1626')   
            endif 
            if (sol_evap(i).gt.ridicule_evap) then 
               call iso_verif_aberrant_o17(xtsol_evap(iso_O17,i) &
     &           /sol_evap(i),xtsol_evap(iso_O18,i)/sol_evap(i), &
     &           'iso_surf_ter 1631')   
            endif
            if (qsol(i).gt.ridicule_qsol) then               
              if (iso_verif_aberrant_o17_nostop(xtsol(iso_O17,i) &
     &           /(qsol_avant_deversement(i)), &
     &           xtsol(iso_O18,i) &
     &           /(qsol_avant_deversement(i)), &
     &           'iso_surf_ter 1623').eq.1) then
                  write(*,*) 'i, qsol(i)=',i,qsol_avant_deversement(i)
                  write(*,*) 'qsol_avant_evap,qevap,L=', &
     &                   qsol_avant_evap(i),qevap(i),L
                  write(*,*) 'o17excess_sol_avant_evap',o17excess( &
     &                 (xtsol_avant_evap(iso_o17,i) &
     &                  /qsol_avant_evap(i)),( &
     &                  xtsol_avant_evap(iso_o18,i)/qsol_avant_evap(i)))
                  write(*,*) 'o17excess_sol_evap=',o17excess( &
     &               xtsol_evap(iso_o17,i)/sol_evap(i), &
     &               xtsol_evap(iso_o18,i)/sol_evap(i))
                  write(*,*) 'h1(i),f=',h1(i),max((min(L, &
     &                   (qsol_avant_evap(i)))-qevap(i)) &
     &                   /min(L,(qsol_avant_evap(i))),0.0)
                  write(*,*) 'qsol_avant_evap,sol_evap,qsol,dt=', &
     &                  qsol_avant_evap(i),sol_evap(i),& 
     &                  qsol_avant_deversement(i),dtime 
                  write(*,*) 'qsol_avant_evap17,sol_evap17,qsol17=', &
     &                   xtsol_avant_evap(iso_o17,i), &
     &                   xtsol_evap(iso_o17,i),xtsol(iso_o17,i)
                  write(*,*) 'qsol_avant_evap18,sol_evap17,qsol18=', &
     &                   xtsol_avant_evap(iso_o18,i), &
     &                   xtsol_evap(iso_o18,i),xtsol(iso_o18,i)
                stop
              endif !if (iso_verif_aberrant_o17_nostop(xtsol(iso_O17,i)
            endif !if ((qsol(i).gt.ridicule).and.(xtsol(iso_O18,i)
          endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then     
#ifdef ISOTRAC
          call iso_verif_traceur(xtsol_evap(1,i), & 
     &           'calcul_iso_surf_ter 1558')
#endif          
#endif
          ! end verif   
       enddo  !do icas_evap=1,ncas_evap

! traitement vectoriel du cas pas d'évap
        do icas=1,ncas_noevap
          i=cas_noevap(icas)
!          write(*,*) 'calcul_iso_surf_oce 3175: pas d''évap'
          do ixt=1,ntraciso
            xtsol_evap(ixt,i)=0.0
          enddo
          do ixt=1,niso      
            xtsol(ixt,i)=xtsol_avant_evap(ixt,i)
          enddo !do ixt=1,niso
        enddo !do icas_evap=1,ncas_evap

        ! traitement vectoriel du cas rosée
        do icas=1,ncas_rosee
          i=cas_rosee(icas)      
          ! evap<0 -> on condense.
!          write(*,*) 'calcul_iso_surf_oce 3176: condense: sol_evap(i)=',
!     :           sol_evap(i)          
!          write(*,*) 'calcul_iso_surf_ter 716: dtime=',dtime
!          Mair=100*100/9.8
          call iso_rosee_givre(xt1lay,q1lay,tsurf,t_coup,  &
     &            sol_evap,i,xtsol_evap,klon)
         ! les traceurs d'eau sont déjà dans iso_rosee_givre
         ! sol_evap est le flux d'eau sortant de la première couche         
          ! calcul de la rosée s'inflitrant dans le sol:      
          ! sol_evap est divisé sans fractionnement en une partie   
          ! dirigée vers le sol, et une partie partant en ruissellement
          if (abs(sol_evap(i)).gt.0.0) then
            do ixt=1,niso
             xtsol_evap_eff(ixt,i)=xtsol_evap(ixt,i) &
     &           /sol_evap(i)*sol_evap_eff(i)
#ifdef ISOVERIF
             if (iso_verif_noNaN_nostop(( &
     &           xtsol_evap_eff(ixt,i)),'iso_surf_ter 1790') &
     &           .eq.1) then
               write(*,*) 'xtsol_evap,sol_evap,sol_evap_eff=', &
     &           xtsol_evap(ixt,i),sol_evap(i),sol_evap_eff(i)
               stop
              endif !if (iso_verif_noNaN_nostop((
#endif             
            enddo !do ixt=1,niso
          else ! if (sol_evap.gt.0.0) then
#ifdef ISOVERIF           
             call iso_verif_egalite(sol_evap_eff(i),0.0, &
     &           'iso_surf_ter 1862')
#endif             
           do ixt=1,niso
             xtsol_evap_eff(ixt,i)=0.0
           enddo !do ixt=1,niso
          endif !if (sol_evap.gt.0.0) then

          if (ruissellement_pluie.eq.1) then
            do ixt=1,niso
              xtrun_off(ixt,i)=xtrun_off(ixt,i)+(xtsol_evap_eff(ixt,i) &
     &           -xtsol_evap(ixt,i))*dtime
            enddo
             runoff_tmp(i)=runoff_tmp(i) &
     &           +(sol_evap_eff(i)-sol_evap(i))*dtime
          endif !if (ruissellement_pluie.eq.1) then

#ifdef ISOVERIF
          do ixt=1,niso
                call iso_verif_noNAN( &
     &           (xtsol_evap_eff(ixt,i)), &
     &           'calcul_iso_surf_ter 1020')
          enddo !do ixt=1,niso   
#endif
#ifdef ISOVERIF   
          if (iso_eau.gt.0) then  
                call iso_verif_egalite_choix( &
     &           (xtsol_evap_eff(iso_eau,i)), &
     &           (sol_evap_eff(i)), &
     &           'calcul_iso_surf_ter 1025', &
     &           errmax,errmaxrel)
          endif
          if (iso_HDO.gt.0) then
              ! si il y a rosée, il faut que le flux d'isotopes soit
              ! aussi négatif
              call iso_verif_positif(-xtsol_evap(iso_hdo,i), &
     &          'calcul_iso_surf_ter 1448')
          endif
#endif
          ! calcul de la nouvelle composition du sol en prenant en
          ! compte la rsoée infiltrée
          do ixt=1,niso      
             xtsol(ixt,i)=xtsol_avant_evap(ixt,i) &
     &            -xtsol_evap_eff(ixt,i)*dtime             
          enddo

#ifdef ISOVERIF
              do ixt=1,niso
                call iso_verif_noNAN(( &
     &           xtsol_avant_evap(ixt,i)), &
     &           'calcul_iso_surf_ter 1826')
                call iso_verif_noNAN(( &
     &           xtsol_evap_eff(ixt,i)), &
     &           'calcul_iso_surf_ter 1832')
                call iso_verif_noNAN(xtsol(ixt,i), &
     &           'calcul_iso_surf_ter 1828')
              enddo !do ixt=1,niso
#endif
#ifdef ISOVERIF
              if (iso_eau.gt.0) then  
                call iso_verif_egalite_choix(xtsol(iso_eau,i), &
     &            (qsol_avant_deversement(i)), &
     &           'calcul_iso_surf_ter 1967', &
     &            errmax,errmaxrel)
                call iso_verif_egalite_choix( &
     &              xtsol_evap(iso_eau,i), &
     &              sol_evap(i), &
     &              'calcul_iso_surf_ter 771',errmax,errmaxrel)
              endif !if (iso_eau.gt.0) then  
              if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
               if (abs(evap(i)).gt.ridicule_evap) then
                call iso_verif_aberrant_o17(xtsol_evap(iso_O17,i) &
     &           /sol_evap(i),xtsol_evap(iso_O18,i) &
     &           /sol_evap(i),'calcul_iso_surf 1754')
              endif !if (qsol(i).gt.ridicule) then
             endif ! if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
#endif
                    
        enddo !do icas_evap=1,ncas_rosee
        
        ! deversement du trop plein  
        ! seulement si c'est le sol qu'on fait ruisseller:
        if (ruissellement_pluie.eq.0) then  
          do i=1,knon  
          if (qsol_avant_deversement(i).gt.max_eau_sol) then     
              do ixt=1,niso
                xtrun_off(ixt,i)=run_off(i)*xtsol(ixt,i) &
     &                   /qsol_avant_deversement(i)
                xtsol(ixt,i)=min(xtsol(ixt,i)/qsol_avant_deversement(i) &
     &                   *max_eau_sol,max_eau_sol) 
#ifdef ISOVERIF 
                if (iso_eau.gt.0) then
                  call iso_verif_egalite_choix(run_off(i), &
     &                 xtrun_off(iso_eau,i),'calcul_iso_surf_ter 1774', &
     &                 errmax,errmaxrel)
                endif
#endif                
              enddo  
          else !if (qsol_avant_deversement(i).gt.max_eau_sol) then
#ifdef ISOVERIF               
               call iso_verif_egalite(run_off(i),0.0, &
     &                   'calcul_iso_surf_ter 1672')  
#endif               
              do ixt=1,niso
               xtrun_off(ixt,i)=0.0 
              enddo               
          endif !if (qsol(i).gt.max_eau_sol) then
          enddo ! do i=1,knon  
      else if (ruissellement_pluie.eq.1) then
            ! on vérifie que rien ne déborde
#ifdef ISOVERIF  
          do i=1,knon  
            call iso_verif_positif_choix( &
     &           max_eau_sol-(qsol_avant_deversement(i)), &
     &           ridicule_qsol,'calcul_iso_surf_ter 935')
            if (iso_eau.gt.0) then
            call  iso_verif_egalite_choix(runoff_tmp(i), &
     &                 xtrun_off(iso_eau,i),'calcul_iso_surf_ter 1794', &
     &                 errmax,errmaxrel)
            endif !if (iso_eau.gt.0) then
            
!            write(*,*) 'tmp ter 1929: i,runoff_tmp,run_off=',
!     :           i,runoff_tmp(i),run_off(i)
           if (iso_verif_egalite_choix_nostop(runoff_tmp(i), &
     &          run_off(i),'calcul_iso_surf_ter 1772', &
     &          errmax_sol*max(qsol_prec(i),1.0),errmaxrel).eq.1) then
           ! il y a beaucoup d'inprecision associée à runoff, car dans
           ! LMDZ, runoff=qsol-max_eau_sol (cf fonte_neige).
           ! en R4, qsol a 6 chiffres significatifs après la virgule ->
           ! la precision sur le résultat ne peut pas être meilleure que
           ! 1e-5.
            write(*,*) 'i,max_eau_sol=',i,max_eau_sol            
            write(*,*) 'qsol_prec=',qsol_prec(i) 
            write(*,*) 'precip_rain*dt=',precip_rain(i)*dtime
            write(*,*) 'fq_fonte_neige=',fq_fonte_neige(i)
            write(*,*) 'sol_evap*dt=',sol_evap(i)*dtime
            write(*,*) 'precip_rain_eff*dt=',precip_rain_eff(i)*dtime
            write(*,*) 'fq_fonte_neige_eff=',fq_fonte_neige_eff(i)
            write(*,*) 'sol_evap_eff*dt=',sol_evap_eff(i)*dtime
            write(*,*) 'qsol_avant_evap=',qsol_avant_evap(i)
            write(*,*) 'qsol_avant_deversement=',  &
     &                   qsol_avant_deversement(i)
            write(*,*) 'run_off=',run_off(i)
            write(*,*) 'runoff_tmp=',runoff_tmp(i)
!            write(*,*) 'xtsol_prec=',xtsol_prec(iso_eau,i)
!            write(*,*) 'xtsol_avant_evap=',xtsol_avant_evap(iso_eau,i) 
!            write(*,*) 'xtprecip_rain_eff=',xtprecip_rain_eff(iso_eau,i)
!            write(*,*) 'fxt_fonte_neige_eff=',
!     :                   fxt_fonte_neige_eff(iso_eau,i)
              stop
              endif  !if (iso_verif_egalite_choix_nostop
            
          enddo !do i=1,knon
#endif          
         ! rectification éventuelle du runoff
        do i=1,knon
         if (runoff_tmp(i).gt.0.0) then
          do ixt=1,niso   
           xtrun_off(ixt,i)=xtrun_off(ixt,i)/runoff_tmp(i)*run_off(i)
          enddo !do ixt=1,niso   
         endif
        enddo  
#ifdef ISOVERIF
        do i=1,knon
        if (iso_eau.gt.0) then
            call iso_verif_egalite_choix(run_off(i), &
     &        xtrun_off(iso_eau,i),'calcul_iso_surf_ter 1834', &
     &        errmax,errmaxrel)            
        endif
        enddo !do i=1,knon
#endif       
        else
          write(*,*) 'calcul_iso_surf 1764: option non valide:'  
          write(*,*) 'ruissellement_pluie=',ruissellement_pluie
          stop
        endif !if (ruissellement_pluie.eq.0) then 

        ! on en déduit l'évap vers l'atm:
        do i=1,knon
        do ixt=1,ntraciso
           xtevap(ixt,i)=xtsol_evap(ixt,i)+xtsnow_evap(ixt,i)
        enddo !do ixt=1,niso
        enddo !do i=1,knon

        ! verif
#ifdef ISOVERIF
        do i=1,knon
              do ixt=1,niso
                call iso_verif_noNAN(xtsol_evap(ixt,i),  &    
     &                   'calcul_iso_surf_ter 800')
                call iso_verif_noNAN(xtsnow_evap(ixt,i),  &    
     &                   'calcul_iso_surf_ter 801')
                call iso_verif_noNAN(xtevap(ixt,i),     & 
     &                   'calcul_iso_surf_ter 802')
                call iso_verif_noNAN(xtsnow(ixt,i),     & 
     &                   'calcul_iso_surf_ter 803')
                call iso_verif_noNAN(xtsol(ixt,i),     & 
     &                   'calcul_iso_surf_ter 804')                
              enddo   !do ixt=1,niso
        enddo ! do i=1,knon
#endif              
#ifdef ISOVERIF
        do i=1,knon
              if (iso_eau.gt.0) then  
                 if (iso_verif_egalite_choix_nostop( &
     &               xtevap(iso_eau,i),evap(i), &
     &               'calcul_iso_surf_ter 1059',errmax,errmaxrel) &
     &               .eq.1) then
                   write(*,*) 'xtevap(iso_eau,i)=',xtevap(iso_eau,i)
                   write(*,*) 'evap(i)=',evap(i)
                   write(*,*) 'xtsol_evap(iso_eau,i)=', &
     &                   xtsol_evap(iso_eau,i)
                   write(*,*) 'sol_evap(i)=',sol_evap(i)
                   write(*,*) 'xtsnow_evap(iso_eau,i)=', &
     &                   xtsnow_evap(iso_eau,i)
                   write(*,*) 'snow_evap(i)=',snow_evap(i)
                   stop                   
                 endif
                 call iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i), &
     &                  'calcul_iso_surf_ter 743',errmax,errmaxrel)
                 call iso_verif_egalite_choix(xtsol(iso_eau,i),qsol(i), &
     &                  'calcul_iso_surf_ter 745',errmax,errmaxrel)
                 call iso_verif_positif(max_eau_sol-qsol(i), &
     &                   'calcul_iso_surf_ter 746a')
                 if (iso_verif_positif_nostop( &
     &                   max_eau_sol-xtsol(iso_eau,i), &
     &                   'calcul_iso_surf_ter 746b').eq.1) then
                   write(*,*) 'i=',i
                   write(*,*) 'max_eau_sol=',max_eau_sol
                   write(*,*) 'qsol(i)=',qsol(i)
                   write(*,*) 'xtsol(iso_eau,i)=',xtsol(iso_eau,i)
                   write(*,*) 'qsol_avant_deversement(i)=', &
     &                   qsol_avant_deversement(i)
                   write(*,*) 'precip_rain(i)=',precip_rain(i)
                   write(*,*) 'precip_rain_eff(i)=',precip_rain_eff(i)
                   write(*,*) 'fq_fonte_neige(i)=',fq_fonte_neige(i)
                   write(*,*) 'qsol_avant_evap(i)=',qsol_avant_evap(i)
                   write(*,*) 'qsol_prec(i)=',qsol_prec(i)
                   write(*,*) 'sol_evap(i)=',sol_evap(i)
                   write(*,*) 'xtprecip_rain(iso_eau,i)=', &
     &                   xtprecip_rain(iso_eau,i)
                   write(*,*) 'xtprecip_rain_eff(iso_eau,i)=', &
     &                   xtprecip_rain_eff(iso_eau,i)
                   write(*,*) 'xtsol_avant_evap(iso_eau,i)=', &
     &                   xtsol_avant_evap(iso_eau,i)
                   write(*,*) 'xtsol_prec(iso_eau,i)=', &
     &                   xtsol_prec(iso_eau,i)
                   write(*,*) 'xtsol_evap(iso_eau,i)=', &
     &                   xtsol_evap(iso_eau,i)
                   if (xtsol(iso_eau,i)-max_eau_sol.gt.1e-9) then
                      stop
                   else
                      xtsol(iso_eau,i)=min(xtsol(iso_eau,i), &
     &                   max_eau_sol)
                   endif
                 endif
              endif !if (iso_eau.gt.0) then
              if (iso_HDO.gt.0) then  
                 call iso_verif_aberrant_choix(xtsnow(iso_HDO,i),snow(i), &
     &                  ridicule_snow,deltalim_snow, 'calcul_iso_surf_ter 749')
                 call iso_verif_aberrant_choix(xtsnow(iso_HDO,i), &
     &               snow(i),ridicule,deltalim_snow, &
     &               'calcul_iso_surf_lic 1955')
                 if (evap(i).gt.ridicule_evap) then
                   if (iso_verif_aberrant_nostop( &
     &                   xtevap(iso_HDO,i)/evap(i), &
     &                  'calcul_iso_surf_ter 751').eq.1) then
                     write(*,*) 'i=',i
                     write(*,*) 'sol_evap,snow_evap=', &
     &                   sol_evap(i),snow_evap(i)
                     if (sol_evap(i).gt.ridicule_evap)write(*,*) 'deltaDsol_evap=', &
     &                   deltaD(xtsol_evap(iso_hdo,i)/sol_evap(i))
                     if (snow_evap(i).gt.ridicule_evap)write(*,*) 'deltaDsnow_evap=', &
     &                   deltaD(xtsnow_evap(iso_hdo,i)/snow_evap(i))
                     write(*,*) 'deltaD1new=',deltaD( &
     &                   (xtevap(iso_hdo,i)*dtime+q10*R1(iso_hdo)) &
     &                   /(evap(i)*dtime+q10))
                     write(*,*) 'deltaD1=',   deltaD(R1(iso_hdo))
                     call iso_verif_aberrant( &
     &                   (xtevap(iso_hdo,i)*dtime+q10*R1(iso_hdo)) &
     &                   /(evap(i)*dtime+q10), &
     &                  'calcul_iso_surf_ter 1571')
                   endif
                 endif !if (evap(i).gt.ridicule_evap) then
                 if (iso_verif_aberrant_choix_nostop(xtevap(iso_HDO,i), &
     &             evap(i),ridicule,1e5,'calcul_iso_surf_ter 1578') &
     &                   .eq.1) then
                     write(*,*) 'i=',i
                     write(*,*) 'sol_evap,snow_evap=', &
     &                   sol_evap(i),snow_evap(i)
                     write(*,*) 'deltaDsol_evap=', &
     &                   deltaD(xtsol_evap(iso_hdo,i)/sol_evap(i))
                     write(*,*) 'deltaDsnow_evap=', &
     &                   deltaD(xtsnow_evap(iso_hdo,i)/snow_evap(i))
                     call iso_verif_aberrant( &
     &                   (xtevap(iso_hdo,i)*dtime+q10*R1(iso_hdo)) &
     &                   /(evap(i)*dtime+q10), &
     &                  'calcul_iso_surf_ter 1590')
                endif
                 if (qsol(i).gt.ridicule_qsol*1e2) then
                   call iso_verif_aberrant(xtsol(iso_HDO,i)/qsol(i) &
     &                  /faccond,'calcul_iso_surf_ter 752')
                 endif !if (qsol(i).gt.ridicule_qsol) then
              endif !if (iso_eau.gt.0) then
              if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
               if (abs(evap(i)).gt.ridicule_qsol) then
                 call iso_verif_aberrant_o17(xtevap(iso_O17,i) &
     &           /evap(i),xtevap(iso_O18,i) &
     &           /evap(i),'iso_surf_ter 1827')
              endif !if ((evap(i).gt.ridicule).and.(xtevap(iso_O18,i)
             endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
#ifdef ISOTRAC
           call iso_verif_tracnps(xtevap(1,i), &
     &          'calcul_iso_surf_ter 1847')
#endif              
           enddo !do i=1,knon 
                  
#endif
        if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) then
         do i=1,knon     
          xtsol(iso_eau,i)=qsol(i) 
         enddo !do i=1,knon   
        endif

#ifdef ISOVERIF
      ! verif du bilan de masse d'eau et d'isotopes pour le sol

      do i=1,knon
         dqdiag=precip_rain(i)*dtime+fq_fonte_neige(i) &
     &            -(evap(i)-snow_evap(i))*dtime-run_off(i)
         if (iso_verif_egalite_choix_nostop(dqdiag, &
     &           qsol(i)-qsol_prec(i),'ter 2087', &
     &           errmax_sol*max(qsol(i),1.0),errmaxrel).eq.1) then
             write(*,*) 'calcul_iso_surf_ter 2050: bilan qsol,i=',i
             write(*,*) 'qsol(i)=',qsol(i)
             write(*,*) 'qsol_prec(i)=',qsol_prec(i)
             write(*,*) 'precip_rain(i)*dt=',precip_rain(i)*dtime
             write(*,*) 'fq_fonte_neige(i)=',fq_fonte_neige(i)
             write(*,*) 'evap(i)*dt=',evap(i)*dtime
             write(*,*) 'snow_evap(i)*dt=',snow_evap(i)*dtime
             write(*,*) 'run_off(i) (diag)=',run_off(i)
             write(*,*) 'runoff_tmp(i)=',runoff_tmp(i)
             stop
         endif !if (iso_verif_egalite_choix_nostop(dqdiag,
         if (evap_cont_cste.ne.1) then
             ! si evap_cont_cste=1, on prescrit compo de l'évap du sol
             ! -> normal de ne pas conserver la masse d'isotopes
         do ixt=1,niso
            dqdiag=xtprecip_rain(ixt,i)*dtime+fxt_fonte_neige(ixt,i) &
     &            -(xtevap(ixt,i)-xtsnow_evap(ixt,i))*dtime &
     &            -xtrun_off(ixt,i)   
            if (iso_verif_egalite_choix_nostop(dqdiag, &
     &           xtsol(ixt,i)-xtsol_prec(ixt,i),'ter 1887', &
     &           errmax_sol*max(qsol(i),1.0),errmaxrel).eq.1) then
             write(*,*) 'calcul_iso_surf_ter 2066: bilan xtsol, ixt=', &
     &           ixt
             write(*,*) 'xtsol(ixt,i)=',xtsol(ixt,i)
             write(*,*) 'xtsol_prec(i)=',xtsol_prec(ixt,i)
             write(*,*) 'xtprecip_rain(i)*dt=',xtprecip_rain(ixt,i) &
     &           *dtime
             write(*,*) 'fxt_fonte_neige(i)=',fxt_fonte_neige(ixt,i)
             write(*,*) 'xtevap(i)*dt=',xtevap(ixt,i)*dtime
             write(*,*) 'xtsnow_evap(i)*dt=',xtsnow_evap(ixt,i)*dtime
             write(*,*) 'xtrun_off(i)=',xtrun_off(ixt,i)
             write(*,*) 'i=',i
             write(*,*) 'qsol(i)=',qsol(i)
             write(*,*) 'qsol_prec(i)=',qsol_prec(i)
             write(*,*) 'precip_rain(i)*dt=',precip_rain(i)*dtime
             write(*,*) 'fq_fonte_neige(i)=',fq_fonte_neige(i)
             write(*,*) 'evap(i)*dt=',evap(i)*dtime
             write(*,*) 'snow_evap(i)*dt=',snow_evap(i)*dtime
             write(*,*) 'run_off(i) (diag)=',run_off(i)
             write(*,*) 'runoff_tmp(i)=',runoff_tmp(i)
             if (qsol_prec(i).gt.-ridicule) then
                 stop
                 ! sinon, si qsolprec<0, on fait compo du sol=compo des
                 ! inputs pour éviyer deltaD aberrants -> masse pas tout
                 ! à fait conservée. On croise les doigts pour que ce
                 ! cas pathologique arrive rarement.
             endif             
           endif    
          enddo
         endif !if (evap_cont_cste.ne.1) then
      enddo !do i=1,knon

#endif      

      ! on rescale le runoff pour qu'il soit en kg/m2/s
        do i=1,knon
        run_off(i)=run_off(i)/dtime
        runoff_tmp(i)=runoff_tmp(i)/dtime
        do ixt=1,niso
           xtrun_off(ixt,i)=xtrun_off(ixt,i)/dtime           
        enddo !do ixt=1,niso
        enddo !do i=1,knon

        return
        end subroutine calcul_iso_surf_ter_vectall


!***           

      SUBROUTINE phyisoetat0 (snow,run_off_lic_0, &
     &           xtsnow,xtrun_off_lic_0, &
     &           Rland_ice,Rsol) 
      USE dimphy, only: klon,klev
      !USE mod_grid_phy_lmdz
      !USE mod_phys_lmdz_para
      USE iophy
      USE phys_state_var_mod, ONLY: q_ancien,xt_ancien,wake_deltaq,wake_deltaxt, &
        xtrain_fall,xtsnow_fall, ql_ancien,xtl_ancien,qs_ancien,xts_ancien, &
        rain_fall,snow_fall,fevap,fxtevap,xtsol,qsol
      !USE iostart, ONLY : close_startphy, get_field, get_var, open_startphy
      !USE write_field_phy
      USE indice_sol_mod, only: nbsrf  
      USE isotopes_mod, ONLY: initialisation_iso, iso_eau,iso_HDO, &
        ridicule_qsol,tnat, P_veg,iso_O18,ridicule, ridicule_snow,iso_O17, &
        iso_HTO
#ifdef ISOVERIF
      USE isotopes_verif_mod
#endif

      USE compbl_mod_h
      USE clesphys_mod_h

      IMPLICIT NONE

      ! equivalent de phyetat0 pour les isotopes

!#ifdef ISOVERIF
!      real deltaD
!#endif        
      ! arguments  
      !real xtsol(niso,klon) 
      real xtsnow(niso,klon,nbsrf)  
      !real xtevap(ntraciso,klon,nbsrf)  
      real xtrun_off_lic_0(niso,klon)
      real Rland_ice(niso,klon)
      real Rsol(niso,klon)

      !REAL qsol(klon)
      REAL snow(klon,nbsrf)
      !REAL evap(klon,nbsrf)
      REAL run_off_lic_0(klon)

      ! locals
      integer ixt,i,k,nsrf

!      character*50 text

!      write(*,*) 'phyisoetat0 20: fichnom=',fichnom
      write(*,*) 'initialisation_iso=',initialisation_iso

      if (initialisation_iso.eq.0) then
          call phyiso_etat0_fichier( &
     &           snow,run_off_lic_0, &
     &           xtsnow,xtrun_off_lic_0, &
     &           Rland_ice,Rsol)
      else
        write(*,*) 'phyisoetat0 57:'
        write(*,*) 'initialisation_iso=',initialisation_iso
!          stop
          call phyiso_etat0_dur( &
     &         xtsnow, &
     &         xtrun_off_lic_0, Rland_ice, Rsol, &
     &         snow,run_off_lic_0)
      endif


      ! verif
#ifdef ISOVERIF
      do i=1,klon
         do ixt=1,niso
         call iso_verif_noNaN(xtsol(ixt,i),'phyisoetat0 753')
         call iso_verif_noNaN(xtrain_fall(ixt,i),'phyisoetat0 754')
         call iso_verif_noNaN(xtsnow_fall(ixt,i),'phyisoetat0 755')
         call iso_verif_noNaN(xtrun_off_lic_0(ixt,i),'phyisoetat0 756')
         enddo !do ixt=1,niso
      enddo !do i=1,klon
      do i=1,klon
         if (iso_eau.gt.0) then
         call iso_verif_egalite(xtsol(iso_eau,i),qsol(i), &
     &           'phyisoetat0 759')
         call iso_verif_egalite(xtrain_fall(iso_eau,i),rain_fall(i), &
     &            'phyisoetat0 760')
         call iso_verif_egalite(xtsnow_fall(iso_eau,i),snow_fall(i), &
     &           'phyisoetat0 761')
         call iso_verif_egalite(xtrun_off_lic_0(iso_eau,i), &
     &           run_off_lic_0(i), 'phyisoetat0 762')
         endif !if (iso_eau.gt.0) then
         do k=1,klev
           do ixt=1,niso
              call iso_verif_noNaN(xt_ancien(ixt,i,k), &
     &           'phyisoetat0 771a')   
              call iso_verif_noNaN(xtl_ancien(ixt,i,k), &
     &           'phyisoetat0 771b')
              call iso_verif_noNaN(xts_ancien(ixt,i,k), &
     &           'phyisoetat0 771c')     
           enddo !do ixt=1,niso
           if (iso_eau.gt.0) then 
             call iso_verif_egalite(xt_ancien(iso_eau,i,k), &
     &           q_ancien(i,k),'phyisoetat0 775a')    
             call iso_verif_egalite(xtl_ancien(iso_eau,i,k), &
     &           ql_ancien(i,k),'phyisoetat0 775b') 
             call iso_verif_egalite(xts_ancien(iso_eau,i,k), &
     &           qs_ancien(i,k),'phyisoetat0 775c')     
           endif !if (iso_eau.gt.0) then
           if (iso_HDO.gt.0) then
             if (q_ancien(i,k).gt.2e-3) then
!                write(*,*) 'i,k=',i,k
               call iso_verif_aberrant(xt_ancien(iso_hdo,i,k) &
     &           /q_ancien(i,k),'phyisoetat0 103a')
             endif !if (q_ancien(i,k).gt.2e-3) then
             if (ql_ancien(i,k).gt.2e-3) then
               call iso_verif_positif(xtl_ancien(iso_hdo,i,k) &
     &           /ql_ancien(i,k),'phyisoetat0 103b')
             endif !if (q_ancien(i,k).gt.2e-3) then
             if (qs_ancien(i,k).gt.2e-3) then
               call iso_verif_positif(xts_ancien(iso_hdo,i,k) &
     &           /qs_ancien(i,k),'phyisoetat0 103c')
             endif !if (q_ancien(i,k).gt.2e-3) then
           endif !if (iso_HDO.gt.0) then
#ifdef ISOTRAC      
           call iso_verif_traceur(xt_ancien(1,i,k), &
     &           'phyisoetat0 111a')
           call iso_verif_traceur(xtl_ancien(1,i,k), &
     &           'phyisoetat0 111b')
           call iso_verif_traceur(xts_ancien(1,i,k), &
     &           'phyisoetat0 111c')
#endif           
         enddo !do k=1,klev
        do nsrf=1,nbsrf
          do ixt=1,niso
               call iso_verif_noNAN(xtsnow(ixt,i,nsrf), &
     &           'phyisoetat0 781')
               call iso_verif_noNAN(fxtevap(ixt,i,nsrf), &
     &           'phyisoetat0 783')
          enddo !do ixt=1,niso
#ifdef ISOTRAC      
           call iso_verif_traceur_justmass(fxtevap(1,i,nsrf), &
     &           'phyisoetat0 123')
#endif 
          if (iso_eau.gt.0) then
            call iso_verif_egalite(xtsnow(iso_eau,i,nsrf),snow(i,nsrf), &
     &                'phyisoetat0 787')
            call iso_verif_egalite(fxtevap(iso_eau,i,nsrf),fevap(i,nsrf), &
     &                   'phyisoetat0 75')
          endif !if (iso_eau.gt.0) then
          if (iso_HDO.gt.0) then
            call iso_verif_aberrant_choix(xtsnow(iso_hdo,i,nsrf),snow(i,nsrf), &
     &                ridicule_snow, deltalim_snow, 'phyisoetat0 117')
          endif !if (iso_eau.gt.0) then
        enddo !do nsrf=1,nbsrf
      enddo !do i=1,klon
      do i=1,klon
        if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
             if ((qsol(i).gt.ridicule_qsol).and.(xtsol(iso_O18,i) &
     &           .gt.ridicule_qsol*tnat(iso_o18))) then
                call iso_verif_aberrant_o17(xtsol(iso_O17,i) &
     &           /qsol(i),xtsol(iso_O18,i) &
     &           /qsol(i),'phyisoetat0 123')
             endif
         endif 
       enddo !do i=1,klon
#endif
      !end verif

        ! pour le tritium: initialisation des tableaux d'essais nucléaires:
        if (iso_HTO.gt.0) then
          CALL table_tritium_nucl()
        endif

      RETURN
      END subroutine phyisoetat0   
      

      SUBROUTINE phyiso_etat0_dur ( &
     &          xtsnow, &
     &         xtrun_off_lic_0, Rland_ice, Rsol, &
     &         snow,run_off_lic_0) 

      USE dimphy, only: klon,klev
      !USE mod_grid_phy_lmdz
      !USE mod_phys_lmdz_para
      USE iophy
      USE phys_state_var_mod, ONLY: q_ancien,xt_ancien,wake_deltaq,wake_deltaxt, &
        xtrain_fall,xtsnow_fall,rain_fall,snow_fall, ql_ancien,xtl_ancien,qs_ancien,xts_ancien, &
        fevap,fxtevap,xtsol,qsol
      !USE iostart
      !USE write_field_phy
      USE indice_sol_mod, only: nbsrf
      USE isotopes_mod, ONLY: tnat,iso_HDO,iso_O18,iso_HTO, iso_eau,toce, &
&       Rdefault,iso_O17,ridicule,ridicule_qsol
#ifdef ISOVERIF
      USE isotopes_verif_mod
#endif
#ifdef ISOTRAC
      USE isotrac_mod, ONLY: index_iso,index_zone,izone_init
#endif
      USE compbl_mod_h
      USE clesphys_mod_h

      IMPLICIT NONE

      ! arguments  
      !integer niso 
      !real xtsol(niso,klon) 
      real xtsnow(niso,klon,nbsrf)  
      !real xtevap(ntraciso,klon,nbsrf) 
      real xtrun_off_lic_0(niso,klon)
      real Rland_ice(niso,klon)
      real Rsol(niso,klon)

      !REAL qsol(klon)
      REAL snow(klon,nbsrf)
      !REAL evap(klon,nbsrf)
      REAL run_off_lic_0(klon)
      !locals
      integer ixt, k, i, nsrf   
      real deltaD_rain_fall(niso)
      real deltaD_snow_fall(niso)
      real deltaD_snow(niso)
      real deltaD_land_ice(niso)
      real deltaD_sol(niso)
      real deltaD_run_off_lic_0(niso)
      real deltaD_evap(niso)
      real RMerlivat(niso)

      ! constes
        real deltaD_snow_fall_O18,deltaD_rain_fall_O18
        real alpha(niso),kcin(niso)
!      character*50 text
        
      ! initialisation des isotopes
     
      ! 1. initialisation de la neige qui tombe
      ! 2. initialisation de la pluie
        deltaD_snow_fall_O18=-20.
        deltaD_rain_fall_O18=-5.
        if (iso_HTO.gt.0) then
        deltaD_snow_fall(iso_HTO)=-1000.  
        deltaD_rain_fall(iso_HTO)=-1000.   
        endif   
        if (iso_O18.gt.0) then
        deltaD_snow_fall(iso_O18)=deltaD_snow_fall_O18
        deltaD_rain_fall(iso_O18)=deltaD_rain_fall_O18
        endif
        if (iso_O17.gt.0) then
        deltaD_snow_fall(iso_O17)=(exp(25.0/1e6) &
     &           *(deltaD_snow_fall_O18/1000.0+1.0)**0.528 &
     &           -1.0)*1000.0
        deltaD_rain_fall(iso_O17)=(exp(25.0/1e6) &
     &           *(deltaD_rain_fall_O18/1000.0+1.0)**0.528 &
     &           -1.0)*1000.0
        endif
        if (iso_HDO.gt.0) then
          deltaD_snow_fall(iso_HDO)=deltaD_snow_fall_O18*8.0+10.0
          deltaD_rain_fall(iso_HDO)=deltaD_rain_fall_O18*8.0+10.
        endif
        if (iso_eau.gt.0) then
          deltaD_snow_fall(iso_eau)=0.
          deltaD_rain_fall(iso_eau)=0.
        endif
        do ixt=1,niso
          deltaD_snow(ixt)=deltaD_snow_fall(ixt)
          deltaD_sol(ixt)=deltaD_rain_fall(ixt)
          deltaD_evap(ixt)=deltaD_sol(ixt)
          deltaD_run_off_lic_0(ixt)=deltaD_sol(ixt)
          deltaD_land_ice(ixt)=deltaD_snow(ixt)
          call fractcalk_liq(ixt, 283.0, alpha(ixt))    
        enddo !do ixt=1,niso
        call calcul_kcin(2.0,kcin) 

       do i=1,klon
        do ixt=1,niso
           xtsnow_fall(ixt,i)=snow_fall(i) &
     &           *tnat(ixt)*(deltaD_snow_fall(ixt)/1000.0+1.0)
        enddo
        do ixt=1,niso
           xtrain_fall(ixt,i)=rain_fall(i) &
     &           *tnat(ixt)*(deltaD_rain_fall(ixt)/1000.0+1.0)
        enddo
       enddo !do i=1,klon
#ifdef ISOTRAC
       do i=1,klon
        do ixt=niso+1,ntraciso
         if (index_zone(ixt).eq.izone_init) then 
           xtrain_fall(ixt,i)=rain_fall(i) &
     &           *tnat(index_iso(ixt)) &
     &           *(deltaD_rain_fall(index_iso(ixt))/1000.0+1.0)
           xtsnow_fall(ixt,i)=snow_fall(i) &
     &           *tnat(index_iso(ixt)) &
     &           *(deltaD_snow_fall(index_iso(ixt))/1000.0+1.0)
         else
             xtsnow_fall(ixt,i)=0.0
             xtrain_fall(ixt,i)=0.0
         endif
        enddo !do ixt=niso+1,ntraciso
       enddo !do i=1,klon
#endif        

        ! 3. initialisation de la neige au sol
       do i=1,klon
        do nsrf=1,nbsrf
          do ixt=1,niso           
           xtsnow(ixt,i,nsrf)=snow(i,nsrf) &
     &           *tnat(ixt)*(deltaD_snow(ixt)/1000+1)
          enddo
        enddo !do nsrf=1,nbsrf
       enddo !do i=1,klon

        ! 4. initialisation du sol
        do i=1,klon
          do ixt=1,niso       
           xtsol(ixt,i)=qsol(i) &
     &           *tnat(ixt)*(deltaD_sol(ixt)/1000.0+1)                   
          enddo
        enddo !do i=1,klon

          ! verif   
#ifdef ISOVERIF
        do i=1,klon  
             if (iso_eau.gt.0)  then
                 call iso_verif_egalite(xtsol(iso_eau,i),qsol(i), &
     &           'phyiso_etat0_dur 74')
             endif  
        enddo !do i=1,klon      
#endif

          ! end verif
      ! 5. initialisation de l'évaporation
      do i=1,klon
        do nsrf=1,nbsrf
          do ixt=1,niso
           fxtevap(ixt,i,nsrf)=fevap(i,nsrf) &
     &           *tnat(ixt)*(deltaD_evap(ixt)/1000+1)
          enddo
#ifdef ISOTRAC
          do ixt=niso+1,ntraciso
           if (index_zone(ixt).eq.izone_init) then 
             fxtevap(ixt,i,nsrf)=fevap(i,nsrf) &
     &           *tnat(index_iso(ixt)) &
     &           *(deltaD_evap(index_iso(ixt))/1000.0+1.0)
           else
             fxtevap(ixt,i,nsrf)=0.0
           endif
          enddo !do ixt=niso+1,ntraciso
#endif            
        enddo !do nsrf=1,nbsrf
      enddo !do i=1,klon 

      ! 6. initialisation de xtrun_off_lic0
      do i=1,klon
          do ixt=1,niso
           xtrun_off_lic_0(ixt,i)=run_off_lic_0(i) &
     &         *tnat(ixt)*(deltaD_run_off_lic_0(ixt)/1000.0+1.0)
          enddo
       enddo !do i=1,klon   

      ! 7. initialisation de xt_ancien et wake_deltaxt
      do i=1,klon
        do k=1,klev
          do ixt=1,niso
            call iso_init_ideal(q_ancien(i,k),xt_ancien(ixt,i,k),ixt, &
                alpha(ixt),kcin(ixt),toce(ixt))

            if (q_ancien(i,k).gt.ridicule) then
              xtl_ancien(ixt,i,k)=ql_ancien(i,k)*alpha(ixt) &
     &           *xt_ancien(ixt,i,k)/q_ancien(i,k)
              xts_ancien(ixt,i,k)=qs_ancien(i,k)*alpha(ixt) &
     &           *xt_ancien(ixt,i,k)/q_ancien(i,k)
            else !if (q_ancien(i,k).gt.ridicule) then
              xtl_ancien(ixt,i,k)=ql_ancien(i,k)*Rdefault(ixt)
              xts_ancien(ixt,i,k)=qs_ancien(i,k)*Rdefault(ixt)
            endif !if (q_ancien(i,k).gt.ridicule) then
          enddo !do ixt=1,niso

#ifdef ISOVERIF
          do ixt=1,niso
            call iso_verif_noNaN(xt_ancien(ixt,i,k), &
     &           'phyisoetat0 16062')   
            call iso_verif_noNaN(xtl_ancien(ixt,i,k), &
     &           'phyisoetat0 16063')
            call iso_verif_noNaN(xts_ancien(ixt,i,k), &
     &           'phyisoetat0 16067')  
          enddo !do ixt=1,niso

        ! Camille 7 mars 2023: ajout d'un check
          if ((i.eq.1).and.(k.eq.1).and.(iso_HDO.gt.0)) then
            write(*,*) 'phyisoetat0 16362: q_ancien(1,1)=',q_ancien(i,k) 
            if (q_ancien(i,k).gt.ridicule) then 
              write(*,*) 'deltaD_ancien=',deltaD(xt_ancien(iso_HDO,i,k)/q_ancien(i,k))
              write(*,*) 'xt_ancien(:,i,k)=',xt_ancien(:,i,k)
            endif
          endif !if ((i.eq.1).and.(k.eq.1)) then

          if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then 
            if (q_ancien(i,k).gt.ridicule) then  
              if (iso_verif_o18_aberrant_nostop( &
     &            xt_ancien(iso_HDO,i,k)/q_ancien(i,k), &
     &            xt_ancien(iso_O18,i,k)/q_ancien(i,k), &
     &            'phyisoetat0 16366 q_ancien').eq.1) then
                write(*,*) 'phyisoetat0 16367: i,k,q_ancien(i,k)=',i,k,q_ancien(i,k) 
                write(*,*) 'xt_ancien(:,i,k)=',xt_ancien(:,i,k)
                stop
              endif !  if (iso_verif_o18_aberrant_nostop 
            endif !if (q_seri(i,k).gt.errmax) then  
          endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then 
#endif 


#ifdef ISOTRAC
          do ixt=niso+1,ntraciso
            if (index_zone(ixt).eq.izone_init) then
              xt_ancien(ixt,i,k)=xt_ancien(index_iso(ixt),i,k) 
              xtl_ancien(ixt,i,k)=xtl_ancien(index_iso(ixt),i,k)
              xts_ancien(ixt,i,k)=xts_ancien(index_iso(ixt),i,k)
            else
              xt_ancien(ixt,i,k)=0.0
              xtl_ancien(ixt,i,k)=0.0
              xts_ancien(ixt,i,k)=0.0
            endif
          enddo !do ixt=niso+1,ntraciso
#endif             
        enddo !do k=1,klev
       enddo ! do i=1,klon

       ! 7bis: wake_deltaxt       
       do i=1,klon
        do k=1,klev
         if (q_ancien(i,k).gt.ridicule) then
          do ixt=1,niso
           wake_deltaxt(ixt,i,k)=xt_ancien(ixt,i,k)/q_ancien(i,k) &
     &           *wake_deltaq(i,k)
          enddo !do ixt=1,niso
        else !if (q_ancien(i,k).gt.ridicule) then
          do ixt=1,niso
           wake_deltaxt(ixt,i,k)=Rdefault(ixt)*wake_deltaq(i,k)
          enddo !do ixt=1,niso
        endif !if (q_ancien(i,k).gt.ridicule) then
#ifdef ISOTRAC
        do ixt=niso+1,ntraciso
          if (index_zone(ixt).eq.izone_init) then
            wake_deltaxt(ixt,i,k)=wake_deltaxt(index_iso(ixt),i,k) 
          else
            wake_deltaxt(ixt,i,k)=0.0
          endif
        enddo !do ixt=niso+1,ntraciso
#endif             
#ifdef ISOVERIF 
        do ixt=1,ntraciso      
             call iso_verif_noNaN(wake_deltaxt(ixt,i,k), &
     &           'phyiso_etat0_dur 288a')
        enddo !do ixt=1,niso
#endif
        enddo !do k=1,klev
       enddo ! do i=1,klon

        ! 8. initialisation de la composition des glaciers
       do i=1,klon 
        do ixt=1,niso
           Rland_ice(ixt,i)= &
     &           tnat(ixt)*(deltaD_snow(ixt)/1000.0+1.0)
           Rsol(ixt,i)=Rland_ice(ixt,i)
          enddo
      enddo !do i=1,klon

#ifdef ISOVERIF
      write(*,*) 'phyisoetat0 16468: verif init dure'
      do i=1,klon
         do ixt=1,niso
         call iso_verif_noNAN(xtsol(ixt,i),'phyiso_etat0_dur 753')
         call iso_verif_noNAN(xtrain_fall(ixt,i),'phyiso_etat0_dur 754')
         call iso_verif_noNAN(xtsnow_fall(ixt,i),'phyiso_etat0_dur 755')
         call iso_verif_noNAN(xtrun_off_lic_0(ixt,i), &
     &           'phyiso_etat0_dur 756')
         call iso_verif_noNAN(Rland_ice(ixt,i),'phyiso_etat0_dur 757')
         call iso_verif_noNAN(Rsol(ixt,i),'phyiso_etat0_dur 757') 
         enddo !do ixt=1,niso
         if (iso_eau.gt.0) then
         call iso_verif_egalite(xtsol(iso_eau,i),qsol(i), &
     &           'phyiso_etat0_dur 759')
         call iso_verif_egalite(xtrain_fall(iso_eau,i),rain_fall(i), &
     &            'phyiso_etat0_dur 760')
         call iso_verif_egalite(xtsnow_fall(iso_eau,i),snow_fall(i), &
     &           'phyiso_etat0_dur 761')
         call iso_verif_egalite(xtrun_off_lic_0(iso_eau,i), &
     &           run_off_lic_0(i), 'phyiso_etat0_dur 762')
         call iso_verif_egalite(Rland_ice(iso_eau,i), &
     &           1.0, 'phyiso_etat0_dur 763')
         endif !if (iso_eau.gt.0) then
         do k=1,klev
           do ixt=1,niso
!              write(*,*) 'ixt,i,k=',ixt,i,k
              call iso_verif_noNAN(xt_ancien(ixt,i,k), &
     &           'phyiso_etat0_dur 771')     
              call iso_verif_noNAN(wake_deltaxt(ixt,i,k), &
     &           'phyiso_etat0_dur 240')        
           enddo !do ixt=1,niso
           if (iso_eau.gt.0) then
             call iso_verif_egalite(xt_ancien(iso_eau,i,k), &
     &           q_ancien(i,k),'phyiso_etat0_dur 775a')        
           endif !if (iso_eau.gt.0) then
           if (iso_HDO.gt.0) then
             if (q_ancien(i,k).gt.ridicule) then
              call iso_verif_aberrant_encadre( &
     &           xt_ancien(iso_hdo,i,k)/q_ancien(i,k), &
     &          'phyiso_etat0_dur 775b')
             endif !if (q_ancien(i,k).gt.ridicule) then
           endif !if (iso_HDO.gt.0) then
           if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
              if (q_ancien(i,k).gt.ridicule) then
                call iso_verif_O18_aberrant( &
     &              xt_ancien(iso_hdo,i,k)/q_ancien(i,k), &
     &              xt_ancien(iso_O18,i,k)/q_ancien(i,k), &
     &              'phyiso_etat0_dur 775c')
              endif ! if (q_ancien(i,k).gt.ridicule) then
           endif ! if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then 
         enddo !do k=1,klev
         do nsrf=1,nbsrf
            do ixt=1,niso
               call iso_verif_noNAN(xtsnow(ixt,i,nsrf), &
     &           'phyiso_etat0_dur 781')
               call iso_verif_noNAN(fxtevap(ixt,i,nsrf), &
     &           'phyiso_etat0_dur 783')
             enddo !do ixt=1,niso
             if (iso_eau.gt.0) then
             call iso_verif_egalite(xtsnow(iso_eau,i,nsrf),snow(i,nsrf), &
     &                'phyiso_etat0_dur 787')        
             call iso_verif_egalite(fxtevap(iso_eau,i,nsrf),fevap(i,nsrf), &
     &                 'phyiso_etat0_dur 789')           
             endif !if (iso_eau.gt.0) then 
         enddo !do nsrf=1,nbsrf
         if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
             if ((qsol(i).gt.ridicule_qsol).and.(xtsol(iso_O18,i) &
     &           .gt.ridicule_qsol*tnat(iso_o18))) then
                call iso_verif_aberrant_o17(xtsol(iso_O17,i) &
     &           /qsol(i),xtsol(iso_O18,i) &
     &           /qsol(i),'phyisoeta0 193')
             endif
         endif
#ifdef ISOTRAC
         do nsrf=1,nbsrf
           call iso_verif_traceur_justmass(fxtevap(1,i,nsrf), &
     &                   'phyiso_etat0_dur 231')
         enddo !do nsrf=1,nbsrf
         do k=1,klev
                call iso_verif_traceur(xt_ancien(1,i,k), &
     &                   'phyiso_etat0_dur 236')
         enddo !do k=1,klev
         call iso_verif_traceur(xtrain_fall(1,i), &
     &                   'phyiso_etat0_dur 238')
         call iso_verif_traceur(xtsnow_fall(1,i), &
     &                   'phyiso_etat0_dur 241')
#endif         
      enddo !do i=1,klon  
#endif

      end subroutine phyiso_etat0_dur

SUBROUTINE phyiso_etat0_fichier(snow, run_off_lic_0, xtsnow, xtrun_off_lic_0, Rland_ice, Rsol)
   USE dimphy,             ONLY: klon,klev
   USE iophy
   USE phys_state_var_mod, ONLY: q_ancien, xt_ancien, wake_deltaq, wake_deltaxt, &
#ifdef ISOVERIF
     rain_fall, snow_fall, fevap,qsol, &
#endif
     xtrain_fall, xtsnow_fall, ql_ancien, xtl_ancien, qs_ancien, xts_ancien, fxtevap, xtsol
   USE indice_sol_mod,    ONLY: nbsrf
   USE isotopes_mod,      ONLY: isoName,iso_HDO,iso_eau
   USE phyetat0_get_mod,  ONLY: phyetat0_get, phyetat0_srf
   USE infotrac_phy,      ONLY: new2oldH2O
   USE strings_mod,       ONLY: strIdx, strHead, strTail, maxlen, msg, num2str
#ifdef ISOVERIF
   USE isotopes_verif_mod
#endif
#ifdef ISOTRAC
   USE isotrac_mod, ONLY: strtrac, initialisation_isotrac, index_iso, index_zone, izone_init
#endif
   USE compbl_mod_h
   USE clesphys_mod_h

   IMPLICIT NONE

   REAL, INTENT(IN)  ::             snow    (klon,nbsrf)
   REAL, INTENT(IN)  ::    run_off_lic_0    (klon)
   REAL, INTENT(OUT) ::          xtsnow(niso,klon,nbsrf) 
   REAL, INTENT(OUT) :: xtrun_off_lic_0(niso,klon)
   REAL, INTENT(OUT) ::       Rland_ice(niso,klon)
   REAL, INTENT(OUT) ::       Rsol     (niso,klon)

   INTEGER :: ierr, i, ixt, k, nsrf, nid, nvarid, lnblnk
   CHARACTER(LEN=2) :: str2
   CHARACTER(LEN=5) :: str5
   CHARACTER(LEN=maxlen) :: outiso, oldIso, modname, nam(3), oldIso2
   REAL :: xmin, xmax
   LOGICAL :: found
#ifdef ISOTRAC
   INTEGER :: iiso, izone
#endif

   modname = 'phyiso_etat0_fichier'
   CALL msg('3', modname)
   CALL msg('niso = '//TRIM(num2str(niso)), modname)
   CALL msg('isoName(1) = '//TRIM(isoName(1)), modname)

   DO ixt = 1, ntraciso

      outiso = isoName(ixt)
      oldIso = strTail(new2oldH2O(outiso), '_')            !--- Remove "H2O_" from "H2O_<iso>[_<tag>]"
      oldIso2= TRIM(strHead(outiso,'_'))//strTail(outiso,'_') ! CR 2023: most recent possibility
!      write(*,*) 'tmp 16541:'
!      write(*,*) 'outiso=',outiso
!      write(*,*) 'oldIso=',oldIso
!      write(*,*) 'oldIso2=',oldIso2

      ! on lit seulement si ixt<=niso ou si on initialise les traceurs d'après fichier:
#ifdef ISOTRAC
      IF(ixt <= niso .OR. initialisation_isotrac == 0) THEN
#endif
      found = phyetat0iso_srf3(fxtevap,     "XTEVAP", "evaporation",  0.)
      if (.NOT.found) CALL abort_physic('isotopes_routines_mod', 'phyiso_etat0_fichier 16581a: unfound isotopic variable',1)
      found = phyetat0iso_get2(xtrain_fall, "xtrain_f", "xrain fall", 0.)
      found = phyetat0iso_get2(xtsnow_fall, "xtsnow_f", "xsnow fall", 0.)
      found = phyetat0iso_get3(xt_ancien,   "XTANCIEN",  "QANCIEN",   0.)
      found = phyetat0iso_get3(xtl_ancien,  "XTLANCIEN", "QLANCIEN",  0.)
      found = phyetat0iso_get3(xts_ancien,  "XTSANCIEN", "QSANCIEN",  0.)
      found = phyetat0iso_get3(wake_deltaxt,  "WAKE_DELTAXT", "Delta hum. wake/env",  0.)
#ifdef ISOVERIF
      IF(ixt == iso_eau .AND. iso_eau > 0) THEN
         DO i=1,klon
            CALL iso_verif_egalite(xtrain_fall(iso_eau,i),rain_fall(i),TRIM(modname)//' 231a')
            CALL iso_verif_egalite(xtsnow_fall(iso_eau,i),snow_fall(i),TRIM(modname)//' 231b')
            DO nsrf = 1, nbsrf
               CALL iso_verif_egalite(fxtevap(iso_eau,i,nsrf),fevap(i,nsrf),TRIM(modname)//' 231c')
            END DO
         END DO
      END IF
      IF(ixt == iso_HDO .AND. iso_HDO > 0) THEN
         DO k=1,klev
            DO i=1,klon
               IF(q_ancien(i,k) > 2e-3) &
                  CALL iso_verif_aberrant(xt_ancien(iso_hdo,i,k)/q_ancien(i,k),TRIM(modname)//' 312')
            END DO
         END DO
      END IF
#endif
      ! ces variables n'ont pas de traceurs:
      IF(ixt <= niso) THEN
         found = phyetat0iso_get2(xtsol, "XTSOL", "Surface humidity / bucket", 0.)
         if (.NOT.found) CALL abort_physic('isotopes_routines_mod', 'phyiso_etat0_fichier 16581b: unfound isotopic variable',1)
         found = phyetat0iso_get2(Rland_ice, "Rland_ice", "SR land ice", 0.)
         found = phyetat0iso_get2(Rsol, "Rsol", "SR land soil", 0.)
         found = phyetat0iso_srf3(xtsnow,      "XTSNOW", "Surface snow", 0.) ! CR avril 2023: deplacer ici 
         found = phyetat0iso_get2(xtrun_off_lic_0, "XTRUNOFFLIC0", "RUNOFFLIC0", 0.)
#ifdef ISOVERIF
         DO i=1,klon
            IF(iso_verif_noNaN_nostop(xtsol(ixt,i),TRIM(modname)//' 95') == 1) THEN
               WRITE(*,*) 'ixt,i=',ixt,i
               STOP
            END IF
            IF(ixt == iso_eau .AND. iso_eau > 0) THEN
             DO nsrf = 1, nbsrf
               CALL iso_verif_egalite(fxtevap(iso_eau,i,nsrf),fevap(i,nsrf),TRIM(modname)//' 231c')
               CALL iso_verif_egalite( xtsnow(iso_eau,i,nsrf), snow(i,nsrf),TRIM(modname)//' 231d')
             END DO
             CALL iso_verif_egalite( xtrun_off_lic_0(iso_eau,i), run_off_lic_0(i),TRIM(modname)//' 231e')
            ENDIF !IF(ixt == iso_eau .AND. iso_eau > 0) THEN
         END DO !DO i=1,klon
#endif
      END IF
#ifdef ISOTRAC
      END IF ! IF(ixt > niso .OR. initialisation_isotrac == 0))
#endif

   END DO

#ifdef ISOTRAC
   IF(initialisation_isotrac /= 0) THEN
      ! On n'initialise pas d'apres le fichier. L'eau normale est mise dans la zone izone_init
      DO ixt=niso+1,ntraciso
         iiso=index_iso(ixt)
         IF(index_zone(ixt) == izone_init) THEN
            DO i = 1, klon
               fxtevap(ixt,i,1:nbsrf) = fxtevap(iiso,i,1:nbsrf)
               xtsnow_fall(ixt,i) = xtsnow_fall(iiso,i)
               xtrain_fall(ixt,i) = xtrain_fall(iiso,i)
               DO k = 1, klev
                  xt_ancien   (ixt,i,k) = xt_ancien   (iiso,i,k)
                  xtl_ancien  (ixt,i,k) = xtl_ancien  (iiso,i,k)
                  xts_ancien  (ixt,i,k) = xts_ancien  (iiso,i,k)
                  wake_deltaxt(ixt,i,k) = wake_deltaxt(iiso,i,k)    
               END DO
            END DO
         ELSE
            DO i = 1, klon
               fxtevap(ixt,i,1:nbsrf)=0.0
               xtsnow_fall(ixt,i)=0.0
               xtrain_fall(ixt,i)=0.0
               xt_ancien (ixt,i,1:klev) = 0.0
               xtl_ancien(ixt,i,1:klev) = 0.0
               xts_ancien(ixt,i,1:klev) = 0.0
            END DO
         END IF
      END DO
   END IF

#ifdef ISOVERIF
   DO nsrf = 1, nbsrf
      DO i = 1, klon
         CALL iso_verif_traceur(fxtevap(1,i,nsrf), 'phyiso_etat0_fichier 426')
      END DO
   END DO
   DO i=1,klon
      CALL iso_verif_traceur(xtrain_fall(1,i), 'phyiso_etat0_fichier 466')
      CALL iso_verif_traceur(xtsnow_fall(1,i), 'phyiso_etat0_fichier 468')
   END DO
   DO k = 1, klev
      DO i = 1, klon
         CALL iso_verif_traceur(xt_ancien(1,i,k), 'phyiso_etat0_fichier 591')
      END DO
   END DO
#endif 
        ! endif ISOVERIF       
#endif  
        ! endif ISOTRAC      

CONTAINS

LOGICAL FUNCTION phyetat0iso_get2(field, pref, descr, default) RESULT(lFound)
  REAL,             INTENT(INOUT) :: field(:,:)
  CHARACTER(LEN=*), INTENT(IN)    :: pref, descr
  REAL,             INTENT(IN)    :: default
  REAL :: iso_tmp(klon)
  nam(1) = TRIM(pref)//TRIM(outiso)
  nam(2) = TRIM(pref)//TRIM(oldIso)
  nam(3) = TRIM(pref)//TRIM(oldIso2)
  lFound = phyetat0_get(iso_tmp, nam, descr, default)
  field(ixt,:) = iso_tmp
END FUNCTION phyetat0iso_get2


LOGICAL FUNCTION phyetat0iso_get3(field, pref, descr, default) RESULT(lFound)
  REAL,             INTENT(INOUT) :: field(:,:,:)
  CHARACTER(LEN=*), INTENT(IN)    :: pref, descr
  REAL,             INTENT(IN)    :: default
  REAL :: iso_tmp_lonlev(klon,klev)
  nam(1) = TRIM(pref)//TRIM(outiso)
  nam(2) = TRIM(pref)//TRIM(oldIso)
  nam(3) = TRIM(pref)//TRIM(oldIso2)
  lFound = phyetat0_get(iso_tmp_lonlev, nam, descr, default)
  field(ixt,:,:) = iso_tmp_lonlev(:,:)
END FUNCTION phyetat0iso_get3

LOGICAL FUNCTION phyetat0iso_srf3(field, pref, descr, default) RESULT(lFound)
  REAL,             INTENT(INOUT) :: field(:,:,:)
  CHARACTER(LEN=*), INTENT(IN)    :: pref, descr
  REAL,             INTENT(IN)    :: default
  REAL :: iso_tmp_lonsrf(klon,nbsrf)
  nam(1) = TRIM(pref)//TRIM(outiso)
  nam(2) = TRIM(pref)//TRIM(oldIso)
  nam(3) = TRIM(pref)//TRIM(oldIso2)
  lFound = phyetat0_srf(iso_tmp_lonsrf, nam, descr, default)
  field(ixt,:,:) = iso_tmp_lonsrf
END FUNCTION phyetat0iso_srf3

        end subroutine phyiso_etat0_fichier




!#ifdef ISOHTO
!===================================================================
!
!   subroutines utilisees par iso_tritium: ecrites par Alexandre Cauquoin
!
!===================================================================

     SUBROUTINE iso_tritium(paprs,pplay, &
     &           zphi,dtime, &
     &           d_xt_prod_nucl, &
     &           d_xt_cosmo, &
     &           d_xt_decroiss, &
     &           xt_seri)
      USE isotopes_mod, ONLY: iso_HTO,ok_prod_nucl_tritium
      USE dimphy, ONLY: klon,klev
      USE geometry_mod, ONLY: latitude_deg,longitude_deg, & ! en degré, remplace rlat et rlon
     &           latitude,longitude ! en radian, remplace rlatd et rlond
#ifdef ISOVERIF
      USE isotopes_verif_mod
#endif
      USE yomcst_mod_h

      IMPLICIT NONE



! input
      !integer iim,jjm ! nombre de couches en lat et lon
      !integer klon,klev
      !real rlat(klon), rlon(klon) ! Latitude et longitude en degre
      !real rlatd(klon), rlond(klon) ! Latitude et longitude en radian
      real paprs(klon,klev+1) ! input-R-pression pour chaque inter-couche (en Pa)
      real zphi(klon,klev) ! input-R-geopotentiel de chaque couche (reference ocean, en m2/s2)
      real pplay(klon,klev) ! input-R-pression pour le mileu de chaque couche (en Pa)
      real dtime ! pas de temps en secondes
      !real airephy(klon) ! aire d'une grille (m2)

! output
      real d_xt_prod_nucl(ntraciso,klon,klev) ! tritium provenant des essais nucleaires
      real d_xt_cosmo(ntraciso,klon,klev) ! production naturelle de tritium
      real d_xt_decroiss(ntraciso,klon,klev) ! decroissance radioactive
      real xt_seri(ntraciso,klon,klev) ! quantite d'isotopes de l'eau

! local
!      integer iso_verif_noNAN_nostop ! pour debuggage
!      integer iso_verif_positif_strict_nostop ! pour debuggage
      integer ixt,i,k,k_ref,kb,nlev_prod
      real pi
      parameter (pi=4.*atan(1.))
      real rlat_geo(klon) ! latitude geomagnetique de la grille (en radians, entre 0 et 90 degres)
      real glat ! latitude du pole geomagnetique
      real glon ! longitude du pole geomagnetique
      real lat_geo,qcos
      parameter (nlev_prod=34)
      real p_ref ! grille de pression de reference
      dimension p_ref(nlev_prod)
      real masse_tritium ! masse d'une molecule de HTO en kg
      parameter (masse_tritium=33.3388E-27 )
      real tau_decroissance_tritium ! periode radioactive du tritium (17.77 ans en secondes)
      parameter (tau_decroissance_tritium=560520955.6)
      data p_ref / &
     &      100062.00, 97119.00, 94176.00, 91233.00, &
     &      88290.00, 85347.00, 82404.00, 79461.00, &
     &      76518.00, 73575.00, 70632.00, 67689.00, &
     &      64746.00, 61803.00, 58860.00, 55917.00, &
     &      52974.00, 50031.00, 47088.00, 44145.00, &
     &      41202.00, 38259.00, 35316.00, 32373.00, &
     &      29430.00, 26487.00, 23544.00, 20601.00, &
     &      17658.00, 14715.00, 11772.00, 8829.00, &
     &      5886.00, 2943.00 /

      integer j_1ere_bombe !  numero du premier essai nucleaire de la journee en cours (486 au total)
      integer nbombe ! pour savoir si c'est un jour de bombe et le nombre de bombes durant ce jour

#ifdef ISOVERIF
      call iso_verif_noNaN_vect2D(xt_seri, &
     &     'iso_tritium 66: debut iso_tritium',ntraciso,klon,klev)
#endif
     
! ---------------------------------------------------------------------     
! initialisation
! ---------------------------------------------------------------------
      !pi=4.*atan(1.)
      !masse_tritium=33.3388E-27
      !tau_decroissance_tritium=560520955.6
      
      do ixt=1,ntraciso
      do i=1,klon
      do k=1,klev
      d_xt_cosmo(ixt,i,k)=0.
      d_xt_prod_nucl(ixt,i,k)=0.
      d_xt_decroiss(ixt,i,k)=0.         
      enddo
      enddo
      enddo

!#ifdef ISOVERIF
!      do kb=1,nlev_prod
!      write(*,*) 'iso_tritium 103'
!      write(*,*) 'kb, p_ref', kb, p_ref(kb)
!      enddo
!#endif


! ----------------------------------------------------------------------------
! Production naturelle de tritium --> d_xt_cosmo
! ----------------------------------------------------------------------------

! On passe des coordonnees geographiques a la latitude geomagnetique

       glat = 78.5*pi/180.
       glon = -69.0*pi/180.
       
       do i=1,klon
          qcos=sin(glat)*sin(latitude(i))
          qcos=qcos+cos(glat)*cos(latitude(i))*cos(longitude(i)-glon)
          if ( qcos .lt. -1.) qcos = -1.
          if ( qcos .gt. 1.) qcos = 1.
          rlat_geo(i)=pi/2.-acos(qcos)
       enddo


! Pour chaque niveau de pression atmospherique, on implemente a chaque bande de latitude
! la production de tritium
       
       if (iso_HTO.gt.0) then ! Tritium
       ixt=iso_HTO

       do i = 1,klon
       do k = 1,klev

! Determination du niveau k_ref dans la grille de reference
       k_ref = 1
       do kb = 1,nlev_prod
          if (p_ref(kb) .gt. pplay(i,k)) k_ref=kb
       enddo

       lat_geo=(180./pi)*abs(rlat_geo(i)) ! latitude geomagnetique
       ! Pour le moment, la production d_xt_cosmo est exprime en at/g/s

       if ( k_ref .eq. 1 ) then   
           if (lat_geo.ge.70.)                                  then
                   d_xt_cosmo(ixt,i,k) = 8.9433E-7
                   
           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) then 
                   d_xt_cosmo(ixt,i,k) = 8.9432E-7
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 8.9247E-7
                   
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 8.4992E-7
                   
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 7.655E-7
                   
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 6.9815E-7
                   
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 6.4847E-7
                   
           else    
                  d_xt_cosmo(ixt,i,k) = 6.2824E-7
           
           endif       
       endif
       
       
       if ( k_ref .eq. 2 ) then    
           if (lat_geo.ge.60.)                                  then
                   d_xt_cosmo(ixt,i,k) = 1.736E-6
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.171E-6
                   
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.1121E-6
                   
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 9.9709E-7
                   
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 9.0662E-7
                   
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 8.3986E-7
                   
           else    
                   d_xt_cosmo(ixt,i,k) = 8.1299E-7
           
           endif        
       endif
       
       
       if ( k_ref .eq. 3 ) then     
           if (lat_geo.ge.60.)                                  then
                   d_xt_cosmo(ixt,i,k) = 1.5402E-6
           
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.5365E-6
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.4552E-6
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.2989E-6
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.1775E-6
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.0879E-6
           
           else    
                   d_xt_cosmo(ixt,i,k) = 1.0522E-6
           
           endif    
       endif
       
       
       if ( k_ref .eq. 4 ) then     
           if (lat_geo.ge.60.)                                  then
                   d_xt_cosmo(ixt,i,k) = 2.0198E-6
           
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.0145E-6
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.9024E-6
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.6901E-6
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.5273E-6
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.4072E-6
           
           else    
                   d_xt_cosmo(ixt,i,k) = 1.3599E-6
           
           endif    
       endif
       
       
       if ( k_ref .eq. 5 ) then     
           if (lat_geo.ge.70.)                                  then
                   d_xt_cosmo(ixt,i,k) = 2.6465E-6
           
           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.6464E-6
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.6389E-6
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.4846E-6
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.1965E-6
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.9785E-6
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.8177E-6
           
           else    
                   d_xt_cosmo(ixt,i,k) = 1.755E-6
           
           endif    
       endif
       
       
       if ( k_ref .eq. 6 ) then     
           if (lat_geo.ge.70.)                                  then
                   d_xt_cosmo(ixt,i,k) = 3.4646E-6
           
           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) then
                   d_xt_cosmo(ixt,i,k) = 3.4645E-6
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 3.454E-6
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 3.2415E-6
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.851E-6
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.5595E-6
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.3444E-6
           
           else    
                   d_xt_cosmo(ixt,i,k) = 2.2613E-6
           
           endif    
       endif
       
       
       if ( k_ref .eq. 7 ) then     
           if (lat_geo.ge.70.)                                  then
                   d_xt_cosmo(ixt,i,k) = 4.5316E-6
           
           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) then
                   d_xt_cosmo(ixt,i,k) = 4.5315E-6
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 4.5166E-6
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 4.2244E-6
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 3.6958E-6
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 3.3062E-6
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 3.0191E-6
           
           else    
                   d_xt_cosmo(ixt,i,k) = 2.909E-6
           
           endif    
       endif
       
       
       if ( k_ref .eq. 8 ) then     
           if (lat_geo.ge.70.)                                  then
                   d_xt_cosmo(ixt,i,k) = 5.9217E-6
           
           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) then
                   d_xt_cosmo(ixt,i,k) = 5.9216E-6
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 5.9006E-6
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 5.499E-6
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 4.7842E-6
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 4.2644E-6
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 3.8815E-6
           
           else    
                   d_xt_cosmo(ixt,i,k) = 3.736E-6
           
           endif    
       endif
       
       
       if ( k_ref .eq. 9 ) then     
           if (lat_geo.ge.70.)                                  then
                   d_xt_cosmo(ixt,i,k) = 7.7309E-6
           
           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) then
                   d_xt_cosmo(ixt,i,k) = 7.7307E-6
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 7.701E-6
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 7.1498E-6
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 6.1842E-6
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 5.4915E-6
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 4.9818E-6
           
           else    
                   d_xt_cosmo(ixt,i,k) = 4.7894E-6
           
           endif    
       endif
       
       
       if ( k_ref .eq. 10 ) then     
           if (lat_geo.ge.60.)                                  then
                   d_xt_cosmo(ixt,i,k) = 1.0082E-5
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.004E-5
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 9.2843E-6
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 7.9817E-6
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 7.0598E-6
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 6.3824E-6
           
           else    
                   d_xt_cosmo(ixt,i,k) = 6.1283E-6
           
           endif    
       endif
       
       
       if ( k_ref .eq. 11 ) then     
           if (lat_geo.ge.60.)                                  then
                   d_xt_cosmo(ixt,i,k) = 1.3135E-5
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.3076E-5
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.204E-5
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.0285E-5
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 9.0599E-6
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 8.1612E-6
           
           else    
                   d_xt_cosmo(ixt,i,k) = 7.8258E-6
           
           endif    
       endif
       
       
       if ( k_ref .eq. 12 ) then     
           if (lat_geo.ge.60.)                                  then
                   d_xt_cosmo(ixt,i,k) = 1.7093E-5
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.701E-5
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.5592E-5
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.3231E-5
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.1605E-5
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.0414E-5
           
           else    
                   d_xt_cosmo(ixt,i,k) = 9.9722E-6
           
           endif    
       endif
       
       
       if ( k_ref .eq. 13 ) then     
           if (lat_geo.ge.70.)                                  then
                   d_xt_cosmo(ixt,i,k) = 2.2217E-5
           
           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.2216E-5
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.21E-5
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.0162E-5
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.6989E-5
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.4835E-5
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.3261E-5
           
           else    
                   d_xt_cosmo(ixt,i,k) = 1.2679E-5
           
           endif    
       endif
       
       
       if ( k_ref .eq. 14 ) then     
           if (lat_geo.ge.70.)                                  then
                   d_xt_cosmo(ixt,i,k) = 2.8816E-5
           
           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.8815E-5
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.8652E-5
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.6002E-5
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.1746E-5
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.8898E-5
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.6822E-5
           
           else    
                   d_xt_cosmo(ixt,i,k) = 1.6056E-5
           
           endif    
       endif
       
       
       if ( k_ref .eq. 15 ) then     
           if (lat_geo.ge.70.)                                  then
                   d_xt_cosmo(ixt,i,k) = 3.7386E-5
           
           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) then
                   d_xt_cosmo(ixt,i,k) = 3.7384E-5
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 3.7157E-5
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 3.3546E-5
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.7847E-5
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.4084E-5
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.1349E-5
           
           else    
                   d_xt_cosmo(ixt,i,k) = 2.0343E-5
           
           endif    
       endif
       
       
       if ( k_ref .eq. 16 ) then     
           if (lat_geo.ge.70.)                                  then
                   d_xt_cosmo(ixt,i,k) = 4.8393E-5
           
           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) then
                   d_xt_cosmo(ixt,i,k) = 4.8392E-5
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 4.8073E-5
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 4.3156E-5
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 3.5536E-5
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 3.0578E-5
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.6983E-5
           
           else    
                   d_xt_cosmo(ixt,i,k) = 2.5663E-5
           
           endif    
       endif
       
       
       if ( k_ref .eq. 17 ) then     
           if (lat_geo.ge.70.)                                  then
                   d_xt_cosmo(ixt,i,k) = 6.2543E-5
           
           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) then
                   d_xt_cosmo(ixt,i,k) = 6.2541E-5
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 6.2097E-5
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 5.541E-5
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 4.5241E-5
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 3.8722E-5
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 3.4007E-5
           
           else    
                   d_xt_cosmo(ixt,i,k) = 3.228E-5
           
           endif    
       endif
       
       
       if ( k_ref .eq. 18 ) then     
           if (lat_geo.ge.70.)                                  then
                   d_xt_cosmo(ixt,i,k) = 8.0696E-5
           
           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) then
                   d_xt_cosmo(ixt,i,k) = 8.0693E-5
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 8.0074E-5
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 7.0993E-5
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 5.7449E-5
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 4.8897E-5
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 4.273E-5
           
           else    
                   d_xt_cosmo(ixt,i,k) = 4.0472E-5
           
           endif    
       endif
       
       
       if ( k_ref .eq. 19 ) then     
           if (lat_geo.ge.70.)                                  then
                   d_xt_cosmo(ixt,i,k) = 1.0393E-4
           
           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.0392E-4
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.0306E-4
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 9.0753E-5
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 7.2752E-5
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 6.1561E-5
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 5.3513E-5
           
           else    
                   d_xt_cosmo(ixt,i,k) = 5.057E-5
           
           endif    
       endif
       
       
       if ( k_ref .eq. 20 ) then     
           if (lat_geo.ge.60.)                                  then
                   d_xt_cosmo(ixt,i,k) = 1.3358E-4
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.3238E-4
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.1573E-4
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 9.1859E-5
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 7.7254E-5
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 6.678E-5
           
           else    
                   d_xt_cosmo(ixt,i,k) = 6.2953E-5
           
           endif    
       endif
       
       
       if ( k_ref .eq. 21 ) then     
           if (lat_geo.ge.70.)                                  then
                   d_xt_cosmo(ixt,i,k) = 1.7134E-4
           
           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.7133E-4
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.6968E-4
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.4718E-4
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.1561E-4
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 9.661E-5
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 8.3017E-5
           
           else    
                   d_xt_cosmo(ixt,i,k) = 7.8054E-5
           
           endif    
       endif
       
       
       if ( k_ref .eq. 22 ) then     
           if (lat_geo.ge.70.)                                  then
                   d_xt_cosmo(ixt,i,k) = 2.1926E-4
           
           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.1925E-4
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.1696E-4
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.8664E-4
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.45E-4
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.2036E-4
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.0277E-4
           
           else    
                   d_xt_cosmo(ixt,i,k) = 9.6352E-5
           
           endif    
       endif
       
       
       if ( k_ref .eq. 23 ) then     
           if (lat_geo.ge.70.)                                  then
                   d_xt_cosmo(ixt,i,k) = 2.7986E-4
           
           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.7984E-4
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.7669E-4
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.3591E-4
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.8117E-4
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.4931E-4
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.2663E-4
           
           else    
                   d_xt_cosmo(ixt,i,k) = 1.1836E-4
           
           endif    
       endif
       
       
       if ( k_ref .eq. 24 ) then     
           if (lat_geo.ge.70.)                                  then
                   d_xt_cosmo(ixt,i,k) = 3.5619E-4
           
           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) then
                   d_xt_cosmo(ixt,i,k) = 3.5617E-4
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 3.5183E-4
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.9712E-4
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.2536E-4
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.8436E-4
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.552E-4
           
           else    
                   d_xt_cosmo(ixt,i,k) = 1.446E-4
           
           endif    
       endif
       
       
       if ( k_ref .eq. 25 ) then     
           if (lat_geo.ge.70.)                                  then
                   d_xt_cosmo(ixt,i,k) = 4.5186E-4
           
           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) then
                   d_xt_cosmo(ixt,i,k) = 4.5183E-4
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 4.4587E-4
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 3.7264E-4
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.7894E-4
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.2638E-4
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.8906E-4
           
           else    
                   d_xt_cosmo(ixt,i,k) = 1.7554E-4
           
           endif    
       endif
       
       
       if ( k_ref .eq. 26 ) then     
           if (lat_geo.ge.70.)                                  then
                   d_xt_cosmo(ixt,i,k) = 5.7102E-4
           
           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) then
                   d_xt_cosmo(ixt,i,k) = 5.7098E-4
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 5.628E-4
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 4.6503E-4
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 3.4318E-4
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.7618E-4
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.2861E-4
           
           else    
                   d_xt_cosmo(ixt,i,k) = 2.1146E-4
           
           endif    
       endif
       
       
       if ( k_ref .eq. 27 ) then     
           if (lat_geo.ge.70.)                                  then
                   d_xt_cosmo(ixt,i,k) = 7.1820E-4
           
           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) then
                   d_xt_cosmo(ixt,i,k) = 7.1815E-4
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 7.0693E-4
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 5.7675E-4
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 4.1904E-4
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 3.3416E-4
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.7389E-4
           
           else    
                   d_xt_cosmo(ixt,i,k) = 2.5228E-4
           
           endif    
       endif
       
       
       if ( k_ref .eq. 28 ) then     
           if (lat_geo.ge.70.)                                  then
                   d_xt_cosmo(ixt,i,k) = 8.9801E-4
           
           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) then
                   d_xt_cosmo(ixt,i,k) = 8.9794E-4
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 8.8255E-4
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 7.0966E-4
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 5.0671E-4
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 4.0001E-4
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 3.242E-4
           
           else    
                   d_xt_cosmo(ixt,i,k) = 2.9724E-4
           
           endif    
       endif
       
       
       if ( k_ref .eq. 29 ) then     
           if (lat_geo.ge.70.)                                  then
                   d_xt_cosmo(ixt,i,k) = 1.1145E-3
           
           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.1144E-3
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.0932E-3
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 8.6421E-4
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 6.0487E-4
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 4.7209E-4
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 3.7768E-4
           
           else    
                   d_xt_cosmo(ixt,i,k) = 3.4441E-4
           
           endif    
       endif
       
       
       if ( k_ref .eq. 30 ) then     
           if (lat_geo.ge.70.)                                  then
                   d_xt_cosmo(ixt,i,k) = 1.3709E-3
           
           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.3708E-3
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.3415E-3
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.0387E-3
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 7.1001E-4
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 5.4689E-4
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 4.3085E-4
           
           else    
                   d_xt_cosmo(ixt,i,k) = 3.9032E-4
           
           endif    
       endif
       
       
       if ( k_ref .eq. 31 ) then     
           if (lat_geo.ge.70.)                                  then
                   d_xt_cosmo(ixt,i,k) = 1.6712E-3
           
           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.671E-3
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.63E-3
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.2296E-3
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 8.1648E-4
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 6.1899E-4
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 4.787E-4
           
           else    
                   d_xt_cosmo(ixt,i,k) = 4.2993E-4
           
           endif    
       endif
       
       
       if ( k_ref .eq. 32 ) then     
           if (lat_geo.ge.70.)                                  then
                   d_xt_cosmo(ixt,i,k) = 2.0296E-3
           
           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.0293E-3
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.9704E-3
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.4366E-3
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 9.1906E-4
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 6.8278E-4
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 5.1594E-4
           
           else    
                   d_xt_cosmo(ixt,i,k) = 4.5743E-4
           
           endif    
       endif
       
       
       if ( k_ref .eq. 33 ) then     
           if (lat_geo.ge.70.)                                  then
                   d_xt_cosmo(ixt,i,k) = 2.4971E-3
           
           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.4967E-3
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 2.4078E-3
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.6751E-3
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.017E-3
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 7.3425E-4
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 5.3723E-4
           
           else    
                   d_xt_cosmo(ixt,i,k) = 4.662E-4
           
           endif    
       endif
       
       
       if ( k_ref .eq. 34 ) then     
           if (lat_geo.ge.70.)                                  then
                   d_xt_cosmo(ixt,i,k) = 3.2169E-3
           
           else if ( (lat_geo.ge.60.0) .and. (lat_geo.lt.70.0) ) then
                   d_xt_cosmo(ixt,i,k) = 3.2161E-3
                   
           else if ( (lat_geo.ge.50.0) .and. (lat_geo.lt.60.0) ) then
                   d_xt_cosmo(ixt,i,k) = 3.0665E-3
           
           else if ( (lat_geo.ge.40.0) .and. (lat_geo.lt.50.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.9861E-3
           
           else if ( (lat_geo.ge.30.0) .and. (lat_geo.lt.40.0) ) then
                   d_xt_cosmo(ixt,i,k) = 1.1059E-3
           
           else if ( (lat_geo.ge.20.0) .and. (lat_geo.lt.30.0) ) then
                   d_xt_cosmo(ixt,i,k) = 7.6337E-4
           
           else if ( (lat_geo.ge.10.0) .and. (lat_geo.lt.20.0) ) then
                   d_xt_cosmo(ixt,i,k) = 5.2801E-4
           
           else    
                   d_xt_cosmo(ixt,i,k) = 4.4129E-4
           
           endif    
       endif
       
!#ifdef ISOVERIF
!          if (k.eq.klev) then
!          write(*,*) 'iso_tritium 1096'
!          write(*,*) 'ixt,i,k,klev=',ixt,i,k,klev
!          write(*,*) 'rlat,rlatd=',rlat(i),rlatd(i)
!          write(*,*) 'rlon,rlond=',rlon(i),rlond(i)
!          write(*,*) 'rlat_geo(i), lat_geo=',rlat_geo(i),lat_geo
!          write(*,*) 'pplay(i,k)=',pplay(i,k)
!          write(*,*) 'k_ref=',k_ref
!          write(*,*) 'd_xt_cosmo(ixt,i,k)=',d_xt_cosmo(ixt,i,k)
!          endif
!#endif


#ifdef ISOVERIF
          if (iso_verif_positif_strict_nostop(d_xt_cosmo(ixt,i,k), &
     &      'iso_tritium 1110 : d_xt_cosmo negatif ou pas').eq.1) then
          write(*,*) 'i,k,klev=',i,k,klev
          write(*,*) 'latitude_deg,latitude=',latitude_deg(i),latitude(i)
          write(*,*) 'longitude_deg,longitude=',longitude_deg(i),longitude(i)
          write(*,*) 'rlat_geo(i), lat_geo=',rlat_geo(i),lat_geo
          write(*,*) 'pplay(i,k)=',pplay(i,k)
          write(*,*) 'kb,k_ref, p_ref=',kb,k_ref,p_ref(kb)
          stop
          endif
#endif
          
       enddo
       enddo
       endif
       
! Conversion de la production naturelle de tritium en kg(HTO)/kg(air)/s
! Facteur 1.3/0.7 : test augmentation/baisse de 30% de la production naturelle de tritium
      do ixt=1,ntraciso
      do i=1,klon
      do k=1,klev
         d_xt_cosmo(ixt,i,k)=d_xt_cosmo(ixt,i,k)*masse_tritium*1000.
#ifdef ISOVERIF
         if ((iso_HTO.gt.0).and.(ixt.eq.iso_HTO)) then
            if (d_xt_cosmo(ixt,i,k).eq.0) then
               write(*,*) 'prod cosmo nulle iso_tritium 1134'
               write(*,*) 'ixt,i,k',ixt,i,k
               write(*,*) 'masse_tritium', masse_tritium
               stop
            endif
!            if ((k.eq.klev).and.(ixt.eq.iso_HTO)) then
!               write(*,*) 'iso_tritium 1140'
!               write(*,*) 'ixt,i,k,klev=',ixt,i,k,klev
!               write(*,*) 'pplay(i,k)=',pplay(i,k)
!               write(*,*) 'masse_tritium', masse_tritium
!               write(*,*) 'd_xt_cosmo(ixt,i,k)=',d_xt_cosmo(ixt,i,k)
!            endif
         endif
#endif
      enddo
      enddo
      enddo
  

#ifdef ISOVERIF
      do ixt=1,ntraciso ! boucler sur tous les isotopes
          do i=1,klon ! boucler sur toutes les points horizontaux
          do k=1,klev ! boucler sur l'échelle vertical
            if (iso_verif_noNAN_nostop(d_xt_cosmo(ixt,i,k), &
     &         'iso_tritium cosmo 1151').eq.1) then
          write(*,*) 'ixt,i,k,klev=',ixt,i,k,klev
          write(*,*) 'latitude_deg,latitude=',latitude_deg(i),latitude(i)
          write(*,*) 'longitude_deg,longitude=',longitude_deg(i),longitude(i)
          write(*,*) 'rlat_geo(i), lat_geo=',rlat_geo(i),lat_geo
          write(*,*) 'pplay(i,k)=',pplay(i,k)
          write(*,*) 'kb,k_ref, p_ref=',kb,k_ref,p_ref(kb)
          write(*,*) 'masse tritium=', masse_tritium
          stop
            endif
          enddo
          enddo
      enddo
#endif

#ifdef ISOVERIF
      call iso_verif_noNaN_vect2D(xt_seri, &
     &     'iso_tritium 1167: apres d_xt_cosmo',ntraciso,klon,klev)
#endif


! --------------------------------------------------------------------------------
! Production de tritium liee aux essais nucleaires --> d_xt_prod_nucl
! --------------------------------------------------------------------------------
       
      if (ok_prod_nucl_tritium) then ! production nucleaire de tritium = true 
          
          if (iso_HTO.gt.0) then ! Tritium
             ixt=iso_HTO 
             
             ! on verifie si la date dans la simulation est un jour d'essai nucleaire 
             CALL date_prod_nucl_HTO(j_1ere_bombe, nbombe)
           write(*,*) 'iso_tritium 1183, apres call date_prod_nucl_HTO'
           write(*,*) 'j_1ere_bombe, nbombe', j_1ere_bombe, nbombe
 
             if (nbombe.ge.1) then ! si c'est un jour avec un ou plusieurs essais nucleaires
                 CALL lancer_bombes(nbombe, j_1ere_bombe, &
     &                              zphi, &
     &                              paprs,  &
     &                              d_xt_prod_nucl)
             endif ! if (nbombe.ge.1)
                 
          endif ! if tritium
      
      endif ! if ok_prod_nucl_tritium

#ifdef ISOVERIF
      do ixt=1,ntraciso ! boucler sur tous les isotopes
      do i=1,klon ! boucler sur toutes les points horizontaux
      do k=1,klev ! boucler sur l'échelle verticle
         if ((.not.ok_prod_nucl_tritium).or. &
     &       (iso_HTO.eq.0).or.(ixt.ne.iso_HTO).or. &
     &      (nbombe.eq.0)) then
            if (d_xt_prod_nucl(ixt,i,k).ne.0.) then
            write(*,*) 'iso_tritium 1208 apres d_xt_prod_nucl'
            write(*,*) 'la prod nucleaire d isotopes devrait etre nulle'
            write(*,*) 'ixt, i, k', ixt, i, k
            write(*,*) 'd_xt_prod_nucl', d_xt_prod_nucl(ixt,i,k)
            stop
            endif
         endif
      enddo
      enddo
      enddo
#endif 

#ifdef ISOVERIF
      do ixt=1,ntraciso ! boucler sur tous les isotopes
          do i=1,klon ! boucler sur toutes les points horizontaux
          do k=1,klev ! boucler sur l'échelle verticae
            if (iso_verif_noNAN_nostop(d_xt_prod_nucl(ixt,i,k), &
     &         'iso_tritium prod nucl 1225').eq.1) then
          write(*,*) 'ixt,i,k,latitude_deg(i)',ixt,i,k,latitude_deg(i)
          stop
            endif
          enddo
          enddo
      enddo
#endif

#ifdef ISOVERIF
      call iso_verif_noNaN_vect2D(xt_seri, &
     &     'iso_tritium 1236: apres d_xt_prod_nucl',ntraciso,klon,klev)
#endif


! ------------------------------------------------------------------------
! Definition de la decroissance radioactive du tritium --> d_xt_decroiss
! ------------------------------------------------------------------------
#ifdef ISOTRAC
        if (iso_HTO.gt.0) then
        write(*,*) 'cas pas prevu, a coder'
        ! utiliser index_iso au lieu de ixt dans la condition ci dessous
        ! et vérifier ailleurs
        stop
        endif
#endif
        do ixt=1,ntraciso ! boucler sur tous les isotopes
           if ((iso_HTO.gt.0).and.(ixt.eq.iso_HTO)) then ! Tritium
           do i=1,klon ! boucler sur toutes les points horizontaux
           do k=1,klev ! boucler sur l'échelle verticale
           d_xt_decroiss(ixt,i,k)=-xt_seri(ixt,i,k) &
     &     *1./tau_decroissance_tritium
           enddo
           enddo
           endif
        enddo ! fin de la boucle en ntraciso

#ifdef ISOVERIF
      call iso_verif_noNaN_vect2D(xt_seri, &
     &     'iso_tritium 1257: apres d_xt_decroiss',ntraciso,klon,klev)
#endif


! ----------------------------------------------------------------------
! concentration totale de tritium --> calcul de xt_seri
! ----------------------------------------------------------------------

      do ixt=1,ntraciso ! boucler sur tous les isotopes
         do i=1,klon ! boucler sur toutes les points horizontaux
         do k=1,klev ! boucler sur l'échelle verticale
            xt_seri(ixt,i,k)=xt_seri(ixt,i,k) &
     &      +d_xt_cosmo(ixt,i,k)*dtime &
     &      +d_xt_prod_nucl(ixt,i,k)*dtime &
     &      +d_xt_decroiss(ixt,i,k)*dtime


!#ifdef ISOVERIF
!      if ((ixt.eq.iso_HTO).and.(k.ge.(klev-2))) then !ok
!         write(*,*) 'iso_tritium 1284 - test concentration totale' 
!         write(*,*) 'ixt,i,k,klev=',ixt,i,k,klev
!         write(*,*) 'rlat,rlon=',rlat(i),rlon(i)
!         write(*,*) 'dtime=', dtime
!         write(*,*) 'd_xt_cosmo(ixt,i,k)=',d_xt_cosmo(ixt,i,k)
!         write(*,*) 'd_xt_prod_nucl(ixt,i,k)=',d_xt_prod_nucl(ixt,i,k)
!      endif
!#endif

         enddo
         enddo
      enddo

#ifdef ISOVERIF
      call iso_verif_noNaN_vect2D(xt_seri, &
     &     'iso_tritium 1289: fin de iso_tritium',ntraciso,klon,klev)
#endif


      return
      end subroutine iso_tritium

!===================================================================
!
!   End subroutine iso_tritium
!
!===================================================================



!===================================================================
!
! Subroutine chargement des tableaux de donnees pour production 
! nucleaire de tritium --> call dans iso_init.F
!
!===================================================================

      SUBROUTINE table_tritium_nucl()
        USE isotopes_mod, ONLY: ok_prod_nucl_tritium,nessai, &
     &                            day_nucl,month_nucl,year_nucl, &
     &                            lat_nucl,lon_nucl, &
     &                            zmin_nucl,zmax_nucl, &
     &                            HTO_nucl
#ifdef ISOVERIF
        USE isotopes_verif_mod
#endif
      implicit none

!     Arguments
      !integer nessai
      !integer day_nucl(nessai), month_nucl(nessai), year_nucl(nessai)
      !real lat_nucl(nessai), lon_nucl(nessai)
      !real  zmin_nucl(nessai) ,zmax_nucl(nessai)
      !real HTO_nucl(nessai)

!     local
      integer iessai


      if (ok_prod_nucl_tritium) then

      ! tableau pour day_nucl
      open(30, file='day_nucl.txt')
         do iessai=1,nessai
         read(30,*) day_nucl(iessai)
         enddo
      close(30)

      ! tableau pour month_nucl
      open(31, file='month_nucl.txt')
         do iessai=1,nessai
         read(31,*) month_nucl(iessai)
         enddo
      close(31)

      ! tableau pour year_nucl
      open(32, file='year_nucl.txt')
         do iessai=1,nessai
         read(32,*) year_nucl(iessai)
         enddo
      close(32)

      ! tableau pour lat_nucl
      open(33, file='lat_nucl.txt')
         do iessai=1,nessai
         read(33,*) lat_nucl(iessai)
         enddo
      close(33)

      ! tableau pour lon_nucl
      open(34, file='lon_nucl.txt')
         do iessai=1,nessai
         read(34,*) lon_nucl(iessai)
         enddo
      close(34)

      ! tableau pour zmin_nucl
      open(35, file='zmin_nucl.txt')
         do iessai=1,nessai
         read(35,*) zmin_nucl(iessai)
         enddo
      close(35)

      ! tableau pour zmax_nucl
      open(36, file='zmax_nucl.txt')
         do iessai=1,nessai
         read(36,*) zmax_nucl(iessai)
         enddo
      close(36)

      ! tableau pour HTO_nucl
      open(37, file='HTO_nucl.txt')
         do iessai=1,nessai
         read(37,*) HTO_nucl(iessai)
         enddo
      close(37)



      else 

      do iessai=1,nessai
         day_nucl(iessai)   = 0
         month_nucl(iessai) = 0
         year_nucl(iessai)  = 0
         lat_nucl(iessai)   = 0.
         lon_nucl(iessai)   = 0.
         zmin_nucl(iessai)  = 0.
         zmax_nucl(iessai)  = 0.
         HTO_nucl(iessai)   = 0.
      enddo

      endif ! if (ok_prod_nucl_tritium)

      return
      end subroutine table_tritium_nucl

!===================================================================
!
! Subroutines production nucleaire utilisees par iso_tritium
!
!===================================================================

! Subroutines pour la production nucleaire de tritium :
! 1. Les donnees (temps, localisation, quantite de tritium injecte) sont
!    chargees prealablement dans la subroutine table_tritium_nucl qui
!    est appelee dans iso_init.F. Ces donnees sont mis dans le COMMON
!    de wateriso2
! 2. Determiner si le jour dans la simulation correspond a un jour d'un
!    essai nucleaire, connaitre la ligne correspondante dans le
!    fichier de forcage de production nucleaire, et savoir le nombres 
!    de bombes nbombe dans cette journee --> subroutine 
!    date_prod_nucl_HTO
! 3. Si oui (nbombe > 0), on utilise la subroutine lancer_bombes qui va
!    definir les variables de localisation et quantite de tritium
!    produit avec le bon nombre de bombes dans la journee et appeler les
!    deux subroutines suivantes
! 4. subroutine coord_prod_nucl_HTO --> pour la localisation de l'essai
!    nucleaire sur (klon,klev)
! 5. calcul de la production de tritium (kg) (a partir de P_HTO dans le tableau 
!    repertoriant tous les essais nucleaires) etalee uniformement sur la journee 
!    entre zmin et zmax --> subroutine calcul_prod_nucl_HTO


! --------------------------------------------------------------------------------
! date_prod_nucl_HTO
! --------------------------------------------------------------------------------
       SUBROUTINE date_prod_nucl_HTO(j_1ere_bombe, nbombe)
! anciennement:
!        !date_prod_nucl_HTO(ntest, day_essai, month_essai, &
!     &                               year_essai, j_1ere_bombe, nbombe)

      use phys_cal_mod ! pour le calendrier
      use isotopes_mod, only: nessai, day_nucl, month_nucl, year_nucl
      implicit none

      ! Arguments
      integer nbombe,j_1ere_bombe ! pour un jour dans la simulation, on cherche le nombre de bombes nbombe de la journee et la ligne correspondant a la 1ere bombe de cette journee
!      integer day_essai(nessai),month_essai(nessai),year_essai(nessai) ! date (jour, mois, annee) des essais nucleaires

      ! local
      integer j ! indices
 
      ! initialisation
      nbombe=0
      j_1ere_bombe=0
      write(*,*) 'iso_tritium 1456, subroutine date_prod_nucl_HTO'
      write(*,*) 'Date dans la simulation:',day_cur,mth_cur,year_cur

      do j=1,nessai ! il faut que le tableau d'entree soit dans l'ordre chronologique
         if (nbombe.eq.0) then
            if ((day_cur.eq.day_nucl(j)).and. &
     &          (mth_cur.eq.month_nucl(j)).and. &
     &          (year_cur.eq.year_nucl(j))) then
            nbombe=1
            j_1ere_bombe=j
            endif
         else
            if ((day_cur.eq.day_nucl(j)).and. &
     &         (mth_cur.eq.month_nucl(j)).and. &
     &         (year_cur.eq.year_nucl(j))) then
               nbombe=nbombe+1
            else
               exit
            endif
         endif
!#ifdef ISOVERIF
!      write(*,*) 'controle subroutine date_prod_nucl_HTO' !ok
!      write(*,*) 'day_cur, mth_cur, year_cur',day_cur,mth_cur,year_cur
!      write(*,*) 'j, nessai', j, nessai
!      write(*,*) 'nbombe,  j_1ere_bombe', nbombe, j_1ere_bombe
!      write(*,*) 'day_nucl(j), month_nucl(j), year_nucl(j)',
!     :            day_nucl(j), month_nucl(j), year_nucl(j)
!#endif
      enddo
             

      return
      end subroutine date_prod_nucl_HTO



! --------------------------------------------------------------------------------
! lancer_bombes
! --------------------------------------------------------------------------------

      SUBROUTINE lancer_bombes(nbombe, j_1ere_bombe, &
     &                         zphi, &
     &                         paprs,  &
     &                         prod_nucl_HTO)
! anciennement:
! lancer_bombes(iim, jjm, nbombe, j_1ere_bombe, &
!     &                         klon, klev, zphi, &
!     &                         rlat, rlon, paprs, airephy, &
!     &                         lat_essai, lon_essai, &
!     &                         zmin_essai, zmax_essai, &
!     &                         HTO_essai, ntest, &
!     &                         prod_nucl_HTO)

        use isotopes_mod, only: nessai, lat_nucl, lon_nucl, &
&               zmin_nucl, zmax_nucl, HTO_nucl
        USE dimphy, only: klon,klev
        use geometry_mod, only: latitude_deg,longitude_deg
#ifdef ISOVERIF
        USE isotopes_verif_mod
#endif
      implicit none

!     Arguments
      !integer iim, jjm
      integer nbombe, j_1ere_bombe
      !integer klon, klev
      !integer ntest
      real zphi(klon,klev)
      !real rlat(klon), rlon(klon)
      real paprs(klon,klev+1)
      !real lat_nucl(ntest), lon_nucl(ntest) ! latitude et longitude des essais nucleaires
      !real zmin_nucl(ntest), zmax_nucl(ntest) ! altitudes min et max des nbombes champignons atomiques
      !real HTO_nucl(ntest) ! production de HTO en kg par les essais nucleaires
      real prod_nucl_HTO(ntraciso,klon,klev) ! calcul de la production de tritium (kg/kg d'air) liee aux essais nucleaire de la journee --> d_xt_prod_nucl(ntraciso,klon,klev)

!     local
      integer ibombe,jessai
      real lat_HTO, lon_HTO ! latitude et longitude de l'essai nucleaire jessai
      real zmin_HTO, zmax_HTO ! altitudes min et max du champignon atomique jessai
      real P_HTO ! production de HTO en kg de l'essai nucleaire jessai
      integer coord_HTO 
      integer kmin_HTO, kmax_HTO ! coordonnees lat, lon, zmin et zmax de l'essai nucleaire jessai

      do ibombe=1,nbombe
         jessai=j_1ere_bombe+ibombe-1
         lat_HTO = lat_nucl(jessai)
         lon_HTO = lon_nucl(jessai)
         zmin_HTO = zmin_nucl(jessai)
         zmax_HTO = zmax_nucl(jessai)
         P_HTO = HTO_nucl(jessai)
!#ifdef ISOVERIF !ok
!      write(*,*) 'controle subroutine lancer_bombes'
!      write(*,*) 'ibombe, nbombe', ibombe, nbombe
!      write(*,*) 'jessai, j_1ere_bombe', jessai, j_1ere_bombe
!      write(*,*) 'lat_HTO, lon_HTO', lat_HTO, lon_HTO
!      write(*,*) 'zmin_HTO, zmax_HTO', zmin_HTO, zmax_HTO
!      write(*,*) 'P_HTO', P_HTO 
!#endif
         
        CALL coord_prod_nucl_HTO(zphi, &
     &                            lat_HTO, lon_HTO, &
     &                            zmin_HTO, zmax_HTO, &
     &                            coord_HTO,  &
     &                            kmin_HTO,kmax_HTO)
            
         if (coord_HTO.gt.0) then ! quand on trouve les coordonnees de l'essai nucleaire dans la simulation
       write(*,*) 'iso_tritium 1552 dans subroutine lancer_bombes'
       write(*,*) 'Apres call coord_prod_nucl_HTO pour coord_HTO>0'
       write(*,*) 'ibombe, nbombe', ibombe, nbombe
       write(*,*) 'coord_HTO',coord_HTO
       write(*,*) 'latitude_deg(coord_HTO), longitude_deg(coord_HTO)', & 
     &             latitude_deg(coord_HTO), longitude_deg(coord_HTO)
       write(*,*) 'kmin_HTO, kmax_HTO', kmin_HTO, kmax_HTO

         CALL calcul_prod_nucl_HTO(P_HTO,coord_HTO, &
     &                             kmin_HTO,kmax_HTO, &
     &                             paprs, &
     &                             prod_nucl_HTO)
         endif

      enddo

      return
      end SUBROUTINE lancer_bombes
! --------------------------------------------------------------------------------
! coord_prod_nucl_HTO
! --------------------------------------------------------------------------------
      SUBROUTINE coord_prod_nucl_HTO(zphi, &
     &                               lat_jessai, lon_jessai,  &
     &                               zmin_jessai, zmax_jessai, &
     &                               coord_jessai,& 
     &                               kmin_jessai,kmax_jessai)
        USE dimphy, only: klon,klev
        USE geometry_mod, ONLY: latitude_deg,longitude_deg
#ifdef ISOVERIF
        USE isotopes_verif_mod
#endif
        USE dimensions_mod, ONLY: iim, jjm, llm, ndm
        USE yomcst_mod_h

      IMPLICIT NONE



! pour avoir iim et jjm

!     Arguments
      !integer klon, klev ! indices grilles horizontales et verticales
      !integer iim, jjm ! nombre de mailles en longitude et latitude 
      real zphi(klon,klev) ! input-R-geopotentiel de chaque couche (reference ocean, en m2/s2)
      !real rlat(klon), rlon(klon) ! latitude et longitude en degres
      real lat_jessai, lon_jessai ! latitude et longitude de l'essai nucleaire jessai
      real zmin_jessai, zmax_jessai ! altitudes min et max du champignon atomique jessai
      integer coord_jessai, kmin_jessai, kmax_jessai ! coordonnees lat, lon, zmin et zmax en sortie de la subroutine de l'essai nucleaire jessai

!     local
      integer i,k ! pour le boucles
      real dlat, dlon ! pas en latitude et longitude
      real alt(klon,klev) ! altitude a chaque niveau

!     initialisation
      kmin_jessai=0
      kmax_jessai=0
      coord_jessai=0

      !dlat=180./jjm
      !dlon=(2.*180.)/iim
      
       do i=1,klon
         do k=1,klev
           alt(i,k)=zphi(i,k)/RG
         enddo
       enddo

!#ifdef ISOVERIF !ok
!       do i=1,klon
!       do k=1,klev
!          write(*,*) 'i,k,RG',i,k,RG
!          write(*,*) 'zphi', zphi(i,k)
!          write(*,*) 'alt', alt(i,k)
!       enddo
!       enddo
!#endif
      
      do i=1,klon
        ! ajout Camille Risi 14 aout 2017: calcul local de dlat et dlon en cas
        ! de grille zoomée
        if (i.gt.1) then
          dlon=longitude_deg(i)-longitude_deg(i-1)
        else
          dlon=longitude_deg(i+1)-longitude_deg(i)
        endif        
        if (i.gt.iim) then
          dlat=latitude_deg(i)-latitude_deg(i-iim)
        else
          dlat=latitude_deg(i+iim)-latitude_deg(i)
        endif
#ifdef ISOVERIF
        call iso_verif_positif(dlon-0.1,'iso_routines 18504a')
        call iso_verif_positif(30.0-dlon,'iso_routines 18504b')
        call iso_verif_positif(dlat-0.1,'iso_routines 18504c')
        call iso_verif_positif(20.0-dlat,'iso_routines 18504d')
#endif
         if (((latitude_deg(i)-dlat/2.).le.lat_jessai).and. &
     &       ((latitude_deg(i)+dlat/2.).gt.lat_jessai).and. &
     &       ((longitude_deg(i)-dlon/2.).le.lon_jessai).and. &
     &       ((longitude_deg(i)+dlon/2.).gt.lon_jessai)) then
                coord_jessai=i
                if (alt(i,1).ge.zmin_jessai)    kmin_jessai = 1 ! si base du champignon est plus bas que le niveau 1 dans le modele
                if (alt(i,1).ge.zmax_jessai)    kmax_jessai = 2 ! si le haut du champignon est plus bas que le niveau 1 du modele
                if (alt(i,klev).lt.zmin_jessai) kmin_jessai = klev  ! si base du champignon est plus haut que le niveau klev dans le modele
                if (alt(i,klev).lt.zmax_jessai) kmax_jessai = klev ! si le haut du champignon est plus haut que le niveau klev du modele
                do k=1,klev-1
                    if ((alt(i,k).lt.zmin_jessai).and. &
     &                  (alt(i,k+1).ge.zmin_jessai)) then
                         kmin_jessai = max(1,k) ! si base du champignon est entre le niveau k et k+1
                    endif

                    if ((alt(i,k).lt.zmax_jessai).and. &
     &                  (alt(i,k+1).ge.zmax_jessai)) then
                         kmax_jessai = min(k+1,klev) ! si le haut du champignon est entre le niveau k et k+1
                    endif
                enddo ! boucle klev
            exit ! on arrete la boucle le long de klon quand on a trouve les bonnes coordonnees
         endif ! trouve les bonnes coordonnees sur klon
      enddo ! boucle klon

#ifdef ISOVERIF
      if (kmin_jessai.gt.kmax_jessai) then ! on plante si kmin>=kmax pour k<klev
         write(*,*) 'Pb subroutine coord_prod_nucl_HTO (kmin>kmax)'
         write(*,*) 'coord_jessai', coord_jessai
         write(*,*) 'lon_nucl, lat_nucl', lon_jessai, lat_jessai
         write(*,*) 'zmin_nucl, zmax_nucl', zmin_jessai, zmax_jessai
         write(*,*) 'kmin,kmax',kmin_jessai,kmax_jessai
         stop
       endif

      if ((kmin_jessai.eq.klev).and.(kmax_jessai.ne.klev)) then ! on plante si on n'a pas kmax=klev quand kmin=klev
         write(*,*) 'Pb subroutine coord_prod_nucl_HTO (kmin=klev)'
         write(*,*) 'coord_jessai', coord_jessai
         write(*,*) 'lon_nucl, lat_nucl', lon_jessai, lat_jessai
         write(*,*) 'zmin_nucl, zmax_nucl', zmin_jessai, zmax_jessai
         write(*,*) 'kmin,kmax',kmin_jessai,kmax_jessai
         stop
      endif
#endif

!#ifdef ISOVERIF 
!      write(*,*) 'controle subroutine coord_prod_nucl_HTO' !ok
!      write(*,*) 'iim,jjm,dlat,dlon',iim,jjm,dlat,dlon
!      write(*,*) 'indice coord_HTO', coord_jessai
!      write(*,*) 'latitude_deg, lat_HTO',latitude_deg(coord_jessai),lat_jessai
!      write(*,*) 'longitude_deg, lon_HTO',longitude_deg(coord_jessai),lon_jessai
!      write(*,*) 'kmin_HTO, kmax_HTO', kmin_jessai, kmax_jessai
!      write(*,*) 'alt_min(k), alt_min(k+1), zmin_HTO', 
!     :            alt(coord_jessai,kmin_jessai),
!     :            alt(coord_jessai,kmin_jessai+1),
!     :            zmin_jessai
!      write(*,*) 'alt_max(k), alt_max(k+1), zmax_HTO',
!     :            alt(coord_jessai,kmax_jessai),
!     :            alt(coord_jessai,kmax_jessai+1),
!     :            zmax_jessai
!#endif
      
      return
      end SUBROUTINE coord_prod_nucl_HTO




! --------------------------------------------------------------------------------
! calcul_prod_nucl_HTO
! --------------------------------------------------------------------------------
      SUBROUTINE calcul_prod_nucl_HTO(P_jessai,coord_jessai, &
     &                                kmin_jessai,kmax_jessai, &
     &                                paprs, &
     &                                prod_nucl)
        USE isotopes_mod, ONLY: iso_HTO
        USE geometry_mod, ONLY: cell_area
        USE dimphy, ONLY: klon,klev
#ifdef ISOVERIF
        USE isotopes_verif_mod
#endif
        USE yomcst_mod_h

      IMPLICIT NONE



!     Arguments
      real P_jessai ! production de HTO en kg par l'essai nucleaire jessai
      integer coord_jessai ! indice de coordonnee lat(coord_jessai) et lon(coord_jessai) de l'essai nucleaire jessai
      integer kmin_jessai, kmax_jessai ! indice de hauteur (ou pression) min et max du champignon atomique jessai
      !integer klon, klev
      real paprs(klon,klev+1)  ! input-R-pression pour chaque inter-couche (en Pa) 
      !real airephy(klon) ! aire d'une grille (m2)
      real prod_nucl(ntraciso,klon,klev) ! calcul de la production de HTO en kg par kg d'air sur la journee entre zmin et zmax --> d_xt_prod_nucl

!     local
      integer ixt,i,j,k ! pour les boucles
      real day_sec ! 1 jour en secondes
      real prod_nucl_tmp(klon,klev) ! calcul de la production de HTO en kg/kg d'air pour l'essai nucleaire jessai

      day_sec = 86400.
      ixt=iso_HTO
      j = coord_jessai
      do i=1,klon
      do k=1,klev
         prod_nucl_tmp(i,k)=0.
      enddo
      enddo
!#ifdef ISOVERIF
!      write(*,*) 'ixt,j,coord_HTO',ixt,j,coord_jessai !ok
!      write(*,*) 'kmin_HTO, kmax_HTO', kmin_jessai, kmax_jessai
!      write(*,*) 'day_sec, P_HTO', day_sec, P_jessai
!#endif

      if (kmin_jessai.lt.klev) then ! si kmin < klev, normalement kmin < kmax
         do k=kmin_jessai,kmax_jessai
              prod_nucl_tmp(j,k) =  &
     &          (P_jessai/day_sec)/(  &
     &          (paprs(j,kmin_jessai)-paprs(j,kmax_jessai)) &
     &          /RG*cell_area(j)       ) 
              prod_nucl(ixt,j,k)=prod_nucl(ixt,j,k)+prod_nucl_tmp(j,k)
#ifdef ISOVERIF
       if (kmin_jessai.ge.kmax_jessai) then
       write(*,*) 'Pb subroutine calcul_prod_nucl_HTO (k<klev)'
       write(*,*) 'kmin_HTO devrait etre plus petit que kmax_HTO'
       write(*,*) 'kmin_HTO,kmax_HTO',kmin_jessai,kmax_jessai
       write(*,*) 'ixt,i,k',ixt,j,k
       write(*,*) 'coord_HTO', coord_jessai
       stop
       endif

       if ((prod_nucl_tmp(j,k).le.0.).or. &
     &      (prod_nucl(ixt,j,k).le.0.)) then
       write(*,*) 'Pb subroutine calcul_prod_nucl_HTO (k<klev)'
       write(*,*) 'prod_nucl_tmp(i,k) ou d_xt_prod_nucl devraient etre positifs'
       write(*,*) 'ixt,i,k',ixt,j,k
       write(*,*) 'RG, cell_area=', RG, cell_area(j)
       write(*,*) 'coord_HTO,kmin_HTO,kmax_HTO', &
     &               coord_jessai,kmin_jessai,kmax_jessai
       write(*,*) 'P_HTO, day_sec', P_jessai, day_sec
       write(*,*) 'paprs(coord_HTO,kmin),paprs(coord_HTO,kmax)', &
     &               paprs(j,kmin_jessai), paprs(j,kmax_jessai)
       write(*,*) 'prod_nucl_tmp(i,k)', prod_nucl_tmp(j,k)
       write(*,*) 'd_xt_prod_nucl(ixt,i,k)',prod_nucl(ixt,j,k)
       stop
       endif
#endif
         enddo
      else  ! si kmin = klev (et donc kmax = klev si tout va bien)
         do k=kmin_jessai,kmax_jessai
              prod_nucl_tmp(j,k) = &
     &          (P_jessai/day_sec)/( &
     &          (paprs(j,kmin_jessai)-paprs(j,kmax_jessai+1)) &
     &          /RG*cell_area(j)       )
              prod_nucl(ixt,j,k)=prod_nucl(ixt,j,k)+prod_nucl_tmp(j,k)
#ifdef ISOVERIF
       if ((kmin_jessai.ne.kmax_jessai).and. &
     &     (kmin_jessai.ne.klev)) then
       write(*,*) 'Pb subroutine calcul_prod_nucl_HTO (k=klev)'
       write(*,*) 'kmin_HTO et kmax_HTO devraient etre egaux a klev'
       write(*,*) 'kmin_HTO,kmax_HTO',kmin_jessai,kmax_jessai
       write(*,*) 'ixt,i,k',ixt,j,k
       write(*,*) 'coord_HTO', coord_jessai
       stop
       endif

       if ((prod_nucl_tmp(j,k).le.0.).or. &
     &     (prod_nucl(ixt,j,k).le.0.)) then
       write(*,*) 'Pb subroutine calcul_prod_nucl_HTO (k=klev)'
       write(*,*) 'prod_nucl_tmp(i,k) ou d_xt_prod_nucl devraient etre positifs'
       write(*,*) 'ixt,i,k',ixt,j,k
       write(*,*) 'RG, cell_area(i)', RG, cell_area(j)
       write(*,*) 'coord_HTO,kmin_HTO,kmax_HTO', &
     &               coord_jessai,kmin_jessai,kmax_jessai
       write(*,*) 'P_HTO, day_sec', P_jessai, day_sec
       write(*,*) 'paprs(coord_HTO,kmin),paprs(coord_HTO,kmax+1)', &
     &               paprs(j,kmin_jessai), paprs(j,kmax_jessai+1)
       write(*,*) 'prod_nucl_tmp(i,k)', prod_nucl_tmp(j,k)
       write(*,*) 'd_xt_prod_nucl(ixt,i,k)',prod_nucl(ixt,j,k)
       stop
       endif
#endif
         enddo
      endif

!#ifdef ISOVERIF
!      do i=1,klon
!      do k=1,klev
!         write(*,*) 'controle calcul_prod_nucl_HTO' !ok
!         write(*,*) 'call if ok_prod_nucl_tritium, iso_HTO, nbombe>=1'
!         write(*,*) 'klon, klev', klon, klev
!         write(*,*) 'ixt, i, k', ixt, i, k
!         write(*,*) 'RG, cell_area(i)', RG, cell_area(i)
!         write(*,*) 'coord_HTO,kmin_HTO,kmax_HTO',
!     :               coord_jessai,kmin_jessai,kmax_jessai
!         write(*,*) 'P_HTO, day_sec', P_jessai, day_sec
!         write(*,*) 'paprs(coord_HTO,kmin),paprs(coord_HTO,kmax)',
!     :               paprs(coord_jessai,kmin_jessai), 
!     :               paprs(coord_jessai,kmax_jessai)
!         write(*,*) 'd_xt_prod_nucl(ixt,i,k)', prod_nucl(ixt,i,k)
!      enddo
!      enddo
!#endif

      return
      end subroutine calcul_prod_nucl_HTO

!#endif
!===================================================================
!
!   End subroutines utilisees par iso_tritium
!
!===================================================================

! ces routines propres au water tagging sont dépacées ici pour éviter les
! dépendances circulaires
#ifdef ISOTRAC

        subroutine condiso_liq_ice_vectiso_trac(xt,qt,cond, &
     &           tcond,zfice,zxtice,zxtliq)

    USE isotopes_mod, ONLY: iso_eau,iso_HDO,essai_convergence, &
&       bidouille_anti_divergence,ridicule
!    USE isotopes_routines_mod, ONLY: condiso_liq_ice_vectiso
    use isotrac_mod, only: index_iso, index_zone,option_traceurs,izone_cond
#ifdef ISOVERIF
    USE isotopes_verif_mod
#endif
        implicit none

        ! version vectorisée de condiso_liq_ice
        ! on fait d'un coup tous les iso de 1 à niso
        !d'un point de grille donnée
        
        ! déclarations
        ! **inputs
        real xt(ntraciso),qt,cond,tcond,zfice ! tcond en K        
        ! **outputs
        real zxtice(ntraciso),zxtliq(ntraciso)
        ! **locals
        integer ixt
        real zcond
        integer ieau,izone,iiso
        real zcondtrac,qttrac
        real xttrac(ntraciso),zxtliqtrac(ntraciso), &
     &           zxticetrac(ntraciso)
        ! normallement, niso en dimension suffirait, mais serait pas
        ! cohérent avec les dimensions dans condiso_liq_ice
!INCLUDE "iso_verif.h"

        ! verif que qt n'est pas nul
        if (qt.eq.0) then
            if (cond.lt.ridicule) then
              do ixt=1,ntraciso  
                zxtliq(ixt)=0
                zxtice(ixt)=0
              enddo
              return
            else
                ! c'est impossible de condenser qi pas d'eau au départ
                write(*,*) 'condiso_liq_ice_vectiso_trac 35'
                write(*,*) 'qt=',qt
                write(*,*) 'cond=',cond
                stop
            endif
        endif !if (qt.eq.0) then
        zcond=max(0.0,min(cond,qt))

#ifdef ISOVERIF
       do izone=1,ntraceurs_zone
          ieau=index_trac(izone,iso_eau) 
          call iso_verif_positif((qt-xt(ieau))*1e-4,'condisotrac 54')
       enddo
       call iso_verif_traceur(xt(1),'condisotrac 56')
#endif        
        
        do izone=1,ntraceurs_zone
          ieau=index_trac(izone,iso_eau)
          qttrac=xt(ieau)
          zcondtrac=(zcond/qt)*xt(ieau)
          zcondtrac=min(zcondtrac,qttrac)
          do iiso=1,niso          
            xttrac(iiso)=xt(index_trac(izone,iiso))
          enddo
          call condiso_liq_ice_vectiso(xttrac,qttrac,zcondtrac, &
     &           tcond,zfice,zxticetrac,zxtliqtrac)
!          write(*,*) 'zxticetrac=',zxticetrac
          do iiso=1,niso          
            zxtice(index_trac(izone,iiso))=zxticetrac(iiso)
            zxtliq(index_trac(izone,iiso))=zxtliqtrac(iiso)
          enddo
#ifdef ISOVERIF  
        if (iso_HDO.gt.0) then 
              if (zcondtrac.gt.ridicule) then
                  if (iso_verif_aberrant_nostop(zxtice(iso_HDO)/cond &
     &             /faccond,'condiso_trac 79').eq.1) then
                  write(*,*) 'izone=',izone
                  write(*,*) 'zcondtrac/qttrac=',cond/qt
                  write(*,*) 'deltaD(xt(iso_HDO)/qt)=', &
     &                           deltaD(xttrac(iso_HDO)/qttrac)
                  write(*,*) 'tcond=',tcond-273,'°C' 
                  if (tcond-273.gt.-40.0) then
                      ! au dessus de -40, il y a de quoi s'inquiéter
                      ! en dessous, on ne sait pas ce que valent les alphas
                     stop
                  endif !if (tcond(i).gt.100.0) then
                  endif
                endif !if (cond.gt.ridicule) then 
            endif !if (iso_HDO.gt.0) then
#endif          
        enddo ! do izone=1,ntraceurs_zone 

#ifdef ISOVERIF      
!        write(*,*) 'zxtice=',zxtice  
!        write(*,*) 'zcond=',zcond
!        write(*,*) 'xt=',xt
!        write(*,*) 'qt=',qt
        call iso_verif_traceur(zxtliq(1), &
     &          'condiso_liq_ice_vectiso_trac 194')
        call iso_verif_traceur_justmass(zxtice(1), &
     &          'condiso_liq_ice_vectiso_trac 196')
        ! on ne peut pas faire pour xt
#endif

        if (option_traceurs.eq.17) then
           ! colorier le condensat en un tag spécifique
           do ixt=1,ntraciso
             if (index_zone(ixt).eq.izone_cond) then
                zxtliq(ixt)=zxtliq(index_iso(ixt))
                zxtice(ixt)=zxtice(index_iso(ixt))
             else !if (index_zone(ixt).eq.izone_cond) then
                zxtliq(ixt)=0.0
                zxtice(ixt)=0.0
             endif !if (index_zone(ixt).eq.izone_cond) then
           enddo !do ixt=1,ntraciso      
        endif !if (option_traceurs.eq.17) then
#ifdef ISOVERIF
        call iso_verif_traceur(zxtliq(1), &
     &          'condiso_liq_ice_vectiso_trac 122')
        call iso_verif_traceur_justmass(zxtice(1), &
     &          'condiso_liq_ice_vectiso_trac 124')
#endif

        return
        end subroutine condiso_liq_ice_vectiso_trac


        subroutine condiso_liq_ice_vectall_trac(xt,qt,cond, &
     &           tcond,zfice,zxtice,zxtliq,n)

    USE isotopes_mod, ONLY: iso_eau,iso_HDO,iso_O18,bidouille_anti_divergence, &
&       ridicule
!    USE isotopes_routines_mod, only: condiso_liq_ice_vectall
    use isotrac_mod, only: index_iso, index_zone,option_traceurs,izone_cond, &
&        ridicule_trac
#ifdef ISOVERIF
USE isotopes_verif_mod
#endif
        implicit none

        ! version vectorisée de condiso_liq_ice
        ! on fait d'un coup tous les lieux i de 1 à n
        ! et tous les iso de 1 à niso
        
        ! déclarations
        ! **inputs
        integer n
        real xt(ntraciso,n),qt(n),cond(n),tcond(n),zfice(n) ! tcond en K        
        ! **outputs
        real zxtice(ntraciso,n),zxtliq(ntraciso,n)
        ! **locals
        integer ixt, i ! compteurs
        real zcond(n)
!#ifdef ISOVERIF
!        integer iso_verif_aberrant_nostop ! debugage
!        integer iso_verif_aberrant_choix_nostop
!        real deltaD
!#endif 
        integer izone,ieau,iiso
        real zcondtrac(n),qttrac(n)
        real xttrac(ntraciso,n),zxtliqtrac(ntraciso,n), &
     &           zxticetrac(ntraciso,n)
        ! normallement, niso en dimension suffirait, mais serait pas
        ! cohérent avec les dimensions dans condiso_liq_ice

!#ifdef ISOVERIF
!        write(*,*) 'condisotrac 112: entrée, n=',n
!#endif

!        ! verif qt pas nul
!        do i=1,n
!          if (qt(i).eq.0) then
!            if (cond(i).lt.ridicule) then
!              do ixt=1,ntraciso  
!                zxtliq(ixt,i)=0
!                zxtice(ixt,i)=0
!              enddo
!              return
!            else
!                ! c'est impossible de condenser qi pas d'eau au départ
!                write(*,*) 'condiso_liq_ice_vectall_trac 119'
!                write(*,*) 'qt=',qt(i)
!                write(*,*) 'cond=',cond(i)
!                stop
!            endif
!          endif !if (qt(i).eq.0) then
!        enddo !do i=1,n

        do i=1,n
             zcond(i)=max(0.0,min(cond(i),qt(i)))
        enddo

#ifdef ISOVERIF  
        do i=1,n
          call iso_verif_traceur(xt(1,i), &
     &          'condiso_liq_ice_vectall_trac 132')
        enddo !do i=1,n
#endif

                

        do izone=1,ntraceurs_zone    
          ieau=index_trac(izone,iso_eau)
          do i=1,n
            qttrac(i)=xt(ieau,i)
            if (qt(i).gt.0.0) then ! modif C Risi juillet 2020 ! remodif Camille 9 mars 2023
!            if ((qt(i).gt.0.0).and.(xt(ieau,i).gt.0.0)) then
               zcondtrac(i)=(zcond(i)/qt(i))*qttrac(i)
            else !if (qt(i).eq.0) then
#ifdef ISOVERIF              
                call iso_verif_egalite(cond(i),0.0,'condisotrac 195')
#endif
                zcondtrac(i)=0.0
            endif !if (qt(i).eq.0) then
            zcondtrac(i)=min(zcondtrac(i),qttrac(i))
            do iiso=1,niso          
              xttrac(iiso,i)=xt(index_trac(izone,iiso),i)
            enddo ! do iiso=1,niso
#ifdef ISOVERIF
            if (iso_eau.gt.0) then
              call iso_verif_egalite_choix(qttrac(i), &
     &           xttrac(iso_eau,i),'condisotrac 148', &
     &           errmax,errmaxrel)
            endif
            if (iso_HDO.gt.0) then
                call iso_verif_aberrant_choix(xttrac(iso_HDO,i), &
     &           qttrac(i),ridicule_trac,deltalimtrac, &
     &           'condisotrac 205')
            endif
            call iso_verif_positif(qt(i)-cond(i), &
     &           'condisotrac 163: cond>qt')
            call iso_verif_positif(qttrac(i)-zcondtrac(i), &
     &           'condisotrac 165: cond>qt')
#endif            
          enddo !do i=1,n
#ifdef ISOVERIF          
!          write(*,*) 'condisotrac 164: avant condiso, izone=',izone
#endif           
          call condiso_liq_ice_vectall(xttrac,qttrac,zcondtrac, &
     &           tcond,zfice,zxticetrac,zxtliqtrac,n)

          do i=1,n
          do iiso=1,niso          
            zxtice(index_trac(izone,iiso),i)=zxticetrac(iiso,i)
            zxtliq(index_trac(izone,iiso),i)=zxtliqtrac(iiso,i)
          enddo
          enddo !do i=1,n
        enddo !do izone=1,ntraceurs_zone
!        write(*,*) 'zxtice(1:ntraciso,2)=',
!     :           zxtice(1:ntraciso,2)
!        write(*,*) 'zxtliq(1:ntraciso,2)=',
!     :           zxtliq(1:ntraciso,2)

#ifdef ISOVERIF  
        do i=1,n          
          call iso_verif_traceur(zxtliq(1,i), &
     &          'condiso_liq_ice_vectall_trac 144')
          call iso_verif_traceur(zxtice(1,i), &
     &          'condiso_liq_ice_vectall_trac 146')
        enddo !do i=1,n
#endif

        return
        end subroutine condiso_liq_ice_vectall_trac
#endif

subroutine iso_init_ideal(q,xt,ixt,alpha,kcin,toce)

        USE isotopes_mod, ONLY: iso_eau,iso_HDO,ridicule
#ifdef ISOVERIF
        USE isotopes_verif_mod
#endif
        implicit none

        ! inputs
        real q ! humidité spec
        integer ixt ! indice isotopique
        real alpha ! coef frac à l'eq
        real kcin ! coef frac cinétique
        real toce ! rapport iso ds ocean surface

        ! outputs
        real xt ! equivalent iso de l'humidité spec, même unité.

        ! locals
        real RMerlivat
        real q0,h0 ! conditions initiales de la distill de Rayleigh
        parameter (q0=20e-3,h0=0.7)

        ! verifier que ixt est un isotope et pas un tagging
        if (ixt.gt.niso) then
          CALL abort_physic('isotopes_routines_mod', 'iso_init_ideal, ixt>niso', 1)
        endif

        ! R selon Merlivat:
        RMerlivat=toce/alpha *(1.0-kcin)/(1.0-kcin*h0)

        ! R d'après Rayleigh
        xt=q*RMerlivat*(min(q0,q)/q0)**(alpha-1.0)

#ifdef ISOVERIF
        call iso_verif_noNaN(xt, 'isotopes_routines_mod 18930a: iso_init_ideal')
        if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) then
            if (q.gt.ridicule) then
                    write(*,*) 'xt,q=',xt,q
                    write(*,*) 'alpha=',alpha
                    write(*,*) 'toce,kcin,h0=',toce,kcin,h0
                    write(*,*) 'RMerlivat=',RMerlivat
                call iso_verif_aberrant_encadre( xt/q, 'isotopes_routines_mod 18930b: iso_init_ideal')
            endif
        endif
        if ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) then
             call iso_verif_egalite(xt,q, 'isotopes_routines_mod 18930c: iso_init_ideal')
        endif
#endif
        

end subroutine iso_init_ideal


subroutine appel_stewart_debug(lwork,nloc,inb,na,i, &
                evap,water,rpprec,rr,wdtrain, &
                xtevap,xtwater,xtp,xt,xtwdtrain)
USE isotopes_mod, ONLY: iso_eau, iso_HDO,thumxt1, &
&       bidouille_anti_divergence,ridicule,Rdefault
use infotrac_phy, ONLY: ntraciso=>ntiso, niso
#ifdef ISOTRAC
    use isotrac_mod, only: option_cond,izone_cond,index_iso,index_zone,izone_poubelle
#endif
#ifdef ISOVERIF
USE isotopes_verif_mod
#endif
implicit none


! inputs
integer nloc,na,i ! dimension horiz effective
logical lwork(nloc)
real wdtrain(nloc),xtwdtrain(ntraciso,nloc)
real xt(ntraciso,nloc,na)
real evap(nloc,na),water(nloc,na),rpprec(nloc,na),rr(nloc,na)
integer inb(nloc)

! outputs
real xtevap(ntraciso,nloc,na),xtwater(ntraciso,nloc,na),xtp(ntraciso,nloc,na)

! locals
integer il,ixt

     do il=1,nloc
       if (i.le.inb(il) .and. lwork(il)) then
          if (wdtrain(il).gt.0.) then
            do ixt=1,ntraciso
             xtwater(ixt,il,i)= xtwdtrain(ixt,il)/wdtrain(il)*water(il,i)
             xtevap(ixt,il,i)= xtwdtrain(ixt,il)/wdtrain(il)*evap(il,i)
            enddo
          else !if (wdtrain(il).gt.0.) then
            do ixt=1,niso
             xtwater(ixt,il,i)= Rdefault(ixt)*water(il,i)
             xtevap(ixt,il,i)= Rdefault(ixt)*evap(il,i)
            enddo
#ifdef ISOTRAC
            do ixt=1+niso,ntraciso
             if (index_zone(ixt).eq.izone_poubelle) then
               xtwater(ixt,il,i)= Rdefault(index_iso(ixt))*water(il,i)
               xtevap(ixt,il,i)= Rdefault(index_iso(ixt))*evap(il,i)
             else
               xtwater(ixt,il,i)= 0.
               xtevap(ixt,il,i)=0.
             endif
            enddo ! do ixt=1+niso,ntraciso
#endif 
         endif !if (wdtrain(il).gt.0.) then
         do ixt=1,ntraciso
             xtp(ixt,il,i)= xt(ixt,il,i)/rr(il,i)*rpprec(il,i)
         enddo !do ixt=1,ntraciso
      endif
    enddo ! do il=1,ncum
end subroutine appel_stewart_debug


subroutine dispatch(klon,klev,qx,q_seri,xt_seri,ql_seri,xtl_seri,qs_seri,xts_seri)

use infotrac_phy, ONLY: nqtot,nqo,ivap,iliq,isol,iqIsoPha,ntraciso=>ntiso
implicit none

! inputs
integer, intent(in) :: klon,klev
real,dimension(klon,klev,nqtot), intent(in) ::qx

! outputs
real,dimension(klon,klev), intent(out) ::q_seri,ql_seri,qs_seri
real,dimension(ntraciso,klon,klev), intent(out) :: xt_seri,xtl_seri,xts_seri

! locals
integer :: i,k,ixt

do k=1,klev
do i=1,klon
    q_seri(i,k)  = qx(i,k,ivap)
    ql_seri(i,k) = qx(i,k,iliq)
    IF (nqo.EQ.2) THEN             !--vapour and liquid only
             qs_seri(i,k) = 0.
    ELSE IF (nqo.ge.3) THEN        !--vapour, liquid and ice
             qs_seri(i,k) = qx(i,k,isol)
    ENDIF
    do ixt=1,ntraciso
          xt_seri(ixt,i,k)  = qx(i,k,iqIsoPha(ixt,ivap))
          xtl_seri(ixt,i,k) = qx(i,k,iqIsoPha(ixt,iliq))
          if (nqo.eq.2) then
             xts_seri(ixt,i,k) = 0.
          else if (nqo.eq.3) then
             xts_seri(ixt,i,k) = qx(i,k,iqIsoPha(ixt,isol))
          endif
    enddo !do ixt=1,niso

enddo
enddo

end subroutine dispatch

subroutine together(klon,klev,qx,q_seri,xt_seri,ql_seri,xtl_seri,qs_seri,xts_seri)

use infotrac_phy, ONLY: nqtot,nqo,ivap,iliq,isol,iqIsoPha,ntraciso=>ntiso
implicit none

! inputs
integer, intent(in) :: klon,klev
real,dimension(klon,klev), intent(in) ::q_seri,ql_seri,qs_seri
real,dimension(ntraciso,klon,klev), intent(in) :: xt_seri,xtl_seri,xts_seri

! inputs
real,dimension(klon,klev,nqtot), intent(out) ::qx

! locals
integer :: i,k,ixt

do k=1,klev
do i=1,klon  
    qx(i,k,ivap)  = q_seri(i,k)
    qx(i,k,iliq) = ql_seri(i,k)
    IF (nqo.ge.3) THEN        !--vapour, liquid and ice
             qx(i,k,isol) = qs_seri(i,k)
    ENDIF
    do ixt=1,ntraciso
          qx(i,k,iqIsoPha(ixt,ivap)) = xt_seri(ixt,i,k)  
          qx(i,k,iqIsoPha(ixt,iliq)) = xtl_seri(ixt,i,k)
          if (nqo.ge.3) then
             qx(i,k,iqIsoPha(ixt,isol)) = xts_seri(ixt,i,k)
          endif
    enddo !do ixt=1,niso

enddo
enddo

end subroutine together


END MODULE isotopes_routines_mod
#endif
