UFO
gnssro_mod_grids.F90
Go to the documentation of this file.
1 module gnssro_mod_grids
2 
3 use kinds, only: kind_real
4 use gnssro_mod_constants, only: one
5 
6 public :: get_coordinate_value
7 
8 private
9 
10 contains
11 
12 subroutine get_coordinate_value(fin, fout, x, nx, flag)
13 !
14 ! Get grid coordinates from monotonically increasing or decreasing points
15 ! adapted GSI subprogram: grdcrd1
16 !
17  integer, intent(in) :: nx !number of reference grid point
18  real(kind_real), intent(in) :: x(nx) !grid values
19  real(kind_real), intent(in) :: fin !input point
20  character(10), intent(in) :: flag !"increasing" or "decreasing"
21  real(kind_real), intent(out) :: fout !output point
22  integer :: ix, isrchf
23 
24 ! Treat "normal" case in which nx>1
25  if(nx>1) then
26  if (flag == "increasing") then
27 
28  if(fin<=x(1)) then
29  ix=1
30  else
31  call searcharray(nx-1,x,fin,flag,isrchf)
32  ix=isrchf-1
33  end if
34  if(ix==nx) ix=ix-1
35 
36  else if (flag=="decreasing") then
37 
38  if(fin>=x(1)) then
39  ix=1
40  else
41  call searcharray(nx-1,x,fin,flag,isrchf)
42  ix=isrchf-1
43  end if
44  else
45  ix = 1
46  call abor1_ftn('gnssro get_coordinate_value: flag must be set to "decreasing" or "increasing"')
47  end if
48  fout=float(ix)+(fin-x(ix))/(x(ix+1)-x(ix))
49 
50 ! Treat special case of nx=1
51  elseif (nx==1) then
52  fout = one
53  endif
54 
55  return
56 end subroutine get_coordinate_value
57 
58 
59 subroutine searcharray(nx,x,y,flag,isrchf)
60  integer, intent(in) :: nx !number of input points
61  character(10), intent(in) :: flag !"increasing" or "decreasing"
62  real(kind_real),intent(in) :: y !target values
63  real(kind_real),intent(in) :: x(nx) !grid value
64  integer, intent(out) :: isrchf !array index of input grid value near target value
65  integer :: k
66 
67  if(flag=="increasing") then
68  do k=1,nx
69  if(y<=x(k)) then
70  isrchf=k
71  return
72  end if
73  end do
74  else
75  do k=1,nx
76  if(y>=x(k)) then
77  isrchf=k
78  return
79  end if
80  end do
81  end if
82 
83  isrchf=nx+1
84  if(nx<=0) isrchf=0
85 
86  return
87 end subroutine searcharray
88 
89 end module gnssro_mod_grids
gnssro_mod_grids::searcharray
subroutine searcharray(nx, x, y, flag, isrchf)
Definition: gnssro_mod_grids.F90:60
gnssro_mod_grids
Definition: gnssro_mod_grids.F90:1
gnssro_mod_grids::get_coordinate_value
subroutine, public get_coordinate_value(fin, fout, x, nx, flag)
Definition: gnssro_mod_grids.F90:13
gnssro_mod_constants
Definition: gnssro_mod_constants.F90:2