V3FIT
r8util_bcherm1.f
1  subroutine r8util_bcherm1(fherm,idimx1,
2  > jbcxa,jbcxb,
3  > zbcxa,zbcxb,
4  > x1)
5 
6 C... insert BCs as needed for Hermite interpolation setup
7 
8 
9  IMPLICIT NONE
10  INTEGER, PARAMETER :: R8=selected_real_kind(12,100)
11  integer :: idimx1 ! array dimensions
12  real*8 :: fherm(0:1,idimx1)
13 
14  integer :: jbcxa,jbcxb ! x BC controls
15  real*8 :: zbcxa ! x(1) BC data
16  real*8 :: zbcxb ! x(idimx1) BC data
17 
18  real*8 :: x1(idimx1)
19 
20 C-------------------------------------------------------------
21  integer :: ix
22  REAL*8 :: zdx
23 C-------------------------------------------------------------
24 
25  if((jbcxa.eq.1).or.(jbcxb.eq.1)) then
26 
27  if(jbcxa.eq.1) then
28  fherm(1,1)=zbcxa
29  else
30  zdx = x1(2)-x1(1)
31  fherm(1,1)=(fherm(0,2)-fherm(0,1))/zdx
32  endif
33 
34  if(jbcxb.eq.1) then
35  fherm(1,idimx1)=zbcxb
36  else
37  zdx = x1(idimx1)-x1(idimx1-1)
38  fherm(1,idimx1)=(fherm(0,idimx1)-fherm(0,idimx1-1))/zdx
39  endif
40 
41  endif
42 
43  end subroutine r8util_bcherm1