Changeset 4717 for palm/trunk/SOURCE/radiation_model_mod.f90
- Timestamp:
- Sep 30, 2020 10:27:40 PM (4 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/radiation_model_mod.f90 (modified) (25 diffs)
Legend:
- Unmodified
- Added
- Removed
-
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 !
Note: See TracChangeset
for help on using the changeset viewer.
