!==================================================================== ! subroutine xy_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, & corner) ! include 'der0_2D_cf_vc_include.h' ! call der0_2D_cf_vc_pre( ierror, error, & xbegin,xend,ybegin,yend,zbegin,zend, & bnd4AA, bnd4AB, bnd4I, & bnd6AA, bnd6AB, bnd6AC, bnd6BB, bnd6BC, bnd6I, & bnd8AA, bnd8AB, bnd8AC, bnd8AD, bnd8BB, bnd8BC, & bnd8BD, bnd8CC, bnd8CD, bnd8I, bnd10I, & 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. (piR-piL+1)) .or. (width .gt. (pjR-pjL+1))) then ierror = -100 error = 'DER_0_2D: 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-1 d0f(i,j,k) = 0.0 end do end do end do ! ! Written by Chris Kennedy in Feb. 2002 (Initial draft) ! !======================================================================== ! CENTERED DIFFERENCE OPERATORS ! !----------------------------- ! 2nd-order explicit: (2-2E-2) ! if ( orderi .eq. 2 ) then ! a1 = 1.d0/ 4.d0 ! ! Internal nodes: ! do k = ikL, ikR do j = ybegin, yend do i = xbegin, xend d0f(i,j,k) = a1 *( f(i+0,j+1,k)+f(i+1,j+1,k) & + f(i+0,j+0,k)+f(i+1,j+0,k) ) end do end do end do ! end if ! !----------------------------- ! 4th order explicit: (4,4-4E-4,4) ! ! if ( orderi .eq. 4 ) then a1 = 81.d0/256.d0 b1 = -9.d0/256.d0 b2 = +1.d0/256.d0 ! ! Internal nodes: ! do k = ikL, ikR do j = ybegin, yend do i = xbegin, xend d0f(i,j,k) = a1 *( f(i+0,j+1,k)+f(i+1,j+1,k) & + f(i+0,j+0,k)+f(i+1,j+0,k) ) & + b1 *( f(i+2,j+1,k)+f(i+2,j+0,k) & + f(i+1,j+2,k)+f(i+1,j-1,k) & + f(i+0,j+2,k)+f(i+0,j-1,k) & + f(i-1,j+0,k)+f(i-1,j+1,k) ) & + b2 *( f(i+2,j+2,k)+f(i-1,j+2,k) & + f(i+2,j-1,k)+f(i-1,j-1,k) ) end do end do end do ! ! Boundary nodes: ! ! Solve for all 1D-corners (AB) ! ============================= ! if( orderb .eq. 4) then ! ! Left side (y) = South: ! if ( nproLy .eq. 1 ) then j = (ybegin - 1) do k = ikL, ikR do i = xbegin, xend do ii = 1, 4 do jj = 1, 4 iii = i + ii - 2 jjj = j + jj - 1 d0f(i,j,k) = d0f(i,j,k) + bnd4AB(jj,ii)*f(iii,jjj,k) end do end do end do end do end if ! ! Right side (y) = North: ! if ( nproRy .eq. 1 ) then j = (yend + 1) do k = ikL, ikR do i = xbegin, xend do ii = 1, 4 do jj = 1, 4 iii = i + ii - 2 jjj = j - jj + 2 d0f(i,j,k) = d0f(i,j,k) + bnd4AB(jj,ii)*f(iii,jjj,k) end do end do end do end do end if ! ! Left side (x) = West: ! if ( nproLx .eq. 1 ) then i = (xbegin - 1) do k = ikL, ikR do j = ybegin, yend do ii = 1, 4 do jj = 1, 4 iii = i + jj - 1 jjj = j + ii - 2 d0f(i,j,k) = d0f(i,j,k) + bnd4AB(jj,ii)*f(iii,jjj,k) end do end do end do end do end if ! ! Right side (x) = East: ! if ( nproRx .eq. 1 ) then i = (xend + 1) do k = ikL, ikR do j = ybegin, yend do ii = 1, 4 do jj = 1, 4 iii = i - jj + 2 jjj = j + ii - 2 d0f(i,j,k) = d0f(i,j,k) + bnd4AB(jj,ii)*f(iii,jjj,k) end do end do end do end do end if ! if ( .not. corner ) then ! nproLxC = 1 nproLyC = 1 nproRxC = 1 nproRyC = 1 else nproLxC = nproLx nproLyC = nproLy nproRxC = nproRx nproRyC = nproRy ! endif ! ! Solve for all 2D-Corners (AA) ! ============================= ! if ( ( nproLxC .eq. 1 ) .and. ( nproLyC .eq. 1 ) ) then i = (xbegin - 1) j = (ybegin - 1) do k = ikL, ikR do jj = 1, 4 do ii = 1, 4 iii = i + ii - 1 jjj = j + jj - 1 d0f(i,j,k) = d0f(i,j,k) + bnd4AA(ii,jj)*f(iii,jjj,k) end do end do end do end if ! ! Left side (x), Right side (y) = Northwest : ! if ( ( nproLxC .eq. 1 ) .and. ( nproRyC .eq. 1 ) ) then i = (xbegin - 1) j = (yend + 1) do k = ikL, ikR do jj = 1, 4 do ii = 1, 4 iii = i + ii - 1 jjj = j - jj + 2 d0f(i,j,k) = d0f(i,j,k) + bnd4AA(ii,jj)*f(iii,jjj,k) end do end do end do end if ! ! Right side (x), Left side (y) = Southeast : ! if ( ( nproRxC .eq. 1 ) .and. ( nproLyC .eq. 1 ) ) then i = (xend + 1) j = (ybegin - 1) do k = ikL, ikR do ii = 1, 4 do jj = 1, 4 iii = i - ii + 2 jjj = j + jj - 1 d0f(i,j,k) = d0f(i,j,k) + bnd4AA(ii,jj)*f(iii,jjj,k) end do end do end do end if ! ! Right side (x), Right side (y) = Northeast : ! if ( ( nproRxC .eq. 1 ) .and. ( nproRyC .eq. 1 ) ) then i = (xend + 1) j = (yend + 1) do k = ikL, ikR do ii = 1, 4 do jj = 1, 4 iii = i - jj + 2 jjj = j - ii + 2 d0f(i,j,k) = d0f(i,j,k) + bnd4AA(ii,jj)*f(iii,jjj,k) end do end do end do end if ! end orderb end if ! end 4th-order end if ! !----------------------------- ! 6th order explicit: (6,6,6-6E-6,6,6) ! ! if ( orderi .eq. 6 ) then ! a1 = 22500.d0/65536.d0 b1 = -3750.d0/65536.d0 b2 = 625.d0/65536.d0 c1 = 450.d0/65536.d0 c2 = -75.d0/65536.d0 c3 = 9.d0/65536.d0 ! ! Internal nodes: ! do k = ikL, ikR do j = ybegin, yend do i = xbegin, xend d0f(i,j,k) = a1 *( f(i+0,j+1,k)+f(i+1,j+1,k) & + f(i+0,j+0,k)+f(i+1,j+0,k) ) & + b1 *( f(i+2,j+1,k)+f(i+2,j+0,k) & + f(i+1,j+2,k)+f(i+1,j-1,k) & + f(i+0,j+2,k)+f(i+0,j-1,k) & + f(i-1,j+0,k)+f(i-1,j+1,k) ) & + b2 *( f(i+2,j+2,k)+f(i-1,j+2,k) & + f(i+2,j-1,k)+f(i-1,j-1,k) ) & + c1 *( f(i+3,j+1,k)+f(i+3,j+0,k) & + f(i+0,j+3,k)+f(i+1,j-2,k) & + f(i+1,j+3,k)+f(i+0,j-2,k) & + f(i-2,j+1,k)+f(i-2,j+0,k) ) & + c2 *( f(i+3,j+2,k)+f(i+3,j-1,k) & + f(i+2,j+3,k)+f(i+2,j-2,k) & + f(i-1,j+3,k)+f(i-1,j-2,k) & + f(i-2,j+2,k)+f(i-2,j-1,k) ) & + c3 *( f(i+3,j+3,k)+f(i+3,j-2,k) & + f(i-2,j+3,k)+f(i-2,j-2,k) ) end do end do end do ! ! Boundary nodes: ! ! Solve for all 1D-corners (AC, BC) ! ================================= ! if( orderb .eq. 6) then ! ! Left side (y) = South: ! if ( nproLy .eq. 2 ) then j = (ybegin - 2) do k = ikL, ikR do i = xbegin, xend do ii = 1, 6 do jj = 1, 6 iii = i + ii - 3 jjj = j + jj - 1 d0f(i,j,k) = d0f(i,j,k) + bnd6AC(jj,ii)*f(iii,jjj,k) end do end do end do end do end if ! ! Right side (y) = North: ! if ( nproRy .eq. 2 ) then j = (yend + 2) do k = ikL, ikR do i = xbegin, xend do ii = 1, 6 do jj = 1, 6 iii = i + ii - 3 jjj = j - jj + 2 d0f(i,j,k) = d0f(i,j,k) + bnd6AC(jj,ii)*f(iii,jjj,k) end do end do end do end do end if ! ! Left side (x) = West: ! if ( nproLx .eq. 2 ) then i = (xbegin - 2) do k = ikL, ikR do j = ybegin, yend do ii = 1, 6 do jj = 1, 6 iii = i + jj - 1 jjj = j + ii - 3 d0f(i,j,k) = d0f(i,j,k) + bnd6AC(jj,ii)*f(iii,jjj,k) end do end do end do end do end if ! ! Right side (x) = East: ! if ( nproRx .eq. 2 ) then i = (xend + 2) do k = ikL, ikR do j = ybegin, yend do ii = 1, 6 do jj = 1, 6 iii = i - jj + 2 jjj = j + ii - 3 d0f(i,j,k) = d0f(i,j,k) + bnd6AC(jj,ii)*f(iii,jjj,k) end do end do end do end do end if ! ! Left side (y) = South: ! if ( nproLy .ge. 1 ) then j = (ybegin - 1) do k = ikL, ikR do i = xbegin, xend do ii = 1, 6 do jj = 1, 6 iii = i + ii - 3 jjj = j + jj - 2 d0f(i,j,k) = d0f(i,j,k) + bnd6BC(jj,ii)*f(iii,jjj,k) end do end do end do end do end if ! ! Right side (y) = North: ! if ( nproRy .ge. 1 ) then j = (yend + 1) do k = ikL, ikR do i = xbegin, xend do ii = 1, 6 do jj = 1, 6 iii = i + ii - 3 jjj = j - jj + 3 d0f(i,j,k) = d0f(i,j,k) + bnd6BC(jj,ii)*f(iii,jjj,k) end do end do end do end do end if ! ! Left side (x) = West: ! if ( nproLx .ge. 1 ) then i = (xbegin - 1) do k = ikL, ikR do j = ybegin, yend do ii = 1, 6 do jj = 1, 6 iii = i + jj - 2 jjj = j + ii - 3 d0f(i,j,k) = d0f(i,j,k) + bnd6BC(jj,ii)*f(iii,jjj,k) end do end do end do end do end if ! ! Right side (x) = East: ! if ( nproRx .ge. 1 ) then i = (xend + 1) do k = ikL, ikR do j = ybegin, yend do ii = 1, 6 do jj = 1, 6 iii = i - jj + 3 jjj = j + ii - 3 d0f(i,j,k) = d0f(i,j,k) + bnd6BC(jj,ii)*f(iii,jjj,k) end do end do end do end do end if ! if ( .not. corner ) then ! nproLxC = 2 nproLyC = 2 nproRxC = 2 nproRyC = 2 else nproLxC = nproLx nproLyC = nproLy nproRxC = nproRx nproRyC = nproRy ! endif ! ! Solve for all 2D-Corners (AA, AB, BB) ! ===================================== ! if ( ( nproLxC .eq. 2 ) .and. ( nproLyC .eq. 2 ) ) then i = (xbegin - 2) j = (ybegin - 2) do k = ikL, ikR do jj = 1, 6 do ii = 1, 6 iii = i + ii - 1 jjj = j + jj - 1 d0f(i,j,k) = d0f(i,j,k) + bnd6AA(ii,jj)*f(iii,jjj,k) end do end do end do end if ! ! Left side (x), Right side (y) = Northwest : ! if ( ( nproLxC .eq. 2 ) .and. ( nproRyC .eq. 2 ) ) then i = (xbegin - 2) j = (yend + 2) do k = ikL, ikR do jj = 1, 6 do ii = 1, 6 iii = i + ii - 1 jjj = j - jj + 2 d0f(i,j,k) = d0f(i,j,k) + bnd6AA(ii,jj)*f(iii,jjj,k) end do end do end do end if ! ! Right side (x), Left side (y) = Southeast : ! if ( ( nproRxC .eq. 2 ) .and. ( nproLyC .eq. 2 ) ) then i = (xend + 2) j = (ybegin - 2) do k = ikL, ikR do ii = 1, 6 do jj = 1, 6 iii = i - ii + 2 jjj = j + jj - 1 d0f(i,j,k) = d0f(i,j,k) + bnd6AA(ii,jj)*f(iii,jjj,k) end do end do end do end if ! ! Right side (x), Right side (y) = Northeast : ! if ( ( nproRxC .eq. 2 ) .and. ( nproRyC .eq. 2 ) ) then i = (xend + 2) j = (yend + 2) do k = ikL, ikR do ii = 1, 6 do jj = 1, 6 iii = i - jj + 2 jjj = j - ii + 2 d0f(i,j,k) = d0f(i,j,k) + bnd6AA(ii,jj)*f(iii,jjj,k) end do end do end do end if ! ! Left side (x), Left side (y) = Southwest : ! ! (1,2) if ( ( nproLxC .eq. 2 ) .and. ( nproLyC .ge. 1 ) ) then i = (xbegin - 2) j = (ybegin - 1) do k = ikL, ikR do jj = 1, 6 do ii = 1, 6 iii = i + jj - 1 jjj = j + ii - 2 d0f(i,j,k) = d0f(i,j,k) + bnd6AB(jj,ii)*f(iii,jjj,k) end do end do end do end if ! (2,1) flip x and y if ( ( nproLxC .ge. 1 ) .and. ( nproLyC .eq. 2 ) ) then i = (xbegin - 1) j = (ybegin - 2) do k = ikL, ikR do jj = 1, 6 do ii = 1, 6 iii = i + ii - 2 jjj = j + jj - 1 d0f(i,j,k) = d0f(i,j,k) + bnd6AB(jj,ii)*f(iii,jjj,k) end do end do end do end if ! ! Left side (x), Right side (y) = Northwest : ! !( 1, ny-2) if ( ( nproLxC .eq. 2 ) .and. ( nproRyC .ge. 1 ) ) then i = (xbegin - 2) j = (yend + 1) do k = ikL, ikR do jj = 1, 6 do ii = 1, 6 iii = i + jj - 1 jjj = j - ii + 3 d0f(i,j,k) = d0f(i,j,k) + bnd6AB(jj,ii)*f(iii,jjj,k) end do end do end do end if !( 2, ny-1) if ( ( nproLxC .ge. 1 ) .and. ( nproRyC .eq. 2 ) ) then i = (xbegin - 1) j = (yend + 2) do k = ikL, ikR do jj = 1, 6 do ii = 1, 6 iii = i + ii - 2 jjj = j - jj + 2 d0f(i,j,k) = d0f(i,j,k) + bnd6AB(jj,ii)*f(iii,jjj,k) end do end do end do end if ! ! Right side (x), Left side (y) = Southeast : ! if ( ( nproRxC .eq. 2 ) .and. ( nproLyC .ge. 1 ) ) then !( nx-1, 2) i = (xend + 2) j = (ybegin - 1) do k = ikL, ikR do ii = 1, 6 do jj = 1, 6 iii = i - jj + 2 jjj = j + ii - 2 d0f(i,j,k) = d0f(i,j,k) + bnd6AB(jj,ii)*f(iii,jjj,k) end do end do end do end if !( nx-2, 1) if ( ( nproRxC .ge. 1 ) .and. ( nproLyC .eq. 2 ) ) then i = (xend + 1) j = (ybegin - 2) do k = ikL, ikR do ii = 1, 6 do jj = 1, 6 iii = i - ii + 3 jjj = j + jj - 1 d0f(i,j,k) = d0f(i,j,k) + bnd6AB(jj,ii)*f(iii,jjj,k) end do end do end do end if ! ! Right side (x), Right side (y) = Northeast : ! ! (nx-1,ny-2) if ( ( nproRxC .eq. 2 ) .and. ( nproRyC .ge. 1 ) ) then i = (xend + 2) j = (yend + 1) do k = ikL, ikR do ii = 1, 6 do jj = 1, 6 iii = i - jj + 2 jjj = j - ii + 3 d0f(i,j,k) = d0f(i,j,k) + bnd6AB(jj,ii)*f(iii,jjj,k) end do end do end do end if ! (nx-2,ny-1) if ( ( nproRxC .ge. 1 ) .and. ( nproRyC .eq. 2 ) ) then i = (xend + 1) j = (yend + 2) do k = ikL, ikR do ii = 1, 6 do jj = 1, 6 iii = i - ii + 3 jjj = j - jj + 2 d0f(i,j,k) = d0f(i,j,k) + bnd6AB(jj,ii)*f(iii,jjj,k) end do end do end do end if ! if ( ( nproLxC .ge. 1 ) .and. ( nproLyC .ge. 1 ) ) then i = (xbegin - 1) j = (ybegin - 1) do k = ikL, ikR do jj = 1, 6 do ii = 1, 6 iii = i + ii - 2 jjj = j + jj - 2 d0f(i,j,k) = d0f(i,j,k) + bnd6BB(ii,jj)*f(iii,jjj,k) end do end do end do end if ! ! Left side (x), Right side (y) = Northwest : ! if ( ( nproLxC .ge. 1 ) .and. ( nproRyC .ge. 1 ) ) then i = (xbegin - 1) j = (yend + 1) do k = ikL, ikR do jj = 1, 6 do ii = 1, 6 iii = i + ii - 2 jjj = j - jj + 3 d0f(i,j,k) = d0f(i,j,k) + bnd6BB(ii,jj)*f(iii,jjj,k) end do end do end do end if ! ! Right side (x), Left side (y) = Southeast : ! if ( ( nproRxC .ge. 1 ) .and. ( nproLyC .ge. 1 ) ) then i = (xend + 1) j = (ybegin - 1) do k = ikL, ikR do ii = 1, 6 do jj = 1, 6 iii = i - ii + 3 jjj = j + jj - 2 d0f(i,j,k) = d0f(i,j,k) + bnd6BB(ii,jj)*f(iii,jjj,k) end do end do end do end if ! ! Right side (x), Right side (y) = Northeast : ! if ( ( nproRxC .ge. 1 ) .and. ( nproRyC .ge. 1 ) ) then i = (xend + 1) j = (yend + 1) do k = ikL, ikR do ii = 1, 6 do jj = 1, 6 iii = i - jj + 3 jjj = j - ii + 3 d0f(i,j,k) = d0f(i,j,k) + bnd6BB(ii,jj)*f(iii,jjj,k) end do end do end do end if ! end orderb end if ! end 6th end if ! !----------------------------- ! 8th order explicit: (8,8,8,8-8E-8,8,8,8) ! ! if ( orderi .eq. 8 ) then ! ! Internal nodes: ! do k = ikL, ikR do j = ybegin, yend do i = xbegin, xend do ii = 1, 8 do jj = 1, 8 d0f(i,j,k)=d0f(i,j,k)+bnd8I(ii,jj)*f(i-4+ii,j+jj-4,k) enddo enddo enddo enddo enddo ! ! Boundary nodes: ! ! Solve for all 1D-corners (AD, BD, CD) ! ===================================== ! if( orderb .eq. 8) then ! ! Left side (y) = South: ! if ( nproLy .eq. 3 ) then j = (ybegin - 3) do k = ikL, ikR do i = xbegin, xend do ii = 1, 8 do jj = 1, 8 iii = i + ii - 4 jjj = j + jj - 1 d0f(i,j,k) = d0f(i,j,k) + bnd8AD(jj,ii)*f(iii,jjj,k) end do end do end do end do end if ! ! Right side (y) = North: ! if ( nproRy .eq. 3 ) then j = (yend + 3) do k = ikL, ikR do i = xbegin, xend do ii = 1, 8 do jj = 1, 8 iii = i + ii - 4 jjj = j - jj + 2 d0f(i,j,k) = d0f(i,j,k) + bnd8AD(jj,ii)*f(iii,jjj,k) end do end do end do end do end if ! ! Left side (x) = West: ! if ( nproLx .eq. 3 ) then i = (xbegin - 3) do k = ikL, ikR do j = ybegin, yend do ii = 1, 8 do jj = 1, 8 iii = i + jj - 1 jjj = j + ii - 4 d0f(i,j,k) = d0f(i,j,k) + bnd8AD(jj,ii)*f(iii,jjj,k) end do end do end do end do end if ! ! Right side (x) = East: ! if ( nproRx .eq. 3 ) then i = (xend + 3) do k = ikL, ikR do j = ybegin, yend do ii = 1, 8 do jj = 1, 8 iii = i - jj + 2 jjj = j + ii - 4 d0f(i,j,k) = d0f(i,j,k) + bnd8AD(jj,ii)*f(iii,jjj,k) end do end do end do end do end if ! ! Left side (y) = South: ! if ( nproLy .ge. 2 ) then j = (ybegin - 2) do k = ikL, ikR do i = xbegin, xend do ii = 1, 8 do jj = 1, 8 iii = i + ii - 4 jjj = j + jj - 2 d0f(i,j,k) = d0f(i,j,k) + bnd8BD(jj,ii)*f(iii,jjj,k) end do end do end do end do end if ! ! Right side (y) = North: ! if ( nproRy .ge. 2 ) then j = (yend + 2) do k = ikL, ikR do i = xbegin, xend do ii = 1, 8 do jj = 1, 8 iii = i + ii - 4 jjj = j - jj + 3 d0f(i,j,k) = d0f(i,j,k) + bnd8BD(jj,ii)*f(iii,jjj,k) end do end do end do end do end if ! ! Left side (x) = West: ! if ( nproLx .ge. 2 ) then i = (xbegin - 2) do k = ikL, ikR do j = ybegin, yend do ii = 1, 8 do jj = 1, 8 iii = i + jj - 2 jjj = j + ii - 4 d0f(i,j,k) = d0f(i,j,k) + bnd8BD(jj,ii)*f(iii,jjj,k) end do end do end do end do end if ! ! Right side (x) = East: ! if ( nproRx .ge. 2 ) then i = (xend + 2) do k = ikL, ikR do j = ybegin, yend do ii = 1, 8 do jj = 1, 8 iii = i - jj + 3 jjj = j + ii - 4 d0f(i,j,k) = d0f(i,j,k) + bnd8BD(jj,ii)*f(iii,jjj,k) end do end do end do end do end if ! ! Left side (y) = South: ! if ( nproLy .ge. 1 ) then j = (ybegin - 1) do k = ikL, ikR do i = xbegin, xend do ii = 1, 8 do jj = 1, 8 iii = i + ii - 4 jjj = j + jj - 3 d0f(i,j,k) = d0f(i,j,k) + bnd8CD(jj,ii)*f(iii,jjj,k) end do end do end do end do end if ! ! Right side (y) = North: ! if ( nproRy .ge. 1 ) then j = (yend + 1) do k = ikL, ikR do i = xbegin, xend do ii = 1, 8 do jj = 1, 8 iii = i + ii - 4 jjj = j - jj + 4 d0f(i,j,k) = d0f(i,j,k) + bnd8CD(jj,ii)*f(iii,jjj,k) end do end do end do end do end if ! ! Left side (x) = West: ! if ( nproLx .ge. 1 ) then i = (xbegin - 1) do k = ikL, ikR do j = ybegin, yend do ii = 1, 8 do jj = 1, 8 iii = i + jj - 3 jjj = j + ii - 4 d0f(i,j,k) = d0f(i,j,k) + bnd8CD(jj,ii)*f(iii,jjj,k) end do end do end do end do end if ! ! Right side (x) = East: ! if ( nproRx .ge. 1 ) then i = (xend + 1) do k = ikL, ikR do j = ybegin, yend do ii = 1, 8 do jj = 1, 8 iii = i - jj + 4 jjj = j + ii - 4 d0f(i,j,k) = d0f(i,j,k) + bnd8CD(jj,ii)*f(iii,jjj,k) end do end do end do end do end if ! if ( .not. corner ) then ! nproLxC = 3 nproLyC = 3 nproRxC = 3 nproRyC = 3 else nproLxC = nproLx nproLyC = nproLy nproRxC = nproRx nproRyC = nproRy ! endif ! ! Solve for all 2D-Corners (AA, AB, AC, BB, BC, CC) ! ================================================= ! if ( ( nproLxC .eq. 3 ) .and. ( nproLyC .eq. 3 ) ) then i = (xbegin - 3) j = (ybegin - 3) do k = ikL, ikR do jj = 1, 8 do ii = 1, 8 iii = i + ii - 1 jjj = j + jj - 1 d0f(i,j,k) = d0f(i,j,k) + bnd8AA(ii,jj)*f(iii,jjj,k) end do end do end do end if ! ! Left side (x), Right side (y) = Northwest : ! if ( ( nproLxC .eq. 3 ) .and. ( nproRyC .eq. 3 ) ) then i = (xbegin - 3) j = (yend + 3) do k = ikL, ikR do jj = 1, 8 do ii = 1, 8 iii = i + ii - 1 jjj = j - jj + 2 d0f(i,j,k) = d0f(i,j,k) + bnd8AA(ii,jj)*f(iii,jjj,k) end do end do end do end if ! ! Right side (x), Left side (y) = Southeast : ! if ( ( nproRxC .eq. 3 ) .and. ( nproLyC .eq. 3 ) ) then i = (xend + 3) j = (ybegin - 3) do k = ikL, ikR do ii = 1, 8 do jj = 1, 8 iii = i - ii + 2 jjj = j + jj - 1 d0f(i,j,k) = d0f(i,j,k) + bnd8AA(ii,jj)*f(iii,jjj,k) end do end do end do end if ! ! Right side (x), Right side (y) = Northeast : ! if ( ( nproRxC .eq. 3 ) .and. ( nproRyC .eq. 3 ) ) then i = (xend + 3) j = (yend + 3) do k = ikL, ikR do ii = 1, 8 do jj = 1, 8 iii = i - jj + 2 jjj = j - ii + 2 d0f(i,j,k) = d0f(i,j,k) + bnd8AA(ii,jj)*f(iii,jjj,k) end do end do end do end if ! ! Left side (x), Left side (y) = Southwest : ! ! (1,2) if ( ( nproLxC .eq. 3 ) .and. ( nproLyC .ge. 2 ) ) then i = (xbegin - 3) j = (ybegin - 2) do k = ikL, ikR do jj = 1, 8 do ii = 1, 8 iii = i + jj - 1 jjj = j + ii - 2 d0f(i,j,k) = d0f(i,j,k) + bnd8AB(jj,ii)*f(iii,jjj,k) end do end do end do end if ! (2,1) flip x and y if ( ( nproLxC .ge. 2 ) .and. ( nproLyC .eq. 3 ) ) then i = (xbegin - 2) j = (ybegin - 3) do k = ikL, ikR do jj = 1, 8 do ii = 1, 8 iii = i + ii - 2 jjj = j + jj - 1 d0f(i,j,k) = d0f(i,j,k) + bnd8AB(jj,ii)*f(iii,jjj,k) end do end do end do end if ! ! Left side (x), Right side (y) = Northwest : ! !( 1, ny-2) if ( ( nproLxC .eq. 3 ) .and. ( nproRyC .ge. 2 ) ) then i = (xbegin - 3) j = (yend + 2) do k = ikL, ikR do jj = 1, 8 do ii = 1, 8 iii = i + jj - 1 jjj = j - ii + 3 d0f(i,j,k) = d0f(i,j,k) + bnd8AB(jj,ii)*f(iii,jjj,k) end do end do end do end if !( 2, ny-1) if ( ( nproLxC .ge. 2 ) .and. ( nproRyC .eq. 3 ) ) then i = (xbegin - 2) j = (yend + 3) do k = ikL, ikR do jj = 1, 8 do ii = 1, 8 iii = i + ii - 2 jjj = j - jj + 2 d0f(i,j,k) = d0f(i,j,k) + bnd8AB(jj,ii)*f(iii,jjj,k) end do end do end do end if ! ! Right side (x), Left side (y) = Southeast : ! if ( ( nproRxC .eq. 3 ) .and. ( nproLyC .ge. 2 ) ) then !( nx-1, 2) i = (xend + 3) j = (ybegin - 2) do k = ikL, ikR do ii = 1, 8 do jj = 1, 8 iii = i - jj + 2 jjj = j + ii - 2 d0f(i,j,k) = d0f(i,j,k) + bnd8AB(jj,ii)*f(iii,jjj,k) end do end do end do end if !( nx-2, 1) if ( ( nproRxC .ge. 2 ) .and. ( nproLyC .eq. 3 ) ) then i = (xend + 2) j = (ybegin - 3) do k = ikL, ikR do ii = 1, 8 do jj = 1, 8 iii = i - ii + 3 jjj = j + jj - 1 d0f(i,j,k) = d0f(i,j,k) + bnd8AB(jj,ii)*f(iii,jjj,k) end do end do end do end if ! ! Right side (x), Right side (y) = Northeast : ! ! (nx-1,ny-2) if ( ( nproRxC .eq. 3 ) .and. ( nproRyC .ge. 2 ) ) then i = (xend + 3) j = (yend + 2) do k = ikL, ikR do ii = 1, 8 do jj = 1, 8 iii = i - jj + 2 jjj = j - ii + 3 d0f(i,j,k) = d0f(i,j,k) + bnd8AB(jj,ii)*f(iii,jjj,k) end do end do end do end if ! (nx-2,ny-1) if ( ( nproRxC .ge. 2 ) .and. ( nproRyC .eq. 3 ) ) then i = (xend + 2) j = (yend + 3) do k = ikL, ikR do ii = 1, 8 do jj = 1, 8 iii = i - ii + 3 jjj = j - jj + 2 d0f(i,j,k) = d0f(i,j,k) + bnd8AB(jj,ii)*f(iii,jjj,k) end do end do end do end if ! ! Left side (x), Left side (y) = Southwest : ! ! (1,3) if ( ( nproLxC .eq. 3 ) .and. ( nproLyC .ge. 1 ) ) then i = (xbegin - 3) j = (ybegin - 1) do k = ikL, ikR do jj = 1, 8 do ii = 1, 8 iii = i + jj - 1 jjj = j + ii - 3 d0f(i,j,k) = d0f(i,j,k) + bnd8AC(jj,ii)*f(iii,jjj,k) end do end do end do end if ! (3,1) flip x and y if ( ( nproLxC .ge. 1 ) .and. ( nproLyC .eq. 3 ) ) then i = (xbegin - 1) j = (ybegin - 3) do k = ikL, ikR do jj = 1, 8 do ii = 1, 8 iii = i + ii - 3 jjj = j + jj - 1 d0f(i,j,k) = d0f(i,j,k) + bnd8AC(jj,ii)*f(iii,jjj,k) end do end do end do end if ! ! Left side (x), Right side (y) = Northwest : ! !( 1, ny-3) if ( ( nproLxC .eq. 3 ) .and. ( nproRyC .ge. 1 ) ) then i = (xbegin - 3) j = (yend + 1) do k = ikL, ikR do jj = 1, 8 do ii = 1, 8 iii = i + jj - 1 jjj = j - ii + 4 d0f(i,j,k) = d0f(i,j,k) + bnd8AC(jj,ii)*f(iii,jjj,k) end do end do end do end if !( 3, ny-1) if ( ( nproLxC .ge. 1 ) .and. ( nproRyC .eq. 3 ) ) then i = (xbegin - 1) j = (yend + 3) do k = ikL, ikR do jj = 1, 8 do ii = 1, 8 iii = i + ii - 3 jjj = j - jj + 2 d0f(i,j,k) = d0f(i,j,k) + bnd8AC(jj,ii)*f(iii,jjj,k) end do end do end do end if ! ! Right side (x), Left side (y) = Southeast : ! if ( ( nproRxC .eq. 3 ) .and. ( nproLyC .ge. 1 ) ) then !( nx-1, 3) i = (xend + 3) j = (ybegin - 1) do k = ikL, ikR do ii = 1, 8 do jj = 1, 8 iii = i - jj + 2 jjj = j + ii - 3 d0f(i,j,k) = d0f(i,j,k) + bnd8AC(jj,ii)*f(iii,jjj,k) end do end do end do end if !( nx-3, 1) if ( ( nproRxC .ge. 1 ) .and. ( nproLyC .eq. 3 ) ) then i = (xend + 1) j = (ybegin - 3) do k = ikL, ikR do ii = 1, 8 do jj = 1, 8 iii = i - ii + 4 jjj = j + jj - 1 d0f(i,j,k) = d0f(i,j,k) + bnd8AC(jj,ii)*f(iii,jjj,k) end do end do end do end if ! ! Right side (x), Right side (y) = Northeast : ! ! (nx-1,ny-3) if ( ( nproRxC .eq. 3 ) .and. ( nproRyC .ge. 1 ) ) then i = (xend + 3) j = (yend + 1) do k = ikL, ikR do ii = 1, 8 do jj = 1, 8 iii = i - jj + 2 jjj = j - ii + 4 d0f(i,j,k) = d0f(i,j,k) + bnd8AC(jj,ii)*f(iii,jjj,k) end do end do end do end if ! (nx-3,ny-1) if ( ( nproRxC .ge. 1 ) .and. ( nproRyC .eq. 3 ) ) then i = (xend + 1) j = (yend + 3) do k = ikL, ikR do ii = 1, 8 do jj = 1, 8 iii = i - ii + 4 jjj = j - jj + 2 d0f(i,j,k) = d0f(i,j,k) + bnd8AC(jj,ii)*f(iii,jjj,k) end do end do end do end if ! if ( ( nproLxC .ge. 2 ) .and. ( nproLyC .ge. 2 ) ) then i = (xbegin - 2) j = (ybegin - 2) do k = ikL, ikR do jj = 1, 8 do ii = 1, 8 iii = i + ii - 2 jjj = j + jj - 2 d0f(i,j,k) = d0f(i,j,k) + bnd8BB(ii,jj)*f(iii,jjj,k) end do end do end do end if ! ! Left side (x), Right side (y) = Northwest : ! if ( ( nproLxC .ge. 2 ) .and. ( nproRyC .ge. 2 ) ) then i = (xbegin - 2) j = (yend + 2) do k = ikL, ikR do jj = 1, 8 do ii = 1, 8 iii = i + ii - 2 jjj = j - jj + 3 d0f(i,j,k) = d0f(i,j,k) + bnd8BB(ii,jj)*f(iii,jjj,k) end do end do end do end if ! ! Right side (x), Left side (y) = Southeast : ! if ( ( nproRxC .ge. 2 ) .and. ( nproLyC .ge. 2 ) ) then i = (xend + 2) j = (ybegin - 2) do k = ikL, ikR do ii = 1, 8 do jj = 1, 8 iii = i - ii + 3 jjj = j + jj - 2 d0f(i,j,k) = d0f(i,j,k) + bnd8BB(ii,jj)*f(iii,jjj,k) end do end do end do end if ! ! Right side (x), Right side (y) = Northeast : ! if ( ( nproRxC .ge. 2 ) .and. ( nproRyC .ge. 2 ) ) then i = (xend + 2) j = (yend + 2) do k = ikL, ikR do ii = 1, 8 do jj = 1, 8 iii = i - jj + 3 jjj = j - ii + 3 d0f(i,j,k) = d0f(i,j,k) + bnd8BB(ii,jj)*f(iii,jjj,k) end do end do end do end if ! ! Left side (x), Left side (y) = Southwest : ! ! (2,3) if ( ( nproLxC .ge. 2 ) .and. ( nproLyC .ge. 1 ) ) then i = (xbegin - 2) j = (ybegin - 1) do k = ikL, ikR do jj = 1, 8 do ii = 1, 8 iii = i + jj - 2 jjj = j + ii - 3 d0f(i,j,k) = d0f(i,j,k) + bnd8BC(jj,ii)*f(iii,jjj,k) end do end do end do end if ! (3,2) flip x and y if ( ( nproLxC .ge. 1 ) .and. ( nproLyC .ge. 2 ) ) then i = (xbegin - 1) j = (ybegin - 2) do k = ikL, ikR do jj = 1, 8 do ii = 1, 8 iii = i + ii - 3 jjj = j + jj - 2 d0f(i,j,k) = d0f(i,j,k) + bnd8BC(jj,ii)*f(iii,jjj,k) end do end do end do end if ! ! Left side (x), Right side (y) = Northwest : ! !( 2, ny-3) if ( ( nproLxC .ge. 2 ) .and. ( nproRyC .ge. 1 ) ) then i = (xbegin - 2) j = (yend + 1) do k = ikL, ikR do jj = 1, 8 do ii = 1, 8 iii = i + jj - 2 jjj = j - ii + 4 d0f(i,j,k) = d0f(i,j,k) + bnd8BC(jj,ii)*f(iii,jjj,k) end do end do end do end if !( 3, ny-2) if ( ( nproLxC .ge. 1 ) .and. ( nproRyC .ge. 2 ) ) then i = (xbegin - 1) j = (yend + 2) do k = ikL, ikR do jj = 1, 8 do ii = 1, 8 iii = i + ii - 3 jjj = j - jj + 3 d0f(i,j,k) = d0f(i,j,k) + bnd8BC(jj,ii)*f(iii,jjj,k) end do end do end do end if ! ! Right side (x), Left side (y) = Southeast : ! if ( ( nproRxC .ge. 2 ) .and. ( nproLyC .ge. 1 ) ) then !( nx-2, 3) i = (xend + 2) j = (ybegin - 1) do k = ikL, ikR do ii = 1, 8 do jj = 1, 8 iii = i - jj + 3 jjj = j + ii - 3 d0f(i,j,k) = d0f(i,j,k) + bnd8BC(jj,ii)*f(iii,jjj,k) end do end do end do end if !( nx-3, 2) if ( ( nproRxC .ge. 1 ) .and. ( nproLyC .ge. 2 ) ) then i = (xend + 1) j = (ybegin - 2) do k = ikL, ikR do ii = 1, 8 do jj = 1, 8 iii = i - ii + 4 jjj = j + jj - 2 d0f(i,j,k) = d0f(i,j,k) + bnd8BC(jj,ii)*f(iii,jjj,k) end do end do end do end if ! ! Right side (x), Right side (y) = Northeast : ! ! (nx-2,ny-3) if ( ( nproRxC .ge. 2 ) .and. ( nproRyC .ge. 1 ) ) then i = (xend + 2) j = (yend + 1) do k = ikL, ikR do ii = 1, 8 do jj = 1, 8 iii = i - jj + 3 jjj = j - ii + 4 d0f(i,j,k) = d0f(i,j,k) + bnd8BC(jj,ii)*f(iii,jjj,k) end do end do end do end if ! (nx-3,ny-2) if ( ( nproRxC .ge. 1 ) .and. ( nproRyC .ge. 2 ) ) then i = (xend + 1) j = (yend + 2) do k = ikL, ikR do ii = 1, 8 do jj = 1, 8 iii = i - ii + 4 jjj = j - jj + 3 d0f(i,j,k) = d0f(i,j,k) + bnd8BC(jj,ii)*f(iii,jjj,k) end do end do end do end if ! if ( ( nproLxC .ge. 1 ) .and. ( nproLyC .ge. 1 ) ) then i = (xbegin - 1) j = (ybegin - 1) do k = ikL, ikR do jj = 1, 8 do ii = 1, 8 iii = i + ii - 3 jjj = j + jj - 3 d0f(i,j,k) = d0f(i,j,k) + bnd8CC(ii,jj)*f(iii,jjj,k) end do end do end do end if ! ! Left side (x), Right side (y) = Northwest : ! if ( ( nproLxC .ge. 1 ) .and. ( nproRyC .ge. 1 ) ) then i = (xbegin - 1) j = (yend + 1) do k = ikL, ikR do jj = 1, 8 do ii = 1, 8 iii = i + ii - 3 jjj = j - jj + 4 d0f(i,j,k) = d0f(i,j,k) + bnd8CC(ii,jj)*f(iii,jjj,k) end do end do end do end if ! ! Right side (x), Left side (y) = Southeast : ! if ( ( nproRxC .ge. 1 ) .and. ( nproLyC .ge. 1 ) ) then i = (xend + 1) j = (ybegin - 1) do k = ikL, ikR do ii = 1, 8 do jj = 1, 8 iii = i - ii + 4 jjj = j + jj - 3 d0f(i,j,k) = d0f(i,j,k) + bnd8CC(ii,jj)*f(iii,jjj,k) end do end do end do end if ! ! Right side (x), Right side (y) = Northeast : ! if ( ( nproRxC .ge. 1 ) .and. ( nproRyC .ge. 1 ) ) then i = (xend + 1) j = (yend + 1) do k = ikL, ikR do ii = 1, 8 do jj = 1, 8 iii = i - jj + 4 jjj = j - ii + 4 d0f(i,j,k) = d0f(i,j,k) + bnd8CC(ii,jj)*f(iii,jjj,k) end do end do end do end if ! end orderb end if ! end 8th end if ! !----------------------------- ! 10th order explicit: (10E) ! ! if ( orderi .eq. 10 ) then ! ! ! Are there enough green cells? if( min0(biL,biR,bjL,bjR) .lt. 4 ) then ierror = -110 error = 'DER_0_2D: Too few Green cells for orderi=10' return endif ! ! Internal nodes: ! do k = ikL, ikR do j = ybegin, yend do i = xbegin, xend sum = 0.d0 do ii = 1, 10 do jj = 1, 10 sum = sum + bnd10I(ii,jj)* f(i-5+ii,j+jj-5,k) enddo enddo d0f(i,j,k) = sum enddo enddo enddo ! end if ! return end !====================================================================