Changeset 4127 for palm/trunk/SOURCE
- Timestamp:
- Jul 30, 2019 2:47:10 PM (5 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 8 edited
-
Makefile (modified) (2 diffs)
-
biometeorology_mod.f90 (modified) (16 diffs)
-
data_output_3d.f90 (modified) (5 diffs)
-
module_interface.f90 (modified) (3 diffs)
-
netcdf_interface_mod.f90 (modified) (8 diffs)
-
plant_canopy_model_mod.f90 (modified) (8 diffs)
-
radiation_model_mod.f90 (modified) (3 diffs)
-
urban_surface_mod.f90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/Makefile
r4106 r4127 25 25 # ----------------- 26 26 # $Id$ 27 # Add dependency of data_output_3d on plant_canopy_model_mod 28 # (merge from branch resler) 29 # 30 # 4106 2019-07-19 08:54:42Z gronemeier 27 31 # Remove dependency on pmc_interface for boundary_conds 28 32 # … … 975 979 modules.o \ 976 980 netcdf_interface_mod.o \ 981 plant_canopy_model_mod.o \ 977 982 radiation_model_mod.o \ 978 983 urban_surface_mod.o -
palm/trunk/SOURCE/biometeorology_mod.f90
r4126 r4127 27 27 ! ----------------- 28 28 ! $Id$ 29 ! Output for bio_mrt added (merge from branch resler) 30 ! 31 ! 4126 2019-07-30 11:09:11Z gronemeier 29 32 ! renamed vitd3_exposure_av into vitd3_dose, 30 33 ! renamed uvem_calc_exposure into bio_calculate_uv_exposure … … 226 229 LOGICAL :: average_trigger_utci = .FALSE. !< update averaged input on call to bio_utci? 227 230 LOGICAL :: average_trigger_pet = .FALSE. !< update averaged input on call to bio_pet? 231 LOGICAL :: average_trigger_mrt = .FALSE. !< update averaged input on call to bio_pet? 228 232 LOGICAL :: do_calculate_perct = .FALSE. !< Turn index PT (instant. input) on or off 229 233 LOGICAL :: do_calculate_perct_av = .FALSE. !< Turn index PT (averaged input) on or off … … 232 236 LOGICAL :: do_calculate_utci = .FALSE. !< Turn index UTCI (instant. input) on or off 233 237 LOGICAL :: do_calculate_utci_av = .FALSE. !< Turn index UTCI (averaged input) on or off 238 LOGICAL :: do_calculate_mrt2d = .FALSE. !< Turn index MRT 2D (averaged or inst) on or off 234 239 235 240 ! … … 432 437 433 438 434 CASE ( 'bio_perct*', 'bio_utci*', 'bio_pet*' )439 CASE ( 'bio_perct*', 'bio_utci*', 'bio_pet*', 'bio_mrt*' ) 435 440 436 441 ! … … 447 452 IF ( .NOT. average_trigger_perct .AND. & 448 453 .NOT. average_trigger_utci .AND. & 449 .NOT. average_trigger_pet ) THEN 454 .NOT. average_trigger_pet .AND. & 455 .NOT. average_trigger_mrt ) THEN 450 456 ! 451 457 !-- Memorize the first index called to control averaging … … 458 464 IF ( TRIM( variable ) == 'bio_pet*' ) THEN 459 465 average_trigger_pet = .TRUE. 466 ENDIF 467 IF ( TRIM( variable ) == 'bio_mrt*' ) THEN 468 average_trigger_mrt = .TRUE. 460 469 ENDIF 461 470 ENDIF … … 499 508 ENDIF 500 509 501 CASE ( 'bio_perct*', 'bio_utci*', 'bio_pet*' )510 CASE ( 'bio_perct*', 'bio_utci*', 'bio_pet*', 'bio_mrt*' ) 502 511 ! 503 512 !-- Only continue if the current index is the one to trigger the input … … 509 518 IF ( average_trigger_pet .AND. TRIM( variable ) /= & 510 519 'bio_pet*') RETURN 520 IF ( average_trigger_mrt .AND. TRIM( variable ) /= & 521 'bio_mrt*') RETURN 511 522 ! 512 523 !-- Now memorize which of the input grids are not averaged by other … … 637 648 ENDIF 638 649 639 CASE ( 'bio_perct*', 'bio_utci*', 'bio_pet*' )650 CASE ( 'bio_perct*', 'bio_utci*', 'bio_pet*', 'bio_mrt*' ) 640 651 ! 641 652 !-- Only continue if update index, see above … … 646 657 IF ( average_trigger_pet .AND. & 647 658 TRIM( variable ) /= 'bio_pet*' ) RETURN 659 IF ( average_trigger_mrt .AND. & 660 TRIM( variable ) /= 'bio_mrt*' ) RETURN 648 661 649 662 IF ( ALLOCATED( pt_av ) .AND. do_average_theta ) THEN … … 748 761 !-- derived in a single step based on priorly averaged arrays (see 749 762 !-- bio_calculate_thermal_index_maps). 750 CASE ( 'bio_mrt' )763 CASE ( 'bio_mrt', 'bio_mrt*' ) 751 764 unit = 'degree_C' 752 765 thermal_comfort = .TRUE. !< enable thermal_comfort if user forgot to do so … … 755 768 tmrt_grid = REAL( bio_fill_value, KIND = wp ) 756 769 ENDIF 770 IF ( TRIM( var ) == 'bio_mrt*' ) THEN 771 do_calculate_mrt2d = .TRUE. 772 END IF 757 773 758 774 CASE ( 'bio_perct*' ) … … 961 977 ENDDO 962 978 979 CASE ( 'bio_mrt*_xy' ) ! 2d-array 980 grid = 'zu1' 981 two_d = .TRUE. 982 IF ( av == 0 ) THEN 983 DO i = nxl, nxr 984 DO j = nys, nyn 985 local_pf(i,j,nzb+1) = tmrt_grid(j,i) 986 ENDDO 987 ENDDO 988 ELSE 989 DO i = nxl, nxr 990 DO j = nys, nyn 991 local_pf(i,j,nzb+1) = tmrt_av_grid(j,i) 992 ENDDO 993 ENDDO 994 ENDIF 995 963 996 964 997 CASE ( 'bio_perct*_xy' ) ! 2d-array … … 1372 1405 READ ( 13 ) average_trigger_pet 1373 1406 1407 CASE ( 'average_trigger_mrt' ) 1408 READ ( 13 ) average_trigger_mrt 1409 1374 1410 1375 1411 CASE DEFAULT … … 1451 1487 CALL wrd_write_string( 'average_trigger_pet' ) 1452 1488 WRITE ( 14 ) average_trigger_pet 1489 CALL wrd_write_string( 'average_trigger_mrt' ) 1490 WRITE ( 14 ) average_trigger_mrt 1453 1491 1454 1492 END SUBROUTINE bio_wrd_global … … 1694 1732 IF ( do_calculate_perct .OR. do_calculate_perct_av .OR. & 1695 1733 do_calculate_utci .OR. do_calculate_utci_av .OR. & 1696 do_calculate_pet .OR. do_calculate_pet_av ) THEN 1734 do_calculate_pet .OR. do_calculate_pet_av .OR. & 1735 do_calculate_mrt2d ) THEN 1697 1736 1698 1737 ! -
palm/trunk/SOURCE/data_output_3d.f90
r4048 r4127 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Adjustment for top boundary index for plant-canopy model outputs 28 ! (merge from branch resler) 29 ! 30 ! 4048 2019-06-21 21:00:21Z knoop 27 31 ! Moved tcm_data_output_3d to module_interface 28 32 ! … … 276 280 ONLY: debug_output_timestep, & 277 281 do3d, do3d_no, do3d_time_count, io_blocks, io_group, & 278 land_surface, message_string, ntdim_3d, nz_do3d, psolver, & 279 time_since_reference_point, urban_surface, varnamelength 282 land_surface, message_string, ntdim_3d, nz_do3d, plant_canopy, & 283 psolver, time_since_reference_point, urban_surface, & 284 varnamelength 280 285 281 286 USE cpulog, & … … 313 318 314 319 USE pegrid 320 321 USE plant_canopy_model_mod, & 322 ONLY: pch_index 315 323 316 324 USE radiation_model_mod, & … … 410 418 found = .FALSE. 411 419 resorted = .FALSE. 420 trimvar = TRIM( do3d(av,ivar) ) 421 412 422 ! 413 423 !-- Temporary solution to account for data output within the new urban … … 415 425 !-- Store the array chosen on the temporary array. 416 426 nzb_do = nzb 417 nzt_do = nz_do3d 418 419 trimvar = TRIM( do3d(av,ivar) ) 427 ! 428 !-- Set top index for 3D output. Note in case of plant-canopy model 429 !-- these index is determined by pch_index. 430 IF ( plant_canopy .AND. trimvar(1:4) == 'pcm_' ) THEN 431 nzt_do = pch_index 432 ELSE 433 nzt_do = nz_do3d 434 ENDIF 435 420 436 ! 421 437 !-- Allocate a temporary array with the desired output dimensions. -
palm/trunk/SOURCE/module_interface.f90
r4048 r4127 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Add output of 3D plant-canopy outputs (merge from branch resler) 28 ! 29 ! 4048 2019-06-21 21:00:21Z knoop 27 30 ! Moved turbulence_closure_mod calls into this module_interface 28 31 ! … … 373 376 pcm_init, & 374 377 pcm_header, & 378 pcm_3d_data_averaging, & 375 379 pcm_data_output_3d 376 380 … … 1297 1301 IF ( land_surface ) CALL lsm_3d_data_averaging( mode, variable ) 1298 1302 IF ( ocean_mode ) CALL ocean_3d_data_averaging( mode, variable ) 1303 IF ( plant_canopy ) CALL pcm_3d_data_averaging( mode, variable ) 1299 1304 IF ( radiation ) CALL radiation_3d_data_averaging( mode, variable ) 1300 1305 IF ( salsa ) CALL salsa_3d_data_averaging( mode, variable ) -
palm/trunk/SOURCE/netcdf_interface_mod.f90
r4069 r4127 25 25 ! ----------------- 26 26 ! $Id$ 27 ! -Introduce new vertical dimension for plant-canopy output. 28 ! -Temporarlily disable masked output for soil (merge from branch resler) 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 … … 538 542 id_dim_y_xz, id_dim_yv_xz, id_dim_y_yz, id_dim_yv_yz, & 539 543 id_dim_y_3d, id_dim_yv_3d, id_dim_zs_xy, id_dim_zs_xz, & 540 id_dim_zs_yz, id_dim_zs_3d, id_dim_zu_xy, id_dim_zu1_xy, & 544 id_dim_zs_yz, id_dim_zs_3d, id_dim_zpc_3d, & 545 id_dim_zu_xy, id_dim_zu1_xy, & 541 546 id_dim_zu_xz, id_dim_zu_yz, id_dim_zu_3d, id_dim_zw_xy, & 542 547 id_dim_zw_xz, id_dim_zw_yz, id_dim_zw_3d, id_set_xy, & … … 548 553 id_var_yv_xy, id_var_y_xz, id_var_yv_xz, id_var_y_yz, & 549 554 id_var_yv_yz, id_var_y_3d, id_var_yv_3d, id_var_zs_xy, & 550 id_var_zs_xz, id_var_zs_yz, id_var_zs_3d, id_var_z usi_xy, &551 id_var_zusi_ 3d, id_var_zu_xy, id_var_zu1_xy, id_var_zu_xz, &555 id_var_zs_xz, id_var_zs_yz, id_var_zs_3d, id_var_zpc_3d, & 556 id_var_zusi_xy, id_var_zusi_3d, id_var_zu_xy, id_var_zu1_xy, id_var_zu_xz, & 552 557 id_var_zu_yz, id_var_zu_3d, id_var_zwwi_xy, id_var_zwwi_3d, & 553 558 id_var_zw_xy, id_var_zw_xz, id_var_zw_yz, id_var_zw_3d … … 738 743 739 744 USE plant_canopy_model_mod, & 740 ONLY: pc m_define_netcdf_grid745 ONLY: pch_index, pcm_define_netcdf_grid 741 746 742 747 USE profil_parameter, & … … 1552 1557 1553 1558 ENDIF 1554 1555 IF ( land_surface ) THEN 1559 ! 1560 !-- soil is not in masked output for now - disable temporary this block 1561 ! IF ( land_surface ) THEN 1556 1562 ! 1557 1563 !-- Write zs data (vertical axes for soil model), use negative values 1558 1564 !-- to indicate soil depth 1559 ALLOCATE( netcdf_data(mask_size(mid,3)) )1560 1561 netcdf_data = zs( mask_k_global(mid,:mask_size(mid,3)) )1562 1563 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zs_mask(mid,av), &1564 netcdf_data, start = (/ 1 /), &1565 count = (/ mask_size(mid,3) /) )1566 CALL netcdf_handle_error( 'netcdf_define_header', 538 )1567 1568 DEALLOCATE( netcdf_data )1569 1570 ENDIF1565 ! ALLOCATE( netcdf_data(mask_size(mid,3)) ) 1566 ! 1567 ! netcdf_data = zs( mask_k_global(mid,:mask_size(mid,3)) ) 1568 ! 1569 ! nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zs_mask(mid,av), & 1570 ! netcdf_data, start = (/ 1 /), & 1571 ! count = (/ mask_size(mid,3) /) ) 1572 ! CALL netcdf_handle_error( 'netcdf_define_header', 538 ) 1573 ! 1574 ! DEALLOCATE( netcdf_data ) 1575 ! 1576 ! ENDIF 1571 1577 1572 1578 ! … … 1847 1853 ENDIF 1848 1854 1855 IF ( plant_canopy ) THEN 1856 ! 1857 !-- Define vertical coordinate grid (zpc grid) 1858 CALL netcdf_create_dim( id_set_3d(av), 'zpc_3d', & 1859 pch_index+1, id_dim_zpc_3d(av), 70 ) 1860 !netcdf_create_dim(ncid, dim_name, ncdim_type, ncdim_id, error_no) 1861 CALL netcdf_create_var( id_set_3d(av), (/ id_dim_zpc_3d(av) /), & 1862 'zpc_3d', NF90_DOUBLE, id_var_zpc_3d(av), & 1863 'meters', '', 71, 72, 00 ) 1864 1865 ENDIF 1866 1849 1867 ! 1850 1868 !-- Define the variables … … 2006 2024 ELSEIF ( grid_z == 'zs' ) THEN 2007 2025 id_z = id_dim_zs_3d(av) 2026 ELSEIF ( grid_z == 'zpc' ) THEN 2027 id_z = id_dim_zpc_3d(av) 2008 2028 ENDIF 2009 2029 … … 2248 2268 - zs(nzb_soil:nzt_soil), start = (/ 1 /), & 2249 2269 count = (/ nzt_soil-nzb_soil+1 /) ) 2270 CALL netcdf_handle_error( 'netcdf_define_header', 86 ) 2271 ENDIF 2272 2273 IF ( plant_canopy ) THEN 2274 ! 2275 !-- Write zpc grid 2276 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zpc_3d(av), & 2277 zu(nzb:nzb+pch_index), start = (/ 1 /), & 2278 count = (/ pch_index+1 /) ) 2250 2279 CALL netcdf_handle_error( 'netcdf_define_header', 86 ) 2251 2280 ENDIF -
palm/trunk/SOURCE/plant_canopy_model_mod.f90
r3885 r4127 27 27 ! ----------------- 28 28 ! $Id$ 29 ! Output of 3D plant canopy variables changed. It is now relative to the local 30 ! terrain rather than located at the acutal vertical level in the model. This 31 ! way, the vertical dimension of the output can be significantly reduced. 32 ! (merge from branch resler) 33 ! 34 ! 3885 2019-04-11 11:29:34Z kanani 29 35 ! Changes related to global restructuring of location messages and introduction 30 36 ! of additional debug messages … … 311 317 REAL(wp), DIMENSION(:), ALLOCATABLE :: pre_lad !< preliminary lad 312 318 313 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: cum_lai_hf !< cumulative lai for heatflux calc. 314 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: lad_s !< lad on scalar-grid 315 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: pc_heating_rate !< plant canopy heating rate 316 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: pc_transpiration_rate !< plant canopy transpiration rate 317 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: pc_latent_rate !< plant canopy latent heating rate 319 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: cum_lai_hf !< cumulative lai for heatflux calc. 320 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: lad_s !< lad on scalar-grid 321 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: pc_heating_rate !< plant canopy heating rate 322 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: pc_transpiration_rate !< plant canopy transpiration rate 323 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: pc_latent_rate !< plant canopy latent heating rate 324 325 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: pcm_heatrate_av !< array for averaging plant canopy sensible heating rate 326 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: pcm_latentrate_av !< array for averaging plant canopy latent heating rate 327 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: pcm_transpirationrate_av !< array for averaging plant canopy transpiration rate 318 328 319 329 SAVE … … 325 335 !-- Public functions 326 336 PUBLIC pcm_calc_transpiration_rate, pcm_check_data_output, & 327 pcm_check_parameters, pcm_data_output_3d, pcm_define_netcdf_grid, & 337 pcm_check_parameters, pcm_3d_data_averaging, & 338 pcm_data_output_3d, pcm_define_netcdf_grid, & 328 339 pcm_header, pcm_init, pcm_parin, pcm_tendency 329 340 … … 345 356 MODULE PROCEDURE pcm_check_parameters 346 357 END INTERFACE pcm_check_parameters 358 359 INTERFACE pcm_3d_data_averaging 360 MODULE PROCEDURE pcm_3d_data_averaging 361 END INTERFACE pcm_3d_data_averaging 347 362 348 363 INTERFACE pcm_data_output_3d … … 618 633 ! Description: 619 634 ! ------------ 620 !> Subroutine defining 3D output variables 635 !> Subroutine for averaging 3D data 636 !------------------------------------------------------------------------------! 637 SUBROUTINE pcm_3d_data_averaging( mode, variable ) 638 639 640 USE control_parameters 641 642 USE indices 643 644 USE kinds 645 646 IMPLICIT NONE 647 648 CHARACTER (LEN=*) :: mode !< 649 CHARACTER (LEN=*) :: variable !< 650 651 INTEGER(iwp) :: i !< 652 INTEGER(iwp) :: j !< 653 INTEGER(iwp) :: k !< 654 655 656 IF ( mode == 'allocate' ) THEN 657 658 SELECT CASE ( TRIM( variable ) ) 659 660 CASE ( 'pcm_heatrate' ) 661 IF ( .NOT. ALLOCATED( pcm_heatrate_av ) ) THEN 662 ALLOCATE( pcm_heatrate_av(0:pch_index,nysg:nyng,nxlg:nxrg) ) 663 ENDIF 664 pcm_heatrate_av = 0.0_wp 665 666 667 CASE ( 'pcm_latentrate' ) 668 IF ( .NOT. ALLOCATED( pcm_latentrate_av ) ) THEN 669 ALLOCATE( pcm_latentrate_av(0:pch_index,nysg:nyng,nxlg:nxrg) ) 670 ENDIF 671 pcm_latentrate_av = 0.0_wp 672 673 674 CASE ( 'pcm_transpirationrate' ) 675 IF ( .NOT. ALLOCATED( pcm_transpirationrate_av ) ) THEN 676 ALLOCATE( pcm_transpirationrate_av(0:pch_index,nysg:nyng,nxlg:nxrg) ) 677 ENDIF 678 pcm_transpirationrate_av = 0.0_wp 679 680 CASE DEFAULT 681 CONTINUE 682 683 END SELECT 684 685 ELSEIF ( mode == 'sum' ) THEN 686 687 SELECT CASE ( TRIM( variable ) ) 688 689 CASE ( 'pcm_heatrate' ) 690 IF ( ALLOCATED( pcm_heatrate_av ) ) THEN 691 DO i = nxl, nxr 692 DO j = nys, nyn 693 IF ( pch_index_ji(j,i) /= 0 ) THEN 694 DO k = 0, pch_index_ji(j,i) 695 pcm_heatrate_av(k,j,i) = pcm_heatrate_av(k,j,i) + pc_heating_rate(k,j,i) 696 ENDDO 697 ENDIF 698 ENDDO 699 ENDDO 700 ENDIF 701 702 703 CASE ( 'pcm_latentrate' ) 704 IF ( ALLOCATED( pcm_latentrate_av ) ) THEN 705 DO i = nxl, nxr 706 DO j = nys, nyn 707 IF ( pch_index_ji(j,i) /= 0 ) THEN 708 DO k = 0, pch_index_ji(j,i) 709 pcm_latentrate_av(k,j,i) = pcm_latentrate_av(k,j,i) + pc_latent_rate(k,j,i) 710 ENDDO 711 ENDIF 712 ENDDO 713 ENDDO 714 ENDIF 715 716 717 CASE ( 'pcm_transpirationrate' ) 718 IF ( ALLOCATED( pcm_transpirationrate_av ) ) THEN 719 DO i = nxl, nxr 720 DO j = nys, nyn 721 IF ( pch_index_ji(j,i) /= 0 ) THEN 722 DO k = 0, pch_index_ji(j,i) 723 pcm_transpirationrate_av(k,j,i) = pcm_transpirationrate_av(k,j,i) + pc_transpiration_rate(k,j,i) 724 ENDDO 725 ENDIF 726 ENDDO 727 ENDDO 728 ENDIF 729 730 CASE DEFAULT 731 CONTINUE 732 733 END SELECT 734 735 ELSEIF ( mode == 'average' ) THEN 736 737 SELECT CASE ( TRIM( variable ) ) 738 739 CASE ( 'pcm_heatrate' ) 740 IF ( ALLOCATED( pcm_heatrate_av ) ) THEN 741 DO i = nxlg, nxrg 742 DO j = nysg, nyng 743 IF ( pch_index_ji(j,i) /= 0 ) THEN 744 DO k = 0, pch_index_ji(j,i) 745 pcm_heatrate_av(k,j,i) = pcm_heatrate_av(k,j,i) & 746 / REAL( average_count_3d, KIND=wp ) 747 ENDDO 748 ENDIF 749 ENDDO 750 ENDDO 751 ENDIF 752 753 754 CASE ( 'pcm_latentrate' ) 755 IF ( ALLOCATED( pcm_latentrate_av ) ) THEN 756 DO i = nxlg, nxrg 757 DO j = nysg, nyng 758 IF ( pch_index_ji(j,i) /= 0 ) THEN 759 DO k = 0, pch_index_ji(j,i) 760 pcm_latentrate_av(k,j,i) = pcm_latentrate_av(k,j,i) & 761 / REAL( average_count_3d, KIND=wp ) 762 ENDDO 763 ENDIF 764 ENDDO 765 ENDDO 766 ENDIF 767 768 769 CASE ( 'pcm_transpirationrate' ) 770 IF ( ALLOCATED( pcm_transpirationrate_av ) ) THEN 771 DO i = nxlg, nxrg 772 DO j = nysg, nyng 773 IF ( pch_index_ji(j,i) /= 0 ) THEN 774 DO k = 0, pch_index_ji(j,i) 775 pcm_transpirationrate_av(k,j,i) = pcm_transpirationrate_av(k,j,i) & 776 / REAL( average_count_3d, KIND=wp ) 777 ENDDO 778 ENDIF 779 ENDDO 780 ENDDO 781 ENDIF 782 783 END SELECT 784 785 ENDIF 786 787 END SUBROUTINE pcm_3d_data_averaging 788 789 !------------------------------------------------------------------------------! 790 ! 791 ! Description: 792 ! ------------ 793 !> Subroutine defining 3D output variables. 794 !> Note, 3D plant-canopy output has it's own vertical output dimension, meaning 795 !> that 3D output is relative to the model surface now rather than at the actual 796 !> grid point where the plant canopy is located. 621 797 !------------------------------------------------------------------------------! 622 798 SUBROUTINE pcm_data_output_3d( av, variable, found, local_pf, fill_value, & … … 636 812 INTEGER(iwp) :: j !< 637 813 INTEGER(iwp) :: k !< 638 INTEGER(iwp) :: k_topo !< topography top index639 814 INTEGER(iwp) :: nzb_do !< lower limit of the data output (usually 0) 640 815 INTEGER(iwp) :: nzt_do !< vertical upper limit of the data output (usually nz_do3d) … … 652 827 SELECT CASE ( TRIM( variable ) ) 653 828 654 CASE ( 'pcm_heatrate' ) 655 IF ( av == 0 ) THEN 656 DO i = nxl, nxr 657 DO j = nys, nyn 658 IF ( pch_index_ji(j,i) /= 0 ) THEN 659 k_topo = get_topography_top_index_ji( j, i, 's' ) 660 DO k = k_topo, k_topo + pch_index_ji(j,i) 661 local_pf(i,j,k) = pc_heating_rate(k-k_topo,j,i) 662 ENDDO 663 ENDIF 664 ENDDO 665 ENDDO 666 ENDIF 667 829 CASE ( 'pcm_heatrate' ) 830 IF ( av == 0 ) THEN 831 DO i = nxl, nxr 832 DO j = nys, nyn 833 IF ( pch_index_ji(j,i) /= 0 ) THEN 834 DO k = nzb_do, nzt_do 835 local_pf(i,j,k) = pc_heating_rate(k,j,i) 836 ENDDO 837 ENDIF 838 ENDDO 839 ENDDO 840 ELSE 841 DO i = nxl, nxr 842 DO j = nys, nyn 843 DO k = nzb_do, nzt_do 844 local_pf(i,j,k) = pcm_heatrate_av(k,j,i) 845 ENDDO 846 ENDDO 847 ENDDO 848 ENDIF 849 850 CASE ( 'pcm_latentrate' ) 851 IF ( av == 0 ) THEN 852 DO i = nxl, nxr 853 DO j = nys, nyn 854 IF ( pch_index_ji(j,i) /= 0 ) THEN 855 DO k = nzb_do, nzt_do 856 local_pf(i,j,k) = pc_latent_rate(k,j,i) 857 ENDDO 858 ENDIF 859 ENDDO 860 ENDDO 861 ELSE 862 DO i = nxl, nxr 863 DO j = nys, nyn 864 DO k = nzb_do, nzt_do 865 local_pf(i,j,k) = pcm_latentrate_av(k,j,i) 866 ENDDO 867 ENDDO 868 ENDDO 869 ENDIF 870 668 871 CASE ( 'pcm_transpirationrate' ) 669 IF ( av == 0 ) THEN 670 DO i = nxl, nxr 671 DO j = nys, nyn 672 IF ( pch_index_ji(j,i) /= 0 ) THEN 673 k_topo = get_topography_top_index_ji( j, i, 's' ) 674 DO k = k_topo, k_topo + pch_index_ji(j,i) 675 local_pf(i,j,k) = pc_transpiration_rate(k-k_topo,j,i) 676 ENDDO 677 ENDIF 678 ENDDO 679 ENDDO 680 ENDIF 681 682 CASE ( 'pcm_latentrate' ) 683 IF ( av == 0 ) THEN 684 DO i = nxl, nxr 685 DO j = nys, nyn 686 IF ( pch_index_ji(j,i) /= 0 ) THEN 687 k_topo = get_topography_top_index_ji( j, i, 's' ) 688 DO k = k_topo, k_topo + pch_index_ji(j,i) 689 local_pf(i,j,k) = pc_latent_rate(k-k_topo,j,i) 690 ENDDO 691 ENDIF 692 ENDDO 693 ENDDO 694 ENDIF 872 IF ( av == 0 ) THEN 873 DO i = nxl, nxr 874 DO j = nys, nyn 875 IF ( pch_index_ji(j,i) /= 0 ) THEN 876 DO k = nzb_do, nzt_do 877 local_pf(i,j,k) = pc_transpiration_rate(k,j,i) 878 ENDDO 879 ENDIF 880 ENDDO 881 ENDDO 882 ELSE 883 DO i = nxl, nxr 884 DO j = nys, nyn 885 DO k = nzb_do, nzt_do 886 local_pf(i,j,k) = pcm_transpirationrate_av(k,j,i) 887 ENDDO 888 ENDDO 889 ENDDO 890 ENDIF 695 891 696 892 CASE ( 'pcm_bowenratio' ) 697 IF ( av == 0 ) THEN 698 DO i = nxl, nxr 699 DO j = nys, nyn 700 IF ( pch_index_ji(j,i) /= 0 ) THEN 701 k_topo = get_topography_top_index_ji( j, i, 's' ) 702 DO k = k_topo, k_topo + pch_index_ji(j,i) 703 IF ( pc_latent_rate(k-k_topo,j,i) /= 0._wp ) THEN 704 local_pf(i,j,k) = pc_heating_rate(k-k_topo,j,i) / & 705 pc_latent_rate(k-k_topo,j,i) 706 ENDIF 707 ENDDO 708 ENDIF 709 ENDDO 710 ENDDO 711 ENDIF 712 713 CASE ( 'pcm_lad' ) 714 IF ( av == 0 ) THEN 715 DO i = nxl, nxr 716 DO j = nys, nyn 717 IF ( pch_index_ji(j,i) /= 0 ) THEN 718 k_topo = get_topography_top_index_ji( j, i, 's' ) 719 DO k = k_topo, k_topo + pch_index_ji(j,i) 720 local_pf(i,j,k) = lad_s(k-k_topo,j,i) 721 ENDDO 722 ENDIF 723 ENDDO 724 ENDDO 725 ENDIF 726 727 893 IF ( av == 0 ) THEN 894 DO i = nxl, nxr 895 DO j = nys, nyn 896 IF ( pch_index_ji(j,i) /= 0 ) THEN 897 DO k = nzb_do, nzt_do 898 IF ( pc_latent_rate(k,j,i) /= 0._wp ) THEN 899 local_pf(i,j,k) = pc_heating_rate(k,j,i) / & 900 pc_latent_rate(k,j,i) 901 ENDIF 902 ENDDO 903 ENDIF 904 ENDDO 905 ENDDO 906 ENDIF 907 908 CASE ( 'pcm_lad' ) 909 IF ( av == 0 ) THEN 910 DO i = nxl, nxr 911 DO j = nys, nyn 912 IF ( pch_index_ji(j,i) /= 0 ) THEN 913 DO k = nzb_do, nzt_do 914 local_pf(i,j,k) = lad_s(k,j,i) 915 ENDDO 916 ENDIF 917 ENDDO 918 ENDDO 919 ENDIF 920 728 921 CASE DEFAULT 729 922 found = .FALSE. … … 760 953 grid_x = 'x' 761 954 grid_y = 'y' 762 grid_z = 'z u'955 grid_z = 'zpc' 763 956 764 957 CASE DEFAULT -
palm/trunk/SOURCE/radiation_model_mod.f90
r4089 r4127 28 28 ! ----------------- 29 29 ! $Id$ 30 ! Remove unused pch_index (merge from branch resler) 31 ! 32 ! 4089 2019-07-11 14:30:27Z suehring 30 33 ! - Correct level 2 initialization of spectral albedos in rrtmg branch, long- and 31 34 ! shortwave albedos were mixed-up. … … 6194 6197 USE control_parameters, & 6195 6198 ONLY: dz_stretch_level_start 6196 6197 USE netcdf_data_input_mod, &6198 ONLY: leaf_area_density_f6199 6199 6200 6200 USE plant_canopy_model_mod, & 6201 ONLY: pch_index,lad_s6201 ONLY: lad_s 6202 6202 6203 6203 IMPLICIT NONE … … 6259 6259 nzutl = MAX( nzutl, MAXVAL( pct ) ) 6260 6260 nzptl = MAXVAL( pct ) 6261 !-- code of plant canopy model uses parameter pch_index6262 !-- we need to setup it here to right value6263 !-- (pch_index, lad_s and other arrays in PCM are defined flat)6264 pch_index = MERGE( leaf_area_density_f%nz - 1, MAXVAL( pch ), &6265 leaf_area_density_f%from_file )6266 6261 6267 6262 prototype_lad = MAXVAL( lad_s ) * .9_wp !< better be *1.0 if lad is either 0 or maxval(lad) everywhere -
palm/trunk/SOURCE/urban_surface_mod.f90
r4077 r4127 28 28 ! ----------------- 29 29 ! $Id$ 30 ! Do not add anthopogenic energy during wall/soil spin-up 31 ! (merge from branch resler) 32 ! 33 ! 4077 2019-07-09 13:27:11Z gronemeier 30 34 ! Set roughness length z0 and z0h/q at ground-floor level to same value as 31 35 ! those above ground-floor level … … 8590 8594 ! 8591 8595 !-- Add-up anthropogenic heat, for now only at upward-facing surfaces 8592 IF ( usm_anthropogenic_heat .AND. &8596 IF ( usm_anthropogenic_heat .AND. .NOT. during_spinup .AND. & 8593 8597 intermediate_timestep_count == intermediate_timestep_count_max ) THEN 8594 8598 !
Note: See TracChangeset
for help on using the changeset viewer.
