! *** generated by SAPFOR with version 2412 and build date: Apr 29 2025 22:44:14 ! *** Enabled options ***: ! *** maximum shadow width is 50 percent ! *** generated by SAPFOR !--------------------------------------------------------------------- !--------------------------------------------------------------------- subroutine compute_rhs_bt () include 'header3d_bt.h' integer :: i,j,k,m double precision :: rho_inv,uijk,up1,um1,vijk,vp1,vm1,wijk,wp1,wm &1,rhs_(5) !$SPF PARALLEL_REG r0 ! DVM$ PARALLEL (K,J,I) ON US(I,J,K), SHADOW_COMPUTE ,PRIVATE (RHO_INV,M) ! DVM$&,CUDA_BLOCK (128) ! DVM$ REGION OUT (RHO_I,US,VS,WS,QS,SQUARE) do k = 0,problem_size - 1 do j = 0,problem_size - 1 do i = 0,problem_size - 1 rho_inv = 1.0d0 / u(1,i,j,k) rho_i(i,j,k) = rho_inv us(i,j,k) = u(2,i,j,k) * rho_inv vs(i,j,k) = u(3,i,j,k) * rho_inv ws(i,j,k) = u(4,i,j,k) * rho_inv square(i,j,k) = 0.5d0 * (u(2,i,j,k) * u(2,i,j,k) + u(3,i, &j,k) * u(3,i,j,k) + u(4,i,j,k) * u(4,i,j,k)) * rho_inv qs(i,j,k) = square(i,j,k) * rho_inv do m = 1,5 rhs(m,i,j,k) = forcing(m,i,j,k) enddo enddo enddo enddo !$SPF ANALYSIS(PRIVATE(rhs_)) ! DVM$ PARALLEL (K,J,I) ON RHS(*,I,J,K), PRIVATE (UIJK,UP1,UM1,M,VIJK,VP1 ! DVM$&,VM1,WIJK,WP1,WM1,RHS_),CUDA_BLOCK (32) !--------------------------------------------------------------------- ! compute xi-direction fluxes !--------------------------------------------------------------------- do k = 1,problem_size - 2 do j = 1,problem_size - 2 do i = 1,problem_size - 2 uijk = us(i,j,k) up1 = us(i + 1,j,k) um1 = us(i - 1,j,k) rhs_(1) = forcing(1,i,j,k) rhs_(2) = forcing(2,i,j,k) rhs_(3) = forcing(3,i,j,k) rhs_(4) = forcing(4,i,j,k) rhs_(5) = forcing(5,i,j,k) rhs_(1) = rhs_(1) + dx1tx1 * (u(1,i + 1,j,k) - 2.0d0 * u( &1,i,j,k) + u(1,i - 1,j,k)) - tx2 * (u(2,i + 1,j,k) - u(2,i - 1,j,k &)) rhs_(2) = rhs_(2) + dx2tx1 * (u(2,i + 1,j,k) - 2.0d0 * u( &2,i,j,k) + u(2,i - 1,j,k)) + xxcon2 * con43 * (up1 - 2.0d0 * uijk &+ um1) - tx2 * (u(2,i + 1,j,k) * up1 - u(2,i - 1,j,k) * um1 + (u(5 &,i + 1,j,k) - square(i + 1,j,k) - u(5,i - 1,j,k) + square(i - 1,j, &k)) * c2) rhs_(3) = rhs_(3) + dx3tx1 * (u(3,i + 1,j,k) - 2.0d0 * u( &3,i,j,k) + u(3,i - 1,j,k)) + xxcon2 * (vs(i + 1,j,k) - 2.0d0 * vs( &i,j,k) + vs(i - 1,j,k)) - tx2 * (u(3,i + 1,j,k) * up1 - u(3,i - 1, &j,k) * um1) rhs_(4) = rhs_(4) + dx4tx1 * (u(4,i + 1,j,k) - 2.0d0 * u( &4,i,j,k) + u(4,i - 1,j,k)) + xxcon2 * (ws(i + 1,j,k) - 2.0d0 * ws( &i,j,k) + ws(i - 1,j,k)) - tx2 * (u(4,i + 1,j,k) * up1 - u(4,i - 1, &j,k) * um1) rhs_(5) = rhs_(5) + dx5tx1 * (u(5,i + 1,j,k) - 2.0d0 * u( &5,i,j,k) + u(5,i - 1,j,k)) + xxcon3 * (qs(i + 1,j,k) - 2.0d0 * qs( &i,j,k) + qs(i - 1,j,k)) + xxcon4 * (up1 * up1 - 2.0d0 * uijk * uij &k + um1 * um1) + xxcon5 * (u(5,i + 1,j,k) * rho_i(i + 1,j,k) - 2.0 &d0 * u(5,i,j,k) * rho_i(i,j,k) + u(5,i - 1,j,k) * rho_i(i - 1,j,k) &) - tx2 * ((c1 * u(5,i + 1,j,k) - c2 * square(i + 1,j,k)) * up1 - &(c1 * u(5,i - 1,j,k) - c2 * square(i - 1,j,k)) * um1) if (i .eq. 1) then do m = 1,5 rhs_(m) = rhs_(m) - dssp * (5.0d0 * u(m,i,j,k) - 4. &0d0 * u(m,i + 1,j,k) + u(m,i + 2,j,k)) enddo else if (i .eq. 2) then do m = 1,5 rhs_(m) = rhs_(m) - dssp * ((-(4.0d0)) * u(m,i - 1, &j,k) + 6.0d0 * u(m,i,j,k) - 4.0d0 * u(m,i + 1,j,k) + u(m,i + 2,j,k &)) enddo else if (i .ge. 3 .and. i .le. problem_size - 4) then do m = 1,5 rhs_(m) = rhs_(m) - dssp * (u(m,i - 2,j,k) - 4.0d0 &* u(m,i - 1,j,k) + 6.0 * u(m,i,j,k) - 4.0d0 * u(m,i + 1,j,k) + u(m &,i + 2,j,k)) enddo else if (i .eq. problem_size - 3) then do m = 1,5 rhs_(m) = rhs_(m) - dssp * (u(m,i - 2,j,k) - 4.0d0 &* u(m,i - 1,j,k) + 6.0d0 * u(m,i,j,k) - 4.0d0 * u(m,i + 1,j,k)) enddo else if (i .eq. problem_size - 2) then do m = 1,5 rhs_(m) = rhs_(m) - dssp * (u(m,i - 2,j,k) - 4.d0 * & u(m,i - 1,j,k) + 5.d0 * u(m,i,j,k)) enddo endif vijk = vs(i,j,k) vp1 = vs(i,j + 1,k) vm1 = vs(i,j - 1,k) rhs_(1) = rhs_(1) + dy1ty1 * (u(1,i,j + 1,k) - 2.0d0 * u( &1,i,j,k) + u(1,i,j - 1,k)) - ty2 * (u(3,i,j + 1,k) - u(3,i,j - 1,k &)) rhs_(2) = rhs_(2) + dy2ty1 * (u(2,i,j + 1,k) - 2.0d0 * u( &2,i,j,k) + u(2,i,j - 1,k)) + yycon2 * (us(i,j + 1,k) - 2.0d0 * us( &i,j,k) + us(i,j - 1,k)) - ty2 * (u(2,i,j + 1,k) * vp1 - u(2,i,j - &1,k) * vm1) rhs_(3) = rhs_(3) + dy3ty1 * (u(3,i,j + 1,k) - 2.0d0 * u( &3,i,j,k) + u(3,i,j - 1,k)) + yycon2 * con43 * (vp1 - 2.0d0 * vijk &+ vm1) - ty2 * (u(3,i,j + 1,k) * vp1 - u(3,i,j - 1,k) * vm1 + (u(5 &,i,j + 1,k) - square(i,j + 1,k) - u(5,i,j - 1,k) + square(i,j - 1, &k)) * c2) rhs_(4) = rhs_(4) + dy4ty1 * (u(4,i,j + 1,k) - 2.0d0 * u( &4,i,j,k) + u(4,i,j - 1,k)) + yycon2 * (ws(i,j + 1,k) - 2.0d0 * ws( &i,j,k) + ws(i,j - 1,k)) - ty2 * (u(4,i,j + 1,k) * vp1 - u(4,i,j - &1,k) * vm1) rhs_(5) = rhs_(5) + dy5ty1 * (u(5,i,j + 1,k) - 2.0d0 * u( &5,i,j,k) + u(5,i,j - 1,k)) + yycon3 * (qs(i,j + 1,k) - 2.0d0 * qs( &i,j,k) + qs(i,j - 1,k)) + yycon4 * (vp1 * vp1 - 2.0d0 * vijk * vij &k + vm1 * vm1) + yycon5 * (u(5,i,j + 1,k) * rho_i(i,j + 1,k) - 2.0 &d0 * u(5,i,j,k) * rho_i(i,j,k) + u(5,i,j - 1,k) * rho_i(i,j - 1,k) &) - ty2 * ((c1 * u(5,i,j + 1,k) - c2 * square(i,j + 1,k)) * vp1 - &(c1 * u(5,i,j - 1,k) - c2 * square(i,j - 1,k)) * vm1) if (j .eq. 1) then do m = 1,5 rhs_(m) = rhs_(m) - dssp * (5.0d0 * u(m,i,j,k) - 4. &0d0 * u(m,i,j + 1,k) + u(m,i,j + 2,k)) enddo else if (j .eq. 2) then do m = 1,5 rhs_(m) = rhs_(m) - dssp * ((-(4.0d0)) * u(m,i,j - &1,k) + 6.0d0 * u(m,i,j,k) - 4.0d0 * u(m,i,j + 1,k) + u(m,i,j + 2,k &)) enddo else if (j .ge. 3 .and. j .le. problem_size - 4) then do m = 1,5 rhs_(m) = rhs_(m) - dssp * (u(m,i,j - 2,k) - 4.0d0 &* u(m,i,j - 1,k) + 6.0 * u(m,i,j,k) - 4.0d0 * u(m,i,j + 1,k) + u(m &,i,j + 2,k)) enddo else if (j .eq. problem_size - 3) then do m = 1,5 rhs_(m) = rhs_(m) - dssp * (u(m,i,j - 2,k) - 4.0d0 &* u(m,i,j - 1,k) + 6.0d0 * u(m,i,j,k) - 4.0d0 * u(m,i,j + 1,k)) enddo else if (j .eq. problem_size - 2) then do m = 1,5 rhs_(m) = rhs_(m) - dssp * (u(m,i,j - 2,k) - 4.d0 * & u(m,i,j - 1,k) + 5.d0 * u(m,i,j,k)) enddo endif wijk = ws(i,j,k) wp1 = ws(i,j,k + 1) wm1 = ws(i,j,k - 1) rhs_(1) = rhs_(1) + dz1tz1 * (u(1,i,j,k + 1) - 2.0d0 * u( &1,i,j,k) + u(1,i,j,k - 1)) - tz2 * (u(4,i,j,k + 1) - u(4,i,j,k - 1 &)) rhs_(2) = rhs_(2) + dz2tz1 * (u(2,i,j,k + 1) - 2.0d0 * u( &2,i,j,k) + u(2,i,j,k - 1)) + zzcon2 * (us(i,j,k + 1) - 2.0d0 * us( &i,j,k) + us(i,j,k - 1)) - tz2 * (u(2,i,j,k + 1) * wp1 - u(2,i,j,k &- 1) * wm1) rhs_(3) = rhs_(3) + dz3tz1 * (u(3,i,j,k + 1) - 2.0d0 * u( &3,i,j,k) + u(3,i,j,k - 1)) + zzcon2 * (vs(i,j,k + 1) - 2.0d0 * vs( &i,j,k) + vs(i,j,k - 1)) - tz2 * (u(3,i,j,k + 1) * wp1 - u(3,i,j,k &- 1) * wm1) rhs_(4) = rhs_(4) + dz4tz1 * (u(4,i,j,k + 1) - 2.0d0 * u( &4,i,j,k) + u(4,i,j,k - 1)) + zzcon2 * con43 * (wp1 - 2.0d0 * wijk &+ wm1) - tz2 * (u(4,i,j,k + 1) * wp1 - u(4,i,j,k - 1) * wm1 + (u(5 &,i,j,k + 1) - square(i,j,k + 1) - u(5,i,j,k - 1) + square(i,j,k - &1)) * c2) rhs_(5) = rhs_(5) + dz5tz1 * (u(5,i,j,k + 1) - 2.0d0 * u( &5,i,j,k) + u(5,i,j,k - 1)) + zzcon3 * (qs(i,j,k + 1) - 2.0d0 * qs( &i,j,k) + qs(i,j,k - 1)) + zzcon4 * (wp1 * wp1 - 2.0d0 * wijk * wij &k + wm1 * wm1) + zzcon5 * (u(5,i,j,k + 1) * rho_i(i,j,k + 1) - 2.0 &d0 * u(5,i,j,k) * rho_i(i,j,k) + u(5,i,j,k - 1) * rho_i(i,j,k - 1) &) - tz2 * ((c1 * u(5,i,j,k + 1) - c2 * square(i,j,k + 1)) * wp1 - &(c1 * u(5,i,j,k - 1) - c2 * square(i,j,k - 1)) * wm1) if (k .eq. 1) then do m = 1,5 rhs_(m) = rhs_(m) - dssp * (5.0d0 * u(m,i,j,k) - 4. &0d0 * u(m,i,j,k + 1) + u(m,i,j,k + 2)) enddo else if (k .eq. 2) then do m = 1,5 rhs_(m) = rhs_(m) - dssp * ((-(4.0d0)) * u(m,i,j,k &- 1) + 6.0d0 * u(m,i,j,k) - 4.0d0 * u(m,i,j,k + 1) + u(m,i,j,k + 2 &)) enddo else if (k .ge. 3 .and. k .le. problem_size - 4) then do m = 1,5 rhs_(m) = rhs_(m) - dssp * (u(m,i,j,k - 2) - 4.0d0 &* u(m,i,j,k - 1) + 6.0 * u(m,i,j,k) - 4.0d0 * u(m,i,j,k + 1) + u(m &,i,j,k + 2)) enddo else if (k .eq. problem_size - 3) then do m = 1,5 rhs_(m) = rhs_(m) - dssp * (u(m,i,j,k - 2) - 4.0d0 &* u(m,i,j,k - 1) + 6.0d0 * u(m,i,j,k) - 4.0d0 * u(m,i,j,k + 1)) enddo else if (k .eq. problem_size - 2) then do m = 1,5 rhs_(m) = rhs_(m) - dssp * (u(m,i,j,k - 2) - 4.d0 * & u(m,i,j,k - 1) + 5.d0 * u(m,i,j,k)) enddo endif rhs(1,i,j,k) = rhs_(1) * dt rhs(2,i,j,k) = rhs_(2) * dt rhs(3,i,j,k) = rhs_(3) * dt rhs(4,i,j,k) = rhs_(4) * dt rhs(5,i,j,k) = rhs_(5) * dt enddo enddo enddo !$SPF END PARALLEL_REG ! DVM$ END REGION return end