Changeset 1320 for palm/trunk/SOURCE/production_e.f90
- Timestamp:
- Mar 20, 2014 8:40:49 AM (10 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/production_e.f90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/production_e.f90
r1310 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! ONLY-attribute added to USE-statements, 23 ! kind-parameters added to all INTEGER and REAL declaration statements, 24 ! kinds are defined in new module kinds, 25 ! old module precision_kind is removed, 26 ! revision history before 2012 removed, 27 ! comment fields (!:) to be used for variable explanations added to 28 ! all variable declaration statements 23 29 ! 24 30 ! Former revisions: … … 50 56 ! TKE production by buoyancy can be switched off in case of runs with pure 51 57 ! neutral stratification 52 !53 ! 759 2011-09-15 13:58:31Z raasch54 ! initialization of u_0, v_055 !56 ! 667 2010-12-23 12:06:00Z suehring/gryschka57 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng58 !59 ! 449 2010-02-02 11:23:59Z raasch60 ! test output from rev 410 removed61 !62 ! 388 2009-09-23 09:40:33Z raasch63 ! Bugfix: wrong sign in buoyancy production of ocean part in case of not using64 ! the reference density (only in 3D routine production_e)65 ! Bugfix to avoid zero division by km_neutral66 !67 ! 208 2008-10-20 06:02:59Z raasch68 ! Bugfix concerning the calculation of velocity gradients at vertical walls69 ! in case of diabatic conditions70 !71 ! 187 2008-08-06 16:25:09Z letzel72 ! Change: add 'minus' sign to fluxes obtained from subroutine wall_fluxes_e for73 ! consistency with subroutine wall_fluxes74 !75 ! 124 2007-10-19 15:47:46Z raasch76 ! Bugfix: calculation of density flux in the ocean now starts from nzb+177 !78 ! 108 2007-08-24 15:10:38Z letzel79 ! Bugfix: wrong sign removed from the buoyancy production term in the case80 ! use_reference = .T.,81 ! u_0 and v_0 are calculated for nxr+1, nyn+1 also (otherwise these values are82 ! not available in case of non-cyclic boundary conditions)83 ! Bugfix for ocean density flux at bottom84 !85 ! 97 2007-06-21 08:23:15Z raasch86 ! Energy production by density flux (in ocean) added87 ! use_pt_reference renamed use_reference88 !89 ! 75 2007-03-22 09:54:05Z raasch90 ! Wall functions now include diabatic conditions, call of routine wall_fluxes_e,91 ! reference temperature pt_reference can be used in buoyancy term,92 ! moisture renamed humidity93 !94 ! 37 2007-03-01 08:33:54Z raasch95 ! Calculation extended for gridpoint nzt, extended for given temperature /96 ! humidity fluxes at the top, wall-part is now executed in case that a97 ! Prandtl-layer is switched on (instead of surfaces fluxes switched on)98 !99 ! RCS Log replace by Id keyword, revision history cleaned up100 !101 ! Revision 1.21 2006/04/26 12:45:35 raasch102 ! OpenMP parallelization of production_e_init103 58 ! 104 59 ! Revision 1.1 1997/09/19 07:45:35 raasch … … 113 68 !------------------------------------------------------------------------------! 114 69 115 USE wall_fluxes_mod 70 USE wall_fluxes_mod, & 71 ONLY: wall_fluxes_e, wall_fluxes_e_acc 72 73 USE kinds 116 74 117 75 PRIVATE 118 76 PUBLIC production_e, production_e_acc, production_e_init 119 77 120 LOGICAL, SAVE :: first_call = .TRUE. 121 122 REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: u_0, v_0 78 LOGICAL, SAVE :: first_call = .TRUE. !: 79 80 REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE :: u_0 !: 81 REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE :: v_0 !: 123 82 124 83 INTERFACE production_e … … 143 102 SUBROUTINE production_e 144 103 145 USE arrays_3d 146 USE cloud_parameters 147 USE control_parameters 148 USE grid_variables 149 USE indices 150 USE statistics 104 USE arrays_3d, & 105 ONLY: ddzw, dd2zu, kh, km, pt, q, ql, qsws, qswst, rho, shf, & 106 tend, tswst, u, v, vpt, w 107 108 USE cloud_parameters, & 109 ONLY: l_d_cp, l_d_r, pt_d_t, t_d_pt 110 111 USE control_parameters, & 112 ONLY: cloud_droplets, cloud_physics, g, humidity, kappa, neutral, & 113 ocean, prandtl_layer, pt_reference, rho_reference, & 114 use_single_reference_value, use_surface_fluxes, & 115 use_top_fluxes 116 117 USE grid_variables, & 118 ONLY: ddx, dx, ddy, dy, wall_e_x, wall_e_y 119 120 USE indices, & 121 ONLY: nxl, nxr, nys, nyn, nzb, nzb_diff_s_inner, & 122 nzb_diff_s_outer, nzb_s_inner, nzt, nzt_diff 151 123 152 124 IMPLICIT NONE 153 125 154 INTEGER :: i, j, k 155 156 REAL :: def, dudx, dudy, dudz, dvdx, dvdy, dvdz, dwdx, dwdy, dwdz, & 157 k1, k2, km_neutral, theta, temp 158 159 ! REAL, DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: usvs, vsus, wsus, wsvs 160 REAL, DIMENSION(nzb:nzt+1) :: usvs, vsus, wsus, wsvs 126 INTEGER(iwp) :: i !: 127 INTEGER(iwp) :: j !: 128 INTEGER(iwp) :: k !: 129 130 REAL(wp) :: def !: 131 REAL(wp) :: dudx !: 132 REAL(wp) :: dudy !: 133 REAL(wp) :: dudz !: 134 REAL(wp) :: dvdx !: 135 REAL(wp) :: dvdy !: 136 REAL(wp) :: dvdz !: 137 REAL(wp) :: dwdx !: 138 REAL(wp) :: dwdy !: 139 REAL(wp) :: dwdz !: 140 REAL(wp) :: k1 !: 141 REAL(wp) :: k2 !: 142 REAL(wp) :: km_neutral !: 143 REAL(wp) :: theta !: 144 REAL(wp) :: temp !: 145 146 ! REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: usvs, vsus, wsus, wsvs 147 REAL(wp), DIMENSION(nzb:nzt+1) :: usvs !: 148 REAL(wp), DIMENSION(nzb:nzt+1) :: vsus !: 149 REAL(wp), DIMENSION(nzb:nzt+1) :: wsus !: 150 REAL(wp), DIMENSION(nzb:nzt+1) :: wsvs !: 161 151 162 152 ! … … 166 156 !-- Therefore, ij-Version is called further below within the ij-loops. 167 157 ! IF ( topography /= 'flat' ) THEN 168 ! CALL wall_fluxes_e( usvs, 1.0 , 0.0, 0.0, 0.0, wall_e_y )169 ! CALL wall_fluxes_e( wsvs, 0.0 , 0.0, 1.0, 0.0, wall_e_y )170 ! CALL wall_fluxes_e( vsus, 0.0 , 1.0, 0.0, 0.0, wall_e_x )171 ! CALL wall_fluxes_e( wsus, 0.0 , 0.0, 0.0, 1.0, wall_e_x )158 ! CALL wall_fluxes_e( usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, wall_e_y ) 159 ! CALL wall_fluxes_e( wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp, wall_e_y ) 160 ! CALL wall_fluxes_e( vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp, wall_e_x ) 161 ! CALL wall_fluxes_e( wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, wall_e_x ) 172 162 ! ENDIF 173 163 … … 240 230 !-- has been available 241 231 CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, & 242 usvs, 1.0 , 0.0, 0.0, 0.0)232 usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp ) 243 233 CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, & 244 wsvs, 0.0 , 0.0, 1.0, 0.0)234 wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp ) 245 235 km_neutral = kappa * ( usvs(k)**2 + wsvs(k)**2 )**0.25 * & 246 236 0.5 * dy … … 270 260 !-- has been available 271 261 CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, & 272 vsus, 0.0 , 1.0, 0.0, 0.0)262 vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp ) 273 263 CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, & 274 wsus, 0.0 , 0.0, 0.0, 1.0)264 wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp ) 275 265 km_neutral = kappa * ( vsus(k)**2 + wsus(k)**2 )**0.25 * & 276 266 0.5 * dx … … 716 706 SUBROUTINE production_e_acc 717 707 718 USE arrays_3d 719 USE cloud_parameters 720 USE control_parameters 721 USE grid_variables 722 USE indices 723 USE statistics 708 USE arrays_3d, & 709 ONLY: ddzw, dd2zu, kh, km, pt, q, ql, qsws, qswst, rho, shf, & 710 tend, tswst, u, v, vpt, w 711 712 USE cloud_parameters, & 713 ONLY: l_d_cp, l_d_r, pt_d_t, t_d_pt 714 715 USE control_parameters, & 716 ONLY: cloud_droplets, cloud_physics, g, humidity, kappa, neutral, & 717 ocean, prandtl_layer, pt_reference, rho_reference, & 718 topography, use_single_reference_value, use_surface_fluxes, & 719 use_top_fluxes 720 721 USE grid_variables, & 722 ONLY: ddx, dx, ddy, dy, wall_e_x, wall_e_y 723 724 USE indices, & 725 ONLY: i_left, i_right, j_north, j_south, nxl, nxr, nys, nyn, nzb, & 726 nzb_diff_s_inner, nzb_diff_s_outer, nzb_s_inner, nzt, & 727 nzt_diff 724 728 725 729 IMPLICIT NONE 726 730 727 INTEGER :: i, j, k 728 729 REAL :: def, dudx, dudy, dudz, dvdx, dvdy, dvdz, dwdx, dwdy, dwdz, & 730 k1, k2, km_neutral, theta, temp 731 732 REAL, DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: usvs, vsus, wsus, wsvs 731 INTEGER(iwp) :: i !: 732 INTEGER(iwp) :: j !: 733 INTEGER(iwp) :: k !: 734 735 REAL(wp) :: def !: 736 REAL(wp) :: dudx !: 737 REAL(wp) :: dudy !: 738 REAL(wp) :: dudz !: 739 REAL(wp) :: dvdx !: 740 REAL(wp) :: dvdy !: 741 REAL(wp) :: dvdz !: 742 REAL(wp) :: dwdx !: 743 REAL(wp) :: dwdy !: 744 REAL(wp) :: dwdz !: 745 REAL(wp) :: k1 !: 746 REAL(wp) :: k2 !: 747 REAL(wp) :: km_neutral !: 748 REAL(wp) :: theta !: 749 REAL(wp) :: temp !: 750 751 REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: usvs !: 752 REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: vsus !: 753 REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: wsus !: 754 REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: wsvs !: 733 755 !$acc declare create ( usvs, vsus, wsus, wsvs ) 734 756 … … 739 761 !-- ij-version should be called further below within the ij-loops!! 740 762 IF ( topography /= 'flat' ) THEN 741 CALL wall_fluxes_e_acc( usvs, 1.0 , 0.0, 0.0, 0.0, wall_e_y )742 CALL wall_fluxes_e_acc( wsvs, 0.0 , 0.0, 1.0, 0.0, wall_e_y )743 CALL wall_fluxes_e_acc( vsus, 0.0 , 1.0, 0.0, 0.0, wall_e_x )744 CALL wall_fluxes_e_acc( wsus, 0.0 , 0.0, 0.0, 1.0, wall_e_x )763 CALL wall_fluxes_e_acc( usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, wall_e_y ) 764 CALL wall_fluxes_e_acc( wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp, wall_e_y ) 765 CALL wall_fluxes_e_acc( vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp, wall_e_x ) 766 CALL wall_fluxes_e_acc( wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, wall_e_x ) 745 767 ENDIF 746 768 … … 823 845 !-- has been available 824 846 ! CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, & 825 ! usvs, 1.0 , 0.0, 0.0, 0.0)847 ! usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp ) 826 848 ! CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, & 827 ! wsvs, 0.0 , 0.0, 1.0, 0.0)849 ! wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp ) 828 850 km_neutral = kappa * & 829 851 ( usvs(k,j,i)**2 + wsvs(k,j,i)**2 )**0.25 * & … … 854 876 !-- has been available 855 877 ! CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, & 856 ! vsus, 0.0 , 1.0, 0.0, 0.0)878 ! vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp ) 857 879 ! CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, & 858 ! wsus, 0.0 , 0.0, 0.0, 1.0)880 ! wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp ) 859 881 km_neutral = kappa * & 860 882 ( vsus(k,j,i)**2 + wsus(k,j,i)**2 )**0.25 * & … … 1350 1372 SUBROUTINE production_e_ij( i, j ) 1351 1373 1352 USE arrays_3d 1353 USE cloud_parameters 1354 USE control_parameters 1355 USE grid_variables 1356 USE indices 1357 USE statistics 1374 USE arrays_3d, & 1375 ONLY: ddzw, dd2zu, kh, km, pt, q, ql, qsws, qswst, rho, shf, & 1376 tend, tswst, u, v, vpt, w 1377 1378 USE cloud_parameters, & 1379 ONLY: l_d_cp, l_d_r, pt_d_t, t_d_pt 1380 1381 USE control_parameters, & 1382 ONLY: cloud_droplets, cloud_physics, g, humidity, kappa, neutral, & 1383 ocean, prandtl_layer, pt_reference, rho_reference, & 1384 use_single_reference_value, use_surface_fluxes, & 1385 use_top_fluxes 1386 1387 USE grid_variables, & 1388 ONLY: ddx, dx, ddy, dy, wall_e_x, wall_e_y 1389 1390 USE indices, & 1391 ONLY: nxl, nxr, nys, nyn, nzb, nzb_diff_s_inner, & 1392 nzb_diff_s_outer, nzb_s_inner, nzt, nzt_diff 1358 1393 1359 1394 IMPLICIT NONE 1360 1395 1361 INTEGER :: i, j, k 1362 1363 REAL :: def, dudx, dudy, dudz, dvdx, dvdy, dvdz, dwdx, dwdy, dwdz, & 1364 k1, k2, km_neutral, theta, temp 1365 1366 REAL, DIMENSION(nzb:nzt+1) :: usvs, vsus, wsus, wsvs 1396 INTEGER(iwp) :: i !: 1397 INTEGER(iwp) :: j !: 1398 INTEGER(iwp) :: k !: 1399 1400 REAL(wp) :: def !: 1401 REAL(wp) :: dudx !: 1402 REAL(wp) :: dudy !: 1403 REAL(wp) :: dudz !: 1404 REAL(wp) :: dvdx !: 1405 REAL(wp) :: dvdy !: 1406 REAL(wp) :: dvdz !: 1407 REAL(wp) :: dwdx !: 1408 REAL(wp) :: dwdy !: 1409 REAL(wp) :: dwdz !: 1410 REAL(wp) :: k1 !: 1411 REAL(wp) :: k2 !: 1412 REAL(wp) :: km_neutral !: 1413 REAL(wp) :: theta !: 1414 REAL(wp) :: temp !: 1415 1416 REAL(wp), DIMENSION(nzb:nzt+1) :: usvs !: 1417 REAL(wp), DIMENSION(nzb:nzt+1) :: vsus !: 1418 REAL(wp), DIMENSION(nzb:nzt+1) :: wsus !: 1419 REAL(wp), DIMENSION(nzb:nzt+1) :: wsvs !: 1367 1420 1368 1421 ! … … 1427 1480 !-- validation has been available 1428 1481 CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, & 1429 usvs, 1.0 , 0.0, 0.0, 0.0)1482 usvs, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp ) 1430 1483 CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, & 1431 wsvs, 0.0 , 0.0, 1.0, 0.0)1484 wsvs, 0.0_wp, 0.0_wp, 1.0_wp, 0.0_wp ) 1432 1485 km_neutral = kappa * ( usvs(k)**2 + wsvs(k)**2 )**0.25 * & 1433 1486 0.5 * dy … … 1457 1510 !-- validation has been available 1458 1511 CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, & 1459 vsus, 0.0 , 1.0, 0.0, 0.0)1512 vsus, 0.0_wp, 1.0_wp, 0.0_wp, 0.0_wp ) 1460 1513 CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, & 1461 wsus, 0.0 , 0.0, 0.0, 1.0)1514 wsus, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp ) 1462 1515 km_neutral = kappa * ( vsus(k)**2 + wsus(k)**2 )**0.25 * & 1463 1516 0.5 * dx … … 1840 1893 SUBROUTINE production_e_init 1841 1894 1842 USE arrays_3d 1843 USE control_parameters 1844 USE grid_variables 1845 USE indices 1895 USE arrays_3d, & 1896 ONLY: kh, km, u, us, usws, v, vsws, zu 1897 1898 USE control_parameters, & 1899 ONLY: kappa, prandtl_layer 1900 1901 USE indices, & 1902 ONLY: nxl, nxlg, nxr, nxrg, nys, nysg, nyn, nyng, nzb_u_inner, & 1903 nzb_v_inner 1846 1904 1847 1905 IMPLICIT NONE 1848 1906 1849 INTEGER :: i, j, ku, kv 1907 INTEGER(iwp) :: i !: 1908 INTEGER(iwp) :: j !: 1909 INTEGER(iwp) :: ku !: 1910 INTEGER(iwp) :: kv !: 1850 1911 1851 1912 IF ( prandtl_layer ) THEN
Note: See TracChangeset
for help on using the changeset viewer.
