!==================================================================== ! subroutine y_intp_cf_vc & (f,d0f,orderi,orderb, & biL, biR, bjL, bjR, bkL, bkR, & fiL, fiR, fjL, fjR, fkL, fkR, & iiL, iiR, ijL, ijR, ikL, ikR, & dfiL,dfiR,dfjL,dfjR,dfkL,dfkR, & iperx,ipery,iperz,ierror,error) ! include 'der0_1D_cf_vc_include.h' ! call der0_1D_cf_vc_pre( ierror, error, & xbegin,xend,ybegin,yend,zbegin,zend, & bnd4A, bnd6A, bnd8A, bnd6B, bnd8B, bnd8C, & iperx,ipery,iperz, orderi, orderb, & biL, biR, bjL, bjR, bkL, bkR, & fiL, fiR, fjL, fjR, fkL, fkR, & iiL, iiR, ijL, ijR, ikL, ikR, & piL, piR, pjL, pjR, pkL, pkR, & dfiL,dfiR,dfjL,dfjR,dfkL,dfkR, & nproLx,nproRx,nproLy,nproRy,nproLz,nproRz, & proL,proR,promax, width) ! if( width .gt. pjR-pjL+1) then ierror = -100 error = 'DER_0_1D: Stencil is wider than the f domain' return endif ! ! Zero-out interpolant ! do k = ikL, ikR do j = ijL, ijR-1 do i = iiL, iiR d0f(i,j,k) = 0.0 end do end do end do ! !======================================================================== ! CENTERED DIFFERENCE OPERATORS ! !----------------------------- ! 2nd-order explicit: (2-2E-2) ! if ( orderi .eq. 2 ) then ! ae = 1.d0/ 2.d0 ! ! Internal nodes: ! do k = ikL, ikR do j = ybegin, yend do i = iiL, iiR d0f(i,j,k) = ae *( f(i,j+1,k)+f(i,j-0,k) ) end do end do end do ! end if ! !----------------------------- ! 4th order explicit: (4-4E-4) ! ! if ( orderi .eq. 4 ) then ae = 9.d0/16.d0 be = -1.d0/16.d0 ! ! Internal nodes: ! do k = ikL, ikR do j = ybegin, yend do i = iiL, iiR d0f(i,j,k) = ae *( f(i,j+1,k)+f(i,j-0,k) ) & + be *( f(i,j+2,k)+f(i,j-1,k) ) end do end do end do ! ! Boundary nodes: ! if( orderb .eq. 4 ) then ! ! Left side ! if ( nproLy .eq. 1 ) then do k = ikL, ikR do i = iiL, iiR d0f(i,ybegin-1,k) = (bnd4A(1)*f(i,ybegin-1,k) + & bnd4A(2)*f(i,ybegin+0,k) + & bnd4A(3)*f(i,ybegin+1,k) + & bnd4A(4)*f(i,ybegin+2,k)) end do end do end if ! ! Right side: ! if ( nproRy .eq. 1 ) then do k = ikL, ikR do i = iiL, iiR d0f(i,yend+1,k) = (bnd4A(1)*f(i,yend+2,k) + & bnd4A(2)*f(i,yend+1,k) + & bnd4A(3)*f(i,yend+0,k) + & bnd4A(4)*f(i,yend-1,k)) end do end do end if ! end if end if ! !----------------------------- ! 6th order explicit: (6,6-6E-6,6) ! if ( orderi .eq. 6 ) then ! ae = 150.d0/256.d0 be = -25.d0/256.d0 ce = 3.d0/256.d0 ! ! Internal nodes: ! do k = ikL, ikR do j = ybegin, yend do i = iiL, iiR d0f(i,j,k) = ae *( f(i,j+1,k)+f(i,j-0,k) ) & + be *( f(i,j+2,k)+f(i,j-1,k) ) & + ce *( f(i,j+3,k)+f(i,j-2,k) ) end do end do end do ! ! Boundary nodes: ! if( orderb .eq. 6 ) then ! ! Left side: ! if ( nproLy .ge. 1 ) then do k = ikL, ikR do i = iiL, iiR d0f(i,ybegin-1,k) = (bnd6B(1)*f(i,ybegin-2,k) + & bnd6B(2)*f(i,ybegin-1,k) + & bnd6B(3)*f(i,ybegin+0,k) + & bnd6B(4)*f(i,ybegin+1,k) + & bnd6B(5)*f(i,ybegin+2,k) + & bnd6B(6)*f(i,ybegin+3,k)) end do end do end if ! if ( nproLy .eq. 2 ) then do k = ikL, ikR do i = iiL, iiR d0f(i,ybegin-2,k) = (bnd6A(1)*f(i,ybegin-2,k) + & bnd6A(2)*f(i,ybegin-1,k) + & bnd6A(3)*f(i,ybegin+0,k) + & bnd6A(4)*f(i,ybegin+1,k) + & bnd6A(5)*f(i,ybegin+2,k) + & bnd6A(6)*f(i,ybegin+3,k)) end do end do end if ! ! Right side: ! if ( nproRy .ge. 1 ) then do k = ikL, ikR do i = iiL, iiR d0f(i,yend+1,k) = (bnd6B(1)*f(i,yend+3,k) + & bnd6B(2)*f(i,yend+2,k) + & bnd6B(3)*f(i,yend+1,k) + & bnd6B(4)*f(i,yend+0,k) + & bnd6B(5)*f(i,yend-1,k) + & bnd6B(6)*f(i,yend-2,k)) end do end do end if ! if ( nproRy .eq. 2 ) then do k = ikL, ikR do i = iiL, iiR d0f(i,yend+2,k) = (bnd6A(1)*f(i,yend+3,k) + & bnd6A(2)*f(i,yend+2,k) + & bnd6A(3)*f(i,yend+1,k) + & bnd6A(4)*f(i,yend+0,k) + & bnd6A(5)*f(i,yend-1,k) + & bnd6A(6)*f(i,yend-2,k)) end do end do end if ! end if end if ! !----------------------------- ! 8th order explicit: (8,8,8-8E-8,8,8) ! if ( orderi .eq. 8 ) then ! ae = +1225.d0/2048.d0 be = - 245.d0/2048.d0 ce = + 49.d0/2048.d0 de = - 5.d0/2048.d0 ! ! Internal nodes: ! do k = ikL, ikR do j = ybegin, yend do i = iiL, iiR d0f(i,j,k) = ae *( f(i,j+1,k)+f(i,j-0,k) ) & + be *( f(i,j+2,k)+f(i,j-1,k) ) & + ce *( f(i,j+3,k)+f(i,j-2,k) ) & + de *( f(i,j+4,k)+f(i,j-3,k) ) end do end do end do ! ! Boundary nodes: ! if( orderb .eq. 8 ) then ! ! Left side: ! if ( nproLy .ge. 1 ) then do k = ikL, ikR do i = iiL, iiR d0f(i,ybegin-1,k) = (bnd8C(1)*f(i,ybegin-3,k) + & bnd8C(2)*f(i,ybegin-2,k) + & bnd8C(3)*f(i,ybegin-1,k) + & bnd8C(4)*f(i,ybegin+0,k) + & bnd8C(5)*f(i,ybegin+1,k) + & bnd8C(6)*f(i,ybegin+2,k) + & bnd8C(7)*f(i,ybegin+3,k) + & bnd8C(8)*f(i,ybegin+4,k)) end do end do end if ! if ( nproLy .ge. 2 ) then do k = ikL, ikR do i = iiL, iiR d0f(i,ybegin-2,k) = (bnd8B(1)*f(i,ybegin-3,k) + & bnd8B(2)*f(i,ybegin-2,k) + & bnd8B(3)*f(i,ybegin-1,k) + & bnd8B(4)*f(i,ybegin+0,k) + & bnd8B(5)*f(i,ybegin+1,k) + & bnd8B(6)*f(i,ybegin+2,k) + & bnd8B(7)*f(i,ybegin+3,k) + & bnd8B(8)*f(i,ybegin+4,k)) end do end do end if ! if ( nproLy .eq. 3 ) then do k = ikL, ikR do i = iiL, iiR d0f(i,ybegin-3,k) = (bnd8A(1)*f(i,ybegin-3,k) + & bnd8A(2)*f(i,ybegin-2,k) + & bnd8A(3)*f(i,ybegin-1,k) + & bnd8A(4)*f(i,ybegin+0,k) + & bnd8A(5)*f(i,ybegin+1,k) + & bnd8A(6)*f(i,ybegin+2,k) + & bnd8A(7)*f(i,ybegin+3,k) + & bnd8A(8)*f(i,ybegin+4,k)) end do end do end if ! ! Right side: ! if ( nproRy .ge. 1 ) then do k = ikL, ikR do i = iiL, iiR d0f(i,yend+1,k) = (bnd8C(1)*f(i,yend+4,k) + & bnd8C(2)*f(i,yend+3,k) + & bnd8C(3)*f(i,yend+2,k) + & bnd8C(4)*f(i,yend+1,k) + & bnd8C(5)*f(i,yend+0,k) + & bnd8C(6)*f(i,yend-1,k) + & bnd8C(7)*f(i,yend-2,k) + & bnd8C(8)*f(i,yend-3,k)) end do end do end if ! if ( nproRy .ge. 2 ) then do k = ikL, ikR do i = iiL, iiR d0f(i,yend+2,k) = (bnd8B(1)*f(i,yend+4,k) + & bnd8B(2)*f(i,yend+3,k) + & bnd8B(3)*f(i,yend+2,k) + & bnd8B(4)*f(i,yend+1,k) + & bnd8B(5)*f(i,yend+0,k) + & bnd8B(6)*f(i,yend-1,k) + & bnd8B(7)*f(i,yend-2,k) + & bnd8B(8)*f(i,yend-3,k)) end do end do end if ! if ( nproRy .eq. 3 ) then do k = ikL, ikR do i = iiL, iiR d0f(i,yend+3,k) = (bnd8A(1)*f(i,yend+4,k) + & bnd8A(2)*f(i,yend+3,k) + & bnd8A(3)*f(i,yend+2,k) + & bnd8A(4)*f(i,yend+1,k) + & bnd8A(5)*f(i,yend+0,k) + & bnd8A(6)*f(i,yend-1,k) + & bnd8A(7)*f(i,yend-2,k) + & bnd8A(8)*f(i,yend-3,k)) end do end do end if ! end if end if ! ! End Centered Difference Operators ! return end !====================================================================