Ignore:
Timestamp:
Sep 20, 2024, 12:32:04 PM (7 weeks ago)
Author:
Laurent Fairhead
Message:

Updating cirrus branch to trunk revision 5171

Location:
LMDZ6/branches/cirrus
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/cirrus

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

    r4951 r5202  
    1 !
     1
    22! $Id$
    33!
    … …  
    184184       d_ts, &
    185185       !
    186        d_t_bs,d_q_bs,d_qbs_bs, &
     186       d_t_bsss,d_q_bsss,d_qbs_bsss, &
    187187       !
    188188!       d_t_oli,d_u_oli,d_v_oli, &
    … …  
    333333       !
    334334       rneblsvol, &
    335        pfraclr,pfracld, &
    336        distcltop,temp_cltop, &
     335       pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb, &
     336       distcltop, temp_cltop, &
    337337       !-- LSCP - condensation and ice supersaturation variables
    338338       qsub, qissr, qcld, subfra, issrfra, gamma_cond, ratio_qi_qtot, &
    … …  
    909909    REAL zdtime, zdtime1, zdtime2, zlongi
    910910    !
    911     REAL qcheck
    912911    REAL z_avant(klon), z_apres(klon), z_factor(klon)
    913912    LOGICAL zx_ajustq
    … …  
    11331132    REAL, DIMENSION(klon,klev)     :: mass_solu_aero_pi
    11341133    ! - " - (pre-industrial value)
     1134    REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer
    11351135
    11361136    ! Parameters
    … …  
    12711271
    12721272    !--OB variables for mass fixer (hard coded for now)
    1273     LOGICAL, PARAMETER :: mass_fixer=.FALSE.
    12741273    REAL qql1(klon),qql2(klon),corrqql
    12751274
    … …  
    14011400       IF (read_climoz>=1 .AND. create_etat0_limit .AND. grid_type==unstructured) &
    14021401          CALL regr_horiz_time_climoz(read_climoz,ok_daily_climoz)
    1403 
    1404 #ifdef REPROBUS
    1405        CALL strataer_init
    1406        CALL strataer_emiss_init
    1407 #endif
    1408 
    1409 #ifdef CPP_StratAer
    1410        CALL strataer_init
    1411        CALL strataer_nuc_init
    1412        CALL strataer_emiss_init
    1413 #endif
    14141402
    14151403       print*, '================================================='
    … …  
    15271515       iflag_phytrac = 1 ! by default we do want to call phytrac
    15281516       CALL getin_p('iflag_phytrac',iflag_phytrac)
     1517
     1518       ok_water_mass_fixer=.FALSE.  ! OB: by default we do not apply the mass fixer
     1519       CALL getin_p('ok_water_mass_fixer',ok_water_mass_fixer)
    15291520#ifdef CPP_Dust
    15301521       IF (iflag_phytrac.EQ.0) THEN
    … …  
    15511542       WRITE(lunout,*) 'fl_cor_ebil=',        fl_cor_ebil
    15521543       WRITE(lunout,*) 'iflag_phytrac=',      iflag_phytrac
     1544       WRITE(lunout,*) 'ok_water_mass_fixer=',ok_water_mass_fixer
    15531545       WRITE(lunout,*) 'NVM=',                nvm_lmdz
    15541546
    … …  
    18021794      IF (.NOT. create_etat0_limit) CALL init_readaerosolstrato(flag_aerosol_strat)  !! initialise aero strato from file for XIOS interpolation (unstructured_grid)
    18031795
     1796      ! A.I : Initialisations pour le 1er passage a Cosp
    18041797      if (ok_cosp) then
     1798
    18051799#ifdef CPP_COSP
    1806         ! A.I : Initialisations pour le 1er passage a Cosp
    18071800        CALL ini_COSP(ref_liq_cosp0,ref_ice_cosp0,pctsrf_cosp0,zu10m_cosp0,zv10m_cosp0, &
    18081801               zxtsol_cosp0,zx_rh_cosp0,cldfra_cosp0,rnebcon_cosp0,flwc_cosp0, &
    … …  
    18241817#endif
    18251818
    1826 #ifdef CPP_COSP2
    1827         CALL ini_COSP(ref_liq_cosp0,ref_ice_cosp0,pctsrf_cosp0,zu10m_cosp0,zv10m_cosp0, &
     1819#ifdef CPP_COSPV2
     1820          CALL ini_COSP(ref_liq_cosp0,ref_ice_cosp0,pctsrf_cosp0,zu10m_cosp0,zv10m_cosp0, &
    18281821               zxtsol_cosp0,zx_rh_cosp0,cldfra_cosp0,rnebcon_cosp0,flwc_cosp0, &
    18291822               fiwc_cosp0,prfl_cosp0,psfl_cosp0,pmflxr_cosp0,pmflxs_cosp0, &
    18301823               mr_ozone_cosp0,cldtau_cosp0,cldemi_cosp0,JrNt_cosp0)
    1831      
    1832         CALL phys_cosp2(itap,phys_tstep,freq_cosp, &
    1833                ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
    1834                ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, &
    1835                klon,klev,longitude_deg,latitude_deg,presnivs,overlap, &
    1836                JrNt,ref_liq,ref_ice, &
    1837                pctsrf(:,is_ter)+pctsrf(:,is_lic), &
    1838                zu10m,zv10m,pphis, &
    1839                zphi,paprs(:,1:klev),pplay,zxtsol,t_seri, &
    1840                qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, &
    1841                prfl(:,1:klev),psfl(:,1:klev), &
    1842                pmflxr(:,1:klev),pmflxs(:,1:klev), &
    1843                mr_ozone,cldtau, cldemi)
    1844 #endif
    1845 
    1846 #ifdef CPP_COSPV2
     1824
    18471825          CALL lmdz_cosp_interface(itap,phys_tstep,freq_cosp, &
    18481826               ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
    18491827               ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, &
    18501828               klon,klev,longitude_deg,latitude_deg,presnivs,overlap, &
    1851                JrNt,ref_liq,ref_ice, &
    1852                pctsrf(:,is_ter)+pctsrf(:,is_lic), &
    1853                zu10m,zv10m,pphis, &
    1854                phicosp,paprs(:,1:klev),pplay,zxtsol,t_seri, &
    1855                qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, &
    1856                prfl(:,1:klev),psfl(:,1:klev), &
    1857                pmflxr(:,1:klev),pmflxs(:,1:klev), &
    1858                mr_ozone,cldtau, cldemi)
     1829               JrNt_cosp0,ref_liq_cosp0,ref_ice_cosp0, &
     1830               pctsrf_cosp0, &
     1831               zu10m_cosp0,zv10m_cosp0,pphis, &
     1832               pphi,paprs(:,1:klev),pplay,zxtsol_cosp0,t, &
     1833               qx(:,:,ivap),zx_rh_cosp0,cldfra_cosp0,rnebcon_cosp0,flwc_cosp0,fiwc_cosp0, &
     1834               prfl_cosp0(:,1:klev),psfl_cosp0(:,1:klev), &
     1835               pmflxr_cosp0(:,1:klev),pmflxs_cosp0(:,1:klev), &
     1836               mr_ozone_cosp0,cldtau_cosp0, cldemi_cosp0)
    18591837#endif
    1860       ENDIF
     1838      endif  ! ok_cosp
    18611839
    18621840       !
    … …  
    19081886       !
    19091887!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1888#ifdef REPROBUS
     1889       CALL strataer_init
     1890       CALL strataer_emiss_init
     1891#endif
     1892
     1893#ifdef CPP_StratAer
     1894       CALL strataer_init
     1895       CALL strataer_nuc_init
     1896       CALL strataer_emiss_init
     1897#endif
    19101898
    19111899#ifdef CPP_Dust
    … …  
    19481936       ELSE IF (klon_glo==1) THEN
    19491937          pbl_tke(:,:,is_ave) = 0.
     1938          pbl_eps(:,:,is_ave) = 0.
    19501939          DO nsrf=1,nbsrf
    19511940            DO k = 1,klev+1
    19521941                 pbl_tke(:,k,is_ave) = pbl_tke(:,k,is_ave) &
    19531942                     +pctsrf(:,nsrf)*pbl_tke(:,k,nsrf)
     1943                 pbl_eps(:,k,is_ave) = pbl_eps(:,k,is_ave) &
     1944                     +pctsrf(:,nsrf)*pbl_eps(:,k,nsrf)
    19541945            ENDDO
    19551946          ENDDO
    … …  
    19571948          pbl_tke(:,:,is_ave) = 0. !ym missing init : maybe must be initialized in the same way that for klon_glo==1 ??
    19581949!>jyg
     1950          pbl_eps(:,:,is_ave) = 0.
    19591951       ENDIF
    19601952       !IM begin
    … …  
    24702462    ENDDO
    24712463    !
    2472     !--OB mass fixer
    2473     IF (mass_fixer) THEN
     2464    !--OB water mass fixer
     2465    IF (ok_water_mass_fixer) THEN
    24742466    !--store initial water burden
    24752467    qql1(:)=0.0
    … …  
    30243016    ! Blowing snow sublimation and sedimentation
    30253017
    3026     d_t_bs(:,:)=0.
    3027     d_q_bs(:,:)=0.
    3028     d_qbs_bs(:,:)=0.
     3018    d_t_bsss(:,:)=0.
     3019    d_q_bsss(:,:)=0.
     3020    d_qbs_bsss(:,:)=0.
    30293021    bsfl(:,:)=0.
    30303022    bs_fall(:)=0.
    … …  
    30323024
    30333025     CALL call_blowing_snow_sublim_sedim(klon,klev,phys_tstep,t_seri,q_seri,qbs_seri,pplay,paprs, &
    3034                                         d_t_bs,d_q_bs,d_qbs_bs,bsfl,bs_fall)
     3026                                        d_t_bsss,d_q_bsss,d_qbs_bsss,bsfl,bs_fall)
    30353027
    30363028     CALL add_phys_tend &
    3037                (du0,dv0,d_t_bs,d_q_bs,dql0,dqi0,d_qbs_bs,paprs,&
    3038                'bs',abortphy,flag_inhib_tend,itap,0)
     3029               (du0,dv0,d_t_bsss,d_q_bsss,dql0,dqi0,d_qbs_bsss,paprs,&
     3030               'bsss',abortphy,flag_inhib_tend,itap,0)
    30393031
    30403032    ENDIF
    … …  
    30793071       ENDDO
    30803072    ENDDO
    3081     IF (check) THEN
    3082        za = qcheck(klon,klev,paprs,q_seri,ql_seri,cell_area)
    3083        WRITE(lunout,*) "avantcon=", za
    3084     ENDIF
    3085     zx_ajustq = .FALSE.
    3086     IF (iflag_con.EQ.2) zx_ajustq=.TRUE.
    3087     IF (zx_ajustq) THEN
    3088        DO i = 1, klon
    3089           z_avant(i) = 0.0
    3090        ENDDO
    3091        DO k = 1, klev
    3092           DO i = 1, klon
    3093              z_avant(i) = z_avant(i) + (q_seri(i,k)+ql_seri(i,k)) &
    3094                   *(paprs(i,k)-paprs(i,k+1))/RG
    3095           ENDDO
    3096        ENDDO
    3097     ENDIF
    30983073
    30993074    ! Calcule de vitesse verticale a partir de flux de masse verticale
    … …  
    34883463       CALL writefield_phy('q_seri',q_seri,nbp_lev)
    34893464    ENDIF
    3490 
    3491     IF (check) THEN
    3492        za = qcheck(klon,klev,paprs,q_seri,ql_seri,cell_area)
    3493        WRITE(lunout,*)"aprescon=", za
    3494        zx_t = 0.0
    3495        za = 0.0
    3496        DO i = 1, klon
    3497           za = za + cell_area(i)/REAL(klon)
    3498           zx_t = zx_t + (rain_con(i)+ &
    3499                snow_con(i))*cell_area(i)/REAL(klon)
    3500        ENDDO
    3501        zx_t = zx_t/za*phys_tstep
    3502        WRITE(lunout,*)"Precip=", zx_t
    3503     ENDIF
    3504     IF (zx_ajustq) THEN
    3505        DO i = 1, klon
    3506           z_apres(i) = 0.0
    3507        ENDDO
    3508        DO k = 1, klev
    3509           DO i = 1, klon
    3510              z_apres(i) = z_apres(i) + (q_seri(i,k)+ql_seri(i,k)) &
    3511                   *(paprs(i,k)-paprs(i,k+1))/RG
    3512           ENDDO
    3513        ENDDO
    3514        DO i = 1, klon
    3515           z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*phys_tstep) &
    3516                /z_apres(i)
    3517        ENDDO
    3518        DO k = 1, klev
    3519           DO i = 1, klon
    3520              IF (z_factor(i).GT.(1.0+1.0E-08) .OR. &
    3521                   z_factor(i).LT.(1.0-1.0E-08)) THEN
    3522                 q_seri(i,k) = q_seri(i,k) * z_factor(i)
    3523              ENDIF
    3524           ENDDO
    3525        ENDDO
    3526     ENDIF
    3527     zx_ajustq=.FALSE.
    35283465
    35293466    !
    … …  
    39213858
    39223859    CALL lscp(klon,klev,phys_tstep,missing_val,paprs,pplay, &
    3923          t_seri, q_seri,ptconv,ratqs, &
     3860         t_seri, q_seri,qs_ancien,ptconv,ratqs, &
    39243861         d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, &
    3925          pfraclr,pfracld, &
     3862         pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb, &
    39263863         radocond, picefra, rain_lsc, snow_lsc, &
    39273864         frac_impa, frac_nucl, beta_prec_fisrt, &
    39283865         prfl, psfl, rhcl,  &
    39293866         zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cld_th, &
    3930          iflag_ice_thermo, distcltop, temp_cltop, cell_area, &
    3931          cf_seri, rvc_seri, u_seri, v_seri, pbl_eps(:,:,is_ave), &
     3867         iflag_ice_thermo, distcltop, temp_cltop,   &
     3868         pbl_tke(:,:,is_ave), pbl_eps(:,:,is_ave), &
     3869         cell_area, &
     3870         cf_seri, rvc_seri, u_seri, v_seri, &
    39323871         qsub, qissr, qcld, subfra, issrfra, gamma_cond, ratio_qi_qtot, &
    39333872         dcf_sub, dcf_con, dcf_mix, dqi_adj, dqi_sub, dqi_con, dqi_mix, &
    … …  
    40213960       ENDIF
    40223961
    4023     ENDIF
    4024 
    4025     IF (check) THEN
    4026        za = qcheck(klon,klev,paprs,q_seri,ql_seri,cell_area)
    4027        WRITE(lunout,*)"apresilp=", za
    4028        zx_t = 0.0
    4029        za = 0.0
    4030        DO i = 1, klon
    4031           za = za + cell_area(i)/REAL(klon)
    4032           zx_t = zx_t + (rain_lsc(i) &
    4033                + snow_lsc(i))*cell_area(i)/REAL(klon)
    4034        ENDDO
    4035        zx_t = zx_t/za*phys_tstep
    4036        WRITE(lunout,*)"Precip=", zx_t
    40373962    ENDIF
    40383963
    … …  
    44054330                  flag_aerosol, flag_bc_internal_mixture, itap, jD_cur-jD_ref, &
    44064331                  pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
    4407                   tr_seri, mass_solu_aero, mass_solu_aero_pi) 
     4332                  tr_seri, mass_solu_aero, mass_solu_aero_pi, m_allaer) 
    44084333#else
    44094334                abort_message='You should compile with -rad ecrad if running with iflag_rrtm=2'
    … …  
    46514576               ! Rajoute par OB pour RRTM
    46524577               tau_aero_lw_rrtm, &
    4653                cldtaupirad, &
     4578               cldtaupirad, m_allaer, &
    46544579!              zqsat, flwcrad, fiwcrad, &
    46554580               zqsat, flwc, fiwc, &
    … …  
    47294654                                ! Rajoute par OB pour RRTM
    47304655                     tau_aero_lw_rrtm, &
    4731                      cldtaupi, &
     4656                     cldtaupi, m_allaer, &
    47324657!                    zqsat, flwcrad, fiwcrad, &
    47334658                     zqsat, flwc, fiwc, &
    … …  
    47754700                     tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, &
    47764701                     tau_aero_lw_rrtm, &
    4777                      cldtaupi, &
     4702                     cldtaupi, m_allaer, &
    47784703                     zqsat, flwc, fiwc, &
    47794704                     ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
    … …  
    55085433    !--currently flag is turned off
    55095434    !==================================================================
    5510     IF (mass_fixer) THEN
     5435    IF (ok_water_mass_fixer) THEN
    55115436    qql2(:)=0.0
    55125437    DO k = 1, klev
Note: See TracChangeset for help on using the changeset viewer.