V3FIT
util_bcherm3.f
1  subroutine util_bcherm3(fherm,idimx1,idimx2,idimx3,
2  > jbcx1a,jbcx1b, jbcx2a,jbcx2b, jbcx3a,jbcx3b,
3  > zbcx1a,zbcx1b, zbcx2a,zbcx2b, zbcx3a,zbcx3b,
4  > x1, x2, x3)
5 
6 C... insert BCs as needed for Hermite interpolation setup
7 
8  implicit NONE
9  integer :: idimx1,idimx2,idimx3 ! array dimensions
10  real :: fherm(0:7,idimx1,idimx2,idimx3)
11 
12  integer :: jbcx1a,jbcx1b ! x1 BC controls
13  real :: zbcx1a(idimx2,idimx3) ! x1(1) BC data
14  real :: zbcx1b(idimx2,idimx3) ! x1(idimx1) BC data
15 
16  integer :: jbcx2a,jbcx2b ! x2 BC controls
17  real :: zbcx2a(idimx1,idimx3) ! x2(1) BC data
18  real :: zbcx2b(idimx1,idimx3) ! x2(idimx2) BC data
19 
20  integer :: jbcx3a,jbcx3b ! x3 BC controls
21  real :: zbcx3a(idimx2,idimx3) ! x3(1) BC data
22  real :: zbcx3b(idimx2,idimx3) ! x3(idimx3) BC data
23 
24  real :: x1(idimx1),x2(idimx2),x3(idimx3)
25 
26 C-----------------------------------------------------------------
27  integer :: ix,iy
28  real :: zdx
29 C-----------------------------------------------------------------
30 
31  if((jbcx1a.eq.1).or.(jbcx1b.eq.1)) then
32 
33  if(jbcx1a.eq.1) then
34  fherm(1,1,1:idimx2,1:idimx3)=zbcx1a(1:idimx2,1:idimx3)
35  else
36  zdx = x1(2)-x1(1)
37  do iy=1,idimx3
38  do ix=1,idimx2
39  fherm(1,1,ix,iy)=
40  > (fherm(0,2,ix,iy)-fherm(0,1,ix,iy))/zdx
41  enddo
42  enddo
43  endif
44 
45  if(jbcx1b.eq.1) then
46  fherm(1,idimx1,1:idimx2,1:idimx3)=zbcx1b(1:idimx2,1:idimx3)
47  else
48  zdx = x1(idimx1)-x1(idimx1-1)
49  do iy=1,idimx3
50  do ix=1,idimx2
51  fherm(1,idimx1,ix,iy)=
52  > (fherm(0,idimx1,ix,iy)-fherm(0,idimx1-1,ix,iy))/
53  > zdx
54  enddo
55  enddo
56  endif
57 
58  endif
59 
60  if((jbcx2a.eq.1).or.(jbcx2b.eq.1)) then
61 
62  if(jbcx2a.eq.1) then
63  fherm(2,1:idimx1,1,1:idimx3)=zbcx2a(1:idimx1,1:idimx3)
64  else
65  zdx=x2(2)-x2(1)
66  do iy=1,idimx3
67  do ix=1,idimx1
68  fherm(2,ix,1,iy)=
69  > (fherm(0,ix,2,iy)-fherm(0,ix,1,iy))/zdx
70  enddo
71  enddo
72  endif
73 
74  if(jbcx2b.eq.1) then
75  fherm(2,1:idimx1,idimx2,1:idimx3)=zbcx2b(1:idimx1,1:idimx3)
76  else
77  zdx=x2(idimx2)-x2(idimx2-1)
78  do iy=1,idimx3
79  do ix=1,idimx1
80  fherm(2,ix,idimx2,iy)=
81  > (fherm(0,ix,idimx2,iy)-fherm(0,ix,idimx2-1,iy))/
82  > zdx
83  enddo
84  enddo
85  endif
86  endif
87 
88  if((jbcx3a.eq.1).or.(jbcx3b.eq.1)) then
89 
90  if(jbcx3a.eq.1) then
91  fherm(3,1:idimx1,1:idimx2,1)=zbcx3a(1:idimx1,1:idimx2)
92  else
93  zdx=x3(2)-x3(1)
94  do iy=1,idimx2
95  do ix=1,idimx1
96  fherm(3,ix,iy,1)=
97  > (fherm(0,ix,iy,2)-fherm(0,ix,iy,1))/zdx
98  enddo
99  enddo
100  endif
101 
102  if(jbcx3b.eq.1) then
103  fherm(3,1:idimx1,1:idimx2,idimx3)=zbcx3b(1:idimx1,1:idimx2)
104  else
105  zdx=x3(idimx3)-x3(idimx3-1)
106  do iy=1,idimx2
107  do ix=1,idimx1
108  fherm(3,ix,iy,idimx3)=
109  > (fherm(0,ix,iy,idimx3)-fherm(0,ix,iy,idimx3-1))/
110  > zdx
111  enddo
112  enddo
113  endif
114  endif
115 
116  end subroutine util_bcherm3