Changeset 4167 for palm/trunk/SOURCE/salsa_mod.f90
- Timestamp:
- Aug 16, 2019 11:01:48 AM (5 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
salsa_mod.f90 (modified) (18 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE
- Property svn:mergeinfo changed
-
palm/trunk/SOURCE/salsa_mod.f90
r4131 r4167 26 26 ! ----------------- 27 27 ! $Id$ 28 ! Changed behaviour of masked output over surface to follow terrain and ignore 29 ! buildings (J.Resler, T.Gronemeier) 30 ! 31 ! 4131 2019-08-02 11:06:18Z monakurppa 28 32 ! - Add "salsa_" before each salsa output variable 29 33 ! - Add a possibility to output the number (salsa_N_UFP) and mass concentration … … 256 260 !< 2 = autumn (no harvest yet), 3 = late autumn 257 261 !< (already frost), 4 = winter, 5 = transitional spring 262 263 REAL(wp), PARAMETER :: fill_value = -9999.0_wp !< value for the _FillValue attribute 258 264 ! 259 265 !-- Universal constants … … 10393 10399 !< depositing in the alveolar (or tracheobronchial) 10394 10400 !< region of the lung. Depends on the particle size 10395 REAL(wp) :: fill_value = -9999.0_wp !< value for the _FillValue attribute10396 10401 REAL(wp) :: mean_d !< Particle diameter in micrometres 10397 10402 REAL(wp) :: temp_bin !< temporary array for calculating output variables … … 10808 10813 !< depositing in the alveolar (or tracheobronchial) 10809 10814 !< region of the lung. Depends on the particle size 10810 REAL(wp) :: fill_value = -9999.0_wp !< value for the _FillValue attribute10811 10815 REAL(wp) :: mean_d !< Particle diameter in micrometres 10812 10816 REAL(wp) :: temp_bin !< temporary array for calculating output variables … … 11174 11178 ONLY: mask_i, mask_j, mask_k, mask_size_l, mask_surface, nz_do3d 11175 11179 11176 USE surface_mod, &11177 ONLY: get_topography_top_index_ji11178 11179 11180 IMPLICIT NONE 11180 11181 … … 11191 11192 INTEGER(iwp) :: j !< loop index in y-direction 11192 11193 INTEGER(iwp) :: k !< loop index in z-direction 11194 INTEGER(iwp) :: im !< loop index for masked variables 11195 INTEGER(iwp) :: jm !< loop index for masked variables 11196 INTEGER(iwp) :: kk !< loop index for masked output in z-direction 11193 11197 INTEGER(iwp) :: mid !< masked output running index 11194 INTEGER(iwp) :: topo_top_ind !< k index of highest horizontalsurface11198 INTEGER(iwp) :: ktt !< k index of highest terrain surface 11195 11199 11196 11200 LOGICAL :: found !< … … 11231 11235 DO i = 1, mask_size_l(mid,1) 11232 11236 DO j = 1, mask_size_l(mid,2) 11233 topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i), & 11234 grid ) 11237 ! 11238 !-- Get k index of the highest terraing surface 11239 im = mask_i(mid,i) 11240 jm = mask_j(mid,j) 11241 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1 11235 11242 DO k = 1, mask_size_l(mid,3) 11236 local_pf(i,j,k) = aerosol_number(ib)%conc(MIN( topo_top_ind+mask_k(mid,k),& 11237 nzt+1 ), & 11238 mask_j(mid,j), mask_i(mid,i) ) 11243 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) 11244 ! 11245 !-- Set value if not in building 11246 IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN 11247 local_pf(i,j,k) = fill_value 11248 ELSE 11249 local_pf(i,j,k) = aerosol_number(ib)%conc(kk,jm,im) 11250 ENDIF 11239 11251 ENDDO 11240 11252 ENDDO … … 11277 11289 DO i = 1, mask_size_l(mid,1) 11278 11290 DO j = 1, mask_size_l(mid,2) 11279 topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i), & 11280 grid ) 11291 ! 11292 !-- Get k index of the highest terraing surface 11293 im = mask_i(mid,i) 11294 jm = mask_j(mid,j) 11295 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1 11281 11296 DO k = 1, mask_size_l(mid,3) 11282 local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k), nzt+1 ), & 11283 mask_j(mid,j), mask_i(mid,i) ) 11297 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) 11298 ! 11299 !-- Set value if not in building 11300 IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN 11301 local_pf(i,j,k) = fill_value 11302 ELSE 11303 local_pf(i,j,k) = tend(kk,jm,im) 11304 ENDIF 11284 11305 ENDDO 11285 11306 ENDDO … … 11347 11368 DO i = 1, mask_size_l(mid,1) 11348 11369 DO j = 1, mask_size_l(mid,2) 11349 topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i), & 11350 grid ) 11370 ! 11371 !-- Get k index of the highest terraing surface 11372 im = mask_i(mid,i) 11373 jm = mask_j(mid,j) 11374 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1 11351 11375 DO k = 1, mask_size_l(mid,3) 11352 local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k), nzt+1 ), & 11353 mask_j(mid,j), mask_i(mid,i) ) 11376 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) 11377 ! 11378 !-- Set value if not in building 11379 IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN 11380 local_pf(i,j,k) = fill_value 11381 ELSE 11382 local_pf(i,j,k) = tend(kk,jm,im) 11383 ENDIF 11354 11384 ENDDO 11355 11385 ENDDO … … 11387 11417 DO i = 1, mask_size_l(mid,1) 11388 11418 DO j = 1, mask_size_l(mid,2) 11389 topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i), & 11390 grid ) 11419 ! 11420 !-- Get k index of the highest terraing surface 11421 im = mask_i(mid,i) 11422 jm = mask_j(mid,j) 11423 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1 11391 11424 DO k = 1, mask_size_l(mid,3) 11392 local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k), nzt+1 ), & 11393 mask_j(mid,j), mask_i(mid,i) ) 11425 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) 11426 ! 11427 !-- Set value if not in building 11428 IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN 11429 local_pf(i,j,k) = fill_value 11430 ELSE 11431 local_pf(i,j,k) = tend(kk,jm,im) 11432 ENDIF 11394 11433 ENDDO 11395 11434 ENDDO … … 11425 11464 DO i = 1, mask_size_l(mid,1) 11426 11465 DO j = 1, mask_size_l(mid,2) 11427 topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i), & 11428 grid ) 11466 ! 11467 !-- Get k index of the highest terraing surface 11468 im = mask_i(mid,i) 11469 jm = mask_j(mid,j) 11470 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1 11429 11471 DO k = 1, mask_size_l(mid,3) 11430 local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k), nzt+1 ), & 11431 mask_j(mid,j), mask_i(mid,i) ) 11472 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) 11473 ! 11474 !-- Set value if not in building 11475 IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN 11476 local_pf(i,j,k) = fill_value 11477 ELSE 11478 local_pf(i,j,k) = tend(kk,jm,im) 11479 ENDIF 11432 11480 ENDDO 11433 11481 ENDDO … … 11467 11515 DO i = 1, mask_size_l(mid,1) 11468 11516 DO j = 1, mask_size_l(mid,2) 11469 topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i), & 11470 grid ) 11517 ! 11518 !-- Get k index of the highest terraing surface 11519 im = mask_i(mid,i) 11520 jm = mask_j(mid,j) 11521 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1 11471 11522 DO k = 1, mask_size_l(mid,3) 11472 local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k), nzt+1 ), & 11473 mask_j(mid,j), mask_i(mid,i) ) 11523 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) 11524 ! 11525 !-- Set value if not in building 11526 IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN 11527 local_pf(i,j,k) = fill_value 11528 ELSE 11529 local_pf(i,j,k) = tend(kk,jm,im) 11530 ENDIF 11474 11531 ENDDO 11475 11532 ENDDO … … 11509 11566 DO i = 1, mask_size_l(mid,1) 11510 11567 DO j = 1, mask_size_l(mid,2) 11511 topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i), & 11512 grid ) 11568 ! 11569 !-- Get k index of the highest terraing surface 11570 im = mask_i(mid,i) 11571 jm = mask_j(mid,j) 11572 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1 11513 11573 DO k = 1, mask_size_l(mid,3) 11514 local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k), nzt+1 ), & 11515 mask_j(mid,j), mask_i(mid,i) ) 11574 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) 11575 ! 11576 !-- Set value if not in building 11577 IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN 11578 local_pf(i,j,k) = fill_value 11579 ELSE 11580 local_pf(i,j,k) = tend(kk,jm,im) 11581 ENDIF 11516 11582 ENDDO 11517 11583 ENDDO … … 11551 11617 DO i = 1, mask_size_l(mid,1) 11552 11618 DO j = 1, mask_size_l(mid,2) 11553 topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i), & 11554 grid ) 11619 ! 11620 !-- Get k index of the highest terraing surface 11621 im = mask_i(mid,i) 11622 jm = mask_j(mid,j) 11623 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1 11555 11624 DO k = 1, mask_size_l(mid,3) 11556 local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k), nzt+1 ), & 11557 mask_j(mid,j), mask_i(mid,i) ) 11625 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) 11626 ! 11627 !-- Set value if not in building 11628 IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN 11629 local_pf(i,j,k) = fill_value 11630 ELSE 11631 local_pf(i,j,k) = tend(kk,jm,im) 11632 ENDIF 11558 11633 ENDDO 11559 11634 ENDDO … … 11594 11669 DO i = 1, mask_size_l(mid,1) 11595 11670 DO j = 1, mask_size_l(mid,2) 11596 topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i), & 11597 grid ) 11671 ! 11672 !-- Get k index of the highest terraing surface 11673 im = mask_i(mid,i) 11674 jm = mask_j(mid,j) 11675 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1 11598 11676 DO k = 1, mask_size_l(mid,3) 11599 local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k), nzt+1 ), & 11600 mask_j(mid,j), mask_i(mid,i) ) 11677 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) 11678 ! 11679 !-- Set value if not in building 11680 IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN 11681 local_pf(i,j,k) = fill_value 11682 ELSE 11683 local_pf(i,j,k) = tend(kk,jm,im) 11684 ENDIF 11601 11685 ENDDO 11602 11686 ENDDO … … 11641 11725 DO i = 1, mask_size_l(mid,1) 11642 11726 DO j = 1, mask_size_l(mid,2) 11643 topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i), & 11644 grid ) 11727 ! 11728 !-- Get k index of the highest terraing surface 11729 im = mask_i(mid,i) 11730 jm = mask_j(mid,j) 11731 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1 11645 11732 DO k = 1, mask_size_l(mid,3) 11646 local_pf(i,j,k) = tend( MIN( topo_top_ind+mask_k(mid,k), nzt+1 ), & 11647 mask_j(mid,j), mask_i(mid,i) ) 11733 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) 11734 ! 11735 !-- Set value if not in building 11736 IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN 11737 local_pf(i,j,k) = fill_value 11738 ELSE 11739 local_pf(i,j,k) = tend(kk,jm,im) 11740 ENDIF 11648 11741 ENDDO 11649 11742 ENDDO … … 11661 11754 ENDIF 11662 11755 11663 IF ( .NOT. resorted ) THEN11756 IF ( found .AND. .NOT. resorted ) THEN 11664 11757 IF ( .NOT. mask_surface(mid) ) THEN 11665 11758 ! … … 11677 11770 DO i = 1, mask_size_l(mid,1) 11678 11771 DO j = 1, mask_size_l(mid,2) 11679 ! 11680 !-- Get k index of highest horizontal surface 11681 topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), mask_i(mid,i), grid ) 11682 ! 11683 !-- Save output array 11772 !-- Get k index of the highest terraing surface 11773 im = mask_i(mid,i) 11774 jm = mask_j(mid,j) 11775 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1 11684 11776 DO k = 1, mask_size_l(mid,3) 11685 local_pf(i,j,k) = to_be_resorted( MIN( topo_top_ind+mask_k(mid,k), nzt+1 ), & 11686 mask_j(mid,j), mask_i(mid,i) ) 11777 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) 11778 !-- Set value if not in building 11779 IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN 11780 local_pf(i,j,k) = fill_value 11781 ELSE 11782 local_pf(i,j,k) = to_be_resorted(kk,jm,im) 11783 ENDIF 11687 11784 ENDDO 11688 11785 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.
