source: LMDZ6/branches/cirrus/libf/dyn3d/qminimum.F @ 5875

!
! $Header$
!
      SUBROUTINE qminimum( q,nqtot,deltap )

      USE infotrac, ONLY: niso, ntiso, iqIsoPha, tracers, addPhase
      USE strings_mod, ONLY: strIdx
      IMPLICIT none
c
c  -- Objet : Traiter les valeurs trop petites (meme negatives)
c             pour l'eau vapeur et l'eau liquide
c
      include "dimensions.h"
      include "paramet.h"
c
      INTEGER nqtot
      REAL q(ip1jmp1,llm,nqtot), deltap(ip1jmp1,llm)
c
      LOGICAL, SAVE :: first=.TRUE.
      INTEGER, SAVE :: iq_vap, iq_liq        ! indices pour l'eau vapeur/liquide
      REAL, PARAMETER :: seuil_vap = 1.0e-10 ! seuil pour l'eau vapeur
      REAL, PARAMETER :: seuil_liq = 1.0e-11 ! seuil pour l'eau liquide
c
c  NB. ....( Il est souhaitable mais non obligatoire que les valeurs des
c            parametres seuil_vap, seuil_liq soient pareilles a celles 
c            qui  sont utilisees dans la routine    ADDFI       )
c     .................................................................
c
cDC iq_val and iq_liq are usable for q only, NOT for q_follow
c   and zx_defau_diag (crash if iq_val/liq==3) => vapor/liquid
c   water at hardcoded indices 1/2 in these variables
      INTEGER i, k, iq
      REAL zx_defau, zx_abc, zx_pump(ip1jmp1), pompe

      real zx_defau_diag(ip1jmp1,llm,2) 
      real q_follow(ip1jmp1,llm,2)
c
      REAL SSUM
c
      INTEGER imprim
      SAVE imprim
      DATA imprim /0/
      !INTEGER ijb,ije
      !INTEGER Index_pump(ij_end-ij_begin+1)
      !INTEGER nb_pump
      INTEGER ixt

      IF(first) THEN
         iq_vap = strIdx(tracers(:)%name, addPhase('H2O', 'g'))
         iq_liq = strIdx(tracers(:)%name, addPhase('H2O', 'l'))
         first = .FALSE.
      END IF
c
c Quand l'eau liquide est trop petite (ou negative), on prend
c l'eau vapeur de la meme couche et la convertit en eau liquide
c (sans changer la temperature !)
c

      call check_isotopes_seq(q,ip1jmp1,'qminimum 52')   

      zx_defau_diag(:,:,:)=0.0
      q_follow(:,:,1)=q(:,:,iq_vap)  
      q_follow(:,:,2)=q(:,:,iq_liq)  
      DO k = 1, llm
        DO i = 1, ip1jmp1
          if (seuil_liq - q(i,k,iq_liq) .gt. 0.d0 ) then

            if (niso > 0) zx_defau_diag(i,k,2)=AMAX1
     :               ( seuil_liq - q(i,k,iq_liq), 0.0 )

            q(i,k,iq_vap) = q(i,k,iq_vap) + q(i,k,iq_liq) - seuil_liq
            q(i,k,iq_liq) = seuil_liq
          endif
        ENDDO
      ENDDO
c
c Quand l'eau vapeur est trop faible (ou negative), on complete
c le defaut en prennant de l'eau vapeur de la couche au-dessous.
c
      DO k = llm, 2, -1
ccc      zx_abc = dpres(k) / dpres(k-1)
        DO i = 1, ip1jmp1
          if ( seuil_vap - q(i,k,iq_vap) .gt. 0.d0 ) then

            if (niso > 0) zx_defau_diag(i,k,1)
     &           = AMAX1( seuil_vap - q(i,k,iq_vap), 0.0 )

            q(i,k-1,iq_vap) = q(i,k-1,iq_vap) - (seuil_vap
     &           -q(i,k,iq_vap)) * deltap(i,k)/deltap(i,k-1)
            q(i,k,iq_vap)   =  seuil_vap  

          endif
        ENDDO
      ENDDO

c
c Quand il s'agit de la premiere couche au-dessus du sol, on
c doit imprimer un message d'avertissement (saturation possible).
c
      DO i = 1, ip1jmp1
         zx_pump(i) = AMAX1( 0.0, seuil_vap - q(i,1,iq_vap) )
         q(i,1,iq_vap)  = AMAX1( q(i,1,iq_vap), seuil_vap )
      ENDDO
      pompe = SSUM(ip1jmp1,zx_pump,1)
      IF (imprim.LE.500 .AND. pompe.GT.0.0) THEN
         WRITE(6,'(1x,"ATT!:on pompe de l eau au sol",e15.7)') pompe
         DO i = 1, ip1jmp1
            IF (zx_pump(i).GT.0.0) THEN
               imprim = imprim + 1
               PRINT*,'QMINIMUM:  en ',i,zx_pump(i)
            ENDIF
         ENDDO
      ENDIF

      !write(*,*) 'qminimum 128'
      if (niso > 0) then
      ! CRisi: traiter de même les traceurs d'eau
      ! Mais il faut les prendre à l'envers pour essayer de conserver la
      ! masse.
      ! 1) pompage dans le sol  
      ! On suppose que ce pompage se fait sans isotopes -> on ne modifie
      ! rien ici et on croise les doigts pour que ça ne soit pas trop
      ! génant
      DO i = 1,ip1jmp1
        if (zx_pump(i).gt.0.0) then
          q_follow(i,1,1)=q_follow(i,1,1)+zx_pump(i)
        endif !if (zx_pump(i).gt.0.0) then
      enddo !DO i = 1,ip1jmp1

      ! 2) transfert de vap vers les couches plus hautes
      !write(*,*) 'qminimum 139'
      do k=2,llm
        DO i = 1,ip1jmp1
          if (zx_defau_diag(i,k,1).gt.0.0) then             
              ! on ajoute la vapeur en k              
              do ixt=1,ntiso
               q(i,k,iqIsoPha(ixt,iq_vap))=q(i,k,iqIsoPha(ixt,iq_vap))
     :           +zx_defau_diag(i,k,1)
     :           *q(i,k-1,iqIsoPha(ixt,iq_vap))/q_follow(i,k-1,1)
                
              ! et on la retranche en k-1
               q(i,k-1,iqIsoPha(ixt,iq_vap))=
     :            q(i,k-1,iqIsoPha(ixt,iq_vap))
     :              -zx_defau_diag(i,k,1)
     :              *deltap(i,k)/deltap(i,k-1)
     :              *q(i,k-1,iqIsoPha(ixt,iq_vap))
     :              /q_follow(i,k-1,1)

              enddo !do ixt=1,niso
              q_follow(i,k,1)=   q_follow(i,k,1)
     :               +zx_defau_diag(i,k,1)
              q_follow(i,k-1,1)=   q_follow(i,k-1,1)
     :               -zx_defau_diag(i,k,1)
     :              *deltap(i,k)/deltap(i,k-1)
          endif !if (zx_defau_diag(i,k,1).gt.0.0) then
        enddo !DO i = 1, ip1jmp1        
       enddo !do k=2,llm

       call check_isotopes_seq(q,ip1jmp1,'qminimum 168')
        
      
        ! 3) transfert d'eau de la vapeur au liquide
        !write(*,*) 'qminimum 164'
        do k=1,llm
        DO i = 1,ip1jmp1
          if (zx_defau_diag(i,k,2).gt.0.0) then

              ! on ajoute eau liquide en k en k              
              do ixt=1,ntiso
               q(i,k,iqIsoPha(ixt,iq_liq))=q(i,k,iqIsoPha(ixt,iq_liq))
     :              +zx_defau_diag(i,k,2)
     :              *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,1)
              ! et on la retranche à la vapeur en k
               q(i,k,iqIsoPha(ixt,iq_vap))=q(i,k,iqIsoPha(ixt,iq_vap))
     :              -zx_defau_diag(i,k,2)
     :              *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,1)   
              enddo !do ixt=1,niso
              q_follow(i,k,2)=   q_follow(i,k,2)
     :               +zx_defau_diag(i,k,2)
              q_follow(i,k,1)=   q_follow(i,k,1)
     :               -zx_defau_diag(i,k,2)
          endif !if (zx_defau_diag(i,k,1).gt.0.0) then
        enddo !DO i = 1, ip1jmp1
       enddo !do k=2,llm  

       call check_isotopes_seq(q,ip1jmp1,'qminimum 197')

      endif !if (niso > 0) then
      !write(*,*) 'qminimum 188'
      
c
      RETURN
      END