Index: LMDZ5/trunk/libf/phylmd/orografi_strato.F90 =================================================================== --- LMDZ5/trunk/libf/phylmd/orografi_strato.F90 (revision 2896) +++ LMDZ5/trunk/libf/phylmd/orografi_strato.F90 (revision 2897) @@ -1,3 +1,3 @@ -SUBROUTINE drag_noro_strato(nlon, nlev, dtime, paprs, pplay, pmea, pstd, & +SUBROUTINE drag_noro_strato(partdrag, nlon, nlev, dtime, paprs, pplay, pmea, pstd, & psig, pgam, pthe, ppic, pval, kgwd, kdx, ktest, t, u, v, pulow, pvlow, & pustr, pvstr, d_t, d_u, d_v) @@ -15,4 +15,5 @@ ! Explicit Arguments: ! ================== + ! partdrag-input-I-control which part of the drag we consider (total part or GW part) ! nlon----input-I-Total number of horizontal points that get into physics ! nlev----input-I-Number of vertical levels @@ -66,5 +67,5 @@ ! ARGUMENTS - INTEGER nlon, nlev + INTEGER partdrag,nlon, nlev REAL dtime REAL paprs(nlon, nlev+1) @@ -134,5 +135,5 @@ ! CALL SSO DRAG ROUTINES - CALL orodrag_strato(klon, klev, kgwd, kdx, ktest, dtime, papmh, papmf, & + CALL orodrag_strato(partdrag,klon, klev, kgwd, kdx, ktest, dtime, papmh, papmf, & zgeom, pt, pu, pv, pmea, pstd, psig, pgam, pthe, ppic, pval, pulow, & pvlow, pdudt, pdvdt, pdtdt) @@ -153,5 +154,5 @@ END SUBROUTINE drag_noro_strato -SUBROUTINE orodrag_strato(nlon, nlev, kgwd, kdx, ktest, ptsphy, paphm1, & +SUBROUTINE orodrag_strato(partdrag,nlon, nlev, kgwd, kdx, ktest, ptsphy, paphm1, & papm1, pgeom1, ptm1, pum1, pvm1, pmea, pstd, psig, pgam, pthe, ppic, pval & ! outputs @@ -182,4 +183,5 @@ ! -------------------- ! ==== inputs === + ! partdrag-input-I-control which part of the drag we consider (total part or GW part) ! nlon----input-I-Total number of horizontal points that get into physics ! nlev----input-I-Number of vertical levels @@ -201,5 +203,5 @@ ! pval----input-R-SSO Valleys elevation (m) - INTEGER nlon, nlev, kgwd + INTEGER nlon, nlev, kgwd REAL ptsphy @@ -239,4 +241,5 @@ include "YOMCST.h" include "YOEGWD.h" + ! ----------------------------------------------------------------------- @@ -244,5 +247,5 @@ ! --------- - + INTEGER partdrag REAL pte(nlon, nlev), pvol(nlon, nlev), pvom(nlon, nlev), pulow(nlon), & pvlow(nlon) @@ -269,5 +272,5 @@ INTEGER jl, jk, ji - REAL ztmst, zdelp, ztemp, zforc, ztend, rover + REAL ztmst, zdelp, ztemp, zforc, ztend, rover, facpart REAL zb, zc, zconb, zabsv, zzd1, ratio, zbet, zust, zvst, zdis @@ -393,8 +396,15 @@ ! ----------------- + IF (partdrag .GE. 2) THEN + facpart=0. + ELSE + facpart=gkwake + ENDIF + + IF (jk>ikenvh(ji)) THEN zb = 1.0 - 0.18*pgam(ji) - 0.04*pgam(ji)**2 zc = 0.48*pgam(ji) + 0.3*pgam(ji)**2 - zconb = 2.*ztmst*gkwake*psig(ji)/(4.*pstd(ji)) + zconb = 2.*ztmst*facpart*psig(ji)/(4.*pstd(ji)) zabsv = sqrt(pum1(ji,jk)**2+pvm1(ji,jk)**2)/2. zzd1 = zb*cos(zpsi(ji,jk))**2 + zc*sin(zpsi(ji,jk))**2 @@ -1894,3 +1904,2 @@ RETURN END SUBROUTINE sugwd_strato - Index: LMDZ5/trunk/libf/phylmd/phys_local_var_mod.F90 =================================================================== --- LMDZ5/trunk/libf/phylmd/phys_local_var_mod.F90 (revision 2896) +++ LMDZ5/trunk/libf/phylmd/phys_local_var_mod.F90 (revision 2897) @@ -80,4 +80,8 @@ REAL, SAVE, ALLOCATABLE :: d_u_oro(:,:), d_v_oro(:,:) !$OMP THREADPRIVATE(d_u_oro, d_v_oro) + REAL, SAVE, ALLOCATABLE :: d_t_oro_gw(:,:) + !$OMP THREADPRIVATE(d_t_oro) + REAL, SAVE, ALLOCATABLE :: d_u_oro_gw(:,:), d_v_oro_gw(:,:) + !$OMP THREADPRIVATE(d_u_oro_gw, d_v_oro_gw) REAL, SAVE, ALLOCATABLE :: d_t_lif(:,:) !$OMP THREADPRIVATE(d_t_lif) @@ -244,5 +248,5 @@ !$OMP THREADPRIVATE(toplwad0_aerop, sollwad0_aerop) -!Ajout de celles nécessaires au phys_output_write_mod +!Ajout de celles n??cessaires au phys_output_write_mod REAL, SAVE, ALLOCATABLE :: tal1(:), pal1(:), pab1(:), pab2(:) !$OMP THREADPRIVATE(tal1, pal1, pab1, pab2) @@ -327,5 +331,5 @@ !$OMP THREADPRIVATE(zxfluxlat_x, zxfluxlat_w) !jyg< -!!! Entrées supplémentaires couche-limite +!!! Entr\E9es suppl\E9mentaires couche-limite !! REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: t_x, t_w !!!$OMP THREADPRIVATE(t_x, t_w) @@ -338,5 +342,5 @@ REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: dqvdf_x, dqvdf_w !$OMP THREADPRIVATE(dqvdf_x, dqvdf_w) -! Variables supplémentaires dans physiq.F relative au splitting de la surface +! Variables suppl\E9mentaires dans physiq.F relative au splitting de la surface REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: pbl_tke_input !$OMP THREADPRIVATE(pbl_tke_input) @@ -545,4 +549,6 @@ ALLOCATE(d_u_oli(klon,klev),d_v_oli(klon,klev)) ALLOCATE(d_u_oro(klon,klev),d_v_oro(klon,klev)) + ALLOCATE(d_u_oro_gw(klon,klev),d_v_oro_gw(klon,klev)) + ALLOCATE(d_t_oro_gw(klon,klev)) ALLOCATE(d_t_lif(klon,klev),d_t_ec(klon,klev)) ALLOCATE(d_u_lif(klon,klev),d_v_lif(klon,klev)) @@ -622,5 +628,5 @@ ALLOCATE(toplwad0_aerop(klon), sollwad0_aerop(klon)) -! FH Ajout de celles nécessaires au phys_output_write_mod +! FH Ajout de celles n??cessaires au phys_output_write_mod ALLOCATE(tal1(klon), pal1(klon), pab1(klon), pab2(klon)) @@ -815,4 +821,6 @@ DEALLOCATE(d_u_oli,d_v_oli) DEALLOCATE(d_u_oro,d_v_oro) + DEALLOCATE(d_t_oro_gw) + DEALLOCATE(d_u_oro_gw,d_v_oro_gw) DEALLOCATE(d_t_lif,d_t_ec) DEALLOCATE(d_u_lif,d_v_lif) @@ -887,5 +895,5 @@ DEALLOCATE(toplwad0_aerop, sollwad0_aerop) -! FH Ajout de celles nécessaires au phys_output_write_mod +! FH Ajout de celles n??cessaires au phys_output_write_mod DEALLOCATE(tal1, pal1, pab1, pab2) DEALLOCATE(ptstar, pt0, slp) Index: LMDZ5/trunk/libf/phylmd/physiq_mod.F90 =================================================================== --- LMDZ5/trunk/libf/phylmd/physiq_mod.F90 (revision 2896) +++ LMDZ5/trunk/libf/phylmd/physiq_mod.F90 (revision 2897) @@ -69,4 +69,5 @@ d_t_oli,d_u_oli,d_v_oli, & d_t_oro,d_u_oro,d_v_oro, & + d_t_oro_gw,d_u_oro_gw,d_v_oro_gw, & d_t_lif,d_u_lif,d_v_lif, & d_t_ec, & @@ -434,4 +435,9 @@ REAL d_qx(klon,klev,nqtot) REAL d_ps(klon) + ! variables pour tend_to_tke + REAL duadd(klon,klev) + REAL dvadd(klon,klev) + REAL dtadd(klon,klev) + ! Variables pour le transport convectif real da(klon,klev),phi(klon,klev,klev),mp(klon,klev) @@ -606,5 +612,5 @@ REAL, SAVE :: alp_offset !$OMP THREADPRIVATE(alp_offset) - + ! !RR:fin declarations poches froides @@ -640,4 +646,13 @@ real therm_tke_max(klon,klev) ! Profil de TKE dans les thermiques real env_tke_max(klon,klev) ! Profil de TKE dans l'environnement + + !-------Activer les tendances de TKE due a l'orograp??ie--------- + INTEGER, SAVE :: addtkeoro + !$OMP THREADPRIVATE(addtkeoro) + REAL, SAVE :: alphatkeoro + !$OMP THREADPRIVATE(alphatkeoro) + LOGICAL, SAVE :: smallscales_tkeoro + !$OMP THREADPRIVATE(smallscales_tkeoro) + @@ -780,5 +795,5 @@ real zqsat(klon,klev) ! - INTEGER i, k, iq, nsrf, l + INTEGER i, k, iq, j, nsrf, ll, l ! REAL t_coup @@ -2244,4 +2259,7 @@ !>jyg ENDIF + + + @@ -3870,5 +3888,5 @@ IF (ok_strato) THEN - CALL drag_noro_strato(klon,klev,dtime,paprs,pplay, & + CALL drag_noro_strato(0,klon,klev,dtime,paprs,pplay, & zmea,zstd, zsig, zgam, zthe,zpic,zval, & igwd,idx,itest, & @@ -4045,4 +4063,121 @@ ! ! + +!=============================================================== +! Additional tendency of TKE due to orography +!=============================================================== +! +! Inititialization +!------------------ + + + + addtkeoro=0 + CALL getin_p('addtkeoro',addtkeoro) + + IF (prt_level.ge.5) & + print*,'addtkeoro', addtkeoro + + alphatkeoro=1. + CALL getin_p('alphatkeoro',alphatkeoro) + alphatkeoro=min(max(0.,alphatkeoro),1.) + + smallscales_tkeoro=.false. + CALL getin_p('smallscales_tkeoro',smallscales_tkeoro) + + + dtadd(:,:)=0. + duadd(:,:)=0. + dvadd(:,:)=0. + + + +! Choices for addtkeoro: +! ** 0 no TKE tendency from orography +! ** 1 we include a fraction alphatkeoro of the whole tendency duoro +! ** 2 we include a fraction alphatkeoro of the gravity wave part of duoro +! + + IF (addtkeoro .GT. 0 .AND. ok_orodr ) THEN +! ------------------------------------------- + + + ! selection des points pour lesquels le schema est actif: + + + + IF (addtkeoro .EQ. 1 ) THEN + + duadd(:,:)=alphatkeoro*d_u_oro(:,:) + dvadd(:,:)=alphatkeoro*d_v_oro(:,:) + + ELSE IF (addtkeoro .EQ. 2) THEN + + + + IF (smallscales_tkeoro) THEN + igwd=0 + DO i=1,klon + itest(i)=0 +! Etienne: ici je prends en compte plus de relief que la routine drag_noro_strato +! car on peut s'attendre a ce que les petites echelles produisent aussi de la TKE +! Mais attention, cela ne va pas dans le sens de la conservation de l'energie! + IF (zstd(i).GT.1.0) THEN + itest(i)=1 + igwd=igwd+1 + idx(igwd)=i + ENDIF + ENDDO + + ELSE + + igwd=0 + DO i=1,klon + itest(i)=0 + IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN + itest(i)=1 + igwd=igwd+1 + idx(igwd)=i + ENDIF + ENDDO + + END IF + + + + + CALL drag_noro_strato(addtkeoro,klon,klev,dtime,paprs,pplay, & + zmea,zstd, zsig, zgam, zthe,zpic,zval, & + igwd,idx,itest, & + t_seri, u_seri, v_seri, & + zulow, zvlow, zustrdr, zvstrdr, & + d_t_oro_gw, d_u_oro_gw, d_v_oro_gw) + + zustrdr(:)=0. + zvstrdr(:)=0. + zulow(:)=0. + zvlow(:)=0. + + duadd(:,:)=alphatkeoro*d_u_oro_gw(:,:) + dvadd(:,:)=alphatkeoro*d_v_oro_gw(:,:) + END IF + + + + ! TKE update from subgrid temperature and wind tendencies + !---------------------------------------------------------- + forall (k=1: nbp_lev) exner(:, k) = (pplay(:, k)/paprs(:,1))**RKAPPA + + + CALL tend_to_tke(pdtphys,paprs,exner,t_seri,u_seri,v_seri,dtadd,duadd,dvadd,pbl_tke) + + + + ENDIF +! ----- +!=============================================================== + + + !==================================================================== ! Interface Simulateur COSP (Calipso, ISCCP, MISR, ..) Index: LMDZ5/trunk/libf/phylmd/tend_to_tke.F90 =================================================================== --- LMDZ5/trunk/libf/phylmd/tend_to_tke.F90 (revision 2896) +++ LMDZ5/trunk/libf/phylmd/tend_to_tke.F90 (revision 2897) @@ -32,5 +32,5 @@ !************************************************************************************** - SUBROUTINE tend_to_tke(dt,plev,exner,temp,windu,windv,dt_a,du_a,dv_a,tke,dtke) + SUBROUTINE tend_to_tke(dt,plev,exner,temp,windu,windv,dt_a,du_a,dv_a,tke) USE dimphy, ONLY: klon, klev @@ -57,5 +57,4 @@ !--------------- REAL tke(klon,klev,nbsrf) ! Turbulent Kinetic energy [m2/s2], grid-cell average or for a subsurface - REAL dtke(klon,klev) @@ -127,19 +126,21 @@ ENDDO - dtke(:,:)=tendt(:,:)+tendu(:,:)+tendv(:,:) +! dtke_t(:,:)=tendt(:,:) +! dtke_u(:,:)=tendu(:,:) +! dtke_v(:,:)=tendv(:,:) - IF (klon==1) THEN - CALL iophys_ecrit('u',klev,'u','',windu) - CALL iophys_ecrit('v',klev,'v','',windu) - CALL iophys_ecrit('t',klev,'t','',temp) - CALL iophys_ecrit('tke1',klev,'tke1','',tke(:,1:klev,1)) - CALL iophys_ecrit('tke2',klev,'tke2','',tke(:,1:klev,2)) - CALL iophys_ecrit('tke3',klev,'tke3','',tke(:,1:klev,3)) - CALL iophys_ecrit('tke4',klev,'tke4','',tke(:,1:klev,4)) - CALL iophys_ecrit('theta',klev,'theta','',temp/exner) - CALL iophys_ecrit('Duv',klev,'Duv','',tendu(:,1:klev)+tendv(:,1:klev)) - CALL iophys_ecrit('Dt',klev,'Dt','',tendt(:,1:klev)) - ENDIF +! IF (klon==1) THEN +! CALL iophys_ecrit('u',klev,'u','',windu) +! CALL iophys_ecrit('v',klev,'v','',windu) +! CALL iophys_ecrit('t',klev,'t','',temp) +! CALL iophys_ecrit('tke1',klev,'tke1','',tke(:,1:klev,1)) +! CALL iophys_ecrit('tke2',klev,'tke2','',tke(:,1:klev,2)) +! CALL iophys_ecrit('tke3',klev,'tke3','',tke(:,1:klev,3)) +! CALL iophys_ecrit('tke4',klev,'tke4','',tke(:,1:klev,4)) +! CALL iophys_ecrit('theta',klev,'theta','',temp/exner) +! CALL iophys_ecrit('Duv',klev,'Duv','',tendu(:,1:klev)+tendv(:,1:klev)) +! CALL iophys_ecrit('Dt',klev,'Dt','',tendt(:,1:klev)) +! ENDIF END SUBROUTINE tend_to_tke