Changeset 3004 for palm/trunk/SOURCE/sum_up_3d_data.f90
- Timestamp:
- Apr 27, 2018 12:33:25 PM (6 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/sum_up_3d_data.f90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/sum_up_3d_data.f90
r2963 r3004 25 25 ! ----------------- 26 26 ! $Id$ 27 ! prr field added to ONLY-list, prr* case/pr* case/precipitation_rate_av 28 ! removed, further allocation checks implemented 29 ! 30 ! 2963 2018-04-12 14:47:44Z suehring 27 31 ! Introduce index for vegetation/wall, pavement/green-wall and water/window 28 32 ! surfaces, for clearer access of surface fraction, albedo, emissivity, etc. . … … 182 186 183 187 USE arrays_3d, & 184 ONLY: dzw, e, heatflux_output_conversion, nc, nr, p, pt, & 185 precipitation_rate, q, qc, ql, ql_c, & 186 ql_v, qr, rho_ocean, s, sa, u, v, vpt, w, & 188 ONLY: dzw, e, heatflux_output_conversion, nc, nr, p, prr, pt, & 189 q, qc, ql, ql_c, ql_v, qr, rho_ocean, s, sa, u, v, vpt, w, & 187 190 waterflux_output_conversion 188 191 … … 190 193 ONLY: diss_av, e_av, ghf_av, kh_av, km_av, lpt_av, lwp_av, nc_av, & 191 194 nr_av, & 192 ol_av, p_av, pc_av, pr_av, prr_av, precipitation_rate_av, pt_av,& 193 q_av, qc_av, ql_av, ql_c_av, ql_v_av, ql_vp_av, qr_av, qsws_av, & 194 qv_av, r_a_av, rho_ocean_av, s_av, sa_av, shf_av, ssws_av, & 195 ts_av, tsurf_av, u_av, us_av, v_av, vpt_av, w_av, z0_av, z0h_av,& 196 z0q_av 195 ol_av, p_av, pc_av, pr_av, prr_av, pt_av, q_av, qc_av, ql_av, & 196 ql_c_av, ql_v_av, ql_vp_av, qr_av, qsws_av, qv_av, r_a_av, & 197 rho_ocean_av, s_av, sa_av, shf_av, ssws_av, ts_av, tsurf_av, & 198 u_av, us_av, v_av, vpt_av, w_av, z0_av, z0h_av, z0q_av 197 199 USE chemistry_model_mod, & 198 200 ONLY: chem_3d_data_averaging, chem_integrate, chem_species, nspec … … 342 344 prr_av = 0.0_wp 343 345 344 CASE ( 'prr*' )345 IF ( .NOT. ALLOCATED( precipitation_rate_av ) ) THEN346 ALLOCATE( precipitation_rate_av(nysg:nyng,nxlg:nxrg) )347 ENDIF348 precipitation_rate_av = 0.0_wp349 350 346 CASE ( 'pt' ) 351 347 IF ( .NOT. ALLOCATED( pt_av ) ) THEN … … 573 569 574 570 CASE ( 'ghf*' ) 575 DO m = 1, surf_lsm_h%ns 576 i = surf_lsm_h%i(m) 577 j = surf_lsm_h%j(m) 578 ghf_av(j,i) = ghf_av(j,i) + surf_lsm_h%ghf(m) 579 ENDDO 580 581 DO m = 1, surf_usm_h%ns 582 i = surf_usm_h%i(m) 583 j = surf_usm_h%j(m) 584 ghf_av(j,i) = ghf_av(j,i) + surf_usm_h%frac(ind_veg_wall,m) * & 585 surf_usm_h%wghf_eb(m) + & 586 surf_usm_h%frac(ind_pav_green,m) * & 587 surf_usm_h%wghf_eb_green(m) + & 588 surf_usm_h%frac(ind_wat_win,m) * & 589 surf_usm_h%wghf_eb_window(m) 590 ENDDO 571 IF ( ALLOCATED( ghf_av ) ) THEN 572 DO m = 1, surf_lsm_h%ns 573 i = surf_lsm_h%i(m) 574 j = surf_lsm_h%j(m) 575 ghf_av(j,i) = ghf_av(j,i) + surf_lsm_h%ghf(m) 576 ENDDO 577 578 DO m = 1, surf_usm_h%ns 579 i = surf_usm_h%i(m) 580 j = surf_usm_h%j(m) 581 ghf_av(j,i) = ghf_av(j,i) + surf_usm_h%frac(ind_veg_wall,m) * & 582 surf_usm_h%wghf_eb(m) + & 583 surf_usm_h%frac(ind_pav_green,m) * & 584 surf_usm_h%wghf_eb_green(m) + & 585 surf_usm_h%frac(ind_wat_win,m) * & 586 surf_usm_h%wghf_eb_window(m) 587 ENDDO 588 ENDIF 591 589 592 590 CASE ( 'e' ) 593 DO i = nxlg, nxrg 594 DO j = nysg, nyng 595 DO k = nzb, nzt+1 596 e_av(k,j,i) = e_av(k,j,i) + e(k,j,i) 597 ENDDO 598 ENDDO 599 ENDDO 591 IF ( ALLOCATED( e_av ) ) THEN 592 DO i = nxlg, nxrg 593 DO j = nysg, nyng 594 DO k = nzb, nzt+1 595 e_av(k,j,i) = e_av(k,j,i) + e(k,j,i) 596 ENDDO 597 ENDDO 598 ENDDO 599 ENDIF 600 600 601 601 CASE ( 'lpt' ) 602 DO i = nxlg, nxrg 603 DO j = nysg, nyng 604 DO k = nzb, nzt+1 605 lpt_av(k,j,i) = lpt_av(k,j,i) + pt(k,j,i) 606 ENDDO 607 ENDDO 608 ENDDO 602 IF ( ALLOCATED( lpt_av ) ) THEN 603 DO i = nxlg, nxrg 604 DO j = nysg, nyng 605 DO k = nzb, nzt+1 606 lpt_av(k,j,i) = lpt_av(k,j,i) + pt(k,j,i) 607 ENDDO 608 ENDDO 609 ENDDO 610 ENDIF 609 611 610 612 CASE ( 'lwp*' ) 611 DO i = nxlg, nxrg 612 DO j = nysg, nyng 613 lwp_av(j,i) = lwp_av(j,i) + SUM( ql(nzb:nzt,j,i) & 614 * dzw(1:nzt+1) ) * rho_surface 615 ENDDO 616 ENDDO 613 IF ( ALLOCATED( lwp_av ) ) THEN 614 DO i = nxlg, nxrg 615 DO j = nysg, nyng 616 lwp_av(j,i) = lwp_av(j,i) + SUM( ql(nzb:nzt,j,i) & 617 * dzw(1:nzt+1) ) * rho_surface 618 ENDDO 619 ENDDO 620 ENDIF 617 621 618 622 CASE ( 'nc' ) 619 DO i = nxlg, nxrg 620 DO j = nysg, nyng 621 DO k = nzb, nzt+1 622 nc_av(k,j,i) = nc_av(k,j,i) + nc(k,j,i) 623 ENDDO 624 ENDDO 625 ENDDO 623 IF ( ALLOCATED( nc_av ) ) THEN 624 DO i = nxlg, nxrg 625 DO j = nysg, nyng 626 DO k = nzb, nzt+1 627 nc_av(k,j,i) = nc_av(k,j,i) + nc(k,j,i) 628 ENDDO 629 ENDDO 630 ENDDO 631 ENDIF 626 632 627 633 CASE ( 'nr' ) 628 DO i = nxlg, nxrg 629 DO j = nysg, nyng 630 DO k = nzb, nzt+1 631 nr_av(k,j,i) = nr_av(k,j,i) + nr(k,j,i) 632 ENDDO 633 ENDDO 634 ENDDO 634 IF ( ALLOCATED( nr_av ) ) THEN 635 DO i = nxlg, nxrg 636 DO j = nysg, nyng 637 DO k = nzb, nzt+1 638 nr_av(k,j,i) = nr_av(k,j,i) + nr(k,j,i) 639 ENDDO 640 ENDDO 641 ENDDO 642 ENDIF 635 643 636 644 CASE ( 'ol*' ) 637 DO m = 1, surf_def_h(0)%ns 638 i = surf_def_h(0)%i(m) 639 j = surf_def_h(0)%j(m) 640 ol_av(j,i) = ol_av(j,i) + surf_def_h(0)%ol(m) 641 ENDDO 642 DO m = 1, surf_lsm_h%ns 643 i = surf_lsm_h%i(m) 644 j = surf_lsm_h%j(m) 645 ol_av(j,i) = ol_av(j,i) + surf_lsm_h%ol(m) 646 ENDDO 647 DO m = 1, surf_usm_h%ns 648 i = surf_usm_h%i(m) 649 j = surf_usm_h%j(m) 650 ol_av(j,i) = ol_av(j,i) + surf_usm_h%ol(m) 651 ENDDO 645 IF ( ALLOCATED( ol_av ) ) THEN 646 DO m = 1, surf_def_h(0)%ns 647 i = surf_def_h(0)%i(m) 648 j = surf_def_h(0)%j(m) 649 ol_av(j,i) = ol_av(j,i) + surf_def_h(0)%ol(m) 650 ENDDO 651 DO m = 1, surf_lsm_h%ns 652 i = surf_lsm_h%i(m) 653 j = surf_lsm_h%j(m) 654 ol_av(j,i) = ol_av(j,i) + surf_lsm_h%ol(m) 655 ENDDO 656 DO m = 1, surf_usm_h%ns 657 i = surf_usm_h%i(m) 658 j = surf_usm_h%j(m) 659 ol_av(j,i) = ol_av(j,i) + surf_usm_h%ol(m) 660 ENDDO 661 ENDIF 652 662 653 663 CASE ( 'p' ) 654 DO i = nxlg, nxrg 655 DO j = nysg, nyng 656 DO k = nzb, nzt+1 657 p_av(k,j,i) = p_av(k,j,i) + p(k,j,i) 658 ENDDO 659 ENDDO 660 ENDDO 664 IF ( ALLOCATED( p_av ) ) THEN 665 DO i = nxlg, nxrg 666 DO j = nysg, nyng 667 DO k = nzb, nzt+1 668 p_av(k,j,i) = p_av(k,j,i) + p(k,j,i) 669 ENDDO 670 ENDDO 671 ENDDO 672 ENDIF 661 673 662 674 CASE ( 'pc' ) 663 DO i = nxl, nxr 664 DO j = nys, nyn 665 DO k = nzb, nzt+1 666 pc_av(k,j,i) = pc_av(k,j,i) + prt_count(k,j,i) 667 ENDDO 668 ENDDO 669 ENDDO 675 IF ( ALLOCATED( pc_av ) ) THEN 676 DO i = nxl, nxr 677 DO j = nys, nyn 678 DO k = nzb, nzt+1 679 pc_av(k,j,i) = pc_av(k,j,i) + prt_count(k,j,i) 680 ENDDO 681 ENDDO 682 ENDDO 683 ENDIF 670 684 671 685 CASE ( 'pr' ) 672 DO i = nxl, nxr 673 DO j = nys, nyn 674 DO k = nzb, nzt+1 675 number_of_particles = prt_count(k,j,i) 676 IF ( number_of_particles <= 0 ) CYCLE 677 particles => grid_particles(k,j,i)%particles(1:number_of_particles) 678 s_r2 = 0.0_wp 679 s_r3 = 0.0_wp 680 681 DO n = 1, number_of_particles 682 IF ( particles(n)%particle_mask ) THEN 683 s_r2 = s_r2 + particles(n)%radius**2 * & 684 particles(n)%weight_factor 685 s_r3 = s_r3 + particles(n)%radius**3 * & 686 particles(n)%weight_factor 686 IF ( ALLOCATED( pr_av ) ) THEN 687 DO i = nxl, nxr 688 DO j = nys, nyn 689 DO k = nzb, nzt+1 690 number_of_particles = prt_count(k,j,i) 691 IF ( number_of_particles <= 0 ) CYCLE 692 particles => & 693 grid_particles(k,j,i)%particles(1:number_of_particles) 694 s_r2 = 0.0_wp 695 s_r3 = 0.0_wp 696 697 DO n = 1, number_of_particles 698 IF ( particles(n)%particle_mask ) THEN 699 s_r2 = s_r2 + particles(n)%radius**2 * & 700 particles(n)%weight_factor 701 s_r3 = s_r3 + particles(n)%radius**3 * & 702 particles(n)%weight_factor 703 ENDIF 704 ENDDO 705 706 IF ( s_r2 > 0.0_wp ) THEN 707 mean_r = s_r3 / s_r2 708 ELSE 709 mean_r = 0.0_wp 687 710 ENDIF 688 ENDDO 689 690 IF ( s_r2 > 0.0_wp ) THEN 691 mean_r = s_r3 / s_r2 692 ELSE 693 mean_r = 0.0_wp 694 ENDIF 695 pr_av(k,j,i) = pr_av(k,j,i) + mean_r 696 ENDDO 697 ENDDO 698 ENDDO 699 700 701 CASE ( 'pr*' ) 702 DO i = nxlg, nxrg 703 DO j = nysg, nyng 704 precipitation_rate_av(j,i) = precipitation_rate_av(j,i) + & 705 precipitation_rate(j,i) 706 ENDDO 707 ENDDO 711 pr_av(k,j,i) = pr_av(k,j,i) + mean_r 712 ENDDO 713 ENDDO 714 ENDDO 715 ENDIF 716 717 CASE ( 'prr' ) 718 IF ( ALLOCATED( prr_av ) ) THEN 719 DO i = nxlg, nxrg 720 DO j = nysg, nyng 721 DO k = nzb, nzt+1 722 prr_av(k,j,i) = prr_av(k,j,i) + prr(k,j,i) 723 ENDDO 724 ENDDO 725 ENDDO 726 ENDIF 708 727 709 728 CASE ( 'pt' ) 710 IF ( .NOT. cloud_physics ) THEN 711 DO i = nxlg, nxrg 712 DO j = nysg, nyng 713 DO k = nzb, nzt+1 714 pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i) 715 ENDDO 716 ENDDO 717 ENDDO 718 ELSE 719 DO i = nxlg, nxrg 720 DO j = nysg, nyng 721 DO k = nzb, nzt+1 722 pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i) + l_d_cp * & 723 pt_d_t(k) * ql(k,j,i) 724 ENDDO 725 ENDDO 726 ENDDO 729 IF ( ALLOCATED( pt_av ) ) THEN 730 IF ( .NOT. cloud_physics ) THEN 731 DO i = nxlg, nxrg 732 DO j = nysg, nyng 733 DO k = nzb, nzt+1 734 pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i) 735 ENDDO 736 ENDDO 737 ENDDO 738 ELSE 739 DO i = nxlg, nxrg 740 DO j = nysg, nyng 741 DO k = nzb, nzt+1 742 pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i) + l_d_cp * & 743 pt_d_t(k) * ql(k,j,i) 744 ENDDO 745 ENDDO 746 ENDDO 747 ENDIF 727 748 ENDIF 728 749 729 750 CASE ( 'q' ) 730 DO i = nxlg, nxrg 731 DO j = nysg, nyng 732 DO k = nzb, nzt+1 733 q_av(k,j,i) = q_av(k,j,i) + q(k,j,i) 734 ENDDO 735 ENDDO 736 ENDDO 751 IF ( ALLOCATED( q_av ) ) THEN 752 DO i = nxlg, nxrg 753 DO j = nysg, nyng 754 DO k = nzb, nzt+1 755 q_av(k,j,i) = q_av(k,j,i) + q(k,j,i) 756 ENDDO 757 ENDDO 758 ENDDO 759 ENDIF 737 760 738 761 CASE ( 'qc' ) 739 DO i = nxlg, nxrg 740 DO j = nysg, nyng 741 DO k = nzb, nzt+1 742 qc_av(k,j,i) = qc_av(k,j,i) + qc(k,j,i) 743 ENDDO 744 ENDDO 745 ENDDO 762 IF ( ALLOCATED( qc_av ) ) THEN 763 DO i = nxlg, nxrg 764 DO j = nysg, nyng 765 DO k = nzb, nzt+1 766 qc_av(k,j,i) = qc_av(k,j,i) + qc(k,j,i) 767 ENDDO 768 ENDDO 769 ENDDO 770 ENDIF 746 771 747 772 CASE ( 'ql' ) 748 DO i = nxlg, nxrg 749 DO j = nysg, nyng 750 DO k = nzb, nzt+1 751 ql_av(k,j,i) = ql_av(k,j,i) + ql(k,j,i) 752 ENDDO 753 ENDDO 754 ENDDO 773 IF ( ALLOCATED( ql_av ) ) THEN 774 DO i = nxlg, nxrg 775 DO j = nysg, nyng 776 DO k = nzb, nzt+1 777 ql_av(k,j,i) = ql_av(k,j,i) + ql(k,j,i) 778 ENDDO 779 ENDDO 780 ENDDO 781 ENDIF 755 782 756 783 CASE ( 'ql_c' ) 757 DO i = nxlg, nxrg 758 DO j = nysg, nyng 759 DO k = nzb, nzt+1 760 ql_c_av(k,j,i) = ql_c_av(k,j,i) + ql_c(k,j,i) 761 ENDDO 762 ENDDO 763 ENDDO 784 IF ( ALLOCATED( ql_c_av ) ) THEN 785 DO i = nxlg, nxrg 786 DO j = nysg, nyng 787 DO k = nzb, nzt+1 788 ql_c_av(k,j,i) = ql_c_av(k,j,i) + ql_c(k,j,i) 789 ENDDO 790 ENDDO 791 ENDDO 792 ENDIF 764 793 765 794 CASE ( 'ql_v' ) 766 DO i = nxlg, nxrg 767 DO j = nysg, nyng 768 DO k = nzb, nzt+1 769 ql_v_av(k,j,i) = ql_v_av(k,j,i) + ql_v(k,j,i) 770 ENDDO 771 ENDDO 772 ENDDO 795 IF ( ALLOCATED( ql_v_av ) ) THEN 796 DO i = nxlg, nxrg 797 DO j = nysg, nyng 798 DO k = nzb, nzt+1 799 ql_v_av(k,j,i) = ql_v_av(k,j,i) + ql_v(k,j,i) 800 ENDDO 801 ENDDO 802 ENDDO 803 ENDIF 773 804 774 805 CASE ( 'ql_vp' ) 775 DO i = nxl, nxr 776 DO j = nys, nyn 777 DO k = nzb, nzt+1 778 number_of_particles = prt_count(k,j,i) 779 IF ( number_of_particles <= 0 ) CYCLE 780 particles => grid_particles(k,j,i)%particles(1:number_of_particles) 781 DO n = 1, number_of_particles 782 IF ( particles(n)%particle_mask ) THEN 783 ql_vp_av(k,j,i) = ql_vp_av(k,j,i) + & 784 particles(n)%weight_factor / & 785 number_of_particles 786 ENDIF 787 ENDDO 788 ENDDO 789 ENDDO 790 ENDDO 806 IF ( ALLOCATED( ql_vp_av ) ) THEN 807 DO i = nxl, nxr 808 DO j = nys, nyn 809 DO k = nzb, nzt+1 810 number_of_particles = prt_count(k,j,i) 811 IF ( number_of_particles <= 0 ) CYCLE 812 particles => & 813 grid_particles(k,j,i)%particles(1:number_of_particles) 814 DO n = 1, number_of_particles 815 IF ( particles(n)%particle_mask ) THEN 816 ql_vp_av(k,j,i) = ql_vp_av(k,j,i) + & 817 particles(n)%weight_factor / & 818 number_of_particles 819 ENDIF 820 ENDDO 821 ENDDO 822 ENDDO 823 ENDDO 824 ENDIF 791 825 792 826 CASE ( 'qr' ) 793 DO i = nxlg, nxrg 794 DO j = nysg, nyng 795 DO k = nzb, nzt+1 796 qr_av(k,j,i) = qr_av(k,j,i) + qr(k,j,i) 797 ENDDO 798 ENDDO 799 ENDDO 827 IF ( ALLOCATED( qr_av ) ) THEN 828 DO i = nxlg, nxrg 829 DO j = nysg, nyng 830 DO k = nzb, nzt+1 831 qr_av(k,j,i) = qr_av(k,j,i) + qr(k,j,i) 832 ENDDO 833 ENDDO 834 ENDDO 835 ENDIF 800 836 801 837 CASE ( 'qsws*' ) … … 804 840 !-- In case of land- and urban-surfaces, convert fluxes into 805 841 !-- dynamic units. 806 DO m = 1, surf_def_h(0)%ns 807 i = surf_def_h(0)%i(m) 808 j = surf_def_h(0)%j(m) 809 k = surf_def_h(0)%k(m) 810 qsws_av(j,i) = qsws_av(j,i) + surf_def_h(0)%qsws(m) * & 811 waterflux_output_conversion(k) 812 ENDDO 813 DO m = 1, surf_lsm_h%ns 814 i = surf_lsm_h%i(m) 815 j = surf_lsm_h%j(m) 816 qsws_av(j,i) = qsws_av(j,i) + surf_lsm_h%qsws(m) * l_v 817 ENDDO 818 DO m = 1, surf_usm_h%ns 819 i = surf_usm_h%i(m) 820 j = surf_usm_h%j(m) 821 qsws_av(j,i) = qsws_av(j,i) + surf_usm_h%qsws(m) * l_v 822 ENDDO 842 IF ( ALLOCATED( qsws_av ) ) THEN 843 DO m = 1, surf_def_h(0)%ns 844 i = surf_def_h(0)%i(m) 845 j = surf_def_h(0)%j(m) 846 k = surf_def_h(0)%k(m) 847 qsws_av(j,i) = qsws_av(j,i) + surf_def_h(0)%qsws(m) * & 848 waterflux_output_conversion(k) 849 ENDDO 850 DO m = 1, surf_lsm_h%ns 851 i = surf_lsm_h%i(m) 852 j = surf_lsm_h%j(m) 853 qsws_av(j,i) = qsws_av(j,i) + surf_lsm_h%qsws(m) * l_v 854 ENDDO 855 DO m = 1, surf_usm_h%ns 856 i = surf_usm_h%i(m) 857 j = surf_usm_h%j(m) 858 qsws_av(j,i) = qsws_av(j,i) + surf_usm_h%qsws(m) * l_v 859 ENDDO 860 ENDIF 823 861 824 862 CASE ( 'qv' ) 825 DO i = nxlg, nxrg 826 DO j = nysg, nyng 827 DO k = nzb, nzt+1 828 qv_av(k,j,i) = qv_av(k,j,i) + q(k,j,i) - ql(k,j,i) 829 ENDDO 830 ENDDO 831 ENDDO 863 IF ( ALLOCATED( qv_av ) ) THEN 864 DO i = nxlg, nxrg 865 DO j = nysg, nyng 866 DO k = nzb, nzt+1 867 qv_av(k,j,i) = qv_av(k,j,i) + q(k,j,i) - ql(k,j,i) 868 ENDDO 869 ENDDO 870 ENDDO 871 ENDIF 832 872 833 873 CASE ( 'r_a*' ) 834 DO m = 1, surf_lsm_h%ns 835 i = surf_lsm_h%i(m) 836 j = surf_lsm_h%j(m) 837 r_a_av(j,i) = r_a_av(j,i) + surf_lsm_h%r_a(m) 838 ENDDO 839 ! 840 !-- Please note, resistance is also applied at urban-type surfaces, 841 !-- and is output only as a single variable. Here, tile approach is 842 !-- already implemented, so for each surface fraction resistance 843 !-- need to be summed-up. 844 DO m = 1, surf_usm_h%ns 845 i = surf_usm_h%i(m) 846 j = surf_usm_h%j(m) 847 r_a_av(j,i) = r_a_av(j,i) + & 848 ( surf_usm_h%frac(ind_veg_wall,m) * & 849 surf_usm_h%r_a(m) + & 850 surf_usm_h%frac(ind_pav_green,m) * & 851 surf_usm_h%r_a_green(m) + & 852 surf_usm_h%frac(ind_wat_win,m) * & 853 surf_usm_h%r_a_window(m) ) 854 ENDDO 874 IF ( ALLOCATED( r_a_av ) ) THEN 875 DO m = 1, surf_lsm_h%ns 876 i = surf_lsm_h%i(m) 877 j = surf_lsm_h%j(m) 878 r_a_av(j,i) = r_a_av(j,i) + surf_lsm_h%r_a(m) 879 ENDDO 880 ! 881 !-- Please note, resistance is also applied at urban-type surfaces, 882 !-- and is output only as a single variable. Here, tile approach is 883 !-- already implemented, so for each surface fraction resistance 884 !-- need to be summed-up. 885 DO m = 1, surf_usm_h%ns 886 i = surf_usm_h%i(m) 887 j = surf_usm_h%j(m) 888 r_a_av(j,i) = r_a_av(j,i) + & 889 ( surf_usm_h%frac(ind_veg_wall,m) * & 890 surf_usm_h%r_a(m) + & 891 surf_usm_h%frac(ind_pav_green,m) * & 892 surf_usm_h%r_a_green(m) + & 893 surf_usm_h%frac(ind_wat_win,m) * & 894 surf_usm_h%r_a_window(m) ) 895 ENDDO 896 ENDIF 855 897 856 898 CASE ( 'rho_ocean' ) 857 DO i = nxlg, nxrg 858 DO j = nysg, nyng 859 DO k = nzb, nzt+1 860 rho_ocean_av(k,j,i) = rho_ocean_av(k,j,i) + rho_ocean(k,j,i) 861 ENDDO 862 ENDDO 863 ENDDO 899 IF ( ALLOCATED( rho_ocean_av ) ) THEN 900 DO i = nxlg, nxrg 901 DO j = nysg, nyng 902 DO k = nzb, nzt+1 903 rho_ocean_av(k,j,i) = rho_ocean_av(k,j,i) + rho_ocean(k,j,i) 904 ENDDO 905 ENDDO 906 ENDDO 907 ENDIF 864 908 865 909 CASE ( 's' ) 866 DO i = nxlg, nxrg 867 DO j = nysg, nyng 868 DO k = nzb, nzt+1 869 s_av(k,j,i) = s_av(k,j,i) + s(k,j,i) 870 ENDDO 871 ENDDO 872 ENDDO 910 IF ( ALLOCATED( s_av ) ) THEN 911 DO i = nxlg, nxrg 912 DO j = nysg, nyng 913 DO k = nzb, nzt+1 914 s_av(k,j,i) = s_av(k,j,i) + s(k,j,i) 915 ENDDO 916 ENDDO 917 ENDDO 918 ENDIF 873 919 874 920 CASE ( 'sa' ) 875 DO i = nxlg, nxrg 876 DO j = nysg, nyng 877 DO k = nzb, nzt+1 878 sa_av(k,j,i) = sa_av(k,j,i) + sa(k,j,i) 879 ENDDO 880 ENDDO 881 ENDDO 921 IF ( ALLOCATED( sa_av ) ) THEN 922 DO i = nxlg, nxrg 923 DO j = nysg, nyng 924 DO k = nzb, nzt+1 925 sa_av(k,j,i) = sa_av(k,j,i) + sa(k,j,i) 926 ENDDO 927 ENDDO 928 ENDDO 929 ENDIF 882 930 883 931 CASE ( 'shf*' ) … … 886 934 !-- In case of land- and urban-surfaces, convert fluxes into 887 935 !-- dynamic units. 888 DO m = 1, surf_def_h(0)%ns 889 i = surf_def_h(0)%i(m) 890 j = surf_def_h(0)%j(m) 891 k = surf_def_h(0)%k(m) 892 shf_av(j,i) = shf_av(j,i) + surf_def_h(0)%shf(m) * & 893 heatflux_output_conversion(k) 894 ENDDO 895 DO m = 1, surf_lsm_h%ns 896 i = surf_lsm_h%i(m) 897 j = surf_lsm_h%j(m) 898 shf_av(j,i) = shf_av(j,i) + surf_lsm_h%shf(m) * cp 899 ENDDO 900 DO m = 1, surf_usm_h%ns 901 i = surf_usm_h%i(m) 902 j = surf_usm_h%j(m) 903 shf_av(j,i) = shf_av(j,i) + surf_usm_h%shf(m) * cp 904 ENDDO 936 IF ( ALLOCATED( shf_av ) ) THEN 937 DO m = 1, surf_def_h(0)%ns 938 i = surf_def_h(0)%i(m) 939 j = surf_def_h(0)%j(m) 940 k = surf_def_h(0)%k(m) 941 shf_av(j,i) = shf_av(j,i) + surf_def_h(0)%shf(m) * & 942 heatflux_output_conversion(k) 943 ENDDO 944 DO m = 1, surf_lsm_h%ns 945 i = surf_lsm_h%i(m) 946 j = surf_lsm_h%j(m) 947 shf_av(j,i) = shf_av(j,i) + surf_lsm_h%shf(m) * cp 948 ENDDO 949 DO m = 1, surf_usm_h%ns 950 i = surf_usm_h%i(m) 951 j = surf_usm_h%j(m) 952 shf_av(j,i) = shf_av(j,i) + surf_usm_h%shf(m) * cp 953 ENDDO 954 ENDIF 905 955 906 956 CASE ( 'ssws*' ) 907 DO m = 1, surf_def_h(0)%ns 908 i = surf_def_h(0)%i(m) 909 j = surf_def_h(0)%j(m) 910 ssws_av(j,i) = ssws_av(j,i) + surf_def_h(0)%ssws(m) 911 ENDDO 912 DO m = 1, surf_lsm_h%ns 913 i = surf_lsm_h%i(m) 914 j = surf_lsm_h%j(m) 915 ssws_av(j,i) = ssws_av(j,i) + surf_lsm_h%ssws(m) 916 ENDDO 917 DO m = 1, surf_usm_h%ns 918 i = surf_usm_h%i(m) 919 j = surf_usm_h%j(m) 920 ssws_av(j,i) = ssws_av(j,i) + surf_usm_h%ssws(m) 921 ENDDO 957 IF ( ALLOCATED( ssws_av ) ) THEN 958 DO m = 1, surf_def_h(0)%ns 959 i = surf_def_h(0)%i(m) 960 j = surf_def_h(0)%j(m) 961 ssws_av(j,i) = ssws_av(j,i) + surf_def_h(0)%ssws(m) 962 ENDDO 963 DO m = 1, surf_lsm_h%ns 964 i = surf_lsm_h%i(m) 965 j = surf_lsm_h%j(m) 966 ssws_av(j,i) = ssws_av(j,i) + surf_lsm_h%ssws(m) 967 ENDDO 968 DO m = 1, surf_usm_h%ns 969 i = surf_usm_h%i(m) 970 j = surf_usm_h%j(m) 971 ssws_av(j,i) = ssws_av(j,i) + surf_usm_h%ssws(m) 972 ENDDO 973 ENDIF 922 974 923 975 CASE ( 't*' ) 924 DO m = 1, surf_def_h(0)%ns 925 i = surf_def_h(0)%i(m) 926 j = surf_def_h(0)%j(m) 927 ts_av(j,i) = ts_av(j,i) + surf_def_h(0)%ts(m) 928 ENDDO 929 DO m = 1, surf_lsm_h%ns 930 i = surf_lsm_h%i(m) 931 j = surf_lsm_h%j(m) 932 ts_av(j,i) = ts_av(j,i) + surf_lsm_h%ts(m) 933 ENDDO 934 DO m = 1, surf_usm_h%ns 935 i = surf_usm_h%i(m) 936 j = surf_usm_h%j(m) 937 ts_av(j,i) = ts_av(j,i) + surf_usm_h%ts(m) 938 ENDDO 976 IF ( ALLOCATED( ts_av ) ) THEN 977 DO m = 1, surf_def_h(0)%ns 978 i = surf_def_h(0)%i(m) 979 j = surf_def_h(0)%j(m) 980 ts_av(j,i) = ts_av(j,i) + surf_def_h(0)%ts(m) 981 ENDDO 982 DO m = 1, surf_lsm_h%ns 983 i = surf_lsm_h%i(m) 984 j = surf_lsm_h%j(m) 985 ts_av(j,i) = ts_av(j,i) + surf_lsm_h%ts(m) 986 ENDDO 987 DO m = 1, surf_usm_h%ns 988 i = surf_usm_h%i(m) 989 j = surf_usm_h%j(m) 990 ts_av(j,i) = ts_av(j,i) + surf_usm_h%ts(m) 991 ENDDO 992 ENDIF 939 993 940 994 CASE ( 'tsurf*' ) 941 DO m = 1, surf_def_h(0)%ns 942 i = surf_def_h(0)%i(m) 943 j = surf_def_h(0)%j(m) 944 tsurf_av(j,i) = tsurf_av(j,i) + surf_def_h(0)%pt_surface(m) 945 ENDDO 946 947 DO m = 1, surf_lsm_h%ns 948 i = surf_lsm_h%i(m) 949 j = surf_lsm_h%j(m) 950 tsurf_av(j,i) = tsurf_av(j,i) + surf_lsm_h%pt_surface(m) 951 ENDDO 952 953 DO m = 1, surf_usm_h%ns 954 i = surf_usm_h%i(m) 955 j = surf_usm_h%j(m) 956 tsurf_av(j,i) = tsurf_av(j,i) + surf_usm_h%pt_surface(m) 957 ENDDO 995 IF ( ALLOCATED( tsurf_av ) ) THEN 996 DO m = 1, surf_def_h(0)%ns 997 i = surf_def_h(0)%i(m) 998 j = surf_def_h(0)%j(m) 999 tsurf_av(j,i) = tsurf_av(j,i) + surf_def_h(0)%pt_surface(m) 1000 ENDDO 1001 1002 DO m = 1, surf_lsm_h%ns 1003 i = surf_lsm_h%i(m) 1004 j = surf_lsm_h%j(m) 1005 tsurf_av(j,i) = tsurf_av(j,i) + surf_lsm_h%pt_surface(m) 1006 ENDDO 1007 1008 DO m = 1, surf_usm_h%ns 1009 i = surf_usm_h%i(m) 1010 j = surf_usm_h%j(m) 1011 tsurf_av(j,i) = tsurf_av(j,i) + surf_usm_h%pt_surface(m) 1012 ENDDO 1013 ENDIF 958 1014 959 1015 CASE ( 'u' ) 960 DO i = nxlg, nxrg 961 DO j = nysg, nyng 962 DO k = nzb, nzt+1 963 u_av(k,j,i) = u_av(k,j,i) + u(k,j,i) 964 ENDDO 965 ENDDO 966 ENDDO 1016 IF ( ALLOCATED( u_av ) ) THEN 1017 DO i = nxlg, nxrg 1018 DO j = nysg, nyng 1019 DO k = nzb, nzt+1 1020 u_av(k,j,i) = u_av(k,j,i) + u(k,j,i) 1021 ENDDO 1022 ENDDO 1023 ENDDO 1024 ENDIF 967 1025 968 1026 CASE ( 'u*' ) 969 DO m = 1, surf_def_h(0)%ns 970 i = surf_def_h(0)%i(m) 971 j = surf_def_h(0)%j(m) 972 us_av(j,i) = us_av(j,i) + surf_def_h(0)%us(m) 973 ENDDO 974 DO m = 1, surf_lsm_h%ns 975 i = surf_lsm_h%i(m) 976 j = surf_lsm_h%j(m) 977 us_av(j,i) = us_av(j,i) + surf_lsm_h%us(m) 978 ENDDO 979 DO m = 1, surf_usm_h%ns 980 i = surf_usm_h%i(m) 981 j = surf_usm_h%j(m) 982 us_av(j,i) = us_av(j,i) + surf_usm_h%us(m) 983 ENDDO 1027 IF ( ALLOCATED( us_av ) ) THEN 1028 DO m = 1, surf_def_h(0)%ns 1029 i = surf_def_h(0)%i(m) 1030 j = surf_def_h(0)%j(m) 1031 us_av(j,i) = us_av(j,i) + surf_def_h(0)%us(m) 1032 ENDDO 1033 DO m = 1, surf_lsm_h%ns 1034 i = surf_lsm_h%i(m) 1035 j = surf_lsm_h%j(m) 1036 us_av(j,i) = us_av(j,i) + surf_lsm_h%us(m) 1037 ENDDO 1038 DO m = 1, surf_usm_h%ns 1039 i = surf_usm_h%i(m) 1040 j = surf_usm_h%j(m) 1041 us_av(j,i) = us_av(j,i) + surf_usm_h%us(m) 1042 ENDDO 1043 ENDIF 984 1044 985 1045 CASE ( 'v' ) 986 DO i = nxlg, nxrg 987 DO j = nysg, nyng 988 DO k = nzb, nzt+1 989 v_av(k,j,i) = v_av(k,j,i) + v(k,j,i) 990 ENDDO 991 ENDDO 992 ENDDO 1046 IF ( ALLOCATED( v_av ) ) THEN 1047 DO i = nxlg, nxrg 1048 DO j = nysg, nyng 1049 DO k = nzb, nzt+1 1050 v_av(k,j,i) = v_av(k,j,i) + v(k,j,i) 1051 ENDDO 1052 ENDDO 1053 ENDDO 1054 ENDIF 993 1055 994 1056 CASE ( 'vpt' ) 995 DO i = nxlg, nxrg 996 DO j = nysg, nyng 997 DO k = nzb, nzt+1 998 vpt_av(k,j,i) = vpt_av(k,j,i) + vpt(k,j,i) 999 ENDDO 1000 ENDDO 1001 ENDDO 1057 IF ( ALLOCATED( vpt_av ) ) THEN 1058 DO i = nxlg, nxrg 1059 DO j = nysg, nyng 1060 DO k = nzb, nzt+1 1061 vpt_av(k,j,i) = vpt_av(k,j,i) + vpt(k,j,i) 1062 ENDDO 1063 ENDDO 1064 ENDDO 1065 ENDIF 1002 1066 1003 1067 CASE ( 'w' ) 1004 DO i = nxlg, nxrg 1005 DO j = nysg, nyng 1006 DO k = nzb, nzt+1 1007 w_av(k,j,i) = w_av(k,j,i) + w(k,j,i) 1008 ENDDO 1009 ENDDO 1010 ENDDO 1068 IF ( ALLOCATED( w_av ) ) THEN 1069 DO i = nxlg, nxrg 1070 DO j = nysg, nyng 1071 DO k = nzb, nzt+1 1072 w_av(k,j,i) = w_av(k,j,i) + w(k,j,i) 1073 ENDDO 1074 ENDDO 1075 ENDDO 1076 ENDIF 1011 1077 1012 1078 CASE ( 'z0*' ) 1013 DO m = 1, surf_def_h(0)%ns 1014 i = surf_def_h(0)%i(m) 1015 j = surf_def_h(0)%j(m) 1016 z0_av(j,i) = z0_av(j,i) + surf_def_h(0)%z0(m) 1017 ENDDO 1018 DO m = 1, surf_lsm_h%ns 1019 i = surf_lsm_h%i(m) 1020 j = surf_lsm_h%j(m) 1021 z0_av(j,i) = z0_av(j,i) + surf_lsm_h%z0(m) 1022 ENDDO 1023 DO m = 1, surf_usm_h%ns 1024 i = surf_usm_h%i(m) 1025 j = surf_usm_h%j(m) 1026 z0_av(j,i) = z0_av(j,i) + surf_usm_h%z0(m) 1027 ENDDO 1079 IF ( ALLOCATED( z0_av ) ) THEN 1080 DO m = 1, surf_def_h(0)%ns 1081 i = surf_def_h(0)%i(m) 1082 j = surf_def_h(0)%j(m) 1083 z0_av(j,i) = z0_av(j,i) + surf_def_h(0)%z0(m) 1084 ENDDO 1085 DO m = 1, surf_lsm_h%ns 1086 i = surf_lsm_h%i(m) 1087 j = surf_lsm_h%j(m) 1088 z0_av(j,i) = z0_av(j,i) + surf_lsm_h%z0(m) 1089 ENDDO 1090 DO m = 1, surf_usm_h%ns 1091 i = surf_usm_h%i(m) 1092 j = surf_usm_h%j(m) 1093 z0_av(j,i) = z0_av(j,i) + surf_usm_h%z0(m) 1094 ENDDO 1095 ENDIF 1028 1096 1029 1097 CASE ( 'z0h*' ) 1030 DO m = 1, surf_def_h(0)%ns 1031 i = surf_def_h(0)%i(m) 1032 j = surf_def_h(0)%j(m) 1033 z0h_av(j,i) = z0h_av(j,i) + surf_def_h(0)%z0h(m) 1034 ENDDO 1035 DO m = 1, surf_lsm_h%ns 1036 i = surf_lsm_h%i(m) 1037 j = surf_lsm_h%j(m) 1038 z0h_av(j,i) = z0h_av(j,i) + surf_lsm_h%z0h(m) 1039 ENDDO 1040 DO m = 1, surf_usm_h%ns 1041 i = surf_usm_h%i(m) 1042 j = surf_usm_h%j(m) 1043 z0h_av(j,i) = z0h_av(j,i) + surf_usm_h%z0h(m) 1044 ENDDO 1045 1098 IF ( ALLOCATED( z0h_av ) ) THEN 1099 DO m = 1, surf_def_h(0)%ns 1100 i = surf_def_h(0)%i(m) 1101 j = surf_def_h(0)%j(m) 1102 z0h_av(j,i) = z0h_av(j,i) + surf_def_h(0)%z0h(m) 1103 ENDDO 1104 DO m = 1, surf_lsm_h%ns 1105 i = surf_lsm_h%i(m) 1106 j = surf_lsm_h%j(m) 1107 z0h_av(j,i) = z0h_av(j,i) + surf_lsm_h%z0h(m) 1108 ENDDO 1109 DO m = 1, surf_usm_h%ns 1110 i = surf_usm_h%i(m) 1111 j = surf_usm_h%j(m) 1112 z0h_av(j,i) = z0h_av(j,i) + surf_usm_h%z0h(m) 1113 ENDDO 1114 ENDIF 1115 1046 1116 CASE ( 'z0q*' ) 1047 DO m = 1, surf_def_h(0)%ns 1048 i = surf_def_h(0)%i(m) 1049 j = surf_def_h(0)%j(m) 1050 z0q_av(j,i) = z0q_av(j,i) + surf_def_h(0)%z0q(m) 1051 ENDDO 1052 DO m = 1, surf_lsm_h%ns 1053 i = surf_lsm_h%i(m) 1054 j = surf_lsm_h%j(m) 1055 z0q_av(j,i) = z0q_av(j,i) + surf_lsm_h%z0q(m) 1056 ENDDO 1057 DO m = 1, surf_usm_h%ns 1058 i = surf_usm_h%i(m) 1059 j = surf_usm_h%j(m) 1060 z0q_av(j,i) = z0q_av(j,i) + surf_usm_h%z0q(m) 1061 ENDDO 1117 IF ( ALLOCATED( z0q_av ) ) THEN 1118 DO m = 1, surf_def_h(0)%ns 1119 i = surf_def_h(0)%i(m) 1120 j = surf_def_h(0)%j(m) 1121 z0q_av(j,i) = z0q_av(j,i) + surf_def_h(0)%z0q(m) 1122 ENDDO 1123 DO m = 1, surf_lsm_h%ns 1124 i = surf_lsm_h%i(m) 1125 j = surf_lsm_h%j(m) 1126 z0q_av(j,i) = z0q_av(j,i) + surf_lsm_h%z0q(m) 1127 ENDDO 1128 DO m = 1, surf_usm_h%ns 1129 i = surf_usm_h%i(m) 1130 j = surf_usm_h%j(m) 1131 z0q_av(j,i) = z0q_av(j,i) + surf_usm_h%z0q(m) 1132 ENDDO 1133 ENDIF 1062 1134 ! 1063 1135 !-- Block of urban surface model outputs. 1064 1136 !-- In case of urban surface variables it should be always checked 1065 1137 !-- if respective arrays are allocated, at least in case of a restart 1066 !-- run, as usm arrays are not read from file at the moment.1138 !-- run, as averaged usm arrays are not read from file at the moment. 1067 1139 CASE ( 'usm_output' ) 1068 1140 CALL usm_average_3d_data( 'allocate', doav(ii) )
Note: See TracChangeset
for help on using the changeset viewer.
