Ignore:
Timestamp:
Jun 14, 2015, 9:13:32 PM (9 years ago)
Author:
Laurent Fairhead
Message:

Merged trunk changes -r2237:2291 into testing branch

Location:
LMDZ5/branches/testing
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/testing

  • LMDZ5/branches/testing/libf/phylmd/cv3_routines.F90

    r2220 r2298  
    55
    66
    7 SUBROUTINE cv3_param(nd, delt)
     7SUBROUTINE cv3_param(nd, k_upper, delt)
    88
    99  use mod_phys_lmdz_para
    … …  
    3636  include "conema3.h"
    3737
    38   INTEGER nd
    39   REAL delt ! timestep (seconds)
     38  INTEGER, INTENT(IN)              :: nd
     39  INTEGER, INTENT(IN)              :: k_upper
     40  REAL, INTENT(IN)                 :: delt ! timestep (seconds)
    4041
    4142
    … …  
    5152! -- limit levels for convection:
    5253
    53   noff = 1
     54!jyg<
     55!  noff is chosen such that nl = k_upper so that upmost loops end at about 22 km
     56!
     57  noff = min(max(nd-k_upper, 1), (nd+1)/2)
     58!!  noff = 1
     59!>jyg
    5460  minorig = 1
    5561  nl = nd - noff
    … …  
    264270
    265271!inputs:
    266   INTEGER len, nd
    267   LOGICAL ok_conserv_q
    268   REAL t(len, nd), q(len, nd), p(len, nd)
    269   REAL u(len, nd), v(len, nd)
    270   REAL hm(len, nd), gz(len, nd)
    271   REAL ph(len, nd+1)
    272   REAL p1feed(len)
    273 ! ,  wght(len)
    274   REAL wght(nd)
     272  INTEGER, INTENT (IN)                               :: len, nd
     273  LOGICAL, INTENT (IN)                               :: ok_conserv_q
     274  REAL, DIMENSION (len, nd), INTENT (IN)             :: t, q, p
     275  REAL, DIMENSION (len, nd), INTENT (IN)             :: u, v
     276  REAL, DIMENSION (len, nd), INTENT (IN)             :: hm, gz
     277  REAL, DIMENSION (len, nd+1), INTENT (IN)           :: ph
     278  REAL, DIMENSION (len), INTENT (IN)                 :: p1feed
     279  REAL, DIMENSION (nd), INTENT (IN)                  :: wght
    275280!input-output
    276   REAL p2feed(len)
     281  REAL, DIMENSION (len), INTENT (INOUT)              :: p2feed
    277282!outputs:
    278   INTEGER iflag(len), nk(len), icb(len), icbmax
    279 !   real   wghti(len)
    280   REAL wghti(len, nd)
    281   REAL tnk(len), thnk(len), qnk(len), qsnk(len)
    282   REAL unk(len), vnk(len)
    283   REAL cpnk(len), hnk(len), gznk(len)
    284   REAL plcl(len)
     283  INTEGER, INTENT (OUT)                              :: icbmax
     284  INTEGER, DIMENSION (len), INTENT (OUT)             :: iflag, nk, icb
     285  REAL, DIMENSION (len, nd), INTENT (OUT)            :: wghti
     286  REAL, DIMENSION (len), INTENT (OUT)                :: tnk, thnk, qnk, qsnk
     287  REAL, DIMENSION (len), INTENT (OUT)                :: unk, vnk
     288  REAL, DIMENSION (len), INTENT (OUT)                :: cpnk, hnk, gznk
     289  REAL, DIMENSION (len), INTENT (OUT)                :: plcl
    285290
    286291!local variables:
    … …  
    514519
    515520! inputs:
    516   INTEGER len, nd
    517   INTEGER icb(len)
    518   REAL t(len, nd), qs(len, nd), gz(len, nd)
    519   REAL tnk(len), qnk(len), gznk(len)
    520   REAL p(len, nd)
    521   REAL plcl(len) ! convect3
     521  INTEGER, INTENT (IN)                              :: len, nd
     522  INTEGER, DIMENSION (len), INTENT (IN)             :: icb
     523  REAL, DIMENSION (len, nd), INTENT (IN)            :: t, qs, gz
     524  REAL, DIMENSION (len), INTENT (IN)                :: tnk, qnk, gznk
     525  REAL, DIMENSION (len, nd), INTENT (IN)            :: p
     526  REAL, DIMENSION (len), INTENT (IN)                :: plcl              ! convect3
    522527
    523528! outputs:
    524   REAL tp(len, nd), tvp(len, nd), clw(len, nd)
     529  INTEGER, DIMENSION (len), INTENT (OUT)            :: icbs
     530  REAL, DIMENSION (len, nd), INTENT (OUT)           :: tp, tvp, clw
    525531
    526532! local variables:
    527533  INTEGER i, k
    528   INTEGER icb1(len), icbs(len), icbsmax2 ! convect3
     534  INTEGER icb1(len), icbsmax2                                            ! convect3
    529535  REAL tg, qg, alv, s, ahg, tc, denom, es, rg
    530536  REAL ah0(len), cpp(len)
    531537  REAL ticb(len), gzicb(len)
    532   REAL qsicb(len) ! convect3
    533   REAL cpinv(len) ! convect3
     538  REAL qsicb(len)                                                        ! convect3
     539  REAL cpinv(len)                                                        ! convect3
    534540
    535541! -------------------------------------------------------------------
    … …  
    10511057
    10521058!inputs:
    1053   INTEGER ncum, nd, nloc, j
    1054   INTEGER icb(nloc), icbs(nloc), nk(nloc)
    1055   REAL t(nloc, nd), q(nloc, nd), qs(nloc, nd), gz(nloc, nd)
    1056   REAL p(nloc, nd)
    1057   REAL tnk(nloc), qnk(nloc), gznk(nloc)
    1058   REAL hnk(nloc)
    1059   REAL lv(nloc, nd), lf(nloc, nd), tv(nloc, nd), h(nloc, nd)
    1060   REAL pbase(nloc), buoybase(nloc), plcl(nloc)
     1059  INTEGER, INTENT (IN)                               :: ncum, nd, nloc
     1060  INTEGER, DIMENSION (nloc), INTENT (IN)             :: icb, icbs, nk
     1061  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: t, q, qs, gz
     1062  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: p
     1063  REAL, DIMENSION (nloc), INTENT (IN)                :: tnk, qnk, gznk
     1064  REAL, DIMENSION (nloc), INTENT (IN)                :: hnk
     1065  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: lv, lf, tv, h
     1066  REAL, DIMENSION (nloc), INTENT (IN)                :: pbase, buoybase, plcl
     1067
     1068!input/outputs:
     1069  REAL, DIMENSION (nloc, nd), INTENT (INOUT)         :: tp, tvp, clw   ! Input for k = 1, icb+1 (computed in cv3_undilute1)
     1070                                                                       ! Output above
    10611071
    10621072!outputs:
    1063   INTEGER inb(nloc)
    1064   REAL tp(nloc, nd), tvp(nloc, nd), clw(nloc, nd)
    1065   REAL ep(nloc, nd), sigp(nloc, nd), hp(nloc, nd)
    1066   REAL buoy(nloc, nd)
     1073  INTEGER, DIMENSION (nloc), INTENT (OUT)            :: inb
     1074  REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: ep, sigp, hp
     1075  REAL, DIMENSION (nloc, nd), INTENT (OUT)           :: buoy
    10671076
    10681077!local variables:
    1069   INTEGER i, k
     1078  INTEGER i, j, k
    10701079  REAL tg, qg, ahg, alv, alf, s, tc, es, esi, denom, rg, tca, elacrit
    10711080  REAL als
    … …  
    10841093  DO k = 1, nl
    10851094    DO i = 1, ncum
    1086       ep(i, k) = 0.0
    1087       sigp(i, k) = spfac
    10881095      qi(i, k) = 0.
    10891096    END DO
    … …  
    11871194          END IF
    11881195        END IF
    1189       END IF
     1196!jyg<
     1197!!      END IF  ! Endif moved to the end of the loop
     1198!>jyg
    11901199
    11911200      IF (cvflag_ice) THEN
    … …  
    12581267        END IF
    12591268      END IF ! (cvflag_ice)
    1260 
     1269!jyg<
     1270      END IF ! (k>=(icbs(i)+1))
     1271!>jyg
    12611272    END DO
    12621273  END DO
    … …  
    12671278! --- THESE MAY BE FUNCTIONS OF TP(I), P(I) AND CLW(I)
    12681279! =====================================================================
    1269 
     1280!
     1281!jyg<
     1282  DO k = 1, nl
     1283    DO i = 1, ncum
     1284      ep(i, k) = 0.0
     1285      sigp(i, k) = spfac
     1286    END DO
     1287  END DO
     1288!>jyg
     1289!
    12701290  IF (flag_epkeorig/=1) THEN
    12711291    DO k = 1, nl ! convect3
    12721292      DO i = 1, ncum
    1273         pden = ptcrit - pbcrit
    1274         ep(i, k) = (plcl(i)-p(i,k)-pbcrit)/pden*epmax
    1275         ep(i, k) = max(ep(i,k), 0.0)
    1276         ep(i, k) = min(ep(i,k), epmax)
    1277         sigp(i, k) = spfac
     1293!jyg<
     1294       IF(k>=icb(i)) THEN
     1295!>jyg
     1296         pden = ptcrit - pbcrit
     1297         ep(i, k) = (plcl(i)-p(i,k)-pbcrit)/pden*epmax
     1298         ep(i, k) = max(ep(i,k), 0.0)
     1299         ep(i, k) = min(ep(i,k), epmax)
     1300!!         sigp(i, k) = spfac  ! jyg
     1301        ENDIF   ! (k>=icb(i))
    12781302      END DO
    12791303    END DO
    … …  
    12811305    DO k = 1, nl
    12821306      DO i = 1, ncum
    1283         IF (k>=(nk(i)+1)) THEN
     1307        IF(k>=icb(i)) THEN
     1308!!        IF (k>=(nk(i)+1)) THEN
     1309!>jyg
    12841310          tca = tp(i, k) - t0
    12851311          IF (tca>=0.0) THEN
    … …  
    12921318          ep(i, k) = max(ep(i,k), 0.0)
    12931319          ep(i, k) = min(ep(i,k), epmax)
    1294           sigp(i, k) = spfac
    1295         END IF
     1320!!          sigp(i, k) = spfac  ! jyg
     1321        END IF  ! (k>=icb(i))
    12961322      END DO
    12971323    END DO
    12981324  END IF
     1325!
    12991326! =====================================================================
    13001327! --- CALCULATE VIRTUAL TEMPERATURE AND LIFTED PARCEL
    … …  
    13311358! first estimate of buoyancy:
    13321359
    1333   DO i = 1, ncum
    1334     DO k = 1, nl
     1360!jyg : k-loop outside i-loop (07042015)
     1361  DO k = 1, nl
     1362    DO i = 1, ncum
    13351363      buoy(i, k) = tvp(i, k) - tv(i, k)
    13361364    END DO
    … …  
    13401368! for safety, set buoy(icb)=buoybase
    13411369
    1342   DO i = 1, ncum
    1343     DO k = 1, nl
     1370!jyg : k-loop outside i-loop (07042015)
     1371  DO k = 1, nl
     1372    DO i = 1, ncum
    13441373      IF ((k>=icb(i)) .AND. (k<=nl) .AND. (p(i,k)>=pbase(i))) THEN
    13451374        buoy(i, k) = buoybase(i)
    13461375      END IF
    13471376    END DO
     1377  END DO
     1378  DO i = 1, ncum
    13481379!    buoy(icb(i),k)=buoybase(i)
    13491380    buoy(i, icb(i)) = buoybase(i)
    … …  
    14901521  END DO
    14911522
    1492   DO k = minorig + 1, nl
    1493     DO i = 1, ncum
    1494       IF ((k>=icb(i)) .AND. (k<=inb(i))) THEN
    1495 
    1496         IF (cvflag_ice) THEN
     1523!jyg : cvflag_ice test outside the loops (07042015)
     1524!
     1525  IF (cvflag_ice) THEN
     1526!
     1527    DO k = minorig + 1, nl
     1528      DO i = 1, ncum
     1529        IF ((k>=icb(i)) .AND. (k<=inb(i))) THEN
    14971530          frac(i, k) = 1. - (t(i,k)-243.15)/(263.15-243.15)
    14981531          frac(i, k) = min(max(frac(i,k),0.0), 1.0)
    14991532          hp(i, k) = hnk(i) + (lv(i,k)+(cpd-cpv)*t(i,k)+frac(i,k)*lf(i,k))* &
    15001533                              ep(i, k)*clw(i, k)
    1501 
    1502         ELSE
     1534        END IF
     1535      END DO
     1536    END DO
     1537!
     1538  ELSE
     1539!
     1540    DO k = minorig + 1, nl
     1541      DO i = 1, ncum
     1542        IF ((k>=icb(i)) .AND. (k<=inb(i))) THEN
    15031543          hp(i, k) = hnk(i) + (lv(i,k)+(cpd-cpv)*t(i,k))*ep(i, k)*clw(i, k)
    15041544        END IF
    1505 
    1506       END IF
    1507     END DO
    1508   END DO
     1545      END DO
     1546    END DO
     1547!
     1548  END IF  ! (cvflag_ice)
    15091549
    15101550  RETURN
    … …  
    17681808
    17691809!inputs:
    1770   INTEGER ncum, nd, na, ntra, nloc
    1771   INTEGER icb(nloc), inb(nloc), nk(nloc)
    1772   REAL sig(nloc, nd)
    1773   REAL qnk(nloc), unk(nloc), vnk(nloc)
    1774   REAL ph(nloc, nd+1)
    1775   REAL t(nloc, nd), rr(nloc, nd), rs(nloc, nd)
    1776   REAL u(nloc, nd), v(nloc, nd)
    1777   REAL tra(nloc, nd, ntra) ! input of convect3
    1778   REAL lv(nloc, na), h(nloc, na), hp(nloc, na)
    1779   REAL lf(nloc, na), frac(nloc, na)
    1780   REAL tv(nloc, na), tvp(nloc, na), ep(nloc, na), clw(nloc, na)
    1781   REAL m(nloc, na) ! input of convect3
     1810  INTEGER, INTENT (IN)                               :: ncum, nd, na, ntra, nloc
     1811  INTEGER, DIMENSION (nloc), INTENT (IN)             :: icb, inb, nk
     1812  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: sig
     1813  REAL, DIMENSION (nloc), INTENT (IN)                :: qnk, unk, vnk
     1814  REAL, DIMENSION (nloc, nd+1), INTENT (IN)          :: ph
     1815  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: t, rr, rs
     1816  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: u, v
     1817  REAL, DIMENSION (nloc, nd, ntra), INTENT (IN)      :: tra              ! input of convect3
     1818  REAL, DIMENSION (nloc, na), INTENT (IN)            :: lv, h, hp
     1819  REAL, DIMENSION (nloc, na), INTENT (IN)            :: lf, frac
     1820  REAL, DIMENSION (nloc, na), INTENT (IN)            :: tv, tvp, ep, clw
     1821  REAL, DIMENSION (nloc, na), INTENT (IN)            :: m                ! input of convect3
    17821822
    17831823!outputs:
    1784   REAL ment(nloc, na, na), qent(nloc, na, na)
    1785   REAL uent(nloc, na, na), vent(nloc, na, na)
    1786   REAL sij(nloc, na, na), elij(nloc, na, na)
    1787   REAL traent(nloc, nd, nd, ntra)
    1788   REAL ments(nloc, nd, nd), qents(nloc, nd, nd)
    1789   REAL sigij(nloc, nd, nd)
    1790   INTEGER nent(nloc, nd)
     1824  REAL, DIMENSION (nloc, na, na), INTENT (OUT)        :: ment, qent
     1825  REAL, DIMENSION (nloc, na, na), INTENT (OUT)        :: uent, vent
     1826  REAL, DIMENSION (nloc, na, na), INTENT (OUT)        :: sij, elij
     1827  REAL, DIMENSION (nloc, nd, nd, ntra), INTENT (OUT)  :: traent
     1828  REAL, DIMENSION (nloc, nd, nd), INTENT (OUT)        :: ments, qents
     1829  INTEGER, DIMENSION (nloc, nd), INTENT (OUT)         :: nent
    17911830
    17921831!local variables:
    … …  
    17971836  REAL asij(nloc), smax(nloc), scrit(nloc)
    17981837  REAL asum(nloc, nd), bsum(nloc, nd), csum(nloc, nd)
     1838  REAL sigij(nloc, nd, nd)
    17991839  REAL wgh
    18001840  REAL zm(nloc, na)
    … …  
    21842224  include "cv3param.h"
    21852225  include "cvflag.h"
     2226  include "nuage.h"
    21862227
    21872228!inputs:
    … …  
    23632404
    23642405          IF (cvflag_ice) THEN
    2365             thaw = (t(il,i)-273.15)/(275.15-273.15)
     2406!CR:tmax_fonte_cv: T for which ice is totally melted (used to be 275.15)
     2407            thaw = (t(il,i)-273.15)/(tmax_fonte_cv-273.15)
    23662408            thaw = min(max(thaw,0.0), 1.0)
    23672409            frac(il, i) = frac(il, i)*(1.-thaw)
    … …  
    24772519          f6 = -100.*sigd(il)*bfac*(ph(il,i)-ph(il,i+1))*evap(il, i)
    24782520
    2479           thaw = (t(il,i)-273.15)/(275.15-273.15)
     2521!CR:tmax_fonte_cv: T for which ice is totally melted (used to be 275.15)
     2522          thaw = (t(il,i)-273.15)/(tmax_fonte_cv-273.15)
    24802523          thaw = min(max(thaw,0.0), 1.0)
    24812524          water(il, i) = water(il, i+1) + (1-fraci(il,i))*d6
    … …  
    27632806                     iflag, precip, Vprecip, ft, fr, fu, fv, ftra, &
    27642807                     cbmf, upwd, dnwd, dnwd0, ma, mip, &
    2765                      tls, tps, qcondc, wd, &
     2808!!                     tls, tps,                             ! useless . jyg
     2809                     qcondc, wd, &
    27662810                     ftd, fqd, qnk, qtc, sigt, tau_cld_cv, coefw_cld_cv)
    27672811
    … …  
    28112855      REAL dnwd0(nloc, nd), mip(nloc, nd)
    28122856      REAL Vprecip(nloc, nd+1)
    2813       REAL tls(nloc, nd), tps(nloc, nd)
     2857!!      REAL tls(nloc, nd), tps(nloc, nd)                 ! useless . jyg
    28142858      REAL qcondc(nloc, nd) ! cld
    28152859      REAL qtc(nloc,nd), sigt(nloc,nd) ! cld
    … …  
    28232867      REAL cpinv, rdcp, dpinv
    28242868      REAL awat(nloc)
    2825       REAL lvcp(nloc, na), lfcp(nloc, na), mke(nloc, na)
     2869      REAL lvcp(nloc, na), lfcp(nloc, na)                  ! , mke(nloc, na) ! unused . jyg
    28262870      REAL am(nloc), work(nloc), ad(nloc), amp1(nloc)
    28272871!!      real up1(nloc), dn1(nloc)
    … …  
    35883632! ***           reset counter and return           ***
    35893633
     3634! Reset counter only for points actually convective (jyg)
     3635! In order take into account the possibility of changing the compression,
     3636! reset m, sig and w0 to zero for non-convecting points.
    35903637  DO il = 1, ncum
    3591     sig(il, nd) = 2.0
     3638    IF (iflag(il) < 3) THEN
     3639      sig(il, nd) = 2.0
     3640    ENDIF
    35923641  END DO
    35933642
    … …  
    37433792! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    37443793
    3745   DO i = 1, nd
    3746     DO il = 1, ncum
    3747       mke(il, i) = upwd(il, i) + dnwd(il, i)
    3748     END DO
    3749   END DO
    3750 
    3751   DO i = 1, nd
    3752     DO il = 1, ncum
    3753       rdcp = (rrd*(1.-rr(il,i))-rr(il,i)*rrv)/(cpd*(1.-rr(il,i))+rr(il,i)*cpv)
    3754       tls(il, i) = t(il, i)*(1000.0/p(il,i))**rdcp
    3755       tps(il, i) = tp(il, i)
    3756     END DO
    3757   END DO
     3794!!  DO i = 1, nd                                  ! unused . jyg
     3795!!    DO il = 1, ncum                             ! unused . jyg
     3796!!      mke(il, i) = upwd(il, i) + dnwd(il, i)    ! unused . jyg
     3797!!    END DO                                      ! unused . jyg
     3798!!  END DO                                        ! unused . jyg
     3799
     3800!!  DO i = 1, nd                                                                 ! unused . jyg
     3801!!    DO il = 1, ncum                                                            ! unused . jyg
     3802!!      rdcp = (rrd*(1.-rr(il,i))-rr(il,i)*rrv)/(cpd*(1.-rr(il,i))+rr(il,i)*cpv) ! unused . jyg
     3803!!      tls(il, i) = t(il, i)*(1000.0/p(il,i))**rdcp                             ! unused . jyg
     3804!!      tps(il, i) = tp(il, i)                                                   ! unused . jyg
     3805!!    END DO                                                                     ! unused . jyg
     3806!!  END DO                                                                       ! unused . jyg
    37583807
    37593808
Note: See TracChangeset for help on using the changeset viewer.