!==================================================================== ! subroutine zx_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. (pkR-pkL+1)) .or. (width .gt. (piR-piL+1))) then ierror = -100 error = 'DER_0_2D: Stencil is wider than the f domain' return endif ! ! Zero-out interpolant ! do k = ikL, ikR-1 do j = ijL, ijR 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 = zbegin, zend do j = ijL, ijR do i = xbegin, xend d0f(i,j,k) = a1 *( f(i+0,j,k+1)+f(i+1,j,k+1) & + f(i+0,j,k+0)+f(i+1,j,k+0) ) 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 = zbegin, zend do j = ijL, ijR do i = xbegin, xend d0f(i,j,k) = a1 *( f(i+0,j,k+1)+f(i+1,j,k+1) & + f(i+0,j,k+0)+f(i+1,j,k+0) ) & + b1 *( f(i+2,j,k+1)+f(i+2,j,k+0) & + f(i+1,j,k+2)+f(i+1,j,k-1) & + f(i+0,j,k+2)+f(i+0,j,k-1) & + f(i-1,j,k+0)+f(i-1,j,k+1) ) & + b2 *( f(i+2,j,k+2)+f(i-1,j,k+2) & + f(i+2,j,k-1)+f(i-1,j,k-1) ) end do end do end do ! ! Boundary nodes: ! ! Solve for all 1D-corners (AB) ! ============================= ! if( orderb .eq. 4) then ! ! Left side (y) = South: ! if ( nproLx .eq. 1 ) then i = (xbegin - 1) do j = ijL, ijR do k = zbegin, zend do kk = 1, 4 do ii = 1, 4 kkk = k + kk - 2 iii = i + ii - 1 d0f(i,j,k) = d0f(i,j,k) + bnd4AB(ii,kk)*f(iii,j,kkk) end do end do end do end do end if ! ! Right side (y) = North: ! if ( nproRx .eq. 1 ) then i = (xend + 1) do j = ijL, ijR do k = zbegin, zend do kk = 1, 4 do ii = 1, 4 kkk = k + kk - 2 iii = i - ii + 2 d0f(i,j,k) = d0f(i,j,k) + bnd4AB(ii,kk)*f(iii,j,kkk) end do end do end do end do end if ! ! Left side (x) = West: ! if ( nproLz .eq. 1 ) then k = (zbegin - 1) do j = ijL, ijR do i = xbegin, xend do kk = 1, 4 do ii = 1, 4 kkk = k + ii - 1 iii = i + kk - 2 d0f(i,j,k) = d0f(i,j,k) + bnd4AB(ii,kk)*f(iii,j,kkk) end do end do end do end do end if ! ! Right side (x) = East: ! if ( nproRz .eq. 1 ) then k = (zend + 1) do j = ijL, ijR do i = xbegin, xend do kk = 1, 4 do ii = 1, 4 kkk = k - ii + 2 iii = i + kk - 2 d0f(i,j,k) = d0f(i,j,k) + bnd4AB(ii,kk)*f(iii,j,kkk) end do end do end do end do end if ! if ( .not. corner ) then ! nproLzC = 1 nproLxC = 1 nproRzC = 1 nproRxC = 1 else nproLzC = nproLz nproLxC = nproLx nproRzC = nproRz nproRxC = nproRx ! endif ! ! Solve for all 2D-Corners (AA) ! ============================= ! if ( ( nproLzC .eq. 1 ) .and. ( nproLxC .eq. 1 ) ) then k = (zbegin - 1) i = (xbegin - 1) do j = ijL, ijR do ii = 1, 4 do kk = 1, 4 kkk = k + kk - 1 iii = i + ii - 1 d0f(i,j,k) = d0f(i,j,k) + bnd4AA(kk,ii)*f(iii,j,kkk) end do end do end do end if ! ! Left side (x), Right side (y) = Northwest : ! if ( ( nproLzC .eq. 1 ) .and. ( nproRxC .eq. 1 ) ) then k = (zbegin - 1) i = (xend + 1) do j = ijL, ijR do ii = 1, 4 do kk = 1, 4 kkk = k + kk - 1 iii = i - ii + 2 d0f(i,j,k) = d0f(i,j,k) + bnd4AA(kk,ii)*f(iii,j,kkk) end do end do end do end if ! ! Right side (x), Left side (y) = Southeast : ! if ( ( nproRzC .eq. 1 ) .and. ( nproLxC .eq. 1 ) ) then k = (zend + 1) i = (xbegin - 1) do j = ijL, ijR do kk = 1, 4 do ii = 1, 4 kkk = k - kk + 2 iii = i + ii - 1 d0f(i,j,k) = d0f(i,j,k) + bnd4AA(kk,ii)*f(iii,j,kkk) end do end do end do end if ! ! Right side (x), Right side (y) = Northeast : ! if ( ( nproRzC .eq. 1 ) .and. ( nproRxC .eq. 1 ) ) then k = (zend + 1) i = (xend + 1) do j = ijL, ijR do kk = 1, 4 do ii = 1, 4 kkk = k - ii + 2 iii = i - kk + 2 d0f(i,j,k) = d0f(i,j,k) + bnd4AA(kk,ii)*f(iii,j,kkk) 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 = zbegin, zend do j = ijL, ijR do i = xbegin, xend d0f(i,j,k) = a1 *( f(i+0,j,k+1)+f(i+1,j,k+1) & + f(i+0,j,k+0)+f(i+1,j,k+0) ) & + b1 *( f(i+2,j,k+1)+f(i+2,j,k+0) & + f(i+1,j,k+2)+f(i+1,j,k-1) & + f(i+0,j,k+2)+f(i+0,j,k-1) & + f(i-1,j,k+0)+f(i-1,j,k+1) ) & + b2 *( f(i+2,j,k+2)+f(i-1,j,k+2) & + f(i+2,j,k-1)+f(i-1,j,k-1) ) & + c1 *( f(i+3,j,k+1)+f(i+3,j,k+0) & + f(i+0,j,k+3)+f(i+1,j,k-2) & + f(i+1,j,k+3)+f(i+0,j,k-2) & + f(i-2,j,k+1)+f(i-2,j,k+0) ) & + c2 *( f(i+3,j,k+2)+f(i+3,j,k-1) & + f(i+2,j,k+3)+f(i+2,j,k-2) & + f(i-1,j,k+3)+f(i-1,j,k-2) & + f(i-2,j,k+2)+f(i-2,j,k-1) ) & + c3 *( f(i+3,j,k+3)+f(i+3,j,k-2) & + f(i-2,j,k+3)+f(i-2,j,k-2) ) 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 ( nproLx .eq. 2 ) then i = (xbegin - 2) do j = ijL, ijR do k = zbegin, zend do kk = 1, 6 do ii = 1, 6 kkk = k + kk - 3 iii = i + ii - 1 d0f(i,j,k) = d0f(i,j,k) + bnd6AC(ii,kk)*f(iii,j,kkk) end do end do end do end do end if ! ! Right side (y) = North: ! if ( nproRx .eq. 2 ) then i = (xend + 2) do j = ijL, ijR do k = zbegin, zend do kk = 1, 6 do ii = 1, 6 kkk = k + kk - 3 iii = i - ii + 2 d0f(i,j,k) = d0f(i,j,k) + bnd6AC(ii,kk)*f(iii,j,kkk) end do end do end do end do end if ! ! Left side (x) = West: ! if ( nproLz .eq. 2 ) then k = (zbegin - 2) do j = ijL, ijR do i = xbegin, xend do kk = 1, 6 do ii = 1, 6 kkk = k + ii - 1 iii = i + kk - 3 d0f(i,j,k) = d0f(i,j,k) + bnd6AC(ii,kk)*f(iii,j,kkk) end do end do end do end do end if ! ! Right side (x) = East: ! if ( nproRz .eq. 2 ) then k = (zend + 2) do j = ijL, ijR do i = xbegin, xend do kk = 1, 6 do ii = 1, 6 kkk = k - ii + 2 iii = i + kk - 3 d0f(i,j,k) = d0f(i,j,k) + bnd6AC(ii,kk)*f(iii,j,kkk) end do end do end do end do end if ! ! Left side (y) = South: ! if ( nproLx .ge. 1 ) then i = (xbegin - 1) do j = ijL, ijR do k = zbegin, zend do kk = 1, 6 do ii = 1, 6 kkk = k + kk - 3 iii = i + ii - 2 d0f(i,j,k) = d0f(i,j,k) + bnd6BC(ii,kk)*f(iii,j,kkk) end do end do end do end do end if ! ! Right side (y) = North: ! if ( nproRx .ge. 1 ) then i = (xend + 1) do j = ijL, ijR do k = zbegin, zend do kk = 1, 6 do ii = 1, 6 kkk = k + kk - 3 iii = i - ii + 3 d0f(i,j,k) = d0f(i,j,k) + bnd6BC(ii,kk)*f(iii,j,kkk) end do end do end do end do end if ! ! Left side (x) = West: ! if ( nproLz .ge. 1 ) then k = (zbegin - 1) do j = ijL, ijR do i = xbegin, xend do kk = 1, 6 do ii = 1, 6 kkk = k + ii - 2 iii = i + kk - 3 d0f(i,j,k) = d0f(i,j,k) + bnd6BC(ii,kk)*f(iii,j,kkk) end do end do end do end do end if ! ! Right side (x) = East: ! if ( nproRz .ge. 1 ) then k = (zend + 1) do j = ijL, ijR do i = xbegin, xend do kk = 1, 6 do ii = 1, 6 kkk = k - ii + 3 iii = i + kk - 3 d0f(i,j,k) = d0f(i,j,k) + bnd6BC(ii,kk)*f(iii,j,kkk) end do end do end do end do end if ! if ( .not. corner ) then nproLzC = 2 nproLxC = 2 nproRzC = 2 nproRxC = 2 else nproLzC = nproLz nproLxC = nproLx nproRzC = nproRz nproRxC = nproRx ! endif ! ! Solve for all 2D-Corners (AA, AB, BB) ! ===================================== ! if ( ( nproLz .eq. 2 ) .and. ( nproLx .eq. 2 ) ) then k = (zbegin - 2) i = (xbegin - 2) do j = ijL, ijR do ii = 1, 6 do kk = 1, 6 kkk = k + kk - 1 iii = i + ii - 1 d0f(i,j,k) = d0f(i,j,k) + bnd6AA(kk,ii)*f(iii,j,kkk) end do end do end do end if ! ! Left side (x), Right side (y) = Northwest : ! if ( ( nproLz .eq. 2 ) .and. ( nproRx .eq. 2 ) ) then k = (zbegin - 2) i = (xend + 2) do j = ijL, ijR do ii = 1, 6 do kk = 1, 6 kkk = k + kk - 1 iii = i - ii + 2 d0f(i,j,k) = d0f(i,j,k) + bnd6AA(kk,ii)*f(iii,j,kkk) end do end do end do end if ! ! Right side (x), Left side (y) = Southeast : ! if ( ( nproRz .eq. 2 ) .and. ( nproLx .eq. 2 ) ) then k = (zend + 2) i = (xbegin - 2) do j = ijL, ijR do kk = 1, 6 do ii = 1, 6 kkk = k - kk + 2 iii = i + ii - 1 d0f(i,j,k) = d0f(i,j,k) + bnd6AA(kk,ii)*f(iii,j,kkk) end do end do end do end if ! ! Right side (x), Right side (y) = Northeast : ! if ( ( nproRz .eq. 2 ) .and. ( nproRx .eq. 2 ) ) then k = (zend + 2) i = (xend + 2) do j = ijL, ijR do kk = 1, 6 do ii = 1, 6 kkk = k - ii + 2 iii = i - kk + 2 d0f(i,j,k) = d0f(i,j,k) + bnd6AA(kk,ii)*f(iii,j,kkk) end do end do end do end if ! ! Left side (x), Left side (y) = Southwest : ! ! (1,2) if ( ( nproLz .eq. 2 ) .and. ( nproLx .ge. 1 ) ) then k = (zbegin - 2) i = (xbegin - 1) do j = ijL, ijR do ii = 1, 6 do kk = 1, 6 kkk = k + ii - 1 iii = i + kk - 2 d0f(i,j,k) = d0f(i,j,k) + bnd6AB(ii,kk)*f(iii,j,kkk) end do end do end do end if ! (2,1) flip x and y if ( ( nproLz .ge. 1 ) .and. ( nproLx .eq. 2 ) ) then k = (zbegin - 1) i = (xbegin - 2) do j = ijL, ijR do ii = 1, 6 do kk = 1, 6 kkk = k + kk - 2 iii = i + ii - 1 d0f(i,j,k) = d0f(i,j,k) + bnd6AB(ii,kk)*f(iii,j,kkk) end do end do end do end if ! ! Left side (x), Right side (y) = Northwest : ! !( 1, ny-2) if ( ( nproLz .eq. 2 ) .and. ( nproRx .ge. 1 ) ) then k = (zbegin - 2) i = (xend + 1) do j = ijL, ijR do ii = 1, 6 do kk = 1, 6 kkk = k + ii - 1 iii = i - kk + 3 d0f(i,j,k) = d0f(i,j,k) + bnd6AB(ii,kk)*f(iii,j,kkk) end do end do end do end if !( 2, ny-1) if ( ( nproLz .ge. 1 ) .and. ( nproRx .eq. 2 ) ) then k = (zbegin - 1) i = (xend + 2) do j = ijL, ijR do ii = 1, 6 do kk = 1, 6 kkk = k + kk - 2 iii = i - ii + 2 d0f(i,j,k) = d0f(i,j,k) + bnd6AB(ii,kk)*f(iii,j,kkk) end do end do end do end if ! ! Right side (x), Left side (y) = Southeast : ! if ( ( nproRz .eq. 2 ) .and. ( nproLx .ge. 1 ) ) then !( nx-1, 2) k = (zend + 2) i = (xbegin - 1) do j = ijL, ijR do kk = 1, 6 do ii = 1, 6 kkk = k - ii + 2 iii = i + kk - 2 d0f(i,j,k) = d0f(i,j,k) + bnd6AB(ii,kk)*f(iii,j,kkk) end do end do end do end if !( nx-2, 1) if ( ( nproRz .ge. 1 ) .and. ( nproLx .eq. 2 ) ) then k = (zend + 1) i = (xbegin - 2) do j = ijL, ijR do kk = 1, 6 do ii = 1, 6 kkk = k - kk + 3 iii = i + ii - 1 d0f(i,j,k) = d0f(i,j,k) + bnd6AB(ii,kk)*f(iii,j,kkk) end do end do end do end if ! ! Right side (x), Right side (y) = Northeast : ! ! (nx-1,ny-2) if ( ( nproRz .eq. 2 ) .and. ( nproRx .ge. 1 ) ) then k = (zend + 2) i = (xend + 1) do j = ijL, ijR do kk = 1, 6 do ii = 1, 6 kkk = k - ii + 2 iii = i - kk + 3 d0f(i,j,k) = d0f(i,j,k) + bnd6AB(ii,kk)*f(iii,j,kkk) end do end do end do end if ! (nx-2,ny-1) if ( ( nproRz .ge. 1 ) .and. ( nproRx .eq. 2 ) ) then k = (zend + 1) i = (xend + 2) do j = ijL, ijR do kk = 1, 6 do ii = 1, 6 kkk = k - kk + 3 iii = i - ii + 2 d0f(i,j,k) = d0f(i,j,k) + bnd6AB(ii,kk)*f(iii,j,kkk) end do end do end do end if ! if ( ( nproLz .ge. 1 ) .and. ( nproLx .ge. 1 ) ) then k = (zbegin - 1) i = (xbegin - 1) do j = ijL, ijR do ii = 1, 6 do kk = 1, 6 kkk = k + kk - 2 iii = i + ii - 2 d0f(i,j,k) = d0f(i,j,k) + bnd6BB(kk,ii)*f(iii,j,kkk) end do end do end do end if ! ! Left side (x), Right side (y) = Northwest : ! if ( ( nproLz .ge. 1 ) .and. ( nproRx .ge. 1 ) ) then k = (zbegin - 1) i = (xend + 1) do j = ijL, ijR do ii = 1, 6 do kk = 1, 6 kkk = k + kk - 2 iii = i - ii + 3 d0f(i,j,k) = d0f(i,j,k) + bnd6BB(kk,ii)*f(iii,j,kkk) end do end do end do end if ! ! Right side (x), Left side (y) = Southeast : ! if ( ( nproRz .ge. 1 ) .and. ( nproLx .ge. 1 ) ) then k = (zend + 1) i = (xbegin - 1) do j = ijL, ijR do kk = 1, 6 do ii = 1, 6 kkk = k - kk + 3 iii = i + ii - 2 d0f(i,j,k) = d0f(i,j,k) + bnd6BB(kk,ii)*f(iii,j,kkk) end do end do end do end if ! ! Right side (x), Right side (y) = Northeast : ! if ( ( nproRz .ge. 1 ) .and. ( nproRx .ge. 1 ) ) then k = (zend + 1) i = (xend + 1) do j = ijL, ijR do kk = 1, 6 do ii = 1, 6 kkk = k - ii + 3 iii = i - kk + 3 d0f(i,j,k) = d0f(i,j,k) + bnd6BB(kk,ii)*f(iii,j,kkk) 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 = zbegin, zend do j = ijL, ijR do i = xbegin, xend do kk = 1, 8 do ii = 1, 8 d0f(i,j,k) = d0f(i,j,k)+bnd8I(kk,ii)*f(i+ii-4,j,k+kk-4) enddo enddo enddo enddo enddo ! ! Boundary nodes: ! ! if( orderb .eq. 8) then ! ! Left side (y) = South: ! if ( nproLx .eq. 3 ) then i = (xbegin - 3) do j = ijL, ijR do k = zbegin, zend do kk = 1, 8 do ii = 1, 8 kkk = k + kk - 4 iii = i + ii - 1 d0f(i,j,k) = d0f(i,j,k) + bnd8AD(ii,kk)*f(iii,j,kkk) end do end do end do end do end if ! ! Right side (y) = North: ! if ( nproRx .eq. 3 ) then i = (xend + 3) do j = ijL, ijR do k = zbegin, zend do kk = 1, 8 do ii = 1, 8 kkk = k + kk - 4 iii = i - ii + 2 d0f(i,j,k) = d0f(i,j,k) + bnd8AD(ii,kk)*f(iii,j,kkk) end do end do end do end do end if ! ! Left side (x) = West: ! if ( nproLz .eq. 3 ) then k = (zbegin - 3) do j = ijL, ijR do i = xbegin, xend do kk = 1, 8 do ii = 1, 8 kkk = k + ii - 1 iii = i + kk - 4 d0f(i,j,k) = d0f(i,j,k) + bnd8AD(ii,kk)*f(iii,j,kkk) end do end do end do end do end if ! ! Right side (x) = East: ! if ( nproRz .eq. 3 ) then k = (zend + 3) do j = ijL, ijR do i = xbegin, xend do kk = 1, 8 do ii = 1, 8 kkk = k - ii + 2 iii = i + kk - 4 d0f(i,j,k) = d0f(i,j,k) + bnd8AD(ii,kk)*f(iii,j,kkk) end do end do end do end do end if ! ! Left side (y) = South: ! if ( nproLx .ge. 2 ) then i = (xbegin - 2) do j = ijL, ijR do k = zbegin, zend do kk = 1, 8 do ii = 1, 8 kkk = k + kk - 4 iii = i + ii - 2 d0f(i,j,k) = d0f(i,j,k) + bnd8BD(ii,kk)*f(iii,j,kkk) end do end do end do end do end if ! ! Right side (y) = North: ! if ( nproRx .ge. 2 ) then i = (xend + 2) do j = ijL, ijR do k = zbegin, zend do kk = 1, 8 do ii = 1, 8 kkk = k + kk - 4 iii = i - ii + 3 d0f(i,j,k) = d0f(i,j,k) + bnd8BD(ii,kk)*f(iii,j,kkk) end do end do end do end do end if ! ! Left side (x) = West: ! if ( nproLz .ge. 2 ) then k = (zbegin - 2) do j = ijL, ijR do i = xbegin, xend do kk = 1, 8 do ii = 1, 8 kkk = k + ii - 2 iii = i + kk - 4 d0f(i,j,k) = d0f(i,j,k) + bnd8BD(ii,kk)*f(iii,j,kkk) end do end do end do end do end if ! ! Right side (x) = East: ! if ( nproRz .ge. 2 ) then k = (zend + 2) do j = ijL, ijR do i = xbegin, xend do kk = 1, 8 do ii = 1, 8 kkk = k - ii + 3 iii = i + kk - 4 d0f(i,j,k) = d0f(i,j,k) + bnd8BD(ii,kk)*f(iii,j,kkk) end do end do end do end do end if ! ! Left side (y) = South: ! if ( nproLx .ge. 1 ) then i = (xbegin - 1) do j = ijL, ijR do k = zbegin, zend do kk = 1, 8 do ii = 1, 8 kkk = k + kk - 4 iii = i + ii - 3 d0f(i,j,k) = d0f(i,j,k) + bnd8CD(ii,kk)*f(iii,j,kkk) end do end do end do end do end if ! ! Right side (y) = North: ! if ( nproRx .ge. 1 ) then i = (xend + 1) do j = ijL, ijR do k = zbegin, zend do kk = 1, 8 do ii = 1, 8 kkk = k + kk - 4 iii = i - ii + 4 d0f(i,j,k) = d0f(i,j,k) + bnd8CD(ii,kk)*f(iii,j,kkk) end do end do end do end do end if ! ! Left side (x) = West: ! if ( nproLz .ge. 1 ) then k = (zbegin - 1) do j = ijL, ijR do i = xbegin, xend do kk = 1, 8 do ii = 1, 8 kkk = k + ii - 3 iii = i + kk - 4 d0f(i,j,k) = d0f(i,j,k) + bnd8CD(ii,kk)*f(iii,j,kkk) end do end do end do end do end if ! ! Right side (x) = East: ! if ( nproRz .ge. 1 ) then k = (zend + 1) do j = ijL, ijR do i = xbegin, xend do kk = 1, 8 do ii = 1, 8 kkk = k - ii + 4 iii = i + kk - 4 d0f(i,j,k) = d0f(i,j,k) + bnd8CD(ii,kk)*f(iii,j,kkk) end do end do end do end do end if ! if ( .not. corner ) then ! nproLzC = 3 nproLxC = 3 nproRzC = 3 nproRxC = 3 else nproLzC = nproLz nproLxC = nproLx nproRzC = nproRz nproRxC = nproRx ! endif ! ! Solve for all 2D-Corners (AA, AB, AC, BB, BC, CC) ! ================================================= ! if ( ( nproLzC .eq. 3 ) .and. ( nproLxC .eq. 3 ) ) then k = (zbegin - 3) i = (xbegin - 3) do j = ijL, ijR do ii = 1, 8 do kk = 1, 8 kkk = k + kk - 1 iii = i + ii - 1 d0f(i,j,k) = d0f(i,j,k) + bnd8AA(kk,ii)*f(iii,j,kkk) end do end do end do end if ! ! Left side (x), Right side (y) = Northwest : ! if ( ( nproLzC .eq. 3 ) .and. ( nproRxC .eq. 3 ) ) then k = (zbegin - 3) i = (xend + 3) do j = ijL, ijR do ii = 1, 8 do kk = 1, 8 kkk = k + kk - 1 iii = i - ii + 2 d0f(i,j,k) = d0f(i,j,k) + bnd8AA(kk,ii)*f(iii,j,kkk) end do end do end do end if ! ! Right side (x), Left side (y) = Southeast : ! if ( ( nproRzC .eq. 3 ) .and. ( nproLxC .eq. 3 ) ) then k = (zend + 3) i = (xbegin - 3) do j = ijL, ijR do kk = 1, 8 do ii = 1, 8 kkk = k - kk + 2 iii = i + ii - 1 d0f(i,j,k) = d0f(i,j,k) + bnd8AA(kk,ii)*f(iii,j,kkk) end do end do end do end if ! ! Right side (x), Right side (y) = Northeast : ! if ( ( nproRzC .eq. 3 ) .and. ( nproRxC .eq. 3 ) ) then k = (zend + 3) i = (xend + 3) do j = ijL, ijR do kk = 1, 8 do ii = 1, 8 kkk = k - ii + 2 iii = i - kk + 2 d0f(i,j,k) = d0f(i,j,k) + bnd8AA(kk,ii)*f(iii,j,kkk) end do end do end do end if ! ! Left side (x), Left side (y) = Southwest : ! ! (1,2) if ( ( nproLzC .eq. 3 ) .and. ( nproLxC .ge. 2 ) ) then k = (zbegin - 3) i = (xbegin - 2) do j = ijL, ijR do ii = 1, 8 do kk = 1, 8 kkk = k + ii - 1 iii = i + kk - 2 d0f(i,j,k) = d0f(i,j,k) + bnd8AB(ii,kk)*f(iii,j,kkk) end do end do end do end if ! (2,1) flip x and y if ( ( nproLzC .ge. 2 ) .and. ( nproLxC .eq. 3 ) ) then k = (zbegin - 2) i = (xbegin - 3) do j = ijL, ijR do ii = 1, 8 do kk = 1, 8 kkk = k + kk - 2 iii = i + ii - 1 d0f(i,j,k) = d0f(i,j,k) + bnd8AB(ii,kk)*f(iii,j,kkk) end do end do end do end if ! ! Left side (x), Right side (y) = Northwest : ! !( 1, ny-2) if ( ( nproLzC .eq. 3 ) .and. ( nproRxC .ge. 2 ) ) then k = (zbegin - 3) i = (xend + 2) do j = ijL, ijR do ii = 1, 8 do kk = 1, 8 kkk = k + ii - 1 iii = i - kk + 3 d0f(i,j,k) = d0f(i,j,k) + bnd8AB(ii,kk)*f(iii,j,kkk) end do end do end do end if !( 2, ny-1) if ( ( nproLzC .ge. 2 ) .and. ( nproRxC .eq. 3 ) ) then k = (zbegin - 2) i = (xend + 3) do j = ijL, ijR do ii = 1, 8 do kk = 1, 8 kkk = k + kk - 2 iii = i - ii + 2 d0f(i,j,k) = d0f(i,j,k) + bnd8AB(ii,kk)*f(iii,j,kkk) end do end do end do end if ! ! Right side (x), Left side (y) = Southeast : ! if ( ( nproRzC .eq. 3 ) .and. ( nproLxC .ge. 2 ) ) then !( nx-1, 2) k = (zend + 3) i = (xbegin - 2) do j = ijL, ijR do kk = 1, 8 do ii = 1, 8 kkk = k - ii + 2 iii = i + kk - 2 d0f(i,j,k) = d0f(i,j,k) + bnd8AB(ii,kk)*f(iii,j,kkk) end do end do end do end if !( nx-2, 1) if ( ( nproRzC .ge. 2 ) .and. ( nproLxC .eq. 3 ) ) then k = (zend + 2) i = (xbegin - 3) do j = ijL, ijR do kk = 1, 8 do ii = 1, 8 kkk = k - kk + 3 iii = i + ii - 1 d0f(i,j,k) = d0f(i,j,k) + bnd8AB(ii,kk)*f(iii,j,kkk) end do end do end do end if ! ! Right side (x), Right side (y) = Northeast : ! ! (nx-1,ny-2) if ( ( nproRzC .eq. 3 ) .and. ( nproRxC .ge. 2 ) ) then k = (zend + 3) i = (xend + 2) do j = ijL, ijR do kk = 1, 8 do ii = 1, 8 kkk = k - ii + 2 iii = i - kk + 3 d0f(i,j,k) = d0f(i,j,k) + bnd8AB(ii,kk)*f(iii,j,kkk) end do end do end do end if ! (nx-2,ny-1) if ( ( nproRzC .ge. 2 ) .and. ( nproRxC .eq. 3 ) ) then k = (zend + 2) i = (xend + 3) do j = ijL, ijR do kk = 1, 8 do ii = 1, 8 kkk = k - kk + 3 iii = i - ii + 2 d0f(i,j,k) = d0f(i,j,k) + bnd8AB(ii,kk)*f(iii,j,kkk) end do end do end do end if ! ! Left side (x), Left side (y) = Southwest : ! ! (1,3) if ( ( nproLzC .eq. 3 ) .and. ( nproLxC .ge. 1 ) ) then k = (zbegin - 3) i = (xbegin - 1) do j = ijL, ijR do ii = 1, 8 do kk = 1, 8 kkk = k + ii - 1 iii = i + kk - 3 d0f(i,j,k) = d0f(i,j,k) + bnd8AC(ii,kk)*f(iii,j,kkk) end do end do end do end if ! (3,1) flip x and y if ( ( nproLzC .ge. 1 ) .and. ( nproLxC .eq. 3 ) ) then k = (zbegin - 1) i = (xbegin - 3) do j = ijL, ijR do ii = 1, 8 do kk = 1, 8 kkk = k + kk - 3 iii = i + ii - 1 d0f(i,j,k) = d0f(i,j,k) + bnd8AC(ii,kk)*f(iii,j,kkk) end do end do end do end if ! ! Left side (x), Right side (y) = Northwest : ! !( 1, ny-3) if ( ( nproLzC .eq. 3 ) .and. ( nproRxC .ge. 1 ) ) then k = (zbegin - 3) i = (xend + 1) do j = ijL, ijR do ii = 1, 8 do kk = 1, 8 kkk = k + ii - 1 iii = i - kk + 4 d0f(i,j,k) = d0f(i,j,k) + bnd8AC(ii,kk)*f(iii,j,kkk) end do end do end do end if !( 3, ny-1) if ( ( nproLzC .ge. 1 ) .and. ( nproRxC .eq. 3 ) ) then k = (zbegin - 1) i = (xend + 3) do j = ijL, ijR do ii = 1, 8 do kk = 1, 8 kkk = k + kk - 3 iii = i - ii + 2 d0f(i,j,k) = d0f(i,j,k) + bnd8AC(ii,kk)*f(iii,j,kkk) end do end do end do end if ! ! Right side (x), Left side (y) = Southeast : ! if ( ( nproRzC .eq. 3 ) .and. ( nproLxC .ge. 1 ) ) then !( nx-1, 3) k = (zend + 3) i = (xbegin - 1) do j = ijL, ijR do kk = 1, 8 do ii = 1, 8 kkk = k - ii + 2 iii = i + kk - 3 d0f(i,j,k) = d0f(i,j,k) + bnd8AC(ii,kk)*f(iii,j,kkk) end do end do end do end if !( nx-3, 1) if ( ( nproRzC .ge. 1 ) .and. ( nproLxC .eq. 3 ) ) then k = (zend + 1) i = (xbegin - 3) do j = ijL, ijR do kk = 1, 8 do ii = 1, 8 kkk = k - kk + 4 iii = i + ii - 1 d0f(i,j,k) = d0f(i,j,k) + bnd8AC(ii,kk)*f(iii,j,kkk) end do end do end do end if ! ! Right side (x), Right side (y) = Northeast : ! ! (nx-1,ny-3) if ( ( nproRzC .eq. 3 ) .and. ( nproRxC .ge. 1 ) ) then k = (zend + 3) i = (xend + 1) do j = ijL, ijR do kk = 1, 8 do ii = 1, 8 kkk = k - ii + 2 iii = i - kk + 4 d0f(i,j,k) = d0f(i,j,k) + bnd8AC(ii,kk)*f(iii,j,kkk) end do end do end do end if ! (nx-3,ny-1) if ( ( nproRzC .ge. 1 ) .and. ( nproRxC .eq. 3 ) ) then k = (zend + 1) i = (xend + 3) do j = ijL, ijR do kk = 1, 8 do ii = 1, 8 kkk = k - kk + 4 iii = i - ii + 2 d0f(i,j,k) = d0f(i,j,k) + bnd8AC(ii,kk)*f(iii,j,kkk) end do end do end do end if ! if ( ( nproLzC .ge. 2 ) .and. ( nproLxC .ge. 2 ) ) then k = (zbegin - 2) i = (xbegin - 2) do j = ijL, ijR do ii = 1, 8 do kk = 1, 8 kkk = k + kk - 2 iii = i + ii - 2 d0f(i,j,k) = d0f(i,j,k) + bnd8BB(kk,ii)*f(iii,j,kkk) end do end do end do end if ! ! Left side (x), Right side (y) = Northwest : ! if ( ( nproLzC .ge. 2 ) .and. ( nproRxC .ge. 2 ) ) then k = (zbegin - 2) i = (xend + 2) do j = ijL, ijR do ii = 1, 8 do kk = 1, 8 kkk = k + kk - 2 iii = i - ii + 3 d0f(i,j,k) = d0f(i,j,k) + bnd8BB(kk,ii)*f(iii,j,kkk) end do end do end do end if ! ! Right side (x), Left side (y) = Southeast : ! if ( ( nproRzC .ge. 2 ) .and. ( nproLxC .ge. 2 ) ) then k = (zend + 2) i = (xbegin - 2) do j = ijL, ijR do kk = 1, 8 do ii = 1, 8 kkk = k - kk + 3 iii = i + ii - 2 d0f(i,j,k) = d0f(i,j,k) + bnd8BB(kk,ii)*f(iii,j,kkk) end do end do end do end if ! ! Right side (x), Right side (y) = Northeast : ! if ( ( nproRzC .ge. 2 ) .and. ( nproRxC .ge. 2 ) ) then k = (zend + 2) i = (xend + 2) do j = ijL, ijR do kk = 1, 8 do ii = 1, 8 kkk = k - ii + 3 iii = i - kk + 3 d0f(i,j,k) = d0f(i,j,k) + bnd8BB(kk,ii)*f(iii,j,kkk) end do end do end do end if ! ! Left side (x), Left side (y) = Southwest : ! ! (2,3) if ( ( nproLzC .ge. 2 ) .and. ( nproLxC .ge. 2 ) ) then k = (zbegin - 2) i = (xbegin - 1) do j = ijL, ijR do ii = 1, 8 do kk = 1, 8 kkk = k + ii - 2 iii = i + kk - 3 d0f(i,j,k) = d0f(i,j,k) + bnd8BC(ii,kk)*f(iii,j,kkk) end do end do end do end if ! (3,2) flip x and y if ( ( nproLzC .ge. 2 ) .and. ( nproLxC .ge. 2 ) ) then k = (zbegin - 1) i = (xbegin - 2) do j = ijL, ijR do ii = 1, 8 do kk = 1, 8 kkk = k + kk - 3 iii = i + ii - 2 d0f(i,j,k) = d0f(i,j,k) + bnd8BC(ii,kk)*f(iii,j,kkk) end do end do end do end if ! ! Left side (x), Right side (y) = Northwest : ! !( 2, ny-3) if ( ( nproLzC .ge. 2 ) .and. ( nproRxC .ge. 2 ) ) then k = (zbegin - 2) i = (xend + 1) do j = ijL, ijR do ii = 1, 8 do kk = 1, 8 kkk = k + ii - 2 iii = i - kk + 4 d0f(i,j,k) = d0f(i,j,k) + bnd8BC(ii,kk)*f(iii,j,kkk) end do end do end do end if !( 3, ny-2) if ( ( nproLzC .ge. 2 ) .and. ( nproRxC .ge. 2 ) ) then k = (zbegin - 1) i = (xend + 2) do j = ijL, ijR do ii = 1, 8 do kk = 1, 8 kkk = k + kk - 3 iii = i - ii + 3 d0f(i,j,k) = d0f(i,j,k) + bnd8BC(ii,kk)*f(iii,j,kkk) end do end do end do end if ! ! Right side (x), Left side (y) = Southeast : ! if ( ( nproRzC .ge. 2 ) .and. ( nproLxC .ge. 2 ) ) then !( nx-2, 3) k = (zend + 2) i = (xbegin - 1) do j = ijL, ijR do kk = 1, 8 do ii = 1, 8 kkk = k - ii + 3 iii = i + kk - 3 d0f(i,j,k) = d0f(i,j,k) + bnd8BC(ii,kk)*f(iii,j,kkk) end do end do end do end if !( nx-3, 2) if ( ( nproRzC .ge. 2 ) .and. ( nproLxC .ge. 2 ) ) then k = (zend + 1) i = (xbegin - 2) do j = ijL, ijR do kk = 1, 8 do ii = 1, 8 kkk = k - kk + 4 iii = i + ii - 2 d0f(i,j,k) = d0f(i,j,k) + bnd8BC(ii,kk)*f(iii,j,kkk) end do end do end do end if ! ! Right side (x), Right side (y) = Northeast : ! ! (nx-2,ny-3) if ( ( nproRzC .ge. 2 ) .and. ( nproRxC .ge. 2 ) ) then k = (zend + 2) i = (xend + 1) do j = ijL, ijR do kk = 1, 8 do ii = 1, 8 kkk = k - ii + 3 iii = i - kk + 4 d0f(i,j,k) = d0f(i,j,k) + bnd8BC(ii,kk)*f(iii,j,kkk) end do end do end do end if ! (nx-3,ny-2) if ( ( nproRzC .ge. 2 ) .and. ( nproRxC .ge. 2 ) ) then k = (zend + 1) i = (xend + 2) do j = ijL, ijR do kk = 1, 8 do ii = 1, 8 kkk = k - kk + 4 iii = i - ii + 3 d0f(i,j,k) = d0f(i,j,k) + bnd8BC(ii,kk)*f(iii,j,kkk) end do end do end do end if ! if ( ( nproLzC .ge. 1 ) .and. ( nproLxC .ge. 1 ) ) then k = (zbegin - 1) i = (xbegin - 1) do j = ijL, ijR do ii = 1, 8 do kk = 1, 8 kkk = k + kk - 3 iii = i + ii - 3 d0f(i,j,k) = d0f(i,j,k) + bnd8CC(kk,ii)*f(iii,j,kkk) end do end do end do end if ! ! Left side (x), Right side (y) = Northwest : ! if ( ( nproLzC .ge. 1 ) .and. ( nproRxC .ge. 1 ) ) then k = (zbegin - 1) i = (xend + 1) do j = ijL, ijR do ii = 1, 8 do kk = 1, 8 kkk = k + kk - 3 iii = i - ii + 4 d0f(i,j,k) = d0f(i,j,k) + bnd8CC(kk,ii)*f(iii,j,kkk) end do end do end do end if ! ! Right side (x), Left side (y) = Southeast : ! if ( ( nproRzC .ge. 1 ) .and. ( nproLxC .ge. 1 ) ) then k = (zend + 1) i = (xbegin - 1) do j = ijL, ijR do kk = 1, 8 do ii = 1, 8 kkk = k - kk + 4 iii = i + ii - 3 d0f(i,j,k) = d0f(i,j,k) + bnd8CC(kk,ii)*f(iii,j,kkk) end do end do end do end if ! ! Right side (x), Right side (y) = Northeast : ! if ( ( nproRzC .ge. 1 ) .and. ( nproRxC .ge. 1 ) ) then k = (zend + 1) i = (xend + 1) do j = ijL, ijR do kk = 1, 8 do ii = 1, 8 kkk = k - ii + 4 iii = i - kk + 4 d0f(i,j,k) = d0f(i,j,k) + bnd8CC(kk,ii)*f(iii,j,kkk) 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,bkL,bkR) .lt. 4 ) then ierror = -110 error = 'DER_0_2D: Too few Green cells for orderi=10' return endif ! ! Internal nodes: ! do k = zbegin, zend do j = ijL, ijR do i = xbegin, xend sum = 0.d0 do kk = 1, 10 do ii = 1, 10 sum = sum + bnd10I(kk,ii)* f(i+ii-5,j,k+kk-5) enddo enddo d0f(i,j,k) = sum enddo enddo enddo ! end if ! return end !====================================================================