| 3 |
michaesp |
1 |
PROGRAM Cutnetcdf
|
|
|
2 |
|
|
|
3 |
c -----------------------------------------------------------------------
|
|
|
4 |
c Cut and split an input netcdf
|
|
|
5 |
c Michael Sprenger / Summer 2006
|
|
|
6 |
c -----------------------------------------------------------------------
|
|
|
7 |
|
|
|
8 |
implicit none
|
|
|
9 |
|
|
|
10 |
c -----------------------------------------------------------------------
|
|
|
11 |
c Declaration of variables
|
|
|
12 |
c -----------------------------------------------------------------------
|
|
|
13 |
|
|
|
14 |
c Maximum domain size
|
|
|
15 |
integer nxmax,nymax,nzmax,ntmax
|
|
|
16 |
parameter (nxmax=400,nymax=400,nzmax=400,ntmax=5)
|
|
|
17 |
|
|
|
18 |
c Variables for input and output netcdf file
|
|
|
19 |
integer cdfid
|
|
|
20 |
real phymin(4),phymax(4),stag(4), misdat
|
|
|
21 |
integer ndim, vardim(4), error, nlev
|
|
|
22 |
integer cstid
|
|
|
23 |
real dx, dy
|
|
|
24 |
real aklev(nzmax),bklev(nzmax),aklay(nzmax),bklay(nzmax)
|
|
|
25 |
real pollon, pollat
|
|
|
26 |
integer stdate(5)
|
|
|
27 |
integer ncdfid
|
|
|
28 |
integer datar(14)
|
|
|
29 |
character*80 cfn
|
|
|
30 |
real varold(nxmax*nymax*nzmax)
|
|
|
31 |
real time(ntmax)
|
|
|
32 |
|
|
|
33 |
c Parameters
|
|
|
34 |
character*80 oldfile(400),newfile(400)
|
|
|
35 |
character*80 oldname(400),newname(400)
|
|
|
36 |
integer novars
|
|
|
37 |
|
|
|
38 |
c Auxiliary variables
|
|
|
39 |
integer i,j,k,l,t,ntimes
|
|
|
40 |
integer imin, imax, jmin, jmax, tmin, tmax
|
|
|
41 |
integer nx,ny,nz
|
|
|
42 |
integer crename(400),crefile(400)
|
|
|
43 |
integer isnew
|
|
|
44 |
character*80 varname
|
|
|
45 |
|
|
|
46 |
c -----------------------------------------------------------------------
|
|
|
47 |
c Preparations
|
|
|
48 |
c -----------------------------------------------------------------------
|
|
|
49 |
|
|
|
50 |
print*,'*********************************************************'
|
|
|
51 |
print*,'* cutnetcdf *'
|
|
|
52 |
print*,'*********************************************************'
|
|
|
53 |
|
|
|
54 |
c Read entries from argument file
|
|
|
55 |
open(10,file='fort.10')
|
|
|
56 |
novars=1
|
|
|
57 |
100 read(10,*,end=110) oldname(novars),newname(novars),
|
|
|
58 |
> oldfile(novars),newfile(novars)
|
|
|
59 |
novars=novars+1
|
|
|
60 |
goto 100
|
|
|
61 |
110 close(10)
|
|
|
62 |
novars=novars-1
|
|
|
63 |
|
|
|
64 |
c Init the flags for creating files and variables
|
|
|
65 |
do i=1,novars
|
|
|
66 |
crename(i)=0
|
|
|
67 |
crefile(i)=0
|
|
|
68 |
enddo
|
|
|
69 |
|
|
|
70 |
c -----------------------------------------------------------------------
|
|
|
71 |
c Loop through data points
|
|
|
72 |
c -----------------------------------------------------------------------
|
|
|
73 |
|
|
|
74 |
do t=1,novars
|
|
|
75 |
|
|
|
76 |
c Write info
|
|
|
77 |
write(*,'(a10,a5,3x,a5,3x,a15,3x,a15)')
|
|
|
78 |
> ' Split ',trim(oldname(t)),
|
|
|
79 |
> trim(newname(t)),
|
|
|
80 |
> trim(oldfile(t)),
|
|
|
81 |
> trim(newfile(t))
|
|
|
82 |
|
|
|
83 |
c Open input file and read some parametersq
|
|
|
84 |
call cdfopn(oldfile(t),cdfid,error)
|
|
|
85 |
if (error.ne.0) goto 997
|
|
|
86 |
call getcfn(cdfid,cfn,error)
|
|
|
87 |
if (error.ne.0) goto 997
|
|
|
88 |
call cdfopn(cfn,cstid,error)
|
|
|
89 |
if (error.ne.0) goto 997
|
|
|
90 |
call gettimes(cdfid, time, ntimes, error)
|
|
|
91 |
if (error.ne.0) goto 997
|
|
|
92 |
call getgrid(cstid, dx, dy, error)
|
|
|
93 |
if (error.ne.0) goto 997
|
|
|
94 |
call getlevs(cstid, nlev, aklev, bklev, aklay, bklay, error)
|
|
|
95 |
if (error.ne.0) goto 997
|
|
|
96 |
call getpole(cstid,pollon,pollat,error)
|
|
|
97 |
if (error.ne.0) goto 997
|
|
|
98 |
call getstart(cstid,stdate,error)
|
|
|
99 |
if (error.ne.0) goto 997
|
|
|
100 |
|
|
|
101 |
c Set new grid parameters and read data of subdomain
|
|
|
102 |
call getdef(cdfid,oldname(t),ndim,misdat,
|
|
|
103 |
> vardim,phymin,phymax,stag,error)
|
|
|
104 |
if (error.ne.0) goto 997
|
|
|
105 |
nx=vardim(1)
|
|
|
106 |
ny=vardim(2)
|
|
|
107 |
nz=vardim(3)
|
|
|
108 |
|
|
|
109 |
c Load data
|
|
|
110 |
varname=oldname(t)
|
|
|
111 |
call getdat(cdfid,varname,time(1),0,varold,error)
|
|
|
112 |
if (error.ne.0) goto 997
|
|
|
113 |
|
|
|
114 |
c Create file if necessary (otherwise open it for writing)
|
|
|
115 |
isnew=1
|
|
|
116 |
do k=1,novars
|
|
|
117 |
if ((crefile(k).eq.1).and.
|
|
|
118 |
> (newfile(t).eq.newfile(k))) then
|
|
|
119 |
isnew=0
|
|
|
120 |
endif
|
|
|
121 |
enddo
|
|
|
122 |
if (isnew.eq.1) then
|
|
|
123 |
cfn=trim(newfile(t))//'_cst'
|
|
|
124 |
datar(1) = vardim(1)
|
|
|
125 |
datar(2) = vardim(2)
|
|
|
126 |
datar(3) = 1000.*phymax(2)
|
|
|
127 |
datar(4) = 1000.*phymin(1)
|
|
|
128 |
datar(5) = 1000.*phymin(2)
|
|
|
129 |
datar(6) = 1000.*phymax(1)
|
|
|
130 |
datar(7) = 1000.*dx
|
|
|
131 |
datar(8) = 1000.*dy
|
|
|
132 |
datar(9) = nlev
|
|
|
133 |
datar(10) = 1
|
|
|
134 |
datar(11) = 0
|
|
|
135 |
datar(12) = 0
|
|
|
136 |
datar(13) = 1000.*pollon
|
|
|
137 |
datar(14) = 1000.*pollat
|
|
|
138 |
call wricst(cfn,datar,
|
|
|
139 |
> aklev,bklev,aklay,bklay,stdate)
|
|
|
140 |
call crecdf(trim(newfile(t)),ncdfid, phymin, phymax,
|
|
|
141 |
> ndim,cfn,error)
|
|
|
142 |
if (error.ne.0) goto 998
|
|
|
143 |
else
|
|
|
144 |
call cdfwopn(trim(newfile(t)),ncdfid,error)
|
|
|
145 |
if (error.ne.0) goto 998
|
|
|
146 |
endif
|
|
|
147 |
do k=1,novars
|
|
|
148 |
if (newfile(k).eq.newfile(t)) then
|
|
|
149 |
crefile(k)=1
|
|
|
150 |
endif
|
|
|
151 |
enddo
|
|
|
152 |
|
|
|
153 |
c Create variable if necessary
|
|
|
154 |
isnew=1
|
|
|
155 |
do k=1,novars
|
|
|
156 |
if ((newfile(t).eq.newfile(k)).and.
|
|
|
157 |
> (newname(t).eq.newname(k)).and.
|
|
|
158 |
> (crename(t).eq.1)) then
|
|
|
159 |
isnew=0
|
|
|
160 |
endif
|
|
|
161 |
enddo
|
|
|
162 |
if (isnew.eq.1) then
|
|
|
163 |
call putdef(ncdfid, newname(t), ndim, misdat, vardim,
|
|
|
164 |
> phymin, phymax, stag, error)
|
|
|
165 |
if (error.ne.0) goto 998
|
|
|
166 |
endif
|
|
|
167 |
do k=1,novars
|
|
|
168 |
if ((newname(k).eq.newname(t)).and.
|
|
|
169 |
> (crefile(k).eq.1)) then
|
|
|
170 |
crename(k)=1
|
|
|
171 |
endif
|
|
|
172 |
enddo
|
|
|
173 |
|
|
|
174 |
c Write data
|
|
|
175 |
call putdat(ncdfid,newname(t),time(1),0,varold,error)
|
|
|
176 |
if (error.ne.0) goto 998
|
|
|
177 |
|
|
|
178 |
c Close files
|
|
|
179 |
call clscdf(cdfid, error)
|
|
|
180 |
if (error.ne.0) goto 997
|
|
|
181 |
call clscdf(ncdfid, error)
|
|
|
182 |
if (error.ne.0) goto 998
|
|
|
183 |
call clscdf(cstid, error)
|
|
|
184 |
if (error.ne.0) goto 997
|
|
|
185 |
|
|
|
186 |
enddo
|
|
|
187 |
|
|
|
188 |
c -----------------------------------------------------------------------
|
|
|
189 |
c Exception handling
|
|
|
190 |
c -----------------------------------------------------------------------
|
|
|
191 |
|
|
|
192 |
stop
|
|
|
193 |
|
|
|
194 |
997 print*,'Problems with input file... Stop'
|
|
|
195 |
stop
|
|
|
196 |
|
|
|
197 |
998 print*,'Problems with output file... Stop'
|
|
|
198 |
stop
|
|
|
199 |
|
|
|
200 |
|
|
|
201 |
end
|