Subversion Repositories lagranto.ecmwf

Rev

Rev 5 | Only display areas with differences | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 5 Rev 46
1 
 
 1 
 
2 
      SUBROUTINE special (flag,cmd,tra,ntim,ncol,
 2 
      SUBROUTINE special (flag,cmd,tra,ntim,ncol,
3 
     >                    vars,times,param,nparam)
 3 
     >                    vars,times,param,nparam)
4 
 
 4 
 
5 
c     ***************************************************************************
 5 
c     ***************************************************************************
6 
c     *                                                                         *
 6 
c     *                                                                         *
7 
c     * OUTPUT:  flag           -> 1 if trajectory is selected, 0 if not        *
 7 
c     * OUTPUT:  flag           -> 1 if trajectory is selected, 0 if not        *
8 
c     *                                                                         *
 8 
c     *                                                                         *
9 
c     * INPUT:   cmd            <- command string                               *
 9 
c     * INPUT:   cmd            <- command string                               *
10 
c     *          tra(ntim,ncol) <- single trajectory: indices time,column       *
 10 
c     *          tra(ntim,ncol) <- single trajectory: indices time,column       *
11 
c     *          ntim           <- number of times                              *
 11 
c     *          ntim           <- number of times                              *
12 
c     *          ncol           <- number of columns (including time,lon,lat,p) *
 12 
c     *          ncol           <- number of columns (including time,lon,lat,p) *
13 
c     *          vars(ncol)     <- names of columns                             *
 13 
c     *          vars(ncol)     <- names of columns                             *
14 
c     *          times(ntim)    <- List of times
 14 
c     *          times(ntim)    <- List of times
15 
c     *          param(nparam)  <- parameter values                             *
 15 
c     *          param(nparam)  <- parameter values                             *
16 
c     *          nparam         <- number of parameters                         *
 16 
c     *          nparam         <- number of parameters                         *
17 
c     *                                                                         *
 17 
c     *                                                                         *
18 
c     ***************************************************************************
 18 
c     ***************************************************************************
19 
 
 19 
 
20 
      implicit none
 20 
      implicit none
21
21
22 
c     ---------------------------------------------------------------------------
 22 
c     ---------------------------------------------------------------------------
23 
c     Declaration of subroutine parameters
 23 
c     Declaration of subroutine parameters
24 
c     ---------------------------------------------------------------------------
 24 
c     ---------------------------------------------------------------------------
25 
 
 25 
 
26 
      integer       flag           ! Boolean flag whether trajectory is selected
 26 
      integer       flag           ! Boolean flag whether trajectory is selected
27 
      character*80  cmd            ! Command string
 27 
      character*80  cmd            ! Command string
28 
      integer       ntim,ncol      ! Dimension of single trajectory
 28 
      integer       ntim,ncol      ! Dimension of single trajectory
29 
      real          tra(ntim,ncol) ! Single trajectory
 29 
      real          tra(ntim,ncol) ! Single trajectory
30 
      character*80  vars(ncol)     ! Name of columns
 30 
      character*80  vars(ncol)     ! Name of columns
31 
      real          times(ntim)    ! List of times
 31 
      real          times(ntim)    ! List of times
32 
      integer       nparam         ! # parameters
 32 
      integer       nparam         ! # parameters
33 
      real          param(nparam)  ! List of parameters
 33 
      real          param(nparam)  ! List of parameters
34 
 
 34 
 
35 
c     ---------------------------------------------------------------------------
 35 
c     ---------------------------------------------------------------------------
36 
c     Declaration of local variables
 36 
c     Declaration of local variables
37 
c     ---------------------------------------------------------------------------
 37 
c     ---------------------------------------------------------------------------
38 
 
 38 
 
39 
      integer       i
 39 
      integer       i
40 
      integer       ip,i0,i1
 40 
      integer       ip,i0,i1
41 
 
 41 
 
42 
c     --------------------------------------------------------------------------  %)
 42 
c     --------------------------------------------------------------------------  %)
43 
c     SPECIAL:WCB:ascent,first,last                                               %)
 43 
c     SPECIAL:WCB:ascent,first,last                                               %)
44 
c         : Detect Warm Conveyor Belts (WCB); the air stream must ascend at least %)
 44 
c         : Detect Warm Conveyor Belts (WCB); the air stream must ascend at least %)
45 
c         : <ascent=param(1)> hPa between the two times <first=param(2)> and      %)
 45 
c         : <ascent=param(1)> hPa between the two times <first=param(2)> and      %)
46 
c         : <last=param(3)>. Note, the lowest pressure is allowed to occur at any %)
 46 
c         : <last=param(3)>. Note, the lowest pressure is allowed to occur at any %)
47 
c         : time between <first> and <last>.                                      %)
 47 
c         : time between <first> and <last>.                                      %)
48 
c     --------------------------------------------------------------------------- %)
 48 
c     --------------------------------------------------------------------------- %)
49 
 
 49 
 
50 
      if ( cmd.eq.'WCB' ) then
 50 
      if ( cmd.eq.'WCB' ) then
51 
 
 51 
 
52 
c        Reset the flag for selection
 52 
c        Reset the flag for selection
53 
         flag = 0
 53 
         flag = 0
54 
 
 54 
 
55 
c        Pressure is in the 4th column
 55 
c        Pressure is in the 4th column
56 
         ip = 4
 56 
         ip = 4
57 
 
 57 
 
58 
c        Get times
 58 
c        Get times
59 
         i0 = 0
 59 
         i0 = 0
60 
         i1 = 0
 60 
         i1 = 0
61 
         do i=1,ntim
 61 
         do i=1,ntim
62 
            if ( param(2).eq.times(i) ) i0 = i
 62 
            if ( abs(param(2)-times(i)).lt.0.001 ) i0 = i
63 
            if ( param(3).eq.times(i) ) i1 = i
 63 
            if ( abs(param(3)-times(i)).lt.0.001 ) i1 = i
64 
         enddo
 64 
         enddo
65 
         if ( (i0.eq.0).or.(i1.eq.0) ) then
 65 
         if ( (i0.eq.0).or.(i1.eq.0) ) then
66 
            print*,' ERROR: invalid times in SPECIAL:WCB... Stop'
 66 
            print*,' ERROR: invalid times in SPECIAL:WCB... Stop'
- 
 
 67 
            print*,param(2),param(3)
- 
 
 68 
            print*,(times(i),i=1,ntim)
- 
 
 69 
            print*,i0,i1
67 
            stop
 70 
            stop
68 
         endif
 71 
         endif
69 
 
 72 
 
70 
c        Check for ascent
73 
c        Check for ascent
71 
         do i=i0+1,i1
 74 
         do i=i0+1,i1
72 
            if ( ( tra(i0,ip)-tra(i,ip) ) .gt. param(1) ) flag = 1
 75 
            if ( ( tra(i0,ip)-tra(i,ip) ) .gt. param(1) ) flag = 1
73 
         enddo
 76 
         enddo
74 
 
 77 
 
75 
      endif
 78 
      endif
76 
 
 79 
 
77 
c     ---------------------------------------------------------------------------
 80 
c     ---------------------------------------------------------------------------
78 
 
 81 
 
79 
 
 82 
 
80 
      end
 83 
      end