Changeset 3435 for palm/trunk/SOURCE
- Timestamp:
- Oct 26, 2018 6:25:44 PM (6 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 10 edited
-
Makefile (modified) (3 diffs)
-
chemistry_model_mod.f90 (modified) (4 diffs)
-
data_output_mask.f90 (modified) (13 diffs)
-
init_masks.f90 (modified) (9 diffs)
-
modules.f90 (modified) (3 diffs)
-
netcdf_interface_mod.f90 (modified) (6 diffs)
-
parin.f90 (modified) (3 diffs)
-
radiation_model_mod.f90 (modified) (7 diffs)
-
urban_surface_mod.f90 (modified) (2 diffs)
-
user_data_output_mask.f90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/Makefile
r3421 r3435 25 25 # ----------------- 26 26 # $Id$ 27 # - Add surface_mod to data_output_mask 28 # - Add chemistry_model_mod and surface_mod to init_masks 29 # 30 # 3421 2018-10-24 18:39:32Z gronemeier 27 31 # Add netcdf_data_input_mod to netcdf_interface_mod 28 32 # bugfix: add dependencies to chemistry_model_mod … … 879 883 mod_particle_attributes.o \ 880 884 modules.o \ 881 netcdf_interface_mod.o 885 netcdf_interface_mod.o \ 886 surface_mod.o 882 887 data_output_profiles.o: \ 883 888 cpulog_mod.o \ … … 1087 1092 init_masks.o: \ 1088 1093 bulk_cloud_model_mod.o \ 1089 mod_kinds.o \ 1090 modules.o \ 1091 netcdf_interface_mod.o 1094 chemistry_model_mod.o \ 1095 mod_kinds.o \ 1096 modules.o \ 1097 netcdf_interface_mod.o \ 1098 radiation_model_mod.o 1092 1099 init_pegrid.o: \ 1093 1100 mod_kinds.o \ -
palm/trunk/SOURCE/chemistry_model_mod.f90
r3373 r3435 27 27 ! ----------------- 28 28 ! $Id$ 29 ! Add terrain-following masked output 30 ! 31 ! 3373 2018-10-18 15:25:56Z kanani 29 32 ! Remove MPI_Abort, replace by message 30 33 ! … … 1149 1152 USE kinds 1150 1153 USE pegrid, ONLY: myid, threads_per_task 1151 1154 USE surface_mod, ONLY: get_topography_top_index_ji 1152 1155 1153 1156 IMPLICIT NONE 1157 1158 CHARACTER(LEN=5) :: grid !< flag to distinquish between staggered grids 1154 1159 1155 1160 CHARACTER (LEN=*):: variable !< … … 1166 1171 INTEGER(iwp) :: j !< grid index along y-direction 1167 1172 INTEGER(iwp) :: k !< grid index along z-direction 1173 INTEGER(iwp) :: topo_top_ind !< k index of highest horizontal surface 1174 1168 1175 found = .TRUE. 1176 grid = 's' 1169 1177 1170 1178 spec_name = TRIM( variable(4:) ) … … 1178 1186 ! TRIM(chem_species(lsp)%name) 1179 1187 IF (av == 0) THEN 1180 DO i = 1, mask_size_l(mid,1) 1181 DO j = 1, mask_size_l(mid,2) 1182 DO k = 1, mask_size(mid,3) 1183 local_pf(i,j,k) = chem_species(lsp)%conc(mask_k(mid,k), & 1184 mask_j(mid,j), mask_i(mid,i)) 1188 IF ( .NOT. mask_surface(mid) ) THEN 1189 1190 DO i = 1, mask_size_l(mid,1) 1191 DO j = 1, mask_size_l(mid,2) 1192 DO k = 1, mask_size(mid,3) 1193 local_pf(i,j,k) = chem_species(lsp)%conc( & 1194 mask_k(mid,k), & 1195 mask_j(mid,j), & 1196 mask_i(mid,i) ) 1197 ENDDO 1185 1198 ENDDO 1186 1199 ENDDO 1187 ENDDO 1188 1189 ELSE 1190 DO i = 1, mask_size_l(mid,1) 1191 DO j = 1, mask_size_l(mid,2) 1192 DO k = 1, mask_size_l(mid,3) 1193 local_pf(i,j,k) = chem_species(lsp)%conc_av(mask_k(mid,k), & 1194 mask_j(mid,j), mask_i(mid,i)) 1200 1201 ELSE 1202 ! 1203 !-- Terrain-following masked output 1204 DO i = 1, mask_size_l(mid,1) 1205 DO j = 1, mask_size_l(mid,2) 1206 ! 1207 !-- Get k index of highest horizontal surface 1208 topo_top_ind = get_topography_top_index_ji( & 1209 mask_j(mid,j), & 1210 mask_i(mid,i), & 1211 grid ) 1212 ! 1213 !-- Save output array 1214 DO k = 1, mask_size_l(mid,3) 1215 local_pf(i,j,k) = chem_species(lsp)%conc( & 1216 MIN( topo_top_ind+mask_k(mid,k), & 1217 nzt+1 ), & 1218 mask_j(mid,j), & 1219 mask_i(mid,i) ) 1220 ENDDO 1195 1221 ENDDO 1196 1222 ENDDO 1197 ENDDO 1223 1224 ENDIF 1225 ELSE 1226 IF ( .NOT. mask_surface(mid) ) THEN 1227 1228 DO i = 1, mask_size_l(mid,1) 1229 DO j = 1, mask_size_l(mid,2) 1230 DO k = 1, mask_size_l(mid,3) 1231 local_pf(i,j,k) = chem_species(lsp)%conc_av( & 1232 mask_k(mid,k), & 1233 mask_j(mid,j), & 1234 mask_i(mid,i) ) 1235 ENDDO 1236 ENDDO 1237 ENDDO 1238 1239 ELSE 1240 ! 1241 !-- Terrain-following masked output 1242 DO i = 1, mask_size_l(mid,1) 1243 DO j = 1, mask_size_l(mid,2) 1244 ! 1245 !-- Get k index of highest horizontal surface 1246 topo_top_ind = get_topography_top_index_ji( & 1247 mask_j(mid,j), & 1248 mask_i(mid,i), & 1249 grid ) 1250 ! 1251 !-- Save output array 1252 DO k = 1, mask_size_l(mid,3) 1253 local_pf(i,j,k) = chem_species(lsp)%conc_av( & 1254 MIN( topo_top_ind+mask_k(mid,k), & 1255 nzt+1 ), & 1256 mask_j(mid,j), & 1257 mask_i(mid,i) ) 1258 ENDDO 1259 ENDDO 1260 ENDDO 1261 1262 ENDIF 1263 1264 1198 1265 ENDIF 1199 1266 found = .FALSE. -
palm/trunk/SOURCE/data_output_mask.f90
r3421 r3435 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Add terrain-following output 28 ! 29 ! 3421 2018-10-24 18:39:32Z gronemeier 27 30 ! Renamed output variables 28 31 ! … … 155 158 ONLY: air_chemistry, domask, domask_no, domask_time_count, mask_i, & 156 159 mask_j, mask_k, mask_size, mask_size_l, mask_start_l, & 160 mask_surface, & 157 161 max_masks, message_string, mid, nz_do3d, simulated_time 158 162 USE cpulog, & … … 160 164 161 165 USE indices, & 162 ONLY: nbgp, nxl, nxr, nyn, nys, nzb 166 ONLY: nbgp, nxl, nxr, nyn, nys, nzb, nzt 163 167 164 168 USE kinds … … 182 186 ONLY: radiation, radiation_data_output_mask 183 187 188 USE surface_mod, & 189 ONLY : surf_def_h, surf_lsm_h, surf_usm_h, get_topography_top_index_ji 190 184 191 IMPLICIT NONE 185 192 186 INTEGER(iwp) :: av !< 187 INTEGER(iwp) :: ngp !< 188 INTEGER(iwp) :: i !< 189 INTEGER(iwp) :: ivar !< 190 INTEGER(iwp) :: j !< 191 INTEGER(iwp) :: k !< 192 INTEGER(iwp) :: n !< 193 CHARACTER(LEN=5) :: grid !< flag to distinquish between staggered grids 194 195 INTEGER(iwp) :: av !< 196 INTEGER(iwp) :: ngp !< 197 INTEGER(iwp) :: i !< 198 INTEGER(iwp) :: ivar !< 199 INTEGER(iwp) :: j !< 200 INTEGER(iwp) :: k !< 201 INTEGER(iwp) :: kk !< 202 INTEGER(iwp) :: n !< 193 203 INTEGER(iwp) :: netcdf_data_format_save !< 194 INTEGER(iwp) :: sender !< 195 INTEGER(iwp) :: ind(6) !< 196 197 LOGICAL :: found !< 198 LOGICAL :: resorted !< 199 200 REAL(wp) :: mean_r !< 201 REAL(wp) :: s_r2 !< 202 REAL(wp) :: s_r3 !< 204 INTEGER(iwp) :: sender !< 205 INTEGER(iwp) :: topo_top_ind !< k index of highest horizontal surface 206 INTEGER(iwp) :: ind(6) !< 207 208 LOGICAL :: found !< 209 LOGICAL :: resorted !< 210 211 REAL(wp) :: mean_r !< 212 REAL(wp) :: s_r2 !< 213 REAL(wp) :: s_r3 !< 203 214 204 215 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: local_pf !< … … 261 272 ENDIF 262 273 ! 274 !-- Set default grid for terrain-following output 275 grid = 's' 276 ! 263 277 !-- Set flag to steer output of radiation, land-surface, or user-defined 264 278 !-- quantities … … 308 322 tend = prt_count 309 323 CALL exchange_horiz( tend, nbgp ) 310 DO i = 1, mask_size_l(mid,1) 311 DO j = 1, mask_size_l(mid,2) 312 DO k = 1, mask_size_l(mid,3) 313 local_pf(i,j,k) = tend(mask_k(mid,k), & 314 mask_j(mid,j),mask_i(mid,i)) 315 ENDDO 316 ENDDO 317 ENDDO 324 IF ( .NOT. mask_surface(mid) ) THEN 325 DO i = 1, mask_size_l(mid,1) 326 DO j = 1, mask_size_l(mid,2) 327 DO k = 1, mask_size_l(mid,3) 328 local_pf(i,j,k) = tend(mask_k(mid,k), & 329 mask_j(mid,j),mask_i(mid,i)) 330 ENDDO 331 ENDDO 332 ENDDO 333 ELSE 334 ! 335 !-- Terrain-following masked output 336 DO i = 1, mask_size_l(mid,1) 337 DO j = 1, mask_size_l(mid,2) 338 ! 339 !-- Get k index of highest horizontal surface 340 topo_top_ind = & 341 get_topography_top_index_ji( mask_j(mid,j), & 342 mask_i(mid,i), & 343 grid ) 344 DO k = 1, mask_size_l(mid,3) 345 kk = MIN( topo_top_ind+mask_k(mid,k), nzt+1 ) 346 local_pf(i,j,k) = & 347 tend(kk,mask_j(mid,j),mask_i(mid,i)) 348 ENDDO 349 ENDDO 350 ENDDO 351 ENDIF 318 352 resorted = .TRUE. 319 353 ELSE … … 354 388 tend = 0.0_wp 355 389 ENDIF 356 DO i = 1, mask_size_l(mid,1) 357 DO j = 1, mask_size_l(mid,2) 358 DO k = 1, mask_size_l(mid,3) 359 local_pf(i,j,k) = tend(mask_k(mid,k), & 360 mask_j(mid,j),mask_i(mid,i)) 361 ENDDO 362 ENDDO 363 ENDDO 390 IF ( .NOT. mask_surface(mid) ) THEN 391 DO i = 1, mask_size_l(mid,1) 392 DO j = 1, mask_size_l(mid,2) 393 DO k = 1, mask_size_l(mid,3) 394 local_pf(i,j,k) = tend(mask_k(mid,k), & 395 mask_j(mid,j),mask_i(mid,i)) 396 ENDDO 397 ENDDO 398 ENDDO 399 ELSE 400 ! 401 !-- Terrain-following masked output 402 DO i = 1, mask_size_l(mid,1) 403 DO j = 1, mask_size_l(mid,2) 404 ! 405 !-- Get k index of highest horizontal surface 406 topo_top_ind = & 407 get_topography_top_index_ji( mask_j(mid,j), & 408 mask_i(mid,i), & 409 grid ) 410 DO k = 1, mask_size_l(mid,3) 411 kk = MIN( topo_top_ind+mask_k(mid,k), nzt+1 ) 412 local_pf(i,j,k) = & 413 tend(kk,mask_j(mid,j),mask_i(mid,i)) 414 ENDDO 415 ENDDO 416 ENDDO 417 ENDIF 364 418 resorted = .TRUE. 365 419 ELSE … … 373 427 to_be_resorted => pt 374 428 ELSE 375 DO i = 1, mask_size_l(mid,1) 376 DO j = 1, mask_size_l(mid,2) 377 DO k = 1, mask_size_l(mid,3) 378 local_pf(i,j,k) = & 379 pt(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) & 380 + lv_d_cp * d_exner(mask_k(mid,k)) * & 381 ql(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) 382 ENDDO 383 ENDDO 384 ENDDO 429 IF ( .NOT. mask_surface(mid) ) THEN 430 DO i = 1, mask_size_l(mid,1) 431 DO j = 1, mask_size_l(mid,2) 432 DO k = 1, mask_size_l(mid,3) 433 local_pf(i,j,k) = & 434 pt(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) & 435 + lv_d_cp * d_exner(mask_k(mid,k)) * & 436 ql(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) 437 ENDDO 438 ENDDO 439 ENDDO 440 ELSE 441 ! 442 !-- Terrain-following masked output 443 DO i = 1, mask_size_l(mid,1) 444 DO j = 1, mask_size_l(mid,2) 445 ! 446 !-- Get k index of highest horizontal surface 447 topo_top_ind = & 448 get_topography_top_index_ji( mask_j(mid,j), & 449 mask_i(mid,i), & 450 grid ) 451 DO k = 1, mask_size_l(mid,3) 452 kk = MIN( topo_top_ind+mask_k(mid,k), nzt+1 ) 453 local_pf(i,j,k) = & 454 pt(kk,mask_j(mid,j),mask_i(mid,i) ) & 455 + lv_d_cp * d_exner(kk) * & 456 ql(kk,mask_j(mid,j),mask_i(mid,i)) 457 ENDDO 458 ENDDO 459 ENDDO 460 ENDIF 385 461 resorted = .TRUE. 386 462 ENDIF … … 447 523 tend = 0.0_wp 448 524 ENDIF 449 DO i = 1, mask_size_l(mid,1) 450 DO j = 1, mask_size_l(mid,2) 451 DO k = 1, mask_size_l(mid,3) 452 local_pf(i,j,k) = tend(mask_k(mid,k), & 453 mask_j(mid,j),mask_i(mid,i)) 454 ENDDO 455 ENDDO 456 ENDDO 525 IF ( .NOT. mask_surface(mid) ) THEN 526 DO i = 1, mask_size_l(mid,1) 527 DO j = 1, mask_size_l(mid,2) 528 DO k = 1, mask_size_l(mid,3) 529 local_pf(i,j,k) = tend(mask_k(mid,k), & 530 mask_j(mid,j),mask_i(mid,i)) 531 ENDDO 532 ENDDO 533 ENDDO 534 ELSE 535 ! 536 !-- Terrain-following masked output 537 DO i = 1, mask_size_l(mid,1) 538 DO j = 1, mask_size_l(mid,2) 539 ! 540 !-- Get k index of highest horizontal surface 541 topo_top_ind = & 542 get_topography_top_index_ji( mask_j(mid,j), & 543 mask_i(mid,i), & 544 grid ) 545 DO k = 1, mask_size_l(mid,3) 546 kk = MIN( topo_top_ind+mask_k(mid,k), nzt+1 ) 547 local_pf(i,j,k) = & 548 tend(kk,mask_j(mid,j),mask_i(mid,i)) 549 ENDDO 550 ENDDO 551 ENDDO 552 ENDIF 457 553 resorted = .TRUE. 458 554 ELSE … … 463 559 CASE ( 'qv' ) 464 560 IF ( av == 0 ) THEN 465 DO i = 1, mask_size_l(mid,1) 466 DO j = 1, mask_size_l(mid,2) 467 DO k = 1, mask_size_l(mid,3) 468 local_pf(i,j,k) = & 469 q(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) - & 470 ql(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) 471 ENDDO 472 ENDDO 473 ENDDO 561 IF ( .NOT. mask_surface(mid) ) THEN 562 DO i = 1, mask_size_l(mid,1) 563 DO j = 1, mask_size_l(mid,2) 564 DO k = 1, mask_size_l(mid,3) 565 local_pf(i,j,k) = & 566 q(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) - & 567 ql(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) 568 ENDDO 569 ENDDO 570 ENDDO 571 ELSE 572 ! 573 !-- Terrain-following masked output 574 DO i = 1, mask_size_l(mid,1) 575 DO j = 1, mask_size_l(mid,2) 576 ! 577 !-- Get k index of highest horizontal surface 578 topo_top_ind = & 579 get_topography_top_index_ji( mask_j(mid,j), & 580 mask_i(mid,i), & 581 grid ) 582 DO k = 1, mask_size_l(mid,3) 583 kk = MIN( topo_top_ind+mask_k(mid,k), nzt+1 ) 584 local_pf(i,j,k) = & 585 q(kk,mask_j(mid,j),mask_i(mid,i)) - & 586 ql(kk,mask_j(mid,j),mask_i(mid,i)) 587 ENDDO 588 ENDDO 589 ENDDO 590 ENDIF 474 591 resorted = .TRUE. 475 592 ELSE … … 527 644 528 645 CASE ( 'w' ) 646 grid = 'w' 529 647 IF ( av == 0 ) THEN 530 648 to_be_resorted => w … … 566 684 !-- Resort the array to be output, if not done above 567 685 IF ( .NOT. resorted ) THEN 568 DO i = 1, mask_size_l(mid,1) 569 DO j = 1, mask_size_l(mid,2) 570 DO k = 1, mask_size_l(mid,3) 571 local_pf(i,j,k) = to_be_resorted(mask_k(mid,k), & 572 mask_j(mid,j),mask_i(mid,i)) 686 IF ( .NOT. mask_surface(mid) ) THEN 687 ! 688 !-- Default masked output 689 DO i = 1, mask_size_l(mid,1) 690 DO j = 1, mask_size_l(mid,2) 691 DO k = 1, mask_size_l(mid,3) 692 local_pf(i,j,k) = to_be_resorted(mask_k(mid,k), & 693 mask_j(mid,j),mask_i(mid,i)) 694 ENDDO 573 695 ENDDO 574 696 ENDDO 575 ENDDO 697 698 ELSE 699 ! 700 !-- Terrain-following masked output 701 DO i = 1, mask_size_l(mid,1) 702 DO j = 1, mask_size_l(mid,2) 703 ! 704 !-- Get k index of highest horizontal surface 705 topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), & 706 mask_i(mid,i), & 707 grid ) 708 ! 709 !-- Save output array 710 DO k = 1, mask_size_l(mid,3) 711 local_pf(i,j,k) = to_be_resorted( & 712 MIN( topo_top_ind+mask_k(mid,k), & 713 nzt+1 ), & 714 mask_j(mid,j), & 715 mask_i(mid,i) ) 716 ENDDO 717 ENDDO 718 ENDDO 719 720 ENDIF 576 721 ENDIF 577 722 … … 710 855 #endif 711 856 857 712 858 END SUBROUTINE data_output_mask -
palm/trunk/SOURCE/init_masks.f90
r3421 r3435 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Add checks for chemistry and radiation model 28 ! Set indices for terrain-following masked output 29 ! 30 ! 3421 2018-10-24 18:39:32Z gronemeier 27 31 ! Renamed output variables 28 32 ! … … 142 146 ONLY: zu, zw 143 147 148 USE bulk_cloud_model_mod, & 149 ONLY: bulk_cloud_model, microphysics_morrison, microphysics_seifert 150 151 USE chemistry_model_mod, & 152 ONLY: chem_check_data_output 153 144 154 USE control_parameters, & 145 ONLY: constant_diffusion, cloud_droplets, & 155 ONLY: air_chemistry, & 156 constant_diffusion, cloud_droplets, & 146 157 data_output_masks, data_output_masks_user, & 147 158 doav, doav_n, domask, domask_no, dz, dz_stretch_level_start, & 148 159 humidity, mask, masks, mask_scale, mask_i, & 149 160 mask_i_global, mask_j, mask_j_global, mask_k, mask_k_global, & 150 mask_loop, mask_size, mask_size_l, mask_start_l, mask_x, & 161 mask_k_over_surface, & 162 mask_loop, mask_size, mask_size_l, mask_start_l, & 163 mask_surface, mask_x, & 151 164 mask_x_loop, mask_xyz_dimension, mask_y, mask_y_loop, mask_z, & 152 165 mask_z_loop, max_masks, message_string, mid, & 153 166 passive_scalar, ocean_mode, varnamelength 154 167 155 156 168 USE grid_variables, & 157 169 ONLY: dx, dy … … 162 174 USE kinds 163 175 164 USE bulk_cloud_model_mod, &165 ONLY: bulk_cloud_model, microphysics_morrison, microphysics_seifert166 167 176 USE netcdf_interface, & 168 177 ONLY: domask_unit, netcdf_data_format … … 172 181 173 182 USE pegrid 183 184 USE radiation_model_mod, & 185 ONLY: radiation, radiation_check_data_output 174 186 175 187 IMPLICIT NONE … … 181 193 CHARACTER (LEN=varnamelength), DIMENSION(max_masks,100) :: do_mask_user !< 182 194 195 INTEGER(iwp) :: count !< counting masking indices along a dimension 183 196 INTEGER(iwp) :: i !< 184 197 INTEGER(iwp) :: ilen !< … … 187 200 INTEGER(iwp) :: j !< 188 201 INTEGER(iwp) :: k !< 202 INTEGER(iwp) :: m !< mask index 189 203 INTEGER(iwp) :: n !< 190 204 INTEGER(iwp) :: sender !< … … 232 246 mask (mid,2,:) = mask_y(mid,:) 233 247 mask (mid,3,:) = mask_z(mid,:) 234 248 ! 249 !-- Flag a mask as terrain following 250 IF ( mask_k_over_surface(mid,1) /= -1_iwp ) THEN 251 mask_surface(mid) = .TRUE. 252 ENDIF 253 235 254 IF ( mask_x_loop(mid,1) == -1.0_wp .AND. mask_x_loop(mid,2) == -1.0_wp& 236 255 .AND. mask_x_loop(mid,3) == -1.0_wp ) THEN … … 456 475 457 476 CASE DEFAULT 477 458 478 CALL user_check_data_output( var, unit ) 479 480 IF ( unit == 'illegal' .AND. air_chemistry & 481 .AND. (var(1:3) == 'kc_' .OR. var(1:3) == 'em_') ) THEN 482 CALL chem_check_data_output( var, unit, 0, 0, 0 ) 483 ENDIF 484 485 IF ( unit == 'illegal' ) THEN 486 CALL radiation_check_data_output( var, unit, 0, 0, 0 ) 487 ENDIF 459 488 460 489 IF ( unit == 'illegal' ) THEN … … 505 534 CALL set_mask_locations( 1, dx, 'dx', nx, 'nx', nxl, nxr ) 506 535 CALL set_mask_locations( 2, dy, 'dy', ny, 'ny', nys, nyn ) 507 CALL set_mask_locations( 3, dz(1), 'dz', nz, 'nz', nzb, nzt ) 536 IF ( .NOT. mask_surface(mid) ) THEN 537 CALL set_mask_locations( 3, dz(1), 'dz', nz, 'nz', nzb, nzt ) 538 ELSE 539 ! 540 !-- Set vertical mask locations and size in case of terrain-following 541 !-- output 542 count = 0 543 DO WHILE ( mask_k_over_surface(mid, count+1) >= 0 ) 544 m = mask_k_over_surface(mid, count+1) 545 IF ( m > nz+1 ) THEN 546 WRITE ( message_string, '(I3,A,I3,A,I1,3A,I3)' ) & 547 m,' in mask ',mid,' along dimension ', 3, & 548 ' exceeds (nz+1) = ',nz+1 549 CALL message( 'init_masks', 'PA0331', 1, 2, 0, 6, 0 ) 550 ENDIF 551 count = count + 1 552 mask_k(mid,count) = mask_k_over_surface(mid, count) 553 IF ( count == mask_xyz_dimension ) EXIT 554 ENDDO 555 mask_start_l(mid,3) = 1 556 mask_size(mid,3) = count 557 mask_size_l(mid,3) = count 558 ENDIF 508 559 ! 509 560 !-- Set global masks along all three dimensions (required by -
palm/trunk/SOURCE/modules.f90
r3422 r3435 25 25 ! ----------------- 26 26 ! $Id$ 27 ! +mask_k_over_surface, mask_surface 28 ! 29 ! 3422 2018-10-24 19:01:57Z gronemeier 27 30 ! bugfix: increase number of blanks in output string 28 31 ! … … 1283 1286 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: mask_j_global !< global grid index of masked output point on y-dimension 1284 1287 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: mask_k_global !< global grid index of masked output point on z-dimension 1288 1289 INTEGER(iwp), DIMENSION(max_masks,mask_xyz_dimension) :: mask_k_over_surface = -1 !< namelist parameter, k index of height over surface 1285 1290 1286 1291 LOGICAL :: agent_time_unlimited = .FALSE. !< namelist parameter … … 1393 1398 LOGICAL :: data_output_xz(0:1) = .FALSE. !< output of xz cross-section data? 1394 1399 LOGICAL :: data_output_yz(0:1) = .FALSE. !< output of yz cross-section data? 1400 1401 LOGICAL, DIMENSION(max_masks) :: mask_surface = .FALSE. !< flag for surface-following masked output 1395 1402 1396 1403 REAL(wp) :: advected_distance_x = 0.0_wp !< advected distance of model domain along x -
palm/trunk/SOURCE/netcdf_interface_mod.f90
r3421 r3435 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Bugfix: corrected order of calls to define_netcdf_grid for masked output 28 ! Add vertical dimensions to masked output in case of terrain-following output 29 ! 30 ! 3421 2018-10-24 18:39:32Z gronemeier 27 31 ! Bugfix: move ocean output variables to ocean_mod 28 32 ! Renamed output variables … … 589 593 do3d_time_count, domask_time_count, end_time, land_surface, & 590 594 mask_size_l, mask_i, mask_i_global, mask_j, mask_j_global, & 591 mask_k_global, message_string, mid, ntdim_2d_xy, ntdim_2d_xz, & 595 mask_k_global, mask_surface, & 596 message_string, mid, ntdim_2d_xy, ntdim_2d_xz, & 592 597 ntdim_2d_yz, ntdim_3d, nz_do3d, ocean_mode, plant_canopy, & 593 598 run_description_header, section, simulated_time, & … … 873 878 ! 874 879 !-- Define spatial dimensions and coordinates: 875 !-- Define vertical coordinate grid (zu grid) 876 CALL netcdf_create_dim( id_set_mask(mid,av), 'zu_3d', & 877 mask_size(mid,3), id_dim_zu_mask(mid,av), & 878 470 ) 879 CALL netcdf_create_var( id_set_mask(mid,av), & 880 (/ id_dim_zu_mask(mid,av) /), 'zu_3d', & 881 NF90_DOUBLE, id_var_zu_mask(mid,av), & 882 'meters', '', 471, 472, 000 ) 883 ! 884 !-- Define vertical coordinate grid (zw grid) 885 CALL netcdf_create_dim( id_set_mask(mid,av), 'zw_3d', & 886 mask_size(mid,3), id_dim_zw_mask(mid,av), & 887 473 ) 888 CALL netcdf_create_var( id_set_mask(mid,av), & 889 (/ id_dim_zw_mask(mid,av) /), 'zw_3d', & 890 NF90_DOUBLE, id_var_zw_mask(mid,av), & 891 'meters', '', 474, 475, 000 ) 880 IF ( mask_surface(mid) ) THEN 881 ! 882 !-- In case of terrain-following output, the vertical dimensions are 883 !-- indices, not meters 884 CALL netcdf_create_dim( id_set_mask(mid,av), 'ku_above_surf', & 885 mask_size(mid,3), id_dim_zu_mask(mid,av), & 886 470 ) 887 CALL netcdf_create_var( id_set_mask(mid,av), & 888 (/ id_dim_zu_mask(mid,av) /), & 889 'ku_above_surf', & 890 NF90_DOUBLE, id_var_zu_mask(mid,av), & 891 '1', 'grid point above terrain', & 892 471, 472, 000 ) 893 CALL netcdf_create_dim( id_set_mask(mid,av), 'kw_above_surf', & 894 mask_size(mid,3), id_dim_zw_mask(mid,av), & 895 473 ) 896 CALL netcdf_create_var( id_set_mask(mid,av), & 897 (/ id_dim_zw_mask(mid,av) /), & 898 'kw_above_surf', & 899 NF90_DOUBLE, id_var_zw_mask(mid,av), & 900 '1', 'grid point above terrain', & 901 474, 475, 000 ) 902 ELSE 903 ! 904 !-- Define vertical coordinate grid (zu grid) 905 CALL netcdf_create_dim( id_set_mask(mid,av), 'zu_3d', & 906 mask_size(mid,3), id_dim_zu_mask(mid,av), & 907 470 ) 908 CALL netcdf_create_var( id_set_mask(mid,av), & 909 (/ id_dim_zu_mask(mid,av) /), 'zu_3d', & 910 NF90_DOUBLE, id_var_zu_mask(mid,av), & 911 'meters', '', 471, 472, 000 ) 912 ! 913 !-- Define vertical coordinate grid (zw grid) 914 CALL netcdf_create_dim( id_set_mask(mid,av), 'zw_3d', & 915 mask_size(mid,3), id_dim_zw_mask(mid,av), & 916 473 ) 917 CALL netcdf_create_var( id_set_mask(mid,av), & 918 (/ id_dim_zw_mask(mid,av) /), 'zw_3d', & 919 NF90_DOUBLE, id_var_zw_mask(mid,av), & 920 'meters', '', 474, 475, 000 ) 921 ENDIF 892 922 ! 893 923 !-- Define x-axis (for scalar position) … … 1068 1098 ! 1069 1099 !-- Check for quantities defined in other modules 1100 CALL tcm_define_netcdf_grid( domask( mid,av,i), found, & 1101 grid_x, grid_y, grid_z ) 1102 1070 1103 IF ( .NOT. found .AND. air_chemistry ) THEN 1071 1104 CALL chem_define_netcdf_grid( domask(mid,av,i), found, & … … 1105 1138 grid_z ) 1106 1139 ENDIF 1107 1108 CALL tcm_define_netcdf_grid( domask( mid,av,i), found, &1109 grid_x, grid_y, grid_z )1110 1111 1140 ! 1112 1141 !-- Now check for user-defined quantities … … 1343 1372 ALLOCATE( netcdf_data(mask_size(mid,3)) ) 1344 1373 1345 netcdf_data = zu( mask_k_global(mid,:mask_size(mid,3)) ) 1346 1347 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zu_mask(mid,av), & 1348 netcdf_data, start = (/ 1 /), & 1349 count = (/ mask_size(mid,3) /) ) 1350 CALL netcdf_handle_error( 'netcdf_define_header', 503 ) 1351 1352 netcdf_data = zw( mask_k_global(mid,:mask_size(mid,3)) ) 1353 1354 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zw_mask(mid,av), & 1355 netcdf_data, start = (/ 1 /), & 1356 count = (/ mask_size(mid,3) /) ) 1357 CALL netcdf_handle_error( 'netcdf_define_header', 504 ) 1374 IF ( mask_surface(mid) ) THEN 1375 1376 netcdf_data = mask_k_global(mid,:mask_size(mid,3)) 1377 1378 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zu_mask(mid,av), & 1379 netcdf_data, start = (/ 1 /), & 1380 count = (/ mask_size(mid,3) /) ) 1381 CALL netcdf_handle_error( 'netcdf_define_header', 503 ) 1382 1383 netcdf_data = mask_k_global(mid,:mask_size(mid,3)) 1384 1385 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zw_mask(mid,av), & 1386 netcdf_data, start = (/ 1 /), & 1387 count = (/ mask_size(mid,3) /) ) 1388 CALL netcdf_handle_error( 'netcdf_define_header', 504 ) 1389 1390 ELSE 1391 1392 netcdf_data = zu( mask_k_global(mid,:mask_size(mid,3)) ) 1393 1394 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zu_mask(mid,av), & 1395 netcdf_data, start = (/ 1 /), & 1396 count = (/ mask_size(mid,3) /) ) 1397 CALL netcdf_handle_error( 'netcdf_define_header', 503 ) 1398 1399 netcdf_data = zw( mask_k_global(mid,:mask_size(mid,3)) ) 1400 1401 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zw_mask(mid,av), & 1402 netcdf_data, start = (/ 1 /), & 1403 count = (/ mask_size(mid,3) /) ) 1404 CALL netcdf_handle_error( 'netcdf_define_header', 504 ) 1405 1406 ENDIF 1358 1407 1359 1408 DEALLOCATE( netcdf_data ) -
palm/trunk/SOURCE/parin.f90
r3421 r3435 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Add mask_k_over_surface 28 ! 29 ! 3421 2018-10-24 18:39:32Z gronemeier 27 30 ! Added module for data output at surfaces 28 31 ! … … 698 701 dt_domask, dt_dopr, dt_dopr_listing, dt_dots, dt_do2d_xy, & 699 702 dt_do2d_xz, dt_do2d_yz, dt_do3d, dt_max, dt_restart, & 700 dt_run_control,end_time, force_print_header, mask_scale_x, & 703 dt_run_control,end_time, force_print_header, mask_k_over_surface, & 704 mask_scale_x, & 701 705 mask_scale_y, mask_scale_z, mask_x, mask_y, mask_z, mask_x_loop, & 702 706 mask_y_loop, mask_z_loop, netcdf_data_format, netcdf_deflate, & … … 719 723 dt_domask, dt_dopr, dt_dopr_listing, dt_dots, dt_do2d_xy, & 720 724 dt_do2d_xz, dt_do2d_yz, dt_do3d, dt_max, dt_restart, & 721 dt_run_control,end_time, force_print_header, mask_scale_x, & 725 dt_run_control,end_time, force_print_header, mask_k_over_surface, & 726 mask_scale_x, & 722 727 mask_scale_y, mask_scale_z, mask_x, mask_y, mask_z, mask_x_loop, & 723 728 mask_y_loop, mask_z_loop, netcdf_data_format, netcdf_deflate, & -
palm/trunk/SOURCE/radiation_model_mod.f90
r3424 r3435 28 28 ! ----------------- 29 29 ! $Id$ 30 ! - workaround: return unit=illegal in check_data_output for certain variables 31 ! when check called from init_masks 32 ! - Use pointer in masked output to reduce code redundancies 33 ! - Add terrain-following masked output 34 ! 35 ! 3424 2018-10-25 07:29:10Z gronemeier 30 36 ! bugfix: add rad_lw_in, rad_lw_out, rad_sw_out to radiation_check_data_output 31 37 ! … … 1250 1256 'rrtm_asdir*', 'rad_lw_in*', 'rad_lw_out*', 'rad_sw_in*', & 1251 1257 'rad_sw_out*') 1258 IF ( i == 0 .AND. ilen == 0 .AND. k == 0) THEN 1259 ! Workaround for masked output (calls with i=ilen=k=0) 1260 unit = 'illegal' 1261 RETURN 1262 ENDIF 1252 1263 IF ( k == 0 .OR. data_output(i)(ilen-2:ilen) /= '_xy' ) THEN 1253 1264 message_string = 'illegal value for data_output: "' // & … … 1281 1292 1282 1293 CASE ( 'rad_mrt', 'rad_mrt_sw', 'rad_mrt_lw' ) 1294 1295 IF ( i == 0 .AND. ilen == 0 .AND. k == 0) THEN 1296 ! Workaround for masked output (calls with i=ilen=k=0) 1297 unit = 'illegal' 1298 RETURN 1299 ENDIF 1300 1283 1301 IF ( .NOT. radiation ) THEN 1284 1302 message_string = 'output of "' // TRIM( var ) // '" require'& … … 8890 8908 found = .TRUE. 8891 8909 8892 8893 8910 ! 8894 8911 !-- Check for the grid … … 9634 9651 CHARACTER (LEN=*) :: variable !< 9635 9652 9636 INTEGER(iwp) :: av !< 9637 INTEGER(iwp) :: i !< 9638 INTEGER(iwp) :: j !< 9639 INTEGER(iwp) :: k !< 9640 9641 LOGICAL :: found !< 9653 CHARACTER(LEN=5) :: grid !< flag to distinquish between staggered grids 9654 9655 INTEGER(iwp) :: av !< 9656 INTEGER(iwp) :: i !< 9657 INTEGER(iwp) :: j !< 9658 INTEGER(iwp) :: k !< 9659 INTEGER(iwp) :: topo_top_ind !< k index of highest horizontal surface 9660 9661 LOGICAL :: found !< true if output array was found 9662 LOGICAL :: resorted !< true if array is resorted 9663 9642 9664 9643 9665 REAL(wp), & … … 9645 9667 local_pf !< 9646 9668 9647 9648 found = .TRUE. 9669 REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to array which needs to be resorted for output 9670 9671 9672 found = .TRUE. 9673 grid = 's' 9674 resorted = .FALSE. 9649 9675 9650 9676 SELECT CASE ( TRIM( variable ) ) … … 9653 9679 CASE ( 'rad_lw_in' ) 9654 9680 IF ( av == 0 ) THEN 9655 DO i = 1, mask_size_l(mid,1) 9656 DO j = 1, mask_size_l(mid,2) 9657 DO k = 1, mask_size_l(mid,3) 9658 local_pf(i,j,k) = rad_lw_in(mask_k(mid,k), & 9659 mask_j(mid,j),mask_i(mid,i)) 9660 ENDDO 9661 ENDDO 9662 ENDDO 9681 to_be_resorted => rad_lw_in 9663 9682 ELSE 9664 DO i = 1, mask_size_l(mid,1) 9665 DO j = 1, mask_size_l(mid,2) 9666 DO k = 1, mask_size_l(mid,3) 9667 local_pf(i,j,k) = rad_lw_in_av(mask_k(mid,k), & 9668 mask_j(mid,j),mask_i(mid,i)) 9669 ENDDO 9683 to_be_resorted => rad_lw_in_av 9684 ENDIF 9685 9686 CASE ( 'rad_lw_out' ) 9687 IF ( av == 0 ) THEN 9688 to_be_resorted => rad_lw_out 9689 ELSE 9690 to_be_resorted => rad_lw_out_av 9691 ENDIF 9692 9693 CASE ( 'rad_lw_cs_hr' ) 9694 IF ( av == 0 ) THEN 9695 to_be_resorted => rad_lw_cs_hr 9696 ELSE 9697 to_be_resorted => rad_lw_cs_hr_av 9698 ENDIF 9699 9700 CASE ( 'rad_lw_hr' ) 9701 IF ( av == 0 ) THEN 9702 to_be_resorted => rad_lw_hr 9703 ELSE 9704 to_be_resorted => rad_lw_hr_av 9705 ENDIF 9706 9707 CASE ( 'rad_sw_in' ) 9708 IF ( av == 0 ) THEN 9709 to_be_resorted => rad_sw_in 9710 ELSE 9711 to_be_resorted => rad_sw_in_av 9712 ENDIF 9713 9714 CASE ( 'rad_sw_out' ) 9715 IF ( av == 0 ) THEN 9716 to_be_resorted => rad_sw_out 9717 ELSE 9718 to_be_resorted => rad_sw_out_av 9719 ENDIF 9720 9721 CASE ( 'rad_sw_cs_hr' ) 9722 IF ( av == 0 ) THEN 9723 to_be_resorted => rad_sw_cs_hr 9724 ELSE 9725 to_be_resorted => rad_sw_cs_hr_av 9726 ENDIF 9727 9728 CASE ( 'rad_sw_hr' ) 9729 IF ( av == 0 ) THEN 9730 to_be_resorted => rad_sw_hr 9731 ELSE 9732 to_be_resorted => rad_sw_hr_av 9733 ENDIF 9734 9735 CASE DEFAULT 9736 found = .FALSE. 9737 9738 END SELECT 9739 9740 ! 9741 !-- Resort the array to be output, if not done above 9742 IF ( .NOT. resorted ) THEN 9743 IF ( .NOT. mask_surface(mid) ) THEN 9744 ! 9745 !-- Default masked output 9746 DO i = 1, mask_size_l(mid,1) 9747 DO j = 1, mask_size_l(mid,2) 9748 DO k = 1, mask_size_l(mid,3) 9749 local_pf(i,j,k) = to_be_resorted(mask_k(mid,k), & 9750 mask_j(mid,j),mask_i(mid,i)) 9670 9751 ENDDO 9671 9752 ENDDO 9672 ENDIF 9673 9674 CASE ( 'rad_lw_out' ) 9675 IF ( av == 0 ) THEN 9676 DO i = 1, mask_size_l(mid,1) 9677 DO j = 1, mask_size_l(mid,2) 9678 DO k = 1, mask_size_l(mid,3) 9679 local_pf(i,j,k) = rad_lw_out(mask_k(mid,k), & 9680 mask_j(mid,j),mask_i(mid,i)) 9681 ENDDO 9682 ENDDO 9683 ENDDO 9684 ELSE 9685 DO i = 1, mask_size_l(mid,1) 9686 DO j = 1, mask_size_l(mid,2) 9687 DO k = 1, mask_size_l(mid,3) 9688 local_pf(i,j,k) = rad_lw_out_av(mask_k(mid,k), & 9689 mask_j(mid,j),mask_i(mid,i)) 9690 ENDDO 9753 ENDDO 9754 9755 ELSE 9756 ! 9757 !-- Terrain-following masked output 9758 DO i = 1, mask_size_l(mid,1) 9759 DO j = 1, mask_size_l(mid,2) 9760 ! 9761 !-- Get k index of highest horizontal surface 9762 topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), & 9763 mask_i(mid,i), & 9764 grid ) 9765 ! 9766 !-- Save output array 9767 DO k = 1, mask_size_l(mid,3) 9768 local_pf(i,j,k) = to_be_resorted( & 9769 MIN( topo_top_ind+mask_k(mid,k), & 9770 nzt+1 ), & 9771 mask_j(mid,j), & 9772 mask_i(mid,i) ) 9691 9773 ENDDO 9692 9774 ENDDO 9693 ENDIF 9694 9695 CASE ( 'rad_lw_cs_hr' ) 9696 IF ( av == 0 ) THEN 9697 DO i = 1, mask_size_l(mid,1) 9698 DO j = 1, mask_size_l(mid,2) 9699 DO k = 1, mask_size_l(mid,3) 9700 local_pf(i,j,k) = rad_lw_cs_hr(mask_k(mid,k), & 9701 mask_j(mid,j),mask_i(mid,i)) 9702 ENDDO 9703 ENDDO 9704 ENDDO 9705 ELSE 9706 DO i = 1, mask_size_l(mid,1) 9707 DO j = 1, mask_size_l(mid,2) 9708 DO k = 1, mask_size_l(mid,3) 9709 local_pf(i,j,k) = rad_lw_cs_hr_av(mask_k(mid,k), & 9710 mask_j(mid,j),mask_i(mid,i)) 9711 ENDDO 9712 ENDDO 9713 ENDDO 9714 ENDIF 9715 9716 CASE ( 'rad_lw_hr' ) 9717 IF ( av == 0 ) THEN 9718 DO i = 1, mask_size_l(mid,1) 9719 DO j = 1, mask_size_l(mid,2) 9720 DO k = 1, mask_size_l(mid,3) 9721 local_pf(i,j,k) = rad_lw_hr(mask_k(mid,k), & 9722 mask_j(mid,j),mask_i(mid,i)) 9723 ENDDO 9724 ENDDO 9725 ENDDO 9726 ELSE 9727 DO i = 1, mask_size_l(mid,1) 9728 DO j = 1, mask_size_l(mid,2) 9729 DO k = 1, mask_size_l(mid,3) 9730 local_pf(i,j,k) = rad_lw_hr_av(mask_k(mid,k), & 9731 mask_j(mid,j),mask_i(mid,i)) 9732 ENDDO 9733 ENDDO 9734 ENDDO 9735 ENDIF 9736 9737 CASE ( 'rad_sw_in' ) 9738 IF ( av == 0 ) THEN 9739 DO i = 1, mask_size_l(mid,1) 9740 DO j = 1, mask_size_l(mid,2) 9741 DO k = 1, mask_size_l(mid,3) 9742 local_pf(i,j,k) = rad_sw_in(mask_k(mid,k), & 9743 mask_j(mid,j),mask_i(mid,i)) 9744 ENDDO 9745 ENDDO 9746 ENDDO 9747 ELSE 9748 DO i = 1, mask_size_l(mid,1) 9749 DO j = 1, mask_size_l(mid,2) 9750 DO k = 1, mask_size_l(mid,3) 9751 local_pf(i,j,k) = rad_sw_in_av(mask_k(mid,k), & 9752 mask_j(mid,j),mask_i(mid,i)) 9753 ENDDO 9754 ENDDO 9755 ENDDO 9756 ENDIF 9757 9758 CASE ( 'rad_sw_out' ) 9759 IF ( av == 0 ) THEN 9760 DO i = 1, mask_size_l(mid,1) 9761 DO j = 1, mask_size_l(mid,2) 9762 DO k = 1, mask_size_l(mid,3) 9763 local_pf(i,j,k) = rad_sw_out(mask_k(mid,k), & 9764 mask_j(mid,j),mask_i(mid,i)) 9765 ENDDO 9766 ENDDO 9767 ENDDO 9768 ELSE 9769 DO i = 1, mask_size_l(mid,1) 9770 DO j = 1, mask_size_l(mid,2) 9771 DO k = 1, mask_size_l(mid,3) 9772 local_pf(i,j,k) = rad_sw_out_av(mask_k(mid,k), & 9773 mask_j(mid,j),mask_i(mid,i)) 9774 ENDDO 9775 ENDDO 9776 ENDDO 9777 ENDIF 9778 9779 CASE ( 'rad_sw_cs_hr' ) 9780 IF ( av == 0 ) THEN 9781 DO i = 1, mask_size_l(mid,1) 9782 DO j = 1, mask_size_l(mid,2) 9783 DO k = 1, mask_size_l(mid,3) 9784 local_pf(i,j,k) = rad_sw_cs_hr(mask_k(mid,k), & 9785 mask_j(mid,j),mask_i(mid,i)) 9786 ENDDO 9787 ENDDO 9788 ENDDO 9789 ELSE 9790 DO i = 1, mask_size_l(mid,1) 9791 DO j = 1, mask_size_l(mid,2) 9792 DO k = 1, mask_size_l(mid,3) 9793 local_pf(i,j,k) = rad_sw_cs_hr_av(mask_k(mid,k), & 9794 mask_j(mid,j),mask_i(mid,i)) 9795 ENDDO 9796 ENDDO 9797 ENDDO 9798 ENDIF 9799 9800 CASE ( 'rad_sw_hr' ) 9801 IF ( av == 0 ) THEN 9802 DO i = 1, mask_size_l(mid,1) 9803 DO j = 1, mask_size_l(mid,2) 9804 DO k = 1, mask_size_l(mid,3) 9805 local_pf(i,j,k) = rad_sw_hr(mask_k(mid,k), & 9806 mask_j(mid,j),mask_i(mid,i)) 9807 ENDDO 9808 ENDDO 9809 ENDDO 9810 ELSE 9811 DO i = 1, mask_size_l(mid,1) 9812 DO j = 1, mask_size_l(mid,2) 9813 DO k = 1, mask_size_l(mid,3) 9814 local_pf(i,j,k) = rad_sw_hr_av(mask_k(mid,k), & 9815 mask_j(mid,j),mask_i(mid,i)) 9816 ENDDO 9817 ENDDO 9818 ENDDO 9819 ENDIF 9820 9821 CASE DEFAULT 9822 found = .FALSE. 9823 9824 END SELECT 9775 ENDDO 9776 9777 ENDIF 9778 ENDIF 9779 9825 9780 9826 9781 -
palm/trunk/SOURCE/urban_surface_mod.f90
r3418 r3435 28 28 ! ----------------- 29 29 ! $Id$ 30 ! Bugfix: allocate gamma_w_green_sat until nzt_wall+1 31 ! 32 ! 3418 2018-10-24 16:07:39Z kanani 30 33 ! (rvtils, srissman) 31 34 ! -Updated building databse, two green roof types (ind_green_type_roof) … … 1376 1379 ALLOCATE ( surf_usm_h%alpha_vg_green(1:surf_usm_h%ns) ) 1377 1380 ALLOCATE ( surf_usm_h%l_vg_green(1:surf_usm_h%ns) ) 1378 ALLOCATE ( surf_usm_h%gamma_w_green_sat(nzb_wall:nzt_wall ,1:surf_usm_h%ns) )1381 ALLOCATE ( surf_usm_h%gamma_w_green_sat(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 1379 1382 ALLOCATE ( surf_usm_h%lambda_w_green(nzb_wall:nzt_wall,1:surf_usm_h%ns) ) 1380 1383 ALLOCATE ( surf_usm_h%gamma_w_green(nzb_wall:nzt_wall,1:surf_usm_h%ns) ) -
palm/trunk/SOURCE/user_data_output_mask.f90
r2718 r3435 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Add terrain-following output 28 ! 29 ! 2718 2018-01-02 08:49:38Z maronga 27 30 ! Corrected "Former revisions" section 28 31 ! … … 62 65 USE kinds 63 66 67 USE surface_mod, & 68 ONLY: get_topography_top_index_ji 69 64 70 USE user 65 71 66 72 IMPLICIT NONE 67 73 68 CHARACTER (LEN=*) :: variable !< 74 CHARACTER (LEN=*) :: variable !< 75 CHARACTER (LEN=5) :: grid !< flag to distinquish between staggered grids 69 76 70 INTEGER(iwp) :: av !< 71 INTEGER(iwp) :: i !< 72 INTEGER(iwp) :: j !< 73 INTEGER(iwp) :: k !< 77 INTEGER(iwp) :: av !< 78 INTEGER(iwp) :: i !< 79 INTEGER(iwp) :: j !< 80 INTEGER(iwp) :: k !< 81 INTEGER(iwp) :: topo_top_ind !< k index of highest horizontal surface 74 82 75 LOGICAL :: found !<83 LOGICAL :: found !< 76 84 77 85 REAL(wp), & … … 81 89 82 90 found = .TRUE. 91 grid = 's' 83 92 84 93 SELECT CASE ( TRIM( variable ) ) … … 90 99 ! CASE ( 'u2' ) 91 100 ! IF ( av == 0 ) THEN 92 ! DO i = 1, mask_size_l(mid,1) 93 ! DO j = 1, mask_size_l(mid,2) 94 ! DO k = 1, mask_size_l(mid,3) 95 ! local_pf(i,j,k) = u2(mask_k(mid,k), & 96 ! mask_j(mid,j),mask_i(mid,i)) 101 ! IF ( .NOT. mask_surface(mid) ) THEN 102 !! 103 !!-- Default masked output 104 ! DO i = 1, mask_size_l(mid,1) 105 ! DO j = 1, mask_size_l(mid,2) 106 ! DO k = 1, mask_size_l(mid,3) 107 ! local_pf(i,j,k) = u2(mask_k(mid,k), & 108 ! mask_j(mid,j), & 109 ! mask_i(mid,i)) 110 ! ENDDO 97 111 ! ENDDO 98 112 ! ENDDO 99 ! ENDDO 100 ! ELSE 101 ! DO i = 1, mask_size_l(mid,1) 102 ! DO j = 1, mask_size_l(mid,2) 103 ! DO k = 1, mask_size_l(mid,3) 104 ! local_pf(i,j,k) = u2_av(mask_k(mid,k), & 105 ! mask_j(mid,j),mask_i(mid,i)) 113 ! ELSE 114 !! 115 !!-- Terrain-following masked output 116 ! DO i = 1, mask_size_l(mid,1) 117 ! DO j = 1, mask_size_l(mid,2) 118 !! 119 !!-- Get k index of highest horizontal surface 120 ! topo_top_ind = get_topography_top_index_ji( & 121 ! mask_j(mid,j), & 122 ! mask_i(mid,i), & 123 ! grid ) 124 !! 125 !!-- Save output array 126 ! DO k = 1, mask_size_l(mid,3) 127 ! local_pf(i,j,k) = u2(MIN( topo_top_ind+mask_k(mid,k),& 128 ! nzt+1 ), & 129 ! mask_j(mid,j), & 130 ! mask_i(mid,i) ) 131 ! ENDDO 106 132 ! ENDDO 107 133 ! ENDDO 108 ! ENDDO 134 ! ENDIF 135 ! ELSE 136 ! IF ( .NOT. mask_surface(mid) ) THEN 137 !! 138 !!-- Default masked output 139 ! DO i = 1, mask_size_l(mid,1) 140 ! DO j = 1, mask_size_l(mid,2) 141 ! DO k = 1, mask_size_l(mid,3) 142 ! local_pf(i,j,k) = u2_av(mask_k(mid,k), & 143 ! mask_j(mid,j), & 144 ! mask_i(mid,i) ) 145 ! ENDDO 146 ! ENDDO 147 ! ENDDO 148 ! ELSE 149 !! 150 !!-- Terrain-following masked output 151 ! DO i = 1, mask_size_l(mid,1) 152 ! DO j = 1, mask_size_l(mid,2) 153 !! 154 !!-- Get k index of highest horizontal surface 155 ! topo_top_ind = get_topography_top_index_ji( & 156 ! mask_j(mid,j), & 157 ! mask_i(mid,i), & 158 ! grid ) 159 !! 160 !!-- Save output array 161 ! DO k = 1, mask_size_l(mid,3) 162 ! local_pf(i,j,k) = u2_av( & 163 ! MIN( topo_top_ind+mask_k(mid,k),& 164 ! nzt+1 ), & 165 ! mask_j(mid,j), & 166 ! mask_i(mid,i) ) 167 ! ENDDO 168 ! ENDDO 169 ! ENDDO 170 ! ENDIF 109 171 ! ENDIF 110 172
Note: See TracChangeset
for help on using the changeset viewer.
