| 3 |
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 |
|