!==================================================================== ! subroutine yz_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. (pjR-pjL+1)) .or. (width .gt. (pkR-pkL+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-1 do i = iiL, iiR 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 = ybegin, yend do i = iiL, iiR d0f(i,j,k) = a1 *( f(i,j+0,k+1)+f(i,j+1,k+1) & + f(i,j+0,k+0)+f(i,j+1,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 = ybegin, yend do i = iiL, iiR d0f(i,j,k) = a1 *( f(i,j+0,k+1)+f(i,j+1,k+1) & + f(i,j+0,k+0)+f(i,j+1,k+0) ) & + b1 *( f(i,j+2,k+1)+f(i,j+2,k+0) & + f(i,j+1,k+2)+f(i,j+1,k-1) & + f(i,j+0,k+2)+f(i,j+0,k-1) & + f(i,j-1,k+0)+f(i,j-1,k+1) ) & + b2 *( f(i,j+2,k+2)+f(i,j-1,k+2) & + f(i,j+2,k-1)+f(i,j-1,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 ( nproLz .eq. 1 ) then k = (zbegin - 1) do j = ybegin, yend do i = iiL, iiR do jj = 1, 4 do kk = 1, 4 jjj = j + jj - 2 kkk = k + kk - 1 d0f(i,j,k) = d0f(i,j,k) + bnd4AB(kk,jj)*f(i,jjj,kkk) end do end do end do end do end if ! ! Right side (z) = North: ! if ( nproRz .eq. 1 ) then k = (zend + 1) do j = ybegin, yend do i = iiL, iiR do jj = 1, 4 do kk = 1, 4 jjj = j + jj - 2 kkk = k - kk + 2 d0f(i,j,k) = d0f(i,j,k) + bnd4AB(kk,jj)*f(i,jjj,kkk) end do end do end do end do end if ! ! Left side (y) = West: ! if ( nproLy .eq. 1 ) then j = (ybegin - 1) do k = zbegin, zend do i = iiL, iiR do jj = 1, 4 do kk = 1, 4 jjj = j + kk - 1 kkk = k + jj - 2 d0f(i,j,k) = d0f(i,j,k) + bnd4AB(kk,jj)*f(i,jjj,kkk) end do end do end do end do end if ! ! Right side (y) = East: ! if ( nproRy .eq. 1 ) then j = (yend + 1) do k = zbegin, zend do i = iiL, iiR do jj = 1, 4 do kk = 1, 4 jjj = j - kk + 2 kkk = k + jj - 2 d0f(i,j,k) = d0f(i,j,k) + bnd4AB(kk,jj)*f(i,jjj,kkk) end do end do end do end do end if ! if ( .not. corner ) then ! nproLyC = 1 nproLzC = 1 nproRyC = 1 nproRzC = 1 else nproLyC = nproLy nproLzC = nproLz nproRyC = nproRy nproRzC = nproRz ! endif ! ! Solve for all 2D-Corners (AA) ! ============================= ! ! if ( ( nproLyC .eq. 1 ) .and. ( nproLzC .eq. 1 ) ) then j = (ybegin - 1) k = (zbegin - 1) do i = iiL, iiR do kk = 1, 4 do jj = 1, 4 jjj = j + jj - 1 kkk = k + kk - 1 d0f(i,j,k) = d0f(i,j,k) + bnd4AA(jj,kk)*f(i,jjj,kkk) end do end do end do end if ! ! Left side (y), Right side (z) = Northwest : ! if ( ( nproLyC .eq. 1 ) .and. ( nproRzC .eq. 1 ) ) then j = (ybegin - 1) k = (zend + 1) do i = iiL, iiR do kk = 1, 4 do jj = 1, 4 jjj = j + jj - 1 kkk = k - kk + 2 d0f(i,j,k) = d0f(i,j,k) + bnd4AA(jj,kk)*f(i,jjj,kkk) end do end do end do end if ! ! Right side (y), Left side (z) = Southeast : ! if ( ( nproRyC .eq. 1 ) .and. ( nproLzC .eq. 1 ) ) then j = (yend + 1) k = (zbegin - 1) do i = iiL, iiR do jj = 1, 4 do kk = 1, 4 jjj = j - jj + 2 kkk = k + kk - 1 d0f(i,j,k) = d0f(i,j,k) + bnd4AA(jj,kk)*f(i,jjj,kkk) end do end do end do end if ! ! Right side (y), Right side (z) = Northeast : ! if ( ( nproRyC .eq. 1 ) .and. ( nproRzC .eq. 1 ) ) then j = (yend + 1) k = (zend + 1) do i = iiL, iiR do jj = 1, 4 do kk = 1, 4 jjj = j - kk + 2 kkk = k - jj + 2 d0f(i,j,k) = d0f(i,j,k) + bnd4AA(jj,kk)*f(i,jjj,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 = ybegin, yend do i = iiL, iiR d0f(i,j,k) = a1 *( f(i,j+0,k+1)+f(i,j+1,k+1) & + f(i,j+0,k+0)+f(i,j+1,k+0) ) & + b1 *( f(i,j+2,k+1)+f(i,j+2,k+0) & + f(i,j+1,k+2)+f(i,j+1,k-1) & + f(i,j+0,k+2)+f(i,j+0,k-1) & + f(i,j-1,k+0)+f(i,j-1,k+1) ) & + b2 *( f(i,j+2,k+2)+f(i,j-1,k+2) & + f(i,j+2,k-1)+f(i,j-1,k-1) ) & + c1 *( f(i,j+3,k+1)+f(i,j+3,k+0) & + f(i,j+0,k+3)+f(i,j+1,k-2) & + f(i,j+1,k+3)+f(i,j+0,k-2) & + f(i,j-2,k+1)+f(i,j-2,k+0) ) & + c2 *( f(i,j+3,k+2)+f(i,j+3,k-1) & + f(i,j+2,k+3)+f(i,j+2,k-2) & + f(i,j-1,k+3)+f(i,j-1,k-2) & + f(i,j-2,k+2)+f(i,j-2,k-1) ) & + c3 *( f(i,j+3,k+3)+f(i,j+3,k-2) & + f(i,j-2,k+3)+f(i,j-2,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 ( nproLz .eq. 2 ) then k = (zbegin - 2) do j = ybegin, yend do i = iiL, iiR do jj = 1, 6 do kk = 1, 6 jjj = j + jj - 3 kkk = k + kk - 1 d0f(i,j,k) = d0f(i,j,k) + bnd6AC(kk,jj)*f(i,jjj,kkk) end do end do end do end do end if ! ! Right side (y) = North: ! if ( nproRz .eq. 2 ) then k = (zend + 2) do j = ybegin, yend do i = iiL, iiR do jj = 1, 6 do kk = 1, 6 jjj = j + jj - 3 kkk = k - kk + 2 d0f(i,j,k) = d0f(i,j,k) + bnd6AC(kk,jj)*f(i,jjj,kkk) end do end do end do end do end if ! ! Left side (x) = West: ! if ( nproLy .eq. 2 ) then j = (ybegin - 2) do k = zbegin, zend do i = iiL, iiR do jj = 1, 6 do kk = 1, 6 jjj = j + kk - 1 kkk = k + jj - 3 d0f(i,j,k) = d0f(i,j,k) + bnd6AC(kk,jj)*f(i,jjj,kkk) end do end do end do end do end if ! ! Right side (x) = East: ! if ( nproRy .eq. 2 ) then j = (yend + 2) do k = zbegin, zend do i = iiL, iiR do jj = 1, 6 do kk = 1, 6 jjj = j - kk + 2 kkk = k + jj - 3 d0f(i,j,k) = d0f(i,j,k) + bnd6AC(kk,jj)*f(i,jjj,kkk) end do end do end do end do end if ! ! Left side (y) = South: ! if ( nproLz .ge. 1 ) then k = (zbegin - 1) do j = ybegin, yend do i = iiL, iiR do jj = 1, 6 do kk = 1, 6 jjj = j + jj - 3 kkk = k + kk - 2 d0f(i,j,k) = d0f(i,j,k) + bnd6BC(kk,jj)*f(i,jjj,kkk) end do end do end do end do end if ! ! Right side (y) = North: ! if ( nproRz .ge. 1 ) then k = (zend + 1) do j = ybegin, yend do i = iiL, iiR do jj = 1, 6 do kk = 1, 6 jjj = j + jj - 3 kkk = k - kk + 3 d0f(i,j,k) = d0f(i,j,k) + bnd6BC(kk,jj)*f(i,jjj,kkk) end do end do end do end do end if ! ! Left side (x) = West: ! if ( nproLy .ge. 1 ) then j = (ybegin - 1) do k = zbegin, zend do i = iiL, iiR do jj = 1, 6 do kk = 1, 6 jjj = j + kk - 2 kkk = k + jj - 3 d0f(i,j,k) = d0f(i,j,k) + bnd6BC(kk,jj)*f(i,jjj,kkk) end do end do end do end do end if ! ! Right side (x) = East: ! if ( nproRy .ge. 1 ) then j = (yend + 1) do k = zbegin, zend do i = iiL, iiR do jj = 1, 6 do kk = 1, 6 jjj = j - kk + 3 kkk = k + jj - 3 d0f(i,j,k) = d0f(i,j,k) + bnd6BC(kk,jj)*f(i,jjj,kkk) end do end do end do end do end if ! if ( .not. corner ) then ! nproLyC = 2 nproLzC = 2 nproRyC = 2 nproRzC = 2 else nproLyC = nproLy nproLzC = nproLz nproRyC = nproRy nproRzC = nproRz ! endif ! ! Solve for all 2D-Corners (AA, AB, BB) ! ===================================== ! if ( ( nproLyC .eq. 2 ) .and. ( nproLzC .eq. 2 ) ) then j = (ybegin - 2) k = (zbegin - 2) do i = iiL, iiR do kk = 1, 6 do jj = 1, 6 jjj = j + jj - 1 kkk = k + kk - 1 d0f(i,j,k) = d0f(i,j,k) + bnd6AA(jj,kk)*f(i,jjj,kkk) end do end do end do end if ! ! Left side (x), Right side (y) = Northwest : ! if ( ( nproLyC .eq. 2 ) .and. ( nproRzC .eq. 2 ) ) then j = (ybegin - 2) k = (zend + 2) do i = iiL, iiR do kk = 1, 6 do jj = 1, 6 jjj = j + jj - 1 kkk = k - kk + 2 d0f(i,j,k) = d0f(i,j,k) + bnd6AA(jj,kk)*f(i,jjj,kkk) end do end do end do end if ! ! Right side (x), Left side (y) = Southeast : ! if ( ( nproRyC .eq. 2 ) .and. ( nproLzC .eq. 2 ) ) then j = (yend + 2) k = (zbegin - 2) do i = iiL, iiR do jj = 1, 6 do kk = 1, 6 jjj = j - jj + 2 kkk = k + kk - 1 d0f(i,j,k) = d0f(i,j,k) + bnd6AA(jj,kk)*f(i,jjj,kkk) end do end do end do end if ! ! Right side (x), Right side (y) = Northeast : ! if ( ( nproRyC .eq. 2 ) .and. ( nproRzC .eq. 2 ) ) then j = (yend + 2) k = (zend + 2) do i = iiL, iiR do jj = 1, 6 do kk = 1, 6 jjj = j - kk + 2 kkk = k - jj + 2 d0f(i,j,k) = d0f(i,j,k) + bnd6AA(jj,kk)*f(i,jjj,kkk) end do end do end do end if ! ! Left side (x), Left side (y) = Southwest : ! ! (1,2) if ( ( nproLyC .eq. 2 ) .and. ( nproLzC .ge. 1 ) ) then j = (ybegin - 2) k = (zbegin - 1) do i = iiL, iiR do kk = 1, 6 do jj = 1, 6 jjj = j + kk - 1 kkk = k + jj - 2 d0f(i,j,k) = d0f(i,j,k) + bnd6AB(kk,jj)*f(i,jjj,kkk) end do end do end do end if ! (2,1) flip x and y if ( ( nproLyC .ge. 1 ) .and. ( nproLzC .eq. 2 ) ) then j = (ybegin - 1) k = (zbegin - 2) do i = iiL, iiR do kk = 1, 6 do jj = 1, 6 jjj = j + jj - 2 kkk = k + kk - 1 d0f(i,j,k) = d0f(i,j,k) + bnd6AB(kk,jj)*f(i,jjj,kkk) end do end do end do end if ! ! Left side (x), Right side (y) = Northwest : ! !( 1, ny-2) if ( ( nproLyC .eq. 2 ) .and. ( nproRzC .ge. 1 ) ) then j = (ybegin - 2) k = (zend + 1) do i = iiL, iiR do kk = 1, 6 do jj = 1, 6 jjj = j + kk - 1 kkk = k - jj + 3 d0f(i,j,k) = d0f(i,j,k) + bnd6AB(kk,jj)*f(i,jjj,kkk) end do end do end do end if !( 2, ny-1) if ( ( nproLyC .ge. 1 ) .and. ( nproRzC .eq. 2 ) ) then j = (ybegin - 1) k = (zend + 2) do i = iiL, iiR do kk = 1, 6 do jj = 1, 6 jjj = j + jj - 2 kkk = k - kk + 2 d0f(i,j,k) = d0f(i,j,k) + bnd6AB(kk,jj)*f(i,jjj,kkk) end do end do end do end if ! ! Right side (x), Left side (y) = Southeast : ! if ( ( nproRyC .eq. 2 ) .and. ( nproLzC .ge. 1 ) ) then !( nx-1, 2) j = (yend + 2) k = (zbegin - 1) do i = iiL, iiR do jj = 1, 6 do kk = 1, 6 jjj = j - kk + 2 kkk = k + jj - 2 d0f(i,j,k) = d0f(i,j,k) + bnd6AB(kk,jj)*f(i,jjj,kkk) end do end do end do end if !( nx-2, 1) if ( ( nproRyC .ge. 1 ) .and. ( nproLzC .eq. 2 ) ) then j = (yend + 1) k = (zbegin - 2) do i = iiL, iiR do jj = 1, 6 do kk = 1, 6 jjj = j - jj + 3 kkk = k + kk - 1 d0f(i,j,k) = d0f(i,j,k) + bnd6AB(kk,jj)*f(i,jjj,kkk) end do end do end do end if ! ! Right side (x), Right side (y) = Northeast : ! ! (nx-1,ny-2) if ( ( nproRyC .eq. 2 ) .and. ( nproRzC .ge. 1 ) ) then j = (yend + 2) k = (zend + 1) do i = iiL, iiR do jj = 1, 6 do kk = 1, 6 jjj = j - kk + 2 kkk = k - jj + 3 d0f(i,j,k) = d0f(i,j,k) + bnd6AB(kk,jj)*f(i,jjj,kkk) end do end do end do end if ! (nx-2,ny-1) if ( ( nproRyC .ge. 1 ) .and. ( nproRzC .eq. 2 ) ) then j = (yend + 1) k = (zend + 2) do i = iiL, iiR do jj = 1, 6 do kk = 1, 6 jjj = j - jj + 3 kkk = k - kk + 2 d0f(i,j,k) = d0f(i,j,k) + bnd6AB(kk,jj)*f(i,jjj,kkk) end do end do end do end if ! if ( ( nproLyC .ge. 1 ) .and. ( nproLzC .ge. 1 ) ) then j = (ybegin - 1) k = (zbegin - 1) do i = iiL, iiR do kk = 1, 6 do jj = 1, 6 jjj = j + jj - 2 kkk = k + kk - 2 d0f(i,j,k) = d0f(i,j,k) + bnd6BB(jj,kk)*f(i,jjj,kkk) end do end do end do end if ! ! Left side (x), Right side (y) = Northwest : ! if ( ( nproLyC .ge. 1 ) .and. ( nproRzC .ge. 1 ) ) then j = (ybegin - 1) k = (zend + 1) do i = iiL, iiR do kk = 1, 6 do jj = 1, 6 jjj = j + jj - 2 kkk = k - kk + 3 d0f(i,j,k) = d0f(i,j,k) + bnd6BB(jj,kk)*f(i,jjj,kkk) end do end do end do end if ! ! Right side (x), Left side (y) = Southeast : ! if ( ( nproRyC .ge. 1 ) .and. ( nproLzC .ge. 1 ) ) then j = (yend + 1) k = (zbegin - 1) do i = iiL, iiR do jj = 1, 6 do kk = 1, 6 jjj = j - jj + 3 kkk = k + kk - 2 d0f(i,j,k) = d0f(i,j,k) + bnd6BB(jj,kk)*f(i,jjj,kkk) end do end do end do end if ! ! Right side (x), Right side (y) = Northeast : ! if ( ( nproRyC .ge. 1 ) .and. ( nproRzC .ge. 1 ) ) then j = (yend + 1) k = (zend + 1) do i = iiL, iiR do jj = 1, 6 do kk = 1, 6 jjj = j - kk + 3 kkk = k - jj + 3 d0f(i,j,k) = d0f(i,j,k) + bnd6BB(jj,kk)*f(i,jjj,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 = ybegin, yend do i = iiL, iiR sum = 0.d0 do jj = 1, 8 do kk = 1, 8 sum = sum + bnd8I(jj,kk)* f(i,j+jj-4,k+kk-4) enddo enddo d0f(i,j,k) = sum enddo enddo enddo ! ! Boundary nodes: ! ! Solve for all 1D-corners (AD, BD, CD) ! ===================================== ! if( orderb .eq. 8) then ! ! Left side (y) = South: ! if ( nproLz .eq. 3 ) then k = (zbegin - 3) do j = ybegin, yend do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j + jj - 4 kkk = k + kk - 1 d0f(i,j,k) = d0f(i,j,k) + bnd8AD(kk,jj)*f(i,jjj,kkk) end do end do end do end do end if ! ! Right side (y) = North: ! if ( nproRz .eq. 3 ) then k = (zend + 3) do j = ybegin, yend do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j + jj - 4 kkk = k - kk + 2 d0f(i,j,k) = d0f(i,j,k) + bnd8AD(kk,jj)*f(i,jjj,kkk) end do end do end do end do end if ! ! Left side (x) = West: ! if ( nproLy .eq. 3 ) then j = (ybegin - 3) do k = zbegin, zend do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j + kk - 1 kkk = k + jj - 4 d0f(i,j,k) = d0f(i,j,k) + bnd8AD(kk,jj)*f(i,jjj,kkk) end do end do end do end do end if ! ! Right side (x) = East: ! if ( nproRy .eq. 3 ) then j = (yend + 3) do k = zbegin, zend do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j - kk + 2 kkk = k + jj - 4 d0f(i,j,k) = d0f(i,j,k) + bnd8AD(kk,jj)*f(i,jjj,kkk) end do end do end do end do end if ! ! Left side (y) = South: ! if ( nproLz .ge. 2 ) then k = (zbegin - 2) do j = ybegin, yend do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j + jj - 4 kkk = k + kk - 2 d0f(i,j,k) = d0f(i,j,k) + bnd8BD(kk,jj)*f(i,jjj,kkk) end do end do end do end do end if ! ! Right side (y) = North: ! if ( nproRz .ge. 2 ) then k = (zend + 2) do j = ybegin, yend do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j + jj - 4 kkk = k - kk + 3 d0f(i,j,k) = d0f(i,j,k) + bnd8BD(kk,jj)*f(i,jjj,kkk) end do end do end do end do end if ! ! Left side (x) = West: ! if ( nproLy .ge. 2 ) then j = (ybegin - 2) do k = zbegin, zend do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j + kk - 2 kkk = k + jj - 4 d0f(i,j,k) = d0f(i,j,k) + bnd8BD(kk,jj)*f(i,jjj,kkk) end do end do end do end do end if ! ! Right side (x) = East: ! if ( nproRy .ge. 2 ) then j = (yend + 2) do k = zbegin, zend do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j - kk + 3 kkk = k + jj - 4 d0f(i,j,k) = d0f(i,j,k) + bnd8BD(kk,jj)*f(i,jjj,kkk) end do end do end do end do end if ! ! Left side (y) = South: ! if ( nproLz .ge. 1 ) then k = (zbegin - 1) do j = ybegin, yend do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j + jj - 4 kkk = k + kk - 3 d0f(i,j,k) = d0f(i,j,k) + bnd8CD(kk,jj)*f(i,jjj,kkk) end do end do end do end do end if ! ! Right side (y) = North: ! if ( nproRz .ge. 1 ) then k = (zend + 1) do j = ybegin, yend do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j + jj - 4 kkk = k - kk + 4 d0f(i,j,k) = d0f(i,j,k) + bnd8CD(kk,jj)*f(i,jjj,kkk) end do end do end do end do end if ! ! Left side (x) = West: ! if ( nproLy .ge. 1 ) then j = (ybegin - 1) do k = zbegin, zend do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j + kk - 3 kkk = k + jj - 4 d0f(i,j,k) = d0f(i,j,k) + bnd8CD(kk,jj)*f(i,jjj,kkk) end do end do end do end do end if ! ! Right side (x) = East: ! if ( nproRy .ge. 1 ) then j = (yend + 1) do k = zbegin, zend do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j - kk + 4 kkk = k + jj - 4 d0f(i,j,k) = d0f(i,j,k) + bnd8CD(kk,jj)*f(i,jjj,kkk) end do end do end do end do end if ! if ( .not. corner ) then ! nproLyC = 3 nproLzC = 3 nproRyC = 3 nproRzC = 3 else nproLzC = nproLz nproLyC = nproLy nproRzC = nproRz nproRyC = nproRy ! endif ! ! Solve for all 2D-Corners (AA, AB, AC, BB, BC, CC) ! ================================================= ! if ( ( nproLyC .eq. 3 ) .and. ( nproLzC .eq. 3 ) ) then j = (ybegin - 3) k = (zbegin - 3) do i = iiL, iiR do kk = 1, 8 do jj = 1, 8 jjj = j + jj - 1 kkk = k + kk - 1 d0f(i,j,k) = d0f(i,j,k) + bnd8AA(jj,kk)*f(i,jjj,kkk) end do end do end do end if ! ! Left side (x), Right side (y) = Northwest : ! if ( ( nproLyC .eq. 3 ) .and. ( nproRzC .eq. 3 ) ) then j = (ybegin - 3) k = (zend + 3) do i = iiL, iiR do kk = 1, 8 do jj = 1, 8 jjj = j + jj - 1 kkk = k - kk + 2 d0f(i,j,k) = d0f(i,j,k) + bnd8AA(jj,kk)*f(i,jjj,kkk) end do end do end do end if ! ! Right side (x), Left side (y) = Southeast : ! if ( ( nproRyC .eq. 3 ) .and. ( nproLzC .eq. 3 ) ) then j = (yend + 3) k = (zbegin - 3) do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j - jj + 2 kkk = k + kk - 1 d0f(i,j,k) = d0f(i,j,k) + bnd8AA(jj,kk)*f(i,jjj,kkk) end do end do end do end if ! ! Right side (x), Right side (y) = Northeast : ! if ( ( nproRyC .eq. 3 ) .and. ( nproRzC .eq. 3 ) ) then j = (yend + 3) k = (zend + 3) do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j - kk + 2 kkk = k - jj + 2 d0f(i,j,k) = d0f(i,j,k) + bnd8AA(jj,kk)*f(i,jjj,kkk) end do end do end do end if ! ! Left side (x), Left side (y) = Southwest : ! ! (1,2) if ( ( nproLyC .eq. 3 ) .and. ( nproLzC .ge. 2 ) ) then j = (ybegin - 3) k = (zbegin - 2) do i = iiL, iiR do kk = 1, 8 do jj = 1, 8 jjj = j + kk - 1 kkk = k + jj - 2 d0f(i,j,k) = d0f(i,j,k) + bnd8AB(kk,jj)*f(i,jjj,kkk) end do end do end do end if ! (2,1) flip x and y if ( ( nproLyC .ge. 2 ) .and. ( nproLzC .eq. 3 ) ) then j = (ybegin - 2) k = (zbegin - 3) do i = iiL, iiR do kk = 1, 8 do jj = 1, 8 jjj = j + jj - 2 kkk = k + kk - 1 d0f(i,j,k) = d0f(i,j,k) + bnd8AB(kk,jj)*f(i,jjj,kkk) end do end do end do end if ! ! Left side (x), Right side (y) = Northwest : ! !( 1, ny-2) if ( ( nproLyC .eq. 3 ) .and. ( nproRzC .ge. 2 ) ) then j = (ybegin - 3) k = (zend + 2) do i = iiL, iiR do kk = 1, 8 do jj = 1, 8 jjj = j + kk - 1 kkk = k - jj + 3 d0f(i,j,k) = d0f(i,j,k) + bnd8AB(kk,jj)*f(i,jjj,kkk) end do end do end do end if !( 2, ny-1) if ( ( nproLyC .ge. 2 ) .and. ( nproRzC .eq. 3 ) ) then j = (ybegin - 2) k = (zend + 3) do i = iiL, iiR do kk = 1, 8 do jj = 1, 8 jjj = j + jj - 2 kkk = k - kk + 2 d0f(i,j,k) = d0f(i,j,k) + bnd8AB(kk,jj)*f(i,jjj,kkk) end do end do end do end if ! ! Right side (x), Left side (y) = Southeast : ! if ( ( nproRyC .eq. 3 ) .and. ( nproLzC .ge. 2 ) ) then !( nx-1, 2) j = (yend + 3) k = (zbegin - 2) do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j - kk + 2 kkk = k + jj - 2 d0f(i,j,k) = d0f(i,j,k) + bnd8AB(kk,jj)*f(i,jjj,kkk) end do end do end do end if !( nx-2, 1) if ( ( nproRyC .ge. 2 ) .and. ( nproLzC .eq. 3 ) ) then j = (yend + 2) k = (zbegin - 3) do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j - jj + 3 kkk = k + kk - 1 d0f(i,j,k) = d0f(i,j,k) + bnd8AB(kk,jj)*f(i,jjj,kkk) end do end do end do end if ! ! Right side (x), Right side (y) = Northeast : ! ! (nx-1,ny-2) if ( ( nproRyC .eq. 3 ) .and. ( nproRzC .ge. 2 ) ) then j = (yend + 3) k = (zend + 2) do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j - kk + 2 kkk = k - jj + 3 d0f(i,j,k) = d0f(i,j,k) + bnd8AB(kk,jj)*f(i,jjj,kkk) end do end do end do end if ! (nx-2,ny-1) if ( ( nproRyC .ge. 2 ) .and. ( nproRzC .eq. 3 ) ) then j = (yend + 2) k = (zend + 3) do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j - jj + 3 kkk = k - kk + 2 d0f(i,j,k) = d0f(i,j,k) + bnd8AB(kk,jj)*f(i,jjj,kkk) end do end do end do end if ! ! Left side (x), Left side (y) = Southwest : ! ! (1,3) if ( ( nproLyC .eq. 3 ) .and. ( nproLzC .ge. 1 ) ) then j = (ybegin - 3) k = (zbegin - 1) do i = iiL, iiR do kk = 1, 8 do jj = 1, 8 jjj = j + kk - 1 kkk = k + jj - 3 d0f(i,j,k) = d0f(i,j,k) + bnd8AC(kk,jj)*f(i,jjj,kkk) end do end do end do end if ! (3,1) flip x and y if ( ( nproLyC .ge. 1 ) .and. ( nproLzC .eq. 3 ) ) then j = (ybegin - 1) k = (zbegin - 3) do i = iiL, iiR do kk = 1, 8 do jj = 1, 8 jjj = j + jj - 3 kkk = k + kk - 1 d0f(i,j,k) = d0f(i,j,k) + bnd8AC(kk,jj)*f(i,jjj,kkk) end do end do end do end if ! ! Left side (x), Right side (y) = Northwest : ! !( 1, ny-3) if ( ( nproLyC .eq. 3 ) .and. ( nproRzC .ge. 1 ) ) then j = (ybegin - 3) k = (zend + 1) do i = iiL, iiR do kk = 1, 8 do jj = 1, 8 jjj = j + kk - 1 kkk = k - jj + 4 d0f(i,j,k) = d0f(i,j,k) + bnd8AC(kk,jj)*f(i,jjj,kkk) end do end do end do end if !( 3, ny-1) if ( ( nproLyC .ge. 1 ) .and. ( nproRzC .eq. 3 ) ) then j = (ybegin - 1) k = (zend + 3) do i = iiL, iiR do kk = 1, 8 do jj = 1, 8 jjj = j + jj - 3 kkk = k - kk + 2 d0f(i,j,k) = d0f(i,j,k) + bnd8AC(kk,jj)*f(i,jjj,kkk) end do end do end do end if ! ! Right side (x), Left side (y) = Southeast : ! if ( ( nproRyC .eq. 3 ) .and. ( nproLzC .ge. 1 ) ) then !( nx-1, 3) j = (yend + 3) k = (zbegin - 1) do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j - kk + 2 kkk = k + jj - 3 d0f(i,j,k) = d0f(i,j,k) + bnd8AC(kk,jj)*f(i,jjj,kkk) end do end do end do end if !( nx-3, 1) if ( ( nproRyC .ge. 1 ) .and. ( nproLzC .eq. 3 ) ) then j = (yend + 1) k = (zbegin - 3) do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j - jj + 4 kkk = k + kk - 1 d0f(i,j,k) = d0f(i,j,k) + bnd8AC(kk,jj)*f(i,jjj,kkk) end do end do end do end if ! ! Right side (x), Right side (y) = Northeast : ! ! (nx-1,ny-3) if ( ( nproRyC .eq. 3 ) .and. ( nproRzC .ge. 1 ) ) then j = (yend + 3) k = (zend + 1) do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j - kk + 2 kkk = k - jj + 4 d0f(i,j,k) = d0f(i,j,k) + bnd8AC(kk,jj)*f(i,jjj,kkk) end do end do end do end if ! (nx-3,ny-1) if ( ( nproRyC .ge. 1 ) .and. ( nproRzC .eq. 3 ) ) then j = (yend + 1) k = (zend + 3) do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j - jj + 4 kkk = k - kk + 2 d0f(i,j,k) = d0f(i,j,k) + bnd8AC(kk,jj)*f(i,jjj,kkk) end do end do end do end if ! if ( ( nproLyC .ge. 2 ) .and. ( nproLzC .ge. 2 ) ) then j = (ybegin - 2) k = (zbegin - 2) do i = iiL, iiR do kk = 1, 8 do jj = 1, 8 jjj = j + jj - 2 kkk = k + kk - 2 d0f(i,j,k) = d0f(i,j,k) + bnd8BB(jj,kk)*f(i,jjj,kkk) end do end do end do end if ! ! Left side (x), Right side (y) = Northwest : ! if ( ( nproLyC .ge. 2 ) .and. ( nproRzC .ge. 2 ) ) then j = (ybegin - 2) k = (zend + 2) do i = iiL, iiR do kk = 1, 8 do jj = 1, 8 jjj = j + jj - 2 kkk = k - kk + 3 d0f(i,j,k) = d0f(i,j,k) + bnd8BB(jj,kk)*f(i,jjj,kkk) end do end do end do end if ! ! Right side (x), Left side (y) = Southeast : ! if ( ( nproRyC .ge. 2 ) .and. ( nproLzC .ge. 2 ) ) then j = (yend + 2) k = (zbegin - 2) do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j - jj + 3 kkk = k + kk - 2 d0f(i,j,k) = d0f(i,j,k) + bnd8BB(jj,kk)*f(i,jjj,kkk) end do end do end do end if ! ! Right side (x), Right side (y) = Northeast : ! if ( ( nproRyC .ge. 2 ) .and. ( nproRzC .ge. 2 ) ) then j = (yend + 2) k = (zend + 2) do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j - kk + 3 kkk = k - jj + 3 d0f(i,j,k) = d0f(i,j,k) + bnd8BB(jj,kk)*f(i,jjj,kkk) end do end do end do end if ! ! Left side (x), Left side (y) = Southwest : ! ! (2,3) if ( ( nproLyC .ge. 2 ) .and. ( nproLzC .ge. 1 ) ) then j = (ybegin - 2) k = (zbegin - 1) do i = iiL, iiR do kk = 1, 8 do jj = 1, 8 jjj = j + kk - 2 kkk = k + jj - 3 d0f(i,j,k) = d0f(i,j,k) + bnd8BC(kk,jj)*f(i,jjj,kkk) end do end do end do end if ! (3,2) flip x and y if ( ( nproLyC .ge. 1 ) .and. ( nproLzC .ge. 2 ) ) then j = (ybegin - 1) k = (zbegin - 2) do i = iiL, iiR do kk = 1, 8 do jj = 1, 8 jjj = j + jj - 3 kkk = k + kk - 2 d0f(i,j,k) = d0f(i,j,k) + bnd8BC(kk,jj)*f(i,jjj,kkk) end do end do end do end if ! ! Left side (x), Right side (y) = Northwest : ! !( 2, ny-3) if ( ( nproLyC .ge. 2 ) .and. ( nproRzC .ge. 1 ) ) then j = (ybegin - 2) k = (zend + 1) do i = iiL, iiR do kk = 1, 8 do jj = 1, 8 jjj = j + kk - 2 kkk = k - jj + 4 d0f(i,j,k) = d0f(i,j,k) + bnd8BC(kk,jj)*f(i,jjj,kkk) end do end do end do end if !( 3, ny-2) if ( ( nproLyC .ge. 1 ) .and. ( nproRzC .ge. 2 ) ) then j = (ybegin - 1) k = (zend + 2) do i = iiL, iiR do kk = 1, 8 do jj = 1, 8 jjj = j + jj - 3 kkk = k - kk + 3 d0f(i,j,k) = d0f(i,j,k) + bnd8BC(kk,jj)*f(i,jjj,kkk) end do end do end do end if ! ! Right side (x), Left side (y) = Southeast : ! if ( ( nproRyC .ge. 2 ) .and. ( nproLzC .ge. 1 ) ) then !( nx-2, 3) j = (yend + 2) k = (zbegin - 1) do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j - kk + 3 kkk = k + jj - 3 d0f(i,j,k) = d0f(i,j,k) + bnd8BC(kk,jj)*f(i,jjj,kkk) end do end do end do end if !( nx-3, 2) if ( ( nproRyC .ge. 1 ) .and. ( nproLzC .ge. 2 ) ) then j = (yend + 1) k = (zbegin - 2) do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j - jj + 4 kkk = k + kk - 2 d0f(i,j,k) = d0f(i,j,k) + bnd8BC(kk,jj)*f(i,jjj,kkk) end do end do end do end if ! ! Right side (x), Right side (y) = Northeast : ! ! (nx-2,ny-3) if ( ( nproRyC .ge. 2 ) .and. ( nproRzC .ge. 1 ) ) then j = (yend + 2) k = (zend + 1) do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j - kk + 3 kkk = k - jj + 4 d0f(i,j,k) = d0f(i,j,k) + bnd8BC(kk,jj)*f(i,jjj,kkk) end do end do end do end if ! (nx-3,ny-2) if ( ( nproRyC .ge. 1 ) .and. ( nproRzC .ge. 2 ) ) then j = (yend + 1) k = (zend + 2) do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j - jj + 4 kkk = k - kk + 3 d0f(i,j,k) = d0f(i,j,k) + bnd8BC(kk,jj)*f(i,jjj,kkk) end do end do end do end if ! if ( ( nproLyC .ge. 1 ) .and. ( nproLzC .ge. 1 ) ) then j = (ybegin - 1) k = (zbegin - 1) do i = iiL, iiR do kk = 1, 8 do jj = 1, 8 jjj = j + jj - 3 kkk = k + kk - 3 d0f(i,j,k) = d0f(i,j,k) + bnd8CC(jj,kk)*f(i,jjj,kkk) end do end do end do end if ! ! Left side (x), Right side (y) = Northwest : ! if ( ( nproLyC .ge. 1 ) .and. ( nproRzC .ge. 1 ) ) then j = (ybegin - 1) k = (zend + 1) do i = iiL, iiR do kk = 1, 8 do jj = 1, 8 jjj = j + jj - 3 kkk = k - kk + 4 d0f(i,j,k) = d0f(i,j,k) + bnd8CC(jj,kk)*f(i,jjj,kkk) end do end do end do end if ! ! Right side (x), Left side (y) = Southeast : ! if ( ( nproRyC .ge. 1 ) .and. ( nproLzC .ge. 1 ) ) then j = (yend + 1) k = (zbegin - 1) do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j - jj + 4 kkk = k + kk - 3 d0f(i,j,k) = d0f(i,j,k) + bnd8CC(jj,kk)*f(i,jjj,kkk) end do end do end do end if ! ! Right side (x), Right side (y) = Northeast : ! if ( ( nproRyC .ge. 1 ) .and. ( nproRzC .ge. 1 ) ) then j = (yend + 1) k = (zend + 1) do i = iiL, iiR do jj = 1, 8 do kk = 1, 8 jjj = j - kk + 4 kkk = k - jj + 4 d0f(i,j,k) = d0f(i,j,k) + bnd8CC(jj,kk)*f(i,jjj,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(bjL,bjR,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 = ybegin, yend do i = iiL, iiR sum = 0.d0 do jj = 1, 10 do kk = 1, 10 sum = sum + bnd10I(jj,kk)* f(i,j+jj-5,k+kk-5) enddo enddo d0f(i,j,k) = sum enddo enddo enddo ! end if ! return end !====================================================================