Changeset 3832 for palm


Ignore:
Timestamp:
Mar 28, 2019 1:16:58 PM (5 years ago)
Author:
raasch
Message:

some routines instrumented with openmp directives, loop reordering for performance optimization

Location:
palm/trunk/SOURCE
Files:
4 edited

Legend:

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

    r3786 r3832  
    2525! -----------------
    2626! $Id$
     27! instrumented with openmp directives
     28!
     29! 3786 2019-03-06 16:58:03Z raasch
    2730! further unused variables removed
    2831!
     
    19001903    i_off = surf%ioff
    19011904
     1905    !$OMP PARALLEL PRIVATE (m, i, j, k, lambda_h_sat, ke, lambda_soil, lambda_surface,             &
     1906    !$OMP&                  c_surface_tmp, f1,m_total, f2, e_s, e, f3, m_min, m_liq_max, q_s,      &
     1907    !$OMP&                  f_qsws_veg, f_qsws_soil, f_qsws_liq, f_shf, f_qsws, e_s_dt, dq_s_dt,   &
     1908    !$OMP&                  coef_1, coef_2, tend)
     1909    !$OMP DO SCHEDULE (STATIC)
    19021910    DO  m = 1, surf%ns
    19031911
     
    23962404
    23972405    ENDDO
     2406    !$OMP END PARALLEL
    23982407
    23992408!
     
    24382447       REAL(wp) ::  resistance    !< aerodynamic and soil resistance term
    24392448
     2449
     2450       !$OMP PARALLEL PRIVATE (m, i, j, k, e_s, q_s, resistance)
     2451       !$OMP DO SCHEDULE (STATIC)
    24402452       DO  m = 1, surf%ns
    24412453
     
    24742486                     
    24752487       ENDDO
     2488       !$OMP END PARALLEL
    24762489 
    24772490    END SUBROUTINE calc_q_surface
     
    52535266       ENDIF
    52545267
     5268       !$OMP PARALLEL PRIVATE (m, k, lambda_temp, lambda_h_sat, ke, tend, gamma_temp, h_vg, m_total)
     5269       !$OMP DO SCHEDULE (STATIC)
    52555270       DO  m = 1, surf%ns
    52565271
     
    55255540
    55265541       ENDDO
     5542       !$OMP END PARALLEL
    55275543
    55285544    END SUBROUTINE lsm_soil_model
  • palm/trunk/SOURCE/transpose.f90

    r3694 r3832  
    2525! -----------------
    2626! $Id$
     27! loop reordering for performance optimization
     28!
     29! 3694 2019-01-23 17:01:49Z knoop
    2730! OpenACC port for SPEC
    2831!
     
    129132     !$ACC PRESENT(f_inv, f_in)
    130133#endif
    131      DO  i = 0, nx
    132          DO  k = nzb_x, nzt_x
     134     DO  k = nzb_x, nzt_x
     135         DO  i = 0, nx
    133136             DO  j = nys_x, nyn_x
    134137                 f_inv(j,k,i) = f_in(i,j,k)
     
    856859    !$ACC PRESENT(f_in, f_inv)
    857860#endif
    858      DO  k = 1,nz
    859          DO  i = nxl, nxr
     861     DO  i = nxl, nxr
     862         DO  k = 1,nz
    860863             DO  j = nys, nyn
    861864                 f_inv(j,i,k) = f_in(k,j,i)
     
    10201023    !$ACC PRESENT(f_out, f_inv)
    10211024#endif
    1022      DO  k = nzb_y, nzt_y
    1023          DO  j = 0, ny
     1025     DO  j = 0, ny
     1026         DO  k = nzb_y, nzt_y
    10241027             DO  i = nxl_y, nxr_y
    10251028                 f_out(j,i,k) = f_inv(i,k,j)
  • palm/trunk/SOURCE/urban_surface_mod.f90

    r3824 r3832  
    2828! -----------------
    2929! $Id$
     30! instrumented with openmp directives
     31!
     32! 3824 2019-03-27 15:56:16Z pavelkrc
    3033! Remove unused imports
    3134!
     
    53325335        LOGICAL      :: spinup  !< if true, no calculation of window temperatures
    53335336
     5337        !$OMP PARALLEL PRIVATE (m, i, j, k, kw, wtend, wintend, win_absorp, wall_mod)
    53345338        wall_mod=1.0_wp
    53355339        IF (usm_wall_mod .AND. spinup) THEN
     
    53415345!
    53425346!--     For horizontal surfaces                                   
     5347        !$OMP DO SCHEDULE (STATIC)
    53435348        DO  m = 1, surf_usm_h%ns
    53445349!
     
    55215526!
    55225527!--     For vertical surfaces     
     5528        !$OMP DO SCHEDULE (STATIC)
    55235529        DO  l = 0, 3                             
    55245530           DO  m = 1, surf_usm_v(l)%ns
     
    56995705           ENDDO
    57005706        ENDDO
     5707        !$OMP END PARALLEL
    57015708
    57025709    END SUBROUTINE usm_material_heat_model
     
    57345741!
    57355742!--     For horizontal surfaces                                   
     5743        !$OMP PARALLEL PRIVATE (m, i, j, k, kw, lambda_h_green_sat, ke, lambda_green_temp, gtend,  &
     5744        !$OMP&                  tend, h_vg, gamma_green_temp, m_total, root_extr_green)
     5745        !$OMP DO SCHEDULE (STATIC)
    57365746        DO  m = 1, surf_usm_h%ns
    57375747
     
    59805990           
    59815991        ENDDO
     5992        !$OMP END PARALLEL
    59825993
    59835994!
     
    77527763!       
    77537764!--     First, treat horizontal surface elements
     7765        !$OMP PARALLEL PRIVATE (m, i, j, k, lambda_surface, lambda_surface_window,                 &
     7766        !$OMP&                  lambda_surface_green, qv1, rho_cp, rho_lv, drho_l_lv, f_shf,       &
     7767        !$OMP&                  f_shf_window, f_shf_green, m_total, f1, f2, e_s, e, f3, f_qsws_veg,&
     7768        !$OMP&                  q_s, f_qsws_liq, f_qsws, e_s_dt, dq_s_dt, coef_1, coef_window_1,   &
     7769        !$OMP&                  coef_green_1, coef_2, coef_window_2, coef_green_2, stend_wall,     &
     7770        !$OMP&                  stend_window, stend_green, tend, m_liq_max)
     7771        !$OMP DO SCHEDULE (STATIC)
    77547772        DO  m = 1, surf_usm_h%ns
    77557773!
     
    81978215       ENDDO
    81988216!
    8199 !--   Now, treat vertical surface elements
     8217!--    Now, treat vertical surface elements
     8218       !$OMP DO SCHEDULE (STATIC)
    82008219       DO  l = 0, 3
    82018220           DO  m = 1, surf_usm_v(l)%ns
     
    85748593 
    85758594       ENDDO
     8595       !$OMP END PARALLEL
     8596
    85768597!
    85778598!--     Add-up anthropogenic heat, for now only at upward-facing surfaces
     
    85868607            dtime = mod(simulated_time + time_utc_init, 24.0_wp*3600.0_wp)
    85878608            dhour = INT(dtime/3600.0_wp)
     8609
     8610!--         TO_DO: activate, if testcase is available
     8611!--         !$OMP PARALLEL DO PRIVATE (i, j, k, acoef, rho_cp)
     8612!--         it may also improve performance to move get_topography_top_index_ji before the k-loop
    85888613            DO i = nxl, nxr
    85898614               DO j = nys, nyn
  • palm/trunk/SOURCE/wind_turbine_model_mod.f90

    r3725 r3832  
    2626! -----------------
    2727! $Id$
     28! instrumented with openmp directives
     29!
     30! 3725 2019-02-07 10:11:02Z raasch
    2831! unused variables removed
    2932!
     
    340343    REAL(wp) ::  w_int_l                     !<
    341344    REAL(wp) ::  w_int_u                     !<
     345    !$OMP THREADPRIVATE (cur_r, phi_rotor, pre_factor, torque_seg, u_int_l, u_int_u, u_rot, &
     346    !$OMP&               v_int_l, v_int_u, w_int_l, w_int_u)
    342347!
    343348!-  Tendencies from the nacelle and tower thrust
     
    346351    REAL(wp) ::  tend_nac_y = 0.0_wp  !<
    347352    REAL(wp) ::  tend_tow_y = 0.0_wp  !<
     353    !$OMP THREADPRIVATE (tend_nac_x, tend_tow_x, tend_nac_y, tend_tow_y)
    348354
    349355    REAL(wp), DIMENSION(:), ALLOCATABLE ::  alpha_attack !<
     
    17311737!
    17321738!--          Loop over rings of each turbine:
     1739
     1740             !$OMP PARALLEL PRIVATE (ring, rseg, thrust_seg, torque_seg_y, torque_seg_z, sin_rot,  &
     1741             !$OMP&                  cos_rot, re, rbx, rby, rbz, ii, jj, kk, aa, bb, cc, dd, gg)
     1742             !$OMP DO
    17331743             DO ring = 1, nrings(inot)
    17341744
     
    19191929                ENDDO
    19201930             ENDDO
     1931             !$OMP END PARALLEL
    19211932
    19221933          ENDDO
     
    19601971!
    19611972!--          Loop over rings of each turbine:
     1973             !$OMP PARALLEL PRIVATE (ring, rseg, sin_rot, cos_rot, re, rea, ren, rote, rota, rotn, &
     1974             !$OMP&                  vtheta, phi_rel, lct, rad_d, alpha_attack, vrel,              &
     1975             !$OMP&                  chord, iialpha, iir, turb_cl, tl_factor, thrust_seg,          &
     1976             !$OMP&                  torque_seg_y, turb_cd, torque_seg_z, thrust_ring,             &
     1977             !$OMP&                  torque_ring_y, torque_ring_z)
     1978             !$OMP DO
    19621979             DO ring = 1, nrings(inot)
    19631980!
     
    21842201!
    21852202!--                Add the segment thrust to the thrust of the whole rotor
     2203                   !$OMP CRITICAL
    21862204                   thrust_rotor(inot) = thrust_rotor(inot) +                   &
    21872205                                        thrust_seg(rseg)                   
     
    21892207
    21902208                   torque_total(inot) = torque_total(inot) + (torque_seg * cur_r)
     2209                   !$OMP END CRITICAL
    21912210
    21922211                ENDDO   !-- end of loop over ring segments
     
    22012220
    22022221             ENDDO   !-- end of loop over rings
     2222             !$OMP END PARALLEL
    22032223
    22042224
     
    22972317                                        eps_min ) / dy )
    22982318
     2319             !$OMP PARALLEL PRIVATE (i, j, k, ring, rseg, flag, dist_u_3d, dist_v_3d, dist_w_3d)
     2320             !$OMP DO
    22992321             DO i = MAX( nxl, i_hub(inot) - i_smear(inot) ),                   &
    23002322                    MIN( nxr, i_hub(inot) + i_smear(inot) )
     
    23772399                ENDDO           ! End of loop over j
    23782400             ENDDO              ! End of loop over i
     2401             !$OMP END PARALLEL
    23792402
    23802403             CALL cpu_log( log_point_s(63), 'wtm_smearing', 'stop' )         
Note: See TracChangeset for help on using the changeset viewer.