Changeset 2160 for LMDZ5/branches/testing/libf/phylmd/calwake.F90

Timestamp:

Nov 28, 2014, 4:36:29 PM (10 years ago)

Author:

Laurent Fairhead

Message:

Merged trunk changes -r2070:2158 into testing branch. Compilation problems introduced by revision r2155 have been corrected by hand

Location:

LMDZ5/branches/testing

Files:

• . (modified) (1 prop)
• libf/phylmd/calwake.F90 (modified) (1 diff)

LMDZ5/branches/testing/libf/phylmd/calwake.F90

@@ -233 +233 @@
   RETURN
 END SUBROUTINE calwake
-
-SUBROUTINE calwake_scal(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"
-  ! ccc#include "dimphy.h"
-  include "YOMCST.h"
-
-  ! Arguments
-  ! ----------
-
-  INTEGER i, l, ktopw
-  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+1), 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(klev), d_deltaqw(klev)
-  INTEGER wake_k(klon)
-  REAL sigd(klon)
-  REAL wake_dens(klon)
-
-  ! Variable internes
-  ! -----------------
-
-  REAL aire
-  REAL p(klev), ph(klev+1), pi(klev)
-  REAL te(klev), qe(klev), omgbe(klev), dtdwn(klev), dqdwn(klev)
-  REAL dta(klev), dqa(klev)
-  REAL wdtpbl(klev), wdqpbl(klev)
-  REAL udtpbl(klev), udqpbl(klev)
-  REAL amdwn(klev), amup(klev)
-  REAL dtw(klev), dqw(klev), dth(klev), d_deltat_gw(klev)
-  REAL dtls(klev), dqls(klev)
-  REAL tu(klev), qu(klev)
-  REAL hw, sigmaw, wape, fip, gfl
-  REAL omgbdth(klev), dp_omgb(klev)
-  REAL dtke(klev), dqke(klev)
-  REAL dtpbl(klev), dqpbl(klev)
-  REAL omg(klev+1), dp_deltomg(klev), spread(klev), cstar
-  REAL sigd0, wdens
-
-  REAL rdcp
-
-  ! print *, '-> calwake, wake_s ', wake_s(1)
-
-  rdcp = 1./3.5
-
-  ! -----------------------------------------------------------
-  DO i = 1, klon ! a vectoriser
-    ! ----------------------------------------------------------
-
-
-    DO l = 1, klev
-      p(l) = pplay(i, l)
-      ph(l) = paprs(i, l)
-      pi(l) = (pplay(i,l)/100000.)**rdcp
-
-      te(l) = t(i, l)
-      qe(l) = q(i, l)
-      omgbe(l) = omgb(i, l)
-
-      dtdwn(l) = dt_dwn(i, l)
-      dqdwn(l) = dq_dwn(i, l)
-      dta(l) = dt_a(i, l)
-      dqa(l) = dq_a(i, l)
-      wdtpbl(l) = wdt_pbl(i, l)
-      wdqpbl(l) = wdq_pbl(i, l)
-      udtpbl(l) = udt_pbl(i, l)
-      udqpbl(l) = udq_pbl(i, l)
-    END DO
-
-    sigd0 = sigd(i)
-    ! print*, 'sigd0,sigd', sigd0, sigd(i)
-    ph(klev+1) = 0.
-
-    ktopw = wake_k(i)
-
-    DO l = 1, klev
-      dtw(l) = wake_deltat(i, l)
-      dqw(l) = wake_deltaq(i, l)
-    END DO
-
-    DO l = 1, klev
-      dtls(l) = dt_wake(i, l)
-      dqls(l) = dq_wake(i, l)
-    END DO
-
-    hw = wake_h(i)
-    sigmaw = wake_s(i)
-
-    ! 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
-      amdwn(l) = 0.5*(m_dwn(i,l)+m_dwn(i,l+1))
-      amdwn(l) = (m_dwn(i,l+1))
-    END DO
-
-    ! au sommet le flux de masse est nul
-
-    amdwn(klev) = 0.5*m_dwn(i, klev)
-
-    DO l = 1, klev
-      amup(l) = m_up(i, l)
-    END DO
-
-    CALL wake_scal(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)
-
-    IF (ktopw>0) THEN
-      DO l = 1, klev
-        wake_deltat(i, l) = dtw(l)
-        wake_deltaq(i, l) = dqw(l)
-        wake_d_deltat_gw(i, l) = d_deltat_gw(l)
-        wake_omgbdth(i, l) = omgbdth(l)
-        wake_dp_omgb(i, l) = dp_omgb(l)
-        wake_dtke(i, l) = dtke(l)
-        wake_dqke(i, l) = dqke(l)
-        wake_dtpbl(i, l) = dtpbl(l)
-        wake_dqpbl(i, l) = dqpbl(l)
-        wake_omg(i, l) = omg(l)
-        wake_dp_deltomg(i, l) = dp_deltomg(l)
-        wake_spread(i, l) = spread(l)
-        wake_dth(i, l) = dth(l)
-        dt_wake(i, l) = dtls(l)
-        dq_wake(i, l) = dqls(l)
-        undi_t(i, l) = tu(l)
-        undi_q(i, l) = qu(l)
-        wake_ddeltat(i, l) = d_deltatw(l)
-        wake_ddeltaq(i, l) = d_deltaqw(l)
-      END DO
-    ELSE
-      DO l = 1, klev
-        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_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(l)
-        undi_q(i, l) = qe(l)
-      END DO
-    END IF
-
-    wake_h(i) = hw
-    wake_s(i) = sigmaw
-    wake_pe(i) = wape
-    wake_fip(i) = fip
-    wake_gfl(i) = gfl
-    wake_k(i) = ktopw
-    wake_cstar(i) = cstar
-    wake_dens(i) = wdens
-
-  END DO
-
-  RETURN
-END SUBROUTINE calwake_scal