WebSVN – lagranto.ecmwf – Diff – /trunk/goodies/trainfo.f


      PROGRAM trainfo
      
c     ***********************************************************************
c     * Get infos for a trajectory file                                     *
c     * Michael Sprenger / Spring, summer 2010                              *
c     ***********************************************************************
 
      implicit none
      
c     ----------------------------------------------------------------------
c     Declaration of variables
c     ----------------------------------------------------------------------
 
c     Input file
      character*80                           inpfile     ! Input filename
      character*80                           mode        ! Mode
 
c     Trajectories
      integer                                ntra        ! Number of trajectories
      integer                                ntim        ! Number of times
      integer                                ncol        ! Number of columns
      character*80                           vars(100)   ! Variable names
      integer                                refdate(6)  ! Reference date
      real,allocatable, dimension (:,:,:) :: tra         ! Trajectories (ntra,ntim,ncol)
 
c     Auxiliary variables
      integer                                inpmode
      integer                                stat
      integer                                fid
      integer                                i,j,n
      integer                                old(5)
      integer                                new(5)
      integer                                hour,min
      character*20                           datestr
      character*120                          str
      character*4                            str1
      character*2                            str2,str3,str4,str5,str6
      integer                                isok
      integer                                nleaving
 
c     ----------------------------------------------------------------------
c     Do the reformating
c     ----------------------------------------------------------------------
 
c     Read parameters
      open(10,file='trainfo.param')
       read(10,*) inpfile
       read(10,*) mode
      close(10)
      
c     Determine the formats
      call mode_tra(inpmode,inpfile)
      if (inpmode.eq.-1) inpmode=1
 
c     Get the dimension of the trajectory file
      call info_tra(inpfile,ntra,ntim,ncol,inpmode)
 
c     Get haeder information
      call ropen_tra(fid,inpfile,ntra,ntim,ncol,refdate,vars,inpmode)
      call close_tra(fid,inpmode)
 
c     Write dimensions
      if ( (mode.eq.'dim').or.(mode.eq.'all') ) then
         print*,ntra,ntim,ncol
      endif
 
c     Write single dimensions
      if ( (mode.eq.'ntra').or.(mode.eq.'all') ) then
         print*,ntra
      endif
      if ( (mode.eq.'ntim').or.(mode.eq.'all') ) then
         print*,ntim
      endif
      if ( (mode.eq.'ncol').or.(mode.eq.'all') ) then
         print*,ncol
      endif
 
c     Write variable names
      if ( (mode.eq.'vars').or.(mode.eq.'all') ) then
         print*,(trim(vars(i))//' ',i=1,ncol)         
      endif
 
c     Write reference date 
      if ( (mode.eq.'refdate').or.(mode.eq.'all') ) then
         
c        Concatenate date string
         min = refdate(5)         
         call datestring(datestr,
     >             refdate(1),refdate(2),refdate(3),refdate(4) )
         if ( min.eq.0 ) then
            datestr = trim(datestr)//'00'
         elseif (min.lt.10) then
            datestr = trim(datestr)//'0'//char(ichar('0')+min)
         else
            datestr = trim(datestr)//
     >                char(ichar('0')+int(min/10))//
     >                char(ichar('0')+mod(min,10))
         endif
                    
c        Write date string
         print*,trim(datestr)
 
      endif
 
c     Load all trajectory times if necessary
      if ( (mode.eq.'all'      ).or.
     >     (mode.eq.'times'    ).or.
     >     (mode.eq.'startdate').or.
     >     (mode.eq.'enddate'  ) )
     >then
         allocate(tra(ntra,ntim,ncol),stat=stat)
         call ropen_tra(fid,inpfile,ntra,ntim,ncol,refdate,vars,inpmode)
         call read_tra (fid,tra,ntra,ntim,ncol,inpmode)
         call close_tra(fid,inpmode)
      endif
 
c     Write list of all times
      if ( (mode.eq.'times').or.(mode.eq.'all') ) then
         write(*,'(100f8.2)') (tra(1,i,1),i=1,ntim)
      endif
 
c     Write time range
      if ( (mode.eq.'timerange').or.(mode.eq.'all') ) then
         write(*,'(i6)') refdate(6)
      endif
      
c     Write firstdate (reference date + first time)
      if ( (mode.eq.'startdate').or.(mode.eq.'all') ) then
         
c        Set the time shift of first time relative to reference date
         hour = int(tra(1,1,1))
         min  = mod(nint(100.*tra(1,1,1)),100) + refdate(5)
         if (min.gt.60) then
            min  = min - 60
            hour = hour + 1
         endif
         if (min.lt.0) then
            min  = min + 60
            hour = hour - 1
         endif
         if (min.lt.0) then
            min  = min + 60
            hour = hour - 1
         endif
 
c        Get new date (hours and minutes)
         old(1) = refdate(1)
         old(2) = refdate(2)
         old(3) = refdate(3)
         old(4) = refdate(4)
         old(5) = 0
         call newdate(old,real(hour),new)
 
c        Concatenate the date string
         call datestring(datestr,
     >             new(1),new(2),new(3),new(4) )
         if ( min.eq.0 ) then
            datestr = trim(datestr)//'00'
         elseif (min.lt.10) then
            datestr = trim(datestr)//'0'//char(ichar('0')+min)
         else
            datestr = trim(datestr)//
     >                char(ichar('0')+int(min/10))//
     >                char(ichar('0')+mod(min,10))
         endif
                    
c        Write date string
         print*,trim(datestr)
 
      endif
 
c     Write enddate (reference date + last time)
      if ( (mode.eq.'enddate').or.(mode.eq.'all') ) then
         
c        Set the time shift of first time relative to reference date
         hour = int(tra(1,ntim,1))
         min  = mod(nint(100.*tra(1,ntim,1)),100) + refdate(5)
         if (min.gt.60) then
            min  = min - 60
            hour = hour + 1
         endif
         if (min.lt.0) then
            min  = min + 60
            hour = hour - 1
         endif
         if (min.lt.0) then
            min  = min + 60
            hour = hour - 1
         endif
 
c        Get new date (hours and minutes)
         old(1) = refdate(1)
         old(2) = refdate(2)
         old(3) = refdate(3)
         old(4) = refdate(4)
         old(5) = 0
         call newdate(old,real(hour),new)
 
c        Concatenate the date string
         call datestring(datestr,
     >             new(1),new(2),new(3),new(4) )
         if ( min.eq.0 ) then
            datestr = trim(datestr)//'00'
         elseif (min.lt.10) then
            datestr = trim(datestr)//'0'//char(ichar('0')+min)
         else
            datestr = trim(datestr)//
     >                char(ichar('0')+int(min/10))//
     >                char(ichar('0')+mod(min,10))
         endif
                    
c        Write date string
         print*,trim(datestr)
 
      endif
 
c     Write trajectories to screen
      if ( (mode.eq.'list') ) then
 
c        Read the complete trajectory file
         allocate(tra(ntra,ntim,ncol),stat=stat)
         call ropen_tra(fid,inpfile,ntra,ntim,ncol,refdate,vars,inpmode)
         call read_tra (fid,tra,ntra,ntim,ncol,inpmode)
         call close_tra(fid,inpmode)
 
c        Get the strings for output
         write(str1,'(i4)') refdate(1)
         write(str2,'(i2)') refdate(2)
         write(str3,'(i2)') refdate(3)
         write(str4,'(i2)') refdate(4)
         write(str5,'(i2)') refdate(5)
         if (refdate(2).eq. 0) str2(1:1)='0'
         if (refdate(3).eq. 0) str3(1:1)='0'
         if (refdate(4).eq. 0) str4(1:1)='0'
         if (refdate(5).eq. 0) str5(1:1)='0'
         if (refdate(2).lt.10) str2(1:1)='0'
         if (refdate(3).lt.10) str3(1:1)='0'
         if (refdate(4).lt.10) str4(1:1)='0'
         if (refdate(5).lt.10) str5(1:1)='0'
 
c        Write the time specification
         write(*,'(a15,a4,a2,a2,a1,a2,a2,a13,i8,a4)') 
     >          'Reference date ',
     >           str1,str2,str3,'_',str4,str5,
     >          ' / Time range',refdate(6), ' min'
         write(*,*)
 
c        Write variable names
         str=''
         do i=1,ncol
            str=trim(str)//trim(vars(i))
         enddo
         write(*,'(a6,a9,a8,a6,100a10)') (trim(vars(i)),i=1,ncol)
         write(*,'(a6,a9,a8,a6,100a10)') 
     >              '------','---------','--------','------',
     >              ('----------',i=5,ncol)
 
         do n=1,ntra
            write(*,*)
            do i=1,ntim
               write(*,'(1f7.2,f9.2,f8.2,i6,100f10.3)') 
     >               (tra(n,i,j),j=1,3),             ! time, lon, lat
     >               nint(tra(n,i,4)),               ! p
     >               (tra(n,i,j),j=5,ncol)           ! fields
            enddo
         enddo
 
      endif
         
c     Get number of trajectories leaving domain
      if ( (mode.eq.'leaving') ) then
 
c        Read the complete trajectory file
         allocate(tra(ntra,ntim,ncol),stat=stat)
         call ropen_tra(fid,inpfile,ntra,ntim,ncol,refdate,vars,inpmode)
         call read_tra (fid,tra,ntra,ntim,ncol,inpmode)
         call close_tra(fid,inpmode)
 
c        Determine the number of trajectories leaving domain
         do i=1,ntra
            isok = 1
            do j=1,ntim
               if ( tra(i,j,4).lt.0. ) isok = 0
            enddo         
            if ( isok.eq.0 ) then
               nleaving = nleaving + 1
            endif
         enddo
 
c        Write output
	 print*,nleaving     
 
      endif
         
      end
 
 
      
 
      

Rev 3	Rev 5
1	`PROGRAM trainfo`	1	`PROGRAM trainfo`
2		2
3	`c ***********************************************************************`	3	`c ***********************************************************************`
4	`c * Get infos for a trajectory file *`	4	`c * Get infos for 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 variables`	11	`c Declaration of variables`
12	`c ----------------------------------------------------------------------`	12	`c ----------------------------------------------------------------------`
13		13
14	`c Input file`	14	`c Input file`
15	`character*80 inpfile ! Input filename`	15	`character*80 inpfile ! Input filename`
16	`character*80 mode ! Mode`	16	`character*80 mode ! Mode`
17		17
18	`c Trajectories`	18	`c Trajectories`
19	`integer ntra ! Number of trajectories`	19	`integer ntra ! Number of trajectories`
20	`integer ntim ! Number of times`	20	`integer ntim ! Number of times`
21	`integer ncol ! Number of columns`	21	`integer ncol ! Number of columns`
22	`character*80 vars(100) ! Variable names`	22	`character*80 vars(100) ! Variable names`
23	`integer refdate(6) ! Reference date`	23	`integer refdate(6) ! Reference date`
24	`real,allocatable, dimension (:,:,:) :: tra ! Trajectories (ntra,ntim,ncol)`	24	`real,allocatable, dimension (:,:,:) :: tra ! Trajectories (ntra,ntim,ncol)`
25		25
26	`c Auxiliary variables`	26	`c Auxiliary variables`
27	`integer inpmode`	27	`integer inpmode`
28	`integer stat`	28	`integer stat`
29	`integer fid`	29	`integer fid`
30	`integer i,j,n`	30	`integer i,j,n`
31	`integer old(5)`	31	`integer old(5)`
32	`integer new(5)`	32	`integer new(5)`
33	`integer hour,min`	33	`integer hour,min`
34	`character*20 datestr`	34	`character*20 datestr`
35	`character*120 str`	35	`character*120 str`
36	`character*4 str1`	36	`character*4 str1`
37	`character*2 str2,str3,str4,str5,str6`	37	`character*2 str2,str3,str4,str5,str6`
-		38	`integer isok`
-		39	`integer nleaving`
38		40
39	`c ----------------------------------------------------------------------`	41	`c ----------------------------------------------------------------------`
40	`c Do the reformating`	42	`c Do the reformating`
41	`c ----------------------------------------------------------------------`	43	`c ----------------------------------------------------------------------`
42		44
43	`c Read parameters`	45	`c Read parameters`
44	`open(10,file='trainfo.param')`	46	`open(10,file='trainfo.param')`
45	`read(10,*) inpfile`	47	`read(10,*) inpfile`
46	`read(10,*) mode`	48	`read(10,*) mode`
47	`close(10)`	49	`close(10)`
48		50
49	`c Determine the formats`	51	`c Determine the formats`
50	`call mode_tra(inpmode,inpfile)`	52	`call mode_tra(inpmode,inpfile)`
51	`if (inpmode.eq.-1) inpmode=1`	53	`if (inpmode.eq.-1) inpmode=1`
52		54
53	`c Get the dimension of the trajectory file`	55	`c Get the dimension of the trajectory file`
54	`call info_tra(inpfile,ntra,ntim,ncol,inpmode)`	56	`call info_tra(inpfile,ntra,ntim,ncol,inpmode)`
55		57
56	`c Get haeder information`	58	`c Get haeder information`
57	`call ropen_tra(fid,inpfile,ntra,ntim,ncol,refdate,vars,inpmode)`	59	`call ropen_tra(fid,inpfile,ntra,ntim,ncol,refdate,vars,inpmode)`
58	`call close_tra(fid,inpmode)`	60	`call close_tra(fid,inpmode)`
59		61
60	`c Write dimensions`	62	`c Write dimensions`
61	`if ( (mode.eq.'dim').or.(mode.eq.'all') ) then`	63	`if ( (mode.eq.'dim').or.(mode.eq.'all') ) then`
62	`print*,ntra,ntim,ncol`	64	`print*,ntra,ntim,ncol`
63	`endif`	65	`endif`
64		66
65	`c Write single dimensions`	67	`c Write single dimensions`
66	`if ( (mode.eq.'ntra').or.(mode.eq.'all') ) then`	68	`if ( (mode.eq.'ntra').or.(mode.eq.'all') ) then`
67	`print*,ntra`	69	`print*,ntra`
68	`endif`	70	`endif`
69	`if ( (mode.eq.'ntim').or.(mode.eq.'all') ) then`	71	`if ( (mode.eq.'ntim').or.(mode.eq.'all') ) then`
70	`print*,ntim`	72	`print*,ntim`
71	`endif`	73	`endif`
72	`if ( (mode.eq.'ncol').or.(mode.eq.'all') ) then`	74	`if ( (mode.eq.'ncol').or.(mode.eq.'all') ) then`
73	`print*,ncol`	75	`print*,ncol`
74	`endif`	76	`endif`
75		77
76	`c Write variable names`	78	`c Write variable names`
77	`if ( (mode.eq.'vars').or.(mode.eq.'all') ) then`	79	`if ( (mode.eq.'vars').or.(mode.eq.'all') ) then`
78	`print*,(trim(vars(i))//' ',i=1,ncol)`	80	`print*,(trim(vars(i))//' ',i=1,ncol)`
79	`endif`	81	`endif`
80		82
81	`c Write reference date`	83	`c Write reference date`
82	`if ( (mode.eq.'refdate').or.(mode.eq.'all') ) then`	84	`if ( (mode.eq.'refdate').or.(mode.eq.'all') ) then`
83		85
84	`c Concatenate date string`	86	`c Concatenate date string`
85	`min = refdate(5)`	87	`min = refdate(5)`
86	`call datestring(datestr,`	88	`call datestring(datestr,`
87	`> refdate(1),refdate(2),refdate(3),refdate(4) )`	89	`> refdate(1),refdate(2),refdate(3),refdate(4) )`
88	`if ( min.eq.0 ) then`	90	`if ( min.eq.0 ) then`
89	`datestr = trim(datestr)//'00'`	91	`datestr = trim(datestr)//'00'`
90	`elseif (min.lt.10) then`	92	`elseif (min.lt.10) then`
91	`datestr = trim(datestr)//'0'//char(ichar('0')+min)`	93	`datestr = trim(datestr)//'0'//char(ichar('0')+min)`
92	`else`	94	`else`
93	`datestr = trim(datestr)//`	95	`datestr = trim(datestr)//`
94	`> char(ichar('0')+int(min/10))//`	96	`> char(ichar('0')+int(min/10))//`
95	`> char(ichar('0')+mod(min,10))`	97	`> char(ichar('0')+mod(min,10))`
96	`endif`	98	`endif`
97		99
98	`c Write date string`	100	`c Write date string`
99	`print*,trim(datestr)`	101	`print*,trim(datestr)`
100		102
101	`endif`	103	`endif`
102		104
103	`c Load all trajectory times if necessary`	105	`c Load all trajectory times if necessary`
104	`if ( (mode.eq.'all' ).or.`	106	`if ( (mode.eq.'all' ).or.`
105	`> (mode.eq.'times' ).or.`	107	`> (mode.eq.'times' ).or.`
106	`> (mode.eq.'startdate').or.`	108	`> (mode.eq.'startdate').or.`
107	`> (mode.eq.'enddate' ) )`	109	`> (mode.eq.'enddate' ) )`
108	`>then`	110	`>then`
109	`allocate(tra(ntra,ntim,ncol),stat=stat)`	111	`allocate(tra(ntra,ntim,ncol),stat=stat)`
110	`call ropen_tra(fid,inpfile,ntra,ntim,ncol,refdate,vars,inpmode)`	112	`call ropen_tra(fid,inpfile,ntra,ntim,ncol,refdate,vars,inpmode)`
111	`call read_tra (fid,tra,ntra,ntim,ncol,inpmode)`	113	`call read_tra (fid,tra,ntra,ntim,ncol,inpmode)`
112	`call close_tra(fid,inpmode)`	114	`call close_tra(fid,inpmode)`
113	`endif`	115	`endif`
114		116
115	`c Write list of all times`	117	`c Write list of all times`
116	`if ( (mode.eq.'times').or.(mode.eq.'all') ) then`	118	`if ( (mode.eq.'times').or.(mode.eq.'all') ) then`
117	`write(*,'(100f8.2)') (tra(1,i,1),i=1,ntim)`	119	`write(*,'(100f8.2)') (tra(1,i,1),i=1,ntim)`
118	`endif`	120	`endif`
119		121
120	`c Write time range`	122	`c Write time range`
121	`if ( (mode.eq.'timerange').or.(mode.eq.'all') ) then`	123	`if ( (mode.eq.'timerange').or.(mode.eq.'all') ) then`
122	`write(*,'(i6)') refdate(6)`	124	`write(*,'(i6)') refdate(6)`
123	`endif`	125	`endif`
124		126
125	`c Write firstdate (reference date + first time)`	127	`c Write firstdate (reference date + first time)`
126	`if ( (mode.eq.'startdate').or.(mode.eq.'all') ) then`	128	`if ( (mode.eq.'startdate').or.(mode.eq.'all') ) then`
127		129
128	`c Set the time shift of first time relative to reference date`	130	`c Set the time shift of first time relative to reference date`
129	`hour = int(tra(1,1,1))`	131	`hour = int(tra(1,1,1))`
130	`min = mod(nint(100.*tra(1,1,1)),100) + refdate(5)`	132	`min = mod(nint(100.*tra(1,1,1)),100) + refdate(5)`
131	`if (min.gt.60) then`	133	`if (min.gt.60) then`
132	`min = min - 60`	134	`min = min - 60`
133	`hour = hour + 1`	135	`hour = hour + 1`
134	`endif`	136	`endif`
135	`if (min.lt.0) then`	137	`if (min.lt.0) then`
136	`min = min + 60`	138	`min = min + 60`
137	`hour = hour - 1`	139	`hour = hour - 1`
138	`endif`	140	`endif`
139	`if (min.lt.0) then`	141	`if (min.lt.0) then`
140	`min = min + 60`	142	`min = min + 60`
141	`hour = hour - 1`	143	`hour = hour - 1`
142	`endif`	144	`endif`
143		145
144	`c Get new date (hours and minutes)`	146	`c Get new date (hours and minutes)`
145	`old(1) = refdate(1)`	147	`old(1) = refdate(1)`
146	`old(2) = refdate(2)`	148	`old(2) = refdate(2)`
147	`old(3) = refdate(3)`	149	`old(3) = refdate(3)`
148	`old(4) = refdate(4)`	150	`old(4) = refdate(4)`
149	`old(5) = 0`	151	`old(5) = 0`
150	`call newdate(old,real(hour),new)`	152	`call newdate(old,real(hour),new)`
151		153
152	`c Concatenate the date string`	154	`c Concatenate the date string`
153	`call datestring(datestr,`	155	`call datestring(datestr,`
154	`> new(1),new(2),new(3),new(4) )`	156	`> new(1),new(2),new(3),new(4) )`
155	`if ( min.eq.0 ) then`	157	`if ( min.eq.0 ) then`
156	`datestr = trim(datestr)//'00'`	158	`datestr = trim(datestr)//'00'`
157	`elseif (min.lt.10) then`	159	`elseif (min.lt.10) then`
158	`datestr = trim(datestr)//'0'//char(ichar('0')+min)`	160	`datestr = trim(datestr)//'0'//char(ichar('0')+min)`
159	`else`	161	`else`
160	`datestr = trim(datestr)//`	162	`datestr = trim(datestr)//`
161	`> char(ichar('0')+int(min/10))//`	163	`> char(ichar('0')+int(min/10))//`
162	`> char(ichar('0')+mod(min,10))`	164	`> char(ichar('0')+mod(min,10))`
163	`endif`	165	`endif`
164		166
165	`c Write date string`	167	`c Write date string`
166	`print*,trim(datestr)`	168	`print*,trim(datestr)`
167		169
168	`endif`	170	`endif`
169		171
170	`c Write enddate (reference date + last time)`	172	`c Write enddate (reference date + last time)`
171	`if ( (mode.eq.'enddate').or.(mode.eq.'all') ) then`	173	`if ( (mode.eq.'enddate').or.(mode.eq.'all') ) then`
172		174
173	`c Set the time shift of first time relative to reference date`	175	`c Set the time shift of first time relative to reference date`
174	`hour = int(tra(1,ntim,1))`	176	`hour = int(tra(1,ntim,1))`
175	`min = mod(nint(100.*tra(1,ntim,1)),100) + refdate(5)`	177	`min = mod(nint(100.*tra(1,ntim,1)),100) + refdate(5)`
176	`if (min.gt.60) then`	178	`if (min.gt.60) then`
177	`min = min - 60`	179	`min = min - 60`
178	`hour = hour + 1`	180	`hour = hour + 1`
179	`endif`	181	`endif`
180	`if (min.lt.0) then`	182	`if (min.lt.0) then`
181	`min = min + 60`	183	`min = min + 60`
182	`hour = hour - 1`	184	`hour = hour - 1`
183	`endif`	185	`endif`
184	`if (min.lt.0) then`	186	`if (min.lt.0) then`
185	`min = min + 60`	187	`min = min + 60`
186	`hour = hour - 1`	188	`hour = hour - 1`
187	`endif`	189	`endif`
188		190
189	`c Get new date (hours and minutes)`	191	`c Get new date (hours and minutes)`
190	`old(1) = refdate(1)`	192	`old(1) = refdate(1)`
191	`old(2) = refdate(2)`	193	`old(2) = refdate(2)`
192	`old(3) = refdate(3)`	194	`old(3) = refdate(3)`
193	`old(4) = refdate(4)`	195	`old(4) = refdate(4)`
194	`old(5) = 0`	196	`old(5) = 0`
195	`call newdate(old,real(hour),new)`	197	`call newdate(old,real(hour),new)`
196		198
197	`c Concatenate the date string`	199	`c Concatenate the date string`
198	`call datestring(datestr,`	200	`call datestring(datestr,`
199	`> new(1),new(2),new(3),new(4) )`	201	`> new(1),new(2),new(3),new(4) )`
200	`if ( min.eq.0 ) then`	202	`if ( min.eq.0 ) then`
201	`datestr = trim(datestr)//'00'`	203	`datestr = trim(datestr)//'00'`
202	`elseif (min.lt.10) then`	204	`elseif (min.lt.10) then`
203	`datestr = trim(datestr)//'0'//char(ichar('0')+min)`	205	`datestr = trim(datestr)//'0'//char(ichar('0')+min)`
204	`else`	206	`else`
205	`datestr = trim(datestr)//`	207	`datestr = trim(datestr)//`
206	`> char(ichar('0')+int(min/10))//`	208	`> char(ichar('0')+int(min/10))//`
207	`> char(ichar('0')+mod(min,10))`	209	`> char(ichar('0')+mod(min,10))`
208	`endif`	210	`endif`
209		211
210	`c Write date string`	212	`c Write date string`
211	`print*,trim(datestr)`	213	`print*,trim(datestr)`
212		214
213	`endif`	215	`endif`
214		216
215	`c Write trajectories to screen`	217	`c Write trajectories to screen`
216	`if ( (mode.eq.'list') ) then`	218	`if ( (mode.eq.'list') ) then`
217		219
218	`c Read the complete trajectory file`	220	`c Read the complete trajectory file`
219	`allocate(tra(ntra,ntim,ncol),stat=stat)`	221	`allocate(tra(ntra,ntim,ncol),stat=stat)`
220	`call ropen_tra(fid,inpfile,ntra,ntim,ncol,refdate,vars,inpmode)`	222	`call ropen_tra(fid,inpfile,ntra,ntim,ncol,refdate,vars,inpmode)`
221	`call read_tra (fid,tra,ntra,ntim,ncol,inpmode)`	223	`call read_tra (fid,tra,ntra,ntim,ncol,inpmode)`
222	`call close_tra(fid,inpmode)`	224	`call close_tra(fid,inpmode)`
223		225
224	`c Get the strings for output`	226	`c Get the strings for output`
225	`write(str1,'(i4)') refdate(1)`	227	`write(str1,'(i4)') refdate(1)`
226	`write(str2,'(i2)') refdate(2)`	228	`write(str2,'(i2)') refdate(2)`
227	`write(str3,'(i2)') refdate(3)`	229	`write(str3,'(i2)') refdate(3)`
228	`write(str4,'(i2)') refdate(4)`	230	`write(str4,'(i2)') refdate(4)`
229	`write(str5,'(i2)') refdate(5)`	231	`write(str5,'(i2)') refdate(5)`
230	`if (refdate(2).eq. 0) str2(1:1)='0'`	232	`if (refdate(2).eq. 0) str2(1:1)='0'`
231	`if (refdate(3).eq. 0) str3(1:1)='0'`	233	`if (refdate(3).eq. 0) str3(1:1)='0'`
232	`if (refdate(4).eq. 0) str4(1:1)='0'`	234	`if (refdate(4).eq. 0) str4(1:1)='0'`
233	`if (refdate(5).eq. 0) str5(1:1)='0'`	235	`if (refdate(5).eq. 0) str5(1:1)='0'`
234	`if (refdate(2).lt.10) str2(1:1)='0'`	236	`if (refdate(2).lt.10) str2(1:1)='0'`
235	`if (refdate(3).lt.10) str3(1:1)='0'`	237	`if (refdate(3).lt.10) str3(1:1)='0'`
236	`if (refdate(4).lt.10) str4(1:1)='0'`	238	`if (refdate(4).lt.10) str4(1:1)='0'`
237	`if (refdate(5).lt.10) str5(1:1)='0'`	239	`if (refdate(5).lt.10) str5(1:1)='0'`
238		240
239	`c Write the time specification`	241	`c Write the time specification`
240	`write(*,'(a15,a4,a2,a2,a1,a2,a2,a13,i8,a4)')`	242	`write(*,'(a15,a4,a2,a2,a1,a2,a2,a13,i8,a4)')`
241	`> 'Reference date ',`	243	`> 'Reference date ',`
242	`> str1,str2,str3,'_',str4,str5,`	244	`> str1,str2,str3,'_',str4,str5,`
243	`> ' / Time range',refdate(6), ' min'`	245	`> ' / Time range',refdate(6), ' min'`
244	`write(,)`	246	`write(,)`
245		247
246	`c Write variable names`	248	`c Write variable names`
247	`str=''`	249	`str=''`
248	`do i=1,ncol`	250	`do i=1,ncol`
249	`str=trim(str)//trim(vars(i))`	251	`str=trim(str)//trim(vars(i))`
250	`enddo`	252	`enddo`
251	`write(*,'(a6,a9,a8,a6,100a10)') (trim(vars(i)),i=1,ncol)`	253	`write(*,'(a6,a9,a8,a6,100a10)') (trim(vars(i)),i=1,ncol)`
252	`write(*,'(a6,a9,a8,a6,100a10)')`	254	`write(*,'(a6,a9,a8,a6,100a10)')`
253	`> '------','---------','--------','------',`	255	`> '------','---------','--------','------',`
254	`> ('----------',i=5,ncol)`	256	`> ('----------',i=5,ncol)`
255		257
256	`do n=1,ntra`	258	`do n=1,ntra`
257	`write(,)`	259	`write(,)`
258	`do i=1,ntim`	260	`do i=1,ntim`
259	`write(*,'(1f7.2,f9.2,f8.2,i6,100f10.3)')`	261	`write(*,'(1f7.2,f9.2,f8.2,i6,100f10.3)')`
260	`> (tra(n,i,j),j=1,3), ! time, lon, lat`	262	`> (tra(n,i,j),j=1,3), ! time, lon, lat`
261	`> nint(tra(n,i,4)), ! p`	263	`> nint(tra(n,i,4)), ! p`
262	`> (tra(n,i,j),j=5,ncol) ! fields`	264	`> (tra(n,i,j),j=5,ncol) ! fields`
263	`enddo`	265	`enddo`
264	`enddo`	266	`enddo`
265		267
266	`endif`	268	`endif`
267		269
-		270	`c Get number of trajectories leaving domain`
-		271	`if ( (mode.eq.'leaving') ) then`
268		272
-		273	`c Read the complete trajectory file`
-		274	`allocate(tra(ntra,ntim,ncol),stat=stat)`
-		275	`call ropen_tra(fid,inpfile,ntra,ntim,ncol,refdate,vars,inpmode)`
-		276	`call read_tra (fid,tra,ntra,ntim,ncol,inpmode)`
-		277	`call close_tra(fid,inpmode)`
-		278
-		279	`c Determine the number of trajectories leaving domain`
-		280	`do i=1,ntra`
-		281	`isok = 1`
-		282	`do j=1,ntim`
-		283	`if ( tra(i,j,4).lt.0. ) isok = 0`
-		284	`enddo`
-		285	`if ( isok.eq.0 ) then`
-		286	`nleaving = nleaving + 1`
-		287	`endif`
-		288	`enddo`
-		289
-		290	`c Write output`
-		291	`print*,nleaving`
-		292
-		293	`endif`
-		294
269	`end`	295	`end`
270		296
271		297
272		298
273		299
274		300

Subversion Repositories lagranto.ecmwf

(root)/trunk/goodies/trainfo.f – Rev 3 → 5