Changeset 2899 for palm/trunk/SOURCE/pmc_interface_mod.f90
- Timestamp:
- Mar 15, 2018 1:36:02 PM (7 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/pmc_interface_mod.f90 (modified) (23 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/pmc_interface_mod.f90
r2895 r2899 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Control logics improved to allow nesting also in cases with 28 ! constant_flux_layer = .F. or constant_diffusion = .T. 29 ! 30 ! 2895 2018-03-15 10:26:12Z hellstea 27 31 ! Change in the nest initialization (pmci_interp_tril_all). Bottom wall BC is no 28 32 ! longer overwritten. … … 260 264 261 265 USE control_parameters, & 262 ONLY: air_chemistry, cloud_physics, coupling_char, dt_3d, dz, & 263 humidity, message_string, microphysics_morrison, & 264 microphysics_seifert, nest_bound_l, nest_bound_r, nest_bound_s, & 265 nest_bound_n, nest_domain, neutral, passive_scalar, & 266 roughness_length, simulated_time, topography, volume_flow 266 ONLY: air_chemistry, cloud_physics, & 267 constant_diffusion, constant_flux_layer, & 268 coupling_char, dt_3d, dz, humidity, message_string, & 269 microphysics_morrison, microphysics_seifert, & 270 nest_bound_l, nest_bound_r, nest_bound_s, nest_bound_n, & 271 nest_domain, neutral, passive_scalar, roughness_length, & 272 simulated_time, topography, volume_flow 267 273 268 274 USE chem_modules, & … … 1347 1353 ! 1348 1354 !-- Precompute the log-law correction index- and ratio-arrays 1349 CALL pmci_init_loglaw_correction 1355 IF ( constant_flux_layer ) THEN 1356 CALL pmci_init_loglaw_correction 1357 ENDIF 1350 1358 ! 1351 1359 !-- Define the SGS-TKE scaling factor based on the grid-spacing ratio 1352 CALL pmci_init_tkefactor 1360 IF ( .NOT. constant_diffusion ) THEN 1361 CALL pmci_init_tkefactor 1362 ENDIF 1353 1363 ! 1354 1364 !-- Two-way coupling for general and vertical nesting. … … 3473 3483 CALL pmci_interp_tril_all ( w, wc, ico, jco, kcw, r1xo, r2xo, r1yo, & 3474 3484 r2yo, r1zw, r2zw, 'w' ) 3475 CALL pmci_interp_tril_all ( e, ec, ico, jco, kco, r1xo, r2xo, r1yo, & 3476 r2yo, r1zo, r2zo, 'e' ) 3477 3485 3486 IF ( .NOT. constant_diffusion ) THEN 3487 CALL pmci_interp_tril_all ( e, ec, ico, jco, kco, r1xo, r2xo, & 3488 r1yo, r2yo, r1zo, r2zo, 'e' ) 3489 ENDIF 3490 3478 3491 IF ( .NOT. neutral ) THEN 3479 3492 CALL pmci_interp_tril_all ( pt, ptc, ico, jco, kco, r1xo, r2xo, & … … 3657 3670 !-- conditions, a corresponding correction is made for all vertical walls, 3658 3671 !-- too. 3659 IF ( var == 'u' .OR. var == 'v') THEN3672 IF ( constant_flux_layer .AND. ( var == 'u' .OR. var == 'v' ) ) THEN 3660 3673 z0_topo = roughness_length 3661 3674 DO i = ib, nxr … … 4175 4188 !-- Left border pe: 4176 4189 IF ( nest_bound_l ) THEN 4190 4177 4191 CALL pmci_interp_tril_lr( u, uc, icu, jco, kco, r1xu, r2xu, & 4178 4192 r1yo, r2yo, r1zo, r2zo, & … … 4193 4207 nzt_topo_nestbc_l, 'l', 'w' ) 4194 4208 4195 CALL pmci_interp_tril_lr( e, ec, ico, jco, kco, r1xo, r2xo, & 4196 r1yo, r2yo, r1zo, r2zo, & 4197 logc_w_l, logc_ratio_w_l, & 4198 logc_kbounds_w_l, & 4199 nzt_topo_nestbc_l, 'l', 'e' ) 4200 4209 IF ( .NOT. constant_diffusion ) THEN 4210 CALL pmci_interp_tril_lr( e, ec, ico, jco, kco, r1xo, r2xo, & 4211 r1yo, r2yo, r1zo, r2zo, & 4212 logc_w_l, logc_ratio_w_l, & 4213 logc_kbounds_w_l, & 4214 nzt_topo_nestbc_l, 'l', 'e' ) 4215 ENDIF 4216 4201 4217 IF ( .NOT. neutral ) THEN 4202 4218 CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo, & … … 4269 4285 !-- Right border pe 4270 4286 IF ( nest_bound_r ) THEN 4287 4271 4288 CALL pmci_interp_tril_lr( u, uc, icu, jco, kco, r1xu, r2xu, & 4272 4289 r1yo, r2yo, r1zo, r2zo, & … … 4287 4304 nzt_topo_nestbc_r, 'r', 'w' ) 4288 4305 4289 CALL pmci_interp_tril_lr( e, ec, ico, jco, kco, r1xo, r2xo, & 4290 r1yo,r2yo, r1zo, r2zo, & 4291 logc_w_r, logc_ratio_w_r, & 4292 logc_kbounds_w_r, & 4293 nzt_topo_nestbc_r, 'r', 'e' ) 4294 4306 IF ( .NOT. constant_diffusion ) THEN 4307 CALL pmci_interp_tril_lr( e, ec, ico, jco, kco, r1xo, r2xo, & 4308 r1yo,r2yo, r1zo, r2zo, & 4309 logc_w_r, logc_ratio_w_r, & 4310 logc_kbounds_w_r, & 4311 nzt_topo_nestbc_r, 'r', 'e' ) 4312 ENDIF 4295 4313 4296 4314 IF ( .NOT. neutral ) THEN … … 4300 4318 logc_kbounds_w_r, & 4301 4319 nzt_topo_nestbc_r, 'r', 's' ) 4302 4303 4320 ENDIF 4304 4321 … … 4370 4387 !-- South border pe 4371 4388 IF ( nest_bound_s ) THEN 4389 4372 4390 CALL pmci_interp_tril_sn( u, uc, icu, jco, kco, r1xu, r2xu, & 4373 4391 r1yo, r2yo, r1zo, r2zo, & … … 4375 4393 logc_kbounds_u_s, & 4376 4394 nzt_topo_nestbc_s, 's', 'u' ) 4395 4377 4396 CALL pmci_interp_tril_sn( v, vc, ico, jcv, kco, r1xo, r2xo, & 4378 4397 r1yv, r2yv, r1zo, r2zo, & … … 4380 4399 logc_kbounds_v_s, & 4381 4400 nzt_topo_nestbc_s, 's', 'v' ) 4401 4382 4402 CALL pmci_interp_tril_sn( w, wc, ico, jco, kcw, r1xo, r2xo, & 4383 4403 r1yo, r2yo, r1zw, r2zw, & … … 4385 4405 logc_kbounds_w_s, & 4386 4406 nzt_topo_nestbc_s, 's','w' ) 4387 CALL pmci_interp_tril_sn( e, ec, ico, jco, kco, r1xo, r2xo, & 4388 r1yo, r2yo, r1zo, r2zo, & 4389 logc_w_s, logc_ratio_w_s, & 4390 logc_kbounds_w_s, & 4391 nzt_topo_nestbc_s, 's', 'e' ) 4392 4407 4408 IF ( .NOT. constant_diffusion ) THEN 4409 CALL pmci_interp_tril_sn( e, ec, ico, jco, kco, r1xo, r2xo, & 4410 r1yo, r2yo, r1zo, r2zo, & 4411 logc_w_s, logc_ratio_w_s, & 4412 logc_kbounds_w_s, & 4413 nzt_topo_nestbc_s, 's', 'e' ) 4414 ENDIF 4415 4393 4416 IF ( .NOT. neutral ) THEN 4394 4417 CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo, & … … 4464 4487 !-- North border pe 4465 4488 IF ( nest_bound_n ) THEN 4489 4466 4490 CALL pmci_interp_tril_sn( u, uc, icu, jco, kco, r1xu, r2xu, & 4467 4491 r1yo, r2yo, r1zo, r2zo, & … … 4481 4505 logc_kbounds_w_n, & 4482 4506 nzt_topo_nestbc_n, 'n', 'w' ) 4483 4484 CALL pmci_interp_tril_sn( e, ec, ico, jco, kco, r1xo, r2xo, & 4485 r1yo, r2yo, r1zo, r2zo, & 4486 logc_w_n, logc_ratio_w_n, & 4487 logc_kbounds_w_n, & 4488 nzt_topo_nestbc_n, 'n', 'e' ) 4489 4507 IF ( .NOT. constant_diffusion ) THEN 4508 CALL pmci_interp_tril_sn( e, ec, ico, jco, kco, r1xo, r2xo, & 4509 r1yo, r2yo, r1zo, r2zo, & 4510 logc_w_n, logc_ratio_w_n, & 4511 logc_kbounds_w_n, & 4512 nzt_topo_nestbc_n, 'n', 'e' ) 4513 ENDIF 4514 4490 4515 IF ( .NOT. neutral ) THEN 4491 4516 CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo, & … … 4568 4593 CALL pmci_interp_tril_t( w, wc, ico, jco, kcw, r1xo, r2xo, r1yo, & 4569 4594 r2yo, r1zw, r2zw, 'w' ) 4570 CALL pmci_interp_tril_t( e, ec, ico, jco, kco, r1xo, r2xo, r1yo, & 4571 r2yo, r1zo, r2zo, 'e' ) 4572 4595 IF ( .NOT. constant_diffusion ) THEN 4596 CALL pmci_interp_tril_t( e, ec, ico, jco, kco, r1xo, r2xo, r1yo, & 4597 r2yo, r1zo, r2zo, 'e' ) 4598 ENDIF 4573 4599 IF ( .NOT. neutral ) THEN 4574 4600 CALL pmci_interp_tril_t( pt, ptc, ico, jco, kco, r1xo, r2xo, r1yo, & … … 4797 4823 ! 4798 4824 !-- Solid surface below the node 4799 IF ( var == 'u' .OR. var == 'v' ) THEN4825 IF ( constant_flux_layer .AND. ( var == 'u' .OR. var == 'v' ) ) THEN 4800 4826 DO j = nys, nyn 4801 4827 ! … … 4820 4846 IF ( topography /= 'flat' ) THEN 4821 4847 4822 IF ( var == 'u' .OR. var == 'w' ) THEN4848 IF ( constant_flux_layer .AND. ( var == 'u' .OR. var == 'w' ) ) THEN 4823 4849 ! 4824 4850 !-- Solid surface only on south/north side of the node … … 4843 4869 ! 4844 4870 !-- Solid surface on both below and on south/north side of the node 4845 IF ( var == 'u' ) THEN4871 IF ( constant_flux_layer .AND. var == 'u' ) THEN 4846 4872 DO j = nys, nyn 4847 4873 k = logc_kbounds(1,j) … … 5014 5040 ! 5015 5041 !-- Solid surface below the node 5016 IF ( var == 'u' .OR. var == 'v') THEN5042 IF ( constant_flux_layer .AND. ( var == 'u' .OR. var == 'v' ) ) THEN 5017 5043 DO i = nxl, nxr 5018 5044 ! … … 5038 5064 IF ( topography /= 'flat' ) THEN 5039 5065 5040 IF ( var == 'v' .OR. var == 'w') THEN5066 IF ( constant_flux_layer .AND. ( var == 'v' .OR. var == 'w' ) ) THEN 5041 5067 DO i = nxl, nxr 5042 5068 DO k = logc_kbounds(1,i), logc_kbounds(2,i) … … 5061 5087 ! 5062 5088 !-- Solid surface on both below and on left/right side of the node 5063 IF ( var == 'v' ) THEN5089 IF ( constant_flux_layer .AND. var == 'v' ) THEN 5064 5090 DO i = nxl, nxr 5065 5091 k = logc_kbounds(1,i)
Note: See TracChangeset
for help on using the changeset viewer.
