- Timestamp:
- May 14, 2018 10:45:48 AM (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/pmc_interface_mod.f90
r3001 r3020 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Bugfix in pmci_define_loglaw_correction_parameters 28 ! 29 ! 3001 2018-04-20 12:27:13Z suehring 27 30 ! Bugfix, replace MERGE function by an if-condition in the anterpolation (in 28 31 ! order to avoid floating-point exceptions). … … 2673 2676 IMPLICIT NONE 2674 2677 2675 INTEGER(iwp), INTENT(IN) :: direction !<2676 INTEGER(iwp), INTENT(IN) :: ij !<2677 INTEGER(iwp), INTENT(IN) :: inc !<2678 INTEGER(iwp), INTENT(IN) :: k !<2679 INTEGER(iwp), INTENT(IN) :: kb !<2680 INTEGER(iwp), INTENT(OUT) :: lc !<2681 INTEGER(iwp), INTENT(IN) :: ncorr !<2682 INTEGER(iwp), INTENT(IN) :: wall_index !<2683 2684 INTEGER(iwp) :: alcorr !<2685 INTEGER(iwp) :: corr_index !<2686 INTEGER(iwp) :: lcorr !<2687 2688 LOGICAL :: more !<2678 INTEGER(iwp), INTENT(IN) :: direction !< 2679 INTEGER(iwp), INTENT(IN) :: ij !< 2680 INTEGER(iwp), INTENT(IN) :: inc !< 2681 INTEGER(iwp), INTENT(IN) :: k !< 2682 INTEGER(iwp), INTENT(IN) :: kb !< 2683 INTEGER(iwp), INTENT(OUT) :: lc !< 2684 INTEGER(iwp), INTENT(IN) :: ncorr !< 2685 INTEGER(iwp), INTENT(IN) :: wall_index !< 2686 2687 INTEGER(iwp) :: alcorr !< 2688 INTEGER(iwp) :: corr_index !< 2689 INTEGER(iwp) :: lcorr !< 2690 2691 LOGICAL :: more !< 2689 2692 2690 2693 REAL(wp), DIMENSION(0:ncorr-1), INTENT(OUT) :: lcr !< 2691 2694 REAL(wp), INTENT(IN) :: z0_l !< 2692 2695 2693 REAL(wp) :: logvelc1 !<2696 REAL(wp) :: logvelc1 !< 2694 2697 2695 2698 … … 2728 2731 !-- The role of inc here is to make the comparison operation "<" 2729 2732 !-- valid in both directions 2730 IF ( inc * corr_index < inc * lc) THEN2733 IF ( ( inc * corr_index < inc * lc ) .AND. ( lc /= -99 ) ) THEN 2731 2734 lcr(alcorr) = LOG( ABS( coord_y(corr_index) + 0.5_wp * dy & 2732 2735 - coord_y(wall_index) ) / z0_l ) & … … 2754 2757 !-- The role of inc here is to make the comparison operation "<" 2755 2758 !-- valid in both directions 2756 IF ( inc * corr_index < inc * lc) THEN2759 IF ( ( inc * corr_index < inc * lc ) .AND. ( lc /= -99 ) ) THEN 2757 2760 lcr(alcorr) = LOG( ABS( coord_x(corr_index) + 0.5_wp * dx & 2758 2761 - coord_x(wall_index) ) / z0_l ) & … … 2787 2790 INTEGER(iwp), INTENT(OUT) :: lc !< 2788 2791 2789 INTEGER(iwp) :: kbc !<2790 INTEGER(iwp) :: k1 !<2791 2792 REAL(wp), INTENT(OUT) :: logzc1 2793 REAL(wp), INTENT(IN) :: z0_l!<2794 2795 REAL(wp) :: zuc1 !<2792 INTEGER(iwp) :: kbc !< 2793 INTEGER(iwp) :: k1 !< 2794 2795 REAL(wp), INTENT(OUT) :: logzc1 !< 2796 REAL(wp), INTENT(IN) :: z0_l !< 2797 2798 REAL(wp) :: zuc1 !< 2796 2799 2797 2800 ! … … 2829 2832 INTEGER(iwp), INTENT(OUT) :: lc !< 2830 2833 2831 INTEGER(iwp) :: jwc !<2832 INTEGER(iwp) :: j1 !<2833 2834 REAL(wp), INTENT(IN) :: z0_l!<2835 2836 REAL(wp) :: logyc1 !< 2837 REAL(wp) :: ycb !<2838 REAL(wp) :: yc1 !<2834 INTEGER(iwp) :: jwc !< 2835 INTEGER(iwp) :: j1 !< 2836 2837 REAL(wp), INTENT(IN) :: z0_l !< 2838 REAL(wp), INTENT(OUT) :: logyc1 !< 2839 2840 REAL(wp) :: ycb !< 2841 REAL(wp) :: yc1 !< 2839 2842 2840 2843 ! … … 2849 2852 IF ( yc1 < ( REAL( nysg, KIND=wp ) + 0.5_wp ) * dy ) THEN 2850 2853 lc = -99 2854 logyc1 = 1.0_wp 2851 2855 ELSE IF ( yc1 > ( REAL( nyng, KIND=wp ) + 0.5_wp ) * dy ) THEN 2852 2856 lc = -99 2857 logyc1 = 1.0_wp 2853 2858 ELSE 2854 2859 ! … … 2886 2891 INTEGER(iwp), INTENT(OUT) :: lc !< 2887 2892 2888 INTEGER(iwp) :: iwc !<2889 INTEGER(iwp) :: i1 !<2890 2891 REAL(wp), INTENT(IN) :: z0_l!<2892 2893 REAL(wp) :: logxc1 !< 2894 REAL(wp) :: xcb !<2895 REAL(wp) :: xc1 !<2893 INTEGER(iwp) :: iwc !< 2894 INTEGER(iwp) :: i1 !< 2895 2896 REAL(wp), INTENT(IN) :: z0_l !< 2897 REAL(wp), INTENT(OUT) :: logxc1 !< 2898 2899 REAL(wp) :: xcb !< 2900 REAL(wp) :: xc1 !< 2896 2901 2897 2902 ! … … 2906 2911 IF ( xc1 < ( REAL( nxlg, KIND=wp ) + 0.5_wp ) * dx ) THEN 2907 2912 lc = -99 2913 logxc1 = 1.0_wp 2908 2914 ELSE IF ( xc1 > ( REAL( nxrg, KIND=wp ) + 0.5_wp ) * dx ) THEN 2909 2915 lc = -99 2916 logxc1 = 1.0_wp 2910 2917 ELSE 2911 2918 !
Note: See TracChangeset
for help on using the changeset viewer.