source: LMDZ5/branches/LMDZ6_rc0/libf/phylmd/calwake.F90 @ 2568

! $Id: calwake.F90 2160 2014-11-28 15:36:29Z fairhead $

SUBROUTINE calwake(paprs, pplay, dtime, t, q, omgb, dt_dwn, dq_dwn, m_dwn, &
    m_up, dt_a, dq_a, sigd, wdt_pbl, wdq_pbl, udt_pbl, udq_pbl, wake_deltat, &
    wake_deltaq, wake_dth, wake_h, wake_s, wake_dens, wake_pe, wake_fip, &
    wake_gfl, dt_wake, dq_wake, wake_k, undi_t, undi_q, wake_omgbdth, &
    wake_dp_omgb, wake_dtke, wake_dqke, wake_dtpbl, wake_dqpbl, wake_omg, &
    wake_dp_deltomg, wake_spread, wake_cstar, wake_d_deltat_gw, wake_ddeltat, &
    wake_ddeltaq)
  ! **************************************************************
  ! *
  ! CALWAKE                                                     *
  ! interface avec le schema de calcul de la poche    *
  ! froide                                            *
  ! *
  ! written by   : CHERUY Frederique, 13/03/2000, 10.31.05      *
  ! modified by :  ROEHRIG Romain,    01/30/2007                *
  ! **************************************************************

  USE dimphy
  IMPLICIT NONE
  ! ======================================================================
  include "dimensions.h"
  ! #include "dimphy.h"
  include "YOMCST.h"

  ! Arguments
  ! ----------

  INTEGER i, l, ktopw(klon)
  REAL dtime

  REAL paprs(klon, klev+1), pplay(klon, klev)
  REAL t(klon, klev), q(klon, klev), omgb(klon, klev)
  REAL dt_dwn(klon, klev), dq_dwn(klon, klev), m_dwn(klon, klev)
  REAL m_up(klon, klev)
  REAL dt_a(klon, klev), dq_a(klon, klev)
  REAL wdt_pbl(klon, klev), wdq_pbl(klon, klev)
  REAL udt_pbl(klon, klev), udq_pbl(klon, klev)
  REAL wake_deltat(klon, klev), wake_deltaq(klon, klev)
  REAL dt_wake(klon, klev), dq_wake(klon, klev)
  REAL wake_d_deltat_gw(klon, klev)
  REAL wake_h(klon), wake_s(klon)
  REAL wake_dth(klon, klev)
  REAL wake_pe(klon), wake_fip(klon), wake_gfl(klon)
  REAL undi_t(klon, klev), undi_q(klon, klev)
  REAL wake_omgbdth(klon, klev), wake_dp_omgb(klon, klev)
  REAL wake_dtke(klon, klev), wake_dqke(klon, klev)
  REAL wake_dtpbl(klon, klev), wake_dqpbl(klon, klev)
  REAL wake_omg(klon, klev), wake_dp_deltomg(klon, klev)
  REAL wake_spread(klon, klev), wake_cstar(klon)
  REAL wake_ddeltat(klon, klev), wake_ddeltaq(klon, klev)
  REAL d_deltatw(klon, klev), d_deltaqw(klon, klev)
  INTEGER wake_k(klon)
  REAL sigd(klon)
  REAL wake_dens(klon)

  ! Variable internes
  ! -----------------

  REAL aire
  REAL p(klon, klev), ph(klon, klev+1), pi(klon, klev)
  REAL te(klon, klev), qe(klon, klev), omgbe(klon, klev+1)
  REAL dtdwn(klon, klev), dqdwn(klon, klev)
  REAL dta(klon, klev), dqa(klon, klev)
  REAL wdtpbl(klon, klev), wdqpbl(klon, klev)
  REAL udtpbl(klon, klev), udqpbl(klon, klev)
  REAL amdwn(klon, klev), amup(klon, klev)
  REAL dtw(klon, klev), dqw(klon, klev), dth(klon, klev)
  REAL d_deltat_gw(klon, klev)
  REAL dtls(klon, klev), dqls(klon, klev)
  REAL tu(klon, klev), qu(klon, klev)
  REAL hw(klon), sigmaw(klon), wape(klon), fip(klon), gfl(klon)
  REAL omgbdth(klon, klev+1), dp_omgb(klon, klev)
  REAL dtke(klon, klev), dqke(klon, klev)
  REAL dtpbl(klon, klev), dqpbl(klon, klev)
  REAL omg(klon, klev+1), dp_deltomg(klon, klev), spread(klon, klev)
  REAL cstar(klon)
  REAL sigd0(klon), wdens(klon)

  REAL rdcp

  ! print *, '-> calwake, wake_s ', wake_s(1)

  rdcp = 1./3.5


  ! -----------------------------------------------------------
  ! IM 290108     DO 999 i=1,klon   ! a vectoriser
  ! ----------------------------------------------------------


  DO l = 1, klev
    DO i = 1, klon
      p(i, l) = pplay(i, l)
      ph(i, l) = paprs(i, l)
      pi(i, l) = (pplay(i,l)/100000.)**rdcp

      te(i, l) = t(i, l)
      qe(i, l) = q(i, l)
      omgbe(i, l) = omgb(i, l)

      dtdwn(i, l) = dt_dwn(i, l)
      dqdwn(i, l) = dq_dwn(i, l)
      dta(i, l) = dt_a(i, l)
      dqa(i, l) = dq_a(i, l)
      wdtpbl(i, l) = wdt_pbl(i, l)
      wdqpbl(i, l) = wdq_pbl(i, l)
      udtpbl(i, l) = udt_pbl(i, l)
      udqpbl(i, l) = udq_pbl(i, l)
    END DO
  END DO

  omgbe(:, klev+1) = 0.

  DO i = 1, klon
    sigd0(i) = sigd(i)
  END DO
  ! print*, 'sigd0,sigd', sigd0, sigd(i)
  DO i = 1, klon
    ph(i, klev+1) = 0.
  END DO

  DO i = 1, klon
    ktopw(i) = wake_k(i)
  END DO

  DO l = 1, klev
    DO i = 1, klon
      dtw(i, l) = wake_deltat(i, l)
      dqw(i, l) = wake_deltaq(i, l)
    END DO
  END DO

  DO l = 1, klev
    DO i = 1, klon
      dtls(i, l) = dt_wake(i, l)
      dqls(i, l) = dq_wake(i, l)
    END DO
  END DO

  DO i = 1, klon
    hw(i) = wake_h(i)
    sigmaw(i) = wake_s(i)
  END DO

  ! fkc les flux de masses sont evalues aux niveaux et valent 0 a la surface
  ! fkc  on veut le flux de masse au milieu des couches

  DO l = 1, klev - 1
    DO i = 1, klon
      amdwn(i, l) = 0.5*(m_dwn(i,l)+m_dwn(i,l+1))
      amdwn(i, l) = (m_dwn(i,l+1))
    END DO
  END DO

  ! au sommet le flux de masse est nul

  DO i = 1, klon
    amdwn(i, klev) = 0.5*m_dwn(i, klev)
  END DO

  DO l = 1, klev
    DO i = 1, klon
      amup(i, l) = m_up(i, l)
    END DO
  END DO

  CALL wake(p, ph, pi, dtime, sigd0, te, qe, omgbe, dtdwn, dqdwn, amdwn, &
    amup, dta, dqa, wdtpbl, wdqpbl, udtpbl, udqpbl, dtw, dqw, dth, hw, &
    sigmaw, wape, fip, gfl, dtls, dqls, ktopw, omgbdth, dp_omgb, wdens, tu, &
    qu, dtke, dqke, dtpbl, dqpbl, omg, dp_deltomg, spread, cstar, &
    d_deltat_gw, d_deltatw, d_deltaqw)

  DO l = 1, klev
    DO i = 1, klon
      IF (ktopw(i)>0) THEN
        wake_deltat(i, l) = dtw(i, l)
        wake_deltaq(i, l) = dqw(i, l)
        wake_d_deltat_gw(i, l) = d_deltat_gw(i, l)
        wake_omgbdth(i, l) = omgbdth(i, l)
        wake_dp_omgb(i, l) = dp_omgb(i, l)
        wake_dtke(i, l) = dtke(i, l)
        wake_dqke(i, l) = dqke(i, l)
        wake_dtpbl(i, l) = dtpbl(i, l)
        wake_dqpbl(i, l) = dqpbl(i, l)
        wake_omg(i, l) = omg(i, l)
        wake_dp_deltomg(i, l) = dp_deltomg(i, l)
        wake_spread(i, l) = spread(i, l)
        wake_dth(i, l) = dth(i, l)
        dt_wake(i, l) = dtls(i, l)
        dq_wake(i, l) = dqls(i, l)
        undi_t(i, l) = tu(i, l)
        undi_q(i, l) = qu(i, l)
        wake_ddeltat(i, l) = d_deltatw(i, l)
        wake_ddeltaq(i, l) = d_deltaqw(i, l)
      ELSE
        wake_deltat(i, l) = 0.
        wake_deltaq(i, l) = 0.
        wake_d_deltat_gw(i, l) = 0.
        wake_omgbdth(i, l) = 0.
        wake_dp_omgb(i, l) = 0.
        wake_dtke(i, l) = 0.
        wake_dqke(i, l) = 0.
        wake_dtpbl(i, l) = 0.
        wake_dqpbl(i, l) = 0.
        wake_omg(i, l) = 0.
        wake_dp_deltomg(i, l) = 0.
        wake_spread(i, l) = 0.
        wake_dth(i, l) = 0.
        dt_wake(i, l) = 0.
        dq_wake(i, l) = 0.
        undi_t(i, l) = te(i, l)
        undi_q(i, l) = qe(i, l)
        wake_ddeltat(i, l) = 0.
        wake_ddeltaq(i, l) = 0.
      END IF
    END DO
  END DO

  DO i = 1, klon
    wake_h(i) = hw(i)
    wake_s(i) = sigmaw(i)
    wake_pe(i) = wape(i)
    wake_fip(i) = fip(i)
    wake_gfl(i) = gfl(i)
    wake_k(i) = ktopw(i)
    wake_cstar(i) = cstar(i)
    wake_dens(i) = wdens(i)
  END DO

  RETURN
END SUBROUTINE calwake