Changeset 2897 for LMDZ5/trunk
- Timestamp:
- May 31, 2017, 12:34:09 AM (7 years ago)
- Location:
- LMDZ5/trunk/libf/phylmd
- Files:
-
- 4 edited
-
orografi_strato.F90 (modified) (12 diffs)
-
phys_local_var_mod.F90 (modified) (8 diffs)
-
physiq_mod.F90 (modified) (8 diffs)
-
tend_to_tke.F90 (modified) (3 diffs)
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, &1 SUBROUTINE drag_noro_strato(partdrag, nlon, nlev, dtime, paprs, pplay, pmea, pstd, & 2 2 psig, pgam, pthe, ppic, pval, kgwd, kdx, ktest, t, u, v, pulow, pvlow, & 3 3 pustr, pvstr, d_t, d_u, d_v) … … 15 15 ! Explicit Arguments: 16 16 ! ================== 17 ! partdrag-input-I-control which part of the drag we consider (total part or GW part) 17 18 ! nlon----input-I-Total number of horizontal points that get into physics 18 19 ! nlev----input-I-Number of vertical levels … … 66 67 ! ARGUMENTS 67 68 68 INTEGER nlon, nlev69 INTEGER partdrag,nlon, nlev 69 70 REAL dtime 70 71 REAL paprs(nlon, nlev+1) … … 134 135 ! CALL SSO DRAG ROUTINES 135 136 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, & 137 138 zgeom, pt, pu, pv, pmea, pstd, psig, pgam, pthe, ppic, pval, pulow, & 138 139 pvlow, pdudt, pdvdt, pdtdt) … … 153 154 END SUBROUTINE drag_noro_strato 154 155 155 SUBROUTINE orodrag_strato( nlon, nlev, kgwd, kdx, ktest, ptsphy, paphm1, &156 SUBROUTINE orodrag_strato(partdrag,nlon, nlev, kgwd, kdx, ktest, ptsphy, paphm1, & 156 157 papm1, pgeom1, ptm1, pum1, pvm1, pmea, pstd, psig, pgam, pthe, ppic, pval & 157 158 ! outputs … … 182 183 ! -------------------- 183 184 ! ==== inputs === 185 ! partdrag-input-I-control which part of the drag we consider (total part or GW part) 184 186 ! nlon----input-I-Total number of horizontal points that get into physics 185 187 ! nlev----input-I-Number of vertical levels … … 201 203 ! pval----input-R-SSO Valleys elevation (m) 202 204 203 INTEGER nlon, nlev, kgwd205 INTEGER nlon, nlev, kgwd 204 206 REAL ptsphy 205 207 … … 239 241 include "YOMCST.h" 240 242 include "YOEGWD.h" 243 241 244 ! ----------------------------------------------------------------------- 242 245 … … 244 247 ! --------- 245 248 246 249 INTEGER partdrag 247 250 REAL pte(nlon, nlev), pvol(nlon, nlev), pvom(nlon, nlev), pulow(nlon), & 248 251 pvlow(nlon) … … 269 272 270 273 INTEGER jl, jk, ji 271 REAL ztmst, zdelp, ztemp, zforc, ztend, rover 274 REAL ztmst, zdelp, ztemp, zforc, ztend, rover, facpart 272 275 REAL zb, zc, zconb, zabsv, zzd1, ratio, zbet, zust, zvst, zdis 273 276 … … 393 396 ! ----------------- 394 397 398 IF (partdrag .GE. 2) THEN 399 facpart=0. 400 ELSE 401 facpart=gkwake 402 ENDIF 403 404 395 405 IF (jk>ikenvh(ji)) THEN 396 406 zb = 1.0 - 0.18*pgam(ji) - 0.04*pgam(ji)**2 397 407 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)) 399 409 zabsv = sqrt(pum1(ji,jk)**2+pvm1(ji,jk)**2)/2. 400 410 zzd1 = zb*cos(zpsi(ji,jk))**2 + zc*sin(zpsi(ji,jk))**2 … … 1894 1904 RETURN 1895 1905 END SUBROUTINE sugwd_strato 1896 -
LMDZ5/trunk/libf/phylmd/phys_local_var_mod.F90
r2877 r2897 80 80 REAL, SAVE, ALLOCATABLE :: d_u_oro(:,:), d_v_oro(:,:) 81 81 !$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) 82 86 REAL, SAVE, ALLOCATABLE :: d_t_lif(:,:) 83 87 !$OMP THREADPRIVATE(d_t_lif) … … 244 248 !$OMP THREADPRIVATE(toplwad0_aerop, sollwad0_aerop) 245 249 246 !Ajout de celles n écessaires au phys_output_write_mod250 !Ajout de celles n??cessaires au phys_output_write_mod 247 251 REAL, SAVE, ALLOCATABLE :: tal1(:), pal1(:), pab1(:), pab2(:) 248 252 !$OMP THREADPRIVATE(tal1, pal1, pab1, pab2) … … 327 331 !$OMP THREADPRIVATE(zxfluxlat_x, zxfluxlat_w) 328 332 !jyg< 329 !!! Entr ées supplémentaires couche-limite333 !!! Entr\E9es suppl\E9mentaires couche-limite 330 334 !! REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: t_x, t_w 331 335 !!!$OMP THREADPRIVATE(t_x, t_w) … … 338 342 REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: dqvdf_x, dqvdf_w 339 343 !$OMP THREADPRIVATE(dqvdf_x, dqvdf_w) 340 ! Variables suppl émentaires dans physiq.F relative au splitting de la surface344 ! Variables suppl\E9mentaires dans physiq.F relative au splitting de la surface 341 345 REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: pbl_tke_input 342 346 !$OMP THREADPRIVATE(pbl_tke_input) … … 545 549 ALLOCATE(d_u_oli(klon,klev),d_v_oli(klon,klev)) 546 550 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)) 547 553 ALLOCATE(d_t_lif(klon,klev),d_t_ec(klon,klev)) 548 554 ALLOCATE(d_u_lif(klon,klev),d_v_lif(klon,klev)) … … 622 628 ALLOCATE(toplwad0_aerop(klon), sollwad0_aerop(klon)) 623 629 624 ! FH Ajout de celles n écessaires au phys_output_write_mod630 ! FH Ajout de celles n??cessaires au phys_output_write_mod 625 631 626 632 ALLOCATE(tal1(klon), pal1(klon), pab1(klon), pab2(klon)) … … 815 821 DEALLOCATE(d_u_oli,d_v_oli) 816 822 DEALLOCATE(d_u_oro,d_v_oro) 823 DEALLOCATE(d_t_oro_gw) 824 DEALLOCATE(d_u_oro_gw,d_v_oro_gw) 817 825 DEALLOCATE(d_t_lif,d_t_ec) 818 826 DEALLOCATE(d_u_lif,d_v_lif) … … 887 895 DEALLOCATE(toplwad0_aerop, sollwad0_aerop) 888 896 889 ! FH Ajout de celles n écessaires au phys_output_write_mod897 ! FH Ajout de celles n??cessaires au phys_output_write_mod 890 898 DEALLOCATE(tal1, pal1, pab1, pab2) 891 899 DEALLOCATE(ptstar, pt0, slp) -
LMDZ5/trunk/libf/phylmd/physiq_mod.F90
r2882 r2897 69 69 d_t_oli,d_u_oli,d_v_oli, & 70 70 d_t_oro,d_u_oro,d_v_oro, & 71 d_t_oro_gw,d_u_oro_gw,d_v_oro_gw, & 71 72 d_t_lif,d_u_lif,d_v_lif, & 72 73 d_t_ec, & … … 434 435 REAL d_qx(klon,klev,nqtot) 435 436 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 436 442 ! Variables pour le transport convectif 437 443 real da(klon,klev),phi(klon,klev,klev),mp(klon,klev) … … 606 612 REAL, SAVE :: alp_offset 607 613 !$OMP THREADPRIVATE(alp_offset) 608 614 609 615 ! 610 616 !RR:fin declarations poches froides … … 640 646 real therm_tke_max(klon,klev) ! Profil de TKE dans les thermiques 641 647 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 642 657 643 658 … … 780 795 real zqsat(klon,klev) 781 796 ! 782 INTEGER i, k, iq, nsrf, l797 INTEGER i, k, iq, j, nsrf, ll, l 783 798 ! 784 799 REAL t_coup … … 2244 2259 !>jyg 2245 2260 ENDIF 2261 2262 2263 2246 2264 2247 2265 … … 3870 3888 IF (ok_strato) THEN 3871 3889 3872 CALL drag_noro_strato( klon,klev,dtime,paprs,pplay, &3890 CALL drag_noro_strato(0,klon,klev,dtime,paprs,pplay, & 3873 3891 zmea,zstd, zsig, zgam, zthe,zpic,zval, & 3874 3892 igwd,idx,itest, & … … 4045 4063 ! 4046 4064 ! 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 4047 4182 !==================================================================== 4048 4183 ! Interface Simulateur COSP (Calipso, ISCCP, MISR, ..) -
LMDZ5/trunk/libf/phylmd/tend_to_tke.F90
r2728 r2897 32 32 !************************************************************************************** 33 33 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) 35 35 36 36 USE dimphy, ONLY: klon, klev … … 57 57 !--------------- 58 58 REAL tke(klon,klev,nbsrf) ! Turbulent Kinetic energy [m2/s2], grid-cell average or for a subsurface 59 REAL dtke(klon,klev)60 59 61 60 … … 127 126 ENDDO 128 127 129 dtke(:,:)=tendt(:,:)+tendu(:,:)+tendv(:,:) 128 ! dtke_t(:,:)=tendt(:,:) 129 ! dtke_u(:,:)=tendu(:,:) 130 ! dtke_v(:,:)=tendv(:,:) 130 131 131 132 132 IF (klon==1) THEN133 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 ENDIF133 ! 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 144 145 145 146 END SUBROUTINE tend_to_tke
Note: See TracChangeset
for help on using the changeset viewer.
