39 subroutine borehole(field, x_pos, y_pos, dxi, deta, ch_grid, field_val)
46 real(dp),
dimension(0:JMAX,0:IMAX),
intent(in) :: field
47 real(dp),
intent(in) :: x_pos, y_pos, dxi, deta
48 character (len=*),
intent(in) :: ch_grid
50 real(dp),
intent(out) :: field_val
52 integer(i4b) :: i_kl, i_gr, j_kl, j_gr
53 real(dp) :: real_i, real_j, dist1, dist2, dist3, dist4, &
54 weight1, weight2, weight3, weight4
58 real_i = (x_pos-xi(0)) /dxi
59 real_j = (y_pos-eta(0))/deta
63 i_gr = ceiling(real_i)
64 j_gr = ceiling(real_j)
66 if (i_kl <= 1) stop
' borehole: i_kl <= 1 not allowed!'
67 if (j_kl <= 1) stop
' borehole: j_kl <= 1 not allowed!'
68 if (i_gr >= imax-1) stop
' borehole: i_gr >= IMAX-1 not allowed!'
69 if (j_gr >= jmax-1) stop
' borehole: j_gr >= JMAX-1 not allowed!'
71 dist1 = sqrt( (x_pos-xi(i_kl))**2 + (y_pos-eta(j_kl))**2 )
72 dist2 = sqrt( (x_pos-xi(i_kl))**2 + (y_pos-eta(j_gr))**2 )
73 dist3 = sqrt( (x_pos-xi(i_gr))**2 + (y_pos-eta(j_kl))**2 )
74 dist4 = sqrt( (x_pos-xi(i_gr))**2 + (y_pos-eta(j_gr))**2 )
76 weight1 = 1.0_dp/(dist1+eps)
77 weight2 = 1.0_dp/(dist2+eps)
78 weight3 = 1.0_dp/(dist3+eps)
79 weight4 = 1.0_dp/(dist4+eps)
83 if (ch_grid==
'grid')
then
85 field_val = ( weight1*field(j_kl,i_kl) &
86 +weight2*field(j_gr,i_kl) &
87 +weight3*field(j_kl,i_gr) &
88 +weight4*field(j_gr,i_gr) ) &
89 /(weight1 + weight2 + weight3 + weight4)
91 else if (ch_grid==
'sg_x')
then
94 field_val = ( weight1*0.5_dp*(field(j_kl,i_kl)+field(j_kl,i_kl-1)) &
95 +weight2*0.5_dp*(field(j_gr,i_kl)+field(j_gr,i_kl-1)) &
96 +weight3*0.5_dp*(field(j_kl,i_gr)+field(j_kl,i_gr-1)) &
97 +weight4*0.5_dp*(field(j_gr,i_gr)+field(j_gr,i_gr-1)) ) &
98 /(weight1 + weight2 + weight3 + weight4)
100 else if (ch_grid==
'sg_y')
then
103 field_val = ( weight1*0.5_dp*(field(j_kl,i_kl)+field(j_kl-1,i_kl)) &
104 +weight2*0.5_dp*(field(j_gr,i_kl)+field(j_gr-1,i_kl)) &
105 +weight3*0.5_dp*(field(j_kl,i_gr)+field(j_kl-1,i_gr)) &
106 +weight4*0.5_dp*(field(j_gr,i_gr)+field(j_gr-1,i_gr)) ) &
107 /(weight1 + weight2 + weight3 + weight4)
111 stop
' borehole: Parameter ch_grid has undefined value!'