Changeset 4220
 Timestamp:
 Sep 5, 2019 4:42:39 PM (3 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

palm/trunk/SOURCE/plant_canopy_model_mod.f90
r4216 r4220 27 27 !  28 28 ! $Id$ 29 ! Further bugfix in 3d data output for plant canopy 30 ! 31 ! 4216 20190904 09:09:03Z suehring 29 32 ! Bugfixes in 3d data output 30 33 ! … … 633 636 INTEGER(iwp) :: j !< grid index ydirection 634 637 INTEGER(iwp) :: k !< grid index zdirection 635 INTEGER(iwp) :: kk !< grid index zdirection relative to canopy arrays636 638 INTEGER(iwp) :: nzb_do !< lower limit of the data output (usually 0) 637 639 INTEGER(iwp) :: nzt_do !< vertical upper limit of the data output (usually nz_do3d) … … 652 654 ! Thus, output must be relative to these array indices. Further, check 653 655 ! whether the output is within the vertical output range, 654 ! i.e. nzb_do:nzt_do. 656 ! i.e. nzb_do:nzt_do, which is necessary as local_pf is only allocated 657 ! for this index space. Note, plantcanopy output has a separate 658 ! vertical output coordinate zlad, so that output is mapped down to the 659 ! surface. 655 660 CASE ( 'pcm_heatrate' ) 656 661 IF ( av == 0 ) THEN 657 662 DO i = nxl, nxr 658 663 DO j = nys, nyn 659 DO k = MAX( topo_top_ind(j,i,0)+1, nzb_do ), & 660 MIN( topo_top_ind(j,i,0) + pch_index_ji(j,i), nzt_do ) 661 kk = k  topo_top_ind(j,i,0) 662 local_pf(i,j,k) = pc_heating_rate(kk,j,i) 664 DO k = MAX( 1, nzb_do ), MIN( pch_index, nzt_do ) 665 local_pf(i,j,k) = pc_heating_rate(k,j,i) 663 666 ENDDO 664 667 ENDDO … … 667 670 DO i = nxl, nxr 668 671 DO j = nys, nyn 669 DO k = MAX( topo_top_ind(j,i,0)+1, nzb_do ), & 670 MIN( topo_top_ind(j,i,0) + pch_index_ji(j,i), nzt_do ) 671 kk = k  topo_top_ind(j,i,0) 672 local_pf(i,j,k) = pcm_heatrate_av(kk,j,i) 672 DO k = MAX( 1, nzb_do ), MIN( pch_index, nzt_do ) 673 local_pf(i,j,k) = pcm_heatrate_av(k,j,i) 673 674 ENDDO 674 675 ENDDO … … 680 681 DO i = nxl, nxr 681 682 DO j = nys, nyn 682 DO k = MAX( topo_top_ind(j,i,0)+1, nzb_do ), & 683 MIN( topo_top_ind(j,i,0) + pch_index_ji(j,i), nzt_do ) 684 kk = k  topo_top_ind(j,i,0) 685 local_pf(i,j,k) = pc_latent_rate(kk,j,i) 683 DO k = MAX( 1, nzb_do ), MIN( pch_index, nzt_do ) 684 local_pf(i,j,k) = pc_latent_rate(k,j,i) 686 685 ENDDO 687 686 ENDDO … … 690 689 DO i = nxl, nxr 691 690 DO j = nys, nyn 692 DO k = MAX( topo_top_ind(j,i,0)+1, nzb_do ), & 693 MIN( topo_top_ind(j,i,0) + pch_index_ji(j,i), nzt_do ) 694 kk = k  topo_top_ind(j,i,0) 695 local_pf(i,j,k) = pcm_latentrate_av(kk,j,i) 691 DO k = MAX( 1, nzb_do ), MIN( pch_index, nzt_do ) 692 local_pf(i,j,k) = pcm_latentrate_av(k,j,i) 696 693 ENDDO 697 694 ENDDO … … 703 700 DO i = nxl, nxr 704 701 DO j = nys, nyn 705 DO k = MAX( topo_top_ind(j,i,0)+1, nzb_do ), & 706 MIN( topo_top_ind(j,i,0) + pch_index_ji(j,i), nzt_do ) 707 kk = k  topo_top_ind(j,i,0) 708 local_pf(i,j,k) = pc_transpiration_rate(kk,j,i) 702 DO k = MAX( 1, nzb_do ), MIN( pch_index, nzt_do ) 703 local_pf(i,j,k) = pc_transpiration_rate(k,j,i) 709 704 ENDDO 710 705 ENDDO … … 713 708 DO i = nxl, nxr 714 709 DO j = nys, nyn 715 DO k = MAX( topo_top_ind(j,i,0)+1, nzb_do ), & 716 MIN( topo_top_ind(j,i,0) + pch_index_ji(j,i), nzt_do ) 717 kk = k  topo_top_ind(j,i,0) 718 local_pf(i,j,k) = pcm_transpirationrate_av(kk,j,i) 710 DO k = MAX( 1, nzb_do ), MIN( pch_index, nzt_do ) 711 local_pf(i,j,k) = pcm_transpirationrate_av(k,j,i) 719 712 ENDDO 720 713 ENDDO … … 726 719 DO i = nxl, nxr 727 720 DO j = nys, nyn 728 DO k = MAX( topo_top_ind(j,i,0)+1, nzb_do ), & 729 MIN( topo_top_ind(j,i,0) + pch_index_ji(j,i), nzt_do ) 730 kk = k  topo_top_ind(j,i,0) 731 IF ( pc_latent_rate(kk,j,i) /= 0.0_wp ) THEN 732 local_pf(i,j,k) = pc_heating_rate(kk,j,i) / & 733 pc_latent_rate(kk,j,i) 721 DO k = MAX( 1, nzb_do ), MIN( pch_index, nzt_do ) 722 IF ( pc_latent_rate(k,j,i) /= 0.0_wp ) THEN 723 local_pf(i,j,k) = pc_heating_rate(k,j,i) / & 724 pc_latent_rate(k,j,i) 734 725 ENDIF 735 726 ENDDO … … 739 730 DO i = nxl, nxr 740 731 DO j = nys, nyn 741 DO k = MAX( topo_top_ind(j,i,0)+1, nzb_do ), & 742 MIN( topo_top_ind(j,i,0) + pch_index_ji(j,i), nzt_do ) 743 kk = k  topo_top_ind(j,i,0) 744 IF ( pcm_latentrate_av(kk,j,i) /= 0.0_wp ) THEN 745 local_pf(i,j,k) = pcm_heatrate_av(kk,j,i) / & 746 pcm_latentrate_av(kk,j,i) 732 DO k = MAX( 1, nzb_do ), MIN( pch_index, nzt_do ) 733 IF ( pcm_latentrate_av(k,j,i) /= 0.0_wp ) THEN 734 local_pf(i,j,k) = pcm_heatrate_av(k,j,i) / & 735 pcm_latentrate_av(k,j,i) 747 736 ENDIF 748 737 ENDDO … … 755 744 DO i = nxl, nxr 756 745 DO j = nys, nyn 757 DO k = MAX( topo_top_ind(j,i,0)+1, nzb_do ), & 758 MIN( topo_top_ind(j,i,0) + pch_index_ji(j,i), nzt_do ) 759 kk = k  topo_top_ind(j,i,0) 760 local_pf(i,j,k) = lad_s(kk,j,i) 746 DO k = MAX( 1, nzb_do ), MIN( pch_index, nzt_do ) 747 local_pf(i,j,k) = lad_s(k,j,i) 761 748 ENDDO 762 749 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.