Changeset 4127 for palm/trunk/SOURCE/plant_canopy_model_mod.f90
- Timestamp:
- Jul 30, 2019 2:47:10 PM (5 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/plant_canopy_model_mod.f90 (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
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
Note: See TracChangeset
for help on using the changeset viewer.
