Ignore:
Timestamp:
Aug 16, 2019 1:50:17 PM (5 years ago)
Author:
suehring
Message:

Replace get_topography_top_index functions by pre-calculated arrays in order to save computational resources

File:
1 edited

Legend:

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

    r4148 r4168  
    2828! -----------------
    2929! $Id$
     30! Replace function get_topography_top_index by topo_top_ind
     31!
     32! 4148 2019-08-08 11:26:00Z suehring
    3033! - Add anthropogenic heat output factors for heating and cooling to building
    3134!   data base
     
    538541    USE indices,                                                               &
    539542        ONLY:  nx, ny, nnx, nny, nnz, nxl, nxlg, nxr, nxrg, nyn, nyng, nys,    &
    540                nysg, nzb, nzt, nbgp, wall_flags_0
     543               nysg, nzb, nzt, nbgp, topo_top_ind, wall_flags_0
    541544
    542545    USE, INTRINSIC :: iso_c_binding
     
    559562
    560563    USE surface_mod,                                                           &
    561         ONLY:  get_topography_top_index_ji, get_topography_top_index,          &
    562                ind_pav_green, ind_veg_wall, ind_wat_win, surf_usm_h,           &
     564        ONLY:  ind_pav_green, ind_veg_wall, ind_wat_win, surf_usm_h,           &
    563565               surf_usm_v, surface_restore_elements
    564566
     
    61596161                    READ( 151, *, err=12, end=13 )  i, j, k, heat
    61606162                    IF ( i >= nxl  .AND.  i <= nxr  .AND.  j >= nys  .AND.  j <= nyn )  THEN
    6161                         IF ( k <= naheatlayers  .AND.  k > get_topography_top_index_ji( j, i, 's' ) )  THEN
     6163                        IF ( k <= naheatlayers  .AND.  k > topo_top_ind(j,i,0) )  THEN
    61626164!--                         write heat into the array
    61636165                            aheat(k,j,i) = heat
     
    73947396              ELSE
    73957397                 WRITE(9,*) 'Problem reading USM data:'
    7396                  WRITE(9,*) l,i,j,kw,get_topography_top_index_ji( j, i, 's' )
    7397                  WRITE(9,*) ii,iw,jw,kw,get_topography_top_index_ji( jw, iw, 's' )
     7398                 WRITE(9,*) l,i,j,kw,topo_top_ind(j,i,0)
     7399                 WRITE(9,*) ii,iw,jw,kw,topo_top_ind(jw,iw,0)
    73987400                 WRITE(9,*) usm_par(ii,jw,iw),usm_par(ii+1,jw,iw)
    73997401                 WRITE(9,*) usm_par(ii+2,jw,iw),usm_par(ii+3,jw,iw)
     
    86148616!--         TO_DO: activate, if testcase is available
    86158617!--         !$OMP PARALLEL DO PRIVATE (i, j, k, acoef, rho_cp)
    8616 !--         it may also improve performance to move get_topography_top_index_ji before the k-loop
     8618!--         it may also improve performance to move topo_top_ind before the k-loop
    86178619            DO i = nxl, nxr
    86188620               DO j = nys, nyn
    86198621                  DO k = nz_urban_b, min(nz_urban_t,naheatlayers)
    8620                      IF ( k > get_topography_top_index_ji( j, i, 's' ) ) THEN
     8622                     IF ( k > topo_top_ind(j,i,0) ) THEN
    86218623!
    86228624!--                    increase of pt in box i,j,k in time dt_3d
Note: See TracChangeset for help on using the changeset viewer.