Changeset 3435 for palm/trunk/SOURCE/data_output_mask.f90
- Timestamp:
- Oct 26, 2018 6:25:44 PM (5 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/data_output_mask.f90 (modified) (13 diffs)
Legend:
- Unmodified
- Added
- Removed
-
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
Note: See TracChangeset
for help on using the changeset viewer.
