Ignore:
Timestamp:
Sep 20, 2024, 1:28:24 PM (2 months ago)
Author:
Laurent Fairhead
Message:

Integrating A.Borella's work on cirrus in the trunk

Location:
LMDZ6/trunk
Files:
1 deleted
4 edited
3 copied

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk

  • LMDZ6/trunk/libf/phylmdiso/phyetat0_mod.F90

    r5199 r5204  
    2525       du_gwd_rando, du_gwd_front, entr_therm, f0, fm_therm, &
    2626       falb_dir, falb_dif, prw_ancien, prlw_ancien, prsw_ancien, prbsw_ancien, &
    27        ftsol, pbl_tke, pctsrf, q_ancien, ql_ancien, qs_ancien, qbs_ancien, rneb_ancien, radpas, radsol, rain_fall, ratqs, &
     27       ftsol, pbl_tke, pctsrf, q_ancien, ql_ancien, qs_ancien, qbs_ancien, &
     28       cf_ancien, rvc_ancien, radpas, radsol, rain_fall, ratqs, &
    2829       rnebcon, rugoro, sig1, snow_fall, bs_fall, solaire_etat0, sollw, sollwdown, &
    2930       solsw, solswfdiff, t_ancien, u_ancien, v_ancien, w01, wake_cstar, wake_deltaq, &
    … …  
    420421  ancien_ok=ancien_ok.AND.phyetat0_get(ql_ancien,"QLANCIEN","QLANCIEN",0.)
    421422  ancien_ok=ancien_ok.AND.phyetat0_get(qs_ancien,"QSANCIEN","QSANCIEN",0.)
    422   ancien_ok=ancien_ok.AND.phyetat0_get(rneb_ancien,"RNEBANCIEN","RNEBANCIEN",0.)
    423423  ancien_ok=ancien_ok.AND.phyetat0_get(u_ancien,"UANCIEN","UANCIEN",0.)
    424424  ancien_ok=ancien_ok.AND.phyetat0_get(v_ancien,"VANCIEN","VANCIEN",0.)
    … …  
    435435     prbsw_ancien(:)=0.
    436436  ENDIF
     437 
     438  ! cas specifique des variables de la sursaturation par rapport a la glace
     439  IF ( ok_ice_supersat ) THEN
     440    ancien_ok=ancien_ok.AND.phyetat0_get(cf_ancien,"CFANCIEN","CFANCIEN",0.)
     441    ancien_ok=ancien_ok.AND.phyetat0_get(rvc_ancien,"RVCANCIEN","RVCANCIEN",0.)
     442  ELSE
     443    cf_ancien(:,:)=0.
     444    rvc_ancien(:,:)=0.
     445  ENDIF
    437446
    438447  ! Ehouarn: addtional tests to check if t_ancien, q_ancien contain
    … …  
    442451       (maxval(ql_ancien).EQ.minval(ql_ancien))     .OR. &
    443452       (maxval(qs_ancien).EQ.minval(qs_ancien))     .OR. &
    444        (maxval(rneb_ancien).EQ.minval(rneb_ancien)) .OR. &
    445453       (maxval(prw_ancien).EQ.minval(prw_ancien))   .OR. &
    446454       (maxval(prlw_ancien).EQ.minval(prlw_ancien)) .OR. &
    … …  
    455463       ancien_ok=.false.
    456464    ENDIF
     465  ENDIF
     466
     467  IF ( ok_ice_supersat ) THEN
     468    IF ( (maxval(cf_ancien).EQ.minval(cf_ancien))     .OR. &
     469         (maxval(rvc_ancien).EQ.minval(rvc_ancien)) ) THEN
     470       ancien_ok=.false.
     471     ENDIF
    457472  ENDIF
    458473

  • LMDZ6/trunk/libf/phylmdiso/phyredem.F90

    r4613 r5204  
    1919                                zval, rugoro, t_ancien, q_ancien,            &
    2020                                prw_ancien, prlw_ancien, prsw_ancien, prbsw_ancien,      &
    21                                 ql_ancien, qs_ancien, qbs_ancien,  u_ancien, &
    22                                 v_ancien, clwcon, rnebcon, ratqs, pbl_tke,   &
     21                                ql_ancien, qs_ancien, qbs_ancien, cf_ancien, &
     22                                rvc_ancien, u_ancien, v_ancien,              &
     23                                clwcon, rnebcon, ratqs, pbl_tke,             &
    2324                                wake_delta_pbl_tke, zmax0, f0, sig1, w01,    &
    2425                                wake_deltat, wake_deltaq, wake_s, wake_dens, &
    … …  
    265266       CALL put_field(pass,"QBSANCIEN", "QBSANCIEN", qbs_ancien)
    266267       CALL put_field(pass,"PRBSWANCIEN", "PRBSWANCIEN", prbsw_ancien)
     268    ENDIF
     269
     270    IF ( ok_ice_supersat ) THEN
     271      CALL put_field(pass,"CFANCIEN", "CFANCIEN", cf_ancien)
     272      CALL put_field(pass,"RVCANCIEN", "RVCANCIEN", rvc_ancien)
    267273    ENDIF
    268274

  • LMDZ6/trunk/libf/phylmdiso/physiq_mod.F90

    r5199 r5204  
    7272    USE tracinca_mod, ONLY: config_inca
    7373    USE tropopause_m,     ONLY: dyn_tropopause
    74     USE ice_sursat_mod,  ONLY: flight_init, airplane
    7574    USE vampir
    7675    USE write_field_phy
    … …  
    195194       ! [Variables internes non sauvegardees de la physique]
    196195       ! Variables locales pour effectuer les appels en serie
    197        t_seri,q_seri,ql_seri,qs_seri,qbs_seri,u_seri,v_seri,tr_seri,rneb_seri, &
     196       t_seri,q_seri,ql_seri,qs_seri,qbs_seri, &
     197       u_seri,v_seri,cf_seri,rvc_seri,tr_seri, &
     198       rhcl, &       
    198199       qx_seri, & ! CR
    199200       rhcl, &       
    200201       ! Dynamic tendencies (diagnostics)
    201        d_t_dyn,d_q_dyn,d_ql_dyn,d_qs_dyn,d_qbs_dyn,d_u_dyn,d_v_dyn,d_tr_dyn,d_rneb_dyn, &
     202       d_t_dyn,d_q_dyn,d_ql_dyn,d_qs_dyn,d_qbs_dyn, &
     203       d_u_dyn,d_v_dyn,d_cf_dyn,d_rvc_dyn,d_tr_dyn, &
    202204       d_q_dyn2d,d_ql_dyn2d,d_qs_dyn2d,d_qbs_dyn2d, &
    203205       ! Physic tendencies
    … …  
    374376       pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb,  &
    375377       distcltop, temp_cltop,  &
    376        zqsatl, zqsats, &
    377        qclr, qcld, qss, qvc, rnebclr, rnebss, gamma_ss, &
     378       !-- LSCP - condensation and ice supersaturation variables
     379       qsub, qissr, qcld, subfra, issrfra, gamma_cond, ratio_qi_qtot, &
     380       dcf_sub, dcf_con, dcf_mix, dqi_adj, dqi_sub, dqi_con, dqi_mix, &
     381       dqvc_adj, dqvc_sub, dqvc_con, dqvc_mix, qsatliq, qsatice, &
     382       !-- LSCP - aviation and contrails variables
    378383       Tcontr, qcontr, qcontr2, fcontrN, fcontrP, &
     384       dcf_avi, dqi_avi, dqvc_avi, flight_dist, flight_h2o, &
     385       !
    379386       cldemi,  &
    380387       cldfra, cldtau, fiwc,  &
    … …  
    584591! reevap -> je commente les 2 lignes au dessus et je laisse la definition
    585592! plutot dans infotrac_phy
    586     INTEGER,SAVE :: irneb, ibs
    587 !$OMP THREADPRIVATE(irneb, ibs)
     593    INTEGER,SAVE :: irneb, ibs, icf,irvc
     594!$OMP THREADPRIVATE(irneb, ibs, icf,irvc)
    588595!
    589596    !
    … …  
    14791486       iliq = strIdx(tracers(:)%name, addPhase('H2O', 'l'))
    14801487       isol = strIdx(tracers(:)%name, addPhase('H2O', 's'))
    1481        irneb= strIdx(tracers(:)%name, addPhase('H2O', 'r'))
    14821488       ibs  = strIdx(tracers(:)%name, addPhase('H2O', 'b'))
     1489       icf  = strIdx(tracers(:)%name, addPhase('H2O', 'f'))
     1490       irvc = strIdx(tracers(:)%name, addPhase('H2O', 'c'))
    14831491!       CALL init_etat0_limit_unstruct
    1484 !       IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed)
     1492       IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed)
    14851493       !CR:nvelles variables convection/poches froides
    14861494
    … …  
    15331541       ENDIF
    15341542
    1535        IF (ok_ice_sursat.AND.(iflag_ice_thermo.EQ.0)) THEN
    1536           WRITE (lunout, *) ' ok_ice_sursat=y requires iflag_ice_thermo=1 as well'
     1543       IF (ok_ice_supersat.AND.(iflag_ice_thermo.EQ.0)) THEN
     1544          WRITE (lunout, *) ' ok_ice_supersat=y requires iflag_ice_thermo=1 as well'
    15371545          abort_message='see above'
    15381546          CALL abort_physic(modname,abort_message,1)
    15391547       ENDIF
    15401548
    1541        IF (ok_ice_sursat.AND.(nqo.LT.4)) THEN
    1542           WRITE (lunout, *) ' ok_ice_sursat=y requires 4 H2O tracers ', &
    1543                '(H2O_g, H2O_l, H2O_s, H2O_r) but nqo=', nqo, '. Might as well stop here.'
     1549       IF (ok_ice_supersat.AND.(nqo.LT.5)) THEN
     1550          WRITE (lunout, *) ' ok_ice_supersat=y requires 5 H2O tracers ', &
     1551               '(H2O_g, H2O_l, H2O_s, H2O_f, H2O_c) but nqo=', nqo, '. Might as well stop here.'
    15441552          abort_message='see above'
    15451553          CALL abort_physic(modname,abort_message,1)
    15461554       ENDIF
    15471555
    1548        IF (ok_plane_h2o.AND..NOT.ok_ice_sursat) THEN
    1549           WRITE (lunout, *) ' ok_plane_h2o=y requires ok_ice_sursat=y '
     1556       IF (ok_plane_h2o.AND..NOT.ok_ice_supersat) THEN
     1557          WRITE (lunout, *) ' ok_plane_h2o=y requires ok_ice_supersat=y '
    15501558          abort_message='see above'
    15511559          CALL abort_physic(modname,abort_message,1)
    15521560       ENDIF
    15531561
    1554        IF (ok_plane_contrail.AND..NOT.ok_ice_sursat) THEN
    1555           WRITE (lunout, *) ' ok_plane_contrail=y requires ok_ice_sursat=y '
     1562       IF (ok_plane_contrail.AND..NOT.ok_ice_supersat) THEN
     1563          WRITE (lunout, *) ' ok_plane_contrail=y requires ok_ice_supersat=y '
    15561564          abort_message='see above'
    15571565          CALL abort_physic(modname,abort_message,1)
    … …  
    15621570          abort_message='blowing snow cannot be activated with water isotopes yet'
    15631571          CALL abort_physic(modname,abort_message, 1)
    1564 #endif
    1565          IF ((ok_ice_sursat.AND.nqo .LT.5).OR.(.NOT.ok_ice_sursat.AND.nqo.LT.4)) THEN
     1572         IF ((ok_ice_supersat.AND.nqo .LT.6).OR.(.NOT.ok_ice_supersat.AND.nqo.LT.4)) THEN
    15661573             WRITE (lunout, *) 'activation of blowing snow needs a specific H2O tracer', &
    15671574                               'but nqo=', nqo
    … …  
    20152022   &    RG,RD,RCPD,RKAPPA,RLVTT,RETV)
    20162023       CALL ratqs_ini(klon,klev,iflag_thermals,lunout,nbsrf,is_lic,is_ter,RG,RV,RD,RCPD,RLSTT,RLVTT,RTT)
    2017        CALL lscp_ini(pdtphys,lunout,prt_level,ok_ice_sursat,iflag_ratqs,fl_cor_ebil,RCPD,RLSTT,RLVTT,RLMLT,RVTMP2,RTT,RD,RG,RV,RPI)
     2024       CALL lscp_ini(pdtphys,lunout,prt_level,ok_ice_supersat,iflag_ratqs,fl_cor_ebil, &
     2025                     RCPD,RLSTT,RLVTT,RLMLT,RVTMP2,RTT,RD,RV,RG,RPI,EPS_W)
    20182026       CALL blowing_snow_ini(RCPD, RLSTT, RLVTT, RLMLT, &
    20192027                             RVTMP2, RTT,RD,RG, RV, RPI)
    … …  
    24972505                    sollwdown(:))
    24982506
     2507      !--Init for LSCP - condensation
     2508      ratio_qi_qtot(:,:) = 0.
    24992509
    25002510
    … …  
    26042614          q_seri(i,k)  = qx(i,k,ivap)
    26052615          ql_seri(i,k) = qx(i,k,iliq)
    2606           qbs_seri(i,k) = 0.
     2616          qbs_seri(i,k)= 0.
     2617          cf_seri(i,k) = 0.
     2618          rvc_seri(i,k)= 0.
    26072619          !CR: ATTENTION, on rajoute la variable glace
    26082620          IF (nqo.EQ.2) THEN             !--vapour and liquid only
    26092621             qs_seri(i,k) = 0.
    2610              rneb_seri(i,k) = 0.
    26112622          ELSE IF (nqo.EQ.3) THEN        !--vapour, liquid and ice
    26122623             qs_seri(i,k) = qx(i,k,isol)
    2613              rneb_seri(i,k) = 0.
    2614           ELSE IF (nqo.GE.4) THEN        !--vapour, liquid, ice and rneb and blowing snow
     2624          ELSE IF (nqo.GE.4) THEN        !--vapour, liquid, ice, blowing snow, cloud fraction and cloudy water vapor to total water vapor ratio
    26152625             qs_seri(i,k) = qx(i,k,isol)
    2616              IF (ok_ice_sursat) THEN
    2617                rneb_seri(i,k) = qx(i,k,irneb)
     2626             IF (ok_ice_supersat) THEN
     2627               cf_seri(i,k) = qx(i,k,icf)
     2628               rvc_seri(i,k) = qx(i,k,irvc)
    26182629             ENDIF
    26192630             IF (ok_bs) THEN
    … …  
    27842795       d_ql_dyn(:,:) = (ql_seri(:,:)-ql_ancien(:,:))/phys_tstep
    27852796       d_qs_dyn(:,:) = (qs_seri(:,:)-qs_ancien(:,:))/phys_tstep
    2786        d_qbs_dyn(:,:) = (qbs_seri(:,:)-qbs_ancien(:,:))/phys_tstep
     2797       d_qbs_dyn(:,:)= (qbs_seri(:,:)-qbs_ancien(:,:))/phys_tstep
     2798       d_cf_dyn(:,:) = (cf_seri(:,:)-cf_ancien(:,:))/phys_tstep
     2799       d_rvc_dyn(:,:)= (rvc_seri(:,:)-rvc_ancien(:,:))/phys_tstep
    27872800       CALL water_int(klon,klev,q_seri,zmasse,zx_tmp_fi2d)
    27882801       d_q_dyn2d(:)=(zx_tmp_fi2d(:)-prw_ancien(:))/phys_tstep
    … …  
    27962809       IF (nqtot > nqo) d_tr_dyn(:,:,:)=(tr_seri(:,:,:)-tr_ancien(:,:,:))/phys_tstep
    27972810       ! !! RomP <<<
    2798        !!d_rneb_dyn(:,:)=(rneb_seri(:,:)-rneb_ancien(:,:))/phys_tstep
    2799        d_rneb_dyn(:,:)=0.0
    28002811
    28012812#ifdef ISO
    … …  
    28792890       d_ql_dyn(:,:) = 0.0
    28802891       d_qs_dyn(:,:) = 0.0
     2892       d_qbs_dyn(:,:)= 0.0
     2893       d_cf_dyn(:,:) = 0.0
     2894       d_rvc_dyn(:,:)= 0.0
    28812895       d_q_dyn2d(:)  = 0.0
    28822896       d_ql_dyn2d(:) = 0.0
    … …  
    29052919       IF (nqtot > nqo) d_tr_dyn(:,:,:)= 0.0
    29062920       ! !! RomP <<<
    2907        d_rneb_dyn(:,:)=0.0
    2908        d_qbs_dyn(:,:)=0.0
    29092921       ancien_ok = .TRUE.
    29102922#ifdef ISO
    … …  
    30173029          ! "zmasse" changes a little.)
    30183030       ENDIF
     3031    ENDIF
     3032
     3033    !-- Needed for LSCP - condensation and ice supersaturation
     3034    IF (ok_ice_supersat) THEN
     3035      DO k = 1, klev
     3036        DO i = 1, klon
     3037          IF ( ( q_seri(i,k) + ql_seri(i,k) + qs_seri(i,k) ) .GT. 0. ) THEN
     3038            ratio_qi_qtot(i,k) = qs_seri(i,k) / ( q_seri(i,k) + ql_seri(i,k) + qs_seri(i,k) )
     3039            rvc_seri(i,k) = rvc_seri(i,k) * q_seri(i,k) / ( q_seri(i,k) + ql_seri(i,k) + qs_seri(i,k) )
     3040          ELSE
     3041            ratio_qi_qtot(i,k) = 0.
     3042            rvc_seri(i,k) = 0.
     3043          ENDIF
     3044        ENDDO
     3045      ENDDO
    30193046    ENDIF
    30203047
    … …  
    50605087
    50615088    !--mise à jour de flight_m et flight_h2o dans leur module
    5062     IF (ok_plane_h2o .OR. ok_plane_contrail) THEN
    5063       CALL airplane(debut,pphis,pplay,paprs,t_seri)
    5064     ENDIF
     5089    !IF (ok_plane_h2o .OR. ok_plane_contrail) THEN
     5090    !  CALL airplane(debut,pphis,pplay,paprs,t_seri)
     5091    !ENDIF
    50655092
    50665093    CALL lscp(klon,klev,phys_tstep,missing_val,paprs,pplay, &
    50675094         t_seri, q_seri,qs_ini,ptconv,ratqs, &
    5068          d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, rneb_seri, &
     5095         d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, &
    50695096         pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb,  &
    50705097         radocond, picefra, rain_lsc, snow_lsc, &
    … …  
    50725099         prfl, psfl, rhcl,  &
    50735100         zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cld_th, &
    5074          iflag_ice_thermo, ok_ice_sursat, zqsatl, zqsats, distcltop, temp_cltop,  &
    5075          pbl_tke(:,:,is_ave), pbl_eps(:,:,is_ave), qclr, qcld, qss, qvc, rnebclr, rnebss, gamma_ss, &
    5076          Tcontr, qcontr, qcontr2, fcontrN, fcontrP , &
     5101         iflag_ice_thermo, distcltop, temp_cltop,
     5102         pbl_tke(:,:,is_ave), pbl_eps(:,:,is_ave), &
     5103         cell_area, &
     5104         cf_seri, rvc_seri, u_seri, v_seri, &
     5105         qsub, qissr, qcld, subfra, issrfra, gamma_cond, ratio_qi_qtot, &
     5106         dcf_sub, dcf_con, dcf_mix, dqi_adj, dqi_sub, dqi_con, dqi_mix, &
     5107         dqvc_adj, dqvc_sub, dqvc_con, dqvc_mix, qsatliq, qsatice, &
     5108         Tcontr, qcontr, qcontr2, fcontrN, fcontrP, &
     5109         dcf_avi, dqi_avi, dqvc_avi, flight_dist, flight_h2o, &
    50775110         cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv, &
    50785111         qraindiag, qsnowdiag, dqreva, dqssub, dqrauto, dqrcol, dqrmelt, &
    … …  
    71297162             d_qx(i,k,isol) = ( qs_seri(i,k) - qx(i,k,isol) ) / phys_tstep
    71307163          ENDIF
    7131           !--ice_sursat: nqo=4, on ajoute rneb
    7132           IF (nqo.ge.4 .and. ok_ice_sursat) THEN
    7133              d_qx(i,k,irneb) = ( rneb_seri(i,k) - qx(i,k,irneb) ) / phys_tstep
     7164          !--ice_supersat: nqo=5, we add cloud fraction and cloudy water vapor to total water vapor ratio
     7165          IF (nqo.ge.5 .and. ok_ice_supersat) THEN
     7166             d_qx(i,k,icf) = ( cf_seri(i,k) - qx(i,k,icf) ) / phys_tstep
     7167             d_qx(i,k,irvc) = ( rvc_seri(i,k) - qx(i,k,irvc) ) / phys_tstep
    71347168          ENDIF
    71357169
    … …  
    71377171             d_qx(i,k,ibs) = ( qbs_seri(i,k) - qx(i,k,ibs) ) / phys_tstep
    71387172          ENDIF
    7139 
    71407173
    71417174       ENDDO
    … …  
    71867219    ql_ancien(:,:) = ql_seri(:,:)
    71877220    qs_ancien(:,:) = qs_seri(:,:)
    7188     qbs_ancien(:,:) = qbs_seri(:,:)
    7189     rneb_ancien(:,:) = rneb_seri(:,:)
     7221    qbs_ancien(:,:)= qbs_seri(:,:)
     7222    cf_ancien(:,:) = cf_seri(:,:)
     7223    rvc_ancien(:,:)= rvc_seri(:,:)
    71907224#ifdef ISO
    71917225    xt_ancien(:,:,:)=xt_seri(:,:,:)
Note: See TracChangeset for help on using the changeset viewer.