2025-09-05 09:42:21 +02:00

189 lines
5.6 KiB
Plaintext
Executable File

!
! This program may be freely redistributed under the
! condition that the copyright notices (including this
! entire header) are not removed, and no compensation
! is received through use of the software. Private,
! research, and institutional use is free. You may
! distribute modified versions of this code UNDER THE
! CONDITION THAT THIS CODE AND ANY MODIFICATIONS MADE
! TO IT IN THE SAME FILE REMAIN UNDER COPYRIGHT OF THE
! ORIGINAL AUTHOR, BOTH SOURCE AND OBJECT CODE ARE
! MADE FREELY AVAILABLE WITHOUT CHARGE, AND CLEAR
! NOTICE IS GIVEN OF THE MODIFICATIONS. Distribution
! of this code as part of a commercial system is
! permissible ONLY BY DIRECT ARRANGEMENT WITH THE
! AUTHOR. (If you are not directly supplying this
! code to a customer, and you are instead telling them
! how they can obtain it for free, then you are not
! required to make any arrangement with me.)
!
! Disclaimer: Neither I nor: Columbia University, the
! National Aeronautics and Space Administration, nor
! the Massachusetts Institute of Technology warrant
! or certify this code in any way whatsoever. This
! code is provided "as-is" to be used at your own risk.
!
!
!
! P1E.h90: set edge estimates via degree-1 polynomials.
!
! Darren Engwirda
! 09-Sep-2016
! de2363 [at] columbia [dot] edu
!
!
subroutine p1e(npos,nvar,ndof,delx, &
& fdat,bclo,bchi,edge, &
& dfdx,opts,dmin)
!
! NPOS no. edges over grid.
! NVAR no. state variables.
! NDOF no. degrees-of-freedom per grid-cell.
! DELX grid-cell spacing array. LENGTH(DELX) == +1 if
! spacing is uniform .
! FDAT grid-cell moments array. FDAT is an array with
! SIZE = NDOF-by-NVAR-by-NPOS-1 .
! BCLO boundary condition at lower endpoint.
! BCHI boundary condition at upper endpoint.
! EDGE edge-centred interp. for function-value. EDGE
! is an array with SIZE = NVAR-by-NPOS .
! DFDX edge-centred interp. for 1st-derivative. DFDX
! is an array with SIZE = NVAR-by-NPOS .
! OPTS method parameters. See RCON-OPTS for details .
! DMIN min. grid-cell spacing thresh .
!
implicit none
!------------------------------------------- arguments !
integer, intent( in) :: npos,nvar,ndof
real*8 , intent( in) :: delx(:)
real*8 , intent( in) :: fdat(:,:,:)
type (rcon_ends), intent(in) :: bclo(:)
type (rcon_ends), intent(in) :: bchi(:)
real*8 , intent(out) :: edge(:,:)
real*8 , intent(out) :: dfdx(:,:)
real*8 , intent( in) :: dmin
class(rcon_opts), intent(in) :: opts
!------------------------------------------- variables !
integer :: ipos,ivar,head,tail
real*8 :: dd10
real*8 :: delh(-1:+0)
head = +2; tail = npos-1
if (npos.lt.2) return
if (npos.eq.2) then
!----- default to reduced order if insufficient points !
do ivar = 1,nvar
edge(ivar,1) = fdat(1,ivar,1)
dfdx(ivar,1) = 0.e0_8
edge(ivar,2) = fdat(1,ivar,1)
dfdx(ivar,2) = 0.e0_8
end do
end if
if (npos.le.2) return
! Reconstruct edge-centred 2nd-order polynomials. Com- !
! pute values/slopes at edges directly. Full-order ex- !
! trapolation at endpoints.
if (size(delx).eq.+1) then
do ipos = head , tail
!--------------- reconstruction: constant grid-spacing !
dd10 = delx(+1) * 2.e0_8
do ivar = +1, nvar
edge(ivar,ipos) = &
& + delx(+1) * &
& fdat(1,ivar,ipos-1) &
& + delx(+1) * &
& fdat(1,ivar,ipos+0)
dfdx(ivar,ipos) = &
& - 2.0d+0 * &
& fdat(1,ivar,ipos-1) &
& + 2.0d+0 * &
& fdat(1,ivar,ipos+0)
edge(ivar,ipos) = &
& edge(ivar,ipos) / dd10
dfdx(ivar,ipos) = &
& dfdx(ivar,ipos) / dd10
end do
end do
else
do ipos = head , tail
!--------------- reconstruction: variable grid-spacing !
delh(-1) = &
& max(delx(ipos-1),dmin)
delh(+0) = &
& max(delx(ipos+0),dmin)
dd10 = delh(-1)+delh(+0)
do ivar = +1, nvar
edge(ivar,ipos) = &
& + delh(+0) * &
& fdat(1,ivar,ipos-1) &
& + delh(-1) * &
& fdat(1,ivar,ipos+0)
dfdx(ivar,ipos) = &
& - 2.0d+0 * &
& fdat(1,ivar,ipos-1) &
& + 2.0d+0 * &
& fdat(1,ivar,ipos+0)
edge(ivar,ipos) = &
& edge(ivar,ipos) / dd10
dfdx(ivar,ipos) = &
& dfdx(ivar,ipos) / dd10
end do
end do
end if
!------------- 1st-order value/slope BC's at endpoints !
do ivar = +1, nvar
edge(ivar,head-1) = &
& fdat(+1,ivar,head-1)
edge(ivar,tail+1) = &
& fdat(+1,ivar,tail+0)
dfdx(ivar,head-1) = 0.e0_8
dfdx(ivar,tail+1) = 0.e0_8
end do
return
end subroutine