Changeset 4167 for palm/trunk/SOURCE/data_output_mask.f90
- Timestamp:
- Aug 16, 2019 11:01:48 AM (5 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE
- Property svn:mergeinfo changed
-
palm/trunk/SOURCE/data_output_mask.f90
r4069 r4167 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Changed behaviour of masked output over surface to follow terrain and ignore 28 ! buildings (J.Resler, T.Gronemeier) 29 ! 30 ! 4069 2019-07-01 14:05:51Z Giersch 27 31 ! Masked output running index mid has been introduced as a local variable to 28 32 ! avoid runtime error (Loop variable has been modified) in time_integration … … 194 198 195 199 USE indices, & 196 ONLY: nbgp, nxl, nxr, nyn, nys, nzb, nzt 200 ONLY: nbgp, nxl, nxr, nyn, nys, nzb, nzt, wall_flags_0 197 201 198 202 USE kinds … … 204 208 205 209 USE netcdf_interface, & 206 ONLY: id_set_mask, id_var_domask, id_var_time_mask, nc_stat,&207 n etcdf_data_format, netcdf_handle_error210 ONLY: fill_value, id_set_mask, id_var_domask, id_var_time_mask, & 211 nc_stat, netcdf_data_format, netcdf_handle_error 208 212 209 213 USE particle_attributes, & … … 218 222 USE salsa_mod, & 219 223 ONLY: salsa_data_output_mask 220 221 USE surface_mod, & 222 ONLY : get_topography_top_index_ji 224 223 225 224 226 IMPLICIT NONE … … 232 234 INTEGER(iwp) :: j !< loop index 233 235 INTEGER(iwp) :: k !< loop index 236 INTEGER(iwp) :: im !< loop index for masked variables 237 INTEGER(iwp) :: jm !< loop index for masked variables 234 238 INTEGER(iwp) :: kk !< vertical index 235 239 INTEGER(iwp) :: mid !< masked output running index … … 237 241 INTEGER(iwp) :: netcdf_data_format_save !< value of netcdf_data_format 238 242 INTEGER(iwp) :: sender !< PE id of sending PE 239 INTEGER(iwp) :: topo_top_ind !< k index of highest horizontalsurface243 INTEGER(iwp) :: ktt !< k index of highest terrain surface 240 244 INTEGER(iwp) :: ind(6) !< index limits (lower/upper bounds) of array 'local_2d' 241 245 … … 309 313 grid = 's' 310 314 ! 311 !-- Set flag to steer output of radiation, land-surface, or user-defined312 !-- quantities313 found = .FALSE.314 !315 315 !-- Store the variable chosen. 316 316 resorted = .FALSE. … … 370 370 DO i = 1, mask_size_l(mid,1) 371 371 DO j = 1, mask_size_l(mid,2) 372 ! 373 !-- Get k index of highest horizontal surface 374 topo_top_ind = & 375 get_topography_top_index_ji( mask_j(mid,j), & 376 mask_i(mid,i), & 377 grid ) 372 !-- Get k index of the highest terraing surface 373 im = mask_i(mid,i) 374 jm = mask_j(mid,j) 375 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1 378 376 DO k = 1, mask_size_l(mid,3) 379 kk = MIN( topo_top_ind+mask_k(mid,k), nzt+1 ) 380 local_pf(i,j,k) = & 381 tend(kk,mask_j(mid,j),mask_i(mid,i)) 377 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) 378 !-- Set value if not in building 379 IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN 380 local_pf(i,j,k) = fill_value 381 ELSE 382 local_pf(i,j,k) = tend(kk,jm,im) 383 ENDIF 382 384 ENDDO 383 385 ENDDO … … 436 438 DO i = 1, mask_size_l(mid,1) 437 439 DO j = 1, mask_size_l(mid,2) 438 ! 439 !-- Get k index of highest horizontal surface 440 topo_top_ind = & 441 get_topography_top_index_ji( mask_j(mid,j), & 442 mask_i(mid,i), & 443 grid ) 440 !-- Get k index of the highest terraing surface 441 im = mask_i(mid,i) 442 jm = mask_j(mid,j) 443 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1 444 444 DO k = 1, mask_size_l(mid,3) 445 kk = MIN( topo_top_ind+mask_k(mid,k), nzt+1 ) 446 local_pf(i,j,k) = & 447 tend(kk,mask_j(mid,j),mask_i(mid,i)) 445 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) 446 !-- Set value if not in building 447 IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN 448 local_pf(i,j,k) = fill_value 449 ELSE 450 local_pf(i,j,k) = tend(kk,jm,im) 451 ENDIF 448 452 ENDDO 449 453 ENDDO … … 477 481 DO i = 1, mask_size_l(mid,1) 478 482 DO j = 1, mask_size_l(mid,2) 479 ! 480 !-- Get k index of highest horizontal surface 481 topo_top_ind = & 482 get_topography_top_index_ji( mask_j(mid,j), & 483 mask_i(mid,i), & 484 grid ) 483 !-- Get k index of the highest terraing surface 484 im = mask_i(mid,i) 485 jm = mask_j(mid,j) 486 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1 485 487 DO k = 1, mask_size_l(mid,3) 486 kk = MIN( topo_top_ind+mask_k(mid,k), nzt+1 ) 487 local_pf(i,j,k) = & 488 pt(kk,mask_j(mid,j),mask_i(mid,i) ) & 489 + lv_d_cp * d_exner(kk) * & 490 ql(kk,mask_j(mid,j),mask_i(mid,i)) 488 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) 489 !-- Set value if not in building 490 IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN 491 local_pf(i,j,k) = fill_value 492 ELSE 493 local_pf(i,j,k) = pt(kk,jm,im) + lv_d_cp * d_exner(kk) * ql(kk,jm,im) 494 ENDIF 491 495 ENDDO 492 496 ENDDO … … 571 575 DO i = 1, mask_size_l(mid,1) 572 576 DO j = 1, mask_size_l(mid,2) 573 ! 574 !-- Get k index of highest horizontal surface 575 topo_top_ind = & 576 get_topography_top_index_ji( mask_j(mid,j), & 577 mask_i(mid,i), & 578 grid ) 577 !-- Get k index of the highest terraing surface 578 im = mask_i(mid,i) 579 jm = mask_j(mid,j) 580 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1 579 581 DO k = 1, mask_size_l(mid,3) 580 kk = MIN( topo_top_ind+mask_k(mid,k), nzt+1 ) 581 local_pf(i,j,k) = & 582 tend(kk,mask_j(mid,j),mask_i(mid,i)) 582 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) 583 !-- Set value if not in building 584 IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN 585 local_pf(i,j,k) = fill_value 586 ELSE 587 local_pf(i,j,k) = tend(kk,jm,im) 588 ENDIF 583 589 ENDDO 584 590 ENDDO … … 608 614 DO i = 1, mask_size_l(mid,1) 609 615 DO j = 1, mask_size_l(mid,2) 610 ! 611 !-- Get k index of highest horizontal surface 612 topo_top_ind = & 613 get_topography_top_index_ji( mask_j(mid,j), & 614 mask_i(mid,i), & 615 grid ) 616 !-- Get k index of the highest terraing surface 617 im = mask_i(mid,i) 618 jm = mask_j(mid,j) 619 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1 616 620 DO k = 1, mask_size_l(mid,3) 617 kk = MIN( topo_top_ind+mask_k(mid,k), nzt+1 ) 618 local_pf(i,j,k) = & 619 q(kk,mask_j(mid,j),mask_i(mid,i)) - & 620 ql(kk,mask_j(mid,j),mask_i(mid,i)) 621 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) 622 !-- Set value if not in building 623 IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN 624 local_pf(i,j,k) = fill_value 625 ELSE 626 local_pf(i,j,k) = q(kk,jm,im) - ql(kk,jm,im) 627 ENDIF 621 628 ENDDO 622 629 ENDDO … … 686 693 687 694 CASE DEFAULT 688 695 ! 696 !-- Set flag to steer output of radiation, land-surface, or user-defined 697 !-- quantities 698 found = .FALSE. 689 699 ! 690 700 !-- Radiation quantity 691 IF ( radiation ) THEN701 IF ( .NOT. found .AND. radiation ) THEN 692 702 CALL radiation_data_output_mask(av, domask(mid,av,ivar), found,& 693 703 local_pf, mid ) 694 704 ENDIF 695 705 696 IF ( air_chemistry ) THEN706 IF ( .NOT. found .AND. air_chemistry ) THEN 697 707 CALL chem_data_output_mask(av, domask(mid,av,ivar), found, & 698 708 local_pf, mid ) … … 700 710 ! 701 711 !-- Check for diagnostic quantities 702 CALL doq_output_mask( av, domask(mid,av,ivar), found, local_pf, & 712 IF ( .NOT. found ) THEN 713 CALL doq_output_mask( av, domask(mid,av,ivar), found, local_pf, & 703 714 mid) 715 ENDIF 704 716 ! 705 717 !-- SALSA quantities 706 IF ( salsa ) THEN718 IF ( .NOT. found .AND. salsa ) THEN 707 719 CALL salsa_data_output_mask( av, domask(mid,av,ivar), found, & 708 720 local_pf, mid ) … … 745 757 DO i = 1, mask_size_l(mid,1) 746 758 DO j = 1, mask_size_l(mid,2) 747 ! 748 !-- Get k index of highest horizontal surface 749 topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), & 750 mask_i(mid,i), & 751 grid ) 752 ! 753 !-- Save output array 759 !-- Get k index of the highest terraing surface 760 im = mask_i(mid,i) 761 jm = mask_j(mid,j) 762 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1 754 763 DO k = 1, mask_size_l(mid,3) 755 local_pf(i,j,k) = to_be_resorted( & 756 MIN( topo_top_ind+mask_k(mid,k), & 757 nzt+1 ), & 758 mask_j(mid,j), & 759 mask_i(mid,i) ) 764 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) 765 !-- Set value if not in building 766 IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN 767 local_pf(i,j,k) = fill_value 768 ELSE 769 local_pf(i,j,k) = to_be_resorted(kk,jm,im) 770 ENDIF 760 771 ENDDO 761 772 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.