Changeset 4626 for palm


Ignore:
Timestamp:
Jul 26, 2020 9:49:48 AM (3 months ago)
Author:
raasch
Message:

files re-formatted to follow the PALM coding standard

Location:
palm/trunk/SOURCE
Files:
2 edited

Legend:

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

    r4517 r4626  
    33! This file is part of the PALM model system.
    44!
    5 ! PALM is free software: you can redistribute it and/or modify it under the
    6 ! terms of the GNU General Public License as published by the Free Software
    7 ! Foundation, either version 3 of the License, or (at your option) any later
    8 ! version.
    9 !
    10 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
    11 ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
    12 ! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
    13 !
    14 ! You should have received a copy of the GNU General Public License along with
    15 ! PALM. If not, see <http://www.gnu.org/licenses/>.
     5! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General
     6! Public License as published by the Free Software Foundation, either version 3 of the License, or
     7! (at your option) any later version.
     8!
     9! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
     10! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
     11! Public License for more details.
     12!
     13! You should have received a copy of the GNU General Public License along with PALM. If not, see
     14! <http://www.gnu.org/licenses/>.
    1615!
    1716! Copyright 1997-2020 Leibniz Universitaet Hannover
     
    2019! Current revisions:
    2120! -----------------
    22 ! 
    23 ! 
     21!
     22!
    2423! Former revisions:
    2524! -----------------
    2625! $Id$
     26! file re-formatted to follow the PALM coding standard
     27!
     28! 4517 2020-05-03 14:29:30Z raasch
    2729! added restart with MPI-IO for reading local arrays
    28 ! 
     30!
    2931! 4505 2020-04-20 15:37:15Z schwenkel
    3032! Add flag for saturation check
    31 ! 
     33!
    3234! 4495 2020-04-13 20:11:20Z resler
    3335! restart data handling with MPI-IO added
    34 ! 
     36!
    3537! 4360 2020-01-07 11:25:50Z suehring
    3638! Bugfix for last commit.
    37 ! 
     39!
    3840! 4359 2019-12-30 13:36:50Z suehring
    3941! Refine post-initialization check for realistically inital values of mixing ratio. Give an error
    40 ! message for faulty initial values, but only a warning in a restart run. 
    41 ! 
     42! message for faulty initial values, but only a warning in a restart run.
     43!
    4244! 4347 2019-12-18 13:18:33Z suehring
    4345! Implement post-initialization check for realistically inital values of mixing ratio
    44 ! 
     46!
    4547! 4281 2019-10-29 15:15:39Z schwenkel
    4648! Moved boundary conditions in dynamics module
    47 ! 
     49!
    4850! 4097 2019-07-15 11:59:11Z suehring
    4951! Avoid overlong lines - limit is 132 characters per line
     
    6062
    6163
    62     USE arrays_3d, &
    63         ONLY:  c_u, c_u_m, c_u_m_l, c_v, c_v_m, c_v_m_l, c_w, c_w_m, c_w_m_l,  &
    64                dzu, &
    65                exner, &
    66                hyp, &
    67                pt, pt_1, pt_2, pt_init, pt_p, &
    68                q, q_1, q_2, q_p, &
    69                s, s_1, s_2, s_p, &
    70                u, u_1, u_2, u_init, u_p, u_m_l, u_m_n, u_m_r, u_m_s, &
    71                v, v_1, v_2, v_p, v_init, v_m_l, v_m_n, v_m_r, v_m_s, &
     64    USE arrays_3d,                                                                                 &
     65        ONLY:  c_u, c_u_m, c_u_m_l, c_v, c_v_m, c_v_m_l, c_w, c_w_m, c_w_m_l,                      &
     66               dzu,                                                                                &
     67               exner,                                                                              &
     68               hyp,                                                                                &
     69               pt, pt_1, pt_2, pt_init, pt_p,                                                      &
     70               q, q_1, q_2, q_p,                                                                   &
     71               s, s_1, s_2, s_p,                                                                   &
     72               u, u_1, u_2, u_init, u_p, u_m_l, u_m_n, u_m_r, u_m_s,                               &
     73               v, v_1, v_2, v_p, v_init, v_m_l, v_m_n, v_m_r, v_m_s,                               &
    7274               w, w_1, w_2, w_p, w_m_l, w_m_n, w_m_r, w_m_s
    7375
     
    7678               rd_d_rv
    7779
    78     USE control_parameters, &
    79         ONLY:  bc_dirichlet_l, &
    80                bc_dirichlet_s, &
    81                bc_radiation_l, &
    82                bc_radiation_n, &
    83                bc_radiation_r, &
    84                bc_radiation_s, &
    85                bc_pt_t_val, &
    86                bc_q_t_val, &
    87                bc_s_t_val, &
    88                check_realistic_q, &
    89                child_domain, &
    90                coupling_mode, &
    91                dt_3d, &
    92                ibc_pt_b, &
    93                ibc_pt_t, &
    94                ibc_q_b, &
    95                ibc_q_t, &
    96                ibc_s_b, &
    97                ibc_s_t, &
    98                ibc_uv_b, &
    99                ibc_uv_t, &
    100                initializing_actions, &
    101                intermediate_timestep_count, &
    102                length, &
    103                message_string, &
    104                nesting_offline, &
    105                nudging, &
    106                restart_string, &
    107                humidity, &
    108                neutral, &
    109                passive_scalar, &
    110                tsc, &
     80    USE control_parameters,                                                                        &
     81        ONLY:  bc_dirichlet_l,                                                                     &
     82               bc_dirichlet_s,                                                                     &
     83               bc_radiation_l,                                                                     &
     84               bc_radiation_n,                                                                     &
     85               bc_radiation_r,                                                                     &
     86               bc_radiation_s,                                                                     &
     87               bc_pt_t_val,                                                                        &
     88               bc_q_t_val,                                                                         &
     89               bc_s_t_val,                                                                         &
     90               check_realistic_q,                                                                  &
     91               child_domain,                                                                       &
     92               coupling_mode,                                                                      &
     93               dt_3d,                                                                              &
     94               humidity,                                                                          &
     95               ibc_pt_b,                                                                          &
     96               ibc_pt_t,                                                                          &
     97               ibc_q_b,                                                                            &
     98               ibc_q_t,                                                                            &
     99               ibc_s_b,                                                                            &
     100               ibc_s_t,                                                                            &
     101               ibc_uv_b,                                                                          &
     102               ibc_uv_t,                                                                          &
     103               initializing_actions,                                                              &
     104               intermediate_timestep_count,                                                        &
     105               length,                                                                            &
     106               message_string,                                                                    &
     107               nesting_offline,                                                                    &
     108               neutral,                                                                            &
     109               nudging,                                                                            &
     110               passive_scalar,                                                                    &
     111               restart_string,                                                                    &
     112               tsc,                                                                                &
    111113               use_cmax
    112114
    113     USE grid_variables, &
    114         ONLY:  ddx, &
    115                ddy, &
    116                dx, &
     115    USE grid_variables,                                                                            &
     116        ONLY:  ddx,                                                                                &
     117               ddy,                                                                                &
     118               dx,                                                                                 &
    117119               dy
    118120
    119     USE indices, &
    120         ONLY:  nbgp, &
    121                nx, &
    122                nxl, &
    123                nxlg, &
    124                nxr, &
    125                nxrg, &
    126                ny, &
    127                nys, &
    128                nysg, &
    129                nyn, &
    130                nyng, &
    131                nzb, &
     121    USE indices,                                                                                   &
     122        ONLY:  nbgp,                                                                               &
     123               nx,                                                                                 &
     124               nxl,                                                                                &
     125               nxlg,                                                                               &
     126               nxr,                                                                                &
     127               nxrg,                                                                               &
     128               ny,                                                                                 &
     129               nys,                                                                                &
     130               nysg,                                                                               &
     131               nyn,                                                                                &
     132               nyng,                                                                               &
     133               nzb,                                                                                &
    132134               nzt
    133135
     
    136138    USE pegrid
    137139
    138     USE pmc_interface, &
     140    USE pmc_interface,                                                                             &
    139141        ONLY : nesting_mode
    140142
     
    142144!        ONLY:
    143145
    144     USE surface_mod, &
     146    USE surface_mod,                                                                               &
    145147        ONLY :  bc_h
    146148
     
    156158!
    157159!-- Public functions
    158     PUBLIC &
    159        dynamics_parin, &
    160        dynamics_check_parameters, &
    161        dynamics_check_data_output_ts, &
    162        dynamics_check_data_output_pr, &
    163        dynamics_check_data_output, &
    164        dynamics_init_masks, &
    165        dynamics_define_netcdf_grid, &
    166        dynamics_init_arrays, &
    167        dynamics_init, &
    168        dynamics_init_checks, &
    169        dynamics_header, &
    170        dynamics_actions, &
    171        dynamics_non_advective_processes, &
    172        dynamics_exchange_horiz, &
    173        dynamics_prognostic_equations, &
    174        dynamics_boundary_conditions, &
    175        dynamics_swap_timelevel, &
    176        dynamics_3d_data_averaging, &
    177        dynamics_data_output_2d, &
    178        dynamics_data_output_3d, &
    179        dynamics_statistics, &
    180        dynamics_rrd_global, &
    181        dynamics_rrd_local, &
    182        dynamics_wrd_global, &
    183        dynamics_wrd_local, &
     160    PUBLIC                                                                                         &
     161       dynamics_parin,                                                                             &
     162       dynamics_check_parameters,                                                                  &
     163       dynamics_check_data_output_ts,                                                              &
     164       dynamics_check_data_output_pr,                                                              &
     165       dynamics_check_data_output,                                                                 &
     166       dynamics_init_masks,                                                                        &
     167       dynamics_define_netcdf_grid,                                                                &
     168       dynamics_init_arrays,                                                                       &
     169       dynamics_init,                                                                              &
     170       dynamics_init_checks,                                                                       &
     171       dynamics_header,                                                                            &
     172       dynamics_actions,                                                                           &
     173       dynamics_non_advective_processes,                                                           &
     174       dynamics_exchange_horiz,                                                                    &
     175       dynamics_prognostic_equations,                                                              &
     176       dynamics_boundary_conditions,                                                               &
     177       dynamics_swap_timelevel,                                                                    &
     178       dynamics_3d_data_averaging,                                                                 &
     179       dynamics_data_output_2d,                                                                    &
     180       dynamics_data_output_3d,                                                                    &
     181       dynamics_statistics,                                                                        &
     182       dynamics_rrd_global,                                                                        &
     183       dynamics_rrd_local,                                                                         &
     184       dynamics_wrd_global,                                                                        &
     185       dynamics_wrd_local,                                                                         &
    184186       dynamics_last_actions
    185187
    186188!
    187189!-- Public parameters, constants and initial values
    188     PUBLIC &
     190    PUBLIC                                                                                         &
    189191       dynamics_module_enabled
    190192
     
    312314    CHARACTER (LEN=80)  ::  line  !< dummy string that contains the current line of the parameter file
    313315
    314     NAMELIST /dynamics_parameters/  &
     316    NAMELIST /dynamics_parameters/                                                                 &
    315317       dynamics_module_enabled
     318
    316319
    317320    line = ' '
     
    360363 SUBROUTINE dynamics_check_data_output_ts( dots_max, dots_num, dots_label, dots_unit )
    361364
     365    CHARACTER (LEN=*), DIMENSION(dots_max), INTENT(INOUT)  :: dots_label
     366    CHARACTER (LEN=*), DIMENSION(dots_max), INTENT(INOUT)  :: dots_unit
    362367
    363368    INTEGER(iwp),      INTENT(IN)     ::  dots_max
    364369    INTEGER(iwp),      INTENT(INOUT)  ::  dots_num
    365     CHARACTER (LEN=*), DIMENSION(dots_max), INTENT(INOUT)  :: dots_label
    366     CHARACTER (LEN=*), DIMENSION(dots_max), INTENT(INOUT)  :: dots_unit
    367370
    368371!
     
    384387
    385388
     389    CHARACTER (LEN=*) ::  dopr_unit !< local value of dopr_unit
    386390    CHARACTER (LEN=*) ::  unit     !<
    387391    CHARACTER (LEN=*) ::  variable !<
    388     CHARACTER (LEN=*) ::  dopr_unit !< local value of dopr_unit
    389392
    390393    INTEGER(iwp) ::  var_count     !<
     
    433436
    434437
    435 !------------------------------------------------------------------------------!
     438!--------------------------------------------------------------------------------------------------!
    436439!
    437440! Description:
    438441! ------------
    439442!> Initialize module-specific masked output
    440 !------------------------------------------------------------------------------!
     443!--------------------------------------------------------------------------------------------------!
    441444 SUBROUTINE dynamics_init_masks( variable, unit )
    442445
     
    499502
    500503!
    501 !-- Check for realistic initial mixing ratio. This must be in a realistic phyiscial range and must 
    502 !-- not exceed the saturation mixing ratio by more than 2 percent. Please note, the check is 
    503 !-- performed for each grid point (not just for a vertical profile), in order to cover also 
     504!-- Check for realistic initial mixing ratio. This must be in a realistic phyiscial range and must
     505!-- not exceed the saturation mixing ratio by more than 2 percent. Please note, the check is
     506!-- performed for each grid point (not just for a vertical profile), in order to cover also
    504507!-- three-dimensional initialization. Note, this check gives an error only for the initial run not
    505508!-- for a restart run. In case there are no cloud physics considered, the mixing ratio can exceed
    506 !-- the saturation moisture. This case a warning is given. 
     509!-- the saturation moisture. This case a warning is given.
    507510    IF ( humidity  .AND.  .NOT. neutral  .AND.  check_realistic_q )  THEN
    508511       DO  i = nxl, nxr
     
    516519                q_s = rd_d_rv * e_s / ( hyp(k) - e_s )
    517520
    518                 IF ( q(k,j,i) > 1.02_wp * q_s )  realistic_q = .FALSE. 
     521                IF ( q(k,j,i) > 1.02_wp * q_s )  realistic_q = .FALSE.
    519522             ENDDO
    520523          ENDDO
    521524       ENDDO
    522525!
    523 !--    Since the check is performed locally, merge the logical flag from all mpi ranks, 
     526!--    Since the check is performed locally, merge the logical flag from all mpi ranks,
    524527!--    in order to do not print the error message multiple times.
    525528#if defined( __parallel )
     
    598601!-- Format-descriptors
    599602100 FORMAT (//' *** dynamic module disabled'/)
    600 110 FORMAT (//1X,78('#')                                                       &
    601             //' User-defined variables and actions:'/                          &
     603110 FORMAT (//1X,78('#')                                                                           &
     604            //' User-defined variables and actions:'/                                              &
    602605              ' -----------------------------------'//)
    603606
     
    621624!
    622625!-- Here the user-defined actions follow
    623 !-- No calls for single grid points are allowed at locations before and
    624 !-- after the timestep, since these calls are not within an i,j-loop
     626!-- No calls for single grid points are allowed at locations before and after the timestep, since
     627!-- these calls are not within an i,j-loop
    625628    SELECT CASE ( location )
    626629
     
    688691       CASE ( 'u-tendency' )
    689692
     693!
    690694!--       Next line is to avoid compiler warning about unused variables. Please remove.
    691695          IF ( i +  j < 0 )  CONTINUE
     
    784788
    785789    INTEGER(iwp), INTENT(IN) ::  i            !< grid index in x-direction
     790    INTEGER(iwp), INTENT(IN) ::  i_omp_start  !< first loop index of i-loop in prognostic_equations
    786791    INTEGER(iwp), INTENT(IN) ::  j            !< grid index in y-direction
    787     INTEGER(iwp), INTENT(IN) ::  i_omp_start  !< first loop index of i-loop in prognostic_equations
    788792    INTEGER(iwp), INTENT(IN) ::  tn           !< task number of openmp task
    789793
     
    848852!
    849853!-- Vertical nesting: Vertical velocity not zero at the top of the fine grid
    850     IF (  .NOT.  child_domain  .AND.  .NOT.  nesting_offline  .AND.            &
    851                  TRIM(coupling_mode) /= 'vnested_fine' )  THEN
     854    IF ( .NOT.  child_domain  .AND.  .NOT.  nesting_offline  .AND.                                 &
     855         TRIM(coupling_mode) /= 'vnested_fine' )  THEN
    852856       !$ACC KERNELS PRESENT(w_p)
    853857       w_p(nzt:nzt+1,:,:) = 0.0_wp  !< nzt is not a prognostic level (but cf. pres)
     
    857861!
    858862!-- Temperature at bottom and top boundary.
    859 !-- In case of coupled runs (ibc_pt_b = 2) the temperature is given by
    860 !-- the sea surface temperature of the coupled ocean model.
     863!-- In case of coupled runs (ibc_pt_b = 2) the temperature is given by the sea surface temperature
     864!-- of the coupled ocean model.
    861865!-- Dirichlet
    862866    IF ( .NOT. neutral )  THEN
     
    906910    ENDIF
    907911!
    908 !-- Boundary conditions for total water content,
    909 !-- bottom and top boundary (see also temperature)
     912!-- Boundary conditions for total water content, bottom and top boundary (see also temperature)
    910913    IF ( humidity )  THEN
    911914!
    912915!--    Surface conditions for constant_humidity_flux
    913 !--    Run loop over all non-natural and natural walls. Note, in wall-datatype
    914 !--    the k coordinate belongs to the atmospheric grid point, therefore, set
    915 !--    q_p at k-1
     916!--    Run loop over all non-natural and natural walls. Note, in wall-datatype the k coordinate
     917!--    belongs to the atmospheric grid point, therefore, set q_p at k-1
    916918       IF ( ibc_q_b == 0 ) THEN
    917919
     
    947949    ENDIF
    948950!
    949 !-- Boundary conditions for scalar,
    950 !-- bottom and top boundary (see also temperature)
     951!-- Boundary conditions for scalar, bottom and top boundary (see also temperature)
    951952    IF ( passive_scalar )  THEN
    952953!
    953954!--    Surface conditions for constant_humidity_flux
    954 !--    Run loop over all non-natural and natural walls. Note, in wall-datatype
    955 !--    the k coordinate belongs to the atmospheric grid point, therefore, set
    956 !--    s_p at k-1
     955!--    Run loop over all non-natural and natural walls. Note, in wall-datatype the k coordinate
     956!--    belongs to the atmospheric grid point, therefore, set s_p at k-1
    957957       IF ( ibc_s_b == 0 ) THEN
    958958
     
    991991    ENDIF
    992992!
    993 !-- In case of inflow or nest boundary at the south boundary the boundary for v
    994 !-- is at nys and in case of inflow or nest boundary at the left boundary the
    995 !-- boundary for u is at nxl. Since in prognostic_equations (cache optimized
    996 !-- version) these levels are handled as a prognostic level, boundary values
    997 !-- have to be restored here.
     993!-- In case of inflow or nest boundary at the south boundary the boundary for v is at nys and in
     994!-- case of inflow or nest boundary at the left boundary the boundary for u is at nxl. Since in
     995!-- prognostic_equations (cache optimized version) these levels are handled as a prognostic level,
     996!-- boundary values have to be restored here.
    998997    IF ( bc_dirichlet_s )  THEN
    999998       v_p(:,nys,:) = v_p(:,nys-1,:)
     
    10031002
    10041003!
    1005 !-- The same restoration for u at i=nxl and v at j=nys as above must be made
    1006 !-- in case of nest boundaries. This must not be done in case of vertical nesting
    1007 !-- mode as in that case the lateral boundaries are actually cyclic.
    1008 !-- Lateral oundary conditions for TKE and dissipation are set
    1009 !-- in tcm_boundary_conds.
     1004!-- The same restoration for u at i=nxl and v at j=nys as above must be made in case of nest
     1005!-- boundaries. This must not be done in case of vertical nesting mode as in that case the lateral
     1006!-- boundaries are actually cyclic.
     1007!-- Lateral oundary conditions for TKE and dissipation are set in tcm_boundary_conds.
    10101008    IF ( nesting_mode /= 'vertical'  .OR.  nesting_offline )  THEN
    10111009       IF ( bc_dirichlet_s )  THEN
     
    10191017!
    10201018!-- Lateral boundary conditions for scalar quantities at the outflow.
    1021 !-- Lateral oundary conditions for TKE and dissipation are set
    1022 !-- in tcm_boundary_conds.
     1019!-- Lateral oundary conditions for TKE and dissipation are set in tcm_boundary_conds.
    10231020    IF ( bc_radiation_s )  THEN
    10241021       pt_p(:,nys-1,:)     = pt_p(:,nys,:)
     
    10491046!
    10501047!-- Radiation boundary conditions for the velocities at the respective outflow.
    1051 !-- The phase velocity is either assumed to the maximum phase velocity that
    1052 !-- ensures numerical stability (CFL-condition) or calculated after
    1053 !-- Orlanski(1976) and averaged along the outflow boundary.
     1048!-- The phase velocity is either assumed to the maximum phase velocity that ensures numerical
     1049!-- stability (CFL-condition) or calculated after Orlanski(1976) and averaged along the outflow
     1050!-- boundary.
    10541051    IF ( bc_radiation_s )  THEN
    10551052
     
    10711068
    10721069!
    1073 !--       Calculate the phase speeds for u, v, and w, first local and then
    1074 !--       average along the outflow boundary.
     1070!--       Calculate the phase speeds for u, v, and w, first local and then average along the outflow
     1071!--       boundary.
    10751072          DO  k = nzb+1, nzt+1
    10761073             DO  i = nxl, nxr
     
    11241121#if defined( __parallel )
    11251122          IF ( collective_wait )  CALL MPI_BARRIER( comm1dx, ierr )
    1126           CALL MPI_ALLREDUCE( c_u_m_l(nzb+1), c_u_m(nzb+1), nzt-nzb, MPI_REAL, &
    1127                               MPI_SUM, comm1dx, ierr )
     1123          CALL MPI_ALLREDUCE( c_u_m_l(nzb+1), c_u_m(nzb+1), nzt-nzb, MPI_REAL, MPI_SUM, comm1dx,   &
     1124                              ierr )
    11281125          IF ( collective_wait )  CALL MPI_BARRIER( comm1dx, ierr )
    1129           CALL MPI_ALLREDUCE( c_v_m_l(nzb+1), c_v_m(nzb+1), nzt-nzb, MPI_REAL, &
    1130                               MPI_SUM, comm1dx, ierr )
     1126          CALL MPI_ALLREDUCE( c_v_m_l(nzb+1), c_v_m(nzb+1), nzt-nzb, MPI_REAL, MPI_SUM, comm1dx,   &
     1127                              ierr )
    11311128          IF ( collective_wait )  CALL MPI_BARRIER( comm1dx, ierr )
    1132           CALL MPI_ALLREDUCE( c_w_m_l(nzb+1), c_w_m(nzb+1), nzt-nzb, MPI_REAL, &
    1133                               MPI_SUM, comm1dx, ierr )
     1129          CALL MPI_ALLREDUCE( c_w_m_l(nzb+1), c_w_m(nzb+1), nzt-nzb, MPI_REAL, MPI_SUM, comm1dx,   &
     1130                              ierr )
    11341131#else
    11351132          c_u_m = c_u_m_l
     
    11541151          DO  k = nzb+1, nzt+1
    11551152             DO  i = nxlg, nxrg
    1156                 u_p(k,-1,i) = u(k,-1,i) - dt_3d * tsc(2) * c_u_m(k) *          &
    1157                                        ( u(k,-1,i) - u(k,0,i) ) * ddy
    1158 
    1159                 v_p(k,0,i)  = v(k,0,i)  - dt_3d * tsc(2) * c_v_m(k) *          &
    1160                                        ( v(k,0,i) - v(k,1,i) ) * ddy
    1161 
    1162                 w_p(k,-1,i) = w(k,-1,i) - dt_3d * tsc(2) * c_w_m(k) *          &
    1163                                        ( w(k,-1,i) - w(k,0,i) ) * ddy
     1153                u_p(k,-1,i) = u(k,-1,i) - dt_3d * tsc(2) * c_u_m(k) *                              &
     1154                                          ( u(k,-1,i) - u(k,0,i) ) * ddy
     1155
     1156                v_p(k,0,i)  = v(k,0,i)  - dt_3d * tsc(2) * c_v_m(k) *                              &
     1157                                          ( v(k,0,i) - v(k,1,i) ) * ddy
     1158
     1159                w_p(k,-1,i) = w(k,-1,i) - dt_3d * tsc(2) * c_w_m(k) *                              &
     1160                                          ( w(k,-1,i) - w(k,0,i) ) * ddy
    11641161             ENDDO
    11651162          ENDDO
     
    12101207
    12111208!
    1212 !--       Calculate the phase speeds for u, v, and w, first local and then
    1213 !--       average along the outflow boundary.
     1209!--       Calculate the phase speeds for u, v, and w, first local and then average along the outflow
     1210!--       boundary.
    12141211          DO  k = nzb+1, nzt+1
    12151212             DO  i = nxl, nxr
     
    12631260#if defined( __parallel )
    12641261          IF ( collective_wait )  CALL MPI_BARRIER( comm1dx, ierr )
    1265           CALL MPI_ALLREDUCE( c_u_m_l(nzb+1), c_u_m(nzb+1), nzt-nzb, MPI_REAL, &
    1266                               MPI_SUM, comm1dx, ierr )
     1262          CALL MPI_ALLREDUCE( c_u_m_l(nzb+1), c_u_m(nzb+1), nzt-nzb, MPI_REAL, MPI_SUM, comm1dx,   &
     1263                              ierr )
    12671264          IF ( collective_wait )  CALL MPI_BARRIER( comm1dx, ierr )
    1268           CALL MPI_ALLREDUCE( c_v_m_l(nzb+1), c_v_m(nzb+1), nzt-nzb, MPI_REAL, &
    1269                               MPI_SUM, comm1dx, ierr )
     1265          CALL MPI_ALLREDUCE( c_v_m_l(nzb+1), c_v_m(nzb+1), nzt-nzb, MPI_REAL, MPI_SUM, comm1dx,   &
     1266                              ierr )
    12701267          IF ( collective_wait )  CALL MPI_BARRIER( comm1dx, ierr )
    1271           CALL MPI_ALLREDUCE( c_w_m_l(nzb+1), c_w_m(nzb+1), nzt-nzb, MPI_REAL, &
    1272                               MPI_SUM, comm1dx, ierr )
     1268          CALL MPI_ALLREDUCE( c_w_m_l(nzb+1), c_w_m(nzb+1), nzt-nzb, MPI_REAL, MPI_SUM, comm1dx,   &
     1269                              ierr )
    12731270#else
    12741271          c_u_m = c_u_m_l
     
    12931290          DO  k = nzb+1, nzt+1
    12941291             DO  i = nxlg, nxrg
    1295                 u_p(k,ny+1,i) = u(k,ny+1,i) - dt_3d * tsc(2) * c_u_m(k) *      &
    1296                                        ( u(k,ny+1,i) - u(k,ny,i) ) * ddy
    1297 
    1298                 v_p(k,ny+1,i) = v(k,ny+1,i)  - dt_3d * tsc(2) * c_v_m(k) *     &
    1299                                        ( v(k,ny+1,i) - v(k,ny,i) ) * ddy
    1300 
    1301                 w_p(k,ny+1,i) = w(k,ny+1,i) - dt_3d * tsc(2) * c_w_m(k) *      &
    1302                                        ( w(k,ny+1,i) - w(k,ny,i) ) * ddy
     1292                u_p(k,ny+1,i) = u(k,ny+1,i) - dt_3d * tsc(2) * c_u_m(k) *                          &
     1293                                              ( u(k,ny+1,i) - u(k,ny,i) ) * ddy
     1294
     1295                v_p(k,ny+1,i) = v(k,ny+1,i)  - dt_3d * tsc(2) * c_v_m(k) *                         &
     1296                                               ( v(k,ny+1,i) - v(k,ny,i) ) * ddy
     1297
     1298                w_p(k,ny+1,i) = w(k,ny+1,i) - dt_3d * tsc(2) * c_w_m(k) *                          &
     1299                                              ( w(k,ny+1,i) - w(k,ny,i) ) * ddy
    13031300             ENDDO
    13041301          ENDDO
     
    13491346
    13501347!
    1351 !--       Calculate the phase speeds for u, v, and w, first local and then
    1352 !--       average along the outflow boundary.
     1348!--       Calculate the phase speeds for u, v, and w, first local and then average along the outflow
     1349!--       boundary.
    13531350          DO  k = nzb+1, nzt+1
    13541351             DO  j = nys, nyn
     
    14021399#if defined( __parallel )
    14031400          IF ( collective_wait )  CALL MPI_BARRIER( comm1dy, ierr )
    1404           CALL MPI_ALLREDUCE( c_u_m_l(nzb+1), c_u_m(nzb+1), nzt-nzb, MPI_REAL, &
    1405                               MPI_SUM, comm1dy, ierr )
     1401          CALL MPI_ALLREDUCE( c_u_m_l(nzb+1), c_u_m(nzb+1), nzt-nzb, MPI_REAL, MPI_SUM, comm1dy,   &
     1402                              ierr )
    14061403          IF ( collective_wait )  CALL MPI_BARRIER( comm1dy, ierr )
    1407           CALL MPI_ALLREDUCE( c_v_m_l(nzb+1), c_v_m(nzb+1), nzt-nzb, MPI_REAL, &
    1408                               MPI_SUM, comm1dy, ierr )
     1404          CALL MPI_ALLREDUCE( c_v_m_l(nzb+1), c_v_m(nzb+1), nzt-nzb, MPI_REAL, MPI_SUM, comm1dy,   &
     1405                              ierr )
    14091406          IF ( collective_wait )  CALL MPI_BARRIER( comm1dy, ierr )
    1410           CALL MPI_ALLREDUCE( c_w_m_l(nzb+1), c_w_m(nzb+1), nzt-nzb, MPI_REAL, &
    1411                               MPI_SUM, comm1dy, ierr )
     1407          CALL MPI_ALLREDUCE( c_w_m_l(nzb+1), c_w_m(nzb+1), nzt-nzb, MPI_REAL, MPI_SUM, comm1dy,   &
     1408                              ierr )
    14121409#else
    14131410          c_u_m = c_u_m_l
     
    14321429          DO  k = nzb+1, nzt+1
    14331430             DO  j = nysg, nyng
    1434                 u_p(k,j,0) = u(k,j,0) - dt_3d * tsc(2) * c_u_m(k) *            &
    1435                                        ( u(k,j,0) - u(k,j,1) ) * ddx
    1436 
    1437                 v_p(k,j,-1) = v(k,j,-1) - dt_3d * tsc(2) * c_v_m(k) *          &
    1438                                        ( v(k,j,-1) - v(k,j,0) ) * ddx
    1439 
    1440                 w_p(k,j,-1) = w(k,j,-1) - dt_3d * tsc(2) * c_w_m(k) *          &
    1441                                        ( w(k,j,-1) - w(k,j,0) ) * ddx
     1431                u_p(k,j,0)  = u(k,j,0) - dt_3d * tsc(2) * c_u_m(k) *                               &
     1432                                         ( u(k,j,0) - u(k,j,1) ) * ddx
     1433
     1434                v_p(k,j,-1) = v(k,j,-1) - dt_3d * tsc(2) * c_v_m(k) *                              &
     1435                                          ( v(k,j,-1) - v(k,j,0) ) * ddx
     1436
     1437                w_p(k,j,-1) = w(k,j,-1) - dt_3d * tsc(2) * c_w_m(k) *                              &
     1438                                          ( w(k,j,-1) - w(k,j,0) ) * ddx
    14421439             ENDDO
    14431440          ENDDO
     
    14881485
    14891486!
    1490 !--       Calculate the phase speeds for u, v, and w, first local and then
    1491 !--       average along the outflow boundary.
     1487!--       Calculate the phase speeds for u, v, and w, first local and then average along the outflow
     1488!--       boundary.
    14921489          DO  k = nzb+1, nzt+1
    14931490             DO  j = nys, nyn
     
    15411538#if defined( __parallel )
    15421539          IF ( collective_wait )  CALL MPI_BARRIER( comm1dy, ierr )
    1543           CALL MPI_ALLREDUCE( c_u_m_l(nzb+1), c_u_m(nzb+1), nzt-nzb, MPI_REAL, &
    1544                               MPI_SUM, comm1dy, ierr )
     1540          CALL MPI_ALLREDUCE( c_u_m_l(nzb+1), c_u_m(nzb+1), nzt-nzb, MPI_REAL, MPI_SUM, comm1dy,   &
     1541                              ierr )
    15451542          IF ( collective_wait )  CALL MPI_BARRIER( comm1dy, ierr )
    1546           CALL MPI_ALLREDUCE( c_v_m_l(nzb+1), c_v_m(nzb+1), nzt-nzb, MPI_REAL, &
    1547                               MPI_SUM, comm1dy, ierr )
     1543          CALL MPI_ALLREDUCE( c_v_m_l(nzb+1), c_v_m(nzb+1), nzt-nzb, MPI_REAL, MPI_SUM, comm1dy,   &
     1544                              ierr )
    15481545          IF ( collective_wait )  CALL MPI_BARRIER( comm1dy, ierr )
    1549           CALL MPI_ALLREDUCE( c_w_m_l(nzb+1), c_w_m(nzb+1), nzt-nzb, MPI_REAL, &
    1550                               MPI_SUM, comm1dy, ierr )
     1546          CALL MPI_ALLREDUCE( c_w_m_l(nzb+1), c_w_m(nzb+1), nzt-nzb, MPI_REAL, MPI_SUM, comm1dy,   &
     1547                              ierr )
    15511548#else
    15521549          c_u_m = c_u_m_l
     
    15711568          DO  k = nzb+1, nzt+1
    15721569             DO  j = nysg, nyng
    1573                 u_p(k,j,nx+1) = u(k,j,nx+1) - dt_3d * tsc(2) * c_u_m(k) *      &
    1574                                        ( u(k,j,nx+1) - u(k,j,nx) ) * ddx
    1575 
    1576                 v_p(k,j,nx+1) = v(k,j,nx+1) - dt_3d * tsc(2) * c_v_m(k) *      &
    1577                                        ( v(k,j,nx+1) - v(k,j,nx) ) * ddx
    1578 
    1579                 w_p(k,j,nx+1) = w(k,j,nx+1) - dt_3d * tsc(2) * c_w_m(k) *      &
    1580                                        ( w(k,j,nx+1) - w(k,j,nx) ) * ddx
     1570                u_p(k,j,nx+1) = u(k,j,nx+1) - dt_3d * tsc(2) * c_u_m(k) *                          &
     1571                                              ( u(k,j,nx+1) - u(k,j,nx) ) * ddx
     1572
     1573                v_p(k,j,nx+1) = v(k,j,nx+1) - dt_3d * tsc(2) * c_v_m(k) *                          &
     1574                                              ( v(k,j,nx+1) - v(k,j,nx) ) * ddx
     1575
     1576                w_p(k,j,nx+1) = w(k,j,nx+1) - dt_3d * tsc(2) * c_w_m(k) *                          &
     1577                                              ( w(k,j,nx+1) - w(k,j,nx) ) * ddx
    15811578             ENDDO
    15821579          ENDDO
     
    16091606
    16101607 END SUBROUTINE dynamics_boundary_conditions
    1611 !------------------------------------------------------------------------------!
     1608!--------------------------------------------------------------------------------------------------!
    16121609! Description:
    16131610! ------------
    16141611!> Swap timelevels of module-specific array pointers
    1615 !------------------------------------------------------------------------------!
     1612!--------------------------------------------------------------------------------------------------!
    16161613 SUBROUTINE dynamics_swap_timelevel ( mod_count )
    16171614
     
    16601657! Description:
    16611658! ------------
    1662 !> Sum up and time-average module-specific output quantities
    1663 !> as well as allocate the array necessary for storing the average.
     1659!> Sum up and time-average module-specific output quantities as well as allocate the array necessary
     1660!> for storing the average.
    16641661!--------------------------------------------------------------------------------------------------!
    16651662 SUBROUTINE dynamics_3d_data_averaging( mode, variable )
     
    17091706! Description:
    17101707! ------------
    1711 !> Resorts the module-specific output quantity with indices (k,j,i) to a
    1712 !> temporary array with indices (i,j,k) and sets the grid on which it is defined.
     1708!> Resorts the module-specific output quantity with indices (k,j,i) to a temporary array with
     1709!> indices (i,j,k) and sets the grid on which it is defined.
    17131710!> Allowed values for grid are "zu" and "zw".
    17141711!--------------------------------------------------------------------------------------------------!
    1715  SUBROUTINE dynamics_data_output_2d( av, variable, found, grid, mode, local_pf, &
    1716                                      two_d, nzb_do, nzt_do, fill_value )
    1717 
    1718 
    1719     CHARACTER (LEN=*) ::  grid     !<
     1712 SUBROUTINE dynamics_data_output_2d( av, variable, found, grid, mode, local_pf, two_d, nzb_do,     &
     1713                                     nzt_do, fill_value )
     1714
     1715
     1716    CHARACTER (LEN=*)             ::  grid       !<
    17201717    CHARACTER (LEN=*), INTENT(IN) ::  mode       !< either 'xy', 'xz' or 'yz'
    1721     CHARACTER (LEN=*) ::  variable !<
     1718    CHARACTER (LEN=*)             ::  variable  !<
    17221719
    17231720    INTEGER(iwp) ::  av     !< flag to control data output of instantaneous or time-averaged data
     
    17591756! Description:
    17601757! ------------
    1761 !> Resorts the module-specific output quantity with indices (k,j,i)
    1762 !> to a temporary array with indices (i,j,k).
     1758!> Resorts the module-specific output quantity with indices (k,j,i) to a temporary array with
     1759!> indices (i,j,k).
    17631760!--------------------------------------------------------------------------------------------------!
    17641761 SUBROUTINE dynamics_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
     
    18361833 SUBROUTINE dynamics_rrd_global_ftn( found )
    18371834
    1838 
    18391835    LOGICAL, INTENT(OUT)  ::  found
    18401836
     
    18641860!--------------------------------------------------------------------------------------------------!
    18651861 SUBROUTINE dynamics_rrd_global_mpi
    1866 
    18671862
    18681863!    CALL rrd_mpi_io( 'global_parameter', global_parameter )
     
    18801875!> to the subdomain of the current PE (c). They have been calculated in routine rrd_local.
    18811876!--------------------------------------------------------------------------------------------------!
    1882  SUBROUTINE dynamics_rrd_local_ftn( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync,   &
    1883                                     nyn_on_file, nysf, nysc, nys_on_file, tmp_2d, tmp_3d, found )
     1877 SUBROUTINE dynamics_rrd_local_ftn( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf,     &
     1878                                    nync, nyn_on_file, nysf, nysc, nys_on_file, tmp_2d, tmp_3d,    &
     1879                                    found )
    18841880
    18851881
     
    19051901!
    19061902!-- Next line is to avoid compiler warning about unused variables. Please remove.
    1907     IF ( k + nxlc + nxlf + nxrc + nxrf + nync + nynf + nysc + nysf +           &
    1908          tmp_2d(nys_on_file,nxl_on_file) +                                     &
     1903    IF ( k + nxlc + nxlf + nxrc + nxrf + nync + nynf + nysc + nysf +                               &
     1904         tmp_2d(nys_on_file,nxl_on_file) +                                                         &
    19091905         tmp_3d(nzb,nys_on_file,nxl_on_file) < 0.0 )  CONTINUE
    19101906!
  • palm/trunk/SOURCE/exchange_horiz_mod.f90

    r4474 r4626  
    11!> @file exchange_horiz.f90
    2 !------------------------------------------------------------------------------!
     2!--------------------------------------------------------------------------------------------------!
    33! This file is part of the PALM model system.
    44!
    5 ! PALM is free software: you can redistribute it and/or modify it under the
    6 ! terms of the GNU General Public License as published by the Free Software
    7 ! Foundation, either version 3 of the License, or (at your option) any later
    8 ! version.
    9 !
    10 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
    11 ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
    12 ! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
    13 !
    14 ! You should have received a copy of the GNU General Public License along with
    15 ! PALM. If not, see <http://www.gnu.org/licenses/>.
     5! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General
     6! Public License as published by the Free Software Foundation, either version 3 of the License, or
     7! (at your option) any later version.
     8!
     9! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
     10! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
     11! Public License for more details.
     12!
     13! You should have received a copy of the GNU General Public License along with PALM. If not, see
     14! <http://www.gnu.org/licenses/>.
    1615!
    1716! Copyright 1997-2020 Leibniz Universitaet Hannover
    18 !------------------------------------------------------------------------------!
     17!--------------------------------------------------------------------------------------------------!
    1918!
    2019! Current revisions:
    2120! -----------------
    22 ! 
    23 ! 
     21!
     22!
    2423! Former revisions:
    2524! -----------------
    2625! $Id$
     26! file re-formatted to follow the PALM coding standard
     27!
     28! 4474 2020-03-26 09:32:18Z raasch
    2729! bugfix for correct usage of alternative communicators in case of 1d-decompositions and in
    2830! non-parallel mode
    29 ! 
     31!
    3032! 4461 2020-03-12 16:51:59Z raasch
    3133! optional communicator added to exchange_horiz
    32 ! 
     34!
    3335! 4457 2020-03-11 14:20:43Z raasch
    3436! routine has been modularized, file exchange_horiz_2d has been merged
    35 ! 
     37!
    3638! 4429 2020-02-27 15:24:30Z raasch
    3739! bugfix: cpp-directives added for serial mode
    38 ! 
     40!
    3941! 4360 2020-01-07 11:25:50Z suehring
    4042! Corrected "Former revisions" section
    41 ! 
     43!
    4244! 3761 2019-02-25 15:31:42Z raasch
    4345! OpenACC directives re-formatted
    44 ! 
     46!
    4547! 3657 2019-01-07 20:14:18Z knoop
    4648! OpenACC port for SPEC
     
    5254! Description:
    5355! ------------
    54 !> Exchange of ghost point layers for subdomains (in parallel mode) and setting
    55 !> of cyclic lateral boundary conditions for the total domain .
    56 !------------------------------------------------------------------------------!
     56!> Exchange of ghost point layers for subdomains (in parallel mode) and setting of cyclic lateral
     57!> boundary conditions for the total domain .
     58!--------------------------------------------------------------------------------------------------!
    5759 MODULE exchange_horiz_mod
    5860
     
    9193
    9294
    93 !------------------------------------------------------------------------------!
     95!--------------------------------------------------------------------------------------------------!
    9496! Description:
    9597! ------------
    96 !> Exchange of ghost point layers for subdomains (in parallel mode) and setting
    97 !> of cyclic lateral boundary conditions for the total domain.
     98!> Exchange of ghost point layers for subdomains (in parallel mode) and setting of cyclic lateral
     99!> boundary conditions for the total domain.
    98100!> This routine is for REAL 3d-arrays.
    99 !------------------------------------------------------------------------------!
     101!--------------------------------------------------------------------------------------------------!
    100102 SUBROUTINE exchange_horiz( ar, nbgp_local, alternative_communicator)
    101103
    102     USE control_parameters,                                                    &
     104    USE control_parameters,                                                                        &
    103105        ONLY:  bc_lr_cyc, bc_ns_cyc
    104106
    105107#if defined( __parallel )
    106     USE control_parameters,                                                    &
     108    USE control_parameters,                                                                        &
    107109        ONLY:  grid_level, mg_switch_to_pe0, synchronous_exchange
    108110#endif
    109                
    110     USE cpulog,                                                                &
     111
     112    USE cpulog,                                                                                    &
    111113        ONLY:  cpu_log, log_point_s
    112        
    113     USE indices,                                                               &
     114
     115    USE indices,                                                                                   &
    114116        ONLY:  nxl, nxr, nyn, nys, nzb, nzt
    115        
     117
    116118
    117119#if defined( _OPENACC )
     
    120122
    121123    INTEGER(iwp), OPTIONAL ::  alternative_communicator  !< alternative MPI communicator to be used
     124
    122125    INTEGER(iwp) ::  communicator  !< communicator that is used as argument in MPI calls
    123126    INTEGER(iwp) ::  left_pe       !< id of left pe that is used as argument in MPI calls
     
    126129    INTEGER(iwp) ::  right_pe      !< id of right pe that is used as argument in MPI calls
    127130    INTEGER(iwp) ::  south_pe      !< id of south pe that is used as argument in MPI calls
    128    
    129     REAL(wp), DIMENSION(nzb:nzt+1,nys-nbgp_local:nyn+nbgp_local,               &
     131
     132    REAL(wp), DIMENSION(nzb:nzt+1,nys-nbgp_local:nyn+nbgp_local,                                   &
    130133                        nxl-nbgp_local:nxr+nbgp_local) ::  ar !< 3d-array for which exchange is done
    131                        
     134
    132135
    133136    CALL cpu_log( log_point_s(2), 'exchange_horiz', 'start' )
     
    184187    IF ( pdims(1) == 1  .OR.  mg_switch_to_pe0 )  THEN
    185188!
    186 !--    One-dimensional decomposition along y, boundary values can be exchanged
    187 !--    within the PE memory
     189!--    One-dimensional decomposition along y, boundary values can be exchanged within the PE memory.
    188190       IF ( PRESENT( alternative_communicator ) )  THEN
    189191          IF ( alternative_communicator <= 2 )  THEN
     
    253255    IF ( pdims(2) == 1  .OR.  mg_switch_to_pe0 )  THEN
    254256!
    255 !--    One-dimensional decomposition along x, boundary values can be exchanged
    256 !--    within the PE memory
     257!--    One-dimensional decomposition along x, boundary values can be exchanged within the PE memory
    257258       IF ( PRESENT( alternative_communicator ) )  THEN
    258259          IF ( alternative_communicator == 1  .OR.  alternative_communicator == 3 )  THEN
     
    317318!
    318319!-- Lateral boundary conditions in the non-parallel case.
    319 !-- Case dependent, because in GPU mode still not all arrays are on device. This
    320 !-- workaround has to be removed later. Also, since PGI compiler 12.5 has problems
    321 !-- with array syntax, explicit loops are used.
     320!-- Case dependent, because in GPU mode still not all arrays are on device. This workaround has to
     321!-- be removed later. Also, since PGI compiler 12.5 has problems with array syntax, explicit loops
     322!-- are used.
    322323    IF ( PRESENT( alternative_communicator ) )  THEN
    323324       IF ( alternative_communicator <= 2 )  THEN
     
    371372
    372373
    373 !------------------------------------------------------------------------------!
     374!--------------------------------------------------------------------------------------------------!
    374375! Description:
    375376! ------------
    376377!> @todo Missing subroutine description.
    377 !------------------------------------------------------------------------------!
     378!--------------------------------------------------------------------------------------------------!
    378379 SUBROUTINE exchange_horiz_int( ar, nys_l, nyn_l, nxl_l, nxr_l, nzt_l, nbgp_local )
    379380
    380381
    381     USE control_parameters,                                                    &
     382    USE control_parameters,                                                                        &
    382383        ONLY:  bc_lr_cyc, bc_ns_cyc
    383384
    384385#if defined( __parallel )
    385     USE control_parameters,                                                    &
     386    USE control_parameters,                                                                        &
    386387        ONLY:  grid_level
    387388#endif
    388                        
    389     USE indices,                                                               &
     389
     390    USE indices,                                                                                   &
    390391        ONLY:  nzb
    391392
     393    INTEGER(iwp) ::  nbgp_local  !< number of ghost points
    392394    INTEGER(iwp) ::  nxl_l       !< local index bound at current grid level, left side
    393395    INTEGER(iwp) ::  nxr_l       !< local index bound at current grid level, right side
     
    395397    INTEGER(iwp) ::  nys_l       !< local index bound at current grid level, south side
    396398    INTEGER(iwp) ::  nzt_l       !< local index bound at current grid level, top
    397     INTEGER(iwp) ::  nbgp_local  !< number of ghost points
    398    
    399     INTEGER(iwp), DIMENSION(nzb:nzt_l+1,nys_l-nbgp_local:nyn_l+nbgp_local,     &
     399
     400    INTEGER(iwp), DIMENSION(nzb:nzt_l+1,nys_l-nbgp_local:nyn_l+nbgp_local,                         &
    400401                            nxl_l-nbgp_local:nxr_l+nbgp_local) ::  ar  !< treated array
    401402
     
    404405    IF ( pdims(1) == 1 )  THEN
    405406!
    406 !--    One-dimensional decomposition along y, boundary values can be exchanged
    407 !--    within the PE memory
     407!--    One-dimensional decomposition along y, boundary values can be exchanged within the PE memory
    408408       IF ( bc_lr_cyc )  THEN
    409409          ar(:,:,nxl_l-nbgp_local:nxl_l-1) = ar(:,:,nxr_l-nbgp_local+1:nxr_l)
     
    413413!
    414414!--    Send left boundary, receive right one (synchronous)
    415        CALL MPI_SENDRECV(                                                          &
    416            ar(nzb,nys_l-nbgp_local,nxl_l),   1, type_yz_int(grid_level), pleft,  0,&
    417            ar(nzb,nys_l-nbgp_local,nxr_l+1), 1, type_yz_int(grid_level), pright, 0,&
    418            comm2d, status, ierr )
     415       CALL MPI_SENDRECV( ar(nzb,nys_l-nbgp_local,nxl_l),   1, type_yz_int(grid_level), pleft,  0, &
     416                          ar(nzb,nys_l-nbgp_local,nxr_l+1), 1, type_yz_int(grid_level), pright, 0, &
     417                          comm2d, status, ierr )
    419418!
    420419!--    Send right boundary, receive left one (synchronous)
    421        CALL MPI_SENDRECV(                                                          &
    422            ar(nzb,nys_l-nbgp_local,nxr_l+1-nbgp_local), 1, type_yz_int(grid_level),&
    423            pright, 1,                                                              &
    424            ar(nzb,nys_l-nbgp_local,nxl_l-nbgp_local),   1, type_yz_int(grid_level),&
    425            pleft,  1,                                                              &
    426            comm2d, status, ierr )
     420       CALL MPI_SENDRECV( ar(nzb,nys_l-nbgp_local,nxr_l+1-nbgp_local), 1, type_yz_int(grid_level), &
     421                          pright, 1,                                                               &
     422                          ar(nzb,nys_l-nbgp_local,nxl_l-nbgp_local),   1, type_yz_int(grid_level), &
     423                          pleft,  1,                                                               &
     424                          comm2d, status, ierr )
    427425    ENDIF
    428426
     
    430428    IF ( pdims(2) == 1 )  THEN
    431429!
    432 !--    One-dimensional decomposition along x, boundary values can be exchanged
    433 !--    within the PE memory
     430!--    One-dimensional decomposition along x, boundary values can be exchanged within the PE memory
    434431       IF ( bc_ns_cyc )  THEN
    435432          ar(:,nys_l-nbgp_local:nys_l-1,:) = ar(:,nyn_l-nbgp_local+1:nyn_l,:)
     
    441438!
    442439!--    Send front boundary, receive rear one (synchronous)
    443        CALL MPI_SENDRECV(                                                          &
    444            ar(nzb,nys_l,nxl_l-nbgp_local),   1, type_xz_int(grid_level), psouth, 0,&
    445            ar(nzb,nyn_l+1,nxl_l-nbgp_local), 1, type_xz_int(grid_level), pnorth, 0,&
    446            comm2d, status, ierr )
     440       CALL MPI_SENDRECV( ar(nzb,nys_l,nxl_l-nbgp_local),   1, type_xz_int(grid_level), psouth, 0, &
     441                          ar(nzb,nyn_l+1,nxl_l-nbgp_local), 1, type_xz_int(grid_level), pnorth, 0, &
     442                          comm2d, status, ierr )
    447443!
    448444!--    Send rear boundary, receive front one (synchronous)
    449        CALL MPI_SENDRECV( ar(nzb,nyn_l-nbgp_local+1,nxl_l-nbgp_local), 1,          &
    450                           type_xz_int(grid_level), pnorth, 1,                      &
    451                           ar(nzb,nys_l-nbgp_local,nxl_l-nbgp_local),   1,          &
    452                           type_xz_int(grid_level), psouth, 1,                      &
     445       CALL MPI_SENDRECV( ar(nzb,nyn_l-nbgp_local+1,nxl_l-nbgp_local), 1,                          &
     446                          type_xz_int(grid_level), pnorth, 1,                                      &
     447                          ar(nzb,nys_l-nbgp_local,nxl_l-nbgp_local),   1,                          &
     448                          type_xz_int(grid_level), psouth, 1,                                      &
    453449                          comm2d, status, ierr )
    454450
     
    473469! Description:
    474470! ------------
    475 !> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic
    476 !> boundary conditions, respectively, for 2D-arrays.
    477 !------------------------------------------------------------------------------!
     471!> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic boundary conditions,
     472!> respectively, for 2D-arrays.
     473!--------------------------------------------------------------------------------------------------!
    478474 SUBROUTINE exchange_horiz_2d( ar )
    479475
    480     USE control_parameters,                                                    &
    481         ONLY :  bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r,                &
    482                 bc_dirichlet_s, bc_radiation_l,                                &
    483                 bc_radiation_n, bc_radiation_r, bc_radiation_s
    484 
    485     USE cpulog,                                                                &
     476    USE control_parameters,                                                                        &
     477        ONLY :  bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s,                    &
     478                bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s
     479
     480    USE cpulog,                                                                                    &
    486481        ONLY :  cpu_log, log_point_s
    487482
    488     USE indices,                                                               &
     483    USE indices,                                                                                   &
    489484        ONLY :  nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg
    490485
    491486#if ! defined( __parallel )
    492     USE control_parameters,                                                    &
     487    USE control_parameters,                                                                        &
    493488        ONLY:  bc_lr_cyc, bc_ns_cyc
    494489#endif
     
    509504
    510505!
    511 !--    One-dimensional decomposition along y, boundary values can be exchanged
    512 !--    within the PE memory
     506!--    One-dimensional decomposition along y, boundary values can be exchanged within the PE memory
    513507       ar(:,nxlg:nxl-1) = ar(:,nxr-nbgp+1:nxr)
    514508       ar(:,nxr+1:nxrg) = ar(:,nxl:nxl+nbgp-1)
     
    518512!--    Send left boundary, receive right one
    519513
    520        CALL MPI_SENDRECV( ar(nysg,nxl), 1, type_y, pleft,  0,                 &
    521                           ar(nysg,nxr+1), 1, type_y, pright, 0,               &
     514       CALL MPI_SENDRECV( ar(nysg,nxl), 1, type_y, pleft,  0,                                      &
     515                          ar(nysg,nxr+1), 1, type_y, pright, 0,                                    &
    522516                          comm2d, status, ierr )
    523517!
    524518!--    Send right boundary, receive left one
    525        CALL MPI_SENDRECV( ar(nysg,nxr+1-nbgp), 1, type_y, pright,  1,         &
    526                           ar(nysg,nxlg), 1, type_y, pleft,   1,               &
     519       CALL MPI_SENDRECV( ar(nysg,nxr+1-nbgp), 1, type_y, pright,  1,                              &
     520                          ar(nysg,nxlg), 1, type_y, pleft,   1,                                    &
    527521                          comm2d, status, ierr )
    528522
     
    532526    IF ( pdims(2) == 1 )  THEN
    533527!
    534 !--    One-dimensional decomposition along x, boundary values can be exchanged
    535 !--    within the PE memory
     528!--    One-dimensional decomposition along x, boundary values can be exchanged within the PE memory
    536529       ar(nysg:nys-1,:) = ar(nyn-nbgp+1:nyn,:)
    537530       ar(nyn+1:nyng,:) = ar(nys:nys+nbgp-1,:)
     
    541534!--    Send front boundary, receive rear one
    542535
    543        CALL MPI_SENDRECV( ar(nys,nxlg), 1, type_x, psouth, 0,                 &
    544                           ar(nyn+1,nxlg), 1, type_x, pnorth, 0,               &
     536       CALL MPI_SENDRECV( ar(nys,nxlg), 1, type_x, psouth, 0,                                      &
     537                          ar(nyn+1,nxlg), 1, type_x, pnorth, 0,                                    &
    545538                          comm2d, status, ierr )
    546539!
    547540!--    Send rear boundary, receive front one
    548        CALL MPI_SENDRECV( ar(nyn+1-nbgp,nxlg), 1, type_x, pnorth, 1,          &
    549                           ar(nysg,nxlg), 1, type_x, psouth, 1,                &
     541       CALL MPI_SENDRECV( ar(nyn+1-nbgp,nxlg), 1, type_x, pnorth, 1,                               &
     542                          ar(nysg,nxlg), 1, type_x, psouth, 1,                                     &
    550543                          comm2d, status, ierr )
    551544
     
    596589
    597590
    598 !------------------------------------------------------------------------------!
     591!--------------------------------------------------------------------------------------------------!
    599592! Description:
    600593! ------------
    601 !> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic
    602 !> boundary conditions, respectively, for 2D 8-bit integer arrays.
    603 !------------------------------------------------------------------------------!
     594!> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic boundary conditions,
     595!> respectively, for 2D 8-bit integer arrays.
     596!--------------------------------------------------------------------------------------------------!
    604597 SUBROUTINE exchange_horiz_2d_byte( ar, nys_l, nyn_l, nxl_l, nxr_l, nbgp_local )
    605598
    606599
    607     USE control_parameters,                                                    &
    608         ONLY:  bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, &
    609                bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s, &
     600    USE control_parameters,                                                                        &
     601        ONLY:  bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s,                     &
    610602               bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s
    611603
    612     USE cpulog,                                                                &
     604    USE cpulog,                                                                                    &
    613605        ONLY:  cpu_log, log_point_s
    614606
    615607#if ! defined( __parallel )
    616     USE control_parameters,                                                    &
     608    USE control_parameters,                                                                        &
    617609        ONLY:  bc_lr_cyc, bc_ns_cyc
    618610#endif
    619611
     612    INTEGER(iwp) ::  nbgp_local  !< number of ghost layers to be exchanged
    620613    INTEGER(iwp) ::  i           !< dummy index to zero-gradient conditions at in/outflow boundaries
    621614    INTEGER(iwp) ::  nxl_l       !< local index bound at current grid level, left side
     
    623616    INTEGER(iwp) ::  nyn_l       !< local index bound at current grid level, north side
    624617    INTEGER(iwp) ::  nys_l       !< local index bound at current grid level, south side
    625     INTEGER(iwp) ::  nbgp_local  !< number of ghost layers to be exchanged
    626 
    627     INTEGER(KIND=1), DIMENSION(nys_l-nbgp_local:nyn_l+nbgp_local,              &
     618
     619    INTEGER(KIND=1), DIMENSION(nys_l-nbgp_local:nyn_l+nbgp_local,                                  &
    628620                               nxl_l-nbgp_local:nxr_l+nbgp_local) ::  ar  !< treated array
    629621
     
    637629
    638630!
    639 !--    One-dimensional decomposition along y, boundary values can be exchanged
    640 !--    within the PE memory
     631!--    One-dimensional decomposition along y, boundary values can be exchanged within the PE memory
    641632       ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l)
    642633       ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1)
     
    645636!
    646637!--    Send left boundary, receive right one
    647        CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxl_l),   1,                     &
    648                           type_y_byte, pleft,  0,                              &
    649                           ar(nys_l-nbgp_local,nxr_l+1), 1,                     &
    650                           type_y_byte, pright, 0,                              &
     638       CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxl_l),   1,                                         &
     639                          type_y_byte, pleft,  0,                                                  &
     640                          ar(nys_l-nbgp_local,nxr_l+1), 1,                                         &
     641                          type_y_byte, pright, 0,                                                  &
    651642                          comm2d, status, ierr )
    652643!
    653644!--    Send right boundary, receive left one
    654        CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxr_l+1-nbgp_local), 1,          &
    655                           type_y_byte, pright, 1,                              &
    656                           ar(nys_l-nbgp_local,nxl_l-nbgp_local),   1,          &
    657                           type_y_byte, pleft,  1,                              &
     645       CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxr_l+1-nbgp_local), 1,                              &
     646                          type_y_byte, pright, 1,                                                  &
     647                          ar(nys_l-nbgp_local,nxl_l-nbgp_local),   1,                              &
     648                          type_y_byte, pleft,  1,                                                  &
    658649                          comm2d, status, ierr )
    659650
     
    662653    IF ( pdims(2) == 1 )  THEN
    663654!
    664 !--    One-dimensional decomposition along x, boundary values can be exchanged
    665 !--    within the PE memory
     655!--    One-dimensional decomposition along x, boundary values can be exchanged within the PE memory
    666656       ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:)
    667657       ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:)
     
    671661!
    672662!--    Send front boundary, receive rear one
    673        CALL MPI_SENDRECV( ar(nys_l,nxl_l-nbgp_local),   1,                    &
    674                           type_x_byte, psouth, 0,                             &
    675                           ar(nyn_l+1,nxl_l-nbgp_local), 1,                    &
    676                           type_x_byte, pnorth, 0,                             &
     663       CALL MPI_SENDRECV( ar(nys_l,nxl_l-nbgp_local),   1,                                         &
     664                          type_x_byte, psouth, 0,                                                  &
     665                          ar(nyn_l+1,nxl_l-nbgp_local), 1,                                         &
     666                          type_x_byte, pnorth, 0,                                                  &
    677667                          comm2d, status, ierr )
    678668
    679669!
    680670!--    Send rear boundary, receive front one
    681        CALL MPI_SENDRECV( ar(nyn_l+1-nbgp_local,nxl_l-nbgp_local), 1,         &
    682                           type_x_byte, pnorth, 1,                             &
    683                           ar(nys_l-nbgp_local,nxl_l-nbgp_local),   1,         &
    684                           type_x_byte, psouth, 1,                             &
     671       CALL MPI_SENDRECV( ar(nyn_l+1-nbgp_local,nxl_l-nbgp_local), 1,                              &
     672                          type_x_byte, pnorth, 1,                                                  &
     673                          ar(nys_l-nbgp_local,nxl_l-nbgp_local),   1,                              &
     674                          type_x_byte, psouth, 1,                                                  &
    685675                          comm2d, status, ierr )
    686676
     
    730720
    731721
    732 !------------------------------------------------------------------------------!
     722!--------------------------------------------------------------------------------------------------!
    733723! Description:
    734724! ------------
    735 !> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic
    736 !> boundary conditions, respectively, for 2D 32-bit integer arrays.
    737 !------------------------------------------------------------------------------!
     725!> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic boundary conditions,
     726!> respectively, for 2D 32-bit integer arrays.
     727!--------------------------------------------------------------------------------------------------!
    738728 SUBROUTINE exchange_horiz_2d_int( ar, nys_l, nyn_l, nxl_l, nxr_l, nbgp_local )
    739729
    740730
    741     USE control_parameters,                                                    &
    742         ONLY:  bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, &
    743                bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s, &
     731    USE control_parameters,                                                                        &
     732        ONLY:  bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s,                     &
    744733               bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s
    745734
    746735#if defined( __parallel )
    747     USE control_parameters,                                                    &
     736    USE control_parameters,                                                                        &
    748737        ONLY:  grid_level
    749738#endif
    750739
    751     USE cpulog,                                                                &
     740    USE cpulog,                                                                                    &
    752741        ONLY:  cpu_log, log_point_s
    753742
    754743#if ! defined( __parallel )
    755     USE control_parameters,                                                    &
     744    USE control_parameters,                                                                        &
    756745        ONLY:  bc_lr_cyc, bc_ns_cyc
    757746#endif
    758747
     748    INTEGER(iwp) ::  nbgp_local  !< number of ghost layers to be exchanged
    759749    INTEGER(iwp) ::  i           !< dummy index to zero-gradient conditions at in/outflow boundaries
    760750    INTEGER(iwp) ::  nxl_l       !< local index bound at current grid level, left side
     
    762752    INTEGER(iwp) ::  nyn_l       !< local index bound at current grid level, north side
    763753    INTEGER(iwp) ::  nys_l       !< local index bound at current grid level, south side
    764     INTEGER(iwp) ::  nbgp_local  !< number of ghost layers to be exchanged
    765 
    766     INTEGER(iwp), DIMENSION(nys_l-nbgp_local:nyn_l+nbgp_local,                 &
     754
     755    INTEGER(iwp), DIMENSION(nys_l-nbgp_local:nyn_l+nbgp_local,                                     &
    767756                            nxl_l-nbgp_local:nxr_l+nbgp_local) ::  ar  !< treated array
    768757
     
    776765
    777766!
    778 !--    One-dimensional decomposition along y, boundary values can be exchanged
    779 !--    within the PE memory
     767!--    One-dimensional decomposition along y, boundary values can be exchanged within the PE memory
    780768       ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l)
    781769       ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1)
     
    784772!
    785773!--    Send left boundary, receive right one
    786        CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxl_l),   1,                     &
    787                           type_y_int(grid_level), pleft,  0,                   &
    788                           ar(nys_l-nbgp_local,nxr_l+1), 1,                     &
    789                           type_y_int(grid_level), pright, 0,                   &
     774       CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxl_l),   1,                                         &
     775                          type_y_int(grid_level), pleft,  0,                                       &
     776                          ar(nys_l-nbgp_local,nxr_l+1), 1,                                         &
     777                          type_y_int(grid_level), pright, 0,                                       &
    790778                          comm2d, status, ierr )
    791779!
    792780!--    Send right boundary, receive left one
    793        CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxr_l+1-nbgp_local), 1,          &
    794                           type_y_int(grid_level), pright, 1,                   &
    795                           ar(nys_l-nbgp_local,nxl_l-nbgp_local),   1,          &
    796                           type_y_int(grid_level), pleft,  1,                   &
     781       CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxr_l+1-nbgp_local), 1,                              &
     782                          type_y_int(grid_level), pright, 1,                                       &
     783                          ar(nys_l-nbgp_local,nxl_l-nbgp_local),   1,                              &
     784                          type_y_int(grid_level), pleft,  1,                                       &
    797785                          comm2d, status, ierr )
    798786
     
    801789    IF ( pdims(2) == 1 )  THEN
    802790!
    803 !--    One-dimensional decomposition along x, boundary values can be exchanged
    804 !--    within the PE memory
     791!--    One-dimensional decomposition along x, boundary values can be exchanged within the PE memory
    805792       ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:)
    806793       ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:)
     
    810797!
    811798!--    Send front boundary, receive rear one
    812        CALL MPI_SENDRECV( ar(nys_l,nxl_l-nbgp_local),   1,                    &
    813                           type_x_int(grid_level), psouth, 0,                  &
    814                           ar(nyn_l+1,nxl_l-nbgp_local), 1,                    &
    815                           type_x_int(grid_level), pnorth, 0,                  &
     799       CALL MPI_SENDRECV( ar(nys_l,nxl_l-nbgp_local),   1,                                         &
     800                          type_x_int(grid_level), psouth, 0,                                       &
     801                          ar(nyn_l+1,nxl_l-nbgp_local), 1,                                         &
     802                          type_x_int(grid_level), pnorth, 0,                                       &
    816803                          comm2d, status, ierr )
    817804
    818805!
    819806!--    Send rear boundary, receive front one
    820        CALL MPI_SENDRECV( ar(nyn_l+1-nbgp_local,nxl_l-nbgp_local), 1,         &
    821                           type_x_int(grid_level), pnorth, 1,                  &
    822                           ar(nys_l-nbgp_local,nxl_l-nbgp_local),   1,         &
    823                           type_x_int(grid_level), psouth, 1,                  &
     807       CALL MPI_SENDRECV( ar(nyn_l+1-nbgp_local,nxl_l-nbgp_local), 1,                              &
     808                          type_x_int(grid_level), pnorth, 1,                                       &
     809                          ar(nys_l-nbgp_local,nxl_l-nbgp_local),   1,                              &
     810                          type_x_int(grid_level), psouth, 1,                                       &
    824811                          comm2d, status, ierr )
    825812
Note: See TracChangeset for help on using the changeset viewer.