Changeset 4896 for palm/trunk


Ignore:
Timestamp:
Mar 3, 2021 4:10:18 PM (4 years ago)
Author:
raasch
Message:

small re-formatting to follow the coding standard, typo in file appendix removed, more meaningful variable names assigned, redundant code removed

Location:
palm/trunk/SOURCE
Files:
5 edited

Legend:

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

    r4895 r4896  
    2525! -----------------
    2626! $Id$
     27! small re-formatting to follow the coding standard
     28!
     29! 4895 2021-03-03 15:39:08Z suehring
    2730! Remove offset in terrain-following masked output
    2831!
     
    531534                      DO  j = 1, mask_size_l(mid,2)
    532535                         DO  k = 1, mask_size_l(mid,3)
    533                             local_pf(i,j,k) = q(  mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) -  &
    534                                               ql( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) )
     536                            local_pf(i,j,k) = q(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) -       &
     537                                              ql(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
    535538                         ENDDO
    536539                      ENDDO
  • palm/trunk/SOURCE/init_masks.f90

    r4895 r4896  
    2424! -----------------
    2525! $Id$
     26! small re-formatting to follow the coding standard
     27!
     28! 4895 2021-03-03 15:39:08Z suehring
    2629! Allow only mask_k_over_surface >= 1 for terrain-following mask output
    2730!
     
    159162    DO  mid = 1, masks
    160163
    161        do_mask     (mid,:) = data_output_masks(mid,:)
     164       do_mask(mid,:)      = data_output_masks(mid,:)
    162165       do_mask_user(mid,:) = data_output_masks_user(mid,:)
    163        mask      (mid,1,:) = mask_x(mid,:)
    164        mask      (mid,2,:) = mask_y(mid,:)
    165        mask      (mid,3,:) = mask_z(mid,:)
     166
     167       mask(mid,1,:) = mask_x(mid,:)
     168       mask(mid,2,:) = mask_y(mid,:)
     169       mask(mid,3,:) = mask_z(mid,:)
    166170!
    167171!--    Flag a mask as terrain following
  • palm/trunk/SOURCE/radiation_model_mod.f90

    r4875 r4896  
    2727! -----------------
    2828! $Id$
     29! typo in file appendix removed
     30!
     31! 4875 2021-02-17 11:56:22Z scharf
    2932! bugfix for interpolating external radiation on first timestep
    3033!
     
    31253128       IF ( .NOT. lw_exists )  THEN
    31263129          message_string = 'Input file RRTMG_LW for rrtmg model missing.& Please provide ' //      &
    3127                            TRIM( run_identifier ) // '_lsw file in the INPUT directory.'
     3130                           TRIM( run_identifier ) // '_rlw file in the INPUT directory.'
    31283131          CALL message( 'radiation_init', 'PA0583', 1, 2, 0, 6, 0 )
    31293132       ENDIF
  • palm/trunk/SOURCE/restart_data_mpi_io_mod.f90

    r4893 r4896  
    2525! -----------------
    2626! $Id$
     27! more meaningful variable names assigned,
     28! redundant code removed
     29!
     30! 4893 2021-03-02 16:39:14Z raasch
    2731! revised output of surface data via MPI-IO for better performance
    2832!
     
    206210    INTEGER(iwp)            ::  win_surf = -1    !<
    207211#endif
    208     INTEGER(iwp)            ::  total_number_of_surface_values  !< total number of values for one variable
     212    INTEGER(iwp)            ::  total_number_of_surface_elements  !< total number of surface elements for one variable
    209213
    210214    INTEGER(KIND=rd_offset_kind) ::  array_position   !<
     
    213217    INTEGER(iwp), DIMENSION(:,:), POINTER, CONTIGUOUS   ::  array_2di   !<
    214218
    215     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  e_end_index     !< extended end index, every grid cell has at least one value
    216     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  e_start_index   !<
    217     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  m_end_index     !< module copy of end_index
    218     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  m_start_index   !<
    219     INTEGER(iwp), DIMENSION(:),   ALLOCATABLE ::  thread_index    !<
    220     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  target_thread   !<
    221     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  transfer_index  !<
    222     INTEGER(iwp), DIMENSION(:),   ALLOCATABLE ::  thread_values   !<
     219    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  e_end_index       !< extended end index, every grid cell has at least one value
     220    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  e_start_index     !<
     221    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  m_end_index       !< module copy of end_index
     222    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  m_start_index     !<
     223    INTEGER(iwp), DIMENSION(:),   ALLOCATABLE ::  nr_surfaces_in_tb !< number of surface elements in transfer buffer
     224    INTEGER(iwp), DIMENSION(:),   ALLOCATABLE ::  s_index_in_tb     !< start index of surface elements in transfer buffer
     225    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  s_index_in_window !< start index for the pe in the rma window
     226    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  transfer_index    !<
    223227!
    224228!-- Indices for cyclic fill
     
    334338    PRIVATE
    335339
    336     PUBLIC  restart_file_size, total_number_of_surface_values
     340    PUBLIC  restart_file_size, total_number_of_surface_elements
    337341
    338342!
     
    31073111        IF ( TRIM( array_names(i) ) == TRIM( name ) )  THEN
    31083112!
    3109 !--        ATTENTION: The total_number_of_surface_values and wp MUST be INTERGER(8).
    3110 !--        The compiler (at least Intel) first computes total_number_of_surface_values*wp
     3113!--        ATTENTION: The total_number_of_surface_elements and wp MUST be INTERGER(8).
     3114!--        The compiler (at least Intel) first computes total_number_of_surface_elements*wp
    31113115!--        and then does the conversion to INTEGER(8).
    3112 !--        This may lead to wrong results when total_number_of_surface_values*wp is > 2*10**6
     3116!--        This may lead to wrong results when total_number_of_surface_elements*wp is > 2*10**6
    31133117           array_position = array_offset(i) + ( lo_first_index - 1 ) *                             &
    3114                             INT( total_number_of_surface_values, idp ) * INT( wp, idp )
     3118                            INT( total_number_of_surface_elements, idp ) * INT( wp, idp )
    31153119           found = .TRUE.
    31163120           EXIT
     
    31213125!-- In case of 2d-data, name is written only once
    31223126    IF ( lo_first_index == 1 )  THEN
    3123 
    3124        IF ( header_array_index == max_nr_arrays )  THEN
    3125           message_string = 'maximum number of 2d/3d-array entries in restart file header exceeded'
    3126           CALL message( 'rrd_mpi_io_surface', 'PA0585', 1, 2, 0, 6, 0 )
    3127        ENDIF
    31283127
    31293128       array_names(header_array_index)  = name
     
    31843183!
    31853184!--       Copy from RMA window into output array (data) to allow transfering data to target PEs.
    3186 !--       Check, if the number of surface values per grid cell match the index setup.
    3187           lo_index = thread_values
     3185!--       Check, if the number of surface elements per horizontal gridbox match the index setup.
     3186          lo_index = nr_surfaces_in_tb
    31883187          DO  i = nxl, nxr
    31893188             DO  j = nys, nyn
    3190                 is = lo_index(target_thread(j,i)) + 1
     3189                is = lo_index(s_index_in_window(j,i)) + 1
    31913190                ie = is + m_end_index(j,i) - m_start_index(j,i)
    31923191                data(m_start_index(j,i):m_end_index(j,i)) = array_1d(is:ie)
    3193                 lo_index(target_thread(j,i)) = lo_index(target_thread(j,i)) +                      &
    3194                                                e_end_index(j,i) - e_start_index(j,i) + 1
     3192                lo_index(s_index_in_window(j,i)) = lo_index(s_index_in_window(j,i)) +              &
     3193                                                   e_end_index(j,i) - e_start_index(j,i) + 1
    31953194!
    31963195!--             TODO: Test can be removed later.
    31973196                IF ( e_end_index(j,i)-e_start_index(j,i)+1 /= NINT( array_1d(is-1) ) )  THEN
    3198                    WRITE( 9, '(A,6I8)' ) 'Nr surface values does not match ', j, i,                &
     3197                   WRITE( 9, '(A,6I8)' ) 'Nr surface elements does not match ', j, i,              &
    31993198                                         e_start_index(j,i), e_end_index(j,i),                     &
    32003199                                         e_end_index(j,i)-e_start_index(j,i)+1 ,                   &
     
    32193218                IF ( e_end_index(j,i)-e_start_index(j,i)+1 /= NINT(array_out(e_start_index(j,i))) )&
    32203219                THEN
    3221                    WRITE( 9, '(A,6I8)' ) 'Nr surface values does not match ', j, i,                &
     3220                   WRITE( 9, '(A,6I8)' ) 'Nr surface elements does not match ', j, i,              &
    32223221                                         e_start_index(j,i), e_end_index(j,i),                     &
    32233222                                         e_end_index(j,i)-e_start_index(j,i)+1,                    &
     
    35593558!
    35603559!-- Copy from input array (data) to RMA window to allow the target PEs to get the appropiate data.
    3561 !-- At this point, a dummy surface element is added. This makes sure that every x-y grid cell owns
     3560!-- At this point, a dummy surface element is added. This makes sure that every x-y gridbox owns
    35623561!-- at least one surface element. This way, bookkeeping becomes much easier.
    3563     lo_index = thread_values
     3562    lo_index = nr_surfaces_in_tb
    35643563    DO  i = nxl, nxr
    35653564       DO  j = nys, nyn
    3566           is = lo_index(target_thread(j,i)) + 1
     3565          is = lo_index(s_index_in_window(j,i)) + 1
    35673566          ie = is + m_end_index(j,i) - m_start_index(j,i)
    35683567!
     
    35703569          array_1d(is-1)  = e_end_index(j,i) - e_start_index(j,i) + 1
    35713570          array_1d(is:ie) = data(m_start_index(j,i):m_end_index(j,i))
    3572           lo_index(target_thread(j,i)) = lo_index(target_thread(j,i)) +                            &
    3573                                          e_end_index(j,i) - e_start_index(j,i) + 1
     3571          lo_index(s_index_in_window(j,i)) = lo_index(s_index_in_window(j,i)) +                    &
     3572                                             e_end_index(j,i) - e_start_index(j,i) + 1
    35743573       ENDDO
    35753574    ENDDO
     
    36273626#endif
    36283627
    3629     array_position = array_position + total_number_of_surface_values * wp
     3628    array_position = array_position + total_number_of_surface_elements * wp
    36303629
    36313630 END SUBROUTINE wrd_mpi_io_surface
     
    38053804#endif
    38063805
    3807     IF ( ALLOCATED( e_start_index ) )   DEALLOCATE( e_start_index )
    3808     IF ( ALLOCATED( e_end_index )   )   DEALLOCATE( e_end_index    )
    3809     IF ( ALLOCATED( m_start_index ) )   DEALLOCATE( m_start_index )
    3810     IF ( ALLOCATED( m_end_index )   )   DEALLOCATE( m_end_index    )
    3811     IF ( ALLOCATED( target_thread ) )   DEALLOCATE( target_thread )
    3812     IF ( ALLOCATED( thread_index )  )   DEALLOCATE( thread_index  )
    3813     IF ( ALLOCATED( thread_values ) )   DEALLOCATE( thread_values )
    3814     IF ( ALLOCATED( transfer_index ) )  DEALLOCATE( transfer_index )
     3806    IF ( ALLOCATED( e_start_index )     )   DEALLOCATE( e_start_index )
     3807    IF ( ALLOCATED( e_end_index )       )   DEALLOCATE( e_end_index )
     3808    IF ( ALLOCATED( m_start_index )     )   DEALLOCATE( m_start_index )
     3809    IF ( ALLOCATED( m_end_index )       )   DEALLOCATE( m_end_index )
     3810    IF ( ALLOCATED( nr_surfaces_in_tb ) )   DEALLOCATE( nr_surfaces_in_tb )
     3811    IF ( ALLOCATED( s_index_in_tb )     )   DEALLOCATE( s_index_in_tb )
     3812    IF ( ALLOCATED( s_index_in_window ) )   DEALLOCATE( s_index_in_window )
     3813    IF ( ALLOCATED( transfer_index )    )   DEALLOCATE( transfer_index )
    38153814
    38163815    IF ( .NOT. pe_active_for_read )  RETURN
     
    38843883    INTEGER(iwp), DIMENSION(1)              ::  dims1               !< global dimension for MPI_TYPE_CREATE_SUBARRAY
    38853884    INTEGER(iwp), DIMENSION(1)              ::  lsize1              !< local size for MPI_TYPE_CREATE_SUBARRAY
    3886     INTEGER(iwp), DIMENSION(0:numprocs-1)   ::  nr_cells_to_thread  !<
     3885    INTEGER(iwp), DIMENSION(0:numprocs-1)   ::  nr_gp_with_surfaces_for_pe  !< number of horizontal gridpoints containing surface elements for the respective pe
     3886    INTEGER(iwp), DIMENSION(0:numprocs-1)   ::  nr_surface_elements_for_pe !< total number of surface elements for the respective pe
    38873887    INTEGER(iwp), DIMENSION(0:pdims(1))     ::  nr_surf_cells_x     !<
    38883888    INTEGER(iwp), DIMENSION(0:pdims(1))     ::  nr_surf_cells_x_s   !<
    3889     INTEGER(iwp), DIMENSION(0:numprocs-1)   ::  nr_values_to_thread !<
    38903889    INTEGER(iwp), DIMENSION(1)              ::  start1              !< start index for MPI_TYPE_CREATE_SUBARRAY
    38913890    INTEGER(iwp), DIMENSION(nxl:nxr)        ::  sum_y               !<
     
    39033902#endif
    39043903
    3905     LOGICAL, INTENT(OUT) ::  data_to_write      !< returns .TRUE., if surface data have been written
    3906     LOGICAL              ::  only_dummy_values  !< only dummy values, i.e. no data to write
     3904    LOGICAL, INTENT(OUT) ::  data_to_write        !< returns .TRUE., if surface data have been written
     3905    LOGICAL              ::  only_dummy_elements  !< only dummy elements, i.e. no data to write
    39073906
    39083907
     
    39353934       RETURN
    39363935    ELSE
    3937        IF ( .NOT. ALLOCATED( e_end_index )    )  ALLOCATE( e_end_index(nys:nyn,nxl:nxr)  )
    3938        IF ( .NOT. ALLOCATED( e_start_index )  )  ALLOCATE( e_start_index(nys:nyn,nxl:nxr) )
    3939        IF ( .NOT. ALLOCATED( m_end_index )    )  ALLOCATE( m_end_index(nys:nyn,nxl:nxr)  )
    3940        IF ( .NOT. ALLOCATED( m_start_index )  )  ALLOCATE( m_start_index(nys:nyn,nxl:nxr) )
    3941        IF ( .NOT. ALLOCATED( target_thread )  )  ALLOCATE( target_thread(nys:nyn,nxl:nxr) )
    3942        IF ( .NOT. ALLOCATED( thread_index )   )  ALLOCATE( thread_index(0:numprocs-1)    )
    3943        IF ( .NOT. ALLOCATED( thread_values )  )  ALLOCATE( thread_values(0:numprocs-1)    )
    3944        IF ( .NOT. ALLOCATED( transfer_index ) )  ALLOCATE( transfer_index(4,0:numprocs-1) )
     3936       IF ( .NOT. ALLOCATED( e_end_index )        )  ALLOCATE( e_end_index(nys:nyn,nxl:nxr) )
     3937       IF ( .NOT. ALLOCATED( e_start_index )      )  ALLOCATE( e_start_index(nys:nyn,nxl:nxr) )
     3938       IF ( .NOT. ALLOCATED( m_end_index )        )  ALLOCATE( m_end_index(nys:nyn,nxl:nxr) )
     3939       IF ( .NOT. ALLOCATED( m_start_index )      )  ALLOCATE( m_start_index(nys:nyn,nxl:nxr) )
     3940       IF ( .NOT. ALLOCATED( nr_surfaces_in_tb )  )  ALLOCATE( nr_surfaces_in_tb(0:numprocs-1) )
     3941       IF ( .NOT. ALLOCATED( s_index_in_tb )      )  ALLOCATE( s_index_in_tb(0:numprocs-1) )
     3942       IF ( .NOT. ALLOCATED( s_index_in_window )  )  ALLOCATE( s_index_in_window(nys:nyn,nxl:nxr) )
     3943       IF ( .NOT. ALLOCATED( transfer_index )     )  ALLOCATE( transfer_index(4,0:numprocs-1) )
    39453944    ENDIF
    39463945
     
    39743973       ENDDO
    39753974!
    3976 !--    Distribute these values to all PEs along y.
     3975!--    Distribute these elements to all PEs along y.
    39773976       CALL MPI_ALLREDUCE( nr_surf_cells_y_s, nr_surf_cells_y, SIZE( nr_surf_cells_y ),            &
    39783977                           MPI_INTEGER, MPI_SUM, comm1dy, ierr )
     
    40554054#endif
    40564055
    4057     total_number_of_surface_values = 0
     4056    total_number_of_surface_elements = 0
    40584057    DO  i = 0, numprocs-1
    40594058       IF ( i == myid )  THEN
    4060           glo_start = total_number_of_surface_values + 1
    4061        ENDIF
    4062        total_number_of_surface_values = total_number_of_surface_values + nr_surfcells_all_r(i,1)
     4059          glo_start = total_number_of_surface_elements + 1
     4060       ENDIF
     4061       total_number_of_surface_elements = total_number_of_surface_elements + nr_surfcells_all_r(i,1)
    40634062    ENDDO
    4064     only_dummy_values = ( MAXVAL( nr_surfcells_all_r(:,2) ) <= 0 )
     4063    only_dummy_elements = ( MAXVAL( nr_surfcells_all_r(:,2) ) <= 0 )
    40654064
    40664065!
    40674066!-- Compute indices of equally distributed surface elements.
    4068 !-- Number of surface values scheduled for ouput on this PE:
    4069     nr_surfcells_pe  = total_number_of_surface_values  / numprocs
    4070     rest_cells_pe    = MOD( total_number_of_surface_values, numprocs )
     4067!-- Number of surface elements scheduled for ouput on this PE:
     4068    nr_surfcells_pe  = total_number_of_surface_elements  / numprocs
     4069    rest_cells_pe    = MOD( total_number_of_surface_elements, numprocs )
    40714070    rest_bound       = rest_cells_pe * ( nr_surfcells_pe + 1 )
    40724071    m_start_index    = start_index
     
    40744073
    40754074!
    4076 !-- Compute number of elements on source PE, which have to be send to the corresponding target PE.
    4077 #if defined( __parallel )
    4078     nr_cells_to_thread  = 0
    4079     nr_values_to_thread = 0
     4075!-- Compute number of surface elements on source PE, which have to be send to the corresponding
     4076!-- target PE.
     4077#if defined( __parallel )
     4078    nr_gp_with_surfaces_for_pe = 0
     4079    nr_surface_elements_for_pe = 0
    40804080    DO  i = nxl, nxr
    40814081       DO  j = nys, nyn
    40824082          IF ( rest_cells_pe == 0 )  THEN
    4083              target_thread(j,i) = ( global_start(j,i) - 1 ) / nr_surfcells_pe
     4083             s_index_in_window(j,i) = ( global_start(j,i) - 1 ) / nr_surfcells_pe
    40844084          ELSE
    40854085             IF ( global_start(j,i) <= rest_bound )  THEN
    4086                 target_thread(j,i) = ( global_start(j,i) - 1 ) / ( nr_surfcells_pe + 1 )
     4086                s_index_in_window(j,i) = ( global_start(j,i) - 1 ) / ( nr_surfcells_pe + 1 )
    40874087             ELSE
    4088                 target_thread(j,i) = ( global_start(j,i) - rest_bound - 1 ) / nr_surfcells_pe
    4089                 target_thread(j,i) = target_thread(j,i) + rest_cells_pe
     4088                s_index_in_window(j,i) = ( global_start(j,i) - rest_bound - 1 ) / nr_surfcells_pe
     4089                s_index_in_window(j,i) = s_index_in_window(j,i) + rest_cells_pe
    40904090             ENDIF
    40914091!
    40924092!--          TODO: Test output, to be removed later.
    4093              IF ( target_thread(j,i) >= numprocs )  THEN
    4094                 WRITE( 9,'(A,8I8)' )  'target_thread ', j, i, target_thread(j,i),                  &
     4093             IF ( s_index_in_window(j,i) >= numprocs )  THEN
     4094                WRITE( 9,'(A,8I8)' )  's_index_in_window ', j, i, s_index_in_window(j,i),          &
    40954095                                      global_start(j,i) , nr_surfcells_pe
    40964096                FLUSH( 9 )
     
    40984098             ENDIF
    40994099          ENDIF
    4100           nr_cells_to_thread(target_thread(j,i))  = nr_cells_to_thread(target_thread(j,i)) + 1
    4101           nr_values_to_thread(target_thread(j,i)) = nr_values_to_thread(target_thread(j,i)) +      &
    4102                                                     e_end_index(j,i) - e_start_index(j,i) + 1
     4100          nr_gp_with_surfaces_for_pe(s_index_in_window(j,i)) =                                     &
     4101                                             nr_gp_with_surfaces_for_pe(s_index_in_window(j,i)) + 1
     4102          nr_surface_elements_for_pe(s_index_in_window(j,i)) =                                     &
     4103                                             nr_surface_elements_for_pe(s_index_in_window(j,i)) +  &
     4104                                             e_end_index(j,i) - e_start_index(j,i) + 1
    41034105       ENDDO
    41044106    ENDDO
     
    41064108!
    41074109!-- Compute start index in the transfer buffer on the source side for the corresponding target PE.
    4108     thread_index(0)  = 1
    4109     thread_values(0) = 1
     4110    s_index_in_tb(0)     = 1
     4111    nr_surfaces_in_tb(0) = 1
    41104112    DO  n = 1, numprocs-1
    4111        thread_index(n)  = thread_index(n-1) + nr_cells_to_thread(n-1)
    4112        thread_values(n) = thread_values(n-1) + nr_values_to_thread(n-1)
     4113       s_index_in_tb(n)     = s_index_in_tb(n-1)     + nr_gp_with_surfaces_for_pe(n-1)
     4114       nr_surfaces_in_tb(n) = nr_surfaces_in_tb(n-1) + nr_surface_elements_for_pe(n-1)
    41134115    ENDDO
    41144116!
    41154117!-- Buffer distribution on the source side.
    41164118    DO  n = 0, numprocs-1
    4117        transfer_index_s(1,n) = thread_index(n)
    4118        transfer_index_s(2,n) = nr_cells_to_thread(n)
    4119        transfer_index_s(3,n) = thread_values(n)
    4120        transfer_index_s(4,n) = nr_values_to_thread(n)
     4119       transfer_index_s(1,n) = s_index_in_tb(n)
     4120       transfer_index_s(2,n) = nr_gp_with_surfaces_for_pe(n)
     4121       transfer_index_s(3,n) = nr_surfaces_in_tb(n)
     4122       transfer_index_s(4,n) = nr_surface_elements_for_pe(n)
    41214123    ENDDO
    41224124
     
    41284130!
    41294131!-- Create surface element file type.
    4130     IF ( total_number_of_surface_values > 0 .AND. .NOT. only_dummy_values)  THEN
     4132    IF ( total_number_of_surface_elements > 0 .AND. .NOT. only_dummy_elements)  THEN
    41314133        data_to_write = .TRUE.
    41324134    ELSE
     
    41444146
    41454147    IF ( sm_io%iam_io_pe )  THEN
    4146        IF ( total_number_of_surface_values > 0 )  THEN
     4148       IF ( total_number_of_surface_elements > 0 )  THEN
    41474149           CALL MPI_TYPE_CREATE_SUBARRAY( 1, dims1, lsize1, start1, MPI_ORDER_FORTRAN, MPI_REAL,   &
    41484150                                          ft_surf, ierr )
     
    41524154!
    41534155!-- Allocate rma window to supply surface data to other PEs.
    4154     CALL rd_alloc_rma_mem( array_1d, SUM( nr_values_to_thread ), win_surf )
     4156    CALL rd_alloc_rma_mem( array_1d, SUM( nr_surface_elements_for_pe ), win_surf )
    41554157!
    41564158!-- Allocate shared array on IO-PE to supply data for MPI-IO (write or read).
     
    41674169    ENDIF
    41684170#else
    4169     IF ( total_number_of_surface_values > 0  .AND.  .NOT. only_dummy_values )  THEN
     4171    IF ( total_number_of_surface_elements > 0  .AND.  .NOT. only_dummy_elements )  THEN
    41704172        data_to_write = .TRUE.
    41714173    ELSE
    41724174        data_to_write = .FALSE.
    41734175    ENDIF
    4174     ALLOCATE( array_out(1:total_number_of_surface_values) )
     4176    ALLOCATE( array_out(1:total_number_of_surface_elements) )
    41754177#endif
    41764178
     
    42694271       local_indices(2,:) = 0
    42704272
    4271        winsize = MAX( 2 * SUM( nr_cells_to_thread ), 2 )
     4273       winsize = MAX( 2 * SUM( nr_gp_with_surfaces_for_pe ), 2 )
    42724274
    42734275       ALLOCATE( surf_val_index(2,winsize) )
     
    42764278       CALL MPI_WIN_FENCE( 0, win_ind, ierr )
    42774279
    4278        lo_index = thread_index
     4280       lo_index = s_index_in_tb
    42794281       DO  i = nxl, nxr
    42804282          DO  j = nys, nyn
    4281              surf_val_index(1,lo_index(target_thread(j,i))) = global_start(j,i)
    4282              surf_val_index(2,lo_index(target_thread(j,i))) = global_end(j,i) - global_start(j,i)  &
    4283                                                               + 1
    4284              lo_index(target_thread(j,i)) = lo_index(target_thread(j,i)) + 1
     4283             surf_val_index(1,lo_index(s_index_in_window(j,i))) = global_start(j,i)
     4284             surf_val_index(2,lo_index(s_index_in_window(j,i))) = global_end(j,i) -                &
     4285                                                                  global_start(j,i) + 1
     4286             lo_index(s_index_in_window(j,i)) = lo_index(s_index_in_window(j,i)) + 1
    42854287          ENDDO
    42864288       ENDDO
  • palm/trunk/SOURCE/surface_mod.f90

    r4893 r4896  
    2525! -----------------
    2626! $Id$
     27! variable renamed
     28!
     29! 4893 2021-03-02 16:39:14Z raasch
    2730! revised output of surface data via MPI-IO for better performance
    2831!
     
    221224               rrd_mpi_io_global_array,                                                            &
    222225               rrd_mpi_io_surface,                                                                 &
    223                total_number_of_surface_values,                                                     &
     226               total_number_of_surface_elements,                                                   &
    224227               wrd_mpi_io,                                                                         &
    225228               wrd_mpi_io_global_array,                                                            &
     
    40194022          IF ( .NOT. surface_data_to_write )  CYCLE
    40204023
    4021           ns_h_on_file(l) = total_number_of_surface_values
     4024          ns_h_on_file(l) = total_number_of_surface_elements
    40224025
    40234026          CALL wrd_mpi_io( 'global_start_index_h_' // dum, global_start_index )
     
    41534156          IF ( .NOT. surface_data_to_write )  CYCLE
    41544157
    4155           ns_v_on_file(l) = total_number_of_surface_values
     4158          ns_v_on_file(l) = total_number_of_surface_elements
    41564159
    41574160          CALL wrd_mpi_io( 'global_start_index_v_' // dum, global_start_index )
Note: See TracChangeset for help on using the changeset viewer.