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