Ignore:
Timestamp:
Jul 15, 2024, 10:42:14 PM (2 months ago)
Author:
evignon
Message:

coherence entre phylmdiso et phylmd

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/cirrus/libf/phylmdiso/physiq_mod.F90

    r4881 r5055  
    7373    USE tracinca_mod, ONLY: config_inca
    7474    USE tropopause_m,     ONLY: dyn_tropopause
    75     USE ice_sursat_mod,  ONLY: flight_init, airplane
    7675    USE vampir
    7776    USE write_field_phy
    … …  
    192191       ! [Variables internes non sauvegardees de la physique]
    193192       ! Variables locales pour effectuer les appels en serie
    194        t_seri,q_seri,ql_seri,qs_seri,qbs_seri,u_seri,v_seri,tr_seri,rneb_seri, &
     193       t_seri,q_seri,ql_seri,qs_seri,qbs_seri, &
     194       u_seri,v_seri,cf_seri,rvc_seri,tr_seri, &
     195       rhcl, &       
    195196       ! Dynamic tendencies (diagnostics)
    196        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, &
     197       d_t_dyn,d_q_dyn,d_ql_dyn,d_qs_dyn,d_qbs_dyn, &
     198       d_u_dyn,d_v_dyn,d_cf_dyn,d_rvc_dyn,d_tr_dyn, &
    197199       d_q_dyn2d,d_ql_dyn2d,d_qs_dyn2d,d_qbs_dyn2d, &
    198200       ! Physic tendencies
    … …  
    271273       JrNt,                             &
    272274       dthmin, evap, snowerosion,fder, plcl, plfc,   &
    273        prw, prlw, prsw, prbsw,                  &
     275       prw, prlw, prsw, prbsw, water_budget,         &
    274276       s_lcl, s_pblh, s_pblt, s_therm,   &
    275277       cdragm, cdragh,                   &
    … …  
    346348       pfraclr,pfracld, &
    347349       distcltop,temp_cltop, &
    348        zqsatl, zqsats, &
    349        qclr, qcld, qss, qvc, rnebclr, rnebss, gamma_ss, &
     350       !-- LSCP - condensation and ice supersaturation variables
     351       qsub, qissr, qcld, subfra, issrfra, gamma_cond, ratio_qi_qtot, &
     352       dcf_sub, dcf_con, dcf_mix, dqi_adj, dqi_sub, dqi_con, dqi_mix, &
     353       dqvc_adj, dqvc_sub, dqvc_con, dqvc_mix, qsatliq, qsatice, &
     354       !-- LSCP - aviation and contrails variables
    350355       Tcontr, qcontr, qcontr2, fcontrN, fcontrP, &
     356       dcf_avi, dqi_avi, dqvc_avi, flight_dist, flight_h2o, &
     357       !
    351358       cldemi,  &
    352359       cldfra, cldtau, fiwc,  &
    … …  
    359366       t2m, fluxlat,  &
    360367       fsollw, evap_pot,  &
    361        fsolsw, wfbils, wfevap,  &
     368       fsolsw, wfbils, wfevap, & 
    362369       prfl, psfl,bsfl, fraca, Vprecip,  &
    363370       zw2,  &
    … …  
    373380       rneb,  &
    374381       zxsnow,snowhgt,qsnow,to_ice,sissnow,runoff,albsol3_lic, &
    375        zxfluxt,zxfluxq
     382       zxfluxt,zxfluxq 
    376383
    377384
    … …  
    549556    !
    550557    ! indices de traceurs eau vapeur, liquide, glace, fraction nuageuse LS (optional), blowing snow (optional)
    551     INTEGER,SAVE :: ivap, iliq, isol, irneb, ibs
    552 !$OMP THREADPRIVATE(ivap, iliq, isol, irneb, ibs)
     558    INTEGER,SAVE :: ivap, iliq, isol, ibs, icf, irvc
     559!$OMP THREADPRIVATE(ivap, iliq, isol, ibs, icf, irvc)
    553560    !
    554561    !
    … …  
    921928    ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    922929    !
    923     REAL rhcl(klon,klev)    ! humiditi relative ciel clair
     930!    REAL rhcl(klon,klev)    ! humiditi relative ciel clair
    924931    REAL dialiq(klon,klev)  ! eau liquide nuageuse
    925932    REAL diafra(klon,klev)  ! fraction nuageuse
    … …  
    14071414       iliq = strIdx(tracers(:)%name, addPhase('H2O', 'l'))
    14081415       isol = strIdx(tracers(:)%name, addPhase('H2O', 's'))
    1409        irneb= strIdx(tracers(:)%name, addPhase('H2O', 'r'))
    14101416       ibs  = strIdx(tracers(:)%name, addPhase('H2O', 'b'))
    1411        CALL init_etat0_limit_unstruct
     1417       icf  = strIdx(tracers(:)%name, addPhase('H2O', 'f'))
     1418       irvc = strIdx(tracers(:)%name, addPhase('H2O', 'c'))
     1419!       CALL init_etat0_limit_unstruct
    14121420       IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed)
    14131421       !CR:nvelles variables convection/poches froides
    … …  
    14541462       ENDIF
    14551463
    1456        IF (ok_ice_sursat.AND.(iflag_ice_thermo.EQ.0)) THEN
    1457           WRITE (lunout, *) ' ok_ice_sursat=y requires iflag_ice_thermo=1 as well'
     1464       IF (ok_ice_supersat.AND.(iflag_ice_thermo.EQ.0)) THEN
     1465          WRITE (lunout, *) ' ok_ice_supersat=y requires iflag_ice_thermo=1 as well'
    14581466          abort_message='see above'
    14591467          CALL abort_physic(modname,abort_message,1)
    14601468       ENDIF
    14611469
    1462        IF (ok_ice_sursat.AND.(nqo.LT.4)) THEN
    1463           WRITE (lunout, *) ' ok_ice_sursat=y requires 4 H2O tracers ', &
    1464                '(H2O_g, H2O_l, H2O_s, H2O_r) but nqo=', nqo, '. Might as well stop here.'
     1470       IF (ok_ice_supersat.AND.(nqo.LT.5)) THEN
     1471          WRITE (lunout, *) ' ok_ice_supersat=y requires 5 H2O tracers ', &
     1472               '(H2O_g, H2O_l, H2O_s, H2O_f, H2O_c) but nqo=', nqo, '. Might as well stop here.'
    14651473          abort_message='see above'
    14661474          CALL abort_physic(modname,abort_message,1)
    14671475       ENDIF
    14681476
    1469        IF (ok_plane_h2o.AND..NOT.ok_ice_sursat) THEN
    1470           WRITE (lunout, *) ' ok_plane_h2o=y requires ok_ice_sursat=y '
     1477       IF (ok_plane_h2o.AND..NOT.ok_ice_supersat) THEN
     1478          WRITE (lunout, *) ' ok_plane_h2o=y requires ok_ice_supersat=y '
    14711479          abort_message='see above'
    14721480          CALL abort_physic(modname,abort_message,1)
    14731481       ENDIF
    14741482
    1475        IF (ok_plane_contrail.AND..NOT.ok_ice_sursat) THEN
    1476           WRITE (lunout, *) ' ok_plane_contrail=y requires ok_ice_sursat=y '
     1483       IF (ok_plane_contrail.AND..NOT.ok_ice_supersat) THEN
     1484          WRITE (lunout, *) ' ok_plane_contrail=y requires ok_ice_supersat=y '
    14771485          abort_message='see above'
    14781486          CALL abort_physic(modname,abort_message,1)
    … …  
    14821490          abort_message='blowing snow cannot be activated with water isotopes yet'
    14831491          CALL abort_physic(modname,abort_message, 1)
    1484          IF ((ok_ice_sursat.AND.nqo .LT.5).OR.(.NOT.ok_ice_sursat.AND.nqo.LT.4)) THEN
     1492         IF ((ok_ice_supersat.AND.nqo .LT.6).OR.(.NOT.ok_ice_supersat.AND.nqo.LT.4)) THEN
    14851493             WRITE (lunout, *) 'activation of blowing snow needs a specific H2O tracer', &
    14861494                               'but nqo=', nqo
    … …  
    19501958   &    RG,RD,RCPD,RKAPPA,RLVTT,RETV)
    19511959       CALL ratqs_ini(klon,klev,iflag_thermals,lunout,nbsrf,is_lic,is_ter,RG,RV,RD,RCPD,RLSTT,RLVTT,RTT)
    1952        CALL lscp_ini(pdtphys,lunout,prt_level,ok_ice_sursat,iflag_ratqs,fl_cor_ebil,RCPD,RLSTT,RLVTT,RLMLT,RVTMP2,RTT,RD,RG,RPI)
     1960       CALL lscp_ini(pdtphys,lunout,prt_level,ok_ice_supersat,iflag_ratqs,fl_cor_ebil, &
     1961                     RCPD,RLSTT,RLVTT,RLMLT,RVTMP2,RTT,RD,RV,RG,RPI,EPS_W)
    19531962       CALL blowing_snow_ini(RCPD, RLSTT, RLVTT, RLMLT, &
    19541963                             RVTMP2, RTT,RD,RG, RV, RPI)
    … …  
    20012010                              ptconv, read_climoz, clevSTD,                   &
    20022011                              ptconvth, d_u, d_t, qx, d_qx, zmasse,           &
    2003                               flag_aerosol, flag_aerosol_strat, ok_cdnc,t,u1,v1)
     2012                              flag_aerosol, flag_aerosol_strat, ok_cdnc, t, u1, v1)
    20042013#endif
    20052014
    … …  
    24342443                    sollwdown(:))
    24352444
     2445      !--Init for LSCP - condensation
     2446      ratio_qi_qtot(:,:) = 0.
    24362447
    24372448
    … …  
    25402551          q_seri(i,k)  = qx(i,k,ivap)
    25412552          ql_seri(i,k) = qx(i,k,iliq)
    2542           qbs_seri(i,k) = 0.
     2553          qbs_seri(i,k)= 0.
     2554          cf_seri(i,k) = 0.
     2555          rvc_seri(i,k)= 0.
    25432556          !CR: ATTENTION, on rajoute la variable glace
    25442557          IF (nqo.EQ.2) THEN             !--vapour and liquid only
    25452558             qs_seri(i,k) = 0.
    2546              rneb_seri(i,k) = 0.
    25472559          ELSE IF (nqo.EQ.3) THEN        !--vapour, liquid and ice
    25482560             qs_seri(i,k) = qx(i,k,isol)
    2549              rneb_seri(i,k) = 0.
    2550           ELSE IF (nqo.GE.4) THEN        !--vapour, liquid, ice and rneb and blowing snow
     2561          ELSE IF (nqo.GE.4) THEN        !--vapour, liquid, ice, blowing snow, cloud fraction and cloudy water vapor to total water vapor ratio
    25512562             qs_seri(i,k) = qx(i,k,isol)
    2552              IF (ok_ice_sursat) THEN
    2553              rneb_seri(i,k) = qx(i,k,irneb)
     2563             IF (ok_ice_supersat) THEN
     2564               cf_seri(i,k) = qx(i,k,icf)
     2565               rvc_seri(i,k) = qx(i,k,irvc)
    25542566             ENDIF
    25552567             IF (ok_bs) THEN
    2556              qbs_seri(i,k)= qx(i,k,ibs)
     2568               qbs_seri(i,k)= qx(i,k,ibs)
    25572569             ENDIF
    2558 
    25592570          ENDIF
    2560 
    2561 
    25622571       ENDDO
    25632572    ENDDO
    … …  
    27172726       d_ql_dyn(:,:) = (ql_seri(:,:)-ql_ancien(:,:))/phys_tstep
    27182727       d_qs_dyn(:,:) = (qs_seri(:,:)-qs_ancien(:,:))/phys_tstep
    2719        d_qbs_dyn(:,:) = (qbs_seri(:,:)-qbs_ancien(:,:))/phys_tstep
     2728       d_qbs_dyn(:,:)= (qbs_seri(:,:)-qbs_ancien(:,:))/phys_tstep
     2729       d_cf_dyn(:,:) = (cf_seri(:,:)-cf_ancien(:,:))/phys_tstep
     2730       d_rvc_dyn(:,:)= (rvc_seri(:,:)-rvc_ancien(:,:))/phys_tstep
    27202731       CALL water_int(klon,klev,q_seri,zmasse,zx_tmp_fi2d)
    27212732       d_q_dyn2d(:)=(zx_tmp_fi2d(:)-prw_ancien(:))/phys_tstep
    … …  
    27292740       IF (nqtot > nqo) d_tr_dyn(:,:,:)=(tr_seri(:,:,:)-tr_ancien(:,:,:))/phys_tstep
    27302741       ! !! RomP <<<
    2731        !!d_rneb_dyn(:,:)=(rneb_seri(:,:)-rneb_ancien(:,:))/phys_tstep
    2732        d_rneb_dyn(:,:)=0.0
    27332742
    27342743#ifdef ISO
    … …  
    28092818       d_ql_dyn(:,:) = 0.0
    28102819       d_qs_dyn(:,:) = 0.0
     2820       d_qbs_dyn(:,:)= 0.0
     2821       d_cf_dyn(:,:) = 0.0
     2822       d_rvc_dyn(:,:)= 0.0
    28112823       d_q_dyn2d(:)  = 0.0
    28122824       d_ql_dyn2d(:) = 0.0
    … …  
    28352847       IF (nqtot > nqo) d_tr_dyn(:,:,:)= 0.0
    28362848       ! !! RomP <<<
    2837        d_rneb_dyn(:,:)=0.0
    2838        d_qbs_dyn(:,:)=0.0
    28392849       ancien_ok = .TRUE.
    28402850    ENDIF
    … …  
    29442954          ! "zmasse" changes a little.)
    29452955       ENDIF
     2956    ENDIF
     2957
     2958    !-- Needed for LSCP - condensation and ice supersaturation
     2959    IF (ok_ice_supersat) THEN
     2960      DO k = 1, klev
     2961        DO i = 1, klon
     2962          IF ( ( q_seri(i,k) + ql_seri(i,k) + qs_seri(i,k) ) .GT. 0. ) THEN
     2963            ratio_qi_qtot(i,k) = qs_seri(i,k) / ( q_seri(i,k) + ql_seri(i,k) + qs_seri(i,k) )
     2964            rvc_seri(i,k) = rvc_seri(i,k) * q_seri(i,k) / ( q_seri(i,k) + ql_seri(i,k) + qs_seri(i,k) )
     2965          ELSE
     2966            ratio_qi_qtot(i,k) = 0.
     2967            rvc_seri(i,k) = 0.
     2968          ENDIF
     2969        ENDDO
     2970      ENDDO
    29462971    ENDIF
    29472972
    … …  
    48724897
    48734898    !--mise à jour de flight_m et flight_h2o dans leur module
    4874     IF (ok_plane_h2o .OR. ok_plane_contrail) THEN
    4875       CALL airplane(debut,pphis,pplay,paprs,t_seri)
    4876     ENDIF
     4899    !IF (ok_plane_h2o .OR. ok_plane_contrail) THEN
     4900    !  CALL airplane(debut,pphis,pplay,paprs,t_seri)
     4901    !ENDIF
    48774902
    48784903    CALL lscp(klon,klev,phys_tstep,missing_val,paprs,pplay, &
    48794904         t_seri, q_seri,ptconv,ratqs, &
    4880          d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, rneb_seri, &
     4905         d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, &
    48814906         pfraclr,pfracld, &
    48824907         radocond, picefra, rain_lsc, snow_lsc, &
    … …  
    48844909         prfl, psfl, rhcl,  &
    48854910         zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cld_th, &
    4886          iflag_ice_thermo, ok_ice_sursat, zqsatl, zqsats, distcltop, temp_cltop, &
    4887          qclr, qcld, qss, qvc, rnebclr, rnebss, gamma_ss, &
    4888          Tcontr, qcontr, qcontr2, fcontrN, fcontrP , &
     4911         iflag_ice_thermo, distcltop, temp_cltop, cell_area, &
     4912         cf_seri, rvc_seri, u_seri, v_seri, pbl_eps(:,:,is_ave), &
     4913         qsub, qissr, qcld, subfra, issrfra, gamma_cond, ratio_qi_qtot, &
     4914         dcf_sub, dcf_con, dcf_mix, dqi_adj, dqi_sub, dqi_con, dqi_mix, &
     4915         dqvc_adj, dqvc_sub, dqvc_con, dqvc_mix, qsatliq, qsatice, &
     4916         Tcontr, qcontr, qcontr2, fcontrN, fcontrP, &
     4917         dcf_avi, dqi_avi, dqvc_avi, flight_dist, flight_h2o, &
    48894918         cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv, &
    48904919         qraindiag, qsnowdiag, dqreva, dqssub, dqrauto, dqrcol, dqrmelt, &
    … …  
    68236852             d_qx(i,k,isol) = ( qs_seri(i,k) - qx(i,k,isol) ) / phys_tstep
    68246853          ENDIF
    6825           !--ice_sursat: nqo=4, on ajoute rneb
    6826           IF (nqo.ge.4 .and. ok_ice_sursat) THEN
    6827              d_qx(i,k,irneb) = ( rneb_seri(i,k) - qx(i,k,irneb) ) / phys_tstep
     6854          !--ice_supersat: nqo=5, we add cloud fraction and cloudy water vapor to total water vapor ratio
     6855          IF (nqo.ge.5 .and. ok_ice_supersat) THEN
     6856             d_qx(i,k,icf) = ( cf_seri(i,k) - qx(i,k,icf) ) / phys_tstep
     6857             d_qx(i,k,irvc) = ( rvc_seri(i,k) - qx(i,k,irvc) ) / phys_tstep
    68286858          ENDIF
    68296859
    … …  
    68316861             d_qx(i,k,ibs) = ( qbs_seri(i,k) - qx(i,k,ibs) ) / phys_tstep
    68326862          ENDIF
    6833 
    68346863
    68356864       ENDDO
    … …  
    69266955    ql_ancien(:,:) = ql_seri(:,:)
    69276956    qs_ancien(:,:) = qs_seri(:,:)
    6928     qbs_ancien(:,:) = qbs_seri(:,:)
    6929     rneb_ancien(:,:) = rneb_seri(:,:)
     6957    qbs_ancien(:,:)= qbs_seri(:,:)
     6958    cf_ancien(:,:) = cf_seri(:,:)
     6959    rvc_ancien(:,:)= rvc_seri(:,:)
    69306960#ifdef ISO
    69316961    xt_ancien(:,:,:)=xt_seri(:,:,:)
Note: See TracChangeset for help on using the changeset viewer.