Ignore:
Timestamp:
Mar 10, 2013 2:48:14 AM (9 years ago)
Author:
raasch
Message:

GPU porting of boundary conditions and routine pres; index bug removec from radiation boundary condition

File:
1 edited

Legend:

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

    r1112 r1113  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! GPU-porting of several loops, some loops rearranged
    2323!
    2424! Former revisions:
     
    403403!--       Solver for 2d-decomposition
    404404          CALL poisfft( d, tend )
    405           !$acc update host( d )
     405
    406406       ELSEIF ( psolver == 'poisfft_hybrid' )  THEN
    407407!
     
    410410!--       are some optimization problems in poisfft
    411411          CALL poisfft_hybrid( d )
     412
    412413       ENDIF
    413414
     
    416417!--    z-direction
    417418       !$OMP PARALLEL DO
     419       !$acc kernels present( d, tend )
     420       !$acc loop
    418421       DO  i = nxl, nxr
    419422          DO  j = nys, nyn
     423             !$acc loop vector( 32 )
    420424             DO  k = nzb+1, nzt
    421425                tend(k,j,i) = d(k,j,i)
     
    423427          ENDDO
    424428       ENDDO
     429       !$acc end kernels
    425430
    426431!
     
    432437!--       Neumann (dp/dz = 0)
    433438          !$OMP PARALLEL DO
     439          !$acc kernels present( nzb_s_inner, tend )
    434440          DO  i = nxlg, nxrg
    435441             DO  j = nysg, nyng
     
    437443             ENDDO
    438444          ENDDO
     445          !$acc end kernels
    439446
    440447       ELSE
     
    442449!--       Dirichlet
    443450          !$OMP PARALLEL DO
     451          !$acc kernels present( tend )
    444452          DO  i = nxlg, nxrg
    445453             DO  j = nysg, nyng
     
    447455             ENDDO
    448456          ENDDO
     457          !$acc end kernels
    449458
    450459       ENDIF
     
    456465!--       Neumann
    457466          !$OMP PARALLEL DO
     467          !$acc kernels present( tend )
    458468          DO  i = nxlg, nxrg
    459469             DO  j = nysg, nyng
     
    461471             ENDDO
    462472          ENDDO
     473          !$acc end kernels
    463474
    464475       ELSE
     
    466477!--       Dirichlet
    467478          !$OMP PARALLEL DO
     479          !$acc kernels present( tend )
    468480          DO  i = nxlg, nxrg
    469481             DO  j = nysg, nyng
     
    471483             ENDDO
    472484          ENDDO
     485          !$acc end kernels
    473486
    474487       ENDIF
     
    476489!
    477490!--    Exchange boundaries for p
     491       IF ( numprocs == 1 )  THEN    ! workaround for single-core GPU runs
     492          on_device = .TRUE.         ! to be removed after complete porting
     493       ELSE                          ! of ghost point exchange
     494          !$acc update host( tend )
     495       ENDIF
    478496       CALL exchange_horiz( tend, nbgp )
     497       IF ( numprocs == 1 )  THEN    ! workaround for single-core GPU runs
     498          on_device = .FALSE.        ! to be removed after complete porting
     499       ELSE                          ! of ghost point exchange
     500          !$acc update device( tend )
     501       ENDIF
    479502     
    480503    ELSEIF ( psolver == 'sor' )  THEN
     
    531554       !$OMP PARALLEL PRIVATE (i,j,k)
    532555       !$OMP DO
     556       !$acc kernels present( p, tend, weight_substep )
     557       !$acc loop
    533558       DO  i = nxl-1, nxr+1
    534559          DO  j = nys-1, nyn+1
     560             !$acc loop vector( 32 )
    535561             DO  k = nzb, nzt+1
    536562                p(k,j,i) = tend(k,j,i) * &
     
    539565          ENDDO
    540566       ENDDO
     567       !$acc end kernels
    541568       !$OMP END PARALLEL
    542569
     
    544571       !$OMP PARALLEL PRIVATE (i,j,k)
    545572       !$OMP DO
     573       !$acc kernels present( p, tend, weight_substep )
     574       !$acc loop
    546575       DO  i = nxl-1, nxr+1
    547576          DO  j = nys-1, nyn+1
     577             !$acc loop vector( 32 )
    548578             DO  k = nzb, nzt+1
    549579                p(k,j,i) = p(k,j,i) + tend(k,j,i) * &
     
    552582          ENDDO
    553583       ENDDO
     584       !$acc end kernels
    554585       !$OMP END PARALLEL
    555586
     
    571602    !$OMP PARALLEL PRIVATE (i,j,k)
    572603    !$OMP DO
     604    !$acc kernels present( ddzu, nzb_u_inner, nzb_v_inner, nzb_w_inner, tend, u, v, w, weight_pres )
     605    !$acc loop
    573606    DO  i = nxl, nxr   
    574607       DO  j = nys, nyn
    575           DO  k = nzb_w_inner(j,i)+1, nzt
    576              w(k,j,i) = w(k,j,i) - dt_3d *                                 &
    577                         ( tend(k+1,j,i) - tend(k,j,i) ) * ddzu(k+1) *      &
    578                         weight_pres(intermediate_timestep_count)
    579           ENDDO
    580           DO  k = nzb_u_inner(j,i)+1, nzt
    581              u(k,j,i) = u(k,j,i) - dt_3d *                                 &
    582                         ( tend(k,j,i) - tend(k,j,i-1) ) * ddx *            &
    583                         weight_pres(intermediate_timestep_count)
    584           ENDDO
    585           DO  k = nzb_v_inner(j,i)+1, nzt
    586              v(k,j,i) = v(k,j,i) - dt_3d *                                 &
    587                         ( tend(k,j,i) - tend(k,j-1,i) ) * ddy *            &
    588                         weight_pres(intermediate_timestep_count)
     608          !$acc loop vector( 32 )
     609          DO  k = 1, nzt
     610             IF ( k > nzb_w_inner(j,i) )  THEN
     611                w(k,j,i) = w(k,j,i) - dt_3d *                                 &
     612                           ( tend(k+1,j,i) - tend(k,j,i) ) * ddzu(k+1) *      &
     613                           weight_pres(intermediate_timestep_count)
     614             ENDIF
     615          ENDDO
     616          !$acc loop vector( 32 )
     617          DO  k = 1, nzt
     618             IF ( k > nzb_u_inner(j,i) )  THEN
     619                u(k,j,i) = u(k,j,i) - dt_3d *                                 &
     620                           ( tend(k,j,i) - tend(k,j,i-1) ) * ddx *            &
     621                           weight_pres(intermediate_timestep_count)
     622             ENDIF
     623          ENDDO
     624          !$acc loop vector( 32 )
     625          DO  k = 1, nzt
     626             IF ( k > nzb_v_inner(j,i) )  THEN
     627                v(k,j,i) = v(k,j,i) - dt_3d *                                 &
     628                           ( tend(k,j,i) - tend(k,j-1,i) ) * ddy *            &
     629                           weight_pres(intermediate_timestep_count)
     630             ENDIF
    589631          ENDDO                                                         
    590 !
    591 !--       Sum up the volume flow through the right and north boundary
    592           IF ( conserve_volume_flow  .AND.  bc_lr_cyc  .AND.  bc_ns_cyc  .AND. &
    593                i == nx )  THEN
    594              !$OMP CRITICAL
    595              DO  k = nzb_2d(j,i) + 1, nzt
    596                 volume_flow_l(1) = volume_flow_l(1) + u(k,j,i) * dzw(k)
    597              ENDDO
    598              !$OMP END CRITICAL
    599           ENDIF
    600           IF ( conserve_volume_flow  .AND.  bc_ns_cyc  .AND.  bc_lr_cyc  .AND. &
    601                j == ny )  THEN
    602              !$OMP CRITICAL
    603              DO  k = nzb_2d(j,i) + 1, nzt
    604                 volume_flow_l(2) = volume_flow_l(2) + v(k,j,i) * dzw(k)
    605              ENDDO
    606              !$OMP END CRITICAL
    607           ENDIF
    608632
    609633       ENDDO
    610634    ENDDO
     635    !$acc end kernels
    611636    !$OMP END PARALLEL
     637
     638!
     639!-- Sum up the volume flow through the right and north boundary
     640    IF ( conserve_volume_flow  .AND.  bc_lr_cyc  .AND.  bc_ns_cyc  .AND.  &
     641         nxr == nx )  THEN
     642
     643       !$OMP PARALLEL PRIVATE (j,k)
     644       !$OMP DO
     645       DO  j = nys, nyn
     646          !$OMP CRITICAL
     647          DO  k = nzb_2d(j,nx) + 1, nzt
     648             volume_flow_l(1) = volume_flow_l(1) + u(k,j,nx) * dzw(k)
     649          ENDDO
     650          !$OMP END CRITICAL
     651       ENDDO
     652       !$OMP END PARALLEL
     653
     654    ENDIF
     655
     656    IF ( conserve_volume_flow  .AND.  bc_ns_cyc  .AND.  bc_lr_cyc  .AND.  &
     657         nyn == ny )  THEN
     658
     659       !$OMP PARALLEL PRIVATE (i,k)
     660       !$OMP DO
     661       DO  i = nxl, nxr
     662          !$OMP CRITICAL
     663          DO  k = nzb_2d(ny,i) + 1, nzt
     664             volume_flow_l(2) = volume_flow_l(2) + v(k,ny,i) * dzw(k)
     665           ENDDO
     666          !$OMP END CRITICAL
     667       ENDDO
     668       !$OMP END PARALLEL
     669
     670    ENDIF
    612671   
    613672!
     
    645704!
    646705!-- Exchange of boundaries for the velocities
     706    IF ( numprocs == 1 )  THEN    ! workaround for single-core GPU runs
     707       on_device = .TRUE.         ! to be removed after complete porting
     708    ELSE                          ! of ghost point exchange
     709       !$acc update host( u, v, w )
     710    ENDIF
    647711    CALL exchange_horiz( u, nbgp )
    648712    CALL exchange_horiz( v, nbgp )
    649713    CALL exchange_horiz( w, nbgp )
     714    IF ( numprocs == 1 )  THEN    ! workaround for single-core GPU runs
     715       on_device = .FALSE.        ! to be removed after complete porting
     716    ELSE                          ! of ghost point exchange
     717       !$acc update device( u, v, w )
     718    ENDIF
    650719
    651720!
     
    679748    ENDDO
    680749#else
     750    !$acc kernels present( d, ddzw, nzb_s_inner, u, v, w )
     751    !$acc loop
    681752    DO  i = nxl, nxr
    682753       DO  j = nys, nyn
     754          !$acc loop vector( 32 )
     755          DO  k = 1, nzt
     756             IF ( k > nzb_s_inner(j,i) )  THEN
     757                d(k,j,i) = ( u(k,j,i+1) - u(k,j,i) ) * ddx + &
     758                           ( v(k,j+1,i) - v(k,j,i) ) * ddy + &
     759                           ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
     760             ENDIF
     761          ENDDO
     762       ENDDO
     763    ENDDO
     764    !$acc end kernels
     765!
     766!-- Compute possible PE-sum of divergences for flow_statistics
     767    !$OMP PARALLEL PRIVATE (i,j,k) FIRSTPRIVATE(threadsum) REDUCTION(+:localsum)
     768    !$OMP DO SCHEDULE( STATIC )
     769    DO  i = nxl, nxr
     770       DO  j = nys, nyn
    683771          DO  k = nzb_s_inner(j,i)+1, nzt
    684              d(k,j,i) = ( u(k,j,i+1) - u(k,j,i) ) * ddx + &
    685                         ( v(k,j+1,i) - v(k,j,i) ) * ddy + &
    686                         ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
    687772             threadsum = threadsum + ABS( d(k,j,i) )
    688773          ENDDO
     
    701786    CALL cpu_log( log_point_s(1), 'divergence', 'stop' )
    702787
    703     !$acc update device( u, v, w )
    704 
    705788    CALL cpu_log( log_point(8), 'pres', 'stop' )
    706    
    707789
    708790
Note: See TracChangeset for help on using the changeset viewer.