Ignore:
Timestamp:
Jun 11, 2020 8:51:48 AM (4 years ago)
Author:
raasch
Message:

files re-formatted to follow the PALM coding standard

File:
1 edited

Legend:

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

    r4457 r4559  
    11!> @file data_output_mask.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/>.
     15
    1616!
    1717! Copyright 1997-2020 Leibniz Universitaet Hannover
    18 !------------------------------------------------------------------------------!
     18!--------------------------------------------------------------------------------------------------!
    1919!
    2020! Current revisions:
     
    2525! -----------------
    2626! $Id$
     27! file re-formatted to follow the PALM coding standard
     28!
     29! 4457 2020-03-11 14:20:43Z raasch
    2730! use statement for exchange horiz added
    28 ! 
     31!
    2932! 4444 2020-03-05 15:59:50Z raasch
    3033! bugfix: cpp-directives for serial mode added
    3134!
    3235! 4377 2020-01-15 11:10:51Z gronemeier
    33 ! bugfix: set fill value for output according to wall_flags_total_0 for
    34 !         non-terrain following output
     36! bugfix: set fill value for output according to wall_flags_total_0 for non-terrain following output
    3537!
    3638! 4360 2020-01-07 11:25:50Z suehring
    37 ! Introduction of wall_flags_total_0, which currently sets bits based on static
    38 ! topography information used in wall_flags_static_0
     39! Introduction of wall_flags_total_0, which currently sets bits based on static topography
     40! information used in wall_flags_static_0
    3941!
    4042! 4331 2019-12-10 18:25:02Z suehring
     
    5153!
    5254! 4167 2019-08-16 11:01:48Z suehring
    53 ! Changed behaviour of masked output over surface to follow terrain and ignore
    54 ! buildings (J.Resler, T.Gronemeier)
     55! Changed behaviour of masked output over surface to follow terrain and ignore buildings
     56! (J.Resler, T.Gronemeier)
    5557!
    5658! 4069 2019-07-01 14:05:51Z Giersch
    57 ! Masked output running index mid has been introduced as a local variable to
    58 ! avoid runtime error (Loop variable has been modified) in time_integration
     59! Masked output running index mid has been introduced as a local variable to avoid runtime error
     60! (Loop variable has been modified) in time_integration
    5961!
    6062! 4039 2019-06-18 10:32:41Z suehring
     
    7678! ------------
    7779!> Masked data output in netCDF format for current mask (current value of mid).
    78 !------------------------------------------------------------------------------!
     80!--------------------------------------------------------------------------------------------------!
    7981 SUBROUTINE data_output_mask( av, mid )
    8082
     
    8284
    8385#if defined( __netcdf )
    84     USE arrays_3d,                                                             &
    85         ONLY:  e, nc, nr, p, pt, q, qc, ql, ql_c, ql_v, qr, rho_ocean, s, sa,  &
    86                tend, u, v, vpt, w, d_exner
    87 
    88     USE averaging,                                                             &
    89         ONLY:  e_av, lpt_av, nc_av, nr_av, p_av, pc_av, pr_av, pt_av, q_av,    &
    90                qc_av, ql_av, ql_c_av, ql_v_av, ql_vp_av, qv_av, qr_av,         &
    91                rho_ocean_av, s_av, sa_av, u_av, v_av, vpt_av, w_av
    92 
    93     USE basic_constants_and_equations_mod,                                     &
     86    USE arrays_3d,                                                                                 &
     87        ONLY:  d_exner, e, nc, nr, p, pt, q, qc, ql, ql_c, ql_v, qr, rho_ocean, s, sa, tend, u, v, &
     88               vpt, w
     89
     90    USE averaging,                                                                                 &
     91        ONLY:  e_av, lpt_av, nc_av, nr_av, p_av, pc_av, pr_av, pt_av, q_av, qc_av, ql_av, ql_c_av, &
     92               ql_v_av, ql_vp_av, qv_av, qr_av, rho_ocean_av, s_av, sa_av, u_av, v_av, vpt_av, w_av
     93
     94    USE basic_constants_and_equations_mod,                                                         &
    9495        ONLY:  lv_d_cp
    9596
    96     USE chemistry_model_mod,                                                   &
     97    USE chemistry_model_mod,                                                                       &
    9798        ONLY:  chem_data_output_mask
    9899
    99     USE control_parameters,                                                    &
    100         ONLY:  air_chemistry, domask, domask_no, domask_time_count, mask_i,    &
    101                mask_j, mask_k, mask_size_l, mask_surface,                                                   &
    102                max_masks, message_string, nz_do3d, salsa,                      &
     100    USE control_parameters,                                                                        &
     101        ONLY:  air_chemistry, domask, domask_no, domask_time_count, mask_i, mask_j, mask_k,        &
     102               mask_size_l, mask_surface, max_masks, message_string, nz_do3d, salsa,               &
    103103               time_since_reference_point
    104104
    105105#if defined( __parallel )
    106     USE control_parameters,                                                    &
     106    USE control_parameters,                                                                        &
    107107        ONLY:  mask_size, mask_start_l
    108108#endif
    109109
    110     USE cpulog,                                                                &
     110    USE cpulog,                                                                                    &
    111111        ONLY:  cpu_log, log_point
    112112
    113     USE diagnostic_output_quantities_mod,                                      &
     113    USE diagnostic_output_quantities_mod,                                                          &
    114114        ONLY:  doq_output_mask
    115115
    116     USE exchange_horiz_mod,                                                    &
     116    USE exchange_horiz_mod,                                                                        &
    117117        ONLY:  exchange_horiz
    118118
    119     USE indices,                                                               &
     119    USE indices,                                                                                   &
    120120        ONLY:  nbgp, nxl, nxr, nyn, nys, nzb, nzt, wall_flags_total_0
    121121
    122122    USE kinds
    123123
    124     USE bulk_cloud_model_mod,                                                  &
     124    USE bulk_cloud_model_mod,                                                                      &
    125125        ONLY:  bulk_cloud_model
    126126
    127127    USE NETCDF
    128128
    129     USE netcdf_interface,                                                      &
    130         ONLY:  fill_value, id_set_mask, id_var_domask, id_var_time_mask,       &
    131                nc_stat, netcdf_data_format, netcdf_handle_error
    132 
    133     USE particle_attributes,                                                   &
    134         ONLY:  grid_particles, number_of_particles, particles,                 &
    135                particle_advection_start, prt_count
     129    USE netcdf_interface,                                                                          &
     130        ONLY:  fill_value, id_set_mask, id_var_domask, id_var_time_mask, nc_stat,                  &
     131               netcdf_data_format, netcdf_handle_error
     132
     133    USE particle_attributes,                                                                       &
     134        ONLY:  grid_particles, number_of_particles, particles, particle_advection_start, prt_count
    136135
    137136    USE pegrid
    138137
    139     USE radiation_model_mod,                                                   &
     138    USE radiation_model_mod,                                                                       &
    140139        ONLY:  radiation, radiation_data_output_mask
    141140
    142     USE salsa_mod,                                                             &
     141    USE salsa_mod,                                                                                 &
    143142        ONLY:  salsa_data_output_mask
    144143
     
    149148    INTEGER(iwp) ::  flag_nr                 !< number of masking flag
    150149    INTEGER(iwp) ::  i                       !< loop index
     150    INTEGER(iwp) ::  im                      !< loop index for masked variables
    151151    INTEGER(iwp) ::  ivar                    !< variable index
    152152    INTEGER(iwp) ::  j                       !< loop index
     153    INTEGER(iwp) ::  jm                      !< loop index for masked variables
    153154    INTEGER(iwp) ::  k                       !< loop index
    154     INTEGER(iwp) ::  im                      !< loop index for masked variables
    155     INTEGER(iwp) ::  jm                      !< loop index for masked variables
    156155    INTEGER(iwp) ::  kk                      !< vertical index
     156    INTEGER(iwp) ::  ktt                     !< k index of highest terrain surface
    157157    INTEGER(iwp) ::  mid                     !< masked output running index
    158158    INTEGER(iwp) ::  n                       !< loop index
    159159    INTEGER(iwp) ::  netcdf_data_format_save !< value of netcdf_data_format
    160     INTEGER(iwp) ::  ktt                     !< k index of highest terrain surface
    161160#if defined( __parallel )
     161    INTEGER(iwp) ::  ind(6)                  !< index limits (lower/upper bounds) of array 'local_2d'
    162162    INTEGER(iwp) ::  ngp                     !< number of grid points of an output slice
    163163    INTEGER(iwp) ::  sender                  !< PE id of sending PE
    164     INTEGER(iwp) ::  ind(6)                  !< index limits (lower/upper bounds) of array 'local_2d'
    165164#endif
    166165
     
    178177    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !< points to array which shall be output
    179178
     179
    180180!
    181181!-- Return, if nothing to output
     
    185185
    186186!
    187 !-- Parallel netcdf output is not tested so far for masked data, hence
    188 !-- netcdf_data_format is switched back to non-paralell output.
     187!-- Parallel netcdf output is not tested so far for masked data, hence netcdf_data_format is
     188!-- switched back to non-paralell output.
    189189    netcdf_data_format_save = netcdf_data_format
    190190    IF ( netcdf_data_format == 5 ) netcdf_data_format = 3
     
    201201#if defined( __parallel )
    202202    IF ( myid == 0 )  THEN
    203        ALLOCATE( total_pf(mask_size(mid,1),mask_size(mid,2),mask_size(mid,3)) )
     203       ALLOCATE( total_pf( mask_size(mid,1),mask_size(mid,2),mask_size(mid,3) ) )
    204204    ENDIF
    205205#endif
    206     ALLOCATE( local_pf(mask_size_l(mid,1),mask_size_l(mid,2), &
    207                        mask_size_l(mid,3)) )
     206    ALLOCATE( local_pf( mask_size_l(mid,1),mask_size_l(mid,2), mask_size_l(mid,3) ) )
    208207
    209208!
     
    211210    domask_time_count(mid,av) = domask_time_count(mid,av) + 1
    212211    IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
    213        nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_time_mask(mid,av), &
    214                                (/ time_since_reference_point /),              &
    215                                start = (/ domask_time_count(mid,av) /),       &
     212       nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_time_mask(mid,av),                      &
     213                               (/ time_since_reference_point /),                                   &
     214                               start = (/ domask_time_count(mid,av) /),                            &
    216215                               count = (/ 1 /) )
    217216       CALL netcdf_handle_error( 'data_output_mask', 460 )
     
    225224!
    226225!--    Reallocate local_pf on PE 0 since its shape changes during MPI exchange
    227        IF ( netcdf_data_format < 5   .AND.  myid == 0  .AND.  ivar > 1 )  THEN
     226       IF ( netcdf_data_format < 5  .AND.  myid == 0  .AND.  ivar > 1 )  THEN
    228227          DEALLOCATE( local_pf )
    229           ALLOCATE( local_pf(mask_size_l(mid,1),mask_size_l(mid,2), &
    230                              mask_size_l(mid,3)) )
     228          ALLOCATE( local_pf( mask_size_l(mid,1),mask_size_l(mid,2), mask_size_l(mid,3) ) )
    231229       ENDIF
    232230!
     
    281279                      DO  j = 1, mask_size_l(mid,2)
    282280                         DO  k = 1, mask_size_l(mid,3)
    283                             local_pf(i,j,k) =  tend(mask_k(mid,k), &
    284                                       mask_j(mid,j),mask_i(mid,i))
     281                            local_pf(i,j,k) =  tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
    285282                         ENDDO
    286283                      ENDDO
     
    294291                         im = mask_i(mid,i)
    295292                         jm = mask_j(mid,j)
    296                          ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )),&
     293                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 ) ),     &
    297294                                       DIM = 1 ) - 1
    298295                         DO  k = 1, mask_size_l(mid,3)
     
    321318                         DO  k = nzb, nz_do3d
    322319                            number_of_particles = prt_count(k,j,i)
    323                             IF (number_of_particles <= 0)  CYCLE
     320                            IF ( number_of_particles <= 0 )  CYCLE
    324321                            particles => grid_particles(k,j,i)%particles(1:number_of_particles)
    325322                            s_r2 = 0.0_wp
     
    327324                            DO  n = 1, number_of_particles
    328325                               IF ( particles(n)%particle_mask )  THEN
    329                                   s_r2 = s_r2 + grid_particles(k,j,i)%particles(n)%radius**2 * &
     326                                  s_r2 = s_r2 + grid_particles(k,j,i)%particles(n)%radius**2 *     &
    330327                                         grid_particles(k,j,i)%particles(n)%weight_factor
    331                                   s_r3 = s_r3 + grid_particles(k,j,i)%particles(n)%radius**3 * &
     328                                  s_r3 = s_r3 + grid_particles(k,j,i)%particles(n)%radius**3 *     &
    332329                                         grid_particles(k,j,i)%particles(n)%weight_factor
    333330                               ENDIF
     
    350347                      DO  j = 1, mask_size_l(mid,2)
    351348                         DO  k = 1, mask_size_l(mid,3)
    352                             local_pf(i,j,k) =  tend(mask_k(mid,k), &
    353                                       mask_j(mid,j),mask_i(mid,i))
     349                            local_pf(i,j,k) =  tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
    354350                         ENDDO
    355351                      ENDDO
     
    363359                         im = mask_i(mid,i)
    364360                         jm = mask_j(mid,j)
    365                          ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
    366                                          DIM = 1 ) - 1
     361                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )),      &
     362                                       DIM = 1 ) - 1
    367363                         DO  k = 1, mask_size_l(mid,3)
    368364                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
     
    392388                         DO  j = 1, mask_size_l(mid,2)
    393389                            DO  k = 1, mask_size_l(mid,3)
    394                                local_pf(i,j,k) =  &
    395                                   pt(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) &
    396                                   + lv_d_cp * d_exner(mask_k(mid,k)) *          &
    397                                     ql(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
     390                               local_pf(i,j,k) = pt( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) &
     391                                                 + lv_d_cp * d_exner( mask_k(mid,k) ) *            &
     392                                                   ql(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i) )
    398393                            ENDDO
    399394                         ENDDO
     
    407402                            im = mask_i(mid,i)
    408403                            jm = mask_j(mid,j)
    409                             ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
    410                                              DIM = 1 ) - 1
     404                            ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )),   &
     405                                          DIM = 1 ) - 1
    411406                            DO  k = 1, mask_size_l(mid,3)
    412407                               kk = MIN( ktt+mask_k(mid,k), nzt+1 )
     
    415410                                  local_pf(i,j,k) = fill_value
    416411                               ELSE
    417                                   local_pf(i,j,k) = pt(kk,jm,im) + lv_d_cp * d_exner(kk) * ql(kk,jm,im)
     412                                  local_pf(i,j,k) = pt(kk,jm,im) +                                 &
     413                                                    lv_d_cp * d_exner(kk) * ql(kk,jm,im)
    418414                               ENDIF
    419415                            ENDDO
     
    469465                         DO  k = nzb, nz_do3d
    470466                            number_of_particles = prt_count(k,j,i)
    471                             IF (number_of_particles <= 0)  CYCLE
     467                            IF ( number_of_particles <= 0 )  CYCLE
    472468                            particles => grid_particles(k,j,i)%particles(1:number_of_particles)
    473469                            DO  n = 1, number_of_particles
    474470                               IF ( particles(n)%particle_mask )  THEN
    475471                                  tend(k,j,i) = tend(k,j,i) + &
    476                                           particles(n)%weight_factor / &
    477                                           prt_count(k,j,i)
     472                                          particles(n)%weight_factor / prt_count(k,j,i)
    478473                               ENDIF
    479474                            ENDDO
     
    489484                      DO  j = 1, mask_size_l(mid,2)
    490485                         DO  k = 1, mask_size_l(mid,3)
    491                             local_pf(i,j,k) =  tend(mask_k(mid,k), &
    492                                       mask_j(mid,j),mask_i(mid,i))
     486                            local_pf(i,j,k) =  tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
    493487                         ENDDO
    494488                      ENDDO
     
    502496                         im = mask_i(mid,i)
    503497                         jm = mask_j(mid,j)
    504                          ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
    505                                           DIM = 1 ) - 1
     498                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )),      &
     499                                       DIM = 1 ) - 1
    506500                         DO  k = 1, mask_size_l(mid,3)
    507501                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
     
    528522                      DO  j = 1, mask_size_l(mid,2)
    529523                         DO  k = 1, mask_size_l(mid,3)
    530                             local_pf(i,j,k) =  &
    531                                  q(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) -  &
    532                                  ql(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
     524                            local_pf(i,j,k) = q(  mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) -  &
     525                                              ql( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
    533526                         ENDDO
    534527                      ENDDO
     
    542535                         im = mask_i(mid,i)
    543536                         jm = mask_j(mid,j)
    544                          ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
    545                                           DIM = 1 ) - 1
     537                         ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )),      &
     538                                       DIM = 1 ) - 1
    546539                         DO  k = 1, mask_size_l(mid,3)
    547540                            kk = MIN( ktt+mask_k(mid,k), nzt+1 )
     
    622615          CASE DEFAULT
    623616!
    624 !--          Set flag to steer output of radiation, land-surface, or user-defined
    625 !--          quantities
     617!--          Set flag to steer output of radiation, land-surface, or user-defined quantities
    626618             found = .FALSE.
    627619!
    628620!--          Radiation quantity
    629621             IF ( .NOT. found  .AND. radiation )  THEN
    630                 CALL radiation_data_output_mask(av, domask(mid,av,ivar), found,&
    631                                                 local_pf, mid )
     622                CALL radiation_data_output_mask( av, domask(mid,av,ivar), found, local_pf, mid )
    632623             ENDIF
    633624
    634625             IF ( .NOT. found  .AND. air_chemistry )  THEN
    635                 CALL chem_data_output_mask(av, domask(mid,av,ivar), found,     &
    636                                            local_pf, mid )
     626                CALL chem_data_output_mask( av, domask(mid,av,ivar), found, local_pf, mid )
    637627             ENDIF
    638628!
    639629!--          Check for diagnostic quantities
    640630             IF ( .NOT. found )  THEN
    641                 CALL doq_output_mask( av, domask(mid,av,ivar), found, local_pf,   &
    642                                       mid)
     631                CALL doq_output_mask( av, domask(mid,av,ivar), found, local_pf, mid )
    643632             ENDIF
    644633!
    645634!--          SALSA quantities
    646              IF ( .NOT. found .AND. salsa )  THEN
    647                 CALL salsa_data_output_mask( av, domask(mid,av,ivar), found,   &
    648                                              local_pf, mid )
     635             IF ( .NOT. found  .AND.  salsa )  THEN
     636                CALL salsa_data_output_mask( av, domask(mid,av,ivar), found, local_pf, mid )
    649637             ENDIF
    650638!
    651639!--          User defined quantity
    652640             IF ( .NOT. found )  THEN
    653                 CALL user_data_output_mask(av, domask(mid,av,ivar), found,     &
    654                                            local_pf, mid )
     641                CALL user_data_output_mask( av, domask(mid,av,ivar), found, local_pf, mid )
    655642             ENDIF
    656643
     
    658645
    659646             IF ( .NOT. found )  THEN
    660                 WRITE ( message_string, * ) 'no masked output available for: ',&
     647                WRITE ( message_string, * ) 'no masked output available for: ',                    &
    661648                                            TRIM( domask(mid,av,ivar) )
    662649                CALL message( 'data_output_mask', 'PA0327', 0, 0, 0, 6, 0 )
     
    674661                DO  j = 1, mask_size_l(mid,2)
    675662                   DO  k = 1, mask_size_l(mid,3)
    676                       local_pf(i,j,k) = MERGE( to_be_resorted(mask_k(mid,k),  &
    677                                                               mask_j(mid,j),  &
    678                                                               mask_i(mid,i)), &
    679                                                REAL( fill_value, KIND = wp ), &
    680                                                BTEST( wall_flags_total_0(     &
    681                                                               mask_k(mid,k),  &
    682                                                               mask_j(mid,j),  &
    683                                                               mask_i(mid,i)), &
    684                                                       flag_nr ) )
     663                      local_pf(i,j,k) = MERGE( to_be_resorted( mask_k(mid,k),                      &
     664                                                               mask_j(mid,j),                      &
     665                                                               mask_i(mid,i)),                    &
     666                                               REAL( fill_value, KIND = wp ),                      &
     667                                               BTEST( wall_flags_total_0( mask_k(mid,k),           &
     668                                                                          mask_j(mid,j),           &
     669                                                                          mask_i(mid,i) ),         &
     670                                                      flag_nr )                                    &
     671                                             )
    685672                   ENDDO
    686673                ENDDO
     
    695682                   im = mask_i(mid,i)
    696683                   jm = mask_j(mid,j)
    697                    ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &
    698                                     DIM = 1 ) - 1
     684                   ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 ) ),          &
     685                                 DIM = 1 ) - 1
    699686                   DO  k = 1, mask_size_l(mid,3)
    700687                      kk = MIN( ktt+mask_k(mid,k), nzt+1 )
     
    726713!
    727714!--       (1) a. Parallel I/O using netCDF 4 (not yet tested)
    728           nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),                         &
    729                id_var_domask(mid,av,ivar), local_pf,                           &
    730                start = (/ mask_start_l(mid,1), mask_start_l(mid,2),            &
    731                           mask_start_l(mid,3), domask_time_count(mid,av) /),   &
    732                count = (/ mask_size_l(mid,1), mask_size_l(mid,2),              &
    733                           mask_size_l(mid,3), 1 /) )
     715          nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),                                             &
     716                                  id_var_domask(mid,av,ivar), local_pf,                            &
     717                                  start = (/ mask_start_l(mid,1), mask_start_l(mid,2),             &
     718                                             mask_start_l(mid,3), domask_time_count(mid,av) /),    &
     719                                  count = (/ mask_size_l(mid,1), mask_size_l(mid,2),               &
     720                                             mask_size_l(mid,3), 1 /) )
    734721          CALL netcdf_handle_error( 'data_output_mask', 461 )
    735722       ELSE
     
    737724!
    738725!--       (1) b. Conventional I/O only through PE0
    739 !--       PE0 receives partial arrays from all processors of the respective mask
    740 !--       and outputs them. Here a barrier has to be set, because otherwise
    741 !--       "-MPI- FATAL: Remote protocol queue full" may occur.
     726!--       PE0 receives partial arrays from all processors of the respective mask and outputs them.
     727!--       Here a barrier has to be set, because otherwise "-MPI- FATAL: Remote protocol queue full"
     728!--       may occur.
    742729          CALL MPI_BARRIER( comm2d, ierr )
    743730
     
    746733!
    747734!--          Local array can be relocated directly.
    748              total_pf( &
    749                mask_start_l(mid,1):mask_start_l(mid,1)+mask_size_l(mid,1)-1, &
    750                mask_start_l(mid,2):mask_start_l(mid,2)+mask_size_l(mid,2)-1, &
    751                mask_start_l(mid,3):mask_start_l(mid,3)+mask_size_l(mid,3)-1 ) &
    752                = local_pf
     735             total_pf( mask_start_l(mid,1):mask_start_l(mid,1)+mask_size_l(mid,1)-1,               &
     736                       mask_start_l(mid,2):mask_start_l(mid,2)+mask_size_l(mid,2)-1,               &
     737                       mask_start_l(mid,3):mask_start_l(mid,3)+mask_size_l(mid,3)-1 )              &
     738                  = local_pf
    753739!
    754740!--          Receive data from all other PEs.
     
    757743!--             Receive index limits first, then array.
    758744!--             Index limits are received in arbitrary order from the PEs.
    759                 CALL MPI_RECV( ind(1), 6, MPI_INTEGER, MPI_ANY_SOURCE, 0,  &
    760                      comm2d, status, ierr )
     745                CALL MPI_RECV( ind(1), 6, MPI_INTEGER, MPI_ANY_SOURCE, 0, comm2d, status, ierr )
    761746!
    762747!--             Not all PEs have data for the mask
    763748                IF ( ind(1) /= -9999 )  THEN
    764                    ngp = ( ind(2)-ind(1)+1 ) * (ind(4)-ind(3)+1 ) *  &
    765                          ( ind(6)-ind(5)+1 )
     749                   ngp = ( ind(2)-ind(1)+1 ) * (ind(4)-ind(3)+1 ) * ( ind(6)-ind(5)+1 )
    766750                   sender = status(MPI_SOURCE)
    767751                   DEALLOCATE( local_pf )
    768                    ALLOCATE(local_pf(ind(1):ind(2),ind(3):ind(4),ind(5):ind(6)))
    769                    CALL MPI_RECV( local_pf(ind(1),ind(3),ind(5)), ngp,  &
    770                         MPI_REAL, sender, 1, comm2d, status, ierr )
    771                    total_pf(ind(1):ind(2),ind(3):ind(4),ind(5):ind(6)) &
    772                         = local_pf
     752                   ALLOCATE( local_pf( ind(1):ind(2),ind(3):ind(4),ind(5):ind(6) ) )
     753                   CALL MPI_RECV( local_pf(ind(1),ind(3),ind(5)), ngp, MPI_REAL, sender, 1, comm2d,&
     754                                  status, ierr )
     755                   total_pf( ind(1):ind(2),ind(3):ind(4),ind(5):ind(6) ) = local_pf
    773756                ENDIF
    774757             ENDDO
    775758
    776              nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),                      &
    777                   id_var_domask(mid,av,ivar), total_pf,                        &
    778                   start = (/ 1, 1, 1, domask_time_count(mid,av) /),            &
    779                   count = (/ mask_size(mid,1), mask_size(mid,2),               &
    780                              mask_size(mid,3), 1 /) )
     759             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),                                          &
     760                                     id_var_domask(mid,av,ivar), total_pf,                         &
     761                                     start = (/ 1, 1, 1, domask_time_count(mid,av) /),             &
     762                                     count = (/ mask_size(mid,1), mask_size(mid,2),                &
     763                                                mask_size(mid,3), 1 /) )
    781764             CALL netcdf_handle_error( 'data_output_mask', 462 )
    782765
    783766          ELSE
    784767!
    785 !--          If at least part of the mask resides on the PE, send the index
    786 !--          limits for the target array, otherwise send -9999 to PE0.
    787              IF ( mask_size_l(mid,1) > 0 .AND.  mask_size_l(mid,2) > 0 .AND. &
    788                   mask_size_l(mid,3) > 0  ) &
    789                   THEN
     768!--          If at least part of the mask resides on the PE, send the index limits for the target
     769!--          array, otherwise send -9999 to PE0.
     770             IF ( mask_size_l(mid,1) > 0  .AND.  mask_size_l(mid,2) > 0  .AND.                     &
     771                  mask_size_l(mid,3) > 0  )  THEN
    790772                ind(1) = mask_start_l(mid,1)
    791773                ind(2) = mask_start_l(mid,1) + mask_size_l(mid,1) - 1
     
    803785!--          If applicable, send data to PE0.
    804786             IF ( ind(1) /= -9999 )  THEN
    805                 CALL MPI_SEND( local_pf(1,1,1), ngp, MPI_REAL, 0, 1, comm2d, &
    806                      ierr )
     787                CALL MPI_SEND( local_pf(1,1,1), ngp, MPI_REAL, 0, 1, comm2d, ierr )
    807788             ENDIF
    808789          ENDIF
    809790!
    810 !--       A barrier has to be set, because otherwise some PEs may proceed too
    811 !--       fast so that PE0 may receive wrong data on tag 0.
     791!--       A barrier has to be set, because otherwise some PEs may proceed too fast so that PE0 may
     792!--       receive wrong data on tag 0.
    812793          CALL MPI_BARRIER( comm2d, ierr )
    813794#if defined( __netcdf4_parallel )
     
    816797#else
    817798!
    818 !--    (2) For serial execution of PALM, the single processor (PE0) holds all
    819 !--    data and writes them directly to file.
    820        nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),                            &
    821                                id_var_domask(mid,av,ivar), local_pf,           &
    822                              start = (/ 1, 1, 1, domask_time_count(mid,av) /), &
    823                              count = (/ mask_size_l(mid,1), mask_size_l(mid,2),&
    824                                mask_size_l(mid,3), 1 /) )
     799!--    (2) For serial execution of PALM, the single processor (PE0) holds all data and writes them
     800!--        directly to file.
     801       nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),                                                &
     802                               id_var_domask(mid,av,ivar), local_pf,                               &
     803                               start = (/ 1, 1, 1, domask_time_count(mid,av) /),                  &
     804                               count = (/ mask_size_l(mid,1), mask_size_l(mid,2),                  &
     805                                          mask_size_l(mid,3), 1 /) )
    825806       CALL netcdf_handle_error( 'data_output_mask', 463 )
    826807#endif
Note: See TracChangeset for help on using the changeset viewer.