Subversion Repositories lagranto.ecmwf

Rev

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

Rev 3 Rev 5
Line 36... Line 36...
36 
      integer                                ntra_out      ! Number of trajectories
 36 
      integer                                ntra_out      ! Number of trajectories
37 
      integer                                ntim_out      ! Number of times
 37 
      integer                                ntim_out      ! Number of times
38 
      integer                                ncol_out      ! Number of columns
 38 
      integer                                ncol_out      ! Number of columns
39 
      real,allocatable, dimension (:,:,:) :: tra_out       ! Trajectories (ntra,ntim,ncol)
 39 
      real,allocatable, dimension (:,:,:) :: tra_out       ! Trajectories (ntra,ntim,ncol)
40 
      integer,allocatable, dimension (:)  :: ind           ! Index for selection
 40 
      integer,allocatable, dimension (:)  :: ind           ! Index for selection
- 
 
 41 
      integer,allocatable, dimension (:)  :: isok          ! Index for selection
41 
      character*80                           vars_out(100) ! Variable names
 42 
      character*80                           vars_out(100) ! Variable names
42
43
43 
      real                                   time_inp(500) ! Times of input trajectory
 44 
      real                                   time_inp(500) ! Times of input trajectory
44 
      real                                   time_out(500) ! Times of output trajectory
 45 
      real                                   time_out(500) ! Times of output trajectory
45 
      integer                                refdate(6)    ! Reference date
 46 
      integer                                refdate(6)    ! Reference date
- 
 
 47 
      integer                                ind_time(500) ! Index for time selection
46 
 
 48 
 
47 
c     Auxiliary variables
 49 
c     Auxiliary variables
48 
      integer                                inpmode
 50 
      integer                                inpmode
49 
      integer                                outmode
 51 
      integer                                outmode
50 
      integer                                stat
 52 
      integer                                stat
Line 108... Line 110...
108 
c     Allocate memory
 110 
c     Allocate memory
109 
      allocate(tra_inp(ntra_inp,ntim_inp,ncol_inp),stat=stat)
 111 
      allocate(tra_inp(ntra_inp,ntim_inp,ncol_inp),stat=stat)
110 
      if (stat.ne.0) print*,'*** error allocating array tra_inp    ***'
112 
      if (stat.ne.0) print*,'*** error allocating array tra_inp    ***'
111 
      allocate(ind(ntra_inp),stat=stat)
 113 
      allocate(ind(ntra_inp),stat=stat)
112 
      if (stat.ne.0) print*,'*** error allocating array ind        ***'
114 
      if (stat.ne.0) print*,'*** error allocating array ind        ***'
- 
 
 115 
      allocate(isok(ntra_inp),stat=stat)
- 
 
 116 
      if (stat.ne.0) print*,'*** error allocating array isok       ***'
113 
 
 117 
 
114 
c     Read inpufile
 118 
c     Read inpufile
115 
      fid = 10
 119 
      fid = 10
116 
      call ropen_tra(fid,inpfile,ntra_inp,ntim_inp,ncol_inp,
 120 
      call ropen_tra(fid,inpfile,ntra_inp,ntim_inp,ncol_inp,
117 
     >               refdate,vars_inp,inpmode)
 121 
     >               refdate,vars_inp,inpmode)
Line 253... Line 257...
253 
 
 257 
 
254 
      enddo
 258 
      enddo
255 
 
 259 
 
256 
c     Get the indices of the selected times
 260 
c     Get the indices of the selected times
257 
      do i=1,ntim_out
 261 
      do i=1,ntim_out
258 
         ind(i) = 0
 262 
         ind_time(i) = 0
259 
      enddo
 263 
      enddo
260 
      do i=1,ntim_out
 264 
      do i=1,ntim_out
261 
         do j=1,ntim_inp
 265 
         do j=1,ntim_inp
262 
            if ( abs(time_out(i)-time_inp(j)).lt.eps) ind(i) = j
 266 
            if ( abs(time_out(i)-time_inp(j)).lt.eps) ind_time(i) = j
263 
         enddo
 267 
         enddo
264 
      enddo
 268 
      enddo
265 
      do i=1,ntim_out
 269 
      do i=1,ntim_out
266 
         if ( ind(i).eq.0) then
 270 
         if ( ind_time(i).eq.0) then
267 
            print*,' Invalid time ',time_out(i)
 271 
            print*,' Invalid time ',time_out(i)
268 
            stop
 272 
            stop
269 
         endif
 273 
         endif
270 
      enddo
 274 
      enddo
271
275
Line 279... Line 283...
279 
 
 283 
 
280 
c     Copy the selected times to the output trajectory
 284 
c     Copy the selected times to the output trajectory
281 
      do i=1,ntra_out
 285 
      do i=1,ntra_out
282 
         do j=1,ntim_out
 286 
         do j=1,ntim_out
283 
            do k=1,ncol_out
 287 
            do k=1,ncol_out
284 
               tra_out(i,j,k) = tra_inp(i,ind(j),k)
 288 
               tra_out(i,j,k) = tra_inp(i,ind_time(j),k)
285 
            enddo
 289 
            enddo
286 
         enddo
 290 
         enddo
287 
      enddo
 291 
      enddo
288 
 
 292 
 
289 
c     Copy meta information
 293 
c     Copy meta information
Line 578... Line 582...
578 
         vars_out(i) = vars_inp(i)
 582 
         vars_out(i) = vars_inp(i)
579 
      enddo
 583 
      enddo
580 
 
 584 
 
581 
 160  continue
 585 
 160  continue
582 
 
 586 
 
- 
 
 587 
c     ----------------------------------------------------------------------
- 
 
 588 
c     Option -leaving : Extract all trajectories which leave domain
- 
 
 589 
c     ----------------------------------------------------------------------
- 
 
 590 
 
- 
 
 591 
      if ( mode.ne.'-leaving' ) goto 170
- 
 
 592 
 
- 
 
 593 
c     Set dimensions of output trajectory
- 
 
 594 
      ntim_out = ntim_inp
- 
 
 595 
      ncol_out = ncol_inp
- 
 
 596 
      ntra_out = 0
- 
 
 597 
 
- 
 
 598 
c     Copy the meta data
- 
 
 599 
      do i=1,ncol_out
- 
 
 600 
         vars_out(i) = vars_inp(i)
- 
 
 601 
      enddo
- 
 
 602 
 
- 
 
 603 
c     Determine the number of trajectories leaving domain
- 
 
 604 
      do i=1,ntra_inp
- 
 
 605 
         isok(i) = 1
- 
 
 606 
         do j=1,ntim_inp
- 
 
 607 
            if ( tra_inp(i,j,4).lt.0. ) isok(i) = 0
- 
 
 608 
         enddo
- 
 
 609 
         if ( isok(i).eq.0 ) then
- 
 
 610 
            ntra_out = ntra_out + 1
- 
 
 611 
         endif
- 
 
 612 
      enddo
- 
 
 613
- 
 
 614 
c     Allocate memory for output trajectory
- 
 
 615 
      allocate(tra_out(ntra_out,ntim_out,ncol_out),stat=stat)
- 
 
 616 
      if (stat.ne.0) print*,'*** error allocating array tra_out    ***'
- 
 
 617 
 
- 
 
 618 
c     Copy the selected trajectories to the output trajectory
- 
 
 619 
      ntra_out = 0
- 
 
 620 
      do i=1,ntra_inp
- 
 
 621 
         if ( isok(i).eq.0 ) then
- 
 
 622 
            ntra_out = ntra_out + 1
- 
 
 623 
            do j=1,ntim_inp
- 
 
 624 
               do k=1,ncol_out
- 
 
 625 
                  tra_out(ntra_out,j,k) = tra_inp(i,j,k)
- 
 
 626 
               enddo
- 
 
 627 
            enddo
- 
 
 628 
         endif
- 
 
 629 
      enddo
- 
 
 630
- 
 
 631 
c     Copy meta information
- 
 
 632 
 
- 
 
 633 
 170  continue
- 
 
 634 
 
- 
 
 635 
c     ----------------------------------------------------------------------
- 
 
 636 
c     Option -staying : Extract all trajectories which stay in domain
- 
 
 637 
c     ----------------------------------------------------------------------
- 
 
 638 
 
- 
 
 639 
      if ( mode.ne.'-staying' ) goto 180
- 
 
 640 
 
- 
 
 641 
c     Set dimensions of output trajectory
- 
 
 642 
      ntim_out = ntim_inp
- 
 
 643 
      ncol_out = ncol_inp
- 
 
 644 
      ntra_out = 0
- 
 
 645 
 
- 
 
 646 
c     Copy the meta data
- 
 
 647 
      do i=1,ncol_out
- 
 
 648 
         vars_out(i) = vars_inp(i)
- 
 
 649 
      enddo
- 
 
 650 
 
- 
 
 651 
c     Determine the number of trajectories staying in domain
- 
 
 652 
      do i=1,ntra_inp
- 
 
 653 
         isok(i) = 1
- 
 
 654 
         do j=1,ntim_inp
- 
 
 655 
            if ( tra_inp(i,j,4).lt.0. ) isok(i) = 0
- 
 
 656 
         enddo
- 
 
 657 
         if ( isok(i).eq.1 ) then
- 
 
 658 
            ntra_out = ntra_out + 1
- 
 
 659 
         endif
- 
 
 660 
      enddo
- 
 
 661
- 
 
 662 
c     Allocate memory for output trajectory
- 
 
 663 
      allocate(tra_out(ntra_out,ntim_out,ncol_out),stat=stat)
- 
 
 664 
      if (stat.ne.0) print*,'*** error allocating array tra_out    ***'
- 
 
 665 
 
- 
 
 666 
c     Copy the selected trajectories to the output trajectory
- 
 
 667 
      ntra_out = 0
- 
 
 668 
      do i=1,ntra_inp
- 
 
 669 
         if ( isok(i).eq.1 ) then
- 
 
 670 
            ntra_out = ntra_out + 1
- 
 
 671 
            do j=1,ntim_inp
- 
 
 672 
               do k=1,ncol_out
- 
 
 673 
                  tra_out(ntra_out,j,k) = tra_inp(i,j,k)
- 
 
 674 
               enddo
- 
 
 675 
            enddo
- 
 
 676 
         endif
- 
 
 677 
      enddo
- 
 
 678
- 
 
 679 
c     Copy meta information
- 
 
 680 
 
- 
 
 681 
 180  continue
583 
 
 682 
 
584 
c     ----------------------------------------------------------------------
 683 
c     ----------------------------------------------------------------------
585 
c     Write output trajectories
 684 
c     Write output trajectories
586 
c     ----------------------------------------------------------------------
 685 
c     ----------------------------------------------------------------------
587 
 
 686