Subversion Repositories lagranto.arpege

Rev

Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
3 michaesp 1
      PROGRAM reformat
2
 
3
c     ***********************************************************************
4
c     * Change format of a trajectory file                                  *
5
c     * Michael Sprenger / Spring, summer 2010                              *
6
c     ***********************************************************************
7
 
8
      implicit none
9
 
10
c     ----------------------------------------------------------------------
11
c     Declaration of variables
12
c     ----------------------------------------------------------------------
13
 
14
c     Mode
15
      character*80                           mode
16
 
17
c     Input and output files
18
      character*80                           inpfile     ! Input filename
19
      character*80                           outfile     ! Output filename
20
 
21
c     Trajectories
22
      integer                                ntra        ! Number of trajectories
23
      integer                                ntim        ! Number of times
24
      integer                                ncol        ! Number of columns
25
      real,allocatable, dimension (:,:,:) :: tra         ! Trajectories (ntra,ntim,ncol)
26
      character*80                           vars(100)   ! Variable names
27
      integer                                refdate(6)  ! Reference date
28
      real,allocatable, dimension (:)     :: num         ! Output number
29
 
30
c     Auxiliary variables
31
      integer                                inpmode
32
      integer                                stat
33
      integer                                fid
34
      integer                                i,j,k
35
      real                                   dist
36
      real                                   lon0,lat0,lon1,lat1
37
 
38
c     Externals
39
      real                                   sdis
40
      external                               sdis
41
 
42
c     ----------------------------------------------------------------------
43
c     Preparations
44
c     ----------------------------------------------------------------------
45
 
46
c     Read parameters
47
      open(10,file='traj2num.param')
48
       read(10,*) inpfile
49
       read(10,*) outfile
50
       read(10,*) ntra,ntim,ncol
51
       read(10,*) mode
52
      close(10)
53
 
54
c     Check that a valid mode is selected
55
      if ( mode.eq.'boost' ) goto 10
56
      print*,' Unknown mode ',trim(mode)
57
      stop
58
 10   continue
59
 
60
c     Determine the formats
61
      call mode_tra(inpmode,inpfile)
62
      if (inpmode.eq.-1) inpmode=1
63
 
64
c     Allocate memory
65
      allocate(tra(ntra,ntim,ncol),stat=stat)
66
      if (stat.ne.0) print*,'*** error allocating array tra      ***' 
67
      allocate(num(ntra),stat=stat)
68
      if (stat.ne.0) print*,'*** error allocating array num      ***'
69
 
70
c     Read inpufile
71
      call ropen_tra(fid,inpfile,ntra,ntim,ncol,refdate,vars,inpmode)
72
      call read_tra (fid,tra,ntra,ntim,ncol,inpmode)
73
      call close_tra(fid,inpmode)
74
 
75
c     ----------------------------------------------------------------------
76
c     Mode = 'boost': get the maximum distance traveled in one time step
77
c     ----------------------------------------------------------------------
78
 
79
      if ( mode.ne.'boost') goto 100
80
 
81
      do i=1,ntra
82
 
83
        num(i) = 0.
84
 
85
        do j=2,ntim
86
 
87
c          Get spherical distance between data points
88
           lon0 = tra(i,j-1,2)
89
           lat0 = tra(i,j-1,3)
90
           lon1 = tra(i,j  ,2)
91
           lat1 = tra(i,j  ,3)
92
           dist = sdis( lon1,lat1,lon0,lat0 )
93
 
94
           if ( dist.gt.num(i) ) num(i) = dist
95
 
96
        enddo
97
 
98
      enddo
99
 
100
 100  continue
101
 
102
c     ----------------------------------------------------------------------
103
c     Write output file
104
c     ----------------------------------------------------------------------
105
 
106
      open(10,file=outfile)
107
        do i=1,ntra
108
            write(10,*) num(i)
109
        enddo
110
      close(10)
111
 
112
      end
113
 
114
c     ***********************************************************************
115
c     * SUBROUTINES                                                         *
116
c     ***********************************************************************
117
 
118
c     -----------------------------------------------------------------------
119
c     Spherical distance between lat/lon points
120
c     -----------------------------------------------------------------------
121
 
122
      real function sdis(xp,yp,xq,yq)
123
c
124
c     calculates spherical distance (in km) between two points given
125
c     by their spherical coordinates (xp,yp) and (xq,yq), respectively.
126
c
127
      real      re
128
      parameter (re=6370.)
129
      real      pi180
130
      parameter (pi180=3.14159/180.)
131
      real      xp,yp,xq,yq,arg
132
 
133
      arg=sin(pi180*yp)*sin(pi180*yq)+
134
     >    cos(pi180*yp)*cos(pi180*yq)*cos(pi180*(xp-xq))
135
      if (arg.lt.-1.) arg=-1.
136
      if (arg.gt.1.) arg=1.
137
 
138
      sdis=re*acos(arg)
139
 
140
      end
141
 
142
 
143