Changeset 2329
- Timestamp:
- Aug 3, 2017 2:24:56 PM (7 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 4 edited
-
advec_ws.f90 (modified) (41 diffs)
-
check_parameters.f90 (modified) (2 diffs)
-
init_3d_model.f90 (modified) (3 diffs)
-
production_e.f90 (modified) (32 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/advec_ws.f90
r2292 r2329 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Bugfix concerning density in divergence correction close to buildings 28 ! 29 ! 2292 2017-06-20 09:51:42Z schwenkel 27 30 ! Implementation of new microphysic scheme: cloud_scheme = 'morrison' 28 31 ! includes two more prognostic equations for cloud drop concentration (nc) … … 1094 1097 1095 1098 USE arrays_3d, & 1096 ONLY: ddzw, drho_air, tend, u, v, w, rho_air , rho_air_zw1099 ONLY: ddzw, drho_air, tend, u, v, w, rho_air_zw 1097 1100 1098 1101 USE constants, & … … 1422 1425 + IBITS(advc_flags_1(k,j,i-1),2,1) & 1423 1426 ) & 1424 ) * rho_air(k) * ddx&1427 ) * ddx & 1425 1428 + ( v(k,j+1,i) * ( ibit3 + ibit4 + ibit5 ) & 1426 1429 - v(k,j,i) * ( IBITS(advc_flags_1(k,j-1,i),3,1) & … … 1428 1431 + IBITS(advc_flags_1(k,j-1,i),5,1) & 1429 1432 ) & 1430 ) * rho_air(k) * ddy&1433 ) * ddy & 1431 1434 + ( w(k,j,i) * rho_air_zw(k) * & 1432 1435 ( ibit6 + ibit7 + ibit8 ) & … … 1436 1439 + IBITS(advc_flags_1(k-1,j,i),8,1) & 1437 1440 ) & 1438 ) * d dzw(k)1441 ) * drho_air(k) * ddzw(k) 1439 1442 1440 1443 … … 1525 1528 !-- correction is needed to overcome numerical instabilities introduced 1526 1529 !-- by a not sufficient reduction of divergences near topography. 1527 div = ( u(k,j,i+1) - u(k,j,i) ) * rho_air(k) * ddx&1528 + ( v(k,j+1,i) - v(k,j,i) ) * rho_air(k) * ddy&1530 div = ( u(k,j,i+1) - u(k,j,i) ) * ddx & 1531 + ( v(k,j+1,i) - v(k,j,i) ) * ddy & 1529 1532 + ( w(k,j,i) * rho_air_zw(k) - & 1530 w(k-1,j,i) * rho_air_zw(k-1) ) * ddzw(k) 1533 w(k-1,j,i) * rho_air_zw(k-1) & 1534 ) * drho_air(k) * ddzw(k) 1531 1535 1532 1536 tend(k,j,i) = tend(k,j,i) - ( & … … 1659 1663 USE arrays_3d, & 1660 1664 ONLY: ddzw, diss_l_u, diss_s_u, flux_l_u, flux_s_u, tend, u, v, w,& 1661 drho_air, rho_air , rho_air_zw1665 drho_air, rho_air_zw 1662 1666 1663 1667 USE constants, & … … 1963 1967 + IBITS(advc_flags_1(k,j,i-1),11,1) & 1964 1968 ) & 1965 ) * rho_air(k) * ddx&1969 ) * ddx & 1966 1970 + ( ( v_comp + gv ) * ( ibit12 + ibit13 + ibit14 ) & 1967 1971 - ( v(k,j,i) + v(k,j,i-1 ) ) & … … 1970 1974 + IBITS(advc_flags_1(k,j-1,i),14,1) & 1971 1975 ) & 1972 ) * rho_air(k) * ddy&1976 ) * ddy & 1973 1977 + ( w_comp * rho_air_zw(k) * ( ibit15 + ibit16 + ibit17 ) & 1974 1978 - ( w(k-1,j,i) + w(k-1,j,i-1) ) * rho_air_zw(k-1) & … … 1977 1981 + IBITS(advc_flags_1(k-1,j,i),17,1) & 1978 1982 ) & 1979 ) * d dzw(k)&1983 ) * drho_air(k) * ddzw(k) & 1980 1984 ) * 0.5_wp 1981 1985 … … 2087 2091 !-- by a not sufficient reduction of divergences near topography. 2088 2092 div = ( ( u_comp(k) - ( u(k,j,i) + u(k,j,i-1) ) ) * ddx & 2089 * rho_air(k)&2090 2093 + ( v_comp + gv - ( v(k,j,i) + v(k,j,i-1 ) ) ) * ddy & 2091 * rho_air(k)&2092 2094 + ( w_comp * rho_air_zw(k) - & 2093 2095 ( w(k-1,j,i) + w(k-1,j,i-1) ) * rho_air_zw(k-1) & 2094 ) * d dzw(k)&2096 ) * drho_air(k) * ddzw(k) & 2095 2097 ) * 0.5_wp 2096 2098 … … 2151 2153 USE arrays_3d, & 2152 2154 ONLY: ddzw, diss_l_v, diss_s_v, flux_l_v, flux_s_v, tend, u, v, w, & 2153 drho_air, rho_air , rho_air_zw2155 drho_air, rho_air_zw 2154 2156 2155 2157 USE constants, & … … 2458 2460 + IBITS(advc_flags_1(k,j,i-1),20,1) & 2459 2461 ) & 2460 ) * rho_air(k) * ddx&2462 ) * ddx & 2461 2463 + ( v_comp(k) & 2462 2464 * ( ibit21 + ibit22 + ibit23 ) & … … 2466 2468 + IBITS(advc_flags_1(k,j-1,i),23,1) & 2467 2469 ) & 2468 ) * rho_air(k) * ddy&2470 ) * ddy & 2469 2471 + ( w_comp * rho_air_zw(k) * ( ibit24 + ibit25 + ibit26 ) & 2470 2472 - ( w(k-1,j-1,i) + w(k-1,j,i) ) * rho_air_zw(k-1) & … … 2473 2475 + IBITS(advc_flags_1(k-1,j,i),26,1) & 2474 2476 ) & 2475 ) * d dzw(k)&2477 ) * drho_air(k) * ddzw(k) & 2476 2478 ) * 0.5_wp 2477 2479 … … 2588 2590 !-- by a not sufficient reduction of divergences near topography. 2589 2591 div = ( ( u_comp + gu - ( u(k,j-1,i) + u(k,j,i) ) ) * ddx & 2590 * rho_air(k)&2591 2592 + ( v_comp(k) - ( v(k,j,i) + v(k,j-1,i) ) ) * ddy & 2592 * rho_air(k)&2593 2593 + ( w_comp * rho_air_zw(k) - & 2594 2594 ( w(k-1,j-1,i) + w(k-1,j,i) ) * rho_air_zw(k-1) & 2595 ) * d dzw(k)&2595 ) * drho_air(k) * ddzw(k) & 2596 2596 ) * 0.5_wp 2597 2597 … … 2652 2652 USE arrays_3d, & 2653 2653 ONLY: ddzu, diss_l_w, diss_s_w, flux_l_w, flux_s_w, tend, u, v, w,& 2654 drho_air_zw, rho_air , rho_air_zw2654 drho_air_zw, rho_air 2655 2655 2656 2656 USE constants, & … … 2962 2962 + IBITS(advc_flags_1(k,j,i-1),29,1) & 2963 2963 ) & 2964 ) * rho_air_zw(k) * ddx&2964 ) * ddx & 2965 2965 + ( ( v_comp + gv ) * ( ibit30 + ibit31 + ibit32 ) & 2966 2966 - ( v(k+1,j,i) + v(k,j,i) ) & … … 2969 2969 + IBITS(advc_flags_2(k,j-1,i),0,1) & 2970 2970 ) & 2971 ) * rho_air_zw(k) * ddy&2971 ) * ddy & 2972 2972 + ( w_comp * rho_air(k+1) * ( ibit33 + ibit34 + ibit35 ) & 2973 2973 - ( w(k,j,i) + w(k-1,j,i) ) * rho_air(k) & … … 2976 2976 + IBITS(advc_flags_2(k-1,j,i),3,1) & 2977 2977 ) & 2978 ) * d dzu(k+1)&2978 ) * drho_air_zw(k) * ddzu(k+1) & 2979 2979 ) * 0.5_wp 2980 2980 … … 3078 3078 !-- by a not sufficient reduction of divergences near topography. 3079 3079 div = ( ( u_comp + gu - ( u(k+1,j,i) + u(k,j,i) ) ) * ddx & 3080 * rho_air_zw(k) &3081 3080 + ( v_comp + gv - ( v(k+1,j,i) + v(k,j,i) ) ) * ddy & 3082 * rho_air_zw(k) &3083 3081 + ( w_comp * rho_air(k+1) - & 3084 3082 ( w(k,j,i) + w(k-1,j,i) ) * rho_air(k) & 3085 ) * d dzu(k+1)&3083 ) * drho_air_zw(k) * ddzu(k+1) & 3086 3084 ) * 0.5_wp 3087 3085 … … 3127 3125 3128 3126 USE arrays_3d, & 3129 ONLY: ddzw, drho_air, tend, u, v, w, rho_air , rho_air_zw3127 ONLY: ddzw, drho_air, tend, u, v, w, rho_air_zw 3130 3128 3131 3129 USE constants, & … … 3448 3446 + IBITS(advc_flags_1(k,j,i-1),2,1) & 3449 3447 ) & 3450 ) * rho_air(k) * ddx&3448 ) * ddx & 3451 3449 + ( v(k,j+1,i) * ( ibit3 + ibit4 + ibit5 ) & 3452 3450 - v(k,j,i) * ( IBITS(advc_flags_1(k,j-1,i),3,1) & … … 3454 3452 + IBITS(advc_flags_1(k,j-1,i),5,1) & 3455 3453 ) & 3456 ) * rho_air(k) * ddy&3454 ) * ddy & 3457 3455 + ( w(k,j,i) * rho_air_zw(k) * & 3458 3456 ( ibit6 + ibit7 + ibit8 ) & … … 3462 3460 + IBITS(advc_flags_1(k-1,j,i),8,1) & 3463 3461 ) & 3464 ) * d dzw(k)3462 ) * drho_air(k) * ddzw(k) 3465 3463 3466 3464 … … 3549 3547 !-- correction is needed to overcome numerical instabilities introduced 3550 3548 !-- by a not sufficient reduction of divergences near topography. 3551 div = ( u(k,j,i+1) - u(k,j,i) ) * rho_air(k) * ddx&3552 + ( v(k,j+1,i) - v(k,j,i) ) * rho_air(k) * ddy&3549 div = ( u(k,j,i+1) - u(k,j,i) ) * ddx & 3550 + ( v(k,j+1,i) - v(k,j,i) ) * ddy & 3553 3551 + ( w(k,j,i) * rho_air_zw(k) - & 3554 w(k-1,j,i) * rho_air_zw(k-1) ) * ddzw(k) 3552 w(k-1,j,i) * rho_air_zw(k-1) & 3553 ) * drho_air(k) * ddzw(k) 3555 3554 3556 3555 tend(k,j,i) = tend(k,j,i) - ( & … … 3682 3681 3683 3682 USE arrays_3d, & 3684 ONLY: ddzw, drho_air, tend, u, v, w, rho_air , rho_air_zw3683 ONLY: ddzw, drho_air, tend, u, v, w, rho_air_zw 3685 3684 3686 3685 USE constants, & … … 3990 3989 + IBITS(advc_flags_1(k,j,i-1),11,1) & 3991 3990 ) & 3992 ) * rho_air(k) * ddx&3991 ) * ddx & 3993 3992 + ( ( v_comp + gv ) * ( ibit12 + ibit13 + ibit14 ) & 3994 3993 - ( v(k,j,i) + v(k,j,i-1 ) ) & … … 3997 3996 + IBITS(advc_flags_1(k,j-1,i),14,1) & 3998 3997 ) & 3999 ) * rho_air(k) * ddy&3998 ) * ddy & 4000 3999 + ( w_comp * rho_air_zw(k) * ( ibit15 + ibit16 + ibit17 ) & 4001 4000 - ( w(k-1,j,i) + w(k-1,j,i-1) ) * rho_air_zw(k-1) & … … 4004 4003 + IBITS(advc_flags_1(k-1,j,i),17,1) & 4005 4004 ) & 4006 ) * d dzw(k)&4005 ) * drho_air(k) * ddzw(k) & 4007 4006 ) * 0.5_wp 4008 4007 … … 4116 4115 !-- by a not sufficient reduction of divergences near topography. 4117 4116 div = ( ( u_comp(k) - ( u(k,j,i) + u(k,j,i-1) ) ) * ddx & 4118 * rho_air(k)&4119 4117 + ( v_comp + gv - ( v(k,j,i) + v(k,j,i-1 ) ) ) * ddy & 4120 * rho_air(k)&4121 4118 + ( w_comp * rho_air_zw(k) - & 4122 4119 ( w(k-1,j,i) + w(k-1,j,i-1) ) * rho_air_zw(k-1) & 4123 ) * d dzw(k)&4120 ) * drho_air(k) * ddzw(k) & 4124 4121 ) * 0.5_wp 4125 4122 … … 4178 4175 4179 4176 USE arrays_3d, & 4180 ONLY: ddzw, drho_air, tend, u, v, w, rho_air , rho_air_zw4177 ONLY: ddzw, drho_air, tend, u, v, w, rho_air_zw 4181 4178 4182 4179 USE constants, & … … 4486 4483 + IBITS(advc_flags_1(k,j,i-1),20,1) & 4487 4484 ) & 4488 ) * rho_air(k) * ddx&4485 ) * ddx & 4489 4486 + ( v_comp(k) & 4490 4487 * ( ibit21 + ibit22 + ibit23 ) & … … 4494 4491 + IBITS(advc_flags_1(k,j-1,i),23,1) & 4495 4492 ) & 4496 ) * rho_air(k) * ddy&4493 ) * ddy & 4497 4494 + ( w_comp * rho_air_zw(k) & 4498 4495 * ( ibit24 + ibit25 + ibit26 ) & … … 4502 4499 + IBITS(advc_flags_1(k-1,j,i),26,1) & 4503 4500 ) & 4504 ) * d dzw(k)&4501 ) * drho_air(k) * ddzw(k) & 4505 4502 ) * 0.5_wp 4506 4503 … … 4619 4616 !-- by a not sufficient reduction of divergences near topography. 4620 4617 div = ( ( u_comp + gu - ( u(k,j-1,i) + u(k,j,i) ) ) * ddx & 4621 * rho_air(k)&4622 4618 + ( v_comp(k) - ( v(k,j,i) + v(k,j-1,i) ) ) * ddy & 4623 * rho_air(k)&4624 4619 + ( w_comp * rho_air_zw(k) - & 4625 4620 ( w(k-1,j-1,i) + w(k-1,j,i) ) * rho_air_zw(k-1) & 4626 ) * d dzw(k)&4621 ) * drho_air(k) * ddzw(k) & 4627 4622 ) * 0.5_wp 4628 4623 … … 4685 4680 4686 4681 USE arrays_3d, & 4687 ONLY: ddzu, drho_air_zw, tend, u, v, w, rho_air , rho_air_zw4682 ONLY: ddzu, drho_air_zw, tend, u, v, w, rho_air 4688 4683 4689 4684 USE constants, & … … 4998 4993 + IBITS(advc_flags_1(k,j,i-1),29,1) & 4999 4994 ) & 5000 ) * rho_air_zw(k) * ddx&4995 ) * ddx & 5001 4996 + ( ( v_comp + gv ) * ( ibit30 + ibit31 + ibit32 ) & 5002 4997 - ( v(k+1,j,i) + v(k,j,i) ) & … … 5005 5000 + IBITS(advc_flags_2(k,j-1,i),0,1) & 5006 5001 ) & 5007 ) * rho_air_zw(k) * ddy&5002 ) * ddy & 5008 5003 + ( w_comp * rho_air(k+1) * ( ibit33 + ibit34 + ibit35 ) & 5009 5004 - ( w(k,j,i) + w(k-1,j,i) ) * rho_air(k) & … … 5012 5007 + IBITS(advc_flags_2(k-1,j,i),3,1) & 5013 5008 ) & 5014 ) * d dzu(k+1)&5009 ) * drho_air_zw(k) * ddzu(k+1) & 5015 5010 ) * 0.5_wp 5016 5011 … … 5116 5111 !-- by a not sufficient reduction of divergences near topography. 5117 5112 div = ( ( u_comp + gu - ( u(k+1,j,i) + u(k,j,i) ) ) * ddx & 5118 * rho_air_zw(k) &5119 5113 + ( v_comp + gv - ( v(k+1,j,i) + v(k,j,i) ) ) * ddy & 5120 * rho_air_zw(k) &5121 5114 + ( w_comp * rho_air(k+1) - & 5122 5115 ( w(k,j,i) + w(k-1,j,i) ) * rho_air(k) & 5123 ) * d dzu(k+1)&5116 ) * drho_air_zw(k) * ddzu(k+1) & 5124 5117 ) * 0.5_wp 5125 5118 -
palm/trunk/SOURCE/check_parameters.f90
r2320 r2329 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Bugfix: index corrected for rho_air and rho_air_zw output 28 ! 29 ! 2320 2017-07-21 12:47:43Z suehring 27 30 ! Modularize large-scale forcing and nudging 28 31 ! … … 2748 2751 2749 2752 CASE ( 'rho_air' ) 2750 dopr_index(i) = 1 212753 dopr_index(i) = 119 2751 2754 dopr_unit(i) = 'kg/m3' 2752 hom(:,2,1 21,:) = SPREAD( zu, 2, statistic_regions+1 )2755 hom(:,2,119,:) = SPREAD( zu, 2, statistic_regions+1 ) 2753 2756 2754 2757 CASE ( 'rho_air_zw' ) 2755 dopr_index(i) = 12 22758 dopr_index(i) = 120 2756 2759 dopr_unit(i) = 'kg/m3' 2757 hom(:,2,12 2,:) = SPREAD( zw, 2, statistic_regions+1 )2760 hom(:,2,120,:) = SPREAD( zw, 2, statistic_regions+1 ) 2758 2761 2759 2762 CASE ( 'nc' ) -
palm/trunk/SOURCE/init_3d_model.f90
r2327 r2329 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Removed temporary bugfix (r2327) as bug is properly resolved by this revision 28 ! 29 ! 2327 2017-08-02 07:40:57Z maronga 27 30 ! Temporary bugfix 28 31 ! … … 346 349 !> or 347 350 !> c) read values of a previous run 348 !> @todo fix crashes for runs with topography and density /= 1349 351 !------------------------------------------------------------------------------! 350 352 SUBROUTINE init_3d_model … … 737 739 rho_air_zw(nzt+1) = rho_air_zw(nzt) & 738 740 + 2.0_wp * ( rho_air(nzt+1) - rho_air_zw(nzt) ) 739 740 ! 741 !-- Temporary workaround as runs with topography do not work with density /= 1 742 rho_air = 1.0_wp 743 rho_air_zw = 1.0_wp 744 745 ENDIF 746 747 748 741 ENDIF 749 742 750 743 !-- compute the inverse density array in order to avoid expencive divisions -
palm/trunk/SOURCE/production_e.f90
r2233 r2329 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Bugfix: added division by density as kinematic fluxes are needed 28 ! 29 ! 2233 2017-05-30 18:08:54Z suehring 27 30 ! 28 31 ! 2232 2017-05-30 17:47:52Z suehring … … 135 138 136 139 USE arrays_3d, & 137 ONLY: ddzw, dd2zu, kh, km, prho, pt, q, ql, tend, u, v, vpt, w 140 ONLY: ddzw, dd2zu, drho_air_zw, kh, km, prho, pt, q, ql, tend, u, & 141 v, vpt, w 138 142 139 143 USE cloud_parameters, & … … 531 535 k = surf_def_h(l)%k(m) 532 536 tend(k,j,i) = tend(k,j,i) + g / pt_reference & 537 * drho_air_zw(k-1) & 533 538 * surf_def_h(l)%shf(m) 534 539 ENDDO … … 541 546 k = surf_lsm_h%k(m) 542 547 tend(k,j,i) = tend(k,j,i) + g / pt_reference & 548 * drho_air_zw(k-1) & 543 549 * surf_lsm_h%shf(m) 544 550 ENDDO … … 550 556 k = surf_usm_h%k(m) 551 557 tend(k,j,i) = tend(k,j,i) + g / pt_reference & 558 * drho_air_zw(k-1) & 552 559 * surf_usm_h%shf(m) 553 560 ENDDO … … 559 566 DO m = surf_s, surf_e 560 567 k = surf_def_h(2)%k(m) 561 tend(k,j,i) = tend(k,j,i) + g / pt_reference * & 562 surf_def_h(2)%shf(m) 568 tend(k,j,i) = tend(k,j,i) + g / pt_reference & 569 * drho_air_zw(k-1) & 570 * surf_def_h(2)%shf(m) 563 571 ENDDO 564 572 ENDIF … … 613 621 k = surf_def_h(l)%k(m) 614 622 tend(k,j,i) = tend(k,j,i) + g / pt_reference & 623 * drho_air_zw(k-1) & 615 624 * surf_def_h(l)%shf(m) 616 625 ENDDO … … 623 632 k = surf_lsm_h%k(m) 624 633 tend(k,j,i) = tend(k,j,i) + g / pt_reference & 634 * drho_air_zw(k-1) & 625 635 * surf_lsm_h%shf(m) 626 636 ENDDO … … 632 642 k = surf_usm_h%k(m) 633 643 tend(k,j,i) = tend(k,j,i) + g / pt_reference & 644 * drho_air_zw(k-1) & 634 645 * surf_usm_h%shf(m) 635 646 ENDDO … … 641 652 DO m = surf_s, surf_e 642 653 k = surf_def_h(2)%k(m) 643 tend(k,j,i) = tend(k,j,i) + g / pt_reference * & 644 surf_def_h(2)%shf(m) 654 tend(k,j,i) = tend(k,j,i) + g / pt_reference & 655 * drho_air_zw(k-1) & 656 * surf_def_h(2)%shf(m) 645 657 ENDDO 646 658 ENDIF … … 754 766 tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) * & 755 767 ( k1 * surf_def_h(l)%shf(m) + & 756 k2 * surf_def_h(l)%qsws(m) ) 768 k2 * surf_def_h(l)%qsws(m) & 769 ) * drho_air_zw(k-1) 757 770 ENDDO 758 771 ENDDO … … 788 801 tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) * & 789 802 ( k1 * surf_lsm_h%shf(m) + & 790 k2 * surf_lsm_h%qsws(m) ) 803 k2 * surf_lsm_h%qsws(m) & 804 ) * drho_air_zw(k-1) 791 805 ENDDO 792 806 ! … … 821 835 tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) * & 822 836 ( k1 * surf_usm_h%shf(m) + & 823 k2 * surf_usm_h%qsws(m) ) 837 k2 * surf_usm_h%qsws(m) & 838 ) * drho_air_zw(k-1) 824 839 ENDDO 825 840 … … 861 876 tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) * & 862 877 ( k1 * surf_def_h(2)%shf(m) + & 863 k2 * surf_def_h(2)%qsws(m) ) 878 k2 * surf_def_h(2)%qsws(m) & 879 ) * drho_air_zw(k-1) 864 880 865 881 ENDDO … … 886 902 887 903 USE arrays_3d, & 888 ONLY: ddzw, dd2zu, kh, km, prho, pt, q, ql, tend, u, v, vpt, w 904 ONLY: ddzw, dd2zu, drho_air_zw, kh, km, prho, pt, q, ql, tend, u, & 905 v, vpt, w 889 906 890 907 USE cloud_parameters, & … … 1254 1271 k = surf_def_h(l)%k(m) 1255 1272 tend(k,j,i) = tend(k,j,i) + g / pt_reference * & 1256 surf_def_h(l)%shf(m) 1273 drho_air_zw(k-1) * & 1274 surf_def_h(l)%shf(m) 1257 1275 ENDDO 1258 1276 ENDDO … … 1264 1282 k = surf_lsm_h%k(m) 1265 1283 tend(k,j,i) = tend(k,j,i) + g / pt_reference * & 1284 drho_air_zw(k-1) * & 1266 1285 surf_lsm_h%shf(m) 1267 1286 ENDDO … … 1273 1292 k = surf_usm_h%k(m) 1274 1293 tend(k,j,i) = tend(k,j,i) + g / pt_reference * & 1294 drho_air_zw(k-1) * & 1275 1295 surf_usm_h%shf(m) 1276 1296 ENDDO … … 1283 1303 k = surf_def_h(2)%k(m) 1284 1304 tend(k,j,i) = tend(k,j,i) + g / pt_reference * & 1305 drho_air_zw(k-1) * & 1285 1306 surf_def_h(2)%shf(m) 1286 1307 ENDDO … … 1331 1352 k = surf_def_h(l)%k(m) 1332 1353 tend(k,j,i) = tend(k,j,i) + g / pt_reference & 1333 * surf_def_h(l)%shf(m) 1354 * drho_air_zw(k-1) & 1355 * surf_def_h(l)%shf(m) 1334 1356 ENDDO 1335 1357 ENDDO … … 1341 1363 k = surf_lsm_h%k(m) 1342 1364 tend(k,j,i) = tend(k,j,i) + g / pt_reference & 1343 * surf_lsm_h%shf(m) 1365 * drho_air_zw(k-1) & 1366 * surf_lsm_h%shf(m) 1344 1367 ENDDO 1345 1368 ! … … 1350 1373 k = surf_usm_h%k(m) 1351 1374 tend(k,j,i) = tend(k,j,i) + g / pt_reference & 1352 * surf_usm_h%shf(m) 1375 * drho_air_zw(k-1) & 1376 * surf_usm_h%shf(m) 1353 1377 ENDDO 1354 1378 ENDIF … … 1360 1384 k = surf_def_h(2)%k(m) 1361 1385 tend(k,j,i) = tend(k,j,i) + g / pt_reference * & 1362 surf_def_h(2)%shf(m) 1386 drho_air_zw(k-1) * & 1387 surf_def_h(2)%shf(m) 1363 1388 ENDDO 1364 1389 ENDIF … … 1461 1486 tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) * & 1462 1487 ( k1 * surf_def_h(l)%shf(m) + & 1463 k2 * surf_def_h(l)%qsws(m) ) 1488 k2 * surf_def_h(l)%qsws(m) & 1489 ) * drho_air_zw(k-1) 1464 1490 ENDDO 1465 1491 ENDDO … … 1495 1521 tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) * & 1496 1522 ( k1 * surf_lsm_h%shf(m) + & 1497 k2 * surf_lsm_h%qsws(m) ) 1523 k2 * surf_lsm_h%qsws(m) & 1524 ) * drho_air_zw(k-1) 1498 1525 ENDDO 1499 1526 ! … … 1528 1555 tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) * & 1529 1556 ( k1 * surf_usm_h%shf(m) + & 1530 k2 * surf_usm_h%qsws(m) ) 1557 k2 * surf_usm_h%qsws(m) & 1558 ) * drho_air_zw(k-1) 1531 1559 ENDDO 1532 1560 … … 1565 1593 tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) * & 1566 1594 ( k1* surf_def_h(2)%shf(m) + & 1567 k2 * surf_def_h(2)%qsws(m) ) 1595 k2 * surf_def_h(2)%qsws(m) & 1596 ) * drho_air_zw(k-1) 1568 1597 ENDDO 1569 1598 … … 1585 1614 1586 1615 USE arrays_3d, & 1587 ONLY: kh, km, u, v, zu1616 ONLY: kh, km, drho_air_zw, u, v, zu 1588 1617 1589 1618 USE control_parameters, & … … 1630 1659 !-- effect of this error is negligible. 1631 1660 surf_def_h(0)%u_0(m) = u(k+1,j,i) + surf_def_h(0)%usws(m) * & 1661 drho_air_zw(k-1) * & 1632 1662 ( zu(k+1) - zu(k-1) ) / & 1633 1663 ( km(k,j,i) + 1.0E-20_wp ) 1634 1664 surf_def_h(0)%v_0(m) = v(k+1,j,i) + surf_def_h(0)%vsws(m) * & 1665 drho_air_zw(k-1) * & 1635 1666 ( zu(k+1) - zu(k-1) ) / & 1636 1667 ( km(k,j,i) + 1.0E-20_wp ) … … 1661 1692 !-- between u_0 and u(k-1). 1662 1693 surf_def_h(1)%u_0(m) = u(k-1,j,i) - surf_def_h(1)%usws(m) * & 1694 drho_air_zw(k-1) * & 1663 1695 ( zu(k+1) - zu(k-1) ) / & 1664 1696 ( km(k,j,i) + 1.0E-20_wp ) 1665 1697 surf_def_h(1)%v_0(m) = v(k-1,j,i) - surf_def_h(1)%vsws(m) * & 1698 drho_air_zw(k-1) * & 1666 1699 ( zu(k+1) - zu(k-1) ) / & 1667 1700 ( km(k,j,i) + 1.0E-20_wp ) … … 1690 1723 !-- effect of this error is negligible. 1691 1724 surf_lsm_h%u_0(m) = u(k+1,j,i) + surf_lsm_h%usws(m) * & 1725 drho_air_zw(k-1) * & 1692 1726 ( zu(k+1) - zu(k-1) ) / & 1693 1727 ( km(k,j,i) + 1.0E-20_wp ) 1694 1728 surf_lsm_h%v_0(m) = v(k+1,j,i) + surf_lsm_h%vsws(m) * & 1729 drho_air_zw(k-1) * & 1695 1730 ( zu(k+1) - zu(k-1) ) / & 1696 1731 ( km(k,j,i) + 1.0E-20_wp ) … … 1719 1754 !-- effect of this error is negligible. 1720 1755 surf_usm_h%u_0(m) = u(k+1,j,i) + surf_usm_h%usws(m) * & 1756 drho_air_zw(k-1) * & 1721 1757 ( zu(k+1) - zu(k-1) ) / & 1722 1758 ( km(k,j,i) + 1.0E-20_wp ) 1723 1759 surf_usm_h%v_0(m) = v(k+1,j,i) + surf_usm_h%vsws(m) * & 1760 drho_air_zw(k-1) * & 1724 1761 ( zu(k+1) - zu(k-1) ) / & 1725 1762 ( km(k,j,i) + 1.0E-20_wp )
Note: See TracChangeset
for help on using the changeset viewer.
