Ignore:
Timestamp:
Jul 12, 2002, 12:27:22 PM (22 years ago)
Author:
lmdzadmin
Message:

Inclusion du nouveau schema de nuages de SB. FH
IM/LF

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/physiq.F

    r364 r373  
    388388      EXTERNAL conlmd    ! convection (schema LMD)
    389389cKE43
    390       EXTERNAL conema  ! convect4.3
     390      EXTERNAL conema3  ! convect4.3
    391391      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)
    392392cAA
    … …  
    412412c Variables locales
    413413c
     414      real clwcon(klon,klev),rnebcon(klon,klev)
     415      real clwcon0(klon,klev),rnebcon0(klon,klev)
     416      save rnebcon, clwcon
     417
     418      REAL rhcl(klon,klev)    ! humiditi relative ciel clair
    414419      REAL dialiq(klon,klev)  ! eau liquide nuageuse
    415420      REAL diafra(klon,klev)  ! fraction nuageuse
    … …  
    464469c
    465470      REAL za, zb
    466       REAL zx_t, zx_qs, zdelta, zcor, zlvdcp, zlsdcp
    467       INTEGER i, k, iq, nsrf, ll
     471      REAL zx_t, zx_qs, zdelta, zcor, zfra, zlvdcp, zlsdcp
     472      real zqsat(klon,klev)
     473      INTEGER i, k, iq, ig, j, nsrf, ll
    468474      REAL t_coup
    469475      PARAMETER (t_coup=234.0)
    … …  
    534540      REAL d_t_lif(klon,klev)
    535541
    536       REAL ratqs(klon,klev)
    537       integer flag_ratqs
     542      REAL ratqs(klon,klev),ratqss(klon,klev),ratqsc(klon,klev)
     543      real ratqsbas,ratqshaut
     544      save ratqsbas,ratqshaut, ratqs
    538545      real zpt_conv(klon,klev)
     546
     547c Parametres lies au nouveau schema de nuages (SB, PDF)
     548      real fact_cldcon
     549      real facttemps
     550      logical ok_newmicro
     551      save ok_newmicro
     552      save fact_cldcon,facttemps
     553
     554      integer iflag_cldcon
     555      save iflag_cldcon
     556
     557      logical ptconv(klon,klev)
    539558
    540559c
    … …  
    630649c
    631650         call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel,
    632      .                  ok_instan)
     651     .                  ok_instan, fact_cldcon, facttemps,ok_newmicro,
     652     .                  iflag_cldcon,ratqsbas,ratqshaut)
    633653
    634654         DO k = 2, nvm          ! pas de vegetation
    … …  
    655675     .       dlw,radsol,frugs,agesno,clesphy0,
    656676     .       zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,tabcntr0,
    657      .       t_ancien, q_ancien, ancien_ok )
     677     .       t_ancien, q_ancien, ancien_ok, rnebcon, ratqs,clwcon )
    658678
    659679c
    … …  
    13071327     .                "ave(X)", zsto,zout)
    13081328c
     1329         CALL histdef(nid_mth, "ducon", "Convection du", "m/s2",
     1330     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
     1331     .                "ave(X)", zsto,zout)
     1332c
    13091333         CALL histdef(nid_mth, "dqcon", "Convection dQ", "Kg/Kg/s",
    13101334     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
    … …  
    17741798      DO i = 1, klon
    17751799         zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
    1776          zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
     1800c        zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
     1801         zlsdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
    17771802         zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k)))
    17781803         zb = MAX(0.0,ql_seri(i,k))
    … …  
    19812006          else
    19822007
    1983           CALL conema (dtime,paprs,pplay,t_seri,q_seri,
     2008c          print*,'Avant conema OUI'
     2009          CALL conema3 (dtime,
     2010     .        paprs,pplay,t_seri,q_seri,
    19842011     .        u_seri,v_seri,tr_seri,nbtr,
    19852012     .        ema_work1,ema_work2,
    … …  
    19882015     .        upwd,dnwd,dnwd0,bas,top,
    19892016     .        Ma,cape,tvp,rflag,
    1990      .       pbase
    1991      .        ,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr)
     2017     .        pbase
     2018     .        ,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr
     2019     .        ,clwcon0)
     2020c          print*,'Apres conema3 '
     2021
     2022c Calculer l'humidite relative pour diagnostique
     2023c
     2024      DO k = 1, klev
     2025      DO i = 1, klon
     2026         zx_t = t_seri(i,k)
     2027         IF (thermcep) THEN
     2028            zdelta = MAX(0.,SIGN(1.,rtt-zx_t))
     2029            zx_qs  = r2es * FOEEW(zx_t,zdelta)/pplay(i,k)
     2030            zx_qs  = MIN(0.5,zx_qs)
     2031            zcor   = 1./(1.-retv*zx_qs)
     2032            zx_qs  = zx_qs*zcor
     2033         ELSE
     2034           IF (zx_t.LT.t_coup) THEN
     2035              zx_qs = qsats(zx_t)/pplay(i,k)
     2036           ELSE
     2037              zx_qs = qsatl(zx_t)/pplay(i,k)
     2038           ENDIF
     2039         ENDIF
     2040         zqsat(i,k)=zx_qs
     2041      ENDDO
     2042      ENDDO
     2043
     2044c   calcul des propriétés des nuages convectifs
     2045             clwcon0(:,:)=fact_cldcon*clwcon0(:,:)
     2046             call clouds_gno
     2047     s       (klon,klev,q_seri,zqsat,clwcon0,ptconv,ratqsc,rnebcon0)
     2048
    19922049          endif
    19932050          DO i = 1, klon
    … …  
    20542111      IF (nqmax.GT.2) THEN !--melange convectif de traceurs
    20552112c
    2056           IF (iflag_con .LT. 2 .AND.  iflag_con .GT. 4 ) THEN
     2113          IF (iflag_con .NE. 2 .AND. debut) THEN
    20572114              PRINT*, 'Pour l instant, seul conflx fonctionne ',
    20582115     $            'avec traceurs', iflag_con
    20592116              PRINT*,' Mettre iflag_con',
    2060      $            ' = 2, 3 ou 4 dans run.def et repasser'
    2061               CALL abort
     2117     $            ' = 2 dans run.def et repasser'
     2118c              CALL abort
    20622119              ENDIF
    20632120c
    … …  
    20742131      ENDDO
    20752132
    2076 c   RATQS
    2077       if (iflag_con.eq.2) then
    2078           flag_ratqs=0
     2133
     2134c-------------------------------------------------------------------------
     2135c  Caclul des ratqs
     2136c-------------------------------------------------------------------------
     2137
     2138c      print*,'calcul des ratqs'
     2139c   ratqs convectifs a l'ancienne en fonction de q(z=0)-q / q
     2140c   ----------------
     2141c   on ecrase le tableau ratqsc calcule par clouds_gno
     2142      if (iflag_cldcon.eq.1) then
     2143         do k=1,klev
     2144         do i=1,klon
     2145            if(ptconv(i,k)) then
     2146              ratqsc(i,k)=ratqsbas
     2147     s        +fact_cldcon*(q_seri(i,1)-q_seri(i,k))/q_seri(i,k)
     2148            else
     2149               ratqsc(i,k)=0.
     2150            endif
     2151         enddo
     2152         enddo
     2153      endif
     2154
     2155c   ratqs stables
     2156c   -------------
     2157      do k=1,klev
     2158         ratqss(:,k)=ratqsbas+(ratqshaut-ratqsbas)*
     2159     s   min((paprs(:,1)-pplay(:,k))/(paprs(:,1)-30000.),1.)       
     2160      enddo
     2161
     2162
     2163c  ratqs final
     2164c  -----------
     2165      if (iflag_cldcon.eq.1 .or.iflag_cldcon.eq.2) then
     2166c   les ratqs sont une conbinaison de ratqss et ratqsc
     2167c   ratqs final
     2168c   1e4 (en gros 3 heures), en dur pour le moment, est le temps de
     2169c   relaxation des ratqs
     2170         facttemps=exp(-pdtphys/1.e4)
     2171         ratqs(:,:)=max(ratqs(:,:)*facttemps,ratqss(:,:))
     2172         ratqs(:,:)=max(ratqs(:,:),ratqsc(:,:))
     2173c         print*,'calcul des ratqs fini'
    20792174      else
    2080           flag_ratqs=1
     2175c   on ne prend que le ratqs stable pour fisrtilp
     2176         ratqs(:,:)=ratqss(:,:)
    20812177      endif
    2082       call calcratqs (flag_ratqs,
    2083      I            paprs,pplay,q_seri,d_t_con,d_t_ajs
    2084      O           ,ratqs,zpt_conv)
     2178
     2179
    20852180c
    20862181c Appeler le processus de condensation a grande echelle
    20872182c et le processus de precipitation
    2088 c
    2089       CALL fisrtilp_tr(dtime,paprs,pplay,
    2090      .           t_seri, q_seri,ratqs,
     2183c-------------------------------------------------------------------------
     2184      CALL fisrtilp(dtime,paprs,pplay,
     2185     .           t_seri, q_seri,ptconv,ratqs,
    20912186     .           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq,
    20922187     .           rain_lsc, snow_lsc,
    20932188     .           pfrac_impa, pfrac_nucl, pfrac_1nucl,
    20942189     .           frac_impa, frac_nucl,
    2095      .           prfl, psfl)
     2190     .           prfl, psfl, rhcl)
     2191
    20962192      WHERE (rain_lsc < 0) rain_lsc = 0.
    20972193      WHERE (snow_lsc < 0) snow_lsc = 0.
    … …  
    21182214      ENDIF
    21192215c
    2120 c Nuages diagnostiques:
    2121 c
    2122       IF (iflag_con.EQ.2) THEN ! seulement pour Tiedtke
     2216c-------------------------------------------------------------------
     2217c  PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
     2218c-------------------------------------------------------------------
     2219
     2220c 1. NUAGES CONVECTIFS
     2221c
     2222      IF (iflag_cldcon.eq.-1) THEN ! seulement pour Tiedtke
     2223
     2224c Nuages diagnostiques pour Tiedtke
    21232225      CALL diagcld1(paprs,pplay,
    21242226     .             rain_con,snow_con,ibas_con,itop_con,
    … …  
    21322234      ENDDO
    21332235      ENDDO
     2236
     2237      ELSE IF (iflag_cldcon.eq.3) THEN
     2238c  On prend pour les nuages convectifs le max du calcul de la
     2239c  convection et du calcul du pas de temps précédent diminué d'un facteur
     2240c  facttemps
     2241      facttemps=pdtphys/1.e4
     2242      do k=1,klev
     2243         do i=1,klon
     2244            rnebcon(i,k)=rnebcon(i,k)*facttemps
     2245            if (rnebcon0(i,k)*clwcon0(i,k).gt.rnebcon(i,k)*clwcon(i,k))
     2246     s      then
     2247                rnebcon(i,k)=rnebcon0(i,k)
     2248                clwcon(i,k)=clwcon0(i,k)
     2249            endif
     2250         enddo
     2251      enddo
     2252
     2253c   On prend la somme des fractions nuageuses et des contenus en eau
     2254      cldfra(:,:)=min(max(cldfra(:,:),rnebcon(:,:)),1.)
     2255      cldliq(:,:)=cldliq(:,:)+rnebcon(:,:)*clwcon(:,:)
     2256
     2257
    21342258      ENDIF
    21352259c
    2136 c Nuages stratus artificiels:
     2260c 2. NUAGES STARTIFORMES
    21372261c
    21382262      IF (ok_stratus) THEN
    … …  
    21742298         ENDIF
    21752299         zx_rh(i,k) = q_seri(i,k)/zx_qs
     2300         zqsat(i,k)=zx_qs
    21762301      ENDDO
    21772302      ENDDO
    … …  
    21802305c parametres pour diagnostiques:
    21812306c
     2307      if (ok_newmicro) then
     2308      CALL newmicro (paprs, pplay,ok_newmicro,
     2309     .            t_seri, cldliq, cldfra, cldtau, cldemi,
     2310     .            cldh, cldl, cldm, cldt, cldq)
     2311      else
    21822312      CALL nuage (paprs, pplay,
    21832313     .            t_seri, cldliq, cldfra, cldtau, cldemi,
    21842314     .            cldh, cldl, cldm, cldt, cldq)
     2315      endif
    21852316c
    21862317c Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
    … …  
    33613492     .      radsol,frugs,agesno,
    33623493     .      zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,
    3363      .      t_ancien, q_ancien)
     3494     .      t_ancien, q_ancien, rnebcon, ratqs, clwcon)
    33643495      ENDIF
    33653496
Note: See TracChangeset for help on using the changeset viewer.