COSMOS v7.655  COSMOSv7655
(AirShowerMC)
kfrge.f
Go to the documentation of this file.
1 !c test kfrge.
2 ! program test_kfrge
3 ! implicit none
4 ! integer l, icon
5 !c
6 ! real*8 x(6)/4., 3., -1., 9., 2., 4./
7 ! call kfrge(x, 1, 6, 3.d0, l, icon)
8 ! write(*, *) l, icon, x(l)
9 ! end
10 ! ****************************************************************
11 ! * *
12 ! * kfrge: find real data (position) .ge. given value *
13 ! * *
14 ! *********************** tested 87.06.07 **********************
15 !
16 ! /usage/
17 ! call kfrge(x, intvx, n, c, l, icon)
18 !
19 ! x: real*8. input. data array
20 ! intvx: integer. input. interval of data in x
21 ! n: integer. input. |n| is no. of data in x
22 ! c: real*8. input. given value. x .ge. c is sought for.
23 ! l: integer. output. position of xf in x. xf=x(1,m)
24 ! icon: 0 if found else 1
25 !
26 ! *** note ***
27 ! if n>0 search is made for from 1st, else from last
28 ! if icon=1 resluts, m will be n+1 or 0 dependingon n>0 or
29 ! n<0.
30 !
31 !
32  subroutine kfrge(x, intvx, n, c, m, icon)
33  implicit none
34  integer intvx, n, m, icon
35  real*8 x(intvx, *), c
36 !
37  integer i
38 !
39  if( n .gt. 0 ) then
40  do i=1, n
41  if(x(1,i) .ge. c) then
42  m=i
43  icon=0
44  goto 100
45  endif
46  enddo
47  icon=1
48  m=n+1
49  elseif(n .lt. 0) then
50  do i=-n, 1, -1
51  if(x(1,i) .ge. c) then
52  m=i
53  icon=0
54  goto 100
55  endif
56  enddo
57  m=0
58  icon=1
59  else
60  icon=1
61  endif
62  100 continue
63  end
kfrge
subroutine kfrge(x, intvx, n, c, m, icon)
Definition: kfrge.f:33