Ignore:
Timestamp:
Jan 21, 2022, 3:50:54 PM (2 years ago)
Author:
oboucher
Message:

Audran Borella's parametrisation for ice supersaturation
activated with flag_ice_sursat (FALSE by default)

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/phylmd/lscp_mod.F90

    r3999 r4059  
    66
    77!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    8 SUBROUTINE LSCP(dtime,paprs,pplay,t,q,ptconv,ratqs,     &
    9      d_t, d_q, d_ql, d_qi, rneb, radliq, radicefrac,    &
    10      rain, snow,                                        &
     8SUBROUTINE LSCP(dtime,missing_val,                      &
     9     paprs,pplay,t,q,ptconv,ratqs,                      &
     10     d_t, d_q, d_ql, d_qi, rneb, rneb_seri,             &
     11     radliq, radicefrac, rain, snow,                    &
    1112     pfrac_impa, pfrac_nucl, pfrac_1nucl,               &
    1213     frac_impa, frac_nucl, beta,                        &
    1314     prfl, psfl, rhcl, zqta, fraca,                     &
    1415     ztv, zpspsk, ztla, zthl, iflag_cld_th,             &
    15      iflag_ice_thermo)
     16     iflag_ice_thermo, iflag_ice_sursat)
    1617
    1718!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    … …  
    9394USE phys_local_var_mod, ONLY: rneblsvol
    9495USE lscp_tools_mod, ONLY : CALC_QSAT_ECMWF, ICEFRAC_LSCP, CALC_GAMMASAT, FALLICE_VELOCITY
    95 
     96USE ice_sursat_mod
     97!--ice supersaturation
     98USE phys_local_var_mod, ONLY: zqsats, zqsatl
     99USE phys_local_var_mod, ONLY: qclr, qcld, qss, qvc, rnebclr, rnebss, gamma_ss
     100USE phys_local_var_mod, ONLY: Tcontr, qcontr, qcontr2, fcontrN, fcontrP
    96101
    97102IMPLICIT NONE
    98 
    99 
    100103
    101104!===============================================================================
    … …  
    114117
    115118  REAL,                            INTENT(IN)   :: dtime           ! time step [s]
     119  REAL, INTENT(IN)                              :: missing_val     ! missing value for output
     120
    116121  REAL, DIMENSION(klon,klev+1),    INTENT(IN)   :: paprs           ! inter-layer pressure [Pa]
    117122  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: pplay           ! mid-layer pressure [Pa]
    … …  
    121126  INTEGER,                         INTENT(IN)   :: iflag_ice_thermo! flag to activate the ice thermodynamics
    122127                                                                   ! CR: if iflag_ice_thermo=2, only convection is active   
     128  INTEGER,                         INTENT(IN)   :: iflag_ice_sursat ! 0 = sursat desativee, 1 = sursat activee
     129
    123130  LOGICAL, DIMENSION(klon,klev),   INTENT(IN)   :: ptconv          ! grid points where deep convection scheme is active
    124131
    … …  
    138145  REAL, DIMENSION(klon,klev),      INTENT(INOUT):: ratqs            ! function of pressure that sets the large-scale
    139146                                                                    ! cloud PDF (sigma=ratqs*qt)
     147
     148  ! Input sursaturation en glace
     149  REAL, DIMENSION(klon,klev),      INTENT(INOUT):: rneb_seri        ! fraction nuageuse en memoire
    140150 
    141151  ! OUTPUT variables
    … …  
    388398d_tot_zneb(:) = 0.0   
    389399
     400!--ice sursaturation
     401gamma_ss(:,:) = 1.
     402qss(:,:) = 0.
     403rnebss(:,:) = 0.
     404Tcontr(:,:) = missing_val
     405qcontr(:,:) = missing_val
     406qcontr2(:,:) = missing_val
     407fcontrN(:,:) = 0.0
     408fcontrP(:,:) = 0.0
    390409
    391410!===============================================================================
    … …  
    645664            qtot=zq(i)+zmqc(i)
    646665            CALL CALC_QSAT_ECMWF(zt(i),qtot,pplay(i,k),RTT,0,.false.,zqs(i),zdqs(i))
    647             zdqsdT_raw(i) = zdqs(i)*  &
    648             & RCPD*(1.0+RVTMP2*zq(i)) / (RLVTT*(1.-zdelta) + RLSTT*zdelta)
     666            zdqsdT_raw(i) = zdqs(i)*RCPD*(1.0+RVTMP2*zq(i)) / (RLVTT*(1.-zdelta) + RLSTT*zdelta)
    649667         
    650668            IF (zq(i) .LT. 1.e-15) THEN
    … …  
    677695        qincloud_mpc(:)=0.
    678696
    679 
    680 
    681697        IF (iflag_cld_th.GE.5) THEN
    682698
    … …  
    778794                        ! new temperature:
    779795                        Tbef(i)=Tbef(i)+DT(i)
    780 
    781796
    782797                        ! Rneb, qzn and zcond for lognormal PDFs
    … …  
    800815                        zpdf_e2(i)=1.-erf(zpdf_e2(i))
    801816             
    802                         IF (zpdf_e1(i).LT.1.e-10) THEN
    803                             rneb(i,k)=0.
    804                             zqn(i)=gammasat(i)*zqs(i)
     817                        !--ice sursaturation by Audran
     818                        IF ((iflag_ice_sursat.EQ.0).OR.(Tbef(i).GT.t_glace_min)) THEN
     819
     820                          IF (zpdf_e1(i).LT.1.e-10) THEN
     821                              rneb(i,k)=0.
     822                              zqn(i)=gammasat(i)*zqs(i)
     823                          ELSE
     824                              rneb(i,k)=0.5*zpdf_e1(i)
     825                              zqn(i)=zq(i)*zpdf_e2(i)/zpdf_e1(i)
     826                          ENDIF
     827
     828                          rnebss(i,k)=0.0   !--ajout OB (necessaire car boucle de convergence sur le temps)
     829                          fcontrN(i,k)=0.0  !--idem
     830                          fcontrP(i,k)=0.0  !--idem
     831                          qss(i,k)=0.0      !--idem
     832
    805833                        ELSE
    806                             rneb(i,k)=0.5*zpdf_e1(i)
    807                             zqn(i)=zq(i)*zpdf_e2(i)/zpdf_e1(i)
    808                         ENDIF
     834                        !------------------------------------
     835                        ! SURSATURATION EN GLACE
     836                        !------------------------------------
     837
     838                        CALL ice_sursat(pplay(i,k), paprs(i,k)-paprs(i,k+1), dtime, i, k, t(i,k), zq(i), &
     839                             gamma_ss(i,k), zqs(i), Tbef(i), rneb_seri(i,k), ratqs(i,k),               &
     840                             rneb(i,k), zqn(i), rnebss(i,k), qss(i,k),                                 &
     841                             Tcontr(i,k), qcontr(i,k), qcontr2(i,k), fcontrN(i,k), fcontrP(i,k) )
     842
     843                        ENDIF ! ((flag_ice_sursat.eq.0).or.(Tbef(i).gt.t_glace_min))
    809844
    810845                        ! If vertical heterogeneity, change fraction by volume as well
    … …  
    823858                       ! EV: calculation of icefrac in one sole function
    824859                        CALL icefrac_lscp(klon, zt(:),pplay(:,k)/paprs(:,1),zfice(:),dzfice(:))
    825 
    826860               
    827861                        IF (zfice(i).LT.1) THEN
    … …  
    9851019    ! remaining water in the cloud during the time step that is seen by the radiation
    9861020    ! -------------------------------------------------------------------------------
    987 
    9881021     
    9891022    DO n = 1, ninter
    … …  
    11281161   ENDDO
    11291162
    1130 
    1131 
    1132                                                                                                          
    11331163    ! LTP: limit of surface cloud fraction covered by precipitation when the local intensity of the flux is below rain_int_min                                                                             
    11341164    ! if iflag_evap_pre=4
    … …  
    11371167        DO i=1, klon                                       
    11381168               
    1139 
    11401169            IF ((zrflclr(i) + ziflclr(i)) .GT. 0. ) THEN     
    11411170                znebprecipclr(i) = min(znebprecipclr(i),max(zrflclr(i)/ &
    … …  
    11441173                znebprecipclr(i)=0.                                                                   
    11451174            ENDIF 
    1146 
    11471175                                                                                                         
    11481176            IF ((zrflcld(i) + ziflcld(i)) .GT. 0.) THEN                                                 
    … …  
    11521180                znebprecipcld(i)=0.                                                                   
    11531181            ENDIF     
    1154 
    11551182
    11561183        ENDDO       
    … …  
    11901217        ENDIF
    11911218
    1192         zprec_cond(i) = MAX(zcond(i)-zoliq(i),0.0) &
    1193         * (paprs(i,k)-paprs(i,k+1))/RG
    1194 
     1219        zprec_cond(i) = MAX(zcond(i)-zoliq(i),0.0)*(paprs(i,k)-paprs(i,k+1))/RG
    11951220
    11961221        IF (rneb(i,k).GT.0.0.AND.zprec_cond(i).GT.0.) THEN
    1197 
    11981222
    11991223            IF (t(i,k) .GE. t_glace_min) THEN
    … …  
    12021226                zalpha_tr = a_tr_sca(4)
    12031227            ENDIF
    1204 
    12051228
    12061229            zfrac_lessi = 1. - EXP(zalpha_tr*zprec_cond(i)/zneb(i))
    … …  
    12411264    ENDDO
    12421265     
    1243 
    1244 END DO
     1266    !--save some variables for ice sursaturation
     1267    !
     1268    DO i = 1, klon
     1269        ! pour la mémoire
     1270        rneb_seri(i,k) = rneb(i,k)
     1271
     1272        ! pour les diagnostics
     1273        rnebclr(i,k) = 1.0 - rneb(i,k) - rnebss(i,k)
     1274
     1275        qvc(i,k) = zqs(i) * rneb(i,k)
     1276        qclr(i,k) = MAX(1.e-10,zq(i) - qvc(i,k) - qss(i,k))  !--ajout OB a cause de cas pathologiques avec lognormale=F
     1277        qcld(i,k) = qvc(i,k) + zcond(i)
     1278
     1279        !q_sat
     1280        CALL CALC_QSAT_ECMWF(Tbef(i),0.,pplay(i,k),RTT,1,.false.,zqsatl(i,k),zdqs(i))
     1281        CALL CALC_QSAT_ECMWF(Tbef(i),0.,pplay(i,k),RTT,2,.false.,zqsats(i,k),zdqs(i))
     1282
     1283     ENDDO
     1284
     1285ENDDO
    12451286
    12461287!======================================================================
    12471288!                      END OF VERTICAL LOOP
    12481289!======================================================================
    1249  
    12501290
    12511291  ! Rain or snow at the surface (depending on the first layer temperature)
    … …  
    12541294      rain(i) = zrfl(i)
    12551295  ENDDO
    1256    
    1257  
    12581296
    12591297  IF (ncoreczq>0) THEN
    … …  
    12611299  ENDIF
    12621300
    1263 
    1264 
    1265 
    12661301END SUBROUTINE LSCP
    12671302!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Note: See TracChangeset for help on using the changeset viewer.