Ignore:
Timestamp:
Jun 11, 2014, 3:46:46 PM (10 years ago)
Author:
Laurent Fairhead
Message:

Merged trunk changes r1997:2055 into testing branch

Location:
LMDZ5/branches/testing
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/testing

  • LMDZ5/branches/testing/libf/phylmd/physiq.F90

    r1999 r2056  
    88     flxmass_w, &
    99     d_u, d_v, d_t, d_qx, d_ps &
    10      , dudyn &
    11      , PVteta)
     10     , dudyn)
    1211
    1312  USE ioipsl, only: histbeg, histvert, histdef, histend, histsync, &
    … …  
    5251  USE indice_sol_mod
    5352  USE phytrac_mod, ONLY : phytrac
     53
     54#ifdef CPP_RRTM
     55  USE YOERAD   , ONLY : NRADLP
     56#endif
    5457
    5558  !IM stations CFMIP
    … …  
    100103  !! d_qx----output-R-tendance physique de "qx" (kg/kg/s)
    101104  !! d_ps----output-R-tendance physique de la pression au sol
    102   !!IM
    103   !! PVteta--output-R-vorticite potentielle a des thetas constantes
    104105  !!======================================================================
    105106  include "dimensions.h"
    … …  
    235236  ! Variables pour le transport convectif
    236237  real da(klon,klev),phi(klon,klev,klev),mp(klon,klev)
     238  real wght_cvfd(klon,klev)
    237239  ! Variables pour le lessivage convectif
    238240  ! RomP >>>
    … …  
    245247  !IM definition dynamique o_trac dans phys_output_open
    246248  !      type(ctrl_out) :: o_trac(nqtot)
    247   !
    248   !IM Amip2 PV a theta constante
    249   !
    250   INTEGER nbteta
    251   PARAMETER(nbteta=3)
    252   CHARACTER*3 ctetaSTD(nbteta)
    253   DATA ctetaSTD/'350','380','405'/
    254   SAVE ctetaSTD
    255   !$OMP THREADPRIVATE(ctetaSTD)
    256   REAL rtetaSTD(nbteta)
    257   DATA rtetaSTD/350., 380., 405./
    258   SAVE rtetaSTD
    259   !$OMP THREADPRIVATE(rtetaSTD)     
    260   !
    261   REAL PVteta(klon,nbteta)
    262   !
    263   !MI Amip2 PV a theta constante
    264 
    265   !ym      INTEGER klevp1, klevm1
    266   !ym      PARAMETER(klevp1=klev+1,klevm1=klev-1)
    267   !ym      include "raddim.h"
    268   !
    269   !
    270   !IM Amip2
     249
    271250  ! variables a une pression donnee
    272251  !
    … …  
    510489  EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)
    511490  !AA
    512   EXTERNAL fisrtilp_tr ! schema de condensation a grande echelle (pluie)
     491! JBM (3/14) fisrtilp_tr not loaded
     492! EXTERNAL fisrtilp_tr ! schema de condensation a grande echelle (pluie)
    513493  !                          ! stockage des coefficients necessaires au
    514494  !                          ! lessivage OFF-LINE et ON-LINE
    … …  
    12501230     call phys_output_open(rlon,rlat,nCFMIP,tabijGCM, &
    12511231          iGCM,jGCM,lonGCM,latGCM, &
    1252           jjmp1,nlevSTD,clevSTD,rlevSTD, &
    1253           nbteta, ctetaSTD, dtime,ok_veget, &
     1232          jjmp1,nlevSTD,clevSTD,rlevSTD, dtime,ok_veget, &
    12541233          type_ocean,iflag_pbl,ok_mensuel,ok_journe, &
    12551234          ok_hf,ok_instan,ok_LES,ok_ade,ok_aie,  &
    … …  
    17851764     IF (klon_glo==1) THEN
    17861765        CALL add_pbl_tend &
    1787           (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,'vdf')
     1766          (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,paprs,'vdf')
    17881767     ELSE
    17891768        CALL add_phys_tend &
    1790           (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,'vdf')
     1769          (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,paprs,'vdf')
    17911770     ENDIF
    17921771     !--------------------------------------------------------------------
    … …  
    20582037             ftd,fqd,lalim_conv,wght_th, &
    20592038             ev, ep,epmlmMm,eplaMm, &
    2060              wdtrainA,wdtrainM)
     2039             wdtrainA,wdtrainM,wght_cvfd)
    20612040        ! RomP <<<
    20622041
    … …  
    21552134  !-----------------------------------------------------------------------------------------
    21562135  ! ajout des tendances de la diffusion turbulente
    2157   CALL add_phys_tend(d_u_con,d_v_con,d_t_con,d_q_con,dql0,'con')
     2136  CALL add_phys_tend(d_u_con,d_v_con,d_t_con,d_q_con,dql0,paprs,'con')
    21582137  !-----------------------------------------------------------------------------------------
    21592138
    … …  
    22722251     d_t_wake(:,:)=dt_wake(:,:)*dtime
    22732252     d_q_wake(:,:)=dq_wake(:,:)*dtime
    2274      CALL add_phys_tend(du0,dv0,d_t_wake,d_q_wake,dql0,'wake')
     2253     CALL add_phys_tend(du0,dv0,d_t_wake,d_q_wake,dql0,paprs,'wake')
    22752254     !-----------------------------------------------------------------------------------------
    22762255
    … …  
    23722351           ENDIF
    23732352
     2353
    23742354           !----Initialisations
    23752355           do i=1,klon
    … …  
    23892369                   s_trig,s2,n2
    23902370           ENDIF
     2371 
     2372!Option pour re-activer l'ancien calcul de Ale_bl (iflag_trig_bl=2)
     2373           IF (iflag_trig_bl.eq.1) then
    23912374
    23922375           !----Tirage al\'eatoire et calcul de ale_bl_trig
    … …  
    24072390              endif
    24082391           enddo
     2392
     2393           ELSE IF (iflag_trig_bl.eq.2) then
     2394
     2395           do i=1,klon
     2396              if ( (Ale_bl(i) .gt. abs(cin(i))+1.e-10) )  then
     2397                 proba_notrig(i)=(1.-exp(-s_trig/s2(i)))** &
     2398                      (n2(i)*dtime/tau_trig(i))
     2399                 !        print *, 'proba_notrig(i) ',proba_notrig(i)
     2400                 if (random_notrig(i) .ge. proba_notrig(i)) then
     2401                    ale_bl_trig(i)=Ale_bl(i)
     2402                 else
     2403                    ale_bl_trig(i)=0.
     2404                 endif
     2405              else
     2406                 proba_notrig(i)=1.
     2407                 random_notrig(i)=0.
     2408                 ale_bl_trig(i)=0.
     2409              endif
     2410           enddo
     2411
     2412           ENDIF
     2413
    24092414           !
    24102415           IF (prt_level .GE. 10) THEN
    … …  
    24162421
    24172422        !-----------Statistical closure-----------
    2418         if (iflag_clos_bl.ge.1) then
    2419 
     2423        if (iflag_clos_bl.eq.1) then
     2424
     2425           do i=1,klon
     2426!CR: alp probabiliste
     2427               if (ale_bl_trig(i).gt.0.) then
     2428                  alp_bl(i)=alp_bl(i)/(1.-min(proba_notrig(i),0.999))
     2429               endif
     2430           enddo       
     2431 
     2432        else if (iflag_clos_bl.eq.2) then
     2433
     2434!CR: alp calculee dans thermcell_main
    24202435           do i=1,klon
    24212436              alp_bl(i)=alp_bl_stat(i)
    … …  
    24542469
    24552470        do i=1,klon
    2456            zmax_th(i)=pphi(i,lmax_th(i))/rg
     2471!           zmax_th(i)=pphi(i,lmax_th(i))/rg
     2472!CR:04/05/12:correction calcul zmax
     2473         zmax_th(i)=zmax0(i)
    24572474        enddo
    24582475
    … …  
    24942511        !-----------------------------------------------------------------------------------------
    24952512        ! ajout des tendances de l'ajustement sec ou des thermiques
    2496         CALL add_phys_tend(du0,dv0,d_t_ajsb,d_q_ajsb,dql0,'ajsb')
     2513        CALL add_phys_tend(du0,dv0,d_t_ajsb,d_q_ajsb,dql0,paprs,'ajsb')
    24972514        d_t_ajs(:,:)=d_t_ajs(:,:)+d_t_ajsb(:,:)
    24982515        d_q_ajs(:,:)=d_q_ajs(:,:)+d_q_ajsb(:,:)
    … …  
    25522569  !-----------------------------------------------------------------------------------------
    25532570  ! ajout des tendances de la diffusion turbulente
    2554   CALL add_phys_tend(du0,dv0,d_t_lsc,d_q_lsc,d_ql_lsc,'lsc')
     2571  CALL add_phys_tend(du0,dv0,d_t_lsc,d_q_lsc,d_ql_lsc,paprs,'lsc')
    25552572  !-----------------------------------------------------------------------------------------
    25562573  DO k = 1, klev
    … …  
    26592676     !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)
    26602677     IF (flag_aerosol .gt. 0) THEN
    2661         IF (.NOT. aerosol_couple) &
     2678        IF (.NOT. aerosol_couple) THEN
     2679           IF (iflag_rrtm .EQ. 0) THEN !--old radiation
     2680!
    26622681             CALL readaerosol_optic( &
    26632682             debut, new_aod, flag_aerosol, itap, jD_cur-jD_ref, &
    … …  
    26662685             tau_aero, piz_aero, cg_aero,  &
    26672686             tausum_aero, tau3d_aero)
     2687!
     2688           ELSE                       ! RRTM radiation
     2689!
     2690#ifdef CPP_RRTM
     2691             CALL readaerosol_optic_rrtm( &
     2692             debut, new_aod, flag_aerosol, itap, jD_cur-jD_ref, &
     2693             pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
     2694             mass_solu_aero, mass_solu_aero_pi,  &
     2695             tau_aero_rrtm, piz_aero_rrtm, cg_aero_rrtm,  &
     2696             tausum_aero, tau3d_aero)
     2697#else
     2698
     2699            abort_message='You should compile with -rrtm if running with iflag_rrtm=1'
     2700            call abort_gcm(modname,abort_message,1)
     2701#endif
     2702!
     2703           ENDIF
     2704        ENDIF
    26682705     ELSE
    26692706        tausum_aero(:,:,:) = 0.
    2670         tau_aero(:,:,:,:) = 0.
    2671         piz_aero(:,:,:,:) = 0.
    2672         cg_aero(:,:,:,:)  = 0.
     2707        IF (iflag_rrtm .EQ. 0) THEN !--old radiation
     2708          tau_aero(:,:,:,:) = 0.
     2709          piz_aero(:,:,:,:) = 0.
     2710          cg_aero(:,:,:,:)  = 0.
     2711        ELSE
     2712          tau_aero_rrtm(:,:,:,:)=0.0
     2713          piz_aero_rrtm(:,:,:,:)=0.0
     2714          cg_aero_rrtm(:,:,:,:)=0.0
     2715        ENDIF
    26732716     ENDIF
    26742717     !
    … …  
    26772720     IF (flag_aerosol_strat) THEN
    26782721        PRINT *,'appel a readaerosolstrat', mth_cur
    2679         CALL readaerosolstrato(debut)
     2722        IF (iflag_rrtm.EQ.0) THEN
     2723         CALL readaerosolstrato(debut)
     2724        ELSE
     2725#ifdef CPP_RRTM
     2726         CALL readaerosolstrato_rrtm(debut)
     2727#else
     2728
     2729         abort_message='You should compile with -rrtm if running with iflag_rrtm=1'
     2730         call abort_gcm(modname,abort_message,1)
     2731#endif
     2732        ENDIF
    26802733     ENDIF
    26812734     !--fin STRAT AEROSOL
    … …  
    28962949
    28972950  if (ok_newmicro) then
     2951     IF (iflag_rrtm.NE.0) THEN
     2952#ifdef CPP_RRTM
     2953       IF (ok_cdnc.AND.NRADLP.NE.3) THEN
     2954         abort_message='RRTM choix incoherent NRADLP doit etre egal a 3 pour ok_cdnc'
     2955         call abort_gcm(modname,abort_message,1)
     2956       endif
     2957#else
     2958
     2959       abort_message='You should compile with -rrtm if running with iflag_rrtm=1'
     2960       call abort_gcm(modname,abort_message,1)
     2961#endif
     2962     ENDIF
    28982963     CALL newmicro (ok_cdnc, bl95_b0, bl95_b1, &
    28992964          paprs, pplay, t_seri, cldliq, cldfra, &
    … …  
    30373102             flag_aerosol_strat, &
    30383103             tau_aero, piz_aero, cg_aero, &
     3104             tau_aero_rrtm, piz_aero_rrtm, cg_aero_rrtm,&     ! Rajoute par OB pour RRTM
    30393105             cldtaupirad,new_aod, &
    30403106             zqsat, flwc, fiwc, &
    … …  
    30833149                   flag_aerosol_strat, &
    30843150                   tau_aero, piz_aero, cg_aero, &
     3151                   tau_aero_rrtm, piz_aero_rrtm, cg_aero_rrtm,&     ! Rajoute par OB pour RRTM
    30853152                   cldtaupi,new_aod, &
    30863153                   zqsat, flwc, fiwc, &
    … …  
    32203287     !-----------------------------------------------------------------------------------------
    32213288     ! ajout des tendances de la trainee de l'orographie
    3222      CALL add_phys_tend(d_u_oro,d_v_oro,d_t_oro,dq0,dql0,'oro')
     3289     CALL add_phys_tend(d_u_oro,d_v_oro,d_t_oro,dq0,dql0,paprs,'oro')
    32233290     !-----------------------------------------------------------------------------------------
    32243291     !
    … …  
    32663333     !-----------------------------------------------------------------------------------------
    32673334     ! ajout des tendances de la portance de l'orographie
    3268      CALL add_phys_tend(d_u_lif,d_v_lif,d_t_lif,dq0,dql0,'lif')
     3335     CALL add_phys_tend(d_u_lif,d_v_lif,d_t_lif,dq0,dql0,paprs,'lif')
    32693336     !-----------------------------------------------------------------------------------------
    32703337     !
    … …  
    32803347     !
    32813348     !  ajout des tendances
    3282      CALL add_phys_tend(d_u_hin,d_v_hin,d_t_hin,dq0,dql0,'hin')
     3349     CALL add_phys_tend(d_u_hin,d_v_hin,d_t_hin,dq0,dql0,paprs,'hin')
    32833350
    32843351  ENDIF
    … …  
    32883355          rain_fall + snow_fall, zustr_gwd_rando, zvstr_gwd_rando, &
    32893356          du_gwd_rando, dv_gwd_rando)
    3290      CALL add_phys_tend(du_gwd_rando, dv_gwd_rando, dt0, dq0, dql0, &
     3357     CALL add_phys_tend(du_gwd_rando, dv_gwd_rando, dt0, dq0, dql0,paprs, &
    32913358          'flott_gwd_rando')
    32923359  end if
    … …  
    34083475       pmflxr,   pmflxs,    prfl,     psfl, &
    34093476       da,       phi,       mp,       upwd, &
    3410        phi2,     d1a,       dam,      sij, &        !<<RomP
     3477       phi2,     d1a,       dam,      sij, wght_cvfd, &        !<<RomP+RL
    34113478       wdtrainA, wdtrainM,  sigd,     clw,elij, &   !<<RomP
    34123479       ev,       ep,        epmlmMm,  eplaMm, &     !<<RomP
    … …  
    37083775       ptconv, read_climoz, clevSTD,                   &
    37093776       ptconvth, d_t, qx, d_qx, zmasse,                &
    3710        flag_aerosol_strat)
     3777       flag_aerosol, flag_aerosol_strat, ok_cdnc)
    37113778
    37123779
Note: See TracChangeset for help on using the changeset viewer.