V3FIT
r8splinck.f
1  subroutine r8splinck(x,inx,ilinx,ztol,ier)
2 C
3 C check if a grid is strictly ascending and if it is evenly spaced
4 C to w/in ztol
5 C
6 !============
7 ! idecl: explicitize implicit INTEGER declarations:
8  IMPLICIT NONE
9  INTEGER, PARAMETER :: R8=selected_real_kind(12,100)
10  INTEGER inx,ix
11 !============
12 ! idecl: explicitize implicit REAL declarations:
13  real*8 dxavg,zeps,zdiffx,zdiff
14 !============
15  real*8 x(inx) ! input -- grid to check
16 C
17  integer ilinx ! output -- =1 if evenly spaced =2 O.W.
18 C
19  real*8 ztol ! input -- spacing check tolerance
20 C
21  integer ier ! output -- =0 if OK
22 C
23 C ier=1 is returned if x(1...inx) is NOT STRICTLY ASCENDING...
24 C
25 C-------------------------------
26 C
27  ier=0
28  ilinx=1
29  if(inx.le.1) return
30 c
31  dxavg=(x(inx)-x(1))/(inx-1)
32  zeps=abs(ztol*dxavg)
33 c
34  do ix=2,inx
35  zdiffx=(x(ix)-x(ix-1))
36  if(zdiffx.le.0.0_r8) ier=2
37  zdiff=zdiffx-dxavg
38  if(abs(zdiff).gt.zeps) then
39  ilinx=2
40  endif
41  enddo
42  10 continue
43 c
44  return
45  end