1 |
MODULE histcom |
2 |
|
3 |
! From histcom.f90, version 2.1 2004/04/21 09:27:10 |
4 |
|
5 |
! Some confusing vocabulary in this code ! |
6 |
|
7 |
! A REGULAR grid is a grid which is i, j indices |
8 |
! and thus it is stored in a 2D matrix. |
9 |
! This is opposed to an IRREGULAR grid which is only in a vector |
10 |
! and where we do not know which neighbors we have. |
11 |
! As a consequence we need the bounds for each grid-cell. |
12 |
|
13 |
! A RECTILINEAR grid is a special case of a regular grid |
14 |
! in which all longitudes for i constant are equal |
15 |
! and all latitudes for j constant. |
16 |
! In other words we do not need the full 2D matrix |
17 |
! to describe the grid, just two vectors. |
18 |
|
19 |
IMPLICIT NONE |
20 |
|
21 |
PRIVATE |
22 |
PUBLIC:: histbeg_totreg, histdef, histhori_regular, histvert, histend, & |
23 |
histclo, histsync |
24 |
|
25 |
CONTAINS |
26 |
|
27 |
SUBROUTINE histbeg_totreg(pfilename, plon_1d, plat_1d, par_orix, par_szx, & |
28 |
par_oriy, par_szy, pitau0, pdate0, pdeltat, phoriid, pfileid) |
29 |
|
30 |
! The user provides "plon_1d" and "plat_1d" as vectors. Obviously |
31 |
! this can only be used for very regular grids. |
32 |
! This subroutine initializes a netcdf file and returns the ID. |
33 |
! It will set up the geographical space on which the data will be |
34 |
! stored and offers the possibility of seting a zoom. |
35 |
! It also gets the global parameters into the I/O subsystem. |
36 |
|
37 |
! INPUT |
38 |
|
39 |
! pfilename: Name of the netcdf file to be created |
40 |
! pim: Size of arrays in longitude direction |
41 |
! plon_1d: Coordinates of points in longitude |
42 |
! pjm: Size of arrays in latitude direction |
43 |
! plat_1d: Coordinates of points in latitude |
44 |
|
45 |
! The next 4 arguments allow to define a horizontal zoom |
46 |
! for this file. It is assumed that all variables to come |
47 |
! have the same index space. This can not be assumed for |
48 |
! the z axis and thus we define the zoom in histdef. |
49 |
|
50 |
! par_orix: Origin of the slab of data within the X axis (pim) |
51 |
! par_szx: Size of the slab of data in X |
52 |
! par_oriy: Origin of the slab of data within the Y axis (pjm) |
53 |
! par_szy: Size of the slab of data in Y |
54 |
|
55 |
! pitau0: time step at which the history tape starts |
56 |
! pdate0: The Julian date at which the itau was equal to 0 |
57 |
! pdeltat: Time step in seconds. Time step of the counter itau |
58 |
! used in histwrt for instance |
59 |
|
60 |
! OUTPUT |
61 |
|
62 |
! phoriid: ID of the horizontal grid |
63 |
! pfileid: ID of the netcdf file |
64 |
|
65 |
! We assume the grid is rectilinear. |
66 |
|
67 |
USE ioipslmpp, ONLY: ioipslmpp_file |
68 |
USE errioipsl, ONLY: histerr |
69 |
USE histcom_var, ONLY: assc_file, date0, deltat, full_size, itau0, & |
70 |
lock_modname, model_name, nb_files, nb_files_max, nb_hax, nb_tax, & |
71 |
nb_var, nb_zax, ncdf_ids, regular, slab_ori, slab_sz, xid, yid, zoom |
72 |
USE netcdf, ONLY: nf90_clobber, nf90_create, nf90_def_dim, & |
73 |
nf90_global, nf90_put_att |
74 |
|
75 |
CHARACTER (len=*), INTENT (IN):: pfilename |
76 |
REAL, DIMENSION (:), INTENT (IN):: plon_1d |
77 |
REAL, DIMENSION (:), INTENT (IN):: plat_1d |
78 |
INTEGER, INTENT (IN):: par_orix, par_szx, par_oriy, par_szy |
79 |
INTEGER, INTENT (IN):: pitau0 |
80 |
REAL, INTENT (IN):: pdate0, pdeltat |
81 |
INTEGER, INTENT (OUT):: pfileid, phoriid |
82 |
|
83 |
! Variables local to the procedure: |
84 |
REAL, DIMENSION (size(plon_1d), size(plat_1d)):: plon, plat |
85 |
INTEGER:: pim, pjm |
86 |
INTEGER:: ncid, iret |
87 |
INTEGER:: lengf, lenga |
88 |
CHARACTER (len=120):: file, tfile |
89 |
|
90 |
!--------------------------------------------------------------------- |
91 |
|
92 |
pim = size(plon_1d) |
93 |
pjm = size(plat_1d) |
94 |
|
95 |
plon = spread(plon_1d, 2, pjm) |
96 |
plat = spread(plat_1d, 1, pim) |
97 |
|
98 |
nb_files = nb_files + 1 |
99 |
pfileid = nb_files |
100 |
|
101 |
! 1.0 Transfering into the common for future use |
102 |
|
103 |
itau0(pfileid) = pitau0 |
104 |
date0(pfileid) = pdate0 |
105 |
deltat(pfileid) = pdeltat |
106 |
|
107 |
! 2.0 Initializes all variables for this file |
108 |
|
109 |
IF (nb_files>nb_files_max) THEN |
110 |
CALL histerr(3, 'histbeg', & |
111 |
'Table of files too small. You should increase nb_files_max', & |
112 |
'in M_HISTCOM.f90 in order to accomodate all these files', ' ') |
113 |
END IF |
114 |
|
115 |
nb_var(pfileid) = 0 |
116 |
nb_tax(pfileid) = 0 |
117 |
nb_hax(pfileid) = 0 |
118 |
nb_zax(pfileid) = 0 |
119 |
|
120 |
slab_ori(pfileid, 1:2) = (/ par_orix, par_oriy/) |
121 |
slab_sz(pfileid, 1:2) = (/ par_szx, par_szy/) |
122 |
|
123 |
! 3.0 Opening netcdf file and defining dimensions |
124 |
|
125 |
tfile = pfilename |
126 |
lengf = len_trim(tfile) |
127 |
IF (tfile(lengf-2:lengf)/='.nc') THEN |
128 |
file = tfile(1:lengf) // '.nc' |
129 |
ELSE |
130 |
file = tfile(1:lengf) |
131 |
END IF |
132 |
|
133 |
! Add PE number in file name on MPP |
134 |
|
135 |
CALL ioipslmpp_file(file) |
136 |
|
137 |
! Keep track of the name of the files opened |
138 |
|
139 |
lengf = len_trim(file) |
140 |
lenga = len_trim(assc_file) |
141 |
IF (nb_files==1) THEN |
142 |
assc_file = file(1:lengf) |
143 |
ELSE IF ((lenga+lengf)<500) THEN |
144 |
assc_file = assc_file(1:lenga) // ' ' // file(1:lengf) |
145 |
ELSE IF (((lenga+7)<500) .AND. (index(assc_file(1:lenga), & |
146 |
'et.al.')<1)) THEN |
147 |
assc_file = assc_file(1:lenga) // ' et.al.' |
148 |
ELSE |
149 |
CALL histerr(2, 'histbeg', & |
150 |
'The file names do not fit into the associate_file attribute.', & |
151 |
'Use shorter names if you wish to keep the information.', ' ') |
152 |
END IF |
153 |
|
154 |
iret = nf90_create(file, nf90_clobber, ncid) |
155 |
iret = nf90_def_dim(ncid, 'lon', par_szx, xid(nb_files)) |
156 |
iret = nf90_def_dim(ncid, 'lat', par_szy, yid(nb_files)) |
157 |
|
158 |
! 4.0 Declaring the geographical coordinates and other attributes |
159 |
|
160 |
! 4.3 Global attributes |
161 |
|
162 |
iret = nf90_put_att(ncid, nf90_global, 'Conventions', 'GDT 1.3') |
163 |
iret = nf90_put_att(ncid, nf90_global, 'file_name', trim(file)) |
164 |
iret = nf90_put_att(ncid, nf90_global, 'production', trim(model_name)) |
165 |
lock_modname = .TRUE. |
166 |
|
167 |
! 5.0 Saving some important information on this file in the common |
168 |
|
169 |
ncdf_ids(pfileid) = ncid |
170 |
full_size(pfileid, 1:2) = (/ pim, pjm/) |
171 |
|
172 |
! 6.0 storing the geographical coordinates |
173 |
|
174 |
IF ((pim/=par_szx) .OR. (pjm/=par_szy)) zoom(pfileid) = .TRUE. |
175 |
regular(pfileid) = .TRUE. |
176 |
|
177 |
CALL histhori_regular(pfileid, pim, plon, pjm, plat, ' ', 'Default grid', & |
178 |
phoriid) |
179 |
|
180 |
END SUBROUTINE histbeg_totreg |
181 |
|
182 |
!********************************** |
183 |
|
184 |
SUBROUTINE histhori_regular(pfileid, pim, plon, pjm, plat, phname, phtitle, & |
185 |
phid) |
186 |
|
187 |
! This subroutine is made to declare a new horizontale grid. |
188 |
! It has to have the same number of points as |
189 |
! the original Thus in this we routine we will only |
190 |
! add two variable (longitude and latitude). |
191 |
! Any variable in the file can thus point to this pair |
192 |
! through an attribute. This routine is very usefull |
193 |
! to allow staggered grids. |
194 |
|
195 |
! INPUT |
196 |
|
197 |
! pfileid: The id of the file to which the grid should be added |
198 |
! pim: Size in the longitude direction |
199 |
! plon: The longitudes |
200 |
! pjm: Size in the latitude direction |
201 |
! plat: The latitudes |
202 |
! phname: The name of grid |
203 |
! phtitle: The title of the grid |
204 |
|
205 |
! OUTPUT |
206 |
|
207 |
! phid: Id of the created grid |
208 |
|
209 |
! We assume that the grid is rectilinear. |
210 |
|
211 |
USE errioipsl, ONLY: histerr |
212 |
USE histcom_var, ONLY: full_size, hax_name, nb_hax, ncdf_ids, & |
213 |
slab_ori, slab_sz, xid, yid |
214 |
USE netcdf, ONLY: nf90_def_var, nf90_enddef, nf90_float, & |
215 |
nf90_put_att, nf90_put_var, nf90_redef |
216 |
|
217 |
INTEGER, INTENT (IN):: pfileid, pim, pjm |
218 |
REAL, INTENT (IN), DIMENSION (pim, pjm):: plon, plat |
219 |
CHARACTER (len=*), INTENT (IN):: phname, phtitle |
220 |
INTEGER, INTENT (OUT):: phid |
221 |
|
222 |
CHARACTER (len=25):: lon_name, lat_name |
223 |
CHARACTER (len=80):: tmp_title, tmp_name |
224 |
INTEGER:: ndim |
225 |
INTEGER, DIMENSION (2):: dims(2) |
226 |
INTEGER:: nlonid, nlatid |
227 |
INTEGER:: orix, oriy, par_szx, par_szy |
228 |
INTEGER:: iret, ncid |
229 |
|
230 |
!--------------------------------------------------------------------- |
231 |
|
232 |
! 1.0 Check that all fits in the buffers |
233 |
|
234 |
IF ((pim/=full_size(pfileid, 1)) .OR. (pjm/=full_size(pfileid, 2))) THEN |
235 |
CALL histerr(3, 'histhori', & |
236 |
'The new horizontal grid does not have the same size', & |
237 |
'as the one provided to histbeg. This is not yet ', & |
238 |
'possible in the hist package.') |
239 |
END IF |
240 |
|
241 |
! 1.1 Create all the variables needed |
242 |
|
243 |
ncid = ncdf_ids(pfileid) |
244 |
|
245 |
ndim = 2 |
246 |
dims(1:2) = (/ xid(pfileid), yid(pfileid) /) |
247 |
|
248 |
tmp_name = phname |
249 |
IF (nb_hax(pfileid)==0) THEN |
250 |
lon_name = 'lon' |
251 |
lat_name = 'lat' |
252 |
ELSE |
253 |
lon_name = 'lon_' // trim(tmp_name) |
254 |
lat_name = 'lat_' // trim(tmp_name) |
255 |
END IF |
256 |
|
257 |
! 1.2 Save the informations |
258 |
|
259 |
phid = nb_hax(pfileid) + 1 |
260 |
nb_hax(pfileid) = phid |
261 |
|
262 |
hax_name(pfileid, phid, 1:2) = (/ lon_name, lat_name/) |
263 |
tmp_title = phtitle |
264 |
|
265 |
! 2.0 Longitude |
266 |
|
267 |
ndim = 1 |
268 |
dims(1:1) = (/ xid(pfileid) /) |
269 |
|
270 |
iret = nf90_def_var(ncid, lon_name, nf90_float, dims(1:ndim), nlonid) |
271 |
iret = nf90_put_att(ncid, nlonid, 'units', 'degrees_east') |
272 |
iret = nf90_put_att(ncid, nlonid, 'valid_min', real(minval(plon))) |
273 |
iret = nf90_put_att(ncid, nlonid, 'valid_max', real(maxval(plon))) |
274 |
iret = nf90_put_att(ncid, nlonid, 'long_name', 'Longitude') |
275 |
iret = nf90_put_att(ncid, nlonid, 'nav_model', trim(tmp_title)) |
276 |
|
277 |
! 3.0 Latitude |
278 |
|
279 |
ndim = 1 |
280 |
dims(1:1) = (/ yid(pfileid) /) |
281 |
|
282 |
iret = nf90_def_var(ncid, lat_name, nf90_float, dims(1:ndim), nlatid) |
283 |
iret = nf90_put_att(ncid, nlatid, 'units', 'degrees_north') |
284 |
iret = nf90_put_att(ncid, nlatid, 'valid_min', real(minval(plat))) |
285 |
iret = nf90_put_att(ncid, nlatid, 'valid_max', real(maxval(plat))) |
286 |
iret = nf90_put_att(ncid, nlatid, 'long_name', 'Latitude') |
287 |
iret = nf90_put_att(ncid, nlatid, 'nav_model', trim(tmp_title)) |
288 |
|
289 |
iret = nf90_enddef(ncid) |
290 |
|
291 |
! 4.0 storing the geographical coordinates |
292 |
|
293 |
orix = slab_ori(pfileid, 1) |
294 |
oriy = slab_ori(pfileid, 2) |
295 |
par_szx = slab_sz(pfileid, 1) |
296 |
par_szy = slab_sz(pfileid, 2) |
297 |
|
298 |
! Transfer the longitude |
299 |
|
300 |
iret = nf90_put_var(ncid, nlonid, plon(1:par_szx, 1)) |
301 |
|
302 |
! Transfer the latitude |
303 |
|
304 |
iret = nf90_put_var(ncid, nlatid, plat(1, 1:par_szy)) |
305 |
|
306 |
iret = nf90_redef(ncid) |
307 |
|
308 |
END SUBROUTINE histhori_regular |
309 |
|
310 |
!********************************** |
311 |
|
312 |
SUBROUTINE histvert(pfileid, pzaxname, pzaxtitle, pzaxunit, pzsize, pzvalues, & |
313 |
pzaxid, pdirect) |
314 |
|
315 |
! This subroutine defines a vertical axis and returns it s id. |
316 |
! It gives the user the possibility to the user to define many |
317 |
! different vertical axes. For each variable defined with histdef a |
318 |
! vertical axis can be specified with by it s ID. |
319 |
|
320 |
! INPUT |
321 |
|
322 |
! pfileid: ID of the file the variable should be archived in |
323 |
! pzaxname: Name of the vertical axis |
324 |
! pzaxtitle: title of the vertical axis |
325 |
! pzaxunit: Units of the vertical axis |
326 |
! pzsize: size of the vertical axis |
327 |
! pzvalues: Coordinate values of the vetical axis |
328 |
|
329 |
! pdirect: is an optional argument which allows to specify the |
330 |
! the positive direction of the axis: up or down. |
331 |
! OUTPUT |
332 |
|
333 |
! pzaxid: Returns the ID of the axis. |
334 |
! Note that this is not the netCDF ID ! |
335 |
|
336 |
USE stringop, ONLY: find_str, strlowercase |
337 |
USE stringop, ONLY: find_str, strlowercase |
338 |
USE errioipsl, ONLY: histerr |
339 |
USE histcom_var, ONLY: nb_zax, nb_zax_max, ncdf_ids, zax_ids, & |
340 |
zax_name, zax_name_length, zax_size |
341 |
USE netcdf, ONLY: nf90_def_dim, nf90_def_var, nf90_enddef, & |
342 |
nf90_float, nf90_put_att, nf90_put_var, nf90_redef |
343 |
|
344 |
INTEGER, INTENT (IN):: pfileid, pzsize |
345 |
CHARACTER (len=*), INTENT (IN):: pzaxname, pzaxunit, pzaxtitle |
346 |
REAL, INTENT (IN):: pzvalues(pzsize) |
347 |
INTEGER, INTENT (OUT):: pzaxid |
348 |
CHARACTER (len=*), INTENT (IN), OPTIONAL:: pdirect |
349 |
|
350 |
INTEGER:: pos, iv, nb, zdimid, zaxid_tmp |
351 |
CHARACTER (len=20):: str20, tab_str20(nb_zax_max) |
352 |
INTEGER:: tab_str20_length(nb_zax_max) |
353 |
CHARACTER (len=70):: str70, str71, str72 |
354 |
CHARACTER (len=80):: str80 |
355 |
CHARACTER (len=20):: direction |
356 |
INTEGER:: iret, leng, ncid |
357 |
|
358 |
!--------------------------------------------------------------------- |
359 |
|
360 |
! 1.0 Verifications: |
361 |
! Do we have enough space for an extra axis ? |
362 |
! Is the name already in use ? |
363 |
|
364 |
! - Direction of axis. Can we get if from the user. |
365 |
! If not we put unknown. |
366 |
|
367 |
IF (present(pdirect)) THEN |
368 |
direction = trim(pdirect) |
369 |
CALL strlowercase(direction) |
370 |
ELSE |
371 |
direction = 'unknown' |
372 |
END IF |
373 |
|
374 |
! Check the consistency of the attribute |
375 |
|
376 |
IF ((direction/='unknown') .AND. (direction/='up') .AND. & |
377 |
(direction/='down')) THEN |
378 |
direction = 'unknown' |
379 |
str80 = 'The specified axis was: ' // trim(direction) |
380 |
CALL histerr(2, 'histvert', & |
381 |
'The specified direction for the vertical axis is not possible.', & |
382 |
'it is replaced by: unknown', str80) |
383 |
END IF |
384 |
|
385 |
IF (nb_zax(pfileid)+1>nb_zax_max) THEN |
386 |
CALL histerr(3, 'histvert', & |
387 |
'Table of vertical axes too small. You should increase ', & |
388 |
'nb_zax_max in M_HISTCOM.f90 in order to accomodate all ', & |
389 |
'these variables ') |
390 |
END IF |
391 |
|
392 |
iv = nb_zax(pfileid) |
393 |
IF (iv>1) THEN |
394 |
str20 = pzaxname |
395 |
nb = iv - 1 |
396 |
tab_str20(1:nb) = zax_name(pfileid, 1:nb) |
397 |
tab_str20_length(1:nb) = zax_name_length(pfileid, 1:nb) |
398 |
CALL find_str(nb, tab_str20, tab_str20_length, str20, pos) |
399 |
ELSE |
400 |
pos = 0 |
401 |
END IF |
402 |
|
403 |
IF (pos>0) THEN |
404 |
str70 = 'Vertical axis already exists' |
405 |
WRITE (str71, '("Check variable ", a, " in file", I3)') str20, & |
406 |
pfileid |
407 |
str72 = 'Can also be a wrong file ID in another declaration' |
408 |
CALL histerr(3, 'histvert', str70, str71, str72) |
409 |
END IF |
410 |
|
411 |
iv = nb_zax(pfileid) + 1 |
412 |
|
413 |
! 2.0 Add the information to the file |
414 |
|
415 |
ncid = ncdf_ids(pfileid) |
416 |
|
417 |
leng = min(len_trim(pzaxname), 20) |
418 |
iret = nf90_def_dim(ncid, pzaxname(1:leng), pzsize, zaxid_tmp) |
419 |
iret = nf90_def_var(ncid, pzaxname(1:leng), nf90_float, zaxid_tmp, zdimid) |
420 |
|
421 |
leng = min(len_trim(pzaxunit), 20) |
422 |
iret = nf90_put_att(ncid, zdimid, 'units', pzaxunit(1:leng)) |
423 |
iret = nf90_put_att(ncid, zdimid, 'positive', trim(direction)) |
424 |
|
425 |
iret = nf90_put_att(ncid, zdimid, 'valid_min', real(minval( & |
426 |
pzvalues(1:pzsize)))) |
427 |
iret = nf90_put_att(ncid, zdimid, 'valid_max', real(maxval( & |
428 |
pzvalues(1:pzsize)))) |
429 |
|
430 |
leng = min(len_trim(pzaxname), 20) |
431 |
iret = nf90_put_att(ncid, zdimid, 'title', pzaxname(1:leng)) |
432 |
leng = min(len_trim(pzaxtitle), 80) |
433 |
iret = nf90_put_att(ncid, zdimid, 'long_name', pzaxtitle(1:leng)) |
434 |
|
435 |
iret = nf90_enddef(ncid) |
436 |
|
437 |
iret = nf90_put_var(ncid, zdimid, pzvalues(1:pzsize)) |
438 |
|
439 |
iret = nf90_redef(ncid) |
440 |
|
441 |
! 3.0 add the information to the common |
442 |
|
443 |
nb_zax(pfileid) = iv |
444 |
zax_size(pfileid, iv) = pzsize |
445 |
zax_name(pfileid, iv) = pzaxname |
446 |
zax_name_length(pfileid, iv) = len_trim(pzaxname) |
447 |
zax_ids(pfileid, iv) = zaxid_tmp |
448 |
pzaxid = iv |
449 |
|
450 |
END SUBROUTINE histvert |
451 |
|
452 |
!********************************** |
453 |
|
454 |
SUBROUTINE histdef(pfileid, pvarname, ptitle, punit, pxsize, pysize, phoriid, & |
455 |
pzsize, par_oriz, par_szz, pzid, popp, pfreq_opp, pfreq_wrt) |
456 |
|
457 |
! With this subroutine each variable to be archived on the history |
458 |
! tape should be declared. |
459 |
|
460 |
! It gives the user the choise of operation |
461 |
! to be performed on the variables, the frequency of this operation |
462 |
! and finaly the frequency of the archiving. |
463 |
|
464 |
USE stringop, ONLY: find_str |
465 |
USE mathelp, ONLY: buildop |
466 |
USE errioipsl, ONLY: histerr |
467 |
USE histcom_var, ONLY: buff_pos, deltat, freq_opp, freq_wrt, fullop, & |
468 |
full_size, itau0, last_opp, last_opp_chk, last_wrt, last_wrt_chk, & |
469 |
missing_val, name, name_length, nbopp, nbopp_max, nb_hax, nb_opp, & |
470 |
nb_tax, nb_var, nb_var_max, nb_wrt, nb_zax, point, scal, scsize, & |
471 |
slab_ori, slab_sz, sopps, tax_last, tax_name, tax_name_length, & |
472 |
title, topp, unit_name, var_axid, var_haxid, var_zaxid, zax_name, & |
473 |
zax_size, zorig, zsize |
474 |
USE calendar, ONLY: ioget_calendar |
475 |
|
476 |
INTEGER, INTENT (IN):: pfileid |
477 |
! (ID of the file the variable should be archived in) |
478 |
|
479 |
CHARACTER (len=*), INTENT (IN):: pvarname |
480 |
! (Name of the variable, short and easy to remember) |
481 |
|
482 |
CHARACTER (len=*), INTENT (IN):: ptitle ! Full name of the variable |
483 |
CHARACTER (len=*), INTENT (IN):: punit ! Units of the variable |
484 |
|
485 |
! The next 3 arguments give the size of that data |
486 |
! that will be passed to histwrite. The zoom will be |
487 |
! done there with the horizontal information obtained |
488 |
! in "histbeg" and the vertical information to follow. |
489 |
INTEGER, INTENT (IN):: pxsize, pysize ! Sizes in X and Y directions |
490 |
INTEGER, INTENT (IN):: phoriid ! ID of the horizontal axis |
491 |
|
492 |
! The next two arguments give the vertical zoom to use. |
493 |
|
494 |
INTEGER, INTENT (IN):: pzsize |
495 |
! (Size in Z direction (If 1 then no axis is declared for this |
496 |
! variable and pzid is not used) |
497 |
|
498 |
INTEGER, INTENT (IN):: par_oriz ! Off set of the zoom |
499 |
INTEGER, INTENT (IN):: par_szz ! Size of the zoom |
500 |
|
501 |
INTEGER, INTENT (IN):: pzid |
502 |
! (ID of the vertical axis to use. It has to have the size of the zoom.) |
503 |
|
504 |
CHARACTER (len=*), INTENT (IN):: popp |
505 |
! Operation to be performed. The following options exist today: |
506 |
! inst: keeps instantaneous values for writting |
507 |
! ave: Computes the average from call between writes |
508 |
|
509 |
REAL, INTENT (IN):: pfreq_opp ! Frequency of this operation (in seconds) |
510 |
|
511 |
REAL, INTENT (IN):: pfreq_wrt |
512 |
! (Frequency at which the variable should be written, in seconds) |
513 |
|
514 |
INTEGER:: iv, i, nb |
515 |
CHARACTER (len=70):: str70, str71, str72 |
516 |
CHARACTER (len=20):: tmp_name |
517 |
CHARACTER (len=20):: str20, tab_str20(nb_var_max) |
518 |
INTEGER:: tab_str20_length(nb_var_max) |
519 |
CHARACTER (len=40):: str40, tab_str40(nb_var_max) |
520 |
INTEGER:: tab_str40_length(nb_var_max) |
521 |
CHARACTER (len=10):: str10 |
522 |
CHARACTER (len=80):: tmp_str80 |
523 |
CHARACTER (len=7):: tmp_topp, tmp_sopp(nbopp_max) |
524 |
CHARACTER (len=120):: ex_topps |
525 |
REAL:: tmp_scal(nbopp_max), un_an, un_jour, test_fopp, test_fwrt |
526 |
INTEGER:: pos, buff_sz |
527 |
|
528 |
!--------------------------------------------------------------------- |
529 |
ex_topps = 'ave, inst, t_min, t_max, t_sum, once, never, l_max, l_min' |
530 |
|
531 |
nb_var(pfileid) = nb_var(pfileid) + 1 |
532 |
iv = nb_var(pfileid) |
533 |
|
534 |
IF (iv>nb_var_max) THEN |
535 |
CALL histerr(3, 'histdef', & |
536 |
'Table of variables too small. You should increase nb_var_max', & |
537 |
'in M_HISTCOM.f90 in order to accomodate all these variables', ' ') |
538 |
END IF |
539 |
|
540 |
! 1.0 Transfer informations on the variable to the common |
541 |
! and verify that it does not already exist |
542 |
|
543 |
IF (iv>1) THEN |
544 |
str20 = pvarname |
545 |
nb = iv - 1 |
546 |
tab_str20(1:nb) = name(pfileid, 1:nb) |
547 |
tab_str20_length(1:nb) = name_length(pfileid, 1:nb) |
548 |
CALL find_str(nb, tab_str20, tab_str20_length, str20, pos) |
549 |
ELSE |
550 |
pos = 0 |
551 |
END IF |
552 |
|
553 |
IF (pos>0) THEN |
554 |
str70 = 'Variable already exists' |
555 |
WRITE (str71, '("Check variable ", a, " in file", I3)') str20, & |
556 |
pfileid |
557 |
str72 = 'Can also be a wrong file ID in another declaration' |
558 |
CALL histerr(3, 'histdef', str70, str71, str72) |
559 |
END IF |
560 |
|
561 |
name(pfileid, iv) = pvarname |
562 |
name_length(pfileid, iv) = len_trim(name(pfileid, iv)) |
563 |
title(pfileid, iv) = ptitle |
564 |
unit_name(pfileid, iv) = punit |
565 |
tmp_name = name(pfileid, iv) |
566 |
|
567 |
! 1.1 decode the operations |
568 |
|
569 |
fullop(pfileid, iv) = popp |
570 |
tmp_str80 = popp |
571 |
CALL buildop(tmp_str80, ex_topps, tmp_topp, nbopp_max, missing_val, & |
572 |
tmp_sopp, tmp_scal, nbopp(pfileid, iv)) |
573 |
|
574 |
topp(pfileid, iv) = tmp_topp |
575 |
DO i = 1, nbopp(pfileid, iv) |
576 |
sopps(pfileid, iv, i) = tmp_sopp(i) |
577 |
scal(pfileid, iv, i) = tmp_scal(i) |
578 |
END DO |
579 |
|
580 |
! 1.2 If we have an even number of operations |
581 |
! then we need to add identity |
582 |
|
583 |
IF (2*int(nbopp(pfileid, iv)/2.0)==nbopp(pfileid, iv)) THEN |
584 |
nbopp(pfileid, iv) = nbopp(pfileid, iv) + 1 |
585 |
sopps(pfileid, iv, nbopp(pfileid, iv)) = 'ident' |
586 |
scal(pfileid, iv, nbopp(pfileid, iv)) = missing_val |
587 |
END IF |
588 |
|
589 |
! 2.0 Put the size of the variable in the common and check |
590 |
|
591 |
scsize(pfileid, iv, :) = (/ pxsize, pysize, pzsize/) |
592 |
|
593 |
zorig(pfileid, iv, 1:3) = (/ slab_ori(pfileid, 1), slab_ori(pfileid, 2), & |
594 |
par_oriz/) |
595 |
|
596 |
zsize(pfileid, iv, 1:3) = (/ slab_sz(pfileid, 1), slab_sz(pfileid, 2), & |
597 |
par_szz/) |
598 |
|
599 |
! Is the size of the full array the same as that of the coordinates ? |
600 |
|
601 |
IF ((pxsize>full_size(pfileid, 1)) .OR. (pysize>full_size(pfileid, & |
602 |
2))) THEN |
603 |
|
604 |
str70 = 'The size of the variable is different ' // & |
605 |
'from the one of the coordinates' |
606 |
WRITE (str71, '("Size of coordinates:", 2I4)') full_size(pfileid, 1), & |
607 |
full_size(pfileid, 2) |
608 |
WRITE (str72, '("Size declared for variable ", a, ":", 2I4)') & |
609 |
trim(tmp_name), pxsize, pysize |
610 |
CALL histerr(3, 'histdef', str70, str71, str72) |
611 |
END IF |
612 |
|
613 |
! Is the size of the zoom smaler than the coordinates ? |
614 |
|
615 |
IF ((full_size(pfileid, 1)<slab_sz(pfileid, 1)) .OR. (full_size(pfileid, & |
616 |
2)<slab_sz(pfileid, 2))) THEN |
617 |
str70 = 'Size of variable should be greater or equal & |
618 |
&to those of the zoom' |
619 |
WRITE (str71, '("Size of XY zoom:", 2I4)') slab_sz(pfileid, 1), & |
620 |
slab_sz(pfileid, 1) |
621 |
WRITE (str72, '("Size declared for variable ", a, ":", 2I4)') & |
622 |
trim(tmp_name), pxsize, pysize |
623 |
CALL histerr(3, 'histdef', str70, str71, str72) |
624 |
END IF |
625 |
|
626 |
! 2.1 We store the horizontal grid information with minimal |
627 |
! and a fall back onto the default grid |
628 |
|
629 |
IF (phoriid>0 .AND. phoriid<=nb_hax(pfileid)) THEN |
630 |
var_haxid(pfileid, iv) = phoriid |
631 |
ELSE |
632 |
var_haxid(pfileid, iv) = 1 |
633 |
CALL histerr(2, 'histdef', & |
634 |
'We use the default grid for variable as an invalide', & |
635 |
'ID was provided for variable: ', pvarname) |
636 |
END IF |
637 |
|
638 |
! 2.2 Check the vertical coordinates if needed |
639 |
|
640 |
IF (par_szz>1) THEN |
641 |
|
642 |
! Does the vertical coordinate exist ? |
643 |
|
644 |
IF (pzid>nb_zax(pfileid)) THEN |
645 |
WRITE (str70, '("The vertical coordinate chosen for variable ", a)' & |
646 |
) trim(tmp_name) |
647 |
str71 = ' Does not exist.' |
648 |
CALL histerr(3, 'histdef', str70, str71, ' ') |
649 |
END IF |
650 |
|
651 |
! Is the vertical size of the variable equal to that of the axis ? |
652 |
|
653 |
IF (par_szz/=zax_size(pfileid, pzid)) THEN |
654 |
str20 = zax_name(pfileid, pzid) |
655 |
str70 = 'The size of the zoom does not correspond ' // & |
656 |
'to the size of the chosen vertical axis' |
657 |
WRITE (str71, '("Size of zoom in z:", I4)') par_szz |
658 |
WRITE (str72, '("Size declared for axis ", a, ":", I4)') & |
659 |
trim(str20), zax_size(pfileid, pzid) |
660 |
CALL histerr(3, 'histdef', str70, str71, str72) |
661 |
END IF |
662 |
|
663 |
! Is the zoom smaler that the total size of the variable ? |
664 |
|
665 |
IF (pzsize<par_szz) THEN |
666 |
str20 = zax_name(pfileid, pzid) |
667 |
str70 = 'The vertical size of variable ' // & |
668 |
'is smaller than that of the zoom.' |
669 |
WRITE (str71, '("Declared vertical size of data:", I5)') pzsize |
670 |
WRITE (str72, '("Size of zoom for variable ", a, " = ", I5)') & |
671 |
trim(tmp_name), par_szz |
672 |
CALL histerr(3, 'histdef', str70, str71, str72) |
673 |
END IF |
674 |
var_zaxid(pfileid, iv) = pzid |
675 |
ELSE |
676 |
var_zaxid(pfileid, iv) = -99 |
677 |
END IF |
678 |
|
679 |
! 3.0 Determine the position of the variable in the buffer |
680 |
! If it is instantaneous output then we do not use the buffer |
681 |
|
682 |
! 3.1 We get the size of the arrays histwrite will get and check |
683 |
! that they fit into the tmp_buffer |
684 |
|
685 |
buff_sz = zsize(pfileid, iv, 1)*zsize(pfileid, iv, 2)*zsize(pfileid, iv, 3) |
686 |
|
687 |
! 3.2 move the pointer of the buffer array for operation |
688 |
! which need bufferisation |
689 |
|
690 |
IF ((trim(tmp_topp)/='inst') .AND. (trim(tmp_topp)/='once') .AND. ( & |
691 |
trim(tmp_topp)/='never')) THEN |
692 |
point(pfileid, iv) = buff_pos + 1 |
693 |
buff_pos = buff_pos + buff_sz |
694 |
END IF |
695 |
|
696 |
! 4.0 Transfer the frequency of the operations and check |
697 |
! for validity. We have to pay attention to negative values |
698 |
! of the frequency which indicate monthly time-steps. |
699 |
! The strategy is to bring it back to seconds for the tests |
700 |
|
701 |
freq_opp(pfileid, iv) = pfreq_opp |
702 |
freq_wrt(pfileid, iv) = pfreq_wrt |
703 |
|
704 |
CALL ioget_calendar(un_an, un_jour) |
705 |
IF (pfreq_opp<0) THEN |
706 |
CALL ioget_calendar(un_an) |
707 |
test_fopp = pfreq_opp*(-1.)*un_an/12.*un_jour |
708 |
ELSE |
709 |
test_fopp = pfreq_opp |
710 |
END IF |
711 |
IF (pfreq_wrt<0) THEN |
712 |
CALL ioget_calendar(un_an) |
713 |
test_fwrt = pfreq_wrt*(-1.)*un_an/12.*un_jour |
714 |
ELSE |
715 |
test_fwrt = pfreq_wrt |
716 |
END IF |
717 |
|
718 |
! 4.1 Frequency of operations and output should be larger than deltat ! |
719 |
|
720 |
IF (test_fopp<deltat(pfileid)) THEN |
721 |
str70 = 'Frequency of operations should be larger than deltat' |
722 |
WRITE (str71, '("It is not the case for variable ", a, ":", F10.4)') & |
723 |
trim(tmp_name), pfreq_opp |
724 |
str72 = 'PATCH: frequency set to deltat' |
725 |
|
726 |
CALL histerr(2, 'histdef', str70, str71, str72) |
727 |
|
728 |
freq_opp(pfileid, iv) = deltat(pfileid) |
729 |
END IF |
730 |
|
731 |
IF (test_fwrt<deltat(pfileid)) THEN |
732 |
str70 = 'Frequency of output should be larger than deltat' |
733 |
WRITE (str71, '("It is not the case for variable ", a, ":", F10.4)') & |
734 |
trim(tmp_name), pfreq_wrt |
735 |
str72 = 'PATCH: frequency set to deltat' |
736 |
|
737 |
CALL histerr(2, 'histdef', str70, str71, str72) |
738 |
|
739 |
freq_wrt(pfileid, iv) = deltat(pfileid) |
740 |
END IF |
741 |
|
742 |
! 4.2 First the existence of the operation is tested and then |
743 |
! its compaticility with the choice of frequencies |
744 |
|
745 |
IF (trim(tmp_topp)=='inst') THEN |
746 |
IF (test_fopp/=test_fwrt) THEN |
747 |
str70 = 'For instantaneous output the frequency ' // & |
748 |
'of operations and output' |
749 |
WRITE (str71, & |
750 |
'("should be the same, this was not case for variable ", a)') & |
751 |
trim(tmp_name) |
752 |
str72 = 'PATCH: The smalest frequency of both is used' |
753 |
CALL histerr(2, 'histdef', str70, str71, str72) |
754 |
IF (test_fopp<test_fwrt) THEN |
755 |
freq_opp(pfileid, iv) = pfreq_opp |
756 |
freq_wrt(pfileid, iv) = pfreq_opp |
757 |
ELSE |
758 |
freq_opp(pfileid, iv) = pfreq_wrt |
759 |
freq_wrt(pfileid, iv) = pfreq_wrt |
760 |
END IF |
761 |
END IF |
762 |
ELSE IF (index(ex_topps, trim(tmp_topp))>0) THEN |
763 |
IF (test_fopp>test_fwrt) THEN |
764 |
str70 = 'For averages the frequency of operations ' // & |
765 |
'should be smaller or equal' |
766 |
WRITE (str71, & |
767 |
'("to that of output. It is not the case for variable ", a)') & |
768 |
trim(tmp_name) |
769 |
str72 = 'PATCH: The output frequency is used for both' |
770 |
CALL histerr(2, 'histdef', str70, str71, str72) |
771 |
freq_opp(pfileid, iv) = pfreq_wrt |
772 |
END IF |
773 |
ELSE |
774 |
WRITE (str70, '("Operation on variable ", a, " is unknown")') & |
775 |
trim(tmp_name) |
776 |
WRITE (str71, '("operation requested is:", a)') tmp_topp |
777 |
WRITE (str72, '("File ID:", I3)') pfileid |
778 |
CALL histerr(3, 'histdef', str70, str71, str72) |
779 |
END IF |
780 |
|
781 |
! 5.0 Initialize other variables of the common |
782 |
|
783 |
last_opp(pfileid, iv) = itau0(pfileid) |
784 |
! - freq_opp(pfileid, iv)/2./deltat(pfileid) |
785 |
last_wrt(pfileid, iv) = itau0(pfileid) |
786 |
! - freq_wrt(pfileid, iv)/2./deltat(pfileid) |
787 |
last_opp_chk(pfileid, iv) = itau0(pfileid) |
788 |
! - freq_opp(pfileid, iv)/2./deltat(pfileid) |
789 |
last_wrt_chk(pfileid, iv) = itau0(pfileid) |
790 |
! - freq_wrt(pfileid, iv)/2./deltat(pfileid) |
791 |
nb_opp(pfileid, iv) = 0 |
792 |
nb_wrt(pfileid, iv) = 0 |
793 |
|
794 |
! 6.0 Get the time axis for this variable |
795 |
|
796 |
IF (freq_wrt(pfileid, iv)>0) THEN |
797 |
WRITE (str10, '(I8.8)') int(freq_wrt(pfileid, iv)) |
798 |
str40 = trim(tmp_topp) // '_' // trim(str10) |
799 |
ELSE |
800 |
WRITE (str10, '(I2.2, "month")') abs(int(freq_wrt(pfileid, iv))) |
801 |
str40 = trim(tmp_topp) // '_' // trim(str10) |
802 |
END IF |
803 |
|
804 |
DO i = 1, nb_tax(pfileid) |
805 |
tab_str40(i) = tax_name(pfileid, i) |
806 |
tab_str40_length(i) = tax_name_length(pfileid, i) |
807 |
END DO |
808 |
|
809 |
CALL find_str(nb_tax(pfileid), tab_str40, tab_str40_length, str40, pos) |
810 |
|
811 |
! No time axis for once, l_max, l_min or never operation |
812 |
|
813 |
IF ((trim(tmp_topp)/='once') .AND. (trim(tmp_topp)/='never') .AND. ( & |
814 |
trim(tmp_topp)/='l_max') .AND. (trim(tmp_topp)/='l_min')) THEN |
815 |
IF (pos<0) THEN |
816 |
nb_tax(pfileid) = nb_tax(pfileid) + 1 |
817 |
tax_name(pfileid, nb_tax(pfileid)) = str40 |
818 |
tax_name_length(pfileid, nb_tax(pfileid)) = len_trim(str40) |
819 |
tax_last(pfileid, nb_tax(pfileid)) = 0 |
820 |
var_axid(pfileid, iv) = nb_tax(pfileid) |
821 |
ELSE |
822 |
var_axid(pfileid, iv) = pos |
823 |
END IF |
824 |
ELSE |
825 |
var_axid(pfileid, iv) = -99 |
826 |
END IF |
827 |
|
828 |
! 7.0 prepare frequence of writing and operation |
829 |
! for never or once operation |
830 |
|
831 |
IF ((trim(tmp_topp)=='once') .OR. (trim(tmp_topp)=='never')) THEN |
832 |
freq_opp(pfileid, iv) = 0. |
833 |
freq_wrt(pfileid, iv) = 0. |
834 |
END IF |
835 |
|
836 |
END SUBROUTINE histdef |
837 |
|
838 |
!********************************** |
839 |
|
840 |
SUBROUTINE histend(pfileid) |
841 |
|
842 |
! This subroutine ends the declaration of variables and sets the |
843 |
! time axes in the netcdf file and puts it into write mode. |
844 |
|
845 |
! INPUT |
846 |
|
847 |
! pfileid: ID of the file to be worked on |
848 |
|
849 |
USE ioipslmpp, ONLY: ioipslmpp_addatt |
850 |
USE errioipsl, ONLY: histerr |
851 |
USE histcom_var, ONLY: date0, freq_opp, freq_wrt, fullop, & |
852 |
missing_val, name, nb_tax, nb_var, ncdf_ids, ncvar_ids, regular, & |
853 |
tax_name, tdimid, tid, title, topp, unit_name, var_axid, var_zaxid, & |
854 |
xid, yid, zax_ids, zax_name |
855 |
USE calendar, ONLY: ioget_calendar, ju2ymds |
856 |
USE netcdf, ONLY: nf90_def_dim, nf90_def_var, nf90_enddef, & |
857 |
nf90_float, nf90_put_att, nf90_unlimited |
858 |
|
859 |
INTEGER, INTENT (IN):: pfileid |
860 |
|
861 |
INTEGER:: ncid, ncvarid |
862 |
INTEGER:: iret, ndim, iv, itx, ziv |
863 |
INTEGER:: itax |
864 |
INTEGER:: dims(4), dim_cnt |
865 |
INTEGER:: year, month, day, hours, minutes |
866 |
REAL:: sec |
867 |
REAL:: rtime0 |
868 |
CHARACTER (len=20):: tname, tunit |
869 |
CHARACTER (len=30):: str30 |
870 |
CHARACTER (len=80):: ttitle |
871 |
CHARACTER (len=120):: assoc |
872 |
CHARACTER (len=70):: str70 |
873 |
CHARACTER (len=3), DIMENSION (12):: cal = (/ 'JAN', 'FEB', 'MAR', & |
874 |
'APR', 'MAY', 'JUN', 'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC'/) |
875 |
CHARACTER (len=7):: tmp_opp |
876 |
|
877 |
!--------------------------------------------------------------------- |
878 |
ncid = ncdf_ids(pfileid) |
879 |
|
880 |
! 1.0 Create the time axes |
881 |
|
882 |
iret = nf90_def_dim(ncid, 'time_counter', nf90_unlimited, tid(pfileid)) |
883 |
|
884 |
! 1.1 Define all the time axes needed for this file |
885 |
|
886 |
DO itx = 1, nb_tax(pfileid) |
887 |
dims(1) = tid(pfileid) |
888 |
IF (nb_tax(pfileid)>1) THEN |
889 |
str30 = 't_' // tax_name(pfileid, itx) |
890 |
ELSE |
891 |
str30 = 'time_counter' |
892 |
END IF |
893 |
iret = nf90_def_var(ncid, str30, nf90_float, dims(1), & |
894 |
tdimid(pfileid, itx)) |
895 |
|
896 |
! To transform the current itau into a real date and take it |
897 |
! as the origin of the file requires the time counter to change. |
898 |
! Thus it is an operation the user has to ask for. |
899 |
! This function should thus only be re-instated |
900 |
! if there is a ioconf routine to control it. |
901 |
|
902 |
! rtime0 = itau2date(itau0(pfileid), date0(pfileid), deltat(pfileid)) |
903 |
rtime0 = date0(pfileid) |
904 |
|
905 |
CALL ju2ymds(rtime0, year, month, day, sec) |
906 |
|
907 |
! Catch any error induced by a change in calendar ! |
908 |
|
909 |
IF (year<0) THEN |
910 |
year = 2000 + year |
911 |
END IF |
912 |
|
913 |
hours = int(sec/(60.*60.)) |
914 |
minutes = int((sec-hours*60.*60.)/60.) |
915 |
sec = sec - (hours*60.*60.+minutes*60.) |
916 |
|
917 |
WRITE (str70, 7000) year, month, day, hours, minutes, int(sec) |
918 |
iret = nf90_put_att(ncid, tdimid(pfileid, itx), 'units', trim(str70)) |
919 |
|
920 |
CALL ioget_calendar(str30) |
921 |
iret = nf90_put_att(ncid, tdimid(pfileid, itx), 'calendar', trim(str30)) |
922 |
|
923 |
iret = nf90_put_att(ncid, tdimid(pfileid, itx), 'title', 'Time') |
924 |
|
925 |
iret = nf90_put_att(ncid, tdimid(pfileid, itx), 'long_name', & |
926 |
'Time axis') |
927 |
|
928 |
WRITE (str70, 7001) year, cal(month), day, hours, minutes, int(sec) |
929 |
iret = nf90_put_att(ncid, tdimid(pfileid, itx), 'time_origin', & |
930 |
trim(str70)) |
931 |
END DO |
932 |
|
933 |
! The formats we need |
934 |
|
935 |
7000 FORMAT ('seconds since ', I4.4, '-', I2.2, '-', I2.2, ' ', I2.2, ':', I2.2, ':', & |
936 |
I2.2) |
937 |
7001 FORMAT (' ', I4.4, '-', A3, '-', I2.2, ' ', I2.2, ':', I2.2, ':', I2.2) |
938 |
|
939 |
! 2.0 declare the variables |
940 |
|
941 |
DO iv = 1, nb_var(pfileid) |
942 |
|
943 |
itax = var_axid(pfileid, iv) |
944 |
|
945 |
tname = name(pfileid, iv) |
946 |
tunit = unit_name(pfileid, iv) |
947 |
ttitle = title(pfileid, iv) |
948 |
|
949 |
IF (regular(pfileid)) THEN |
950 |
dims(1:2) = (/ xid(pfileid), yid(pfileid) /) |
951 |
dim_cnt = 2 |
952 |
ELSE |
953 |
dims(1) = xid(pfileid) |
954 |
dim_cnt = 1 |
955 |
END IF |
956 |
|
957 |
tmp_opp = topp(pfileid, iv) |
958 |
ziv = var_zaxid(pfileid, iv) |
959 |
|
960 |
! 2.1 dimension of field |
961 |
|
962 |
IF ((trim(tmp_opp)/='never')) THEN |
963 |
IF ((trim(tmp_opp)/='once') .AND. (trim( & |
964 |
tmp_opp)/='l_max') .AND. (trim(tmp_opp)/='l_min')) THEN |
965 |
IF (ziv==-99) THEN |
966 |
ndim = dim_cnt + 1 |
967 |
dims(dim_cnt+1:dim_cnt+2) = (/ tid(pfileid), 0 /) |
968 |
ELSE |
969 |
ndim = dim_cnt + 2 |
970 |
dims(dim_cnt+1:dim_cnt+2) = (/ zax_ids(pfileid, ziv), & |
971 |
tid(pfileid) /) |
972 |
END IF |
973 |
ELSE |
974 |
IF (ziv==-99) THEN |
975 |
ndim = dim_cnt |
976 |
dims(dim_cnt+1:dim_cnt+2) = (/ 0, 0 /) |
977 |
ELSE |
978 |
ndim = dim_cnt + 1 |
979 |
dims(dim_cnt+1:dim_cnt+2) = (/ zax_ids(pfileid, ziv), 0 /) |
980 |
END IF |
981 |
END IF |
982 |
|
983 |
iret = nf90_def_var(ncid, trim(tname), nf90_float, dims(1:abs(ndim)), & |
984 |
ncvarid) |
985 |
|
986 |
ncvar_ids(pfileid, iv) = ncvarid |
987 |
|
988 |
iret = nf90_put_att(ncid, ncvarid, 'units', trim(tunit)) |
989 |
|
990 |
iret = nf90_put_att(ncid, ncvarid, 'missing_value', & |
991 |
real(missing_val)) |
992 |
iret = nf90_put_att(ncid, ncvarid, 'long_name', trim(ttitle)) |
993 |
|
994 |
iret = nf90_put_att(ncid, ncvarid, 'short_name', trim(tname)) |
995 |
|
996 |
iret = nf90_put_att(ncid, ncvarid, 'online_operation', trim(fullop( & |
997 |
pfileid, iv))) |
998 |
|
999 |
SELECT CASE (ndim) |
1000 |
CASE (-3) |
1001 |
str30 = 'ZYX' |
1002 |
CASE (2) |
1003 |
str30 = 'YX' |
1004 |
CASE (3) |
1005 |
str30 = 'TYX' |
1006 |
CASE (4) |
1007 |
str30 = 'TZYX' |
1008 |
CASE DEFAULT |
1009 |
CALL histerr(3, 'histend', & |
1010 |
'less than 2 or more than 4 dimensions are not', & |
1011 |
'allowed at this stage', ' ') |
1012 |
END SELECT |
1013 |
|
1014 |
iret = nf90_put_att(ncid, ncvarid, 'axis', trim(str30)) |
1015 |
|
1016 |
assoc = 'nav_lat nav_lon' |
1017 |
ziv = var_zaxid(pfileid, iv) |
1018 |
IF (ziv>0) THEN |
1019 |
str30 = zax_name(pfileid, ziv) |
1020 |
assoc = trim(str30) // ' ' // trim(assoc) |
1021 |
END IF |
1022 |
|
1023 |
IF (itax>0) THEN |
1024 |
IF (nb_tax(pfileid)>1) THEN |
1025 |
str30 = 't_' // tax_name(pfileid, itax) |
1026 |
ELSE |
1027 |
str30 = 'time_counter' |
1028 |
END IF |
1029 |
assoc = trim(str30) // ' ' // trim(assoc) |
1030 |
|
1031 |
iret = nf90_put_att(ncid, ncvarid, 'interval_operation', & |
1032 |
real(freq_opp(pfileid, iv))) |
1033 |
iret = nf90_put_att(ncid, ncvarid, 'interval_write', real(freq_wrt( & |
1034 |
pfileid, iv))) |
1035 |
END IF |
1036 |
iret = nf90_put_att(ncid, ncvarid, 'associate', trim(assoc)) |
1037 |
END IF |
1038 |
END DO |
1039 |
|
1040 |
! Add MPP attributes |
1041 |
|
1042 |
CALL ioipslmpp_addatt(ncid) |
1043 |
|
1044 |
! 3.0 Put the netcdf file into wrte mode |
1045 |
|
1046 |
iret = nf90_enddef(ncid) |
1047 |
|
1048 |
! 4.0 Give some informations to the user |
1049 |
|
1050 |
WRITE (str70, '("All variables have been initialized on file:", I3)') & |
1051 |
pfileid |
1052 |
CALL histerr(1, 'histend', str70, '', ' ') |
1053 |
|
1054 |
END SUBROUTINE histend |
1055 |
|
1056 |
!********************************** |
1057 |
|
1058 |
SUBROUTINE histsync(file) |
1059 |
|
1060 |
! This subroutine will synchronise all |
1061 |
! (or one if defined) opened files. |
1062 |
|
1063 |
! file: optional argument for fileid |
1064 |
|
1065 |
USE histcom_var, ONLY: nb_files, ncdf_ids |
1066 |
USE netcdf, ONLY: nf90_sync |
1067 |
|
1068 |
INTEGER, INTENT (IN), OPTIONAL:: file |
1069 |
|
1070 |
INTEGER:: ifile, ncid, iret |
1071 |
|
1072 |
LOGICAL:: file_exists |
1073 |
!--------------------------------------------------------------------- |
1074 |
|
1075 |
! 1.The loop on files to synchronise |
1076 |
|
1077 |
DO ifile = 1, nb_files |
1078 |
|
1079 |
IF (present(file)) THEN |
1080 |
file_exists = (ifile==file) |
1081 |
ELSE |
1082 |
file_exists = .TRUE. |
1083 |
END IF |
1084 |
|
1085 |
IF (file_exists) THEN |
1086 |
ncid = ncdf_ids(ifile) |
1087 |
iret = nf90_sync(ncid) |
1088 |
END IF |
1089 |
|
1090 |
END DO |
1091 |
|
1092 |
END SUBROUTINE histsync |
1093 |
|
1094 |
!********************************** |
1095 |
|
1096 |
SUBROUTINE histclo(fid) |
1097 |
|
1098 |
! This subroutine will close the file corresponding |
1099 |
! to the argument, if the argument is present. Else it will close |
1100 |
! all opened files. |
1101 |
|
1102 |
USE errioipsl, ONLY: histerr |
1103 |
USE histcom_var, ONLY: nb_files, ncdf_ids |
1104 |
USE netcdf, ONLY: nf90_close, nf90_noerr |
1105 |
|
1106 |
INTEGER, INTENT (IN), OPTIONAL:: fid ! file id |
1107 |
|
1108 |
! Variables local to the procedure: |
1109 |
INTEGER ifile, ncid, iret, iv, ncvarid |
1110 |
INTEGER start_loop, end_loop |
1111 |
CHARACTER(len=70) str70 |
1112 |
|
1113 |
!--------------------------------------------------------------------- |
1114 |
|
1115 |
IF (present(fid)) THEN |
1116 |
start_loop = fid |
1117 |
end_loop = fid |
1118 |
ELSE |
1119 |
start_loop = 1 |
1120 |
end_loop = nb_files |
1121 |
END IF |
1122 |
|
1123 |
DO ifile = start_loop, end_loop |
1124 |
ncid = ncdf_ids(ifile) |
1125 |
iret = nf90_close(ncid) |
1126 |
IF (iret/=nf90_noerr) THEN |
1127 |
WRITE(str70, '("This file has already been closed:", I3)') ifile |
1128 |
CALL histerr(2, 'histclo', str70, '', '') |
1129 |
END IF |
1130 |
END DO |
1131 |
|
1132 |
END SUBROUTINE histclo |
1133 |
|
1134 |
END MODULE histcom |