Changeset 4167 for palm/trunk
- Timestamp:
- Aug 16, 2019 11:01:48 AM (5 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 6 edited
- 1 copied
-
. (modified) (1 prop)
-
Makefile (modified) (4 diffs, 1 prop)
-
chemistry_model_mod.f90 (copied) (copied from palm/branches/resler/SOURCE/chemistry_model_mod.f90)
-
data_output_mask.f90 (modified) (15 diffs)
-
diagnostic_output_quantities_mod.f90 (modified) (5 diffs)
-
radiation_model_mod.f90 (modified) (7 diffs, 1 prop)
-
salsa_mod.f90 (modified) (18 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE
- Property svn:mergeinfo changed
-
palm/trunk/SOURCE/Makefile
- Property svn:mergeinfo changed
/palm/branches/resler/SOURCE/Makefile merged: 3366,3407,3438,3450,3466,3478,3578,3604,3686,3699,3713,3751,3852,3892,3989,4014,4025,4052-4053,4076,4119-4120,4135,4161
r4127 r4167 25 25 # ----------------- 26 26 # $Id$ 27 # Remove no longer needed dependencies on surface_mod 28 # 29 # 30 # 4127 2019-07-30 14:47:10Z suehring 27 31 # Add dependency of data_output_3d on plant_canopy_model_mod 28 32 # (merge from branch resler) … … 930 934 modules.o \ 931 935 netcdf_interface_mod.o \ 932 salsa_mod.o \ 933 surface_mod.o 936 salsa_mod.o 934 937 data_output_netcdf4_module.o: \ 935 938 mod_kinds.o … … 987 990 diagnostic_output_quantities_mod.o: \ 988 991 mod_kinds.o \ 989 modules.o \ 990 surface_mod.o 992 modules.o 991 993 diffusion_s.o: \ 992 994 mod_kinds.o \ … … 1642 1644 mod_kinds.o \ 1643 1645 modules.o \ 1644 surface_mod.o \1645 1646 user_module.o 1646 1647 user_flight.o: \ - 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 -
palm/trunk/SOURCE/diagnostic_output_quantities_mod.f90
r4157 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 ! 4157 2019-08-14 09:19:12Z suehring 27 31 ! Initialization restructured, in order to work also when data output during 28 32 ! spin-up is enabled. … … 86 90 ! 87 91 USE kinds 88 ! 92 ! 89 93 ! USE land_surface_model_mod, & 90 94 ! ONLY: zs … … 694 698 695 699 USE indices 696 697 USE surface_mod, & 698 ONLY: get_topography_top_index_ji 699 700 700 701 IMPLICIT NONE 701 702 702 CHARACTER (LEN=*) :: variable !< 703 CHARACTER (LEN=5) :: grid !< flag to distinquish between staggered grids 704 705 INTEGER(iwp) :: av !< index indicating averaged or instantaneous output 706 INTEGER(iwp) :: flag_nr !< number of the topography flag (0: scalar, 1: u, 2: v, 3: w) 707 INTEGER(iwp) :: i !< index variable along x-direction 708 INTEGER(iwp) :: j !< index variable along y-direction 709 INTEGER(iwp) :: k !< index variable along z-direction 710 INTEGER(iwp) :: mid !< masked output running index 711 INTEGER(iwp) :: topo_top_ind !< k index of highest horizontal surface 712 713 LOGICAL :: found !< true if variable is in list 714 LOGICAL :: resorted !< true if array is resorted 703 CHARACTER (LEN=*) :: variable !< 704 CHARACTER (LEN=5) :: grid !< flag to distinquish between staggered grids 705 706 INTEGER(iwp) :: av !< index indicating averaged or instantaneous output 707 INTEGER(iwp) :: flag_nr !< number of the topography flag (0: scalar, 1: u, 2: v, 3: w) 708 INTEGER(iwp) :: i !< index variable along x-direction 709 INTEGER(iwp) :: j !< index variable along y-direction 710 INTEGER(iwp) :: k !< index variable along z-direction 711 INTEGER(iwp) :: im !< loop index for masked variables 712 INTEGER(iwp) :: jm !< loop index for masked variables 713 INTEGER(iwp) :: kk !< masked output index variable along z-direction 714 INTEGER(iwp) :: mid !< masked output running index 715 INTEGER(iwp) :: ktt !< k index of highest horizontal surface 716 717 LOGICAL :: found !< true if variable is in list 718 LOGICAL :: resorted !< true if array is resorted 715 719 716 720 REAL(wp), & … … 718 722 local_pf !< 719 723 REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to array which needs to be resorted for output 724 725 REAL(wp), PARAMETER :: fill_value = -9999.0_wp !< value for the _FillValue attribute 720 726 721 727 flag_nr = 0 … … 788 794 DO j = 1, mask_size_l(mid,2) 789 795 ! 790 !-- Get k index of highest horizontal surface 791 topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), & 792 mask_i(mid,i), & 793 grid ) 794 ! 795 !-- Save output array 796 !-- Get k index of the highest terraing surface 797 im = mask_i(mid,i) 798 jm = mask_j(mid,j) 799 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), & 800 DIM = 1 ) - 1 796 801 DO k = 1, mask_size_l(mid,3) 797 local_pf(i,j,k) = to_be_resorted( & 798 MIN( topo_top_ind+mask_k(mid,k), & 799 nzt+1 ), & 800 mask_j(mid,j), & 801 mask_i(mid,i) ) 802 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) 803 ! 804 !-- Set value if not in building 805 IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN 806 local_pf(i,j,k) = fill_value 807 ELSE 808 local_pf(i,j,k) = to_be_resorted(kk,jm,im) 809 ENDIF 802 810 ENDDO 803 811 ENDDO -
palm/trunk/SOURCE/radiation_model_mod.f90
- Property svn:mergeinfo changed
r4157 r4167 28 28 ! ----------------- 29 29 ! $Id$ 30 ! Changed behaviour of masked output over surface to follow terrain and ignore 31 ! buildings (J.Resler, T.Gronemeier) 32 ! 33 ! 4157 2019-08-14 09:19:12Z suehring 30 34 ! Give informative message on raytracing distance only by core zero 31 35 ! … … 741 745 742 746 CHARACTER(10) :: radiation_scheme = 'clear-sky' ! 'constant', 'clear-sky', or 'rrtmg' 747 748 REAL(wp), PARAMETER :: fill_value = -9999.0_wp !< value for the _FillValue attribute 743 749 744 750 ! … … 10137 10143 LOGICAL :: two_d !< flag parameter that indicates 2D variables (horizontal cross sections) 10138 10144 10139 REAL(wp) :: fill_value = -999.0_wp !< value for the _FillValue attribute10140 10141 10145 REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< 10142 10146 … … 10536 10540 LOGICAL :: found !< 10537 10541 10538 REAL(wp) :: fill_value = -999.0_wp !< value for the _FillValue attribute10539 10540 10542 REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< 10541 10543 … … 11105 11107 CHARACTER (LEN=*) :: variable !< 11106 11108 11107 CHARACTER(LEN=5) :: grid !< flag to distinquish between staggered grids11108 11109 11109 INTEGER(iwp) :: av !< 11110 11110 INTEGER(iwp) :: i !< 11111 11111 INTEGER(iwp) :: j !< 11112 INTEGER(iwp) :: k !< 11112 INTEGER(iwp) :: k !< 11113 INTEGER(iwp) :: im !< loop index for masked variables 11114 INTEGER(iwp) :: jm !< loop index for masked variables 11115 INTEGER(iwp) :: kk !< 11113 11116 INTEGER(iwp) :: mid !< masked output running index 11114 INTEGER(iwp) :: topo_top_ind !< k index of highest horizontalsurface11117 INTEGER(iwp) :: ktt !< k index of highest terrain surface 11115 11118 11116 11119 LOGICAL :: found !< true if output array was found … … 11124 11127 REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to array which needs to be resorted for output 11125 11128 11126 11127 found = .TRUE.11128 grid = 's'11129 11129 resorted = .FALSE. 11130 found = .TRUE. 11130 11131 11131 11132 SELECT CASE ( TRIM( variable ) ) … … 11214 11215 DO j = 1, mask_size_l(mid,2) 11215 11216 ! 11216 !-- Get k index of highest horizontal surface 11217 topo_top_ind = get_topography_top_index_ji( mask_j(mid,j), & 11218 mask_i(mid,i), & 11219 grid ) 11220 ! 11221 !-- Save output array 11217 !-- Get k index of the highest terraing surface 11218 im = mask_i(mid,i) 11219 jm = mask_j(mid,j) 11220 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), & 11221 DIM = 1 ) - 1 11222 11222 DO k = 1, mask_size_l(mid,3) 11223 local_pf(i,j,k) = to_be_resorted( & 11224 MIN( topo_top_ind+mask_k(mid,k), & 11225 nzt+1 ), & 11226 mask_j(mid,j), & 11227 mask_i(mid,i) ) 11223 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) 11224 ! 11225 !-- Set value if not in building 11226 IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN 11227 local_pf(i,j,k) = fill_value 11228 ELSE 11229 local_pf(i,j,k) = to_be_resorted(kk,jm,im) 11230 ENDIF 11228 11231 ENDDO 11229 11232 ENDDO -
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.
