Changeset 2897


Ignore:
Timestamp:
May 31, 2017, 12:34:09 AM (8 years ago)
Author:
fhourdin
Message:

Introduction d'une possible prise en compte de génération de TKE
par les ondes de relief.
Etienne Vignon et FH

Location:
LMDZ5/trunk/libf/phylmd
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • LMDZ5/trunk/libf/phylmd/orografi_strato.F90

    r2357 r2897  
    1 SUBROUTINE drag_noro_strato(nlon, nlev, dtime, paprs, pplay, pmea, pstd, &
     1SUBROUTINE drag_noro_strato(partdrag, nlon, nlev, dtime, paprs, pplay, pmea, pstd, &
    22    psig, pgam, pthe, ppic, pval, kgwd, kdx, ktest, t, u, v, pulow, pvlow, &
    33    pustr, pvstr, d_t, d_u, d_v)
     
    1515  ! Explicit Arguments:
    1616  ! ==================
     17  ! partdrag-input-I-control which part of the drag we consider (total part or GW part)
    1718  ! nlon----input-I-Total number of horizontal points that get into physics
    1819  ! nlev----input-I-Number of vertical levels
     
    6667  ! ARGUMENTS
    6768
    68   INTEGER nlon, nlev
     69  INTEGER partdrag,nlon, nlev
    6970  REAL dtime
    7071  REAL paprs(nlon, nlev+1)
     
    134135  ! CALL SSO DRAG ROUTINES
    135136
    136   CALL orodrag_strato(klon, klev, kgwd, kdx, ktest, dtime, papmh, papmf, &
     137  CALL orodrag_strato(partdrag,klon, klev, kgwd, kdx, ktest, dtime, papmh, papmf, &
    137138    zgeom, pt, pu, pv, pmea, pstd, psig, pgam, pthe, ppic, pval, pulow, &
    138139    pvlow, pdudt, pdvdt, pdtdt)
     
    153154END SUBROUTINE drag_noro_strato
    154155
    155 SUBROUTINE orodrag_strato(nlon, nlev, kgwd, kdx, ktest, ptsphy, paphm1, &
     156SUBROUTINE orodrag_strato(partdrag,nlon, nlev, kgwd, kdx, ktest, ptsphy, paphm1, &
    156157    papm1, pgeom1, ptm1, pum1, pvm1, pmea, pstd, psig, pgam, pthe, ppic, pval &
    157158  ! outputs
     
    182183  ! --------------------
    183184  ! ==== inputs ===
     185  ! partdrag-input-I-control which part of the drag we consider (total part or GW part)
    184186  ! nlon----input-I-Total number of horizontal points that get into physics
    185187  ! nlev----input-I-Number of vertical levels
     
    201203  ! pval----input-R-SSO Valleys elevation (m)
    202204
    203   INTEGER nlon, nlev, kgwd
     205  INTEGER  nlon, nlev, kgwd
    204206  REAL ptsphy
    205207
     
    239241  include "YOMCST.h"
    240242  include "YOEGWD.h"
     243
    241244  ! -----------------------------------------------------------------------
    242245
     
    244247  ! ---------
    245248
    246 
     249  INTEGER partdrag
    247250  REAL pte(nlon, nlev), pvol(nlon, nlev), pvom(nlon, nlev), pulow(nlon), &
    248251    pvlow(nlon)
     
    269272
    270273  INTEGER jl, jk, ji
    271   REAL ztmst, zdelp, ztemp, zforc, ztend, rover
     274  REAL ztmst, zdelp, ztemp, zforc, ztend, rover, facpart
    272275  REAL zb, zc, zconb, zabsv, zzd1, ratio, zbet, zust, zvst, zdis
    273276
     
    393396        ! -----------------
    394397
     398        IF (partdrag .GE. 2) THEN
     399        facpart=0.
     400        ELSE
     401        facpart=gkwake
     402        ENDIF
     403
     404
    395405        IF (jk>ikenvh(ji)) THEN
    396406          zb = 1.0 - 0.18*pgam(ji) - 0.04*pgam(ji)**2
    397407          zc = 0.48*pgam(ji) + 0.3*pgam(ji)**2
    398           zconb = 2.*ztmst*gkwake*psig(ji)/(4.*pstd(ji))
     408          zconb = 2.*ztmst*facpart*psig(ji)/(4.*pstd(ji))
    399409          zabsv = sqrt(pum1(ji,jk)**2+pvm1(ji,jk)**2)/2.
    400410          zzd1 = zb*cos(zpsi(ji,jk))**2 + zc*sin(zpsi(ji,jk))**2
     
    18941904  RETURN
    18951905END SUBROUTINE sugwd_strato
    1896 
  • LMDZ5/trunk/libf/phylmd/phys_local_var_mod.F90

    r2877 r2897  
    8080      REAL, SAVE, ALLOCATABLE :: d_u_oro(:,:), d_v_oro(:,:)
    8181      !$OMP THREADPRIVATE(d_u_oro, d_v_oro)
     82      REAL, SAVE, ALLOCATABLE :: d_t_oro_gw(:,:)
     83      !$OMP THREADPRIVATE(d_t_oro)
     84      REAL, SAVE, ALLOCATABLE :: d_u_oro_gw(:,:), d_v_oro_gw(:,:)
     85      !$OMP THREADPRIVATE(d_u_oro_gw, d_v_oro_gw)
    8286      REAL, SAVE, ALLOCATABLE :: d_t_lif(:,:)
    8387      !$OMP THREADPRIVATE(d_t_lif)
     
    244248!$OMP THREADPRIVATE(toplwad0_aerop, sollwad0_aerop)
    245249
    246 !Ajout de celles nécessaires au phys_output_write_mod
     250!Ajout de celles n??cessaires au phys_output_write_mod
    247251      REAL, SAVE, ALLOCATABLE :: tal1(:), pal1(:), pab1(:), pab2(:)
    248252!$OMP THREADPRIVATE(tal1, pal1, pab1, pab2)
     
    327331!$OMP THREADPRIVATE(zxfluxlat_x, zxfluxlat_w)
    328332!jyg<
    329 !!! Entrées supplémentaires couche-limite
     333!!! Entr\E9es suppl\E9mentaires couche-limite
    330334!!      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: t_x, t_w
    331335!!!$OMP THREADPRIVATE(t_x, t_w)
     
    338342      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: dqvdf_x, dqvdf_w
    339343!$OMP THREADPRIVATE(dqvdf_x, dqvdf_w)
    340 ! Variables supplémentaires dans physiq.F relative au splitting de la surface
     344! Variables suppl\E9mentaires dans physiq.F relative au splitting de la surface
    341345      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: pbl_tke_input
    342346!$OMP THREADPRIVATE(pbl_tke_input)
     
    545549      ALLOCATE(d_u_oli(klon,klev),d_v_oli(klon,klev))
    546550      ALLOCATE(d_u_oro(klon,klev),d_v_oro(klon,klev))
     551      ALLOCATE(d_u_oro_gw(klon,klev),d_v_oro_gw(klon,klev))
     552      ALLOCATE(d_t_oro_gw(klon,klev))
    547553      ALLOCATE(d_t_lif(klon,klev),d_t_ec(klon,klev))
    548554      ALLOCATE(d_u_lif(klon,klev),d_v_lif(klon,klev))
     
    622628      ALLOCATE(toplwad0_aerop(klon), sollwad0_aerop(klon))
    623629
    624 ! FH Ajout de celles nécessaires au phys_output_write_mod
     630! FH Ajout de celles n??cessaires au phys_output_write_mod
    625631
    626632      ALLOCATE(tal1(klon), pal1(klon), pab1(klon), pab2(klon))
     
    815821      DEALLOCATE(d_u_oli,d_v_oli)
    816822      DEALLOCATE(d_u_oro,d_v_oro)
     823      DEALLOCATE(d_t_oro_gw)
     824      DEALLOCATE(d_u_oro_gw,d_v_oro_gw)
    817825      DEALLOCATE(d_t_lif,d_t_ec)
    818826      DEALLOCATE(d_u_lif,d_v_lif)
     
    887895      DEALLOCATE(toplwad0_aerop, sollwad0_aerop)
    888896
    889 ! FH Ajout de celles nécessaires au phys_output_write_mod
     897! FH Ajout de celles n??cessaires au phys_output_write_mod
    890898      DEALLOCATE(tal1, pal1, pab1, pab2)
    891899      DEALLOCATE(ptstar, pt0, slp)
  • LMDZ5/trunk/libf/phylmd/physiq_mod.F90

    r2882 r2897  
    6969       d_t_oli,d_u_oli,d_v_oli, &
    7070       d_t_oro,d_u_oro,d_v_oro, &
     71       d_t_oro_gw,d_u_oro_gw,d_v_oro_gw, &
    7172       d_t_lif,d_u_lif,d_v_lif, &
    7273       d_t_ec, &
     
    434435    REAL d_qx(klon,klev,nqtot)
    435436    REAL d_ps(klon)
     437  ! variables pour tend_to_tke
     438    REAL duadd(klon,klev)
     439    REAL dvadd(klon,klev)
     440    REAL dtadd(klon,klev)
     441
    436442    ! Variables pour le transport convectif
    437443    real da(klon,klev),phi(klon,klev,klev),mp(klon,klev)
     
    606612    REAL, SAVE :: alp_offset
    607613    !$OMP THREADPRIVATE(alp_offset)
    608 
     614 
    609615    !
    610616    !RR:fin declarations poches froides
     
    640646    real therm_tke_max(klon,klev)   ! Profil de TKE dans les thermiques
    641647    real env_tke_max(klon,klev)     ! Profil de TKE dans l'environnement
     648
     649    !-------Activer les tendances de TKE due a l'orograp??ie---------
     650     INTEGER, SAVE :: addtkeoro
     651    !$OMP THREADPRIVATE(addtkeoro)
     652     REAL, SAVE :: alphatkeoro
     653    !$OMP THREADPRIVATE(alphatkeoro)
     654     LOGICAL, SAVE :: smallscales_tkeoro
     655    !$OMP THREADPRIVATE(smallscales_tkeoro)
     656
    642657
    643658
     
    780795    real zqsat(klon,klev)
    781796    !
    782     INTEGER i, k, iq, nsrf, l
     797    INTEGER i, k, iq, j, nsrf, ll, l
    783798    !
    784799    REAL t_coup
     
    22442259!>jyg
    22452260       ENDIF
     2261
     2262
     2263
    22462264
    22472265
     
    38703888       IF (ok_strato) THEN
    38713889
    3872           CALL drag_noro_strato(klon,klev,dtime,paprs,pplay, &
     3890          CALL drag_noro_strato(0,klon,klev,dtime,paprs,pplay, &
    38733891               zmea,zstd, zsig, zgam, zthe,zpic,zval, &
    38743892               igwd,idx,itest, &
     
    40454063    !
    40464064    !
     4065
     4066!===============================================================
     4067!            Additional tendency of TKE due to orography
     4068!===============================================================
     4069!
     4070! Inititialization
     4071!------------------
     4072
     4073   
     4074
     4075       addtkeoro=0   
     4076       CALL getin_p('addtkeoro',addtkeoro)
     4077     
     4078       IF (prt_level.ge.5) &
     4079            print*,'addtkeoro', addtkeoro
     4080           
     4081       alphatkeoro=1.   
     4082       CALL getin_p('alphatkeoro',alphatkeoro)
     4083       alphatkeoro=min(max(0.,alphatkeoro),1.)
     4084
     4085       smallscales_tkeoro=.false.   
     4086       CALL getin_p('smallscales_tkeoro',smallscales_tkeoro)
     4087
     4088
     4089        dtadd(:,:)=0.
     4090        duadd(:,:)=0.
     4091        dvadd(:,:)=0.
     4092
     4093
     4094
     4095! Choices for addtkeoro:
     4096!      ** 0 no TKE tendency from orography   
     4097!      ** 1 we include a fraction alphatkeoro of the whole tendency duoro
     4098!      ** 2 we include a fraction alphatkeoro of the gravity wave part of duoro
     4099!
     4100
     4101       IF (addtkeoro .GT. 0 .AND. ok_orodr ) THEN
     4102!      -------------------------------------------
     4103
     4104
     4105       !  selection des points pour lesquels le schema est actif:
     4106
     4107
     4108
     4109  IF (addtkeoro .EQ. 1 ) THEN
     4110
     4111            duadd(:,:)=alphatkeoro*d_u_oro(:,:)
     4112            dvadd(:,:)=alphatkeoro*d_v_oro(:,:)
     4113
     4114  ELSE IF (addtkeoro .EQ. 2) THEN
     4115
     4116
     4117
     4118       IF (smallscales_tkeoro) THEN
     4119       igwd=0
     4120       DO i=1,klon
     4121          itest(i)=0
     4122! Etienne: ici je prends en compte plus de relief que la routine drag_noro_strato
     4123! car on peut s'attendre a ce que les petites echelles produisent aussi de la TKE
     4124! Mais attention, cela ne va pas dans le sens de la conservation de l'energie!
     4125          IF (zstd(i).GT.1.0) THEN
     4126             itest(i)=1
     4127             igwd=igwd+1
     4128             idx(igwd)=i
     4129          ENDIF
     4130       ENDDO
     4131
     4132     ELSE
     4133
     4134       igwd=0
     4135       DO i=1,klon
     4136          itest(i)=0
     4137        IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN
     4138             itest(i)=1
     4139             igwd=igwd+1
     4140             idx(igwd)=i
     4141          ENDIF
     4142       ENDDO
     4143
     4144       END IF
     4145
     4146
     4147
     4148
     4149       CALL drag_noro_strato(addtkeoro,klon,klev,dtime,paprs,pplay, &
     4150               zmea,zstd, zsig, zgam, zthe,zpic,zval, &
     4151               igwd,idx,itest, &
     4152               t_seri, u_seri, v_seri, &
     4153               zulow, zvlow, zustrdr, zvstrdr, &
     4154               d_t_oro_gw, d_u_oro_gw, d_v_oro_gw)
     4155
     4156            zustrdr(:)=0.
     4157            zvstrdr(:)=0.
     4158            zulow(:)=0.
     4159            zvlow(:)=0.
     4160
     4161            duadd(:,:)=alphatkeoro*d_u_oro_gw(:,:)
     4162            dvadd(:,:)=alphatkeoro*d_v_oro_gw(:,:)
     4163 END IF
     4164   
     4165
     4166
     4167   ! TKE update from subgrid temperature and wind tendencies
     4168   !----------------------------------------------------------
     4169    forall (k=1: nbp_lev) exner(:, k) = (pplay(:, k)/paprs(:,1))**RKAPPA
     4170
     4171
     4172    CALL tend_to_tke(pdtphys,paprs,exner,t_seri,u_seri,v_seri,dtadd,duadd,dvadd,pbl_tke)
     4173
     4174
     4175
     4176       ENDIF
     4177!      -----
     4178!===============================================================
     4179
     4180
     4181
    40474182    !====================================================================
    40484183    ! Interface Simulateur COSP (Calipso, ISCCP, MISR, ..)
  • LMDZ5/trunk/libf/phylmd/tend_to_tke.F90

    r2728 r2897  
    3232!**************************************************************************************
    3333
    34  SUBROUTINE tend_to_tke(dt,plev,exner,temp,windu,windv,dt_a,du_a,dv_a,tke,dtke)
     34 SUBROUTINE tend_to_tke(dt,plev,exner,temp,windu,windv,dt_a,du_a,dv_a,tke)
    3535
    3636 USE dimphy, ONLY: klon, klev
     
    5757!---------------
    5858  REAL tke(klon,klev,nbsrf)       ! Turbulent Kinetic energy [m2/s2], grid-cell average or for a subsurface
    59   REAL dtke(klon,klev)
    6059
    6160
     
    127126 ENDDO
    128127
    129  dtke(:,:)=tendt(:,:)+tendu(:,:)+tendv(:,:)
     128! dtke_t(:,:)=tendt(:,:)
     129! dtke_u(:,:)=tendu(:,:)
     130! dtke_v(:,:)=tendv(:,:)
    130131
    131132
    132   IF (klon==1) THEN
    133   CALL iophys_ecrit('u',klev,'u','',windu)
    134   CALL iophys_ecrit('v',klev,'v','',windu)
    135   CALL iophys_ecrit('t',klev,'t','',temp)
    136   CALL iophys_ecrit('tke1',klev,'tke1','',tke(:,1:klev,1))
    137   CALL iophys_ecrit('tke2',klev,'tke2','',tke(:,1:klev,2))
    138   CALL iophys_ecrit('tke3',klev,'tke3','',tke(:,1:klev,3))
    139   CALL iophys_ecrit('tke4',klev,'tke4','',tke(:,1:klev,4))
    140   CALL iophys_ecrit('theta',klev,'theta','',temp/exner)
    141   CALL iophys_ecrit('Duv',klev,'Duv','',tendu(:,1:klev)+tendv(:,1:klev))
    142   CALL iophys_ecrit('Dt',klev,'Dt','',tendt(:,1:klev))
    143   ENDIF
     133!  IF (klon==1) THEN
     134!  CALL iophys_ecrit('u',klev,'u','',windu)
     135!  CALL iophys_ecrit('v',klev,'v','',windu)
     136!  CALL iophys_ecrit('t',klev,'t','',temp)
     137!  CALL iophys_ecrit('tke1',klev,'tke1','',tke(:,1:klev,1))
     138!  CALL iophys_ecrit('tke2',klev,'tke2','',tke(:,1:klev,2))
     139!  CALL iophys_ecrit('tke3',klev,'tke3','',tke(:,1:klev,3))
     140!  CALL iophys_ecrit('tke4',klev,'tke4','',tke(:,1:klev,4))
     141!  CALL iophys_ecrit('theta',klev,'theta','',temp/exner)
     142!  CALL iophys_ecrit('Duv',klev,'Duv','',tendu(:,1:klev)+tendv(:,1:klev))
     143!  CALL iophys_ecrit('Dt',klev,'Dt','',tendt(:,1:klev))
     144!  ENDIF
    144145
    145146 END SUBROUTINE tend_to_tke
Note: See TracChangeset for help on using the changeset viewer.