Subversion Repositories lagranto.ecmwf

Rev

Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
5 michaesp 1
      program crecst
2
 
3
c     ************************************************************************************
4
c     * Create constants file for ECMWF data files                                       *
5
c     * Michael Sprenger / Autumn 2013                                                   *
6
c     ************************************************************************************
7
 
8
      implicit none
9
 
10
c     ------------------------------------------------------------------------------------
11
c     Declaration of parameters
12
c     ------------------------------------------------------------------------------------
13
 
14
      integer        iargc
15
      character*(80) arg
16
      character*80   cstname
17
      integer        stdate(5),datar(14)
18
      integer        nx,ny,nz
19
      real           xmin,ymin,xmax,ymax,dx,dy,pollon,pollat
20
      character*80   akbkfile
21
      real           aklay(1000),bklay(1000),aklay_t(1000),bklay_t(1000)
22
      real           aklev(1000),bklev(1000),aklev_t(1000),bklev_t(1000)
23
      integer        i
24
      character*11   datestr
25
      integer        ilev
26
 
27
c     ------------------------------------------------------------------------------------
28
c     Get arguments and list of akbk
29
c     ------------------------------------------------------------------------------------
30
 
31
c     check for sufficient requested arguments
32
      if (iargc().lt.14) then
33
        print*,'USAGE: crecst cstname xmin xmax ymin ymax ...'
34
        print*,'       ...nx ny nz dx dy pollon pollat stdate akbkfile '
35
        call exit(1)
36
      endif
37
 
38
c     read and transform input
39
      call getarg(1,arg)
40
      cstname=trim(arg)
41
 
42
      call getarg(2,arg)
43
      read(arg,*) xmin
44
 
45
      call getarg(3,arg)
46
      read(arg,*) xmax
47
 
48
      call getarg(4,arg)
49
      read(arg,*) ymin
50
 
51
      call getarg(5,arg)
52
      read(arg,*) ymax
53
 
54
      call getarg(6,arg)
55
      read(arg,*) nx
56
 
57
      call getarg(7,arg)
58
      read(arg,*) ny
59
 
60
      call getarg(8,arg)
61
      read(arg,*) nz
62
 
63
      call getarg(9,arg)
64
      read(arg,*) dx
65
 
66
      call getarg(10,arg)
67
      read(arg,*) dy
68
 
69
      call getarg(11,arg)
70
      read(arg,*) pollon
71
 
72
      call getarg(12,arg)
73
      read(arg,*) pollat
74
 
75
      call getarg(13,arg)
76
      read(arg,*) datestr
77
 
78
      call getarg(14,arg)
79
      read(arg,*) akbkfile
80
 
81
c     Read table from akbk file
82
      open(10,file=akbkfile)
83
       do i=1,nz
84
          read(10,*) ilev,aklev_t(i),bklev_t(i)
85
       enddo
86
      close(10)
87
 
88
c     ------------------------------------------------------------------------------------
89
c     Prepare fields and write constants file
90
c     ------------------------------------------------------------------------------------
91
 
92
c     Set grid parameters
93
      datar(1)=nx
94
      datar(2)=ny
95
      datar(3)=int(1000.*ymax)
96
      datar(4)=int(1000.*xmin)
97
      datar(5)=int(1000.*ymin)
98
      datar(6)=int(1000.*xmax)
99
      datar(7)=int(1000.*dx)
100
      datar(8)=int(1000.*dy)
101
      datar(9)=nz
102
      datar(10)=1
103
      datar(11)=1
104
      datar(12)=0
105
      datar(13)=int(1000.*pollon) 
106
      datar(14)=int(1000.*pollat) 
107
 
108
c     Define aklev, bklev
109
      do i=1,nz
110
         aklev(i)=0.01 * aklev_t(nz-i+1)
111
         bklev(i)=bklev_t(nz-i+1)
112
      enddo
113
 
114
c     Define aklay, bklay
115
      do i=1,nz-1
116
         aklay(i+1) = 0.5*(aklev(i)+aklev(i+1))
117
         bklay(i+1) = 0.5*(bklev(i)+bklev(i+1))
118
      enddo
119
      aklay(1)=0.5*(0. + aklev(1))
120
      bklay(1)=0.5*(1. + bklev(1))
121
 
122
c     Set starting date
123
      read(datestr(1:4),  *) stdate(1)
124
      read(datestr(5:6),  *) stdate(2)
125
      read(datestr(7:8),  *) stdate(3) 
126
      read(datestr(10:11),*) stdate(4)
127
      stdate(5) = 0
128
 
129
C     Write the constants files
130
      call wricst(cstname,datar,aklev,bklev,aklay,bklay,stdate)
131
      write(*,*)
132
      write(*,*)'*** cst-file ',trim(cstname),' created'
133
 
134
      end
135
 
136
 
137