Changeset 4717
- Timestamp:
- Sep 30, 2020 10:27:40 PM (4 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 10 edited
-
land_surface_model_mod.f90 (modified) (10 diffs)
-
poisfft_mod.f90 (modified) (8 diffs)
-
pres.f90 (modified) (28 diffs)
-
prognostic_equations.f90 (modified) (3 diffs)
-
radiation_model_mod.f90 (modified) (25 diffs)
-
surface_layer_fluxes_mod.f90 (modified) (5 diffs)
-
timestep.f90 (modified) (3 diffs)
-
transpose.f90 (modified) (32 diffs)
-
turbulence_closure_mod.f90 (modified) (8 diffs)
-
urban_surface_mod.f90 (modified) (27 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/land_surface_model_mod.f90
r4716 r4717 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Fixes and optimizations of OpenMP parallelization, formatting of OpenMP 28 ! directives (J. Resler) 29 ! 30 ! 4716 2020-09-30 22:06:37Z pavelkrc 27 31 ! Revert change at water surfaces (previous) 28 32 ! … … 1744 1748 i_off = surf%ioff 1745 1749 1746 !$OMP PARALLEL PRIVATE (m, i, j, k, lambda_h_sat, ke, lambda_soil, lambda_surface, ueff, & 1747 !$OMP& c_surface_tmp, f1,m_total, f2, e_s, e, f3, m_min, m_liq_max, q_s, & 1748 !$OMP& f_qsws_veg, f_qsws_soil, f_qsws_liq, f_shf, f_qsws, e_s_dt, dq_s_dt, & 1749 !$OMP& coef_1, coef_2, tend) 1750 !$OMP DO SCHEDULE (STATIC) 1750 !$OMP PARALLEL DO PRIVATE (m, i, j, k, lambda_h_sat, ke, lambda_soil, lambda_surface, ueff, & 1751 !$OMP& c_surface_tmp, f1,m_total, f2, e_s, e, f3, m_min, m_liq_max, q_s, & 1752 !$OMP& f_qsws_veg, f_qsws_soil, f_qsws_liq, f_shf, f_qsws, e_s_dt, dq_s_dt,& 1753 !$OMP& coef_1, coef_2, tend) SCHEDULE (STATIC) 1751 1754 DO m = 1, surf%ns 1752 1755 … … 2109 2112 surf%shf(m) = - f_shf * ( surf%pt1(m) - surf%pt_surface(m) ) / c_p 2110 2113 ! 2111 ! update the 3d field of rad_lw_out array to have consistent output2114 !-- update the 3d field of rad_lw_out array to have consistent output 2112 2115 IF ( upward ) THEN 2113 2116 IF ( radiation_scheme == 'rrtmg' ) THEN … … 2246 2249 2247 2250 ENDDO 2248 !$OMP END PARALLEL2249 2251 2250 2252 ! … … 2294 2296 REAL(wp) :: resistance !< aerodynamic and soil resistance term 2295 2297 2296 2297 !$OMP PARALLEL PRIVATE (m, i, j, k, e_s, q_s, resistance) 2298 !$OMP DO SCHEDULE (STATIC) 2298 !$OMP PARALLEL DO PRIVATE (m, i, j, k, e_s, q_s, resistance) SCHEDULE (STATIC) 2299 2299 DO m = 1, surf%ns 2300 2300 … … 2330 2330 ( 1.0_wp + 0.61_wp * surf%q_surface(m) ) 2331 2331 2332 2333 2334 2332 ENDDO 2335 !$OMP END PARALLEL2336 2333 2337 2334 END SUBROUTINE calc_q_surface … … 5555 5552 ENDIF 5556 5553 5557 !$OMP PARALLEL PRIVATE (m, k, lambda_temp, lambda_h_sat, ke, tend, gamma_temp, h_vg, & 5558 !$OMP& m_total, root_extr) 5559 !$OMP DO SCHEDULE (STATIC) 5554 !$OMP PARALLEL DO PRIVATE (m, k, lambda_temp, lambda_h_sat, ke, tend, gamma_temp, h_vg, & 5555 !$OMP& m_total, root_extr) SCHEDULE (STATIC) 5560 5556 DO m = 1, surf%ns 5561 5557 … … 5827 5823 5828 5824 ENDDO 5829 !$OMP END PARALLEL5830 5825 ! 5831 5826 !-- Debug location message … … 7760 7755 ! REAL(wp) :: re_0 !< near-surface roughness Reynolds number 7761 7756 7762 !$OMP DO PRIVATE (m, i, j) SCHEDULE (STATIC) REDUCTION(.OR.:flag_exceed_z0, flag_exceed_z0h) 7757 !$OMP PARALLEL DO PRIVATE (m, i, j) SCHEDULE (STATIC) & 7758 !$OMP& REDUCTION(.OR.:flag_exceed_z0, flag_exceed_z0h) 7763 7759 DO m = 1, surf_lsm_h(0)%ns 7764 7760 !-- only upward facin horizontal surfaces are considered for water surface processing … … 7820 7816 ENDIF 7821 7817 ENDDO 7822 !$OMP END DO7823 7818 #if defined( __parallel ) 7824 7819 CALL MPI_ALLREDUCE( MPI_IN_PLACE, flag_exceed_z0, 1, MPI_LOGICAL, & -
palm/trunk/SOURCE/poisfft_mod.f90
r4671 r4717 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Formatting of OpenMP directives (J. Resler) 28 ! 29 ! 4671 2020-09-09 20:27:58Z pavelkrc 27 30 ! OMP bugfix 28 31 ! … … 1001 1004 1002 1005 tn = 0 ! Default thread number in case of one thread 1003 !$OMP PARALLEL DO PRIVATE ( i, j, k, m, n, tn, work_fftx, work_trix )1006 !$OMP PARALLEL DO PRIVATE ( i, j, k, m, n, tn, work_fftx, work_trix ) 1004 1007 DO j = nys_x, nyn_x 1005 1008 … … 1142 1145 ! 1143 1146 !-- Code for vector processors 1144 !$OMP PARALLEL PRIVATE ( i, j, k )1145 !$OMP DO1147 !$OMP PARALLEL PRIVATE ( i, j, k ) 1148 !$OMP DO 1146 1149 DO i = 0, nx 1147 1150 … … 1154 1157 ENDDO 1155 1158 1156 !$OMP DO1159 !$OMP DO 1157 1160 DO j = nys, nyn 1158 1161 … … 1166 1169 1167 1170 ENDDO 1168 !$OMP END PARALLEL1171 !$OMP END PARALLEL 1169 1172 1170 1173 ELSE … … 1172 1175 ! 1173 1176 !-- Cache optimized code (there might still be a potential for better optimization). 1174 !$OMP PARALLEL PRIVATE (i,j,k)1175 !$OMP DO1177 !$OMP PARALLEL PRIVATE (i,j,k) 1178 !$OMP DO 1176 1179 DO i = 0, nx 1177 1180 … … 1184 1187 ENDDO 1185 1188 1186 !$OMP DO1189 !$OMP DO 1187 1190 DO j = nys, nyn 1188 1191 DO k = 1, nz … … 1196 1199 1197 1200 ENDDO 1198 !$OMP END PARALLEL1201 !$OMP END PARALLEL 1199 1202 1200 1203 ENDIF -
palm/trunk/SOURCE/pres.f90
r4651 r4717 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Fixes and optimizations of OpenMP parallelization, formatting of OpenMP 28 ! directives (J. Resler) 29 ! 30 ! 4651 2020-08-27 07:17:45Z raasch 27 31 ! preprocessor branch for ibm removed 28 32 ! 29 33 ! 4649 2020-08-25 12:11:17Z raasch 30 34 ! File re-formatted to follow the PALM coding standard 31 !32 35 ! 33 36 ! 4457 2020-03-11 14:20:43Z raasch … … 171 174 REAL(wp) :: ddt_3d !< 172 175 REAL(wp) :: d_weight_pres !< 173 REAL(wp) :: localsum !<174 176 REAL(wp) :: threadsum !< 175 177 REAL(wp) :: weight_pres_l !< … … 363 365 364 366 IF ( psolver(1:9) == 'multigrid' ) THEN 365 !$OMP PARALLEL DO SCHEDULE( STATIC ) PRIVATE (i,j,k)367 !$OMP PARALLEL DO PRIVATE (i,j,k) SCHEDULE( STATIC ) 366 368 DO i = nxl-1, nxr+1 367 369 DO j = nys-1, nyn+1 … … 372 374 ENDDO 373 375 ELSE 374 !$OMP PARALLEL DO SCHEDULE( STATIC ) PRIVATE (i,j,k)376 !$OMP PARALLEL DO PRIVATE (i,j,k) SCHEDULE( STATIC ) 375 377 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 376 378 !$ACC PRESENT(d) … … 384 386 ENDIF 385 387 386 localsum = 0.0_wp 387 threadsum = 0.0_wp 388 389 !$OMP PARALLEL PRIVATE (i,j,k) 390 !$OMP DO SCHEDULE( STATIC ) 388 !$OMP PARALLEL DO PRIVATE (i,j,k) SCHEDULE( STATIC ) 391 389 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 392 390 !$ACC PRESENT(u, v, w, rho_air, rho_air_zw, ddzw, wall_flags_total_0) & … … 403 401 ENDDO 404 402 ENDDO 405 !$OMP END PARALLEL406 403 407 404 ! … … 410 407 IF ( intermediate_timestep_count == intermediate_timestep_count_max .OR. & 411 408 intermediate_timestep_count == 0 ) THEN 412 !$OMP PARALLEL PRIVATE (i,j,k) FIRSTPRIVATE(threadsum) REDUCTION(+:localsum)413 !$OMP DOSCHEDULE( STATIC )409 threadsum = 0.0_wp 410 !$OMP PARALLEL DO PRIVATE (i,j,k) REDUCTION(+:threadsum) SCHEDULE( STATIC ) 414 411 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & 415 412 !$ACC REDUCTION(+:threadsum) COPY(threadsum) & … … 422 419 ENDDO 423 420 ENDDO 424 localsum = localsum + threadsum * dt_3d * weight_pres_l 425 !$OMP END PARALLEL 421 threadsum = threadsum + threadsum * dt_3d * weight_pres_l 426 422 ENDIF 427 423 … … 430 426 IF ( intermediate_timestep_count == intermediate_timestep_count_max .OR. & 431 427 intermediate_timestep_count == 0 ) THEN 432 sums_divold_l(0:statistic_regions) = localsum428 sums_divold_l(0:statistic_regions) = threadsum 433 429 ENDIF 434 430 … … 445 441 ! 446 442 !-- Store computed perturbation pressure and set boundary condition in z-direction 447 !$OMP PARALLEL DO PRIVATE (i,j,k) 443 !$OMP PARALLEL DO PRIVATE (i,j,k) SCHEDULE( STATIC ) 448 444 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 449 445 !$ACC PRESENT(d, tend) … … 465 461 !-- natural and urban surfaces 466 462 !-- Upward facing 467 !$OMP PARALLEL DO PRIVATE( i, j, k)463 !$OMP PARALLEL DO PRIVATE( m, i, j, k ) SCHEDULE( STATIC ) 468 464 !$ACC PARALLEL LOOP PRIVATE(i, j, k) & 469 465 !$ACC PRESENT(bc_h, tend) … … 476 472 ! 477 473 !-- Downward facing 478 !$OMP PARALLEL DO PRIVATE( i, j, k)474 !$OMP PARALLEL DO PRIVATE( m, i, j, k ) SCHEDULE( STATIC ) 479 475 !$ACC PARALLEL LOOP PRIVATE(i, j, k) & 480 476 !$ACC PRESENT(bc_h, tend) … … 491 487 !-- urban surfaces 492 488 !-- Upward facing 493 !$OMP PARALLEL DO PRIVATE( i, j, k)489 !$OMP PARALLEL DO PRIVATE( m, i, j, k ) SCHEDULE( STATIC ) 494 490 DO m = 1, bc_h(0)%ns 495 491 i = bc_h(0)%i(m) … … 500 496 ! 501 497 !-- Downward facing 502 !$OMP PARALLEL DO PRIVATE( i, j, k)498 !$OMP PARALLEL DO PRIVATE( m, i, j, k ) SCHEDULE( STATIC ) 503 499 DO m = 1, bc_h(1)%ns 504 500 i = bc_h(1)%i(m) … … 515 511 ! 516 512 !-- Neumann 517 !$OMP PARALLEL DO PRIVATE (i,j ,k)513 !$OMP PARALLEL DO PRIVATE (i,j) SCHEDULE( STATIC ) 518 514 DO i = nxlg, nxrg 519 515 DO j = nysg, nyng … … 525 521 ! 526 522 !-- Dirichlet 527 !$OMP PARALLEL DO PRIVATE (i,j ,k)523 !$OMP PARALLEL DO PRIVATE (i,j) SCHEDULE( STATIC ) 528 524 !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j) & 529 525 !$ACC PRESENT(tend) … … 590 586 !-- Ghost layers are added in the output routines (except sor-method: see below) 591 587 IF ( intermediate_timestep_count <= 1 ) THEN 592 !$OMP PARALLEL PRIVATE (i,j,k) 593 !$OMP DO 588 !$OMP PARALLEL DO PRIVATE (i,j,k) SCHEDULE( STATIC ) 594 589 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 595 590 !$ACC PRESENT(p, tend) … … 601 596 ENDDO 602 597 ENDDO 603 !$OMP END PARALLEL604 598 605 599 ELSEIF ( intermediate_timestep_count > 1 ) THEN 606 !$OMP PARALLEL PRIVATE (i,j,k) 607 !$OMP DO 600 !$OMP PARALLEL DO PRIVATE (i,j,k) SCHEDULE( STATIC ) 608 601 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 609 602 !$ACC PRESENT(p, tend) … … 615 608 ENDDO 616 609 ENDDO 617 !$OMP END PARALLEL618 610 619 611 ENDIF … … 635 627 !-- the velocities, zero-gradient conditions for the pressure are set, so that no modification is 636 628 !-- imposed at the boundaries. 637 !$OMP PARALLEL PRIVATE (i,j,k) 638 !$OMP DO 629 !$OMP PARALLEL DO PRIVATE (i,j,k) SCHEDULE( STATIC ) 639 630 !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j, k) & 640 631 !$ACC PRESENT(u, v, w, tend, ddzu, wall_flags_total_0) … … 660 651 ENDDO 661 652 ENDDO 662 !$OMP END PARALLEL663 653 664 654 ! … … 675 665 IF ( conserve_volume_flow .AND. bc_lr_cyc .AND. bc_ns_cyc .AND. nxr == nx ) THEN 676 666 677 !$OMP PARALLEL PRIVATE (j,k) 678 !$OMP DO 667 !$OMP PARALLEL DO PRIVATE (j,k) REDUCTION (volume_flow_l(1)) 679 668 DO j = nys, nyn 680 !$OMP CRITICAL681 669 DO k = nzb+1, nzt 682 670 volume_flow_l(1) = volume_flow_l(1) + u(k,j,nxr) * dzw(k) & 683 671 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr), 1 ) ) 684 672 ENDDO 685 !$OMP END CRITICAL 686 ENDDO 687 !$OMP END PARALLEL 673 ENDDO 688 674 689 675 ENDIF … … 691 677 IF ( conserve_volume_flow .AND. bc_ns_cyc .AND. bc_lr_cyc .AND. nyn == ny ) THEN 692 678 693 !$OMP PARALLEL PRIVATE (i,k) 694 !$OMP DO 695 DO i = nxl, nxr 696 !$OMP CRITICAL 679 !$OMP PARALLEL DO PRIVATE (i,k) REDUCTION (volume_flow_l(2)) 680 DO i = nxl, nxr 697 681 DO k = nzb+1, nzt 698 682 volume_flow_l(2) = volume_flow_l(2) + v(k,nyn,i) * dzw(k) & 699 683 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn,i), 2 ) ) 700 684 ENDDO 701 !$OMP END CRITICAL 702 ENDDO 703 !$OMP END PARALLEL 685 ENDDO 704 686 705 687 ENDIF … … 719 701 / volume_flow_area(1:2) 720 702 721 !$OMP PARALLEL PRIVATE (i,j,k) 722 !$OMP DO 703 !$OMP PARALLEL DO PRIVATE (i,j,k) SCHEDULE( STATIC ) 723 704 DO i = nxl, nxr 724 705 DO j = nys, nyn … … 733 714 ENDDO 734 715 ENDDO 735 736 !$OMP END PARALLEL737 716 738 717 ENDIF … … 757 736 IF ( topography /= 'flat' ) d = 0.0_wp 758 737 759 localsum = 0.0_wp 760 threadsum = 0.0_wp 761 762 !$OMP PARALLEL PRIVATE (i,j,k) FIRSTPRIVATE(threadsum) REDUCTION(+:localsum) 763 !$OMP DO SCHEDULE( STATIC ) 738 !$OMP PARALLEL DO PRIVATE (i,j,k) SCHEDULE( STATIC ) 764 739 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 765 740 !$ACC PRESENT(u, v, w, rho_air, rho_air_zw, ddzw, wall_flags_total_0) & … … 778 753 ! 779 754 !-- Compute possible PE-sum of divergences for flow_statistics 780 !$OMP DO SCHEDULE( STATIC ) 755 threadsum = 0.0_wp 756 !$OMP PARALLEL DO PRIVATE (i,j,k) REDUCTION(+:threadsum) SCHEDULE( STATIC ) 781 757 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 782 758 !$ACC REDUCTION(+:threadsum) COPY(threadsum) & … … 790 766 ENDDO 791 767 792 localsum = localsum + threadsum793 !$OMP END PARALLEL794 795 768 ! 796 769 !-- For completeness, set the divergence sum of all statistic regions to those of the total 797 770 !-- domain 798 sums_divnew_l(0:statistic_regions) = localsum771 sums_divnew_l(0:statistic_regions) = threadsum 799 772 800 773 CALL cpu_log( log_point_s(1), 'divergence', 'stop' ) -
palm/trunk/SOURCE/prognostic_equations.f90
r4671 r4717 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Fixes and optimizations of OpenMP parallelization, formatting of OpenMP 28 ! directives (J. Resler) 29 ! 30 ! 4671 2020-09-09 20:27:58Z pavelkrc 27 31 ! Implementation of downward facing USM and LSM surfaces 28 32 ! 29 33 ! 4649 2020-08-25 12:11:17Z raasch 30 34 ! File re-formatted to follow the PALM coding standard 31 !32 35 ! 33 36 ! 4370 2020-01-10 14:00:44Z raasch … … 397 400 CALL cpu_log( log_point(32), 'all progn.equations', 'start' ) 398 401 399 !$OMP PARALLEL PRIVATE (i,j) 400 !$OMP DO 402 !$OMP PARALLEL DO PRIVATE (i,j) SCHEDULE( STATIC ) 401 403 DO i = nxl, nxr 402 404 DO j = nys, nyn … … 409 411 !-- Module Inferface for exchange horiz after non_advective_processes but before advection. 410 412 !-- Therefore, non_advective_processes must not run for ghost points. 411 !$OMP END PARALLEL412 413 CALL module_interface_exchange_horiz() 413 414 ! -
palm/trunk/SOURCE/radiation_model_mod.f90
r4713 r4717 28 28 ! ----------------- 29 29 ! $Id$ 30 ! Fixes and optimizations of OpenMP parallelization, formatting of OpenMP 31 ! directives (J. Resler) 32 ! 33 ! 4713 2020-09-29 12:02:05Z pavelkrc 30 34 ! Correct OpenMP parallelization including cycles with cumulative variables (J. Resler) 31 35 ! … … 5954 5958 REAL(wp) :: asrc !< area of source face 5955 5959 REAL(wp) :: pcrad !< irradiance from plant canopy 5960 REAL(wp) :: temp !< temporary variable for calculation 5956 5961 !- variables for coupling the radiation modle (e.g. RRTMG) and RTM 5957 5962 REAL(wp) :: pabsswl !< total absorbed SW radiation energy in local processor (W) … … 6164 6169 6165 6170 IF ( surface_reflections) THEN 6166 !$OMP DO PRIVATE (i, j, k, isvf, isurf, isurfsrc) SCHEDULE (STATIC)6171 !$OMP PARALLEL DO PRIVATE (i, j, k, isvf, isurf, isurfsrc, temp) SCHEDULE (STATIC) 6167 6172 DO isvf = 1, nsvfl 6168 6173 isurf = svfsurf(1, isvf) … … 6174 6179 !-- For surface-to-surface factors we calculate thermal radiation in 1st pass 6175 6180 IF ( plant_lw_interact ) THEN 6176 surfinl(isurf) = surfinl(isurf) +svf(1,isvf) * svf(2,isvf) * surfoutl(isurfsrc)6181 temp = svf(1,isvf) * svf(2,isvf) * surfoutl(isurfsrc) 6177 6182 ELSE 6178 surfinl(isurf) = surfinl(isurf) +svf(1,isvf) * surfoutl(isurfsrc)6183 temp = svf(1,isvf) * surfoutl(isurfsrc) 6179 6184 ENDIF 6185 !$OMP ATOMIC 6186 surfinl(isurf) = surfinl(isurf) + temp 6180 6187 ENDDO 6181 !$OMP END DO6182 6188 ENDIF 6183 6189 ! 6184 6190 !-- diffuse radiation using sky view factor 6185 !$OMP DO PRIVATE (i, j, d, isurf) REDUCTION(+:pinswl, pinlwl) SCHEDULE (STATIC)6191 !$OMP PARALLEL DO PRIVATE (i, j, d, isurf) REDUCTION(+:pinswl, pinlwl) SCHEDULE (STATIC) 6186 6192 DO isurf = 1, nsurfl 6187 6193 j = surfl(iy, isurf) … … 6193 6199 IF ( plant_lw_interact ) THEN 6194 6200 surfinlwdif(isurf) = rad_lw_in_diff(j,i) * skyvft(isurf) 6195 !- update received LW energy for RTM coupling6196 pinlwl = pinlwl + surfinlwdif(isurf) * facearea(d)6197 6201 ELSE 6198 6202 surfinlwdif(isurf) = rad_lw_in_diff(j,i) * skyvf(isurf) 6199 !- update received LW energy for RTM coupling6200 pinlwl = pinlwl + surfinlwdif(isurf) * facearea(d)6201 6203 ENDIF 6204 !- update received LW energy for RTM coupling 6205 pinlwl = pinlwl + surfinlwdif(isurf) * facearea(d) 6202 6206 ENDDO 6203 !$OMP END DO6204 6207 ! 6205 6208 !-- MRT diffuse irradiance 6206 !$OMP DO PRIVATE (i, j, imrt) SCHEDULE (STATIC)6209 !$OMP PARALLEL DO PRIVATE (i, j, imrt) SCHEDULE (STATIC) 6207 6210 DO imrt = 1, nmrtbl 6208 6211 j = mrtbl(iy, imrt) … … 6211 6214 mrtinlw(imrt) = mrtsky(imrt) * rad_lw_in_diff(j,i) 6212 6215 ENDDO 6213 !$OMP END DO6214 6216 ! 6215 6217 !-- Direct radiation … … 6229 6231 isd = dsidir_rev(j, i) 6230 6232 !-- TODO: check if isd = -1 to report that this solar position is not precalculated 6231 !$OMP DO PRIVATE (i, j, d, isurf) REDUCTION(+:pinswl) SCHEDULE (STATIC)6233 !$OMP PARALLEL DO PRIVATE (i, j, d, isurf) REDUCTION(+:pinswl) SCHEDULE (STATIC) 6232 6234 DO isurf = 1, nsurfl 6233 6235 j = surfl(iy, isurf) … … 6236 6238 surfinswdir(isurf) = rad_sw_in_dir(j,i) * & 6237 6239 costheta(surfl(id, isurf)) * dsitrans(isurf, isd) * sun_direct_factor 6238 !- update received SW energy for RTM coupling6240 !-- update received SW energy for RTM coupling 6239 6241 pinswl = pinswl + surfinswdir(isurf) * facearea(d) 6240 6242 ENDDO 6241 !$OMP END DO6242 6243 ! 6243 6244 !-- MRT direct irradiance 6244 !$OMP DO PRIVATE (i, j, imrt) SCHEDULE (STATIC)6245 !$OMP PARALLEL DO PRIVATE (i, j, imrt) SCHEDULE (STATIC) 6245 6246 DO imrt = 1, nmrtbl 6246 6247 j = mrtbl(iy, imrt) … … 6249 6250 * sun_direct_factor / 4.0_wp ! normal to sphere 6250 6251 ENDDO 6251 !$OMP END DO6252 6252 ENDIF 6253 6253 ! 6254 6254 !-- MRT first pass thermal 6255 !$OMP DO PRIVATE (imrtf, imrt, isurfsrc) SCHEDULE (STATIC)6255 !$OMP PARALLEL DO PRIVATE (imrtf, imrt, isurfsrc, temp) SCHEDULE (STATIC) 6256 6256 DO imrtf = 1, nmrtf 6257 6257 imrt = mrtfsurf(1, imrtf) 6258 6258 isurfsrc = mrtfsurf(2, imrtf) 6259 mrtinlw(imrt) = mrtinlw(imrt) + mrtf(imrtf) * surfoutl(isurfsrc) 6259 temp = mrtf(imrtf) * surfoutl(isurfsrc) 6260 !$OMP ATOMIC 6261 mrtinlw(imrt) = mrtinlw(imrt) + temp 6260 6262 ENDDO 6261 !$OMP END DO6262 6263 ! 6263 6264 !-- Absorption in each local plant canopy grid box from the first atmospheric … … 6269 6270 pcbinlw(:) = 0.0_wp 6270 6271 6271 !$OMP DO PRIVATE (icsf, ipcgb, i, j, k, kk, isurfsrc, pc_abs_frac, pcrad, asrc)&6272 !$OMP PARALLEL DO PRIVATE (icsf, ipcgb, i, j, k, kk, isurfsrc, pc_abs_frac, pcrad, asrc) & 6272 6273 !$OMP& REDUCTION(+:pinswl, pinlwl, pabslwl, pemitlwl, pabs_pc_lwdifl) SCHEDULE (STATIC) 6273 6274 DO icsf = 1, ncsfl … … 6328 6329 ENDIF 6329 6330 ENDDO 6330 !$OMP END DO6331 6331 6332 6332 pcbinsw(:) = pcbinswdir(:) + pcbinswdif(:) … … 6424 6424 ! 6425 6425 !-- Reflected radiation 6426 !$OMP DO PRIVATE (isvf, isurf, isurfsrc) SCHEDULE (STATIC)6426 !$OMP PARALLEL DO PRIVATE (isvf, isurf, isurfsrc) SCHEDULE (STATIC) 6427 6427 DO isvf = 1, nsvfl 6428 6428 isurf = svfsurf(1, isvf) … … 6435 6435 ENDIF 6436 6436 ENDDO 6437 !$OMP END DO6438 6437 ! 6439 6438 !-- NOTE: PC absorbtion and MRT from reflected can both be done at once … … 6443 6442 ! 6444 6443 !-- Radiation absorbed by plant canopy 6445 !$OMP DO PRIVATE (icsf, ipcgb, isurfsrc, asrc) SCHEDULE (STATIC)6444 !$OMP PARALLEL DO PRIVATE (icsf, ipcgb, isurfsrc, asrc, temp) SCHEDULE (STATIC) 6446 6445 DO icsf = 1, ncsfl 6447 6446 ipcgb = csfsurf(1, icsf) … … 6453 6452 !-- stored within `csf' 6454 6453 asrc = facearea(surf(id, isurfsrc)) 6455 pcbinsw(ipcgb) = pcbinsw(ipcgb) + csf(1,icsf) * surfouts(isurfsrc) * asrc 6454 temp = csf(1,icsf) * surfouts(isurfsrc) * asrc 6455 !$OMP ATOMIC 6456 pcbinsw(ipcgb) = pcbinsw(ipcgb) + temp 6456 6457 IF ( plant_lw_interact ) THEN 6457 pcbinlw(ipcgb) = pcbinlw(ipcgb) + csf(1,icsf) * surfoutl(isurfsrc) * asrc 6458 temp = csf(1,icsf) * surfoutl(isurfsrc) * asrc 6459 !$OMP ATOMIC 6460 pcbinlw(ipcgb) = pcbinlw(ipcgb) + temp 6458 6461 ENDIF 6459 6462 ENDDO 6460 !$OMP END DO6461 6463 ! 6462 6464 !-- MRT reflected 6463 !$OMP DO PRIVATE (imrtf, imrt, isurfsrc) SCHEDULE (STATIC)6465 !$OMP PARALLEL DO PRIVATE (imrtf, imrt, isurfsrc, temp) SCHEDULE (STATIC) 6464 6466 DO imrtf = 1, nmrtf 6465 6467 imrt = mrtfsurf(1, imrtf) 6466 6468 isurfsrc = mrtfsurf(2, imrtf) 6467 mrtinsw(imrt) = mrtinsw(imrt) + mrtft(imrtf) * surfouts(isurfsrc) 6468 mrtinlw(imrt) = mrtinlw(imrt) + mrtf(imrtf) * surfoutl(isurfsrc) 6469 temp = mrtft(imrtf) * surfouts(isurfsrc) 6470 !$OMP ATOMIC 6471 mrtinsw(imrt) = mrtinsw(imrt) + temp 6472 temp = mrtf(imrtf) * surfoutl(isurfsrc) 6473 !$OMP ATOMIC 6474 mrtinlw(imrt) = mrtinlw(imrt) + temp 6469 6475 ENDDO 6470 !$OMP END DO6471 6476 6472 6477 IF ( trace_fluxes_above >= 0.0_wp ) THEN … … 6490 6495 IF ( npcbl > 0 ) THEN 6491 6496 pcm_heating_rate(:,:,:) = 0.0_wp 6492 !$OMP DO PRIVATE (ipcgb, i, j, k, kk) REDUCTION(+:pabsswl) SCHEDULE (STATIC)6497 !$OMP PARALLEL DO PRIVATE (ipcgb, i, j, k, kk) REDUCTION(+:pabsswl) SCHEDULE (STATIC) 6493 6498 DO ipcgb = 1, npcbl 6494 6499 j = pcbl(iy, ipcgb) … … 6503 6508 pabsswl = pabsswl + pcbinsw(ipcgb) 6504 6509 ENDDO 6505 !$OMP END DO6506 6510 6507 6511 IF ( humidity .AND. plant_canopy_transpiration ) THEN … … 6509 6513 pcm_transpiration_rate(:,:,:) = 0.0_wp 6510 6514 pcm_latent_rate(:,:,:) = 0.0_wp 6511 !$OMP DO PRIVATE (ipcgb, i, j, k, kk) SCHEDULE (STATIC)6515 !$OMP PARALLEL DO PRIVATE (ipcgb, i, j, k, kk) SCHEDULE (STATIC) 6512 6516 DO ipcgb = 1, npcbl 6513 6517 i = pcbl(ix, ipcgb) … … 6520 6524 pcm_latent_rate(kk,j,i) ) 6521 6525 ENDDO 6522 !$OMP END DO6523 6526 ENDIF 6524 6527 ENDIF … … 6630 6633 ENDDO 6631 6634 6632 !$OMP DO PRIVATE (i, d) REDUCTION(+:pabsswl, pabslwl, pemitlwl, pabs_surf_lwdifl) &6633 !$OMP& SCHEDULE (STATIC)6635 !$OMP PARALLEL DO PRIVATE (i, d) REDUCTION(+:pabsswl, pabslwl, pemitlwl, pabs_surf_lwdifl) & 6636 !$OMP& SCHEDULE (STATIC) 6634 6637 DO i = 1, nsurfl 6635 6638 d = surfl(id, i) … … 6646 6649 emiss_surf(i) * facearea(d) * surfinlwdif(i) 6647 6650 ENDDO 6648 !$OMP END DO6649 6651 6650 6652 DO l = 0, 1 6651 !$OMP DO PRIVATE (m) SCHEDULE (STATIC)6653 !$OMP PARALLEL DO PRIVATE (m) SCHEDULE (STATIC) 6652 6654 DO m = 1, surf_usm_h(l)%ns 6653 6655 surf_usm_h(l)%surfhf(m) = surf_usm_h(l)%rad_sw_in(m) + & … … 6656 6658 surf_usm_h(l)%rad_lw_out(m) 6657 6659 ENDDO 6658 !$OMP END DO 6659 !$OMP DO PRIVATE (m) SCHEDULE (STATIC) 6660 !$OMP PARALLEL DO PRIVATE (m) SCHEDULE (STATIC) 6660 6661 DO m = 1, surf_lsm_h(l)%ns 6661 6662 surf_lsm_h(l)%surfhf(m) = surf_lsm_h(l)%rad_sw_in(m) + & … … 6664 6665 surf_lsm_h(l)%rad_lw_out(m) 6665 6666 ENDDO 6666 !$OMP END DO6667 6667 ENDDO 6668 6668 6669 6669 DO l = 0, 3 6670 !$OMP DO PRIVATE (m) SCHEDULE (STATIC)6671 6670 !-- urban 6671 !$OMP PARALLEL DO PRIVATE (m) SCHEDULE (STATIC) 6672 6672 DO m = 1, surf_usm_v(l)%ns 6673 6673 surf_usm_v(l)%surfhf(m) = surf_usm_v(l)%rad_sw_in(m) + & … … 6676 6676 surf_usm_v(l)%rad_lw_out(m) 6677 6677 ENDDO 6678 !$OMP END DO6679 6678 !-- land 6680 !$OMP DO PRIVATE (m) SCHEDULE (STATIC)6679 !$OMP PARALLEL DO PRIVATE (m) SCHEDULE (STATIC) 6681 6680 DO m = 1, surf_lsm_v(l)%ns 6682 6681 surf_lsm_v(l)%surfhf(m) = surf_lsm_v(l)%rad_sw_in(m) + & … … 6686 6685 6687 6686 ENDDO 6688 !$OMP END DO6689 6687 ENDDO 6690 6688 ! -
palm/trunk/SOURCE/surface_layer_fluxes_mod.f90
r4691 r4717 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Fixes and optimizations of OpenMP parallelization, formatting of OpenMP 28 ! directives (J. Resler) 29 ! 30 ! 4691 2020-09-22 14:38:38Z suehring 27 31 ! Bugfix for commit 4593 in vector branch of calc_ol 28 32 ! … … 720 724 !-- This is because the scalar coefficients are also used for other scalars such as passive scalars, 721 725 !-- chemistry and aerosols. 722 !$OMP PARALLEL 726 !$OMP PARALLEL DO PRIVATE( z_mo ) 723 727 !$ACC PARALLEL LOOP PRIVATE(z_mo) & 724 728 !$ACC PRESENT(surf) … … 1050 1054 ! 1051 1055 !-- Calculate the Obukhov length using Newton iteration 1052 !$OMP PARALLEL DO PRIVATE(i, j, z_mo) & 1053 !$OMP PRIVATE(ol_old, ol_m, ol_l, ol_u, f, f_d_ol) 1056 !$OMP PARALLEL DO PRIVATE(i, j, z_mo, ol_old, iter, ol_m, ol_l, ol_u, f, f_d_ol) 1054 1057 !$ACC PARALLEL LOOP PRIVATE(i, j, z_mo) & 1055 1058 !$ACC PRIVATE(ol_old, ol_m, ol_l, ol_u, f, f_d_ol) & … … 1583 1586 1584 1587 IF ( bulk_cloud_model .OR. cloud_droplets ) THEN 1585 !$OMP PARALLEL DO PRIVATE( i, j, k, z_mo )1588 !$OMP PARALLEL DO PRIVATE( i, j, k, z_mo ) 1586 1589 DO m = 1, surf%ns 1587 1590 i = surf%i(m) … … 1952 1955 !-- Compute wsus l={0,1} and wsvs l={2,3} 1953 1956 IF ( mom_w ) THEN 1954 !$OMP PARALLEL 1957 !$OMP PARALLEL DO PRIVATE( i, j, k ) 1955 1958 DO m = 1, surf%ns 1956 1959 i = surf%i(m) -
palm/trunk/SOURCE/timestep.f90
r4564 r4717 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 23 ! 22 ! 23 ! 24 24 ! Former revisions: 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Fixes and optimizations of OpenMP parallelization, formatting of OpenMP 28 ! directives (J. Resler) 29 ! 30 ! 4564 2020-06-12 14:03:36Z raasch 27 31 ! Vertical nesting method of Huq et al. (2019) removed 28 32 ! 29 33 ! 4540 2020-05-18 15:23:29Z raasch 30 34 ! File re-formatted to follow the PALM coding standard 31 !32 35 ! 33 36 ! 4444 2020-03-05 15:59:50Z raasch … … 308 311 ENDDO 309 312 310 !$OMP PARALLEL private(i,j,k) reduction(MIN: dt_diff_l) 311 !$OMP DO 313 !$OMP PARALLEL DO private(i,j,k) reduction(MIN: dt_diff_l) 312 314 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & 313 315 !$ACC COPY(dt_diff_l) REDUCTION(MIN: dt_diff_l) & … … 321 323 ENDDO 322 324 ENDDO 323 !$OMP END PARALLEL324 325 #if defined( __parallel ) 325 326 IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr ) -
palm/trunk/SOURCE/transpose.f90
r4540 r4717 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 23 ! 22 ! 23 ! 24 24 ! Former revisions: 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Formatting of OpenMP directives (J. Resler) 28 ! 29 ! 4540 2020-05-18 15:23:29Z raasch 27 30 ! File re-formatted to follow the PALM coding standard 28 !29 31 ! 30 32 ! 4429 2020-02-27 15:24:30Z raasch … … 197 199 ! 198 200 !-- Reorder transposed array 199 !$OMP PARALLEL PRIVATE ( i, j, k, l, ys )201 !$OMP PARALLEL PRIVATE ( i, j, k, l, ys ) 200 202 DO l = 0, pdims(2) - 1 201 203 ys = 0 + l * ( nyn_x - nys_x + 1 ) … … 214 216 !$OMP END DO NOWAIT 215 217 ENDDO 216 !$OMP END PARALLEL218 !$OMP END PARALLEL 217 219 #endif 218 220 … … 221 223 ! 222 224 !-- Reorder transposed array 223 !$OMP PARALLEL PRIVATE ( i, j, k )224 !$OMP DO225 !$OMP PARALLEL PRIVATE ( i, j, k ) 226 !$OMP DO 225 227 #if __acc_fft_device 226 228 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & … … 234 236 ENDDO 235 237 ENDDO 236 !$OMP END PARALLEL238 !$OMP END PARALLEL 237 239 238 240 ENDIF … … 271 273 !-- Rearrange indices of input array in order to make data to be send by MPI contiguous. 272 274 !-- In case of parallel fft/transposition, scattered store is faster in backward direction!!! 273 !$OMP PARALLEL PRIVATE ( i, j, k )274 !$OMP DO275 #if __acc_fft_device 276 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &277 !$ACC PRESENT(f_out, f_inv)275 !$OMP PARALLEL PRIVATE ( i, j, k ) 276 !$OMP DO 277 #if __acc_fft_device 278 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & 279 !$ACC PRESENT(f_out, f_inv) 278 280 #endif 279 281 DO i = nxl, nxr … … 430 432 ! 431 433 !-- Reorder the array in a way that the z index is in first position 432 !$OMPPARALLEL PRIVATE ( i, j, k )433 !$OMPDO434 !$OMP PARALLEL PRIVATE ( i, j, k ) 435 !$OMP DO 434 436 #if __acc_fft_device 435 437 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & … … 443 445 ENDDO 444 446 ENDDO 445 !$OMPEND PARALLEL447 !$OMP END PARALLEL 446 448 447 449 ENDIF … … 481 483 ! 482 484 !-- Rearrange indices of input array in order to make data to be send by MPI contiguous. 483 !$OMP 484 !$OMP 485 !$OMP PARALLEL PRIVATE ( i, j, k ) 486 !$OMP DO 485 487 #if __acc_fft_device 486 488 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & … … 494 496 ENDDO 495 497 ENDDO 496 !$OMP 498 !$OMP END PARALLEL 497 499 498 500 END SUBROUTINE resort_for_yx … … 560 562 ! 561 563 !-- Reorder input array for transposition 562 !$OMPPARALLEL PRIVATE ( i, j, k, l, ys )564 !$OMP PARALLEL PRIVATE ( i, j, k, l, ys ) 563 565 DO l = 0, pdims(2) - 1 564 566 ys = 0 + l * ( nyn_x - nys_x + 1 ) … … 577 579 !$OMP END DO NOWAIT 578 580 ENDDO 579 !$OMPEND PARALLEL581 !$OMP END PARALLEL 580 582 581 583 ! … … 610 612 ! 611 613 !-- Reorder array f_in the same way as ALLTOALL did it. 612 !$OMPPARALLEL PRIVATE ( i, j, k )613 !$OMPDO614 !$OMP PARALLEL PRIVATE ( i, j, k ) 615 !$OMP DO 614 616 #if __acc_fft_device 615 617 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & … … 623 625 ENDDO 624 626 ENDDO 625 !$OMPEND PARALLEL627 !$OMP END PARALLEL 626 628 627 629 ENDIF … … 748 750 ! 749 751 !-- Rearrange indices of input array in order to make data to be send by MPI contiguous. 750 !$OMPPARALLEL PRIVATE ( i, j, k )751 !$OMPDO752 !$OMP PARALLEL PRIVATE ( i, j, k ) 753 !$OMP DO 752 754 #if __acc_fft_device 753 755 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & … … 761 763 ENDDO 762 764 ENDDO 763 !$OMP 765 !$OMP END PARALLEL 764 766 765 767 END SUBROUTINE resort_for_yz … … 827 829 IF ( pdims(1) == 1 ) THEN 828 830 829 !$OMPPARALLEL PRIVATE ( i, j, k )830 !$OMPDO831 !$OMP PARALLEL PRIVATE ( i, j, k ) 832 !$OMP DO 831 833 #if __acc_fft_device 832 834 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & … … 840 842 ENDDO 841 843 ENDDO 842 !$OMPEND PARALLEL844 !$OMP END PARALLEL 843 845 844 846 ELSE … … 873 875 ! 874 876 !-- Reorder transposed array 875 !$OMPPARALLEL PRIVATE ( i, j, k, l, zs )877 !$OMP PARALLEL PRIVATE ( i, j, k, l, zs ) 876 878 DO l = 0, pdims(1) - 1 877 879 zs = 1 + l * ( nzt_y - nzb_y + 1 ) … … 890 892 !$OMP END DO NOWAIT 891 893 ENDDO 892 !$OMPEND PARALLEL894 !$OMP END PARALLEL 893 895 #endif 894 896 … … 927 929 ! 928 930 !-- Rearrange indices of input array in order to make data to be send by MPI contiguous. 929 !$OMPPARALLEL PRIVATE ( i, j, k )930 !$OMPDO931 #if __acc_fft_device 932 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &933 !$ACC PRESENT(f_in, f_inv)931 !$OMP PARALLEL PRIVATE ( i, j, k ) 932 !$OMP DO 933 #if __acc_fft_device 934 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & 935 !$ACC PRESENT(f_in, f_inv) 934 936 #endif 935 937 DO i = nxl, nxr … … 940 942 ENDDO 941 943 ENDDO 942 !$OMP 944 !$OMP END PARALLEL 943 945 944 946 END SUBROUTINE resort_for_zx … … 1016 1018 IF ( pdims(1) == 1 ) THEN 1017 1019 1018 !$OMPPARALLEL PRIVATE ( i, j, k )1019 !$OMPDO1020 !$OMP PARALLEL PRIVATE ( i, j, k ) 1021 !$OMP DO 1020 1022 #if __acc_fft_device 1021 1023 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & … … 1029 1031 ENDDO 1030 1032 ENDDO 1031 !$OMPEND PARALLEL1033 !$OMP END PARALLEL 1032 1034 1033 1035 ELSE … … 1080 1082 ELSE 1081 1083 1082 !$OMP 1084 !$OMP PARALLEL PRIVATE ( i, j, k, l, xs ) 1083 1085 DO l = 0, pdims(1) - 1 1084 1086 xs = 0 + l * nnx … … 1097 1099 !$OMP END DO NOWAIT 1098 1100 ENDDO 1099 !$OMP 1101 !$OMP END PARALLEL 1100 1102 1101 1103 ENDIF … … 1139 1141 ! 1140 1142 !-- Rearrange indices of input array in order to make data to be send by MPI contiguous. 1141 !$OMP 1142 !$OMP 1143 !$OMP PARALLEL PRIVATE ( i, j, k ) 1144 !$OMP DO 1143 1145 #if __acc_fft_device 1144 1146 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & … … 1152 1154 ENDDO 1153 1155 ENDDO 1154 !$OMP 1156 !$OMP END PARALLEL 1155 1157 1156 1158 END SUBROUTINE resort_for_zy … … 1220 1222 ! 1221 1223 !-- Reorder input array for transposition 1222 !$OMPPARALLEL PRIVATE ( i, j, k, l, zs )1224 !$OMP PARALLEL PRIVATE ( i, j, k, l, zs ) 1223 1225 DO l = 0, pdims(1) - 1 1224 1226 zs = 1 + l * ( nzt_y - nzb_y + 1 ) … … 1237 1239 !$OMP END DO NOWAIT 1238 1240 ENDDO 1239 !$OMPEND PARALLEL1241 !$OMP END PARALLEL 1240 1242 1241 1243 ! … … 1269 1271 ! 1270 1272 !-- Reorder the array in the same way like ALLTOALL did it 1271 !$OMPPARALLEL PRIVATE ( i, j, k )1272 !$OMPDO1273 !$OMP PARALLEL PRIVATE ( i, j, k ) 1274 !$OMP DO 1273 1275 #if __acc_fft_device 1274 1276 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) & … … 1282 1284 ENDDO 1283 1285 ENDDO 1284 !$OMPEND PARALLEL1286 !$OMP END PARALLEL 1285 1287 1286 1288 ENDIF -
palm/trunk/SOURCE/turbulence_closure_mod.f90
r4674 r4717 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Fixes and optimizations of OpenMP parallelization, formatting of OpenMP 28 ! directives (J. Resler) 29 ! 30 ! 4674 2020-09-10 10:36:55Z pavelkrc 27 31 ! Update ACC directives for downward facing USM and LSM surfaces 28 32 ! … … 2103 2107 !-- Not available in case of non-cyclic boundary conditions. 2104 2108 !-- Default surfaces, upward-facing 2105 !$OMP PARALLEL DO PRIVATE(i, j,k,m)2109 !$OMP PARALLEL DO PRIVATE(i, j, k, m, km_sfc) 2106 2110 !$ACC PARALLEL LOOP PRIVATE(i, j, k, m, km_sfc) & 2107 2111 !$ACC PRESENT(surf_def_h(0), u, v, drho_air_zw, zu) … … 2132 2136 ! 2133 2137 !-- Default surfaces, downward-facing surfaces 2134 !$OMP PARALLEL DO PRIVATE(i, j,k,m)2135 !$ACC PARALLEL LOOP PRIVATE(i, j, k, m , km_sfc) &2138 !$OMP PARALLEL DO PRIVATE(i, j, k, m) 2139 !$ACC PARALLEL LOOP PRIVATE(i, j, k, m) & 2136 2140 !$ACC PRESENT(surf_def_h(1), u, v, drho_air_zw, zu, km) 2137 2141 DO m = 1, surf_def_h(1)%ns … … 2158 2162 ! 2159 2163 !-- Natural surfaces, upward- and downward facing 2160 !$OMP PARALLEL DO PRIVATE(i, j,k,m)2164 !$OMP PARALLEL DO PRIVATE(i, j, k, m, km_sfc) 2161 2165 !$ACC PARALLEL LOOP PRIVATE(i, j, k, m, km_sfc) & 2162 2166 !$ACC PRESENT(surf_lsm_h(0), u, v, drho_air_zw, zu) … … 2187 2191 ! 2188 2192 !-- Natural surfaces, downward-facing surfaces 2189 !$OMP PARALLEL DO PRIVATE(i, j,k,m)2190 !$ACC PARALLEL LOOP PRIVATE(i, j, k, m , km_sfc) &2193 !$OMP PARALLEL DO PRIVATE(i, j, k, m) 2194 !$ACC PARALLEL LOOP PRIVATE(i, j, k, m) & 2191 2195 !$ACC PRESENT(surf_lsm_h(1), u, v, drho_air_zw, zu, km) 2192 2196 DO m = 1, surf_lsm_h(1)%ns … … 2213 2217 ! 2214 2218 !-- Urban surfaces, upward-facing 2215 !$OMP PARALLEL DO PRIVATE(i, j,k,m)2219 !$OMP PARALLEL DO PRIVATE(i, j, k, m, km_sfc) 2216 2220 !$ACC PARALLEL LOOP PRIVATE(i, j, k, m, km_sfc) & 2217 2221 !$ACC PRESENT(surf_usm_h(0), u, v, drho_air_zw, zu) … … 2242 2246 ! 2243 2247 !-- Urban surfaces, downward-facing surfaces 2244 !$OMP PARALLEL DO PRIVATE(i, j,k,m)2245 !$ACC PARALLEL LOOP PRIVATE(i, j, k, m , km_sfc) &2248 !$OMP PARALLEL DO PRIVATE(i, j, k, m) 2249 !$ACC PARALLEL LOOP PRIVATE(i, j, k, m) & 2246 2250 !$ACC PRESENT(surf_usm_h(1), u, v, drho_air_zw, zu, km) 2247 2251 DO m = 1, surf_usm_h(1)%ns … … 5192 5196 ! Data output 5193 5197 !$ACC END KERNELS 5194 !$OMP END PARALLEL5198 !$OMP END PARALLEL 5195 5199 5196 5200 END SUBROUTINE tcm_diffusivities_default -
palm/trunk/SOURCE/urban_surface_mod.f90
r4713 r4717 27 27 ! ----------------- 28 28 ! $Id$ 29 ! Fixes and optimizations of OpenMP parallelization, formatting of OpenMP 30 ! directives (J. Resler) 31 ! 32 ! 4713 2020-09-29 12:02:05Z pavelkrc 29 33 ! - Do not change original fractions in USM energy balance 30 34 ! - Correct OpenMP parallelization … … 5159 5163 ENDIF 5160 5164 5161 !$OMP PARALLEL PRIVATE (m, i, j, k, kw, wtend, wintend, win_absorp, wall_mod)5162 5165 wall_mod=1.0_wp 5163 5166 IF ( usm_wall_mod .AND. during_spinup ) THEN … … 5184 5187 ! 5185 5188 !-- Cycle for all surfaces in given direction 5186 !$OMP DOSCHEDULE (STATIC)5189 !$OMP PARALLEL DO PRIVATE (m, i, j, k, kw, wtend, wintend, win_absorp, wall_mod) SCHEDULE (STATIC) 5187 5190 DO m = 1, surf%ns 5188 5191 ! … … 5194 5197 !-- Prognostic equation for ground/roof temperature t_wall 5195 5198 wtend(:) = 0.0_wp 5196 wtend(nzb_wall) = ( 1.0_wp / surf%rho_c_wall(nzb_wall,m) ) &5197 * ( surf%lambda_h(nzb_wall,m) * wall_mod(nzb_wall) &5198 * ( t_wall%val(nzb_wall+1,m) - t_wall%val(nzb_wall,m) ) &5199 * surf%ddz_wall(nzb_wall+1,m) &5200 + surf%frac(m,ind_veg_wall) &5201 / ( surf%frac(m,ind_veg_wall) &5202 + surf%frac(m,ind_pav_green) ) &5203 * surf%wghf_eb(m) &5204 - surf%frac(m,ind_pav_green) &5205 / ( surf%frac(m,ind_veg_wall) &5206 + surf%frac(m,ind_pav_green) ) &5207 * ( surf%lambda_h_green(nzt_wall,m) &5208 * wall_mod(nzt_wall) &5209 * surf%ddz_green(nzt_wall,m) &5210 + surf%lambda_h(nzb_wall,m) &5211 * wall_mod(nzb_wall) &5212 * surf%ddz_wall(nzb_wall,m) ) &5213 / ( surf%ddz_green(nzt_wall,m) &5214 + surf%ddz_wall(nzb_wall,m) ) &5215 * ( t_wall%val(nzb_wall,m) - t_green%val(nzt_wall,m) ) &5199 wtend(nzb_wall) = ( 1.0_wp / surf%rho_c_wall(nzb_wall,m) ) & 5200 * ( surf%lambda_h(nzb_wall,m) * wall_mod(nzb_wall) & 5201 * ( t_wall%val(nzb_wall+1,m) - t_wall%val(nzb_wall,m) ) & 5202 * surf%ddz_wall(nzb_wall+1,m) & 5203 + surf%frac(m,ind_veg_wall) & 5204 / ( surf%frac(m,ind_veg_wall) & 5205 + surf%frac(m,ind_pav_green) ) & 5206 * surf%wghf_eb(m) & 5207 - surf%frac(m,ind_pav_green) & 5208 / ( surf%frac(m,ind_veg_wall) & 5209 + surf%frac(m,ind_pav_green) ) & 5210 * ( surf%lambda_h_green(nzt_wall,m) & 5211 * wall_mod(nzt_wall) & 5212 * surf%ddz_green(nzt_wall,m) & 5213 + surf%lambda_h(nzb_wall,m) & 5214 * wall_mod(nzb_wall) & 5215 * surf%ddz_wall(nzb_wall,m) ) & 5216 / ( surf%ddz_green(nzt_wall,m) & 5217 + surf%ddz_wall(nzb_wall,m) ) & 5218 * ( t_wall%val(nzb_wall,m) - t_green%val(nzt_wall,m) ) & 5216 5219 ) * surf%ddz_wall_stag(nzb_wall,m) 5217 5220 … … 5226 5229 5227 5230 DO kw = nzb_wall+1, nzt_wall-1 5228 wtend(kw) = ( 1.0_wp / surf%rho_c_wall(kw,m) ) &5229 * ( surf%lambda_h(kw,m) * wall_mod(kw)&5230 * ( t_wall%val(kw+1,m) - t_wall%val(kw,m) )&5231 * surf%ddz_wall(kw+1,m)&5232 - surf%lambda_h(kw-1,m) * wall_mod(kw-1)&5233 * ( t_wall%val(kw,m) - t_wall%val(kw-1,m) )&5234 * surf%ddz_wall(kw,m)&5235 5231 wtend(kw) = ( 1.0_wp / surf%rho_c_wall(kw,m) ) & 5232 * ( surf%lambda_h(kw,m) * wall_mod(kw) & 5233 * ( t_wall%val(kw+1,m) - t_wall%val(kw,m) ) & 5234 * surf%ddz_wall(kw+1,m) & 5235 - surf%lambda_h(kw-1,m) * wall_mod(kw-1) & 5236 * ( t_wall%val(kw,m) - t_wall%val(kw-1,m) ) & 5237 * surf%ddz_wall(kw,m) & 5238 ) * surf%ddz_wall_stag(kw,m) 5236 5239 ENDDO 5237 5238 wtend(nzt_wall) = ( 1.0_wp / surf%rho_c_wall(nzt_wall,m) ) & 5239 * ( -surf%lambda_h(nzt_wall-1,m) * wall_mod(nzt_wall-1) & 5240 * ( t_wall%val(nzt_wall,m) - t_wall%val(nzt_wall-1,m) ) & 5241 * surf%ddz_wall(nzt_wall,m) & 5242 + surf%iwghf_eb(m) & 5243 ) * surf%ddz_wall_stag(nzt_wall,m) 5244 5245 t_wall_p%val(nzb_wall:nzt_wall,m) = t_wall%val(nzb_wall:nzt_wall,m) + dt_3d & 5246 * ( tsc(2) * wtend(nzb_wall:nzt_wall) + tsc(3) & 5240 wtend(nzt_wall) = ( 1.0_wp / surf%rho_c_wall(nzt_wall,m) ) & 5241 * ( -surf%lambda_h(nzt_wall-1,m) * wall_mod(nzt_wall-1) & 5242 * ( t_wall%val(nzt_wall,m) - t_wall%val(nzt_wall-1,m) ) & 5243 * surf%ddz_wall(nzt_wall,m) + surf%iwghf_eb(m) & 5244 ) * surf%ddz_wall_stag(nzt_wall,m) 5245 5246 t_wall_p%val(nzb_wall:nzt_wall,m) = t_wall%val(nzb_wall:nzt_wall,m) + dt_3d & 5247 * ( tsc(2) * wtend(nzb_wall:nzt_wall) + tsc(3) & 5247 5248 * surf%tt_wall_m(nzb_wall:nzt_wall,m) ) 5248 5249 … … 5255 5256 !-- of shortwave radiation into account 5256 5257 wintend(:) = 0.0_wp 5257 wintend(nzb_wall) = ( 1.0_wp / surf%rho_c_window(nzb_wall,m) ) &5258 * ( surf%lambda_h_window(nzb_wall,m) &5259 * ( t_window%val(nzb_wall+1,m) - t_window%val(nzb_wall,m) ) &5260 * surf%ddz_window(nzb_wall+1,m) &5261 + surf%wghf_eb_window(m) &5262 + surf%rad_sw_in(m) &5263 * ( 1.0_wp - exp( -win_absorp &5264 * surf%zw_window(nzb_wall,m) ) ) &5258 wintend(nzb_wall) = ( 1.0_wp / surf%rho_c_window(nzb_wall,m) ) & 5259 * ( surf%lambda_h_window(nzb_wall,m) & 5260 * ( t_window%val(nzb_wall+1,m) - t_window%val(nzb_wall,m) ) & 5261 * surf%ddz_window(nzb_wall+1,m) & 5262 + surf%wghf_eb_window(m) & 5263 + surf%rad_sw_in(m) & 5264 * ( 1.0_wp - exp( -win_absorp & 5265 * surf%zw_window(nzb_wall,m) ) ) & 5265 5266 ) * surf%ddz_window_stag(nzb_wall,m) 5266 5267 … … 5272 5273 ENDIF 5273 5274 5275 5274 5276 DO kw = nzb_wall+1, nzt_wall-1 5275 wintend(kw) = ( 1.0_wp / surf%rho_c_window(kw,m) ) &5276 * ( surf%lambda_h_window(kw,m)&5277 * ( t_window%val(kw+1,m) - t_window%val(kw,m) )&5278 * surf%ddz_window(kw+1,m)&5279 - surf%lambda_h_window(kw-1,m)&5280 * ( t_window%val(kw,m) - t_window%val(kw-1,m) )&5281 * surf%ddz_window(kw,m)&5282 + surf%rad_sw_in(m)&5283 * ( exp( -win_absorp * surf%zw_window(kw-1,m) )&5284 - exp(-win_absorp * surf%zw_window(kw,m) )&5285 )&5286 5277 wintend(kw) = ( 1.0_wp / surf%rho_c_window(kw,m) ) & 5278 * ( surf%lambda_h_window(kw,m) & 5279 * ( t_window%val(kw+1,m) - t_window%val(kw,m) ) & 5280 * surf%ddz_window(kw+1,m) & 5281 - surf%lambda_h_window(kw-1,m) & 5282 * ( t_window%val(kw,m) - t_window%val(kw-1,m) ) & 5283 * surf%ddz_window(kw,m) & 5284 + surf%rad_sw_in(m) & 5285 * ( exp( -win_absorp * surf%zw_window(kw-1,m) ) & 5286 - exp(-win_absorp * surf%zw_window(kw,m) ) & 5287 ) & 5288 ) * surf%ddz_window_stag(kw,m) 5287 5289 5288 5290 ENDDO 5289 5291 5290 wintend(nzt_wall) = ( 1.0_wp / surf%rho_c_window(nzt_wall,m) ) &5291 * ( -surf%lambda_h_window(nzt_wall-1,m)&5292 * ( t_window%val(nzt_wall,m) - t_window%val(nzt_wall-1,m) ) &5293 * surf%ddz_window(nzt_wall,m) &5294 + surf%iwghf_eb_window(m) &5295 + surf%rad_sw_in(m) &5296 * ( exp( -win_absorp &5297 * surf%zw_window(nzt_wall-1,m) )&5298 - exp( -win_absorp&5299 * surf%zw_window(nzt_wall,m) )&5300 ) &5301 ) * surf%ddz_window_stag(nzt_wall,m)5302 5303 t_window_p%val(nzb_wall:nzt_wall,m) = t_window%val(nzb_wall:nzt_wall,m) + dt_3d &5304 * ( tsc(2) * wintend(nzb_wall:nzt_wall) + tsc(3) &5292 wintend(nzt_wall) = ( 1.0_wp / surf%rho_c_window(nzt_wall,m) ) & 5293 * ( -surf%lambda_h_window(nzt_wall-1,m) & 5294 * ( t_window%val(nzt_wall,m) - t_window%val(nzt_wall-1,m) ) & 5295 * surf%ddz_window(nzt_wall,m) & 5296 + surf%iwghf_eb_window(m) & 5297 + surf%rad_sw_in(m) & 5298 * ( exp( -win_absorp & 5299 * surf%zw_window(nzt_wall-1,m) ) & 5300 - exp( -win_absorp & 5301 * surf%zw_window(nzt_wall,m) ) & 5302 ) & 5303 ) * surf%ddz_window_stag(nzt_wall,m) 5304 5305 t_window_p%val(nzb_wall:nzt_wall,m) = t_window%val(nzb_wall:nzt_wall,m) + dt_3d & 5306 * ( tsc(2) * wintend(nzb_wall:nzt_wall) + tsc(3) & 5305 5307 * surf%tt_window_m(nzb_wall:nzt_wall,m) ) 5306 5308 5307 5309 ENDIF 5308 5309 5310 ! 5310 5311 !-- Calculate t_wall tendencies for the next Runge-Kutta step … … 5316 5317 ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max ) THEN 5317 5318 DO kw = nzb_wall, nzt_wall 5318 surf%tt_wall_m(kw,m) = -9.5625_wp * wtend(kw) + &5319 surf%tt_wall_m(kw,m) = -9.5625_wp * wtend(kw) + & 5319 5320 5.3125_wp * surf%tt_wall_m(kw,m) 5320 5321 ENDDO … … 5332 5333 ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max ) THEN 5333 5334 DO kw = nzb_wall, nzt_wall 5334 surf%tt_window_m(kw,m) = -9.5625_wp * wintend(kw) + &5335 surf%tt_window_m(kw,m) = -9.5625_wp * wintend(kw) + & 5335 5336 5.3125_wp * surf%tt_window_m(kw,m) 5336 5337 ENDDO … … 5339 5340 ENDIF 5340 5341 ENDDO 5341 !$OMP END PARALLEL5342 5342 5343 5343 IF ( debug_output_timestep ) THEN … … 5403 5403 ENDIF 5404 5404 5405 !$OMP PARALLEL PRIVATE (m, i, j, k, kw, lambda_h_green_sat, ke, lambda_green_temp, gtend, & 5406 !$OMP& tend, h_vg, gamma_green_temp, m_total, root_extr_green) 5407 !$OMP DO SCHEDULE (STATIC) 5405 !$OMP PARALLEL DO PRIVATE (m, i, j, k, kw, lambda_h_green_sat, ke, lambda_green_temp, & 5406 !$OMP& gtend, tend, h_vg, gamma_green_temp, m_total, root_extr_green) SCHEDULE (STATIC) 5408 5407 DO m = 1, surf%ns 5409 5408 IF (surf%frac(m,ind_pav_green) > 0.0_wp) THEN … … 5417 5416 ! 5418 5417 !-- Calculate volumetric heat capacity of the soil, taking into account water content 5419 surf%rho_c_total_green(kw,m) = (surf%rho_c_green(kw,m) &5420 * (1.0_wp - swc_sat_h(l)%val(kw,m)) 5418 surf%rho_c_total_green(kw,m) = (surf%rho_c_green(kw,m) & 5419 * (1.0_wp - swc_sat_h(l)%val(kw,m)) & 5421 5420 + rho_c_water * swc_h(l)%val(kw,m)) 5422 5421 5423 5422 ! 5424 5423 !-- Calculate soil heat conductivity at the center of the soil layers 5425 lambda_h_green_sat = lambda_h_green_sm ** ( 1.0_wp - swc_sat_h(l)%val(kw,m) ) 5424 lambda_h_green_sat = lambda_h_green_sm ** ( 1.0_wp - swc_sat_h(l)%val(kw,m) ) & 5426 5425 * lambda_h_water ** swc_h(l)%val(kw,m) 5427 5426 5428 5427 ke = 1.0_wp + LOG10( MAX( 0.1_wp,swc_h(l)%val(kw,m) / swc_sat_h(l)%val(kw,m) ) ) 5429 5428 5430 lambda_green_temp(kw) = ke * (lambda_h_green_sat - lambda_h_green_dry) 5429 lambda_green_temp(kw) = ke * (lambda_h_green_sat - lambda_h_green_dry) & 5431 5430 + lambda_h_green_dry 5432 5431 … … 5439 5438 !-- For pavement surface, the true pavement depth is considered 5440 5439 DO kw = nzb_wall, nzt_wall 5441 surf%lambda_h_green(kw,m) = ( lambda_green_temp(kw+1) + lambda_green_temp(kw) ) &5440 surf%lambda_h_green(kw,m) = ( lambda_green_temp(kw+1) + lambda_green_temp(kw) ) & 5442 5441 * 0.5_wp 5443 5442 ENDDO … … 5447 5446 !-- Prognostic equation for ground/roof temperature t_green_h 5448 5447 gtend(:) = 0.0_wp 5449 gtend(nzb_wall) = ( 1.0_wp / surf%rho_c_total_green(nzb_wall,m) ) &5450 * ( surf%lambda_h_green(nzb_wall,m) &5451 * ( t_green_h(l)%val(nzb_wall+1,m) 5452 - t_green_h(l)%val(nzb_wall,m) ) 5453 * surf%ddz_green(nzb_wall+1,m) &5454 + surf%wghf_eb_green(m) &5448 gtend(nzb_wall) = ( 1.0_wp / surf%rho_c_total_green(nzb_wall,m) ) & 5449 * ( surf%lambda_h_green(nzb_wall,m) & 5450 * ( t_green_h(l)%val(nzb_wall+1,m) & 5451 - t_green_h(l)%val(nzb_wall,m) ) & 5452 * surf%ddz_green(nzb_wall+1,m) & 5453 + surf%wghf_eb_green(m) & 5455 5454 ) * surf%ddz_green_stag(nzb_wall,m) 5456 5455 5457 5456 DO kw = nzb_wall+1, nzt_wall 5458 gtend(kw) = ( 1.0_wp / surf%rho_c_total_green(kw,m) ) &5459 * ( surf%lambda_h_green(kw,m) &5460 * ( t_green_h(l)%val(kw+1,m) - t_green_h(l)%val(kw,m) ) 5461 * surf%ddz_green(kw+1,m) &5462 - surf%lambda_h_green(kw-1,m) &5463 * ( t_green_h(l)%val(kw,m) - t_green_h(l)%val(kw-1,m) ) 5464 * surf%ddz_green(kw,m) &5457 gtend(kw) = ( 1.0_wp / surf%rho_c_total_green(kw,m) ) & 5458 * ( surf%lambda_h_green(kw,m) & 5459 * ( t_green_h(l)%val(kw+1,m) - t_green_h(l)%val(kw,m) ) & 5460 * surf%ddz_green(kw+1,m) & 5461 - surf%lambda_h_green(kw-1,m) & 5462 * ( t_green_h(l)%val(kw,m) - t_green_h(l)%val(kw-1,m) ) & 5463 * surf%ddz_green(kw,m) & 5465 5464 ) * surf%ddz_green_stag(kw,m) 5466 5465 ENDDO 5467 5466 5468 t_green_h_p(l)%val(nzb_wall:nzt_wall,m) = t_green_h(l)%val(nzb_wall:nzt_wall,m) &5469 + dt_3d * ( tsc(2) * gtend(nzb_wall:nzt_wall) + tsc(3) &5467 t_green_h_p(l)%val(nzb_wall:nzt_wall,m) = t_green_h(l)%val(nzb_wall:nzt_wall,m) & 5468 + dt_3d * ( tsc(2) * gtend(nzb_wall:nzt_wall) + tsc(3) & 5470 5469 * surf%tt_green_m(nzb_wall:nzt_wall,m) ) 5471 5470 … … 5480 5479 ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max ) THEN 5481 5480 DO kw = nzb_wall, nzt_wall 5482 surf%tt_green_m(kw,m) = -9.5625_wp * gtend(kw) + 5.3125_wp &5481 surf%tt_green_m(kw,m) = -9.5625_wp * gtend(kw) + 5.3125_wp & 5483 5482 * surf%tt_green_m(kw,m) 5484 5483 ENDDO … … 5490 5489 ! 5491 5490 !-- Calculate soil diffusivity at the center of the soil layers 5492 lambda_green_temp(kw) = ( - b_ch * surf%gamma_w_green_sat(kw,m) * psi_sat &5493 / swc_sat_h(l)%val(kw,m) ) &5494 * ( MAX( swc_h(l)%val(kw,m), wilt_h(l)%val(kw,m) ) &5491 lambda_green_temp(kw) = ( - b_ch * surf%gamma_w_green_sat(kw,m) * psi_sat & 5492 / swc_sat_h(l)%val(kw,m) ) & 5493 * ( MAX( swc_h(l)%val(kw,m), wilt_h(l)%val(kw,m) ) & 5495 5494 / swc_sat_h(l)%val(kw,m) )**( b_ch + 2.0_wp ) 5496 5495 … … 5500 5499 ! 5501 5500 !-- Calculate the hydraulic conductivity after Van Genuchten (1980) 5502 h_vg = ( ( (swc_res_h(l)%val(kw,m) - swc_sat_h(l)%val(kw,m)) &5503 / ( swc_res_h(l)%val(kw,m) - &5504 MAX( swc_h(l)%val(kw,m), wilt_h(l)%val(kw,m) ) ) )** 5505 ( surf%n_vg_green(m) / (surf%n_vg_green(m) - 1.0_wp ) ) &5506 - 1.0_wp 5501 h_vg = ( ( (swc_res_h(l)%val(kw,m) - swc_sat_h(l)%val(kw,m)) & 5502 / ( swc_res_h(l)%val(kw,m) - & 5503 MAX( swc_h(l)%val(kw,m), wilt_h(l)%val(kw,m) ) ) )** & 5504 ( surf%n_vg_green(m) / (surf%n_vg_green(m) - 1.0_wp ) ) & 5505 - 1.0_wp & 5507 5506 )** ( 1.0_wp / surf%n_vg_green(m) ) / surf%alpha_vg_green(m) 5508 5507 5509 5508 5510 gamma_green_temp(kw) = surf%gamma_w_green_sat(kw,m) &5511 * ( ( ( 1.0_wp + ( surf%alpha_vg_green(m) * h_vg )** &5512 surf%n_vg_green(m) )** &5513 ( 1.0_wp - 1.0_wp / surf%n_vg_green(m) ) &5514 - ( surf%alpha_vg_green(m) * h_vg )** &5515 ( surf%n_vg_green(m) - 1.0_wp) )**2 &5516 ) / ( ( 1.0_wp + ( surf%alpha_vg_green(m) * h_vg )** &5517 surf%n_vg_green(m) )** &5518 ( ( 1.0_wp - 1.0_wp / surf%n_vg_green(m) ) &5519 *( surf%l_vg_green(m) + 2.0_wp) ) &5509 gamma_green_temp(kw) = surf%gamma_w_green_sat(kw,m) & 5510 * ( ( ( 1.0_wp + ( surf%alpha_vg_green(m) * h_vg )** & 5511 surf%n_vg_green(m) )** & 5512 ( 1.0_wp - 1.0_wp / surf%n_vg_green(m) ) & 5513 - ( surf%alpha_vg_green(m) * h_vg )** & 5514 ( surf%n_vg_green(m) - 1.0_wp) )**2 & 5515 ) / ( ( 1.0_wp + ( surf%alpha_vg_green(m) * h_vg )** & 5516 surf%n_vg_green(m) )** & 5517 ( ( 1.0_wp - 1.0_wp / surf%n_vg_green(m) ) & 5518 *( surf%l_vg_green(m) + 2.0_wp) ) & 5520 5519 ) 5521 5520 … … 5523 5522 !-- Parametrization of Clapp & Hornberger 5524 5523 ELSE 5525 gamma_green_temp(kw) = surf%gamma_w_green_sat(kw,m) * ( swc_h(l)%val(kw,m) &5524 gamma_green_temp(kw) = surf%gamma_w_green_sat(kw,m) * ( swc_h(l)%val(kw,m) & 5526 5525 / swc_sat_h(l)%val(kw,m) )**( 2.0_wp * b_ch + 3.0_wp ) 5527 5526 ENDIF … … 5538 5537 DO kw = nzb_wall, nzt_wall-1 5539 5538 5540 surf%lambda_w_green(kw,m) = ( lambda_green_temp(kw+1) &5541 + lambda_green_temp(kw) ) 5539 surf%lambda_w_green(kw,m) = ( lambda_green_temp(kw+1) & 5540 + lambda_green_temp(kw) ) & 5542 5541 * 0.5_wp 5543 surf%gamma_w_green(kw,m) = ( gamma_green_temp(kw+1) &5544 + gamma_green_temp(kw) ) 5542 surf%gamma_w_green(kw,m) = ( gamma_green_temp(kw+1) & 5543 + gamma_green_temp(kw) ) & 5545 5544 * 0.5_wp 5546 5545 … … 5588 5587 tend(:) = 0.0_wp 5589 5588 5590 tend(nzb_wall) = ( surf_usm_h(l)%lambda_w_green(nzb_wall,m) 5591 * ( swc_h(l)%val(nzb_wall+1,m) - swc_h(l)%val(nzb_wall,m) ) 5592 * surf_usm_h(l)%ddz_green(nzb_wall+1,m) 5593 - surf_usm_h(l)%gamma_w_green(nzb_wall,m) 5594 - ( root_extr_green(nzb_wall) * surf_usm_h(l)%qsws_veg(m) 5595 ! + surf_usm_h(l)%qsws_soil_green(m) 5596 ) * drho_l_lv ) 5589 tend(nzb_wall) = ( surf_usm_h(l)%lambda_w_green(nzb_wall,m) & 5590 * ( swc_h(l)%val(nzb_wall+1,m) - swc_h(l)%val(nzb_wall,m) ) & 5591 * surf_usm_h(l)%ddz_green(nzb_wall+1,m) & 5592 - surf_usm_h(l)%gamma_w_green(nzb_wall,m) & 5593 - ( root_extr_green(nzb_wall) * surf_usm_h(l)%qsws_veg(m) & 5594 ! + surf_usm_h(l)%qsws_soil_green(m) & 5595 ) * drho_l_lv ) & 5597 5596 * surf_usm_h(l)%ddz_green_stag(nzb_wall,m) 5598 5597 5599 5598 DO kw = nzb_wall+1, nzt_wall-1 5600 tend(kw) = ( surf_usm_h(l)%lambda_w_green(kw,m) 5601 * ( swc_h(l)%val(kw+1,m) - swc_h(l)%val(kw,m) ) 5602 * surf_usm_h(l)%ddz_green(kw+1,m) 5603 - surf_usm_h(l)%gamma_w_green(kw,m) 5604 - surf_usm_h(l)%lambda_w_green(kw-1,m) 5605 * ( swc_h(l)%val(kw,m) - swc_h(l)%val(kw-1,m) ) 5606 * surf_usm_h(l)%ddz_green(kw,m) 5607 + surf_usm_h(l)%gamma_w_green(kw-1,m) 5608 - (root_extr_green(kw) 5609 * surf_usm_h(l)%qsws_veg(m) 5610 * drho_l_lv) 5599 tend(kw) = ( surf_usm_h(l)%lambda_w_green(kw,m) & 5600 * ( swc_h(l)%val(kw+1,m) - swc_h(l)%val(kw,m) ) & 5601 * surf_usm_h(l)%ddz_green(kw+1,m) & 5602 - surf_usm_h(l)%gamma_w_green(kw,m) & 5603 - surf_usm_h(l)%lambda_w_green(kw-1,m) & 5604 * ( swc_h(l)%val(kw,m) - swc_h(l)%val(kw-1,m) ) & 5605 * surf_usm_h(l)%ddz_green(kw,m) & 5606 + surf_usm_h(l)%gamma_w_green(kw-1,m) & 5607 - (root_extr_green(kw) & 5608 * surf_usm_h(l)%qsws_veg(m) & 5609 * drho_l_lv) & 5611 5610 ) * surf_usm_h(l)%ddz_green_stag(kw,m) 5612 5611 5613 5612 ENDDO 5614 tend(nzt_wall) = ( - surf_usm_h(l)%gamma_w_green(nzt_wall,m) 5615 - surf_usm_h(l)%lambda_w_green(nzt_wall-1,m) 5616 * (swc_h(l)%val(nzt_wall,m) 5617 - swc_h(l)%val(nzt_wall-1,m)) 5618 * surf_usm_h(l)%ddz_green(nzt_wall,m) 5619 + surf_usm_h(l)%gamma_w_green(nzt_wall-1,m) 5620 - ( root_extr_green(nzt_wall) 5621 * surf_usm_h(l)%qsws_veg(m) 5622 * drho_l_lv ) 5613 tend(nzt_wall) = ( - surf_usm_h(l)%gamma_w_green(nzt_wall,m) & 5614 - surf_usm_h(l)%lambda_w_green(nzt_wall-1,m) & 5615 * (swc_h(l)%val(nzt_wall,m) & 5616 - swc_h(l)%val(nzt_wall-1,m)) & 5617 * surf_usm_h(l)%ddz_green(nzt_wall,m) & 5618 + surf_usm_h(l)%gamma_w_green(nzt_wall-1,m) & 5619 - ( root_extr_green(nzt_wall) & 5620 * surf_usm_h(l)%qsws_veg(m) & 5621 * drho_l_lv ) & 5623 5622 ) * surf_usm_h(l)%ddz_green_stag(nzt_wall,m) 5624 5623 5625 swc_h_p(l)%val(nzb_wall:nzt_wall,m) = swc_h(l)%val(nzb_wall:nzt_wall,m) + dt_3d 5626 * ( tsc(2) * tend(:) + tsc(3) 5627 * surf_usm_h(l)%tswc_h_m(:,m) 5624 swc_h_p(l)%val(nzb_wall:nzt_wall,m) = swc_h(l)%val(nzb_wall:nzt_wall,m) + dt_3d & 5625 * ( tsc(2) * tend(:) + tsc(3) & 5626 * surf_usm_h(l)%tswc_h_m(:,m) & 5628 5627 ) 5629 5628 … … 5643 5642 ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max ) THEN 5644 5643 DO kw = nzb_wall, nzt_wall 5645 surf_usm_h(l)%tswc_h_m(kw,m) = -9.5625_wp * tend(kw) + 5.3125_wp 5644 surf_usm_h(l)%tswc_h_m(kw,m) = -9.5625_wp * tend(kw) + 5.3125_wp & 5646 5645 * surf_usm_h(l)%tswc_h_m(kw,m) 5647 5646 ENDDO … … 5652 5651 ENDIF 5653 5652 ENDDO 5654 !$OMP END PARALLEL5655 5653 ELSE 5656 5654 IF ( horizontal) THEN … … 5665 5663 t_green => t_green_v(l) 5666 5664 ENDIF 5667 !$OMP DOSCHEDULE (STATIC)5665 !$OMP PARALLEL DO PRIVATE (m, i, j, k, kw) SCHEDULE (STATIC) 5668 5666 DO m = 1, surf%ns 5669 5667 IF (surf%frac(m,ind_pav_green) > 0.0_wp) THEN … … 5684 5682 ! !-- Prognostic equation for green temperature t_green_v 5685 5683 ! gtend(:) = 0.0_wp 5686 ! gtend(nzb_wall) = (1.0_wp / surf%rho_c_green(nzb_wall,m)) * &5687 ! ( surf%lambda_h_green(nzb_wall,m) * &5688 ! ( t_green%val(nzb_wall+1,m) &5689 ! - t_green%val(nzb_wall,m) ) * &5690 ! surf%ddz_green(nzb_wall+1,m) &5691 ! + surf%wghf_eb(m) ) * &5684 ! gtend(nzb_wall) = (1.0_wp / surf%rho_c_green(nzb_wall,m)) * & 5685 ! ( surf%lambda_h_green(nzb_wall,m) * & 5686 ! ( t_green%val(nzb_wall+1,m) & 5687 ! - t_green%val(nzb_wall,m) ) * & 5688 ! surf%ddz_green(nzb_wall+1,m) & 5689 ! + surf%wghf_eb(m) ) * & 5692 5690 ! surf%ddz_green_stag(nzb_wall,m) 5693 5691 ! 5694 5692 ! DO kw = nzb_wall+1, nzt_wall 5695 ! gtend(kw) = (1.0_wp / surf%rho_c_green(kw,m)) &5696 ! * ( surf%lambda_h_green(kw,m) &5697 ! * ( t_green%val(kw+1,m) - t_green%val(kw,m) ) &5698 ! * surf%ddz_green(kw+1,m) &5699 ! - surf%lambda_h(kw-1,m) &5700 ! * ( t_green%val(kw,m) - t_green%val(kw-1,m) ) &5701 ! * surf%ddz_green(kw,m) ) &5693 ! gtend(kw) = (1.0_wp / surf%rho_c_green(kw,m)) & 5694 ! * ( surf%lambda_h_green(kw,m) & 5695 ! * ( t_green%val(kw+1,m) - t_green%val(kw,m) ) & 5696 ! * surf%ddz_green(kw+1,m) & 5697 ! - surf%lambda_h(kw-1,m) & 5698 ! * ( t_green%val(kw,m) - t_green%val(kw-1,m) ) & 5699 ! * surf%ddz_green(kw,m) ) & 5702 5700 ! * surf%ddz_green_stag(kw,m) 5703 5701 ! ENDDO 5704 5702 ! 5705 ! t_green_v_p(l)%val(nzb_wall:nzt_wall,m) = &5706 ! t_green%val(nzb_wall:nzt_wall,m) &5707 ! + dt_3d * ( tsc(2) &5708 ! * gtend(nzb_wall:nzt_wall) + tsc(3) &5703 ! t_green_v_p(l)%val(nzb_wall:nzt_wall,m) = & 5704 ! t_green%val(nzb_wall:nzt_wall,m) & 5705 ! + dt_3d * ( tsc(2) & 5706 ! * gtend(nzb_wall:nzt_wall) + tsc(3) & 5709 5707 ! * surf%tt_green_m(nzb_wall:nzt_wall,m) ) 5710 5708 ! … … 5716 5714 ! surf%tt_green_m(kw,m) = gtend(kw) 5717 5715 ! ENDDO 5718 ! ELSEIF ( intermediate_timestep_count < &5716 ! ELSEIF ( intermediate_timestep_count < & 5719 5717 ! intermediate_timestep_count_max ) THEN 5720 5718 ! DO kw = nzb_wall, nzt_wall 5721 ! surf%tt_green_m(kw,m) = &5722 ! - 9.5625_wp * gtend(kw) + &5719 ! surf%tt_green_m(kw,m) = & 5720 ! - 9.5625_wp * gtend(kw) + & 5723 5721 ! 5.3125_wp * surf%tt_green_m(kw,m) 5724 5722 ! ENDDO … … 6768 6766 ! 6769 6767 !-- First, treat horizontal surface elements 6770 !$OMP PARALLEL PRIVATE (m, i, j, k, frac_win, frac_wall, frac_green, lambda_surface, ueff, & 6771 !$OMP& lambda_surface_window, lambda_surface_green, qv1, rho_cp, rho_lv, & 6772 !$OMP& drho_l_lv, f_shf, f_shf_window, f_shf_green, m_total, f1, f2, e_s, e, & 6773 !$OMP& f3, f_qsws_veg, q_s, f_qsws_liq, f_qsws, e_s_dt, dq_s_dt, coef_1, & 6774 !$OMP& coef_window_1, coef_green_1, coef_2, coef_window_2, coef_green_2, & 6775 !$OMP& stend_wall, stend_window, stend_green, tend, m_liq_max) 6776 !$OMP DO SCHEDULE (STATIC) 6768 !$OMP PARALLEL DO PRIVATE (m, i, j, k, frac_win, frac_wall, frac_green, lambda_surface, & 6769 !$OMP& lambda_surface_window, lambda_surface_green, ueff, qv1, rho_cp, rho_lv, & 6770 !$OMP& drho_l_lv, f_shf, f_shf_window, f_shf_green, m_total, f1, f2, e_s, e, & 6771 !$OMP& f3, f_qsws_veg, q_s, f_qsws_liq, f_qsws, e_s_dt, dq_s_dt, coef_1, & 6772 !$OMP& coef_window_1, coef_green_1, coef_2, coef_window_2, coef_green_2, & 6773 !$OMP& stend_wall, stend_window, stend_green, tend, m_liq_max) SCHEDULE (STATIC) 6777 6774 DO m = 1, surf%ns 6778 6775 ! … … 7200 7197 7201 7198 ENDDO 7202 !$OMP END PARALLEL7203 7199 7204 7200 !
Note: See TracChangeset
for help on using the changeset viewer.
