Changeset 4216
- Timestamp:
- Sep 4, 2019 9:09:03 AM (5 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/plant_canopy_model_mod.f90 (modified) (13 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/plant_canopy_model_mod.f90
r4205 r4216 27 27 ! ----------------- 28 28 ! $Id$ 29 ! Bugfixes in 3d data output 30 ! 31 ! 4205 2019-08-30 13:25:00Z suehring 29 32 ! Missing working precision + bugfix in calculation of wind speed 30 33 ! … … 75 78 ! 76 79 ! @todo - precalculate constant terms in pcm_calc_transpiration_rate 80 ! @todo - unify variable names (pcm_, pc_, ...) 77 81 !------------------------------------------------------------------------------! 78 82 MODULE plant_canopy_model_mod … … 452 456 !> Subroutine for averaging 3D data 453 457 !------------------------------------------------------------------------------! 454 SUBROUTINE pcm_3d_data_averaging( mode, variable )458 SUBROUTINE pcm_3d_data_averaging( mode, variable ) 455 459 456 460 … … 602 606 ENDIF 603 607 604 END SUBROUTINE pcm_3d_data_averaging608 END SUBROUTINE pcm_3d_data_averaging 605 609 606 610 !------------------------------------------------------------------------------! … … 623 627 IMPLICIT NONE 624 628 625 CHARACTER (LEN=*) :: variable !< 626 627 INTEGER(iwp) :: av !< 628 INTEGER(iwp) :: i !< 629 INTEGER(iwp) :: j !< 630 INTEGER(iwp) :: k !< 629 CHARACTER (LEN=*) :: variable !< treated variable 630 631 INTEGER(iwp) :: av !< flag indicating instantaneous or averaged data output 632 INTEGER(iwp) :: i !< grid index x-direction 633 INTEGER(iwp) :: j !< grid index y-direction 634 INTEGER(iwp) :: k !< grid index z-direction 635 INTEGER(iwp) :: kk !< grid index z-direction relative to canopy arrays 631 636 INTEGER(iwp) :: nzb_do !< lower limit of the data output (usually 0) 632 637 INTEGER(iwp) :: nzt_do !< vertical upper limit of the data output (usually nz_do3d) 633 638 634 LOGICAL :: found !<635 636 REAL(wp) :: fill_value 637 REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< 639 LOGICAL :: found !< flag indicating if variable is found 640 641 REAL(wp) :: fill_value !< fill value 642 REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< data output array 638 643 639 644 … … 643 648 644 649 SELECT CASE ( TRIM( variable ) ) 645 650 ! 651 !-- Note, to save memory arrays for heating are allocated from 0:pch_index. 652 !-- Thus, output must be relative to these array indices. Further, check 653 !-- whether the output is within the vertical output range, 654 !-- i.e. nzb_do:nzt_do. 646 655 CASE ( 'pcm_heatrate' ) 647 656 IF ( av == 0 ) THEN 648 657 DO i = nxl, nxr 649 658 DO j = nys, nyn 650 IF ( pch_index_ji(j,i) /= 0 ) THEN651 DO k = nzb_do, nzt_do652 local_pf(i,j,k) = pc_heating_rate(k,j,i)653 ENDDO654 END IF659 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) 663 ENDDO 655 664 ENDDO 656 665 ENDDO … … 658 667 DO i = nxl, nxr 659 668 DO j = nys, nyn 660 DO k = nzb_do, nzt_do 661 local_pf(i,j,k) = pcm_heatrate_av(k,j,i) 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) 662 673 ENDDO 663 674 ENDDO … … 669 680 DO i = nxl, nxr 670 681 DO j = nys, nyn 671 IF ( pch_index_ji(j,i) /= 0 ) THEN672 DO k = nzb_do, nzt_do673 local_pf(i,j,k) = pc_latent_rate(k,j,i)674 ENDDO675 END IF682 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) 686 ENDDO 676 687 ENDDO 677 688 ENDDO … … 679 690 DO i = nxl, nxr 680 691 DO j = nys, nyn 681 DO k = nzb_do, nzt_do 682 local_pf(i,j,k) = pcm_latentrate_av(k,j,i) 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) 683 696 ENDDO 684 697 ENDDO … … 690 703 DO i = nxl, nxr 691 704 DO j = nys, nyn 692 IF ( pch_index_ji(j,i) /= 0 ) THEN693 DO k = nzb_do, nzt_do694 local_pf(i,j,k) = pc_transpiration_rate(k,j,i)695 ENDDO696 END IF705 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) 709 ENDDO 697 710 ENDDO 698 711 ENDDO … … 700 713 DO i = nxl, nxr 701 714 DO j = nys, nyn 702 DO k = nzb_do, nzt_do 703 local_pf(i,j,k) = pcm_transpirationrate_av(k,j,i) 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) 704 719 ENDDO 705 720 ENDDO … … 711 726 DO i = nxl, nxr 712 727 DO j = nys, nyn 713 IF ( pch_index_ji(j,i) /= 0 ) THEN 714 DO k = nzb_do, nzt_do 715 IF ( pc_latent_rate(k,j,i) /= 0._wp ) THEN 716 local_pf(i,j,k) = pc_heating_rate(k,j,i) / & 717 pc_latent_rate(k,j,i) 718 ENDIF 719 ENDDO 720 ENDIF 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) 734 ENDIF 735 ENDDO 736 ENDDO 737 ENDDO 738 ELSE 739 DO i = nxl, nxr 740 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) 747 ENDIF 748 ENDDO 721 749 ENDDO 722 750 ENDDO … … 727 755 DO i = nxl, nxr 728 756 DO j = nys, nyn 729 IF ( pch_index_ji(j,i) /= 0 ) THEN730 DO k = nzb_do, nzt_do731 local_pf(i,j,k) = lad_s(k,j,i)732 ENDDO733 END IF757 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) 761 ENDDO 734 762 ENDDO 735 763 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.
