Ignore:
Timestamp:
Mar 20, 2014 8:40:49 AM (8 years ago)
Author:
raasch
Message:

ONLY-attribute added to USE-statements,
kind-parameters added to all INTEGER and REAL declaration statements,
kinds are defined in new module kinds,
old module precision_kind is removed,
revision history before 2012 removed,
comment fields (!:) to be used for variable explanations added to all variable declaration statements

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/production_e.f90

    r1310 r1320  
    2020! Current revisions:
    2121! -----------------
    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
    2329!
    2430! Former revisions:
     
    5056! TKE production by buoyancy can be switched off in case of runs with pure
    5157! neutral stratification
    52 !
    53 ! 759 2011-09-15 13:58:31Z raasch
    54 ! initialization of u_0, v_0
    55 !
    56 ! 667 2010-12-23 12:06:00Z suehring/gryschka
    57 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
    58 !
    59 ! 449 2010-02-02 11:23:59Z raasch
    60 ! test output from rev 410 removed
    61 !
    62 ! 388 2009-09-23 09:40:33Z raasch
    63 ! Bugfix: wrong sign in buoyancy production of ocean part in case of not using
    64 !         the reference density (only in 3D routine production_e)
    65 ! Bugfix to avoid zero division by km_neutral
    66 !
    67 ! 208 2008-10-20 06:02:59Z raasch
    68 ! Bugfix concerning the calculation of velocity gradients at vertical walls
    69 ! in case of diabatic conditions
    70 !
    71 ! 187 2008-08-06 16:25:09Z letzel
    72 ! Change: add 'minus' sign to fluxes obtained from subroutine wall_fluxes_e for
    73 ! consistency with subroutine wall_fluxes
    74 !
    75 ! 124 2007-10-19 15:47:46Z raasch
    76 ! Bugfix: calculation of density flux in the ocean now starts from nzb+1
    77 !
    78 ! 108 2007-08-24 15:10:38Z letzel
    79 ! Bugfix: wrong sign removed from the buoyancy production term in the case
    80 ! use_reference = .T.,
    81 ! u_0 and v_0 are calculated for nxr+1, nyn+1 also (otherwise these values are
    82 ! not available in case of non-cyclic boundary conditions)
    83 ! Bugfix for ocean density flux at bottom
    84 !
    85 ! 97 2007-06-21 08:23:15Z raasch
    86 ! Energy production by density flux (in ocean) added
    87 ! use_pt_reference renamed use_reference
    88 !
    89 ! 75 2007-03-22 09:54:05Z raasch
    90 ! 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 humidity
    93 !
    94 ! 37 2007-03-01 08:33:54Z raasch
    95 ! Calculation extended for gridpoint nzt, extended for given temperature /
    96 ! humidity fluxes at the top, wall-part is now executed in case that a
    97 ! Prandtl-layer is switched on (instead of surfaces fluxes switched on)
    98 !
    99 ! RCS Log replace by Id keyword, revision history cleaned up
    100 !
    101 ! Revision 1.21  2006/04/26 12:45:35  raasch
    102 ! OpenMP parallelization of production_e_init
    10358!
    10459! Revision 1.1  1997/09/19 07:45:35  raasch
     
    11368!------------------------------------------------------------------------------!
    11469
    115     USE wall_fluxes_mod
     70    USE wall_fluxes_mod,                                                       &
     71        ONLY:  wall_fluxes_e, wall_fluxes_e_acc
     72
     73    USE kinds
    11674
    11775    PRIVATE
    11876    PUBLIC production_e, production_e_acc, production_e_init
    11977
    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  !:
    12382
    12483    INTERFACE production_e
     
    143102    SUBROUTINE production_e
    144103
    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
    151123
    152124       IMPLICIT NONE
    153125
    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  !:
    161151
    162152!
     
    166156!--    Therefore, ij-Version is called further below within the ij-loops.
    167157!       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 )
    172162!       ENDIF
    173163
     
    240230!--                         has been available
    241231                      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 )
    243233                      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 )
    245235                      km_neutral = kappa * ( usvs(k)**2 + wsvs(k)**2 )**0.25 * &
    246236                                   0.5 * dy
     
    270260!--                         has been available
    271261                      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 )
    273263                      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 )
    275265                      km_neutral = kappa * ( vsus(k)**2 + wsus(k)**2 )**0.25 * &
    276266                                   0.5 * dx
     
    716706    SUBROUTINE production_e_acc
    717707
    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
    724728
    725729       IMPLICIT NONE
    726730
    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  !:
    733755       !$acc declare create ( usvs, vsus, wsus, wsvs )
    734756
     
    739761!--    ij-version should be called further below within the ij-loops!!
    740762       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 )
    745767       ENDIF
    746768
     
    823845!--                               has been available
    824846!                            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 )
    826848!                            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 )
    828850                            km_neutral = kappa *                                    &
    829851                                        ( usvs(k,j,i)**2 + wsvs(k,j,i)**2 )**0.25 * &
     
    854876!--                               has been available
    855877!                            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 )
    857879!                            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 )
    859881                            km_neutral = kappa *                                     &
    860882                                         ( vsus(k,j,i)**2 + wsus(k,j,i)**2 )**0.25 * &
     
    13501372    SUBROUTINE production_e_ij( i, j )
    13511373
    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
    13581393
    13591394       IMPLICIT NONE
    13601395
    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  !:
    13671420
    13681421!
     
    14271480!--                   validation has been available
    14281481                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 )
    14301483                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 )
    14321485                km_neutral = kappa * ( usvs(k)**2 + wsvs(k)**2 )**0.25 * &
    14331486                             0.5 * dy
     
    14571510!--                   validation has been available
    14581511                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 )
    14601513                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 )
    14621515                km_neutral = kappa * ( vsus(k)**2 + wsus(k)**2 )**0.25 * &
    14631516                             0.5 * dx
     
    18401893    SUBROUTINE production_e_init
    18411894
    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
    18461904
    18471905       IMPLICIT NONE
    18481906
    1849        INTEGER ::  i, j, ku, kv
     1907       INTEGER(iwp) ::  i   !:
     1908       INTEGER(iwp) ::  j   !:
     1909       INTEGER(iwp) ::  ku  !:
     1910       INTEGER(iwp) ::  kv  !:
    18501911
    18511912       IF ( prandtl_layer )  THEN
Note: See TracChangeset for help on using the changeset viewer.