WebSVN – lagranto.um – Diff – /tags/2.1/goodies/extract.f


      PROGRAM extract
      
c     ***********************************************************************
c     * Extract columns of a trajectory file                                *
c     * Michael Sprenger / Spring, summer 2010                              *
c     ***********************************************************************
 
      implicit none
 
c     ----------------------------------------------------------------------
c     Declaration of parameters
c     ----------------------------------------------------------------------
 
c     Numerical epsilon
      real      eps
      parameter (eps=0.0001)
 
c     ----------------------------------------------------------------------
c     Declaration of variables
c     ----------------------------------------------------------------------
 
c     Extraction mode
      character*80                           mode                             
 
c     Input and output format for trajectories (see iotra.f)
      character*80                           inpfile       ! Input filename
      character*80                           outfile       ! Output filename
 
c     Trajectories
      integer                                ntra_inp      ! Number of trajectories
      integer                                ntim_inp      ! Number of times
      integer                                ncol_inp      ! Number of columns
      real,allocatable, dimension (:,:,:) :: tra_inp       ! Trajectories (ntra,ntim,ncol)
      character*80                           vars_inp(100) ! Variable names
 
      integer                                ntra_out      ! Number of trajectories
      integer                                ntim_out      ! Number of times
      integer                                ncol_out      ! Number of columns
      real,allocatable, dimension (:,:,:) :: tra_out       ! Trajectories (ntra,ntim,ncol)
      integer,allocatable, dimension (:)  :: ind           ! Index for selection
      character*80                           vars_out(100) ! Variable names
  
      real                                   time_inp(500) ! Times of input trajectory
      real                                   time_out(500) ! Times of output trajectory
      integer                                refdate(6)    ! Reference date
 
c     Auxiliary variables
      integer                                inpmode
      integer                                outmode
      integer                                stat
      integer                                fid
      integer                                i,j,k,j0,j1
      character*80                           str
      character*80                           split_str(100)
      integer                                split_n
      integer                                isstr,nvars,ileft,iright
      character*80                           vars(100)
      character                              ch
      real                                   tmp0,tmp1
      integer                                ind1
 
c     ----------------------------------------------------------------------
c     Read and handle parameters
c     ----------------------------------------------------------------------
 
c     Read parameters
      open(10,file='extract.param')
       read(10,*) inpfile
       read(10,*) outfile
       read(10,*) mode
       read(10,*) ntra_inp,ntim_inp,ncol_inp
       read(10,*) str
      close(10)
 
c     Split the input string
      isstr   = 0
      split_n = 0
      do i=1,80
         ch = str(i:i)
         if ( (isstr.eq.0).and.(ch.ne.' ') ) then
            isstr=1
            ileft=i
         elseif ( (isstr.eq.1).and.(ch.eq.' ') ) then
            isstr              = 0
            iright             = i-1
            split_n            = split_n+1
            split_str(split_n) = str(ileft:iright)
         endif
      enddo
 
c     Determine the formats
      call mode_tra(inpmode,inpfile)
      if (inpmode.eq.-1) inpmode=1
      call mode_tra(outmode,outfile)
      if ( (mode.ne.'-startf').and.(outmode.eq.-1) ) then
         outmode=1
      endif
 
c     ----------------------------------------------------------------------
c     Read input trajectories
c     ----------------------------------------------------------------------
 
c     Allocate memory
      allocate(tra_inp(ntra_inp,ntim_inp,ncol_inp),stat=stat)
      if (stat.ne.0) print*,'*** error allocating array tra_inp    ***' 
      allocate(ind(ntra_inp),stat=stat)
      if (stat.ne.0) print*,'*** error allocating array ind        ***' 
 
c     Read inpufile
      fid = 10
      call ropen_tra(fid,inpfile,ntra_inp,ntim_inp,ncol_inp,
     >               refdate,vars_inp,inpmode)
      call read_tra (fid,tra_inp,ntra_inp,ntim_inp,ncol_inp,inpmode)
      call close_tra(fid,inpmode)
 
c     Check format 
      if ( vars_inp(1).ne.'time') goto 990
      if ( (vars_inp(2).ne.'lon').and.(vars_inp(2).ne.'xpos') ) goto 990
      if ( (vars_inp(3).ne.'lat').and.(vars_inp(3).ne.'ypos') ) goto 990
      if ( (vars_inp(4).ne.'p'  ).and.(vars_inp(4).ne.'ppos') ) goto 990
 
c     ----------------------------------------------------------------------
c     Option -vars : Extract columns of variables
c     ----------------------------------------------------------------------
 
      if ( mode.ne.'-var' ) goto 100
 
c     Set the first for columns of the output
      ncol_out   = 4
      vars_out(1)='time'
      vars_out(2)='lon'
      vars_out(3)='lat'
      vars_out(4)='p'
      ind(1)     =1
      ind(2)     =2
      ind(3)     =3
      ind(4)     =4
 
c     Get final list of extraction columns (set number of columns)
      do i=1,split_n
 
         if (split_str(i).eq.'to') then
            do j=1,ncol_inp
               if ( vars_inp(j).eq.split_str(i-1) ) j0 = j + 1
            enddo
            do j=1,ncol_inp
               if ( vars_inp(j).eq.split_str(i+1) ) j1 = j - 1
            enddo
            do j=j0,j1
               ncol_out           = ncol_out + 1
               vars_out(ncol_out) = vars_inp(j)
            enddo
         else
            ncol_out           = ncol_out + 1
            vars_out(ncol_out) = split_str(i)
         endif
 
      enddo
 
c     Set the dimensions of the output trajectory
      ntra_out = ntra_inp
      ntim_out = ntim_inp
 
c     Allocate memory for output trajectory
      allocate(tra_out(ntra_out,ntim_out,ncol_out),stat=stat)
      if (stat.ne.0) print*,'*** error allocating array tra_out    ***' 
 
c     Extract <time,lon,lat,p> columns
      do i=1,ntra_out
         do j=1,ntim_out
            tra_out(i,j,1) = tra_inp(i,j,1)
            tra_out(i,j,2) = tra_inp(i,j,2)
            tra_out(i,j,3) = tra_inp(i,j,3)
            tra_out(i,j,4) = tra_inp(i,j,4)
         enddo
      enddo
 
c     Get indices for new columns (1..4 are already ok)
      do i=5,ncol_out
         ind(i)=0
      enddo
      do i=5,ncol_out
         do j=1,ncol_inp
            if ( vars_inp(j).eq.vars_out(i) ) ind(i) = j
         enddo
      enddo
 
c     Check if all selected columns are available
      do i=1,ncol_out
         if ( ind(i).eq.0 ) then
            print*,'Invalid column in ',trim(str)
            stop
         endif
      enddo
 
c     Extract the column
      do i=1,ntra_out
         do j=1,ntim_out
            do k=1,ncol_out
               tra_out(i,j,k) = tra_inp(i,j,ind(k))
            enddo
         enddo
      enddo
 
 100  continue
 
c     ----------------------------------------------------------------------
c     Option -times : Extract times of trajectories
c     ----------------------------------------------------------------------
 
      if ( mode.ne.'-time' ) goto 110
 
c     Set the dimension of the output trajectory
      ntim_out = 0
 
c     Get the list of times for the input trajectory
      do i=1,ntim_inp
         time_inp(i) = tra_inp(1,i,1)
      enddo
 
c     Get final list of extraction times (set number of times)
      do i=1,split_n
 
         if (split_str(i).eq.'to') then
            read(split_str(i-1),*) tmp0
            do j=1,ntim_inp
               if ( time_inp(j).eq.tmp0 ) j0 = j + 1
            enddo
            read(split_str(i+1),*) tmp0
            do j=1,ntim_inp
               if ( time_inp(j).eq.tmp0 ) j1 = j - 1
            enddo
            do j=j0,j1
               ntim_out           = ntim_out + 1
               time_out(ntim_out) = time_inp(j)
            enddo
         elseif (split_str(i).eq.'first') then
            ntim_out           = ntim_out + 1
            time_out(ntim_out) = time_inp(1)
         elseif (split_str(i).eq.'last') then
            ntim_out           = ntim_out + 1
            time_out(ntim_out) = time_inp(ntim_inp)
         else
            ntim_out           = ntim_out + 1
            read(split_str(i),*) tmp0
            time_out(ntim_out) = tmp0
         endif
 
      enddo
 
c     Get the indices of the selected times
      do i=1,ntim_out
         ind(i) = 0
      enddo
      do i=1,ntim_out
         do j=1,ntim_inp
            if ( abs(time_out(i)-time_inp(j)).lt.eps) ind(i) = j
         enddo
      enddo
      do i=1,ntim_out
         if ( ind(i).eq.0) then
            print*,' Invalid time ',time_out(i)
            stop
         endif
      enddo
      
c     Set dimensions of output trajectory
      ntra_out = ntra_inp
      ncol_out = ncol_inp
 
c     Allocate memory for output trajectory
      allocate(tra_out(ntra_out,ntim_out,ncol_out),stat=stat)
      if (stat.ne.0) print*,'*** error allocating array tra_out    ***' 
 
c     Copy the selected times to the output trajectory
      do i=1,ntra_out
         do j=1,ntim_out
            do k=1,ncol_out
               tra_out(i,j,k) = tra_inp(i,ind(j),k)
            enddo
         enddo
      enddo
 
c     Copy meta information
      do i=1,ncol_out
         vars_out(i) = vars_inp(i)
      enddo
 
 110  continue
 
c     ----------------------------------------------------------------------
c     Option -tra : Extract trajectories by number
c     ----------------------------------------------------------------------
 
      if ( mode.ne.'-tra' ) goto 120
 
c     Set the dimension of the output trajectory
      ntra_out = 0
 
c     Get final list of extraction times (set number of times)
      do i=1,split_n
 
         if (split_str(i).eq.'to') then
            read(split_str(i-1),*) tmp0
            read(split_str(i+1),*) tmp1
            do j=nint(tmp0)+1,nint(tmp1)-1
               ntra_out        = ntra_out + 1
               ind(ntra_out)   = j   
            enddo
         elseif (split_str(i).eq.'first') then
            ntra_out           = ntra_out + 1
            ind(ntra_out)      = 1
         elseif (split_str(i).eq.'last') then
            ntra_out           = ntra_out + 1
            ind(ntra_out)      = ntra_inp
         else
            ntra_out           = ntra_out + 1
            read(split_str(i),*) tmp0
            ind(ntra_out)      = nint(tmp0) 
         endif
 
      enddo
 
c     Check whether selected trajectories are ok
      do i=1,ntra_out
         if ( (ind(i).lt.1).or.(ind(i).gt.ntra_inp) ) then
            print*,'Invalid trajectory selected ',ind(i)
            stop
         endif
      enddo
 
c     Set dimensions of output trajectory
      ntim_out = ntim_inp
      ncol_out = ncol_inp
     
c     Allocate memory for output trajectory
      allocate(tra_out(ntra_out,ntim_out,ncol_out),stat=stat)
      if (stat.ne.0) print*,'*** error allocating array tra_out    ***' 
 
c     Copy the selected times to the output trajectory
      do i=1,ntra_out
         do j=1,ntim_out
            do k=1,ncol_out
               tra_out(i,j,k) = tra_inp(ind(i),j,k)
            enddo
         enddo
      enddo
 
c     Copy meta information
      do i=1,ncol_out
         vars_out(i) = vars_inp(i)
      enddo
 
 120  continue
 
c     ----------------------------------------------------------------------
c     Option -startf : Extract starting positions for the trajectory file
c     ----------------------------------------------------------------------
 
      if ( mode.ne.'-startf' ) goto 130
 
c     Set the first for columns of the output
      ncol_out   = 4
      vars_out(1)='time'
      vars_out(2)='lon'
      vars_out(3)='lat'
      vars_out(4)='p'
      ind(1)     =1
      ind(2)     =2
      ind(3)     =3
      ind(4)     =4
 
c     Set dimensions of output trajectory
      ntim_out = 1
      ntra_out = ntra_inp
     
c     Allocate memory for output trajectory
      allocate(tra_out(ntra_out,ntim_out,ncol_out),stat=stat)
      if (stat.ne.0) print*,'*** error allocating array tra_out    ***' 
      
c     Copy the selected times to the output trajectory
      do i=1,ntra_out
         do k=1,ncol_out
            tra_out(i,1,k) = tra_inp(i,1,k)
         enddo
      enddo
      
c     Copy meta information
      do i=1,ncol_out
         vars_out(i) = vars_inp(i)
      enddo
 
 130  continue
 
c     ----------------------------------------------------------------------
c     Option -index : Extract trajectories by index file
c     ----------------------------------------------------------------------
 
      if ( mode.ne.'-index' ) goto 140
 
c     Read the index file
      open(10,file=str)
 
        ntra_out = 1
 142    read(10,*,end=141) ind(ntra_out)
        ntra_out = ntra_out + 1
        goto 142 
 141    continue
        ntra_out = ntra_out - 1
 
      close(10)
 
c     Check whether selected trajectories are ok
      do i=1,ntra_out
         if ( (ind(i).lt.1).or.(ind(i).gt.ntra_inp) ) then
            print*,'Invalid trajectory selected ',ind(i)
            stop
         endif
      enddo
 
c     Set dimensions of output trajectory
      ntim_out = ntim_inp
      ncol_out = ncol_inp
     
c     Allocate memory for output trajectory
      allocate(tra_out(ntra_out,ntim_out,ncol_out),stat=stat)
      if (stat.ne.0) print*,'*** error allocating array tra_out    ***' 
 
c     Copy the selected times to the output trajectory
      do i=1,ntra_out
         do j=1,ntim_out
            do k=1,ncol_out
               tra_out(i,j,k) = tra_inp(ind(i),j,k)
            enddo
         enddo
      enddo
 
c     Copy meta information
      do i=1,ncol_out
         vars_out(i) = vars_inp(i)
      enddo
 
 140  continue
 
c     ----------------------------------------------------------------------
c     Option -boolean : Extract trajectories by boolean file
c     ----------------------------------------------------------------------
 
      if ( mode.ne.'-boolean' ) goto 150
 
c     Read the index file
      open(10,file=str)
        ntra_out = 0
        do i=1,ntra_inp
           read(10,*) ind1
           if ( ind1.eq.1 ) then
              ntra_out      = ntra_out + 1
              ind(ntra_out) = i
           endif
        enddo
      close(10)
 
c     Check whether selected trajectories are ok
      do i=1,ntra_out
         if ( (ind(i).lt.1).or.(ind(i).gt.ntra_inp) ) then
            print*,'Invalid trajectory selected ',ind(i)
            stop
         endif
      enddo
 
c     Set dimensions of output trajectory
      ntim_out = ntim_inp
      ncol_out = ncol_inp
     
c     Allocate memory for output trajectory
      allocate(tra_out(ntra_out,ntim_out,ncol_out),stat=stat)
      if (stat.ne.0) print*,'*** error allocating array tra_out    ***' 
 
c     Copy the selected times to the output trajectory
      do i=1,ntra_out
         do j=1,ntim_out
            do k=1,ncol_out
               tra_out(i,j,k) = tra_inp(ind(i),j,k)
            enddo
         enddo
      enddo
 
c     Copy meta information
      do i=1,ncol_out
         vars_out(i) = vars_inp(i)
      enddo
 
 150  continue
 
c     ----------------------------------------------------------------------
c     Write output trajectories
c     ----------------------------------------------------------------------
   
c     Write output as trajectory file
      if (outmode.ge.1) then
 
         call wopen_tra(fid,outfile,ntra_out,ntim_out,ncol_out,
     >                  refdate,vars_out,outmode)
         call write_tra(fid,tra_out,ntra_out,ntim_out,ncol_out,outmode)
         call close_tra(fid,outmode)
         
c     Write output as (lon, lat, p)-list
      else
 
         open(10,file=outfile)
         do i=1,ntra_out
            write(10,'(3f10.2)') tra_out(i,1,2),    ! lon
     >                           tra_out(i,1,3),    ! lat
     >                           tra_out(i,1,4)     ! p
         enddo
         close(10)
 
      endif
 
c     ----------------------------------------------------------------------
c     Error handling
c     ----------------------------------------------------------------------
      
      stop
   
 990  print*,'First columns must be <time,lon,lat,p>... Stop'
      stop
      
 
      end
 
      
 
      

Rev 3	Rev 12
1	`PROGRAM extract`	1	`PROGRAM extract`
2		2
3	`c ***********************************************************************`	3	`c ***********************************************************************`
4	`c * Extract columns of a trajectory file *`	4	`c * Extract columns of a trajectory file *`
5	`c * Michael Sprenger / Spring, summer 2010 *`	5	`c * Michael Sprenger / Spring, summer 2010 *`
6	`c ***********************************************************************`	6	`c ***********************************************************************`
7		7
8	`implicit none`	8	`implicit none`
9		9
10	`c ----------------------------------------------------------------------`	10	`c ----------------------------------------------------------------------`
11	`c Declaration of parameters`	11	`c Declaration of parameters`
12	`c ----------------------------------------------------------------------`	12	`c ----------------------------------------------------------------------`
13		13
14	`c Numerical epsilon`	14	`c Numerical epsilon`
15	`real eps`	15	`real eps`
16	`parameter (eps=0.0001)`	16	`parameter (eps=0.0001)`
17		17
18	`c ----------------------------------------------------------------------`	18	`c ----------------------------------------------------------------------`
19	`c Declaration of variables`	19	`c Declaration of variables`
20	`c ----------------------------------------------------------------------`	20	`c ----------------------------------------------------------------------`
21		21
22	`c Extraction mode`	22	`c Extraction mode`
23	`character*80 mode`	23	`character*80 mode`
24		24
25	`c Input and output format for trajectories (see iotra.f)`	25	`c Input and output format for trajectories (see iotra.f)`
26	`character*80 inpfile ! Input filename`	26	`character*80 inpfile ! Input filename`
27	`character*80 outfile ! Output filename`	27	`character*80 outfile ! Output filename`
28		28
29	`c Trajectories`	29	`c Trajectories`
30	`integer ntra_inp ! Number of trajectories`	30	`integer ntra_inp ! Number of trajectories`
31	`integer ntim_inp ! Number of times`	31	`integer ntim_inp ! Number of times`
32	`integer ncol_inp ! Number of columns`	32	`integer ncol_inp ! Number of columns`
33	`real,allocatable, dimension (:,:,:) :: tra_inp ! Trajectories (ntra,ntim,ncol)`	33	`real,allocatable, dimension (:,:,:) :: tra_inp ! Trajectories (ntra,ntim,ncol)`
34	`character*80 vars_inp(100) ! Variable names`	34	`character*80 vars_inp(100) ! Variable names`
35		35
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	`character*80 vars_out(100) ! Variable names`	41	`character*80 vars_out(100) ! Variable names`
42		42
43	`real time_inp(500) ! Times of input trajectory`	43	`real time_inp(500) ! Times of input trajectory`
44	`real time_out(500) ! Times of output trajectory`	44	`real time_out(500) ! Times of output trajectory`
45	`integer refdate(6) ! Reference date`	45	`integer refdate(6) ! Reference date`
46		46
47	`c Auxiliary variables`	47	`c Auxiliary variables`
48	`integer inpmode`	48	`integer inpmode`
49	`integer outmode`	49	`integer outmode`
50	`integer stat`	50	`integer stat`
51	`integer fid`	51	`integer fid`
52	`integer i,j,k,j0,j1`	52	`integer i,j,k,j0,j1`
53	`character*80 str`	53	`character*80 str`
54	`character*80 split_str(100)`	54	`character*80 split_str(100)`
55	`integer split_n`	55	`integer split_n`
56	`integer isstr,nvars,ileft,iright`	56	`integer isstr,nvars,ileft,iright`
57	`character*80 vars(100)`	57	`character*80 vars(100)`
58	`character ch`	58	`character ch`
59	`real tmp0,tmp1`	59	`real tmp0,tmp1`
60	`integer ind1`	60	`integer ind1`
61		61
62	`c ----------------------------------------------------------------------`	62	`c ----------------------------------------------------------------------`
63	`c Read and handle parameters`	63	`c Read and handle parameters`
64	`c ----------------------------------------------------------------------`	64	`c ----------------------------------------------------------------------`
65		65
66	`c Read parameters`	66	`c Read parameters`
67	`open(10,file='extract.param')`	67	`open(10,file='extract.param')`
68	`read(10,*) inpfile`	68	`read(10,*) inpfile`
69	`read(10,*) outfile`	69	`read(10,*) outfile`
70	`read(10,*) mode`	70	`read(10,*) mode`
71	`read(10,*) ntra_inp,ntim_inp,ncol_inp`	71	`read(10,*) ntra_inp,ntim_inp,ncol_inp`
72	`read(10,*) str`	72	`read(10,*) str`
73	`close(10)`	73	`close(10)`
74		74
75	`c Split the input string`	75	`c Split the input string`
76	`isstr = 0`	76	`isstr = 0`
77	`split_n = 0`	77	`split_n = 0`
78	`do i=1,80`	78	`do i=1,80`
79	`ch = str(i:i)`	79	`ch = str(i:i)`
80	`if ( (isstr.eq.0).and.(ch.ne.' ') ) then`	80	`if ( (isstr.eq.0).and.(ch.ne.' ') ) then`
81	`isstr=1`	81	`isstr=1`
82	`ileft=i`	82	`ileft=i`
83	`elseif ( (isstr.eq.1).and.(ch.eq.' ') ) then`	83	`elseif ( (isstr.eq.1).and.(ch.eq.' ') ) then`
84	`isstr = 0`	84	`isstr = 0`
85	`iright = i-1`	85	`iright = i-1`
86	`split_n = split_n+1`	86	`split_n = split_n+1`
87	`split_str(split_n) = str(ileft:iright)`	87	`split_str(split_n) = str(ileft:iright)`
88	`endif`	88	`endif`
89	`enddo`	89	`enddo`
90		90
91	`c Determine the formats`	91	`c Determine the formats`
92	`call mode_tra(inpmode,inpfile)`	92	`call mode_tra(inpmode,inpfile)`
93	`if (inpmode.eq.-1) inpmode=1`	93	`if (inpmode.eq.-1) inpmode=1`
94	`call mode_tra(outmode,outfile)`	94	`call mode_tra(outmode,outfile)`
95	`if ( (mode.ne.'-startf').and.(outmode.eq.-1) ) then`	95	`if ( (mode.ne.'-startf').and.(outmode.eq.-1) ) then`
96	`outmode=1`	96	`outmode=1`
97	`endif`	97	`endif`
98		98
99	`c ----------------------------------------------------------------------`	99	`c ----------------------------------------------------------------------`
100	`c Read input trajectories`	100	`c Read input trajectories`
101	`c ----------------------------------------------------------------------`	101	`c ----------------------------------------------------------------------`
102		102
103	`c Allocate memory`	103	`c Allocate memory`
104	`allocate(tra_inp(ntra_inp,ntim_inp,ncol_inp),stat=stat)`	104	`allocate(tra_inp(ntra_inp,ntim_inp,ncol_inp),stat=stat)`
105	`if (stat.ne.0) print,' error allocating array tra_inp *'`	105	`if (stat.ne.0) print,' error allocating array tra_inp *'`
106	`allocate(ind(ntra_inp),stat=stat)`	106	`allocate(ind(ntra_inp),stat=stat)`
107	`if (stat.ne.0) print,' error allocating array ind *'`	107	`if (stat.ne.0) print,' error allocating array ind *'`
108		108
109	`c Read inpufile`	109	`c Read inpufile`
110	`fid = 10`	110	`fid = 10`
111	`call ropen_tra(fid,inpfile,ntra_inp,ntim_inp,ncol_inp,`	111	`call ropen_tra(fid,inpfile,ntra_inp,ntim_inp,ncol_inp,`
112	`> refdate,vars_inp,inpmode)`	112	`> refdate,vars_inp,inpmode)`
113	`call read_tra (fid,tra_inp,ntra_inp,ntim_inp,ncol_inp,inpmode)`	113	`call read_tra (fid,tra_inp,ntra_inp,ntim_inp,ncol_inp,inpmode)`
114	`call close_tra(fid,inpmode)`	114	`call close_tra(fid,inpmode)`
115		115
116	`c Check format`	116	`c Check format`
117	`if ( vars_inp(1).ne.'time') goto 990`	117	`if ( vars_inp(1).ne.'time') goto 990`
118	`if ( (vars_inp(2).ne.'lon').and.(vars_inp(2).ne.'xpos') ) goto 990`	118	`if ( (vars_inp(2).ne.'lon').and.(vars_inp(2).ne.'xpos') ) goto 990`
119	`if ( (vars_inp(3).ne.'lat').and.(vars_inp(3).ne.'ypos') ) goto 990`	119	`if ( (vars_inp(3).ne.'lat').and.(vars_inp(3).ne.'ypos') ) goto 990`
120	`if ( (vars_inp(4).ne.'p' ).and.(vars_inp(4).ne.'ppos') ) goto 990`	120	`if ( (vars_inp(4).ne.'p' ).and.(vars_inp(4).ne.'ppos') ) goto 990`
121		121
122	`c ----------------------------------------------------------------------`	122	`c ----------------------------------------------------------------------`
123	`c Option -vars : Extract columns of variables`	123	`c Option -vars : Extract columns of variables`
124	`c ----------------------------------------------------------------------`	124	`c ----------------------------------------------------------------------`
125		125
126	`if ( mode.ne.'-var' ) goto 100`	126	`if ( mode.ne.'-var' ) goto 100`
127		127
128	`c Set the first for columns of the output`	128	`c Set the first for columns of the output`
129	`ncol_out = 4`	129	`ncol_out = 4`
130	`vars_out(1)='time'`	130	`vars_out(1)='time'`
131	`vars_out(2)='lon'`	131	`vars_out(2)='lon'`
132	`vars_out(3)='lat'`	132	`vars_out(3)='lat'`
133	`vars_out(4)='p'`	133	`vars_out(4)='p'`
134	`ind(1) =1`	134	`ind(1) =1`
135	`ind(2) =2`	135	`ind(2) =2`
136	`ind(3) =3`	136	`ind(3) =3`
137	`ind(4) =4`	137	`ind(4) =4`
138		138
139	`c Get final list of extraction columns (set number of columns)`	139	`c Get final list of extraction columns (set number of columns)`
140	`do i=1,split_n`	140	`do i=1,split_n`
141		141
142	`if (split_str(i).eq.'to') then`	142	`if (split_str(i).eq.'to') then`
143	`do j=1,ncol_inp`	143	`do j=1,ncol_inp`
144	`if ( vars_inp(j).eq.split_str(i-1) ) j0 = j + 1`	144	`if ( vars_inp(j).eq.split_str(i-1) ) j0 = j + 1`
145	`enddo`	145	`enddo`
146	`do j=1,ncol_inp`	146	`do j=1,ncol_inp`
147	`if ( vars_inp(j).eq.split_str(i+1) ) j1 = j - 1`	147	`if ( vars_inp(j).eq.split_str(i+1) ) j1 = j - 1`
148	`enddo`	148	`enddo`
149	`do j=j0,j1`	149	`do j=j0,j1`
150	`ncol_out = ncol_out + 1`	150	`ncol_out = ncol_out + 1`
151	`vars_out(ncol_out) = vars_inp(j)`	151	`vars_out(ncol_out) = vars_inp(j)`
152	`enddo`	152	`enddo`
153	`else`	153	`else`
154	`ncol_out = ncol_out + 1`	154	`ncol_out = ncol_out + 1`
155	`vars_out(ncol_out) = split_str(i)`	155	`vars_out(ncol_out) = split_str(i)`
156	`endif`	156	`endif`
157		157
158	`enddo`	158	`enddo`
159		159
160	`c Set the dimensions of the output trajectory`	160	`c Set the dimensions of the output trajectory`
161	`ntra_out = ntra_inp`	161	`ntra_out = ntra_inp`
162	`ntim_out = ntim_inp`	162	`ntim_out = ntim_inp`
163		163
164	`c Allocate memory for output trajectory`	164	`c Allocate memory for output trajectory`
165	`allocate(tra_out(ntra_out,ntim_out,ncol_out),stat=stat)`	165	`allocate(tra_out(ntra_out,ntim_out,ncol_out),stat=stat)`
166	`if (stat.ne.0) print,' error allocating array tra_out *'`	166	`if (stat.ne.0) print,' error allocating array tra_out *'`
167		167
168	`c Extract <time,lon,lat,p> columns`	168	`c Extract <time,lon,lat,p> columns`
169	`do i=1,ntra_out`	169	`do i=1,ntra_out`
170	`do j=1,ntim_out`	170	`do j=1,ntim_out`
171	`tra_out(i,j,1) = tra_inp(i,j,1)`	171	`tra_out(i,j,1) = tra_inp(i,j,1)`
172	`tra_out(i,j,2) = tra_inp(i,j,2)`	172	`tra_out(i,j,2) = tra_inp(i,j,2)`
173	`tra_out(i,j,3) = tra_inp(i,j,3)`	173	`tra_out(i,j,3) = tra_inp(i,j,3)`
174	`tra_out(i,j,4) = tra_inp(i,j,4)`	174	`tra_out(i,j,4) = tra_inp(i,j,4)`
175	`enddo`	175	`enddo`
176	`enddo`	176	`enddo`
177		177
178	`c Get indices for new columns (1..4 are already ok)`	178	`c Get indices for new columns (1..4 are already ok)`
179	`do i=5,ncol_out`	179	`do i=5,ncol_out`
180	`ind(i)=0`	180	`ind(i)=0`
181	`enddo`	181	`enddo`
182	`do i=5,ncol_out`	182	`do i=5,ncol_out`
183	`do j=1,ncol_inp`	183	`do j=1,ncol_inp`
184	`if ( vars_inp(j).eq.vars_out(i) ) ind(i) = j`	184	`if ( vars_inp(j).eq.vars_out(i) ) ind(i) = j`
185	`enddo`	185	`enddo`
186	`enddo`	186	`enddo`
187		187
188	`c Check if all selected columns are available`	188	`c Check if all selected columns are available`
189	`do i=1,ncol_out`	189	`do i=1,ncol_out`
190	`if ( ind(i).eq.0 ) then`	190	`if ( ind(i).eq.0 ) then`
191	`print*,'Invalid column in ',trim(str)`	191	`print*,'Invalid column in ',trim(str)`
192	`stop`	192	`stop`
193	`endif`	193	`endif`
194	`enddo`	194	`enddo`
195		195
196	`c Extract the column`	196	`c Extract the column`
197	`do i=1,ntra_out`	197	`do i=1,ntra_out`
198	`do j=1,ntim_out`	198	`do j=1,ntim_out`
199	`do k=1,ncol_out`	199	`do k=1,ncol_out`
200	`tra_out(i,j,k) = tra_inp(i,j,ind(k))`	200	`tra_out(i,j,k) = tra_inp(i,j,ind(k))`
201	`enddo`	201	`enddo`
202	`enddo`	202	`enddo`
203	`enddo`	203	`enddo`
204		204
205	`100 continue`	205	`100 continue`
206		206
207	`c ----------------------------------------------------------------------`	207	`c ----------------------------------------------------------------------`
208	`c Option -times : Extract times of trajectories`	208	`c Option -times : Extract times of trajectories`
209	`c ----------------------------------------------------------------------`	209	`c ----------------------------------------------------------------------`
210		210
211	`if ( mode.ne.'-time' ) goto 110`	211	`if ( mode.ne.'-time' ) goto 110`
212		212
213	`c Set the dimension of the output trajectory`	213	`c Set the dimension of the output trajectory`
214	`ntim_out = 0`	214	`ntim_out = 0`
215		215
216	`c Get the list of times for the input trajectory`	216	`c Get the list of times for the input trajectory`
217	`do i=1,ntim_inp`	217	`do i=1,ntim_inp`
218	`time_inp(i) = tra_inp(1,i,1)`	218	`time_inp(i) = tra_inp(1,i,1)`
219	`enddo`	219	`enddo`
220		220
221	`c Get final list of extraction times (set number of times)`	221	`c Get final list of extraction times (set number of times)`
222	`do i=1,split_n`	222	`do i=1,split_n`
223		223
224	`if (split_str(i).eq.'to') then`	224	`if (split_str(i).eq.'to') then`
225	`read(split_str(i-1),*) tmp0`	225	`read(split_str(i-1),*) tmp0`
226	`do j=1,ntim_inp`	226	`do j=1,ntim_inp`
227	`if ( time_inp(j).eq.tmp0 ) j0 = j + 1`	227	`if ( time_inp(j).eq.tmp0 ) j0 = j + 1`
228	`enddo`	228	`enddo`
229	`read(split_str(i+1),*) tmp0`	229	`read(split_str(i+1),*) tmp0`
230	`do j=1,ntim_inp`	230	`do j=1,ntim_inp`
231	`if ( time_inp(j).eq.tmp0 ) j1 = j - 1`	231	`if ( time_inp(j).eq.tmp0 ) j1 = j - 1`
232	`enddo`	232	`enddo`
233	`do j=j0,j1`	233	`do j=j0,j1`
234	`ntim_out = ntim_out + 1`	234	`ntim_out = ntim_out + 1`
235	`time_out(ntim_out) = time_inp(j)`	235	`time_out(ntim_out) = time_inp(j)`
236	`enddo`	236	`enddo`
237	`elseif (split_str(i).eq.'first') then`	237	`elseif (split_str(i).eq.'first') then`
238	`ntim_out = ntim_out + 1`	238	`ntim_out = ntim_out + 1`
239	`time_out(ntim_out) = time_inp(1)`	239	`time_out(ntim_out) = time_inp(1)`
240	`elseif (split_str(i).eq.'last') then`	240	`elseif (split_str(i).eq.'last') then`
241	`ntim_out = ntim_out + 1`	241	`ntim_out = ntim_out + 1`
242	`time_out(ntim_out) = time_inp(ntim_inp)`	242	`time_out(ntim_out) = time_inp(ntim_inp)`
243	`else`	243	`else`
244	`ntim_out = ntim_out + 1`	244	`ntim_out = ntim_out + 1`
245	`read(split_str(i),*) tmp0`	245	`read(split_str(i),*) tmp0`
246	`time_out(ntim_out) = tmp0`	246	`time_out(ntim_out) = tmp0`
247	`endif`	247	`endif`
248		248
249	`enddo`	249	`enddo`
250		250
251	`c Get the indices of the selected times`	251	`c Get the indices of the selected times`
252	`do i=1,ntim_out`	252	`do i=1,ntim_out`
253	`ind(i) = 0`	253	`ind(i) = 0`
254	`enddo`	254	`enddo`
255	`do i=1,ntim_out`	255	`do i=1,ntim_out`
256	`do j=1,ntim_inp`	256	`do j=1,ntim_inp`
257	`if ( abs(time_out(i)-time_inp(j)).lt.eps) ind(i) = j`	257	`if ( abs(time_out(i)-time_inp(j)).lt.eps) ind(i) = j`
258	`enddo`	258	`enddo`
259	`enddo`	259	`enddo`
260	`do i=1,ntim_out`	260	`do i=1,ntim_out`
261	`if ( ind(i).eq.0) then`	261	`if ( ind(i).eq.0) then`
262	`print*,' Invalid time ',time_out(i)`	262	`print*,' Invalid time ',time_out(i)`
263	`stop`	263	`stop`
264	`endif`	264	`endif`
265	`enddo`	265	`enddo`
266		266
267	`c Set dimensions of output trajectory`	267	`c Set dimensions of output trajectory`
268	`ntra_out = ntra_inp`	268	`ntra_out = ntra_inp`
269	`ncol_out = ncol_inp`	269	`ncol_out = ncol_inp`
270		270
271	`c Allocate memory for output trajectory`	271	`c Allocate memory for output trajectory`
272	`allocate(tra_out(ntra_out,ntim_out,ncol_out),stat=stat)`	272	`allocate(tra_out(ntra_out,ntim_out,ncol_out),stat=stat)`
273	`if (stat.ne.0) print,' error allocating array tra_out *'`	273	`if (stat.ne.0) print,' error allocating array tra_out *'`
274		274
275	`c Copy the selected times to the output trajectory`	275	`c Copy the selected times to the output trajectory`
276	`do i=1,ntra_out`	276	`do i=1,ntra_out`
277	`do j=1,ntim_out`	277	`do j=1,ntim_out`
278	`do k=1,ncol_out`	278	`do k=1,ncol_out`
279	`tra_out(i,j,k) = tra_inp(i,ind(j),k)`	279	`tra_out(i,j,k) = tra_inp(i,ind(j),k)`
280	`enddo`	280	`enddo`
281	`enddo`	281	`enddo`
282	`enddo`	282	`enddo`
283		283
284	`c Copy meta information`	284	`c Copy meta information`
285	`do i=1,ncol_out`	285	`do i=1,ncol_out`
286	`vars_out(i) = vars_inp(i)`	286	`vars_out(i) = vars_inp(i)`
287	`enddo`	287	`enddo`
288		288
289	`110 continue`	289	`110 continue`
290		290
291	`c ----------------------------------------------------------------------`	291	`c ----------------------------------------------------------------------`
292	`c Option -tra : Extract trajectories by number`	292	`c Option -tra : Extract trajectories by number`
293	`c ----------------------------------------------------------------------`	293	`c ----------------------------------------------------------------------`
294		294
295	`if ( mode.ne.'-tra' ) goto 120`	295	`if ( mode.ne.'-tra' ) goto 120`
296		296
297	`c Set the dimension of the output trajectory`	297	`c Set the dimension of the output trajectory`
298	`ntra_out = 0`	298	`ntra_out = 0`
299		299
300	`c Get final list of extraction times (set number of times)`	300	`c Get final list of extraction times (set number of times)`
301	`do i=1,split_n`	301	`do i=1,split_n`
302		302
303	`if (split_str(i).eq.'to') then`	303	`if (split_str(i).eq.'to') then`
304	`read(split_str(i-1),*) tmp0`	304	`read(split_str(i-1),*) tmp0`
305	`read(split_str(i+1),*) tmp1`	305	`read(split_str(i+1),*) tmp1`
306	`do j=nint(tmp0)+1,nint(tmp1)-1`	306	`do j=nint(tmp0)+1,nint(tmp1)-1`
307	`ntra_out = ntra_out + 1`	307	`ntra_out = ntra_out + 1`
308	`ind(ntra_out) = j`	308	`ind(ntra_out) = j`
309	`enddo`	309	`enddo`
310	`elseif (split_str(i).eq.'first') then`	310	`elseif (split_str(i).eq.'first') then`
311	`ntra_out = ntra_out + 1`	311	`ntra_out = ntra_out + 1`
312	`ind(ntra_out) = 1`	312	`ind(ntra_out) = 1`
313	`elseif (split_str(i).eq.'last') then`	313	`elseif (split_str(i).eq.'last') then`
314	`ntra_out = ntra_out + 1`	314	`ntra_out = ntra_out + 1`
315	`ind(ntra_out) = ntra_inp`	315	`ind(ntra_out) = ntra_inp`
316	`else`	316	`else`
317	`ntra_out = ntra_out + 1`	317	`ntra_out = ntra_out + 1`
318	`read(split_str(i),*) tmp0`	318	`read(split_str(i),*) tmp0`
319	`ind(ntra_out) = nint(tmp0)`	319	`ind(ntra_out) = nint(tmp0)`
320	`endif`	320	`endif`
321		321
322	`enddo`	322	`enddo`
323		323
324	`c Check whether selected trajectories are ok`	324	`c Check whether selected trajectories are ok`
325	`do i=1,ntra_out`	325	`do i=1,ntra_out`
326	`if ( (ind(i).lt.1).or.(ind(i).gt.ntra_inp) ) then`	326	`if ( (ind(i).lt.1).or.(ind(i).gt.ntra_inp) ) then`
327	`print*,'Invalid trajectory selected ',ind(i)`	327	`print*,'Invalid trajectory selected ',ind(i)`
328	`stop`	328	`stop`
329	`endif`	329	`endif`
330	`enddo`	330	`enddo`
331		331
332	`c Set dimensions of output trajectory`	332	`c Set dimensions of output trajectory`
333	`ntim_out = ntim_inp`	333	`ntim_out = ntim_inp`
334	`ncol_out = ncol_inp`	334	`ncol_out = ncol_inp`
335		335
336	`c Allocate memory for output trajectory`	336	`c Allocate memory for output trajectory`
337	`allocate(tra_out(ntra_out,ntim_out,ncol_out),stat=stat)`	337	`allocate(tra_out(ntra_out,ntim_out,ncol_out),stat=stat)`
338	`if (stat.ne.0) print,' error allocating array tra_out *'`	338	`if (stat.ne.0) print,' error allocating array tra_out *'`
339		339
340	`c Copy the selected times to the output trajectory`	340	`c Copy the selected times to the output trajectory`
341	`do i=1,ntra_out`	341	`do i=1,ntra_out`
342	`do j=1,ntim_out`	342	`do j=1,ntim_out`
343	`do k=1,ncol_out`	343	`do k=1,ncol_out`
344	`tra_out(i,j,k) = tra_inp(ind(i),j,k)`	344	`tra_out(i,j,k) = tra_inp(ind(i),j,k)`
345	`enddo`	345	`enddo`
346	`enddo`	346	`enddo`
347	`enddo`	347	`enddo`
348		348
349	`c Copy meta information`	349	`c Copy meta information`
350	`do i=1,ncol_out`	350	`do i=1,ncol_out`
351	`vars_out(i) = vars_inp(i)`	351	`vars_out(i) = vars_inp(i)`
352	`enddo`	352	`enddo`
353		353
354	`120 continue`	354	`120 continue`
355		355
356	`c ----------------------------------------------------------------------`	356	`c ----------------------------------------------------------------------`
357	`c Option -startf : Extract starting positions for the trajectory file`	357	`c Option -startf : Extract starting positions for the trajectory file`
358	`c ----------------------------------------------------------------------`	358	`c ----------------------------------------------------------------------`
359		359
360	`if ( mode.ne.'-startf' ) goto 130`	360	`if ( mode.ne.'-startf' ) goto 130`
361		361
362	`c Set the first for columns of the output`	362	`c Set the first for columns of the output`
363	`ncol_out = 4`	363	`ncol_out = 4`
364	`vars_out(1)='time'`	364	`vars_out(1)='time'`
365	`vars_out(2)='lon'`	365	`vars_out(2)='lon'`
366	`vars_out(3)='lat'`	366	`vars_out(3)='lat'`
367	`vars_out(4)='p'`	367	`vars_out(4)='p'`
368	`ind(1) =1`	368	`ind(1) =1`
369	`ind(2) =2`	369	`ind(2) =2`
370	`ind(3) =3`	370	`ind(3) =3`
371	`ind(4) =4`	371	`ind(4) =4`
372		372
373	`c Set dimensions of output trajectory`	373	`c Set dimensions of output trajectory`
374	`ntim_out = 1`	374	`ntim_out = 1`
375	`ntra_out = ntra_inp`	375	`ntra_out = ntra_inp`
376		376
377	`c Allocate memory for output trajectory`	377	`c Allocate memory for output trajectory`
378	`allocate(tra_out(ntra_out,ntim_out,ncol_out),stat=stat)`	378	`allocate(tra_out(ntra_out,ntim_out,ncol_out),stat=stat)`
379	`if (stat.ne.0) print,' error allocating array tra_out *'`	379	`if (stat.ne.0) print,' error allocating array tra_out *'`
380		380
381	`c Copy the selected times to the output trajectory`	381	`c Copy the selected times to the output trajectory`
382	`do i=1,ntra_out`	382	`do i=1,ntra_out`
383	`do k=1,ncol_out`	383	`do k=1,ncol_out`
384	`tra_out(i,1,k) = tra_inp(i,1,k)`	384	`tra_out(i,1,k) = tra_inp(i,1,k)`
385	`enddo`	385	`enddo`
386	`enddo`	386	`enddo`
387		387
388	`c Copy meta information`	388	`c Copy meta information`
389	`do i=1,ncol_out`	389	`do i=1,ncol_out`
390	`vars_out(i) = vars_inp(i)`	390	`vars_out(i) = vars_inp(i)`
391	`enddo`	391	`enddo`
392		392
393	`130 continue`	393	`130 continue`
394		394
395	`c ----------------------------------------------------------------------`	395	`c ----------------------------------------------------------------------`
396	`c Option -index : Extract trajectories by index file`	396	`c Option -index : Extract trajectories by index file`
397	`c ----------------------------------------------------------------------`	397	`c ----------------------------------------------------------------------`
398		398
399	`if ( mode.ne.'-index' ) goto 140`	399	`if ( mode.ne.'-index' ) goto 140`
400		400
401	`c Read the index file`	401	`c Read the index file`
402	`open(10,file=str)`	402	`open(10,file=str)`
403		403
404	`ntra_out = 1`	404	`ntra_out = 1`
405	`142 read(10,*,end=141) ind(ntra_out)`	405	`142 read(10,*,end=141) ind(ntra_out)`
406	`ntra_out = ntra_out + 1`	406	`ntra_out = ntra_out + 1`
407	`goto 142`	407	`goto 142`
408	`141 continue`	408	`141 continue`
409	`ntra_out = ntra_out - 1`	409	`ntra_out = ntra_out - 1`
410		410
411	`close(10)`	411	`close(10)`
412		412
413	`c Check whether selected trajectories are ok`	413	`c Check whether selected trajectories are ok`
414	`do i=1,ntra_out`	414	`do i=1,ntra_out`
415	`if ( (ind(i).lt.1).or.(ind(i).gt.ntra_inp) ) then`	415	`if ( (ind(i).lt.1).or.(ind(i).gt.ntra_inp) ) then`
416	`print*,'Invalid trajectory selected ',ind(i)`	416	`print*,'Invalid trajectory selected ',ind(i)`
417	`stop`	417	`stop`
418	`endif`	418	`endif`
419	`enddo`	419	`enddo`
420		420
421	`c Set dimensions of output trajectory`	421	`c Set dimensions of output trajectory`
422	`ntim_out = ntim_inp`	422	`ntim_out = ntim_inp`
423	`ncol_out = ncol_inp`	423	`ncol_out = ncol_inp`
424		424
425	`c Allocate memory for output trajectory`	425	`c Allocate memory for output trajectory`
426	`allocate(tra_out(ntra_out,ntim_out,ncol_out),stat=stat)`	426	`allocate(tra_out(ntra_out,ntim_out,ncol_out),stat=stat)`
427	`if (stat.ne.0) print,' error allocating array tra_out *'`	427	`if (stat.ne.0) print,' error allocating array tra_out *'`
428		428
429	`c Copy the selected times to the output trajectory`	429	`c Copy the selected times to the output trajectory`
430	`do i=1,ntra_out`	430	`do i=1,ntra_out`
431	`do j=1,ntim_out`	431	`do j=1,ntim_out`
432	`do k=1,ncol_out`	432	`do k=1,ncol_out`
433	`tra_out(i,j,k) = tra_inp(ind(i),j,k)`	433	`tra_out(i,j,k) = tra_inp(ind(i),j,k)`
434	`enddo`	434	`enddo`
435	`enddo`	435	`enddo`
436	`enddo`	436	`enddo`
437		437
438	`c Copy meta information`	438	`c Copy meta information`
439	`do i=1,ncol_out`	439	`do i=1,ncol_out`
440	`vars_out(i) = vars_inp(i)`	440	`vars_out(i) = vars_inp(i)`
441	`enddo`	441	`enddo`
442		442
443	`140 continue`	443	`140 continue`
444		444
445	`c ----------------------------------------------------------------------`	445	`c ----------------------------------------------------------------------`
446	`c Option -boolean : Extract trajectories by boolean file`	446	`c Option -boolean : Extract trajectories by boolean file`
447	`c ----------------------------------------------------------------------`	447	`c ----------------------------------------------------------------------`
448		448
449	`if ( mode.ne.'-boolean' ) goto 150`	449	`if ( mode.ne.'-boolean' ) goto 150`
450		450
451	`c Read the index file`	451	`c Read the index file`
452	`open(10,file=str)`	452	`open(10,file=str)`
453	`ntra_out = 0`	453	`ntra_out = 0`
454	`do i=1,ntra_inp`	454	`do i=1,ntra_inp`
455	`read(10,*) ind1`	455	`read(10,*) ind1`
456	`if ( ind1.eq.1 ) then`	456	`if ( ind1.eq.1 ) then`
457	`ntra_out = ntra_out + 1`	457	`ntra_out = ntra_out + 1`
458	`ind(ntra_out) = i`	458	`ind(ntra_out) = i`
459	`endif`	459	`endif`
460	`enddo`	460	`enddo`
461	`close(10)`	461	`close(10)`
462		462
463	`c Check whether selected trajectories are ok`	463	`c Check whether selected trajectories are ok`
464	`do i=1,ntra_out`	464	`do i=1,ntra_out`
465	`if ( (ind(i).lt.1).or.(ind(i).gt.ntra_inp) ) then`	465	`if ( (ind(i).lt.1).or.(ind(i).gt.ntra_inp) ) then`
466	`print*,'Invalid trajectory selected ',ind(i)`	466	`print*,'Invalid trajectory selected ',ind(i)`
467	`stop`	467	`stop`
468	`endif`	468	`endif`
469	`enddo`	469	`enddo`
470		470
471	`c Set dimensions of output trajectory`	471	`c Set dimensions of output trajectory`
472	`ntim_out = ntim_inp`	472	`ntim_out = ntim_inp`
473	`ncol_out = ncol_inp`	473	`ncol_out = ncol_inp`
474		474
475	`c Allocate memory for output trajectory`	475	`c Allocate memory for output trajectory`
476	`allocate(tra_out(ntra_out,ntim_out,ncol_out),stat=stat)`	476	`allocate(tra_out(ntra_out,ntim_out,ncol_out),stat=stat)`
477	`if (stat.ne.0) print,' error allocating array tra_out *'`	477	`if (stat.ne.0) print,' error allocating array tra_out *'`
478		478
479	`c Copy the selected times to the output trajectory`	479	`c Copy the selected times to the output trajectory`
480	`do i=1,ntra_out`	480	`do i=1,ntra_out`
481	`do j=1,ntim_out`	481	`do j=1,ntim_out`
482	`do k=1,ncol_out`	482	`do k=1,ncol_out`
483	`tra_out(i,j,k) = tra_inp(ind(i),j,k)`	483	`tra_out(i,j,k) = tra_inp(ind(i),j,k)`
484	`enddo`	484	`enddo`
485	`enddo`	485	`enddo`
486	`enddo`	486	`enddo`
487		487
488	`c Copy meta information`	488	`c Copy meta information`
489	`do i=1,ncol_out`	489	`do i=1,ncol_out`
490	`vars_out(i) = vars_inp(i)`	490	`vars_out(i) = vars_inp(i)`
491	`enddo`	491	`enddo`
492		492
493	`150 continue`	493	`150 continue`
494		494
495	`c ----------------------------------------------------------------------`	495	`c ----------------------------------------------------------------------`
496	`c Write output trajectories`	496	`c Write output trajectories`
497	`c ----------------------------------------------------------------------`	497	`c ----------------------------------------------------------------------`
498		498
499	`c Write output as trajectory file`	499	`c Write output as trajectory file`
500	`if (outmode.ge.1) then`	500	`if (outmode.ge.1) then`

Subversion Repositories lagranto.um

(root)/tags/2.1/goodies/extract.f – Rev 3 → 12