Subversion Repositories lagranto.ecmwf

Rev

Rev 13 | Go to most recent revision | Show entire file | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 13 Rev 15
Line 16... Line 16...
16 
      character*80                           outfile
16 
      character*80                           outfile
17 
      integer                                ntra,otim,ncol
 17 
      integer                                ntra,otim,ncol
18 
      real                                   timeres
 18 
      real                                   timeres
19 
      character*80                           unit
 19 
      character*80                           unit
20 
      character*80                           mode
 20 
      character*80                           mode
- 
 
 21 
      real                                   shift
21 
 
 22 
 
22 
c     Trajectories
 23 
c     Trajectories
23 
      character*80                           vars(100)
24 
      character*80                           vars(100)
24 
      integer                                refdate(6)
25 
      integer                                refdate(6)
25 
      integer                                ntim
26 
      integer                                ntim
Line 38... Line 39...
38 
      integer                                stat
 39 
      integer                                stat
39 
      integer                                fid
 40 
      integer                                fid
40 
      integer                                i,j,k
 41 
      integer                                i,j,k
41 
      real                                   hhmm,tfrac
 42 
      real                                   hhmm,tfrac
42 
      real                                   range
 43 
      real                                   range
- 
 
 44 
      integer                                date0(5),date1(5)
43 
 
 45 
 
44 
c     ----------------------------------------------------------------------
 46 
c     ----------------------------------------------------------------------
45 
c     Parameter handling
 47 
c     Parameter handling
46 
c     ----------------------------------------------------------------------
 48 
c     ----------------------------------------------------------------------
47 
 
 49 
 
Line 51... Line 53...
51 
       read(10,*) outfile
 53 
       read(10,*) outfile
52 
       read(10,*) ntra,otim,ncol
 54 
       read(10,*) ntra,otim,ncol
53 
       read(10,*) timeres
 55 
       read(10,*) timeres
54 
       read(10,*) unit
 56 
       read(10,*) unit
55 
       read(10,*) mode
 57 
       read(10,*) mode
- 
 
 58 
       read(10,*) shift
56 
      close(10)
 59 
      close(10)
57 
 
 60 
 
58 
c     Change unit to minutes
 61 
c     Change unit to hours
59 
      if ( unit.eq.'min') then
 62 
      if ( unit.eq.'min') then
60 
         timeres = 1./60. * timeres
 63 
         timeres = 1./60. * timeres
61 
         unit    = 'h'
 64 
         unit    = 'h'
62 
      endif
 65 
      endif
63 
 
 66 
 
Line 101... Line 104...
101 
            call hhmm2frac(hhmm,tfrac)
 104 
            call hhmm2frac(hhmm,tfrac)
102 
            trainp(i,j,1) = tfrac
 105 
            trainp(i,j,1) = tfrac
103 
         enddo
 106 
         enddo
104 
      enddo
 107 
      enddo
105 
 
 108 
 
106 
c     Get the time range in minutes
 109 
c     Get the time range in hours
107 
      range = ( trainp(1,otim,1) - trainp(1,1,1) )
110 
      range = ( trainp(1,otim,1) - trainp(1,1,1) )
108 
 
 111 
 
- 
 
 112 
c     If timeres=0, keep the original resolution
- 
 
 113 
      if ( abs(timeres).lt.eps ) then
- 
 
 114 
         timeres = trainp(1,2,1) - trainp(1,1,1)
- 
 
 115 
         print*,'Keeping time resolution',timeres
- 
 
 116 
      endif
- 
 
 117 
 
109 
c     Determine the new number of times
 118 
c     Determine the new number of times
110 
      ntim = nint( abs( range ) / timeres ) + 1
119 
      ntim = nint( abs( range ) / timeres ) + 1
111 
 
 120 
 
112 
c     Check that the time range and new time resolution are consistent
 121 
c     Check that the time range and new time resolution are consistent
113 
      if ( abs( real(ntim-1) * timeres - abs(range) ).gt.eps ) then
 122 
      if ( abs( real(ntim-1) * timeres - abs(range) ).gt.eps ) then
Line 123... Line 132...
123 
      allocate(timnew(ntim),stat=stat)
 132 
      allocate(timnew(ntim),stat=stat)
124 
      if (stat.ne.0) print*,'*** error allocating array timnew   ***'
133 
      if (stat.ne.0) print*,'*** error allocating array timnew   ***'
125 
      allocate(fldnew(ntim),stat=stat)
 134 
      allocate(fldnew(ntim),stat=stat)
126 
      if (stat.ne.0) print*,'*** error allocating array fldnew   ***'
135 
      if (stat.ne.0) print*,'*** error allocating array fldnew   ***'
127 
 
 136 
 
- 
 
 137 
c     ----------------------------------------------------------------------
- 
 
 138 
c     Change time resolution
- 
 
 139 
c     ----------------------------------------------------------------------
- 
 
 140 
 
128 
c     Define the old and new times
 141 
c     Define the old and new times
129 
      do i=1,otim
 142 
      do i=1,otim
130 
         timold(i) = trainp(1,i,1)
 143 
         timold(i) = trainp(1,i,1)
131 
      enddo
 144 
      enddo
132 
      do i=1,ntim
 145 
      do i=1,ntim
133 
         timnew(i) = timold(1) + real(i-1) * timeres
 146 
         timnew(i) = timold(1) + real(i-1) * timeres
134 
      enddo
 147 
      enddo
135 
 
 148 
 
136 
c     ----------------------------------------------------------------------
 - 
 
137 
c     Change time resolution
 149 
c     Change time resolution
138 
c     ----------------------------------------------------------------------
 - 
 
139 
 
 - 
 
140 
      do i=1,ntra
 150 
      do i=1,ntra
141 
      do k=2,ncol
 151 
      do k=2,ncol
142 
 
 152 
 
143 
c        Copy old field
 153 
c        Copy old field
144 
         do j=1,otim
 154 
         do j=1,otim
Line 182... Line 192...
182 
 
 192 
 
183 
      enddo
 193 
      enddo
184 
      enddo
 194 
      enddo
185 
 
 195 
 
186 
c     ----------------------------------------------------------------------
 196 
c     ----------------------------------------------------------------------
- 
 
 197 
c     Shift time axis - change reference date
- 
 
 198 
c     ----------------------------------------------------------------------
- 
 
 199 
 
- 
 
 200 
c     Shift the reference date
- 
 
 201 
      date0(1) = refdate(1)
- 
 
 202 
      date0(2) = refdate(2)
- 
 
 203 
      date0(3) = refdate(3)
- 
 
 204 
      date0(4) = refdate(4)
- 
 
 205 
      date0(5) = refdate(5)
- 
 
 206 
      call newdate (date0,shift,date1)
- 
 
 207 
      refdate(1) = date1(1)
- 
 
 208 
      refdate(2) = date1(2)
- 
 
 209 
      refdate(3) = date1(3)
- 
 
 210 
      refdate(4) = date1(4)
- 
 
 211 
      refdate(5) = date1(5)
- 
 
 212 
 
- 
 
 213 
c     Shift the times
- 
 
 214 
      do i=1,ntra
- 
 
 215 
      do j=1,ntim
- 
 
 216 
        traout(i,j,1) = traout(i,j,1) - shift
- 
 
 217 
      enddo
- 
 
 218 
      enddo
- 
 
 219 
 
- 
 
 220 
c     ----------------------------------------------------------------------
187 
c     Write output trajectory
 221 
c     Write output trajectory
188 
c     ----------------------------------------------------------------------
 222 
c     ----------------------------------------------------------------------
189 
 
 223 
 
190 
c     Convert all times from fractional to hhmm time
 224 
c     Convert all times from fractional to hhmm time
191 
      do i=1,ntra
 225 
      do i=1,ntra