1 | |
---|
2 | |
---|
3 | program lslin |
---|
4 | |
---|
5 | ! Program to interpolate data in Solar Longitude linear time coordinate |
---|
6 | ! (usable with grads) from Netcdf diagfi or concatnc files |
---|
7 | ! author Y. Wanherdrick, K. Dassas 2004 |
---|
8 | ! Modified by F.Forget 04/2005 |
---|
9 | ! More modifications by Ehouarn Millour 12/2005 |
---|
10 | ! Modified by Ehouarn Millour 10/2007 (changed evaluation of 'start_var' |
---|
11 | ! from hard-coded values to a computed value) |
---|
12 | ! Read controle field, if available TN, October 2013 |
---|
13 | |
---|
14 | |
---|
15 | implicit none |
---|
16 | |
---|
17 | include "netcdf.inc" ! NetCDF definitions |
---|
18 | |
---|
19 | character (len=50) :: infile |
---|
20 | ! infile(): input file name |
---|
21 | character (len=50), dimension(:), allocatable :: var |
---|
22 | ! var(): names of the variables |
---|
23 | character (len=50) :: title,units |
---|
24 | ! title(),units(): [netcdf] "title" and "units" attributes |
---|
25 | character (len=100) :: outfile |
---|
26 | ! outfile(): output file name |
---|
27 | character (len=100) :: vartmp |
---|
28 | ! vartmp(): used for temporary storage of various strings |
---|
29 | character (len=1) :: answer |
---|
30 | ! answer: the character 'y' (or 'Y'), if input file is of 'concatnc' type |
---|
31 | integer :: nid,varid,ierr |
---|
32 | ! nid: [netcdf] ID # of input file |
---|
33 | ! varid: [netcdf] ID # of a variable |
---|
34 | ! ierr: [netcdf] error code (returned by subroutines) |
---|
35 | integer :: nout,varidout |
---|
36 | ! nout: [netcdf] ID # of output file |
---|
37 | ! varidout: [netcdf] ID # of a variable (to write in the output file) |
---|
38 | integer :: i,j,k,l,x,y |
---|
39 | ! counters for various loops |
---|
40 | integer :: start_var |
---|
41 | ! starting index/ID # from which physical variables are to be found |
---|
42 | integer :: reptime ! Ehouarn: integer or real ? |
---|
43 | ! rep_time: starting date/time of the run (given by user) |
---|
44 | integer :: day_ini ! Ehouarn: integer or real ? |
---|
45 | ! day_ini: starting date/time of the run stored in input file |
---|
46 | integer, parameter :: length=100 |
---|
47 | ! length: (default) lenght of tab_cntrl() |
---|
48 | real, dimension(length) :: tab_cntrl |
---|
49 | ! tab_cntrl(length): array, stored in the input file, |
---|
50 | ! which contains various control parameters. |
---|
51 | real, dimension(:), allocatable:: lat,lon,alt,time,lsgcm,timels |
---|
52 | ! lat(): latitude coordinates (read from input file) |
---|
53 | ! lon(): longitude coordinates (read from input file) |
---|
54 | ! alt(): altitude coordinates (read from input file) |
---|
55 | ! time(): time coordinates (in "sol", read from input file) |
---|
56 | ! lsgcm(): time coordinate (in unevenly spaced "Ls") |
---|
57 | ! timels(): new time coordinates (evenly spaced "Ls"; written to output file) |
---|
58 | integer :: latlen,lonlen,altlen,timelen,Nls |
---|
59 | ! latlen: # of elements of lat() array |
---|
60 | ! lonlen: # of elements of lon() array |
---|
61 | ! altvar: # of elements of alt() array |
---|
62 | ! timelen: # of elements of time() and lsgcm() arrays |
---|
63 | ! Nls: # of elements of timels() array |
---|
64 | integer :: nbvarfile,nbvar,ndim !,nbfile |
---|
65 | ! nbvar: # of time-dependent variables |
---|
66 | ! nbvarfile: total # of variables (in netcdf file) |
---|
67 | ! ndim: [netcdf] # of dimensions (3 or 4) of a variable |
---|
68 | integer :: latdim,londim,altdim,timedim |
---|
69 | ! latdim: [netcdf] "latitude" dim ID |
---|
70 | ! londim: [netcdf] "longitude" dim ID |
---|
71 | ! altdim: [netcdf] "altdim" dim ID |
---|
72 | ! timedim: [netcdf] "timedim" dim ID |
---|
73 | integer :: latvar,lonvar,altvar,timevar |
---|
74 | ! latvar: [netcdf] ID of "latitude" variable |
---|
75 | ! lonvar: [netcdf] ID of "longitude" variable |
---|
76 | ! altvar: [netcdf] ID of "altitude" variable |
---|
77 | ! timevar: [netcdf] ID of "Time" variable |
---|
78 | integer :: latdimout,londimout,altdimout,timedimout,timevarout |
---|
79 | ! latdimout: [netcdf] output latitude (dimension) ID |
---|
80 | ! londimout: [netcdf] output longitude (dimension) ID |
---|
81 | ! altdimout: [netcdf] output altitude (dimension) ID |
---|
82 | ! timedimout: [netcdf] output time (dimension) ID |
---|
83 | ! timevarout: [netcdf] ID of output "Time" variable |
---|
84 | integer, dimension(4) :: corner,edges,dim |
---|
85 | ! corner(4): [netcdf] start indexes (where block of data will be written) |
---|
86 | ! edges(4): [netcdf] lenght (along dimensions) of block of data to write |
---|
87 | ! dim(4): [netcdf] lat, long, alt and time dimensions |
---|
88 | real, dimension(:,:,:,:), allocatable :: var3d,var3dls |
---|
89 | ! var3d(,,,): 4D array to store a variable (on initial lat/lon/alt/sol grid) |
---|
90 | ! var3dls(,,,): 4D array to store a variable (on new lat/lon/alt/Ls grid) |
---|
91 | real, dimension(:), allocatable :: var3dxy |
---|
92 | ! var3dxy(): to store the temporal evolution of a variable (at fixed lat/lon/alt) |
---|
93 | real :: deltatsol,deltals,resultat |
---|
94 | ! deltatsol: time step (in sols) of input file data |
---|
95 | ! deltals: time step (in Ls) for the data sent to output |
---|
96 | ! resultat: to temporarily store the result of the interpolation |
---|
97 | character (len=3) :: mon |
---|
98 | ! mon(3): to store (and write to file) the 3 first letters of a month |
---|
99 | real :: date |
---|
100 | ! date: used to compute/build a fake date (for grads output) |
---|
101 | |
---|
102 | !============================================================================== |
---|
103 | ! 1. Initialisation step |
---|
104 | !============================================================================== |
---|
105 | |
---|
106 | !============================================================================== |
---|
107 | ! 1.1. Get input file name and 'type' (to initialize start_var and reptime) |
---|
108 | !============================================================================== |
---|
109 | |
---|
110 | write(*,*) "which file do you want to use?" |
---|
111 | read(*,'(a50)') infile |
---|
112 | |
---|
113 | !write(*,*) "Is it a concatnc file? (y/n)?" |
---|
114 | write(*,*) "Do you want to specify the beginning day of the file" |
---|
115 | write(*,*) "in case the controle field is not present ? (y/n)?" |
---|
116 | read(*,*) answer |
---|
117 | if ((answer=="y").or.(answer=="Y")) then |
---|
118 | write(*,*) "Beginning day of the file?" |
---|
119 | read(*,*) reptime |
---|
120 | ! start_var=8 ! 'concatnc' type of file |
---|
121 | !else |
---|
122 | ! start_var=16 ! 'diagfi' type of file |
---|
123 | ! N.B.: start_var is now computed; see below |
---|
124 | endif |
---|
125 | |
---|
126 | |
---|
127 | !============================================================================== |
---|
128 | ! 1.2. Open input file and read/list the variables it contains |
---|
129 | !============================================================================== |
---|
130 | |
---|
131 | write(*,*) "opening "//trim(infile)//"..." |
---|
132 | ierr = NF_OPEN(infile,NF_NOWRITE,nid) |
---|
133 | if (ierr.NE.NF_NOERR) then |
---|
134 | write(*,*) 'Failed to open file '//infile |
---|
135 | write(*,*) NF_STRERROR(ierr) |
---|
136 | stop "" |
---|
137 | endif |
---|
138 | |
---|
139 | ! Compute 'start_var', the index from which variables are lon-lat-time |
---|
140 | ! and/or lon-lat-alt-time |
---|
141 | ! WARNING: We assume here that the ordering of variables in the NetCDF |
---|
142 | ! file is such that 0D, 1D and 2D variables are placed BEFORE 3D and 4D |
---|
143 | ! variables |
---|
144 | |
---|
145 | i=1 ! dummy initialization to enter loop below |
---|
146 | start_var=0 ! initialization |
---|
147 | do while (i.lt.3) |
---|
148 | start_var=start_var+1 |
---|
149 | ! request number of dims of variable number 'start_var' |
---|
150 | ierr=NF_INQ_VARNDIMS(nid,start_var,i) |
---|
151 | if (ierr.ne.NF_NOERR) then |
---|
152 | write(*,*) "Failed to get number of dims for variable number:",start_var |
---|
153 | write(*,*) NF_STRERROR(ierr) |
---|
154 | stop "" |
---|
155 | endif |
---|
156 | enddo |
---|
157 | write(*,*) "start_var=",start_var |
---|
158 | |
---|
159 | |
---|
160 | ierr=NF_INQ_NVARS(nid,nbvarfile) |
---|
161 | ! nbvarfile is now equal to the (total) number of variables in input file |
---|
162 | |
---|
163 | allocate(var(nbvarfile-(start_var-1))) |
---|
164 | |
---|
165 | ! Yield the list of variables (to the screen) |
---|
166 | write(*,*) |
---|
167 | do i=start_var,nbvarfile |
---|
168 | ierr=NF_INQ_VARNAME(nid,i,vartmp) |
---|
169 | write(*,*) trim(vartmp) |
---|
170 | enddo |
---|
171 | !nbvar=0 |
---|
172 | |
---|
173 | ! Ehouarn: Redundant (and obsolete) lines ? |
---|
174 | ! nbvar=nbvarfile-(start_var-1) |
---|
175 | ! do j=start_var,nbvarfile |
---|
176 | ! ierr=nf_inq_varname(nid,j,var(j-(start_var-1))) |
---|
177 | ! enddo |
---|
178 | |
---|
179 | ! Get the variables' names from the input file (and store them in var()) |
---|
180 | nbvar=nbvarfile-(start_var-1) |
---|
181 | do i=1,nbvar |
---|
182 | ierr=NF_INQ_VARNAME(nid,i+(start_var-1),var(i)) |
---|
183 | write(*,'(a9,1x,i2,1x,a1,1x,a50)') "variable ",i,":",var(i) |
---|
184 | enddo |
---|
185 | |
---|
186 | !============================================================================== |
---|
187 | ! 1.3. Output file name |
---|
188 | !============================================================================== |
---|
189 | ! outfile="lslin.nc" |
---|
190 | outfile=infile(1:len_trim(infile)-3)//"_Ls.nc" |
---|
191 | write(*,*) outfile |
---|
192 | |
---|
193 | |
---|
194 | !============================================================================== |
---|
195 | ! 2. Work: read input, build new time coordinate and write it to output |
---|
196 | !============================================================================== |
---|
197 | |
---|
198 | !============================================================================== |
---|
199 | ! 2.1. Read (and check) latitude, longitude and altitude from input file |
---|
200 | !============================================================================== |
---|
201 | |
---|
202 | ierr=NF_INQ_DIMID(nid,"latitude",latdim) |
---|
203 | ierr=NF_INQ_VARID(nid,"latitude",latvar) |
---|
204 | if (ierr.NE.NF_NOERR) then |
---|
205 | write(*,*) 'ERROR: Field <latitude> is missing' |
---|
206 | write(*,*) NF_STRERROR(ierr) |
---|
207 | stop "" |
---|
208 | endif |
---|
209 | ierr=NF_INQ_DIMLEN(nid,latdim,latlen) |
---|
210 | ! write(*,*) "latlen: ",latlen |
---|
211 | |
---|
212 | ierr=NF_INQ_DIMID(nid,"longitude",londim) |
---|
213 | ierr=NF_INQ_VARID(nid,"longitude",lonvar) |
---|
214 | if (ierr.NE.NF_NOERR) then |
---|
215 | write(*,*) 'ERROR: Field <longitude> is missing' |
---|
216 | write(*,*) NF_STRERROR(ierr) |
---|
217 | stop "" |
---|
218 | endif |
---|
219 | ierr=NF_INQ_DIMLEN(nid,londim,lonlen) |
---|
220 | ! write(*,*) "lonlen: ",lonlen |
---|
221 | |
---|
222 | ierr=NF_INQ_DIMID(nid,"altitude",altdim) |
---|
223 | ierr=NF_INQ_VARID(nid,"altitude",altvar) |
---|
224 | if (ierr.NE.NF_NOERR) then |
---|
225 | write(*,*) 'ERROR: Field <altitude> is missing' |
---|
226 | write(*,*) NF_STRERROR(ierr) |
---|
227 | ! stop "" |
---|
228 | altlen = 1 |
---|
229 | else |
---|
230 | ierr=NF_INQ_DIMLEN(nid,altdim,altlen) |
---|
231 | endif |
---|
232 | write(*,*) "altlen: ",altlen |
---|
233 | |
---|
234 | ! Allocate lat(), lon() and alt() |
---|
235 | allocate(lat(latlen)) |
---|
236 | allocate(lon(lonlen)) |
---|
237 | allocate(alt(altlen)) |
---|
238 | |
---|
239 | ! Read lat(),lon() and alt() from input file |
---|
240 | |
---|
241 | |
---|
242 | |
---|
243 | |
---|
244 | |
---|
245 | ierr = NF_GET_VAR_REAL(nid,latvar,lat) |
---|
246 | ierr = NF_GET_VAR_REAL(nid,lonvar,lon) |
---|
247 | ierr = NF_GET_VAR_REAL(nid,altvar,alt) |
---|
248 | if (ierr.NE.NF_NOERR) then |
---|
249 | if (altlen.eq.1) alt(1)=0. |
---|
250 | end if |
---|
251 | |
---|
252 | |
---|
253 | !============================================================================== |
---|
254 | ! 2.2. Create (and initialize latitude, longitude and altitude in) output file |
---|
255 | !============================================================================== |
---|
256 | |
---|
257 | call initiate(outfile,lat,lon,alt,nout,& |
---|
258 | latdimout,londimout,altdimout,timedimout,timevarout) |
---|
259 | |
---|
260 | !============================================================================== |
---|
261 | ! 2.3. Read time from input file |
---|
262 | !============================================================================== |
---|
263 | |
---|
264 | ierr=NF_INQ_DIMID(nid,"Time",timedim) |
---|
265 | if (ierr.NE.NF_NOERR) then |
---|
266 | write(*,*) 'ERROR: Dimension <Time> is missing' |
---|
267 | write(*,*) NF_STRERROR(ierr) |
---|
268 | stop "" |
---|
269 | endif |
---|
270 | ierr=NF_INQ_VARID(nid,"Time",timevar) |
---|
271 | if (ierr.NE.NF_NOERR) then |
---|
272 | write(*,*) 'ERROR: Field <Time> is missing' |
---|
273 | write(*,*) NF_STRERROR(ierr) |
---|
274 | stop "" |
---|
275 | endif |
---|
276 | |
---|
277 | ierr=NF_INQ_DIMLEN(nid,timedim,timelen) |
---|
278 | write(*,*) "timelen: ",timelen |
---|
279 | |
---|
280 | allocate(time(timelen)) |
---|
281 | allocate(lsgcm(timelen)) |
---|
282 | |
---|
283 | |
---|
284 | |
---|
285 | |
---|
286 | ierr = NF_GET_VAR_REAL(nid,timevar,time) |
---|
287 | |
---|
288 | |
---|
289 | !============================================================================== |
---|
290 | ! 2.4. Initialize day_ini (starting day of the run) |
---|
291 | !============================================================================== |
---|
292 | |
---|
293 | |
---|
294 | write(*,*) 'answer',answer |
---|
295 | if ((answer/="y").and.(answer/="Y")) then |
---|
296 | ! input file is of 'concatnc' type; the starting date of the run |
---|
297 | ! is stored in the "controle" array |
---|
298 | ierr = NF_INQ_VARID (nid, "controle", varid) |
---|
299 | if (ierr .NE. NF_NOERR) then |
---|
300 | write(*,*) 'ERROR: <controle> variable is missing' |
---|
301 | write(*,*) NF_STRERROR(ierr) |
---|
302 | stop "" |
---|
303 | endif |
---|
304 | |
---|
305 | |
---|
306 | |
---|
307 | |
---|
308 | ierr = NF_GET_VAR_REAL(nid, varid, tab_cntrl) |
---|
309 | |
---|
310 | |
---|
311 | if (ierr .NE. NF_NOERR) then |
---|
312 | write(*,*) 'ERROR: Failed to read <controle>' |
---|
313 | write(*,*) NF_STRERROR(ierr) |
---|
314 | stop "" |
---|
315 | endif |
---|
316 | |
---|
317 | day_ini = tab_cntrl(4) |
---|
318 | day_ini = modulo(day_ini,669) |
---|
319 | write(*,*) 'day_ini', day_ini |
---|
320 | else |
---|
321 | day_ini= reptime |
---|
322 | write(*,*) 'day_ini', day_ini |
---|
323 | endif |
---|
324 | |
---|
325 | !============================================================================== |
---|
326 | ! 2.5. Build timels() (i.e.: time, but in evenly spaced "Ls" time steps) |
---|
327 | !============================================================================== |
---|
328 | |
---|
329 | ! compute time step, in sols, of input dataset |
---|
330 | deltatsol=time(2)-time(1) |
---|
331 | write(*,*) 'deltatsol',deltatsol |
---|
332 | |
---|
333 | ! compute time/dates in "Ls"; result stored in lsgcm() |
---|
334 | do i=1,timelen |
---|
335 | call sol2ls(day_ini+time(i),lsgcm(i)) |
---|
336 | enddo |
---|
337 | |
---|
338 | write(*,*) 'Input data LS range :', lsgcm(1),lsgcm(timelen) |
---|
339 | |
---|
340 | !****************************************** |
---|
341 | write(*,*) "Automatic Ls timetsep (y/n)?" |
---|
342 | read(*,*) answer |
---|
343 | if ((answer=="y").or.(answer=="Y")) then |
---|
344 | ! ********************************************* |
---|
345 | ! Trick of the trade: |
---|
346 | ! Use the value of deltatsol to determine |
---|
347 | ! a suitable value for deltals |
---|
348 | ! ********************************************* |
---|
349 | deltals=1./12. |
---|
350 | if (0.6*deltatsol.ge.1/6.) deltals=1./6. |
---|
351 | if (0.6*deltatsol.ge.0.25) deltals=0.25 |
---|
352 | if (0.6*deltatsol.ge.0.5) deltals=0.5 |
---|
353 | if (0.6*deltatsol.ge.0.75) deltals=0.75 |
---|
354 | if (0.6*deltatsol.ge.1) deltals=1. |
---|
355 | if (0.6*deltatsol.ge.2) deltals=2. |
---|
356 | if (0.6*deltatsol.ge.3) deltals=3. |
---|
357 | if (0.6*deltatsol.ge.5) deltals=5. |
---|
358 | else |
---|
359 | write(*,*) "New timestep in Ls (deg)" |
---|
360 | read(*,*) deltals |
---|
361 | endif |
---|
362 | NLs=int(Int((lsgcm(timelen)-lsgcm(1))/deltals) +1) |
---|
363 | !******************************************** |
---|
364 | allocate(timels(Nls)) |
---|
365 | |
---|
366 | ! Build timels() |
---|
367 | timels(1) = 0.01*nint(100.*lsgcm(1)) ! Ehouarn: what the !!!???!!! |
---|
368 | do k=2,Nls |
---|
369 | timels(k) = timels(k-1) + deltals |
---|
370 | end do |
---|
371 | |
---|
372 | write(*,*) 'timestep in Ls (deg) ', deltals |
---|
373 | write(*,*) 'output data LS range : ', timels(1),timels(Nls) |
---|
374 | |
---|
375 | !============================================================================== |
---|
376 | ! 2.6. Write timels() to output file |
---|
377 | !============================================================================== |
---|
378 | |
---|
379 | do k=1,Nls |
---|
380 | |
---|
381 | |
---|
382 | |
---|
383 | ierr= NF_PUT_VARA_REAL(nout,timevarout,k,1,timels(k)) |
---|
384 | |
---|
385 | enddo |
---|
386 | |
---|
387 | |
---|
388 | !============================================================================== |
---|
389 | ! 3. Read variables, interpolate them along the new time coordinate |
---|
390 | ! and send the result to output |
---|
391 | !============================================================================== |
---|
392 | |
---|
393 | do j=1,nbvar ! loop on the variables to read/interpolate/write |
---|
394 | |
---|
395 | !============================================================================== |
---|
396 | ! 3.1 Check that variable exists, and get some of its attributes |
---|
397 | !============================================================================== |
---|
398 | write(*,*) "variable ",var(j) |
---|
399 | ! Get the variable's ID |
---|
400 | ierr=NF_INQ_VARID(nid,var(j),varid) |
---|
401 | if (ierr.NE.NF_NOERR) then |
---|
402 | write(*,*) 'ERROR: Field <',var(j),'> not found' |
---|
403 | write(*,*) NF_STRERROR(ierr) |
---|
404 | stop "" |
---|
405 | endif |
---|
406 | ! Get the value of 'ndim' for this varriable |
---|
407 | ierr=NF_INQ_VARNDIMS(nid,varid,ndim) |
---|
408 | write(*,*) 'ndim', ndim |
---|
409 | |
---|
410 | !============================================================================== |
---|
411 | ! 3.2 Prepare a few things in order to interpolate/write |
---|
412 | !============================================================================== |
---|
413 | |
---|
414 | if (ndim==3) then |
---|
415 | allocate(var3d(lonlen,latlen,timelen,1)) |
---|
416 | allocate(var3dls(lonlen,latlen,Nls,1)) |
---|
417 | allocate(var3dxy(timelen)) |
---|
418 | |
---|
419 | dim(1)=londimout |
---|
420 | dim(2)=latdimout |
---|
421 | dim(3)=timedimout |
---|
422 | |
---|
423 | corner(1)=1 |
---|
424 | corner(2)=1 |
---|
425 | corner(3)=1 |
---|
426 | corner(4)=1 |
---|
427 | |
---|
428 | edges(1)=lonlen |
---|
429 | edges(2)=latlen |
---|
430 | edges(3)=Nls |
---|
431 | edges(4)=1 |
---|
432 | |
---|
433 | else if (ndim==4) then |
---|
434 | allocate(var3d(lonlen,latlen,altlen,timelen)) |
---|
435 | allocate(var3dls(lonlen,latlen,altlen,Nls)) |
---|
436 | allocate(var3dxy(timelen)) |
---|
437 | |
---|
438 | dim(1)=londimout |
---|
439 | dim(2)=latdimout |
---|
440 | dim(3)=altdimout |
---|
441 | dim(4)=timedimout |
---|
442 | |
---|
443 | corner(1)=1 |
---|
444 | corner(2)=1 |
---|
445 | corner(3)=1 |
---|
446 | corner(4)=1 |
---|
447 | |
---|
448 | edges(1)=lonlen |
---|
449 | edges(2)=latlen |
---|
450 | edges(3)=altlen |
---|
451 | edges(4)=Nls |
---|
452 | endif |
---|
453 | |
---|
454 | !============================================================================== |
---|
455 | ! 3.3 Write this variable's definition and attributes to the output file |
---|
456 | !============================================================================== |
---|
457 | units=" " |
---|
458 | title=" " |
---|
459 | ierr=NF_GET_ATT_TEXT(nid,varid,"title",title) |
---|
460 | ierr=NF_GET_ATT_TEXT(nid,varid,"units",units) |
---|
461 | |
---|
462 | call def_var(nout,var(j),title,units,ndim,dim,varidout,ierr) |
---|
463 | |
---|
464 | !============================================================================== |
---|
465 | ! 3.4 Read variable |
---|
466 | !============================================================================== |
---|
467 | |
---|
468 | |
---|
469 | |
---|
470 | |
---|
471 | ierr = NF_GET_VAR_REAL(nid,varid,var3d) |
---|
472 | |
---|
473 | |
---|
474 | !============================================================================== |
---|
475 | ! 3.5 Interpolate |
---|
476 | !============================================================================== |
---|
477 | |
---|
478 | ! 2D variable (lon, lat, time) |
---|
479 | ! interpolation of var at timels |
---|
480 | if (ndim==3) then |
---|
481 | do x=1,lonlen |
---|
482 | do y=1,latlen |
---|
483 | ! write(*,*) 'd: x, y', x, y |
---|
484 | do l=1,timelen |
---|
485 | var3dxy(l)=var3d(x,y,l,1) |
---|
486 | enddo |
---|
487 | do l=1,Nls |
---|
488 | call interpolf(timels(l),resultat,lsgcm,var3dxy,timelen) |
---|
489 | var3dls(x,y,l,1)=resultat |
---|
490 | enddo |
---|
491 | enddo |
---|
492 | enddo |
---|
493 | ! 3D variable (lon, lat, alt, time) |
---|
494 | ! interpolation of var at timels |
---|
495 | else if (ndim==4) then |
---|
496 | do x=1,lonlen |
---|
497 | do y=1,latlen |
---|
498 | do k=1,altlen |
---|
499 | do l=1,timelen |
---|
500 | var3dxy(l)=var3d(x,y,k,l) |
---|
501 | enddo |
---|
502 | do l=1,Nls |
---|
503 | call interpolf(timels(l),resultat,lsgcm,var3dxy,timelen) |
---|
504 | var3dls(x,y,k,l)=resultat |
---|
505 | enddo |
---|
506 | enddo |
---|
507 | enddo |
---|
508 | enddo |
---|
509 | endif |
---|
510 | |
---|
511 | !============================================================================== |
---|
512 | ! 3.4 Write variable to output file |
---|
513 | !============================================================================== |
---|
514 | |
---|
515 | |
---|
516 | |
---|
517 | |
---|
518 | ierr= NF_PUT_VARA_REAL(nout,varidout,corner,edges,var3dls) |
---|
519 | |
---|
520 | |
---|
521 | if (ierr.ne.NF_NOERR) then |
---|
522 | write(*,*) 'PUT_VAR ERROR: ',NF_STRERROR(ierr) |
---|
523 | stop "" |
---|
524 | endif |
---|
525 | |
---|
526 | deallocate(var3d) |
---|
527 | deallocate(var3dls) |
---|
528 | deallocate(var3dxy) |
---|
529 | |
---|
530 | enddo ! of do j=1,nbvar loop |
---|
531 | |
---|
532 | deallocate(time) |
---|
533 | deallocate(lsgcm) |
---|
534 | |
---|
535 | ! close input and output files |
---|
536 | ierr=nf_close(nid) |
---|
537 | ierr=NF_CLOSE(nout) |
---|
538 | |
---|
539 | |
---|
540 | !============================================================================== |
---|
541 | ! 4. Build a companion file 'lslin.ctl', so that output file can be |
---|
542 | ! processed by Grads |
---|
543 | !============================================================================== |
---|
544 | |
---|
545 | ! ---------------------------------------------------- |
---|
546 | ! Writing ctl file to directly read Ls coordinate in grads |
---|
547 | ! (because of bug in grads that refuse to read date like 0089 in .nc files) |
---|
548 | !open(33,file='lslin.ctl') |
---|
549 | open(33,file=infile(1:len_trim(infile)-3)//"_Ls.ctl") |
---|
550 | date= (timels(1)-int(timels(1)))*365. |
---|
551 | mon='jan' |
---|
552 | if(date.ge.32) mon='feb' |
---|
553 | if(date.ge.60) mon='mar' |
---|
554 | if(date.ge.91) mon='apr' |
---|
555 | if(date.ge.121) mon='may' |
---|
556 | if(date.ge.152) mon='jun' |
---|
557 | if(date.ge.182) mon='jul' |
---|
558 | if(date.ge.213) mon='aug' |
---|
559 | if(date.ge.244) mon='sep' |
---|
560 | if(date.ge.274) mon='oct' |
---|
561 | if(date.ge.305) mon='nov' |
---|
562 | if(date.ge.335) mon='dec' |
---|
563 | write(33,98) outfile |
---|
564 | 98 format("DSET ",a) |
---|
565 | write(33,99) Nls, 15,mon, int(timels(1)),nint(deltals*12),'mo' |
---|
566 | 99 format("TDEF Time ",i5," LINEAR ", i2,a3,i4.4,1x,i2,a2) |
---|
567 | |
---|
568 | deallocate(timels) |
---|
569 | contains |
---|
570 | |
---|
571 | !************************************ |
---|
572 | subroutine initiate (filename,lat,lon,alt,& |
---|
573 | nout,latdimout,londimout,altdimout,timedimout,timevarout) |
---|
574 | !============================================================================== |
---|
575 | ! Purpose: |
---|
576 | ! Create and initialize a data file (NetCDF format) |
---|
577 | !============================================================================== |
---|
578 | ! Remarks: |
---|
579 | ! The NetCDF file (created in this subroutine) remains open |
---|
580 | !============================================================================== |
---|
581 | |
---|
582 | implicit none |
---|
583 | |
---|
584 | include "netcdf.inc" ! NetCDF definitions |
---|
585 | |
---|
586 | !============================================================================== |
---|
587 | ! Arguments: |
---|
588 | !============================================================================== |
---|
589 | character (len=*), intent(in):: filename |
---|
590 | ! filename(): the file's name |
---|
591 | real, dimension(:), intent(in):: lat |
---|
592 | ! lat(): latitude |
---|
593 | real, dimension(:), intent(in):: lon |
---|
594 | ! lon(): longitude |
---|
595 | real, dimension(:), intent(in):: alt |
---|
596 | ! alt(): altitude |
---|
597 | integer, intent(out):: nout |
---|
598 | ! nout: [netcdf] file ID |
---|
599 | integer, intent(out):: latdimout |
---|
600 | ! latdimout: [netcdf] lat() (i.e.: latitude) ID |
---|
601 | integer, intent(out):: londimout |
---|
602 | ! londimout: [netcdf] lon() ID |
---|
603 | integer, intent(out):: altdimout |
---|
604 | ! altdimout: [netcdf] alt() ID |
---|
605 | integer, intent(out):: timedimout |
---|
606 | ! timedimout: [netcdf] "Time" ID |
---|
607 | integer, intent(out):: timevarout |
---|
608 | ! timevarout: [netcdf] "Time" (considered as a variable) ID |
---|
609 | |
---|
610 | !============================================================================== |
---|
611 | ! Local variables: |
---|
612 | !============================================================================== |
---|
613 | !integer :: latdim,londim,altdim,timedim |
---|
614 | integer :: nvarid,ierr |
---|
615 | ! nvarid: [netcdf] ID of a variable |
---|
616 | ! ierr: [netcdf] return error code (from called subroutines) |
---|
617 | |
---|
618 | !============================================================================== |
---|
619 | ! 1. Create (and open) output file |
---|
620 | !============================================================================== |
---|
621 | write(*,*) "creating "//trim(adjustl(filename))//'...' |
---|
622 | ierr = NF_CREATE(filename,IOR(NF_CLOBBER,NF_64BIT_OFFSET),nout) |
---|
623 | ! NB: setting NF_CLOBBER mode means that it's OK to overwrite an existing file |
---|
624 | if (ierr.NE.NF_NOERR) then |
---|
625 | WRITE(*,*)'ERROR: Impossible to create the file.' |
---|
626 | stop "" |
---|
627 | endif |
---|
628 | |
---|
629 | !============================================================================== |
---|
630 | ! 2. Define/write "dimensions" and get their IDs |
---|
631 | !============================================================================== |
---|
632 | |
---|
633 | ierr = NF_DEF_DIM(nout, "latitude", size(lat), latdimout) |
---|
634 | ierr = NF_DEF_DIM(nout, "longitude", size(lon), londimout) |
---|
635 | ierr = NF_DEF_DIM(nout, "altitude", size(alt), altdimout) |
---|
636 | ierr = NF_DEF_DIM(nout, "Time", NF_UNLIMITED, timedimout) |
---|
637 | |
---|
638 | ! End netcdf define mode |
---|
639 | ierr = NF_ENDDEF(nout) |
---|
640 | |
---|
641 | !============================================================================== |
---|
642 | ! 3. Write "Time" and its attributes |
---|
643 | !============================================================================== |
---|
644 | |
---|
645 | call def_var(nout,"Time","Time","years since 0000-00-0 00:00:00",1,& |
---|
646 | (/timedimout/),timevarout,ierr) |
---|
647 | |
---|
648 | !============================================================================== |
---|
649 | ! 4. Write "latitude" (data and attributes) |
---|
650 | !============================================================================== |
---|
651 | |
---|
652 | call def_var(nout,"latitude","latitude","degrees_north",1,& |
---|
653 | (/latdimout/),nvarid,ierr) |
---|
654 | |
---|
655 | ierr = NF_PUT_VAR_REAL (nout,nvarid,lat) |
---|
656 | |
---|
657 | !============================================================================== |
---|
658 | ! 4. Write "longitude" (data and attributes) |
---|
659 | !============================================================================== |
---|
660 | |
---|
661 | call def_var(nout,"longitude","East longitude","degrees_east",1,& |
---|
662 | (/londimout/),nvarid,ierr) |
---|
663 | |
---|
664 | ierr = NF_PUT_VAR_REAL (nout,nvarid,lon) |
---|
665 | |
---|
666 | !============================================================================== |
---|
667 | ! 4. Write "altitude" (data and attributes) |
---|
668 | !============================================================================== |
---|
669 | |
---|
670 | ! Switch to netcdf define mode |
---|
671 | ierr = NF_REDEF (nout) |
---|
672 | |
---|
673 | ierr = NF_DEF_VAR (nout,"altitude",NF_FLOAT,1,altdimout,nvarid) |
---|
674 | |
---|
675 | ierr = NF_PUT_ATT_TEXT (nout,nvarid,"long_name",8,"altitude") |
---|
676 | ierr = NF_PUT_ATT_TEXT (nout,nvarid,'units',2,"km") |
---|
677 | ierr = NF_PUT_ATT_TEXT (nout,nvarid,'positive',2,"up") |
---|
678 | |
---|
679 | ! End netcdf define mode |
---|
680 | ierr = NF_ENDDEF(nout) |
---|
681 | |
---|
682 | ierr = NF_PUT_VAR_REAL (nout,nvarid,alt) |
---|
683 | |
---|
684 | end Subroutine initiate |
---|
685 | !************************************ |
---|
686 | subroutine def_var(nid,name,title,units,nbdim,dim,nvarid,ierr) |
---|
687 | !============================================================================== |
---|
688 | ! Purpose: Write a variable (i.e: add a variable to a dataset) |
---|
689 | ! called "name"; along with its attributes "title", "units"... |
---|
690 | ! to a file (following the NetCDF format) |
---|
691 | !============================================================================== |
---|
692 | ! Remarks: |
---|
693 | ! The NetCDF file must be open |
---|
694 | !============================================================================== |
---|
695 | |
---|
696 | implicit none |
---|
697 | |
---|
698 | include "netcdf.inc" ! NetCDF definitions |
---|
699 | |
---|
700 | !============================================================================== |
---|
701 | ! Arguments: |
---|
702 | !============================================================================== |
---|
703 | integer, intent(in) :: nid |
---|
704 | ! nid: [netcdf] file ID # |
---|
705 | character (len=*), intent(in) :: name |
---|
706 | ! name(): [netcdf] variable's name |
---|
707 | character (len=*), intent(in) :: title |
---|
708 | ! title(): [netcdf] variable's "title" attribute |
---|
709 | character (len=*), intent(in) :: units |
---|
710 | ! unit(): [netcdf] variable's "units" attribute |
---|
711 | integer, intent(in) :: nbdim |
---|
712 | ! nbdim: number of dimensions of the variable |
---|
713 | integer, dimension(nbdim), intent(in) :: dim |
---|
714 | ! dim(nbdim): [netcdf] dimension(s) ID(s) |
---|
715 | integer, intent(out) :: nvarid |
---|
716 | ! nvarid: [netcdf] ID # of the variable |
---|
717 | integer, intent(out) :: ierr |
---|
718 | ! ierr: [netcdf] subroutines returned error code |
---|
719 | |
---|
720 | ! Switch to netcdf define mode |
---|
721 | ierr=NF_REDEF(nid) |
---|
722 | |
---|
723 | ! Insert the definition of the variable |
---|
724 | ierr=NF_DEF_VAR(nid,adjustl(name),NF_FLOAT,nbdim,dim,nvarid) |
---|
725 | |
---|
726 | ! Write the attributes |
---|
727 | ierr=NF_PUT_ATT_TEXT(nid,nvarid,"title",len_trim(adjustl(title)),adjustl(title)) |
---|
728 | ierr=NF_PUT_ATT_TEXT(nid,nvarid,"units",len_trim(adjustl(units)),adjustl(units)) |
---|
729 | |
---|
730 | ! End netcdf define mode |
---|
731 | ierr=NF_ENDDEF(nid) |
---|
732 | |
---|
733 | end subroutine def_var |
---|
734 | !************************************ |
---|
735 | subroutine sol2ls(sol,Ls) |
---|
736 | !============================================================================== |
---|
737 | ! Purpose: |
---|
738 | ! Convert a date/time, given in sol (martian day), |
---|
739 | ! into solar longitude date/time, in Ls (in degrees), |
---|
740 | ! where sol=0 is (by definition) the northern hemisphere |
---|
741 | ! spring equinox (where Ls=0). |
---|
742 | !============================================================================== |
---|
743 | ! Notes: |
---|
744 | ! Even though "Ls" is cyclic, if "sol" is greater than N (martian) year, |
---|
745 | ! "Ls" will be increased by N*360 |
---|
746 | ! Won't work as expected if sol is negative (then again, |
---|
747 | ! why would that ever happen?) |
---|
748 | !============================================================================== |
---|
749 | |
---|
750 | implicit none |
---|
751 | |
---|
752 | !============================================================================== |
---|
753 | ! Arguments: |
---|
754 | !============================================================================== |
---|
755 | real,intent(in) :: sol |
---|
756 | real,intent(out) :: Ls |
---|
757 | |
---|
758 | !============================================================================== |
---|
759 | ! Local variables: |
---|
760 | !============================================================================== |
---|
761 | real year_day,peri_day,timeperi,e_elips,twopi,degrad |
---|
762 | data year_day /669./ ! # of sols in a martian year |
---|
763 | data peri_day /485.0/ |
---|
764 | data timeperi /1.9082314/ |
---|
765 | data e_elips /0.093358/ |
---|
766 | data twopi /6.2831853/ ! 2.*pi |
---|
767 | data degrad /57.2957795/ ! pi/180 |
---|
768 | |
---|
769 | real zanom,xref,zx0,zdx,zteta,zz |
---|
770 | |
---|
771 | integer count_years |
---|
772 | integer iter |
---|
773 | |
---|
774 | !============================================================================== |
---|
775 | ! 1. Compute Ls |
---|
776 | !============================================================================== |
---|
777 | |
---|
778 | zz=(sol-peri_day)/year_day |
---|
779 | zanom=twopi*(zz-nint(zz)) |
---|
780 | xref=abs(zanom) |
---|
781 | |
---|
782 | ! The equation zx0 - e * sin (zx0) = xref, solved by Newton |
---|
783 | zx0=xref+e_elips*sin(xref) |
---|
784 | do iter=1,20 ! typically, 2 or 3 iterations are enough |
---|
785 | zdx=-(zx0-e_elips*sin(zx0)-xref)/(1.-e_elips*cos(zx0)) |
---|
786 | zx0=zx0+zdx |
---|
787 | if(abs(zdx).le.(1.e-7)) then |
---|
788 | ! write(*,*)'iter:',iter,' |zdx|:',abs(zdx) |
---|
789 | exit |
---|
790 | endif |
---|
791 | enddo |
---|
792 | |
---|
793 | if(zanom.lt.0.) zx0=-zx0 |
---|
794 | |
---|
795 | zteta=2.*atan(sqrt((1.+e_elips)/(1.-e_elips))*tan(zx0/2.)) |
---|
796 | Ls=zteta-timeperi |
---|
797 | |
---|
798 | if(Ls.lt.0.) then |
---|
799 | Ls=Ls+twopi |
---|
800 | else |
---|
801 | if(Ls.gt.twopi) then |
---|
802 | Ls=Ls-twopi |
---|
803 | endif |
---|
804 | endif |
---|
805 | |
---|
806 | Ls=degrad*Ls |
---|
807 | ! Ls is now in degrees |
---|
808 | |
---|
809 | !============================================================================== |
---|
810 | ! 1. Account for (eventual) years included in input date/time sol |
---|
811 | !============================================================================== |
---|
812 | |
---|
813 | count_years=0 ! initialize |
---|
814 | zz=sol ! use "zz" to store (and work on) the value of sol |
---|
815 | do while (zz.ge.year_day) |
---|
816 | count_years=count_years+1 |
---|
817 | zz=zz-year_day |
---|
818 | enddo |
---|
819 | |
---|
820 | ! Add 360 degrees to Ls for every year |
---|
821 | if (count_years.ne.0) then |
---|
822 | Ls=Ls+360.*count_years |
---|
823 | endif |
---|
824 | |
---|
825 | |
---|
826 | end subroutine sol2ls |
---|
827 | !************************************ |
---|
828 | |
---|
829 | Subroutine interpolf(x,y,xd,yd,nd) |
---|
830 | !interpolation, give y = f(x) with array xd,yd known, size nd |
---|
831 | ! Version with CONSTANT values oustide limits |
---|
832 | ! Variable declaration |
---|
833 | ! -------------------- |
---|
834 | ! Arguments : |
---|
835 | real x,y |
---|
836 | real xd(*),yd(*) |
---|
837 | integer nd |
---|
838 | ! internal |
---|
839 | integer i,j |
---|
840 | real y_undefined |
---|
841 | |
---|
842 | ! run |
---|
843 | ! --- |
---|
844 | y_undefined=1.e20 |
---|
845 | |
---|
846 | y=0. |
---|
847 | if ((x.le.xd(1)).and.(x.le.xd(nd))) then |
---|
848 | if (xd(1).lt.xd(nd)) y = yd(1) !y_undefined |
---|
849 | if (xd(1).ge.xd(nd)) y = y_undefined ! yd(nd) |
---|
850 | else if ((x.ge.xd(1)).and.(x.ge.xd(nd))) then |
---|
851 | if (xd(1).lt.xd(nd)) y = y_undefined ! yd(nd) |
---|
852 | if (xd(1).ge.xd(nd)) y = y_undefined ! yd(1) |
---|
853 | y = yd(nd) |
---|
854 | else |
---|
855 | do i=1,nd-1 |
---|
856 | if ( ( (x.ge.xd(i)).and.(x.lt.xd(i+1)) ).or.((x.le.xd(i)).and.(x.gt.xd(i+1))) ) then |
---|
857 | y=yd(i)+(x-xd(i))*(yd(i+1)-yd(i))/(xd(i+1)-xd(i)) |
---|
858 | goto 99 |
---|
859 | end if |
---|
860 | end do |
---|
861 | end if |
---|
862 | |
---|
863 | ! write (*,*)' x , y' , x,y |
---|
864 | ! do i=1,nd |
---|
865 | ! write (*,*)' i, xd , yd' ,i, xd(i),yd(i) |
---|
866 | ! end do |
---|
867 | ! stop |
---|
868 | |
---|
869 | 99 continue |
---|
870 | |
---|
871 | end subroutine interpolf |
---|
872 | |
---|
873 | end |
---|