V3FIT
r8util_bcherm2.f
1  subroutine r8util_bcherm2(fherm,idimx1,idimx2,
2  > jbcx1a,jbcx1b, jbcx2a,jbcx2b,
3  > zbcx1a,zbcx1b, zbcx2a,zbcx2b,
4  > x1, x2)
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,idimx2 ! array dimensions
12  real*8 :: fherm(0:3,idimx1,idimx2)
13 
14  integer :: jbcx1a,jbcx1b ! x1 BC controls
15  real*8 :: zbcx1a(idimx2) ! x1(1) BC data
16  real*8 :: zbcx1b(idimx2) ! x1(idimx1) BC data
17 
18  integer :: jbcx2a,jbcx2b ! x2 BC controls
19  real*8 :: zbcx2a(idimx1) ! x2(1) BC data
20  real*8 :: zbcx2b(idimx1) ! x2(idimx2) BC data
21 
22  real*8 :: x1(idimx1),x2(idimx2)
23 
24 C-------------------------------------------------------------
25  integer :: ix
26  REAL*8 :: zdx
27 C-------------------------------------------------------------
28 
29  if((jbcx1a.eq.1).or.(jbcx1b.eq.1)) then
30 
31  if(jbcx1a.eq.1) then
32  fherm(1,1,1:idimx2)=zbcx1a(1:idimx2)
33  else
34  zdx = x1(2)-x1(1)
35  do ix=1,idimx2
36  fherm(1,1,ix)=(fherm(0,2,ix)-fherm(0,1,ix))/zdx
37  enddo
38  endif
39 
40  if(jbcx1b.eq.1) then
41  fherm(1,idimx1,1:idimx2)=zbcx1b(1:idimx2)
42  else
43  zdx = x1(idimx1)-x1(idimx1-1)
44  do ix=1,idimx2
45  fherm(1,idimx1,ix)=
46  > (fherm(0,idimx1,ix)-fherm(0,idimx1-1,ix))/zdx
47  enddo
48  endif
49 
50  endif
51 
52  if((jbcx2a.eq.1).or.(jbcx2b.eq.1)) then
53 
54  if(jbcx2a.eq.1) then
55  fherm(2,1:idimx1,1)=zbcx2a(1:idimx1)
56  else
57  zdx=x2(2)-x2(1)
58  do ix=1,idimx1
59  fherm(2,ix,1)=(fherm(0,ix,2)-fherm(0,ix,1))/zdx
60  enddo
61  endif
62 
63  if(jbcx2b.eq.1) then
64  fherm(2,1:idimx1,idimx2)=zbcx2b(1:idimx1)
65  else
66  zdx=x2(idimx2)-x2(idimx2-1)
67  do ix=1,idimx1
68  fherm(2,ix,idimx2)=
69  > (fherm(0,ix,idimx2)-fherm(0,ix,idimx2-1))/zdx
70  enddo
71  endif
72  endif
73 
74  end subroutine r8util_bcherm2