- Timestamp:
- Feb 12, 2018, 10:01:04 AM (7 years ago)
- Location:
- LMDZ6/branches/IPSLCM6.0.15/libf/phylmd
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/IPSLCM6.0.15/libf/phylmd/acama_gwd_rando_m.F90
r2665 r3200 20 20 use dimphy, only: klon, klev 21 21 use assert_m, only: assert 22 USE ioipsl_getin_p_mod, ONLY : getin_p 23 USE vertical_layers_mod, ONLY : presnivs 24 22 25 include "YOMCST.h" 23 26 include "clesphys.h" … … 111 114 REAL BV(KLON, KLEV + 1) ! Brunt Vaisala freq. (BVF) at 1/2 levels 112 115 REAL BVSEC ! Security to avoid negative BVF 116 117 REAL, DIMENSION(klev+1) ::HREF 118 LOGICAL, SAVE :: gwd_reproductibilite_mpiomp=.true. 119 LOGICAL, SAVE :: firstcall = .TRUE. 120 !$OMP THREADPRIVATE(firstcall,gwd_reproductibilite_mpiomp) 121 122 CHARACTER (LEN=20) :: modname='flott_gwd_rando' 123 CHARACTER (LEN=80) :: abort_message 124 125 126 127 IF (firstcall) THEN 128 ! Cle introduite pour resoudre un probleme de non reproductibilite 129 ! Le but est de pouvoir tester de revenir a la version precedenete 130 ! A eliminer rapidement 131 CALL getin_p('gwd_reproductibilite_mpiomp',gwd_reproductibilite_mpiomp) 132 IF (NW+4*(NA-1)+NA>=KLEV) THEN 133 abort_message = 'NW+3*NA>=KLEV Probleme pour generation des ondes' 134 CALL abort_physic (modname,abort_message,1) 135 ENDIF 136 firstcall=.false. 137 ! CALL iophys_ini 138 ENDIF 113 139 114 140 !----------------------------------------------------------------- … … 205 231 ! Launching altitude 206 232 233 IF (gwd_reproductibilite_mpiomp) THEN 234 ! Reprend la formule qui calcule PH en fonction de PP=play 235 DO LL = 2, KLEV 236 HREF(LL) = EXP((LOG(presnivs(LL)) + LOG(presnivs(LL - 1))) / 2.) 237 end DO 238 HREF(KLEV + 1) = 0. 239 HREF(1) = 2. * presnivs(1) - HREF(2) 240 ELSE 241 HREF(1:KLEV)=PH(KLON/2,1:KLEV) 242 ENDIF 243 207 244 LAUNCH=0 208 245 LTROP =0 209 246 DO LL = 1, KLEV 210 IF ( PH(KLON / 2, LL) / PH(KLON / 2,1) > XLAUNCH) LAUNCH = LL247 IF (HREF(LL) / HREF(1) > XLAUNCH) LAUNCH = LL 211 248 ENDDO 212 249 DO LL = 1, KLEV 213 IF ( PH(KLON / 2, LL) / PH(KLON / 2,1) > XTROP) LTROP = LL250 IF (HREF(LL) / HREF(1) > XTROP) LTROP = LL 214 251 ENDDO 215 252 … … 293 330 294 331 JW = 0 295 DO JP = 1, NP 296 DO JK = 1, NK 297 DO JO = 1, NO 298 JW = JW + 1 332 DO JW = 1, NW 299 333 ! Angle 300 334 DO II = 1, KLON … … 340 374 ! RUW0(JW, II) = RUWFRT 341 375 ENDDO 342 end DO343 end DO344 376 end DO 345 377 -
LMDZ6/branches/IPSLCM6.0.15/libf/phylmd/flott_gwd_rando_m.F90
r2665 r3200 18 18 use dimphy, only: klon, klev 19 19 use assert_m, only: assert 20 USE ioipsl_getin_p_mod, ONLY : getin_p 21 USE vertical_layers_mod, ONLY : presnivs 22 20 23 include "YOMCST.h" 21 24 include "clesphys.h" … … 103 106 REAL PH(KLON, KLEV + 1) ! Pressure at 1/2 levels 104 107 REAL PSEC ! Security to avoid division by 0 pressure 105 REAL PHM1(KLON, KLEV + 1) ! 1/Press at 1/2 levels106 108 REAL BV(KLON, KLEV + 1) ! Brunt Vaisala freq. (BVF) at 1/2 levels 107 109 REAL BVSEC ! Security to avoid negative BVF 110 REAL RAN_NUM_1,RAN_NUM_2,RAN_NUM_3 111 112 REAL, DIMENSION(klev+1) ::HREF 113 114 LOGICAL, SAVE :: gwd_reproductibilite_mpiomp=.true. 115 LOGICAL, SAVE :: firstcall = .TRUE. 116 !$OMP THREADPRIVATE(firstcall,gwd_reproductibilite_mpiomp) 117 118 CHARACTER (LEN=20) :: modname='flott_gwd_rando' 119 CHARACTER (LEN=80) :: abort_message 120 121 122 123 IF (firstcall) THEN 124 ! Cle introduite pour resoudre un probleme de non reproductibilite 125 ! Le but est de pouvoir tester de revenir a la version precedenete 126 ! A eliminer rapidement 127 CALL getin_p('gwd_reproductibilite_mpiomp',gwd_reproductibilite_mpiomp) 128 IF (NW+3*NA>=KLEV) THEN 129 abort_message = 'NW+3*NA>=KLEV Probleme pour generation des ondes' 130 CALL abort_physic (modname,abort_message,1) 131 ENDIF 132 firstcall=.false. 133 ENDIF 134 108 135 109 136 !----------------------------------------------------------------- … … 156 183 ZOISEC = 1.E-6 ! Security FOR 0 INTRINSIC FREQ 157 184 185 IF (1==0) THEN 158 186 !ONLINE 159 187 call assert(klon == (/size(pp, 1), size(tt, 1), size(uu, 1), & … … 167 195 "FLOTT_GWD_RANDO klev") 168 196 !END ONLINE 197 ENDIF 169 198 170 199 IF(DELTAT < DTIME)THEN … … 183 212 DO LL = 2, KLEV 184 213 PH(:, LL) = EXP((LOG(PP(:, LL)) + LOG(PP(:, LL - 1))) / 2.) 185 PHM1(:, LL) = 1. / PH(:, LL) 186 end DO 187 214 end DO 188 215 PH(:, KLEV + 1) = 0. 189 PHM1(:, KLEV + 1) = 1. / PSEC190 216 PH(:, 1) = 2. * PP(:, 1) - PH(:, 2) 191 217 192 218 ! Launching altitude 219 220 !Pour revenir a la version non reproductible en changeant le nombre de process 221 IF (gwd_reproductibilite_mpiomp) THEN 222 ! Reprend la formule qui calcule PH en fonction de PP=play 223 DO LL = 2, KLEV 224 HREF(LL) = EXP((LOG(presnivs(LL)) + LOG(presnivs(LL - 1))) / 2.) 225 end DO 226 HREF(KLEV + 1) = 0. 227 HREF(1) = 2. * presnivs(1) - HREF(2) 228 ELSE 229 HREF(1:KLEV)=PH(KLON/2,1:KLEV) 230 ENDIF 193 231 194 232 LAUNCH=0 195 233 LTROP =0 196 234 DO LL = 1, KLEV 197 IF ( PH(KLON / 2, LL) / PH(KLON / 2,1) > XLAUNCH) LAUNCH = LL235 IF (HREF(LL) / HREF(1) > XLAUNCH) LAUNCH = LL 198 236 ENDDO 199 237 DO LL = 1, KLEV 200 IF ( PH(KLON / 2, LL) / PH(KLON / 2,1) > XTROP) LTROP = LL238 IF (HREF(LL) / HREF(1) > XTROP) LTROP = LL 201 239 ENDDO 202 240 … … 245 283 ! waves characteristics in an almost stochastic way 246 284 247 JW = 0 248 DO JP = 1, NP 249 DO JK = 1, NK 250 DO JO = 1, NO 251 JW = JW + 1 285 DO JW = 1, NW 252 286 ! Angle 253 287 DO II = 1, KLON 254 288 ! Angle (0 or PI so far) 255 ZP(JW, II) = (SIGN(1., 0.5 - MOD(TT(II, JW) * 10., 1.)) + 1.) & 289 RAN_NUM_1=MOD(TT(II, JW) * 10., 1.) 290 RAN_NUM_2= MOD(TT(II, JW) * 100., 1.) 291 ZP(JW, II) = (SIGN(1., 0.5 - RAN_NUM_1) + 1.) & 256 292 * RPI / 2. 257 293 ! Horizontal wavenumber amplitude 258 ZK(JW, II) = KMIN + (KMAX - KMIN) * MOD(TT(II, JW) * 100., 1.)294 ZK(JW, II) = KMIN + (KMAX - KMIN) *RAN_NUM_2 259 295 ! Horizontal phase speed 260 296 CPHA = 0. 261 297 DO JJ = 1, NA 298 RAN_NUM_3=MOD(TT(II, JW+3*JJ)**2, 1.) 262 299 CPHA = CPHA + & 263 CMAX*2.*(MOD(TT(II, JW+3*JJ)**2, 1.)-0.5)*SQRT(3.)/SQRT(NA*1.)300 CMAX*2.*(RAN_NUM_3 -0.5)*SQRT(3.)/SQRT(NA*1.) 264 301 END DO 265 302 IF (CPHA.LT.0.) THEN … … 276 313 RUW0(JW, II) = RUWMAX 277 314 ENDDO 278 end DO 279 end DO 280 end DO 315 ENDDO 281 316 282 317 ! 4. COMPUTE THE FLUXES … … 417 452 ENDDO 418 453 454 419 455 END SUBROUTINE FLOTT_GWD_RANDO 420 456 -
LMDZ6/branches/IPSLCM6.0.15/libf/phylmd/pbl_surface_mod.F90
r3102 r3200 1266 1266 ENDDO 1267 1267 !!! jyg le 07/02/2012 et le 10/04/2013 1268 DO k = 1, klev 1268 DO k = 1, klev+1 1269 1269 DO j = 1, knon 1270 1270 i = ni(j) … … 1272 1272 !! ytke(j,k) = tke(i,k,nsrf) 1273 1273 ytke(j,k) = tke_x(i,k,nsrf) 1274 ENDDO 1275 ENDDO 1274 1276 !>jyg 1277 DO k = 1, klev 1278 DO j = 1, knon 1279 i = ni(j) 1275 1280 !FC 1276 1281 y_treedrg(j,k) = treedrg(i,k,nsrf) … … 2398 2403 IF (iflag_split .eq.0) THEN 2399 2404 wake_dltke(:,:,nsrf) = 0. 2400 DO k = 1, klev 2405 DO k = 1, klev+1 2401 2406 DO j = 1, knon 2402 2407 i = ni(j) … … 2411 2416 2412 2417 ELSE ! (iflag_split .eq.0) 2413 DO k = 1, klev 2418 DO k = 1, klev+1 2414 2419 DO j = 1, knon 2415 2420 i = ni(j) -
LMDZ6/branches/IPSLCM6.0.15/libf/phylmd/physiq_mod.F90
r3176 r3200 4373 4373 4374 4374 4375 CALL tend_to_tke(pdtphys,paprs,exner,t_seri,u_seri,v_seri,dtadd,duadd,dvadd,p bl_tke)4375 CALL tend_to_tke(pdtphys,paprs,exner,t_seri,u_seri,v_seri,dtadd,duadd,dvadd,pctsrf,pbl_tke) 4376 4376 4377 4377 -
LMDZ6/branches/IPSLCM6.0.15/libf/phylmd/tend_to_tke.F90
r3189 r3200 32 32 !************************************************************************************** 33 33 34 SUBROUTINE tend_to_tke(dt,plev,exner,temp,windu,windv,dt_a,du_a,dv_a, tke)34 SUBROUTINE tend_to_tke(dt,plev,exner,temp,windu,windv,dt_a,du_a,dv_a,pctsrf,tke) 35 35 36 36 USE dimphy, ONLY: klon, klev … … 53 53 REAL du_a(klon,klev) ! Zonal wind speed tendency [m/s], grid-cell average or for a one subsurface 54 54 REAL dv_a(klon,klev) ! Meridional wind speed tendency [m/s], grid-cell average or for a one subsurface 55 REAL pctsrf(klon,nbsrf+1) ! Turbulent Kinetic energy [m2/s2], grid-cell average or for a subsurface 55 56 56 57 ! Inputs/Outputs … … 119 120 120 121 121 DO isrf=1,n bsrf122 DO isrf=1,nsrf 122 123 DO k=1,klev 123 tke(:,k,isrf)= tke(:,k,isrf)+tendu(:,k)+tendv(:,k)+tendt(:,k) 124 tke(:,k,isrf)= max(tke(:,k,isrf),1.e-10) 124 DO i=1,klon 125 IF (pctsrf(i,isrf)>0.) THEN 126 tke(i,k,isrf)= tke(i,k,isrf)+tendu(i,k)+tendv(i,k)+tendt(i,k) 127 tke(i,k,isrf)= max(tke(i,k,isrf),1.e-10) 128 ENDIF 129 ENDDO 125 130 ENDDO 126 131 ENDDO 127 128 ! dtke_t(:,:)=tendt(:,:)129 ! dtke_u(:,:)=tendu(:,:)130 ! dtke_v(:,:)=tendv(:,:)131 132 132 133
Note: See TracChangeset
for help on using the changeset viewer.