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