source: LMDZ6/branches/LMDZ-COSP/libf/misc/simple.F90 @ 4212

Last change on this file since 4212 was 1907, checked in by lguez, 11 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 9.4 KB
Line 
1! $Id$
2module simple
3
4  use handle_err_m, only: handle_err
5 
6  implicit none
7
8  private handle_err
9
10contains
11
12  subroutine nf95_open(path, mode, ncid, chunksize, ncerr)
13
14    use netcdf, only: nf90_open
15
16    character(len=*), intent(in):: path
17    integer, intent(in):: mode
18    integer, intent(out):: ncid
19    integer, intent(inout), optional:: chunksize
20    integer, intent(out), optional:: ncerr
21
22    ! Variable local to the procedure:
23    integer ncerr_not_opt
24
25    !-------------------
26
27    ncerr_not_opt = nf90_open(path, mode, ncid, chunksize)
28    if (present(ncerr)) then
29       ncerr = ncerr_not_opt
30    else
31       call handle_err("nf95_open " // path, ncerr_not_opt)
32    end if
33
34  end subroutine nf95_open
35
36  !************************
37
38  subroutine nf95_inq_dimid(ncid, name, dimid, ncerr)
39
40    use netcdf, only: nf90_inq_dimid
41
42    integer,             intent(in) :: ncid
43    character (len = *), intent(in) :: name
44    integer,             intent(out) :: dimid
45    integer, intent(out), optional:: ncerr
46
47    ! Variable local to the procedure:
48    integer ncerr_not_opt
49
50    !-------------------
51
52    ncerr_not_opt = nf90_inq_dimid(ncid, name, dimid)
53    if (present(ncerr)) then
54       ncerr = ncerr_not_opt
55    else
56       call handle_err("nf95_inq_dimid " // name, ncerr_not_opt, ncid)
57    end if
58
59  end subroutine nf95_inq_dimid
60
61  !************************
62
63  subroutine nf95_inquire_dimension(ncid, dimid, name, nclen, ncerr)
64
65    use netcdf, only: nf90_inquire_dimension
66
67    integer,                       intent( in) :: ncid, dimid
68    character (len = *), optional, intent(out) :: name
69    integer,             optional, intent(out) :: nclen
70    integer, intent(out), optional:: ncerr
71
72    ! Variable local to the procedure:
73    integer ncerr_not_opt
74
75    !-------------------
76
77    ncerr_not_opt = nf90_inquire_dimension(ncid, dimid, name, nclen)
78    if (present(ncerr)) then
79       ncerr = ncerr_not_opt
80    else
81       call handle_err("nf95_inquire_dimension", ncerr_not_opt, ncid)
82    end if
83
84  end subroutine nf95_inquire_dimension
85
86  !************************
87
88  subroutine nf95_inq_varid(ncid, name, varid, ncerr)
89
90    use netcdf, only: nf90_inq_varid
91
92    integer,             intent(in) :: ncid
93    character(len=*), intent(in):: name
94    integer,             intent(out) :: varid
95    integer, intent(out), optional:: ncerr
96
97    ! Variable local to the procedure:
98    integer ncerr_not_opt
99
100    !-------------------
101
102    ncerr_not_opt = nf90_inq_varid(ncid, name, varid)
103    if (present(ncerr)) then
104       ncerr = ncerr_not_opt
105    else
106       call handle_err("nf95_inq_varid, name = " // name, ncerr_not_opt, ncid)
107    end if
108
109  end subroutine nf95_inq_varid
110
111  !************************
112
113  subroutine nf95_inquire_variable(ncid, varid, name, xtype, ndims, dimids, &
114       nAtts, ncerr)
115
116    ! In "nf90_inquire_variable", "dimids" is an assumed-size array.
117    ! This is not optimal.
118    ! We are in the classical case of an array the size of which is
119    ! unknown in the calling procedure, before the call.
120    ! Here we use a better solution: a pointer argument array.
121    ! This procedure associates and defines "dimids" if it is present.
122
123    use netcdf, only: nf90_inquire_variable, nf90_max_var_dims
124
125    integer, intent(in):: ncid, varid
126    character(len = *), optional, intent(out):: name
127    integer, optional, intent(out) :: xtype, ndims
128    integer, dimension(:), optional, pointer :: dimids
129    integer, optional, intent(out) :: nAtts
130    integer, intent(out), optional :: ncerr
131
132    ! Variable local to the procedure:
133    integer ncerr_not_opt
134    integer dimids_local(nf90_max_var_dims)
135    integer ndims_not_opt
136
137    !-------------------
138
139    if (present(dimids)) then
140       ncerr_not_opt = nf90_inquire_variable(ncid, varid, name, xtype, &
141            ndims_not_opt, dimids_local, nAtts)
142       allocate(dimids(ndims_not_opt)) ! also works if ndims_not_opt == 0
143       dimids = dimids_local(:ndims_not_opt)
144       if (present(ndims)) ndims = ndims_not_opt
145    else
146       ncerr_not_opt = nf90_inquire_variable(ncid, varid, name, xtype, ndims, &
147            nAtts=nAtts)
148    end if
149
150    if (present(ncerr)) then
151       ncerr = ncerr_not_opt
152    else
153       call handle_err("nf95_inquire_variable", ncerr_not_opt, ncid, varid)
154    end if
155
156  end subroutine nf95_inquire_variable
157
158  !************************
159
160  subroutine nf95_create(path, cmode, ncid, initialsize, chunksize, ncerr)
161   
162    use netcdf, only: nf90_create
163
164    character (len = *), intent(in   ) :: path
165    integer,             intent(in   ) :: cmode
166    integer,             intent(  out) :: ncid
167    integer, optional,   intent(in   ) :: initialsize
168    integer, optional,   intent(inout) :: chunksize
169    integer, intent(out), optional :: ncerr
170
171    ! Variable local to the procedure:
172    integer ncerr_not_opt
173
174    !-------------------
175
176    ncerr_not_opt = nf90_create(path, cmode, ncid, initialsize, chunksize)
177    if (present(ncerr)) then
178       ncerr = ncerr_not_opt
179    else
180       call handle_err("nf95_create " // path, ncerr_not_opt)
181    end if
182
183  end subroutine nf95_create
184
185  !************************
186
187  subroutine nf95_def_dim(ncid, name, nclen, dimid, ncerr)
188
189    use netcdf, only: nf90_def_dim
190
191    integer,             intent( in) :: ncid
192    character (len = *), intent( in) :: name
193    integer,             intent( in) :: nclen
194    integer,             intent(out) :: dimid
195    integer, intent(out), optional :: ncerr
196
197    ! Variable local to the procedure:
198    integer ncerr_not_opt
199
200    !-------------------
201
202    ncerr_not_opt = nf90_def_dim(ncid, name, nclen, dimid)
203    if (present(ncerr)) then
204       ncerr = ncerr_not_opt
205    else
206       call handle_err("nf95_def_dim " // name, ncerr_not_opt, ncid)
207    end if
208
209  end subroutine nf95_def_dim
210
211  !***********************
212
213  subroutine nf95_redef(ncid, ncerr)
214
215    use netcdf, only: nf90_redef
216
217    integer, intent( in) :: ncid
218    integer, intent(out), optional :: ncerr
219
220    ! Variable local to the procedure:
221    integer ncerr_not_opt
222
223    !-------------------
224
225    ncerr_not_opt = nf90_redef(ncid)
226    if (present(ncerr)) then
227       ncerr = ncerr_not_opt
228    else
229       call handle_err("nf95_redef", ncerr_not_opt, ncid)
230    end if
231
232  end subroutine nf95_redef
233 
234  !***********************
235
236  subroutine nf95_enddef(ncid, h_minfree, v_align, v_minfree, r_align, ncerr)
237
238    use netcdf, only: nf90_enddef
239
240    integer,           intent( in) :: ncid
241    integer, optional, intent( in) :: h_minfree, v_align, v_minfree, r_align
242    integer, intent(out), optional :: ncerr
243
244    ! Variable local to the procedure:
245    integer ncerr_not_opt
246
247    !-------------------
248
249    ncerr_not_opt = nf90_enddef(ncid, h_minfree, v_align, v_minfree, r_align)
250    if (present(ncerr)) then
251       ncerr = ncerr_not_opt
252    else
253       call handle_err("nf95_enddef", ncerr_not_opt, ncid)
254    end if
255
256  end subroutine nf95_enddef
257
258  !***********************
259
260  subroutine nf95_close(ncid, ncerr)
261
262    use netcdf, only: nf90_close
263
264    integer, intent( in) :: ncid
265    integer, intent(out), optional :: ncerr
266
267    ! Variable local to the procedure:
268    integer ncerr_not_opt
269
270    !-------------------
271
272    ncerr_not_opt = nf90_close(ncid)
273    if (present(ncerr)) then
274       ncerr = ncerr_not_opt
275    else
276       call handle_err("nf95_close", ncerr_not_opt)
277    end if
278
279  end subroutine nf95_close
280
281  !***********************
282
283  subroutine nf95_copy_att(ncid_in, varid_in, name, ncid_out, varid_out, ncerr)
284
285    use netcdf, only: nf90_copy_att
286
287    integer, intent( in):: ncid_in,  varid_in
288    character(len=*), intent( in):: name
289    integer, intent( in):: ncid_out, varid_out
290    integer, intent(out), optional:: ncerr
291
292    ! Variable local to the procedure:
293    integer ncerr_not_opt
294
295    !-------------------
296
297    ncerr_not_opt = nf90_copy_att(ncid_in, varid_in, name, ncid_out, varid_out)
298    if (present(ncerr)) then
299       ncerr = ncerr_not_opt
300    else
301       call handle_err("nf95_copy_att " // name, ncerr_not_opt, ncid_out)
302    end if
303
304  end subroutine nf95_copy_att
305
306  !***********************
307
308  subroutine nf95_inquire_attribute(ncid, varid, name, xtype, nclen, attnum, &
309       ncerr)
310
311    use netcdf, only: nf90_inquire_attribute
312
313    integer,             intent( in)           :: ncid, varid
314    character (len = *), intent( in)           :: name
315    integer,             intent(out), optional :: xtype, nclen, attnum
316    integer, intent(out), optional:: ncerr
317
318    ! Variable local to the procedure:
319    integer ncerr_not_opt
320
321    !-------------------
322
323    ncerr_not_opt = nf90_inquire_attribute(ncid, varid, name, xtype, nclen, &
324         attnum)
325    if (present(ncerr)) then
326       ncerr = ncerr_not_opt
327    else
328       call handle_err("nf95_inquire_attribute " // name, ncerr_not_opt, &
329            ncid, varid)
330    end if
331
332  end subroutine nf95_inquire_attribute
333
334  !***********************
335
336  subroutine nf95_inquire(ncid, nDimensions, nVariables, nAttributes, &
337       unlimitedDimId, formatNum, ncerr)
338
339    use netcdf, only: nf90_inquire
340
341    integer,           intent( in) :: ncid
342    integer, optional, intent(out) :: nDimensions, nVariables, nAttributes
343    integer, optional, intent(out) :: unlimitedDimId, formatNum
344    integer, intent(out), optional:: ncerr
345
346    ! Variable local to the procedure:
347    integer ncerr_not_opt
348
349    !-------------------
350
351    ncerr_not_opt = nf90_inquire(ncid, nDimensions, nVariables, nAttributes, &
352         unlimitedDimId, formatNum)
353    if (present(ncerr)) then
354       ncerr = ncerr_not_opt
355    else
356       call handle_err("nf95_inquire", ncerr_not_opt, ncid)
357    end if
358
359  end subroutine nf95_inquire
360
361end module simple
Note: See TracBrowser for help on using the repository browser.