Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

module_NCgeneric.f90 @ 2411

Last change on this file since 2411 was 1663, checked in by lfita, 7 years ago

Creation of:

`module_NCgeneric.f90': module with generic netcdf functions

File size: 47.1 KB

Line
1	MODULE module_NCgeneric
2	! Module with generic netcdf functions
3
4	! create_NCfile: Subroutine to create a netCDF file
5	! handle_err: Subroutine to provide the error message when something with netCDF went wrong
6	! handle_errf: Subroutine to provide the error message when something with netCDF went wrong (including fname)
7	! isin_file: Function to tell if a given variable is inside a file
8	! isin_ncunit: Function to tell if a given variable is inside a netcdf file unit
9	! get_var2dims_file: Function to get the dimensions of a given 2D variable inside a file
10	! get_var3dims_file: Function to get the dimensions of a given 3D variable inside a file
11	! get_var4dims_file: Function to get the dimensions of a given 4D variable inside a file
12	! get_var1dims_ncunit: Function to get the dimensions of a given 1D variable inside a unit of a netCDF file
13	! get_var2dims_ncunit: Function to get the dimensions of a given 2D variable inside a unit of a netCDF file
14	! get_var3dims_ncunit: Function to get the dimensions of a given 3D variable inside a unit of a netCDF file
15	! get_varNdims_file: Function to get the number of dimensions of a given variable inside a file
16	! get_varNdims_ncunit: Function to get the number of dimensions of a given variable inside a unit of a netCDF file
17	! get_varI1D_ncunit: Subroutine to get a 1D integer variable from a netCDF file unit
18	! get_varI2D_ncunit: Subroutine to get a 2D integer variable from a netCDF file unit
19	! get_varRK0D_ncunit: Subroutine to get an scalar r_k float variable from a netCDF file unit
20	! get_varRK1D_ncunit: Subroutine to get a 1D r_k float variable from a netCDF file unit
21	! get_varRK2D_ncunit: Subroutine to get a 2D r_k float variable from a netCDF file unit
22	! get_varRK3D_ncunit: Subroutine to get a 3D r_k float variable from a netCDF file unit
23	! get_varRK2D_ncunit: Subroutine to get a 4D r_k float variable from a netCDF file unit
24	! put_var1D: Subroutine to write on a netCDF file a 1D float variable
25	! put_var2D: Subroutine to write on a netCDF file a 2D float variable
26	! put_var3D: Subroutine to write on a netCDF file a 3D float variable
27	! put_var1Dt: Subroutine to write on a netCDF file a 1D float variable at a given time-step
28	! put_var2Dt: Subroutine to write on a netCDF file a 2D float variable at a given time-step
29	! put_var3Dt: Subroutine to write on a netCDF file a 3D float variable at a given time-step
30
31	USE module_definitions
32	USE module_basic
33	USE module_generic
34
35	CONTAINS
36
37	! From UNIDATA: https://www.unidata.ucar.edu/software/netcdf/docs/netcdf-f90.html
38	SUBROUTINE handle_err(st)
39	! Subroutine to provide the error message when something with netCDF went wrong
40
41	USE netcdf
42
43	INTEGER, INTENT(in) :: st
44
45	!!!!!!! Variables
46	! fn: function name from which it is used
47
48	IF (st /= nf90_noerr) THEN
49	PRINT *, TRIM(emsg)
50	PRINT *, ' ' // TRIM(nf90_strerror(st))
51	STOP "Stopped"
52	END IF
53
54	END SUBROUTINE handle_err
55
56	! From UNIDATA: https://www.unidata.ucar.edu/software/netcdf/docs/netcdf-f90.html
57	SUBROUTINE handle_errf(st, fn)
58	! Subroutine to provide the error message when something with netCDF went wrong (including fname)
59
60	USE netcdf
61
62	INTEGER, INTENT(in) :: st
63	CHARACTER(len=*), INTENT(in) :: fn
64
65	!!!!!!! Variables
66	! st: netCDF status number
67	! fn: function name from which it is used
68
69	IF (st /= nf90_noerr) THEN
70	PRINT *, TRIM(emsg)
71	PRINT *, ' ' // TRIM(fn) // ': ' // TRIM(nf90_strerror(st))
72	STOP "Stopped"
73	END IF
74
75	END SUBROUTINE handle_errf
76
77	SUBROUTINE create_NCfile(filename, dimsfile, namelistfile, varsfile, ncid)
78	! Subroutine to create a netCDF file
79
80	USE netcdf
81
82	IMPLICIT NONE
83
84	INCLUDE 'netcdf.inc'
85
86	CHARACTER(LEN=*), INTENT(IN) :: filename, dimsfile, namelistfile, varsfile
87	INTEGER, INTENT(OUT) :: ncid
88
89	! Local
90	INTEGER :: i, j, k, idimnew
91	INTEGER :: rcode, funit, funit2, ios
92	INTEGER :: Nvals, dimsize, dimid, iddimnew, Ntotdims
93	INTEGER :: idvarnew, vartype
94	CHARACTER(LEN=200) :: message, vd, vs, vdd, val
95	CHARACTER(LEN=200) :: vname, Lvname, vunits, coornames
96	CHARACTER(LEN=200), DIMENSION(:), ALLOCATABLE :: valsline, dimsizes
97	CHARACTER(LEN=1000) :: line, dimsline
98	INTEGER, DIMENSION(:), ALLOCATABLE :: dimsvar
99	INTEGER :: Ldimsize, Ldimsvar, dvarL
100	CHARACTER(LEN=1) :: dvarn
101
102	!!!!!!! Variables
103	! filename: name of the file to create
104	! dimsfile: ASCII file with the name of the dimensions to create with ('#' for comentaries)
105	! [dim name]\| [dim orig in WRF]\| [dim orig in namelist]\| ['unlimited' also, 'namelist' (from namelist parameter)]
106	! namelistfile: name of the Namelist file
107	! varsfile: ASCII file with the name of the variables to create with ('#' for comentaries)
108	! [WRFvarname]\| [var name]\| [long var name]\| [var units]\| [var dimensions]
109	! ncid: number assigned to the file
110
111	fname = 'create_NCfile'
112
113	! Opening creation status
114	rcode = nf90_create(TRIM(filename), NF90_NETCDF4, ncid)
115	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
116
117	! Reading dimensions file
118	funit = freeunit()
119	OPEN(funit, FILE=TRIM(dimsfile), STATUS='old', FORM='formatted', IOSTAT=ios)
120	message = "Problems to open varibales file '" // TRIM(varsfile) // "' IOSTAT = "// &
121	TRIM(ItoS(ios)) // " !!"
122	IF ( ios /= 0 ) CALL stoprun(message, fname)
123
124	Nvals = 4
125	IF (ALLOCATED(valsline)) DEALLOCATE(valsline)
126	ALLOCATE (valsline(Nvals))
127
128	! Creation of dimensions
129	idimnew = 3
130	dimsline = ''
131	Ntotdims = 0
132	DO i=1,1000
133	READ(funit, '(A1000)', END=100)line
134	IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
135	CALL split(line,'\|',Nvals,valsline)
136	CALL removeChar(valsline(4),' ')
137	IF (TRIM(valsline(4)) == 'unlimited') THEN
138	idimnew = idimnew + 1
139	dimsize = NF90_UNLIMITED
140	dimid = idimnew
141	ELSE IF (TRIM(valsline(4)) == 'namelist') THEN
142	CALL GetInNamelist(namelistfile, valsline(3), 'I', Ival=dimsize)
143	SELECT CASE (TRIM(valsline(2)))
144	CASE ('i')
145	dimid = 1
146	CASE ('j')
147	dimid = 2
148	CASE ('k')
149	dimid = 3
150	CASE ('t')
151	dimid = 4
152	dimsize = NF90_UNLIMITED
153	CASE DEFAULT
154	idimnew = idimnew + 1
155	dimid = idimnew
156	END SELECT
157	END IF
158	rcode = nf90_def_dim(ncid, TRIM(valsline(1)), dimsize, dimid)
159	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
160	vs = valsline(2)
161	CALL removeChar(vs, ' ')
162	CALL attachString(dimsline, TRIM(vs) // ':' // TRIM(ItoS(dimid)) // ';')
163	Ntotdims = Ntotdims + 1
164	END IF
165	END DO
166
167	100 CONTINUE
168	CLOSE(funit)
169
170	! Sort of python dictionary for [dimn]:[dimsize]...
171	IF (ALLOCATED(dimsizes)) DEALLOCATE(dimsizes)
172	ALLOCATE(dimsizes(Ntotdims))
173	CALL split(dimsline,';',Ntotdims,dimsizes)
174
175	! Reading variables file
176	funit = freeunit()
177	OPEN(funit, FILE=TRIM(varsfile), STATUS='old', FORM='formatted', IOSTAT=ios)
178
179	message = "Problems to open varibales file '" // TRIM(varsfile) // "' IOSTAT = "// &
180	TRIM(ItoS(ios)) // " !!"
181	IF ( ios /= 0 ) CALL stoprun(message, fname)
182
183	Nvals = 6
184	IF (ALLOCATED(valsline)) DEALLOCATE(valsline)
185	ALLOCATE (valsline(Nvals))
186
187	! Defining variables
188	idvarnew = 1
189	DO i=1,1000
190	READ(funit, '(A1000)', END=150)line
191	IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
192	CALL split(line,'\|',Nvals,valsline)
193	vtype: SELECT CASE (TRIM(valsline(6)))
194	CASE ('B')
195	vartype = NF_BYTE
196	CASE ('C')
197	vartype = NF_CHAR
198	CASE ('I')
199	vartype = NF_SHORT
200	CASE ('I16')
201	vartype = NF_INT
202	CASE ('R')
203	vartype = NF_FLOAT
204	CASE ('R16')
205	vartype = NF_DOUBLE
206	END SELECT vtype
207
208	vd = valsline(5)
209	CALL removeChar(vd, ' ')
210	Ldimsvar = LEN_TRIM(vd)
211	IF (ALLOCATED(dimsvar)) DEALLOCATE(dimsvar)
212	ALLOCATE(dimsvar(Ldimsvar))
213
214	! Variable's dimensions
215	coornames = ''
216	DO j=1, Ldimsvar
217	DO k=1, Ntotdims
218	IF (dimsizes(k)(1:1) == vd(j:j)) THEN
219	Ldimsize = LEN_TRIM(dimsizes(k))
220	vdd = dimsizes(k)(3:Ldimsize)
221	dimsvar(j) = StoI(vdd)
222	! Too complicated to assign dimvarname... (or too lazy)
223	! coornames = coornames //
224	CYCLE
225	END IF
226	END DO
227	END DO
228	vname = valsline(2)
229	CALL removeChar(vname, ' ')
230	vartype = 5
231
232	rcode = nf90_def_var(ncid, vname, vartype, dimsvar, idvarnew)
233	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
234
235	! Adding attributes
236	rcode = nf90_put_att(ncid, idvarnew, 'standard_name', TRIM(valsline(2)))
237	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
238	rcode = nf90_put_att(ncid, idvarnew, 'long_name', TRIM(valsline(3)))
239	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
240	rcode = nf90_put_att(ncid, idvarnew, 'units', TRIM(valsline(4)))
241	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
242
243	idvarnew = idvarnew + 1
244	END IF
245	END DO
246
247	150 CONTINUE
248	CLOSE(funit)
249
250	rcode = NF90_ENDDEF(ncid)
251	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
252
253	DEALLOCATE(valsline)
254	DEALLOCATE(dimsizes)
255
256	END SUBROUTINE create_NCfile
257
258	FUNCTION get_var2dims_file(filename, varname)
259	! Function to get the dimensions of a given 2D variable inside a file
260
261	USE netcdf
262
263	IMPLICIT NONE
264
265	CHARACTER(LEN=*), INTENT(in) :: filename, varname
266	! Following: http://stackoverflow.com/questions/3828094/function-returning-an-array-in-fortran
267	INTEGER, DIMENSION(2) :: get_var2dims_file
268
269	! Local
270	INTEGER :: nid, vid, Ndims
271	INTEGER :: rcode
272	INTEGER, DIMENSION(2) :: dimsid
273
274	!!!!!!! Variables
275	! filename: name of the file to open
276	! varname: name of the variable
277
278	fname = 'get_var2dims_file'
279	!PRINT *,TRIM(fname)
280
281	! Opening creation status
282	rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
283	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
284
285	rcode = nf90_inq_varid(nid, varname, vid)
286	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
287
288	rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
289	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
290
291	IF (Ndims /= 2) THEN
292	msg = "variable '" // TRIM(varname) // "' has not 2 dimensions!!"
293	CALL stoprun(msg, fname)
294	END IF
295
296	rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
297	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
298
299	rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = get_var2dims_file(1))
300	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
301
302	rcode = nf90_inquire_dimension(nid, dimsid(2), LEN = get_var2dims_file(2))
303	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
304
305	rcode = NF90_CLOSE(nid)
306	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
307
308	END FUNCTION get_var2dims_file
309
310	FUNCTION get_var3dims_file(filename, varname)
311	! Function to get the dimensions of a given 3D variable inside a file
312
313	USE netcdf
314
315	IMPLICIT NONE
316
317	CHARACTER(LEN=*), INTENT(in) :: filename, varname
318	! Following: http://stackoverflow.com/questions/3828094/function-returning-an-array-in-fortran
319	INTEGER, DIMENSION(3) :: get_var3dims_file
320
321	! Local
322	INTEGER :: nid, vid, Ndims
323	INTEGER :: rcode
324	INTEGER, DIMENSION(3) :: dimsid
325
326
327	!!!!!!! Variables
328	! filename: name of the file to open
329	! varname: name of the variable
330
331	fname = 'get_var3dims_file'
332	!PRINT *,TRIM(fname)
333
334	! Opening creation status
335	rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
336	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
337
338	rcode = nf90_inq_varid(nid, varname, vid)
339	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
340
341	rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
342	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
343
344	IF (Ndims /= 3) THEN
345	msg = "variable '" // TRIM(varname) // "' has not 3 dimensions!!"
346	CALL stoprun(msg, fname)
347	END IF
348
349	rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
350	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
351
352	rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = get_var3dims_file(1))
353	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
354
355	rcode = nf90_inquire_dimension(nid, dimsid(2), LEN = get_var3dims_file(2))
356	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
357
358	rcode = nf90_inquire_dimension(nid, dimsid(3), LEN = get_var3dims_file(3))
359	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
360
361	rcode = NF90_CLOSE(nid)
362	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
363
364	END FUNCTION get_var3dims_file
365
366	FUNCTION get_var1dims_ncunit(nid, varname)
367	! Function to get the dimensions of a given 1D variable inside a unit of a netCDF file
368
369	USE netcdf
370
371	IMPLICIT NONE
372
373	INTEGER, INTENT(in) :: nid
374	CHARACTER(LEN=*), INTENT(in) :: varname
375	! Following: http://stackoverflow.com/questions/3828094/function-returning-an-array-in-fortran
376	INTEGER, DIMENSION(1) :: get_var1dims_ncunit
377
378	! Local
379	INTEGER :: vid, Ndims
380	INTEGER :: rcode
381	INTEGER, DIMENSION(1) :: dimsid
382
383
384	!!!!!!! Variables
385	! filename: name of the file to open
386	! varname: name of the variable
387
388	fname = 'get_var1dims_ncunit'
389	!PRINT *,TRIM(fname)
390
391	rcode = nf90_inq_varid(nid, varname, vid)
392	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
393
394	rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
395	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
396
397	IF (Ndims /= 1) THEN
398	msg = "variable '" // TRIM(varname) // "' has not 1 dimensions!!"
399	CALL stoprun(msg, fname)
400	END IF
401
402	rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
403	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
404
405	rcode = nf90_inquire_dimension(nid, dimsid(1), name=msg)
406
407	rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = get_var1dims_ncunit(1))
408	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
409
410	END FUNCTION get_var1dims_ncunit
411
412	FUNCTION get_var2dims_ncunit(nid, varname)
413	! Function to get the dimensions of a given 2D variable inside a unit of a netCDF file
414
415	USE netcdf
416
417	IMPLICIT NONE
418
419	INTEGER, INTENT(in) :: nid
420	CHARACTER(LEN=*), INTENT(in) :: varname
421	! Following: http://stackoverflow.com/questions/3828094/function-returning-an-array-in-fortran
422	INTEGER, DIMENSION(2) :: get_var2dims_ncunit
423
424	! Local
425	INTEGER :: vid, Ndims
426	INTEGER :: rcode
427	INTEGER, DIMENSION(2) :: dimsid
428
429
430	!!!!!!! Variables
431	! filename: name of the file to open
432	! varname: name of the variable
433
434	fname = 'get_var2dims_ncunit'
435	!PRINT *,TRIM(fname)
436
437	rcode = nf90_inq_varid(nid, varname, vid)
438	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
439
440	rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
441	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
442
443	IF (Ndims /= 2) THEN
444	msg = "variable '" // TRIM(varname) // "' has not 2 dimensions!!"
445	CALL stoprun(msg, fname)
446	END IF
447
448	rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
449	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
450
451	rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = get_var2dims_ncunit(1))
452	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
453
454	rcode = nf90_inquire_dimension(nid, dimsid(2), LEN = get_var2dims_ncunit(2))
455	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
456
457	END FUNCTION get_var2dims_ncunit
458
459	FUNCTION get_var3dims_ncunit(nid, varname)
460	! Function to get the dimensions of a given 3D variable inside a unit of a netCDF file
461
462	USE netcdf
463
464	IMPLICIT NONE
465
466	INTEGER, INTENT(in) :: nid
467	CHARACTER(LEN=*), INTENT(in) :: varname
468	! Following: http://stackoverflow.com/questions/3828094/function-returning-an-array-in-fortran
469	INTEGER, DIMENSION(3) :: get_var3dims_ncunit
470
471	! Local
472	INTEGER :: vid, Ndims
473	INTEGER :: rcode
474	INTEGER, DIMENSION(3) :: dimsid
475
476
477	!!!!!!! Variables
478	! filename: name of the file to open
479	! varname: name of the variable
480
481	fname = 'get_var3dims_ncunit'
482	!PRINT *,TRIM(fname)
483
484	rcode = nf90_inq_varid(nid, varname, vid)
485	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
486
487	rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
488	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
489
490	IF (Ndims /= 3) THEN
491	msg = "variable '" // TRIM(varname) // "' has not 3 dimensions!!"
492	CALL stoprun(msg, fname)
493	END IF
494
495	rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
496	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
497
498	rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = get_var3dims_ncunit(1))
499	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
500
501	rcode = nf90_inquire_dimension(nid, dimsid(2), LEN = get_var3dims_ncunit(2))
502	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
503
504	rcode = nf90_inquire_dimension(nid, dimsid(3), LEN = get_var3dims_ncunit(3))
505	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
506
507	END FUNCTION get_var3dims_ncunit
508
509	FUNCTION get_var4dims_file(filename, varname)
510	! Function to get the dimensions of a given 4D variable inside a file
511
512	USE netcdf
513
514	IMPLICIT NONE
515
516	CHARACTER(LEN=*), INTENT(in) :: filename, varname
517	! Following: http://stackoverflow.com/questions/3828094/function-returning-an-array-in-fortran
518	INTEGER, DIMENSION(4) :: get_var4dims_file
519
520	! Local
521	INTEGER :: nid, vid, Ndims
522	INTEGER :: rcode
523	INTEGER, DIMENSION(4) :: dimsid
524
525
526	!!!!!!! Variables
527	! filename: name of the file to open
528	! varname: name of the variable
529
530	fname = 'get_var4dims_file'
531	!PRINT *,TRIM(fname)
532
533	! Opening creation status
534	rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
535	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
536
537	rcode = nf90_inq_varid(nid, varname, vid)
538	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
539
540	rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
541	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
542
543	IF (Ndims /= 4) THEN
544	msg = "variable '" // TRIM(varname) // "' has not 4 dimensions!!"
545	CALL stoprun(msg, fname)
546	END IF
547
548	rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
549	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
550
551	rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = get_var4dims_file(1))
552	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
553
554	rcode = nf90_inquire_dimension(nid, dimsid(2), LEN = get_var4dims_file(2))
555	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
556
557	rcode = nf90_inquire_dimension(nid, dimsid(3), LEN = get_var4dims_file(3))
558	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
559
560	rcode = nf90_inquire_dimension(nid, dimsid(4), LEN = get_var4dims_file(4))
561	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
562
563	rcode = NF90_CLOSE(nid)
564	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
565
566	END FUNCTION get_var4dims_file
567
568	INTEGER FUNCTION get_varNdims_file(filename, varname)
569	! Function to get the number of dimensions of a given variable inside a file
570
571	USE netcdf
572
573	IMPLICIT NONE
574
575	CHARACTER(LEN=*), INTENT(in) :: filename, varname
576
577	! Local
578	INTEGER :: nid, vid
579	INTEGER :: rcode
580
581	!!!!!!! Variables
582	! filename: name of the file to open
583	! varname: name of the variable
584
585	fname = 'get_varNdims_file'
586	!PRINT *,TRIM(fname)
587
588	! Opening creation status
589	rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
590	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
591
592	rcode = nf90_inq_varid(nid, varname, vid)
593	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
594
595	rcode = nf90_inquire_variable(nid, vid, NDIMS = get_varNdims_file)
596	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
597
598	rcode = NF90_CLOSE(nid)
599	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
600
601	END FUNCTION get_varNdims_file
602
603	INTEGER FUNCTION get_varNdims_ncunit(nid, varname)
604	! Function to get the number of dimensions of a given variable inside a unit of a netCDF file
605
606	USE netcdf
607
608	IMPLICIT NONE
609
610	INTEGER, INTENT(in) :: nid
611	CHARACTER(LEN=*), INTENT(in) :: varname
612
613	! Local
614	INTEGER :: vid
615	INTEGER :: rcode
616
617	!!!!!!! Variables
618	! filename: name of the file to open
619	! varname: name of the variable
620
621	fname = 'get_varNdims_ncunit'
622	!PRINT *,TRIM(fname)
623
624	rcode = nf90_inq_varid(nid, varname, vid)
625	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
626
627	rcode = nf90_inquire_variable(nid, vid, NDIMS = get_varNdims_ncunit)
628	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
629
630	END FUNCTION get_varNdims_ncunit
631
632	LOGICAL FUNCTION isin_file(filename, varname)
633	! Function to tell if a given variable is inside a file
634
635	USE netcdf
636
637	IMPLICIT NONE
638
639	CHARACTER(LEN=*), INTENT(in) :: filename, varname
640
641	! Local
642	INTEGER :: nid, vid, Ndims, Nvars
643	INTEGER :: iv, rcode
644	CHARACTER(LEN=1000) :: varinfile
645
646	!!!!!!! Variables
647	! filename: name of the file to open
648	! varname: name of the variable
649
650	fname = 'isin_file'
651
652	! Opening creation status
653	rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
654	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
655
656	rcode = nf90_inquire(nid, Ndims, Nvars)
657	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
658
659	DO iv=1, Nvars
660	rcode = nf90_inquire_variable(nid, iv, name=varinfile)
661	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
662	IF (TRIM(varinfile) == TRIM(varname)) THEN
663	isin_file = .TRUE.
664	EXIT
665	ELSE
666	isin_file = .FALSE.
667	END IF
668	END DO
669
670	rcode = NF90_CLOSE(nid)
671	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
672
673	END FUNCTION isin_file
674
675	LOGICAL FUNCTION isin_ncunit(nid, varname)
676	! Function to tell if a given variable is inside a netcdf file unit
677
678	USE netcdf
679
680	IMPLICIT NONE
681
682	INTEGER, INTENT(in) :: nid
683	CHARACTER(LEN=*), INTENT(in) :: varname
684
685	! Local
686	INTEGER :: vid, Ndims, Nvars
687	INTEGER :: iv, rcode
688	CHARACTER(LEN=1000) :: varinfile
689
690	!!!!!!! Variables
691	! nid: number of the opened netCDF
692	! varname: name of the variable
693
694	fname = 'isin_ncunit'
695
696	rcode = nf90_inquire(nid, Ndims, Nvars)
697	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
698
699	DO iv=1, Nvars
700	rcode = nf90_inquire_variable(nid, iv, name=varinfile)
701	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
702	IF (TRIM(varinfile) == TRIM(varname)) THEN
703	isin_ncunit = .TRUE.
704	EXIT
705	ELSE
706	isin_ncunit = .FALSE.
707	END IF
708	END DO
709
710	END FUNCTION isin_ncunit
711
712	SUBROUTINE put_var1D(ncid, d1, vals, vname, filevarn)
713	! Subroutine to write on a netCDF file a 1D float variable
714
715	USE netcdf
716
717	IMPLICIT NONE
718
719	INTEGER, INTENT(IN) :: ncid, d1
720	REAL, DIMENSION(d1), INTENT(IN) :: vals
721	CHARACTER(LEN=*), INTENT(IN) :: vname, filevarn
722
723	! Local
724	INTEGER :: funit, i, idvarnew, ios
725	INTEGER :: Nvals, rcode, varid
726	CHARACTER(LEN=50) :: ncvarname
727	CHARACTER(LEN=1000) :: line
728	CHARACTER(LEN=200), DIMENSION(6) :: valsline
729	LOGICAL :: vfound
730
731	!!!!!!! Variables
732	! ncid: netCDF file identifier
733	! d1: shape of the matrix
734	! vals: values to include
735	! vname: name of the variable in the model to be included
736	! filevarn: name of the ASCII file with the information about the variables
737	fname = 'put_var1D'
738
739	! Reading variables file
740	funit = freeunit()
741	OPEN(funit, FILE=TRIM(filevarn), STATUS='old', FORM='formatted', IOSTAT=ios)
742	msg = "Problems to open variables file '" // TRIM(filevarn) // "' IOSTAT = "// &
743	TRIM(ItoS(ios)) // " !!"
744	IF ( ios /= 0 ) CALL stoprun(msg, fname)
745
746	Nvals = 6
747
748	idvarnew = 1
749	vfound = .FALSE.
750	DO i=1,1000
751	READ(funit, '(A1000)', END=150)line
752	IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
753	CALL split(line,'\|',Nvals,valsline)
754	IF (TRIM(vname) == TRIM(valsline(1))) THEN
755	ncvarname = TRIM(valsline(2))
756	CALL removeChar(ncvarname, ' ')
757	rcode = nf90_inq_varid(ncid, ncvarname, varid)
758	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
759
760	rcode = nf90_put_var(ncid, varid, vals)
761	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
762	vfound = .TRUE.
763	CYCLE
764	END IF
765	END IF
766	END DO
767
768	150 CONTINUE
769
770	CLOSE(funit)
771	IF (.NOT.vfound) THEN
772	msg = "variables file '" // TRIM(filevarn) // "' does not have varible '" // TRIM(vname) // &
773	"' !!"
774	CALL stoprun(msg, fname)
775	END IF
776
777	END SUBROUTINE put_var1D
778
779	SUBROUTINE put_var2D(ncid, d1, d2, vals, vname, filevarn)
780	! Subroutine to write on a netCDF file a 2D float variable
781
782	USE netcdf
783
784	IMPLICIT NONE
785
786	INTEGER, INTENT(IN) :: ncid, d1, d2
787	REAL, DIMENSION(d1,d2), INTENT(IN) :: vals
788	CHARACTER(LEN=*), INTENT(IN) :: vname, filevarn
789
790	! Local
791	INTEGER :: funit, i, idvarnew, ios
792	INTEGER :: Nvals, rcode, varid
793	CHARACTER(LEN=50) :: ncvarname
794	CHARACTER(LEN=1000) :: line
795	CHARACTER(LEN=200), DIMENSION(6) :: valsline
796	LOGICAL :: vfound
797
798	!!!!!!! Variables
799	! ncid: netCDF file identifier
800	! d1,d2: shape of the matrix
801	! vals: values to include
802	! vname: name of the variable in the model to be included
803	! filevarn: name of the ASCII file with the information about the variables
804	fname = 'put_var2D'
805
806	! Reading variables file
807	funit = freeunit()
808	OPEN(funit, FILE=TRIM(filevarn), STATUS='old', FORM='formatted', IOSTAT=ios)
809	msg = "Problems to open variables file '" // TRIM(filevarn) // "' IOSTAT = "// &
810	TRIM(ItoS(ios)) // " !!"
811	IF ( ios /= 0 ) CALL stoprun(msg, fname)
812
813	Nvals = 6
814
815	idvarnew = 1
816	vfound = .FALSE.
817	DO i=1,1000
818	READ(funit, '(A1000)', END=150)line
819	IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
820	CALL split(line,'\|',Nvals,valsline)
821	IF (TRIM(vname) == TRIM(valsline(1))) THEN
822	ncvarname = TRIM(valsline(2))
823	CALL removeChar(ncvarname, ' ')
824	rcode = nf90_inq_varid(ncid, ncvarname, varid)
825	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
826
827	rcode = nf90_put_var(ncid, varid, vals)
828	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
829	vfound = .TRUE.
830	CYCLE
831	END IF
832	END IF
833	END DO
834
835	150 CONTINUE
836
837	CLOSE(funit)
838	IF (.NOT.vfound) THEN
839	msg = "variables file '" // TRIM(filevarn) // "' does not have varible '" // TRIM(vname) // &
840	"' !!"
841	CALL stoprun(msg, fname)
842	END IF
843
844	END SUBROUTINE put_var2D
845
846	SUBROUTINE put_var3D(ncid, d1, d2, d3, vals, vname, filevarn)
847	! Subroutine to write on a netCDF file a 3D float variable
848
849	USE netcdf
850
851	IMPLICIT NONE
852
853	INTEGER, INTENT(IN) :: ncid, d1, d2, d3
854	REAL, DIMENSION(d1,d2,d3), INTENT(IN) :: vals
855	CHARACTER(LEN=*), INTENT(IN) :: vname, filevarn
856
857	! Local
858	INTEGER :: funit, i, idvarnew, ios
859	INTEGER :: Nvals, rcode, varid
860	CHARACTER(LEN=50) :: ncvarname
861	CHARACTER(LEN=1000) :: line
862	CHARACTER(LEN=200), DIMENSION(6) :: valsline
863	LOGICAL :: vfound
864
865	!!!!!!! Variables
866	! ncid: netCDF file identifier
867	! d1,d2,d3: shape of the matrix
868	! vals: values to include
869	! vname: name of the variable in the model to be included
870	! filevarn: name of the ASCII file with the information about the variables
871	fname = 'put_var3D'
872
873	! Reading variables file
874	funit = freeunit()
875	OPEN(funit, FILE=TRIM(filevarn), STATUS='old', FORM='formatted', IOSTAT=ios)
876	msg = "Problems to open variables file '" // TRIM(filevarn) // "' IOSTAT = "// &
877	TRIM(ItoS(ios)) // " !!"
878	IF ( ios /= 0 ) CALL stoprun(msg, fname)
879
880	Nvals = 6
881
882	idvarnew = 1
883	vfound = .FALSE.
884	DO i=1,1000
885	READ(funit, '(A1000)', END=150)line
886	IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
887	CALL split(line,'\|',Nvals,valsline)
888	IF (TRIM(vname) == TRIM(valsline(1))) THEN
889	ncvarname = TRIM(valsline(2))
890	CALL removeChar(ncvarname, ' ')
891	rcode = nf90_inq_varid(ncid, ncvarname, varid)
892	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
893
894	rcode = nf90_put_var(ncid, varid, vals)
895	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
896	vfound = .TRUE.
897	CYCLE
898	END IF
899	END IF
900	END DO
901
902	150 CONTINUE
903	CLOSE(funit)
904
905	IF (.NOT.vfound) THEN
906	msg = "variables file '" // TRIM(filevarn) // "' does not have varible '" // TRIM(vname) // &
907	"' !!"
908	CALL stoprun(msg, fname)
909	END IF
910
911	END SUBROUTINE put_var3D
912
913	SUBROUTINE put_var1Dt(ncid, d1, vals, vname, filevarn, it)
914	! Subroutine to write on a netCDF file a 1D float variable at a given time-step
915
916	USE netcdf
917
918	IMPLICIT NONE
919
920	INTEGER, INTENT(IN) :: ncid, d1, it
921	REAL, DIMENSION(d1), INTENT(IN) :: vals
922	CHARACTER(LEN=*), INTENT(IN) :: vname, filevarn
923
924	! Local
925	INTEGER :: funit, i, idvarnew, ios
926	INTEGER :: Nvals, rcode, varid
927	CHARACTER(LEN=50) :: ncvarname
928	CHARACTER(LEN=1000) :: line
929	CHARACTER(LEN=200), DIMENSION(6) :: valsline
930	LOGICAL :: vfound
931
932	!!!!!!! Variables
933	! ncid: netCDF file identifier
934	! d1: shape of the matrix
935	! vals: values to include
936	! vname: name of the variable in the model to be included
937	! filevarn: name of the ASCII file with the information about the variables
938	! it: time-step to add
939
940	fname = 'put_var1Dt'
941
942	! Reading variables file
943	funit = freeunit()
944	OPEN(funit, FILE=TRIM(filevarn), STATUS='old', FORM='formatted', IOSTAT=ios)
945	msg = "Problems to open variables file '" // TRIM(filevarn) // "' IOSTAT = "// &
946	TRIM(ItoS(ios)) // " !!"
947	IF ( ios /= 0 ) CALL stoprun(msg, fname)
948
949	Nvals = 6
950
951	idvarnew = 1
952	vfound = .FALSE.
953	DO i=1,1000
954	READ(funit, '(A1000)', END=150)line
955	IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
956	CALL split(line,'\|',Nvals,valsline)
957	IF (TRIM(vname) == TRIM(valsline(1))) THEN
958	ncvarname = TRIM(valsline(2))
959	CALL removeChar(ncvarname, ' ')
960	rcode = nf90_inq_varid(ncid, ncvarname, varid)
961	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
962
963	rcode = nf90_put_var(ncid, varid, vals, start=(/1,it/), count=(/d1,1/))
964	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
965	vfound = .TRUE.
966	CYCLE
967	END IF
968	END IF
969	END DO
970
971	150 CONTINUE
972
973	CLOSE(funit)
974	IF (.NOT.vfound) THEN
975	msg = "variables file '" // TRIM(filevarn) // "' does not have varible '" // TRIM(vname) // &
976	"' !!"
977	CALL stoprun(msg, fname)
978	END IF
979
980	END SUBROUTINE put_var1Dt
981
982	SUBROUTINE put_var2Dt(ncid, d1, d2, vals, vname, filevarn, it)
983	! Subroutine to write on a netCDF file a 2D float variable at a given time-step
984
985	USE netcdf
986
987	IMPLICIT NONE
988
989	INTEGER, INTENT(IN) :: ncid, d1, d2, it
990	REAL, DIMENSION(d1), INTENT(IN) :: vals
991	CHARACTER(LEN=*), INTENT(IN) :: vname, filevarn
992
993	! Local
994	INTEGER :: funit, i, idvarnew, ios
995	INTEGER :: Nvals, rcode, varid
996	CHARACTER(LEN=50) :: ncvarname
997	CHARACTER(LEN=1000) :: line
998	CHARACTER(LEN=200), DIMENSION(6) :: valsline
999	LOGICAL :: vfound
1000
1001	!!!!!!! Variables
1002	! ncid: netCDF file identifier
1003	! d1: shape of the matrix
1004	! vals: values to include
1005	! vname: name of the variable in the model to be included
1006	! filevarn: name of the ASCII file with the information about the variables
1007	! it: time-step to add
1008
1009	fname = 'put_var2Dt'
1010
1011	! Reading variables file
1012	funit = freeunit()
1013	OPEN(funit, FILE=TRIM(filevarn), STATUS='old', FORM='formatted', IOSTAT=ios)
1014	msg = "Problems to open variables file '" // TRIM(filevarn) // "' IOSTAT = "// &
1015	TRIM(ItoS(ios)) // " !!"
1016	IF ( ios /= 0 ) CALL stoprun(msg, fname)
1017
1018	Nvals = 6
1019
1020	idvarnew = 1
1021	vfound = .FALSE.
1022	DO i=1,1000
1023	READ(funit, '(A1000)', END=150)line
1024	IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
1025	CALL split(line,'\|',Nvals,valsline)
1026	IF (TRIM(vname) == TRIM(valsline(1))) THEN
1027	ncvarname = TRIM(valsline(2))
1028	CALL removeChar(ncvarname, ' ')
1029	rcode = nf90_inq_varid(ncid, ncvarname, varid)
1030	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1031
1032	rcode = nf90_put_var(ncid, varid, vals, start=(/1,1,it/), count=(/d1,d2,1/))
1033	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1034	vfound = .TRUE.
1035	CYCLE
1036	END IF
1037	END IF
1038	END DO
1039
1040	150 CONTINUE
1041
1042	CLOSE(funit)
1043	IF (.NOT.vfound) THEN
1044	msg = "variables file '" // TRIM(filevarn) // "' does not have varible '" // TRIM(vname) // &
1045	"' !!"
1046	CALL stoprun(msg, fname)
1047	END IF
1048
1049	END SUBROUTINE put_var2Dt
1050
1051	SUBROUTINE put_var3Dt(ncid, d1, d2, d3, vals, vname, filevarn, it)
1052	! Subroutine to write on a netCDF file a 3D float variable at a given time-step
1053
1054	USE netcdf
1055
1056	IMPLICIT NONE
1057
1058	INTEGER, INTENT(IN) :: ncid, d1, d2, d3, it
1059	REAL, DIMENSION(d1), INTENT(IN) :: vals
1060	CHARACTER(LEN=*), INTENT(IN) :: vname, filevarn
1061
1062	! Local
1063	INTEGER :: funit, i, idvarnew, ios
1064	INTEGER :: Nvals, rcode, varid
1065	CHARACTER(LEN=50) :: ncvarname
1066	CHARACTER(LEN=1000) :: line
1067	CHARACTER(LEN=200), DIMENSION(6) :: valsline
1068	LOGICAL :: vfound
1069
1070	!!!!!!! Variables
1071	! ncid: netCDF file identifier
1072	! d1,d2,d3: shape of the matrix
1073	! vals: values to include
1074	! vname: name of the variable in the model to be included
1075	! filevarn: name of the ASCII file with the information about the variables
1076	! it: time-step to add
1077
1078	fname = 'put_var3Dt'
1079
1080	! Reading variables file
1081	funit = freeunit()
1082	OPEN(funit, FILE=TRIM(filevarn), STATUS='old', FORM='formatted', IOSTAT=ios)
1083	msg = "Problems to open variables file '" // TRIM(filevarn) // "' IOSTAT = "// &
1084	TRIM(ItoS(ios)) // " !!"
1085	IF ( ios /= 0 ) CALL stoprun(msg, fname)
1086
1087	Nvals = 6
1088
1089	idvarnew = 1
1090	vfound = .FALSE.
1091	DO i=1,1000
1092	READ(funit, '(A1000)', END=150)line
1093	IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
1094	CALL split(line,'\|',Nvals,valsline)
1095	IF (TRIM(vname) == TRIM(valsline(1))) THEN
1096	ncvarname = TRIM(valsline(2))
1097	CALL removeChar(ncvarname, ' ')
1098	rcode = nf90_inq_varid(ncid, ncvarname, varid)
1099	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1100
1101	rcode = nf90_put_var(ncid, varid, vals, start=(/1,1,1,it/), count=(/d1,d2,d3,1/))
1102	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1103	vfound = .TRUE.
1104	CYCLE
1105	END IF
1106	END IF
1107	END DO
1108
1109	150 CONTINUE
1110
1111	CLOSE(funit)
1112	IF (.NOT.vfound) THEN
1113	msg = "variables file '" // TRIM(filevarn) // "' does not have varible '" // TRIM(vname) // &
1114	"' !!"
1115	CALL stoprun(msg, fname)
1116	END IF
1117
1118	END SUBROUTINE put_var3Dt
1119
1120	SUBROUTINE get_varI1D_ncunit(ncid, d1, vname, vals)
1121	! Subroutine to get a 1D integer variable from a netCDF file unit
1122
1123	USE netcdf
1124
1125	IMPLICIT NONE
1126
1127	INTEGER, INTENT(in) :: ncid, d1
1128	CHARACTER(LEN=*), INTENT(in) :: vname
1129	INTEGER, DIMENSION(d1), INTENT(out) :: vals
1130
1131	! Local
1132	INTEGER :: rcode, varid
1133	LOGICAL :: vfound
1134
1135	!!!!!!! Variables
1136	! ncid: netCDF file identifier
1137	! d1: shape of the matrix
1138	! vals: values to get
1139	! vname: name of the variable to getÂºÂº
1140
1141	fname = 'get_varI1D_ncunit'
1142
1143	vfound = isin_ncunit(ncid, vname)
1144
1145	IF (.NOT.vfound) THEN
1146	msg = "Unit file does not have variable '" // TRIM(vname) // "'"
1147	CALL ErrMsg(msg, fname, -1)
1148	END IF
1149
1150	rcode = nf90_inq_varid(ncid, vname, varid)
1151	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1152
1153	rcode = nf90_get_var(ncid, varid, vals)
1154	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1155
1156	END SUBROUTINE get_varI1D_ncunit
1157
1158	SUBROUTINE get_varI2D_ncunit(ncid, d1, d2, vname, vals)
1159	! Subroutine to get a 2D integer variable from a netCDF file unit
1160
1161	USE netcdf
1162
1163	IMPLICIT NONE
1164
1165	INTEGER, INTENT(in) :: ncid, d1, d2
1166	CHARACTER(LEN=*), INTENT(in) :: vname
1167	INTEGER, DIMENSION(d1,d2), INTENT(out) :: vals
1168
1169	! Local
1170	INTEGER :: rcode, varid
1171	LOGICAL :: vfound
1172
1173	!!!!!!! Variables
1174	! ncid: netCDF file identifier
1175	! d1: shape of the matrix
1176	! vals: values to get
1177	! vname: name of the variable to get
1178
1179	fname = 'get_varI2D_ncunit'
1180
1181	vfound = isin_ncunit(ncid, vname)
1182
1183	IF (.NOT.vfound) THEN
1184	msg = "Unit file does not have variable '" // TRIM(vname) // "'"
1185	CALL ErrMsg(msg, fname, -1)
1186	END IF
1187
1188	rcode = nf90_inq_varid(ncid, vname, varid)
1189	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1190
1191	rcode = nf90_get_var(ncid, varid, vals)
1192	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1193
1194	END SUBROUTINE get_varI2D_ncunit
1195
1196	SUBROUTINE get_varI3D_ncunit(ncid, d1, d2, d3, vname, vals)
1197	! Subroutine to get a 2D integer variable from a netCDF file unit
1198
1199	USE netcdf
1200
1201	IMPLICIT NONE
1202
1203	INTEGER, INTENT(in) :: ncid, d1, d2, d3
1204	CHARACTER(LEN=*), INTENT(in) :: vname
1205	INTEGER, DIMENSION(d1,d2,d3), INTENT(out) :: vals
1206
1207	! Local
1208	INTEGER :: rcode, varid
1209	LOGICAL :: vfound
1210
1211	!!!!!!! Variables
1212	! ncid: netCDF file identifier
1213	! d1: shape of the matrix
1214	! vals: values to get
1215	! vname: name of the variable to get
1216
1217	fname = 'get_varI3D_ncunit'
1218
1219	vfound = isin_ncunit(ncid, vname)
1220
1221	IF (.NOT.vfound) THEN
1222	msg = "Unit file does not have variable '" // TRIM(vname) // "'"
1223	CALL ErrMsg(msg, fname, -1)
1224	END IF
1225
1226	rcode = nf90_inq_varid(ncid, vname, varid)
1227	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1228
1229	rcode = nf90_get_var(ncid, varid, vals)
1230	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1231
1232	END SUBROUTINE get_varI3D_ncunit
1233
1234	SUBROUTINE get_varRK0D_ncunit(ncid, vname, vals)
1235	! Subroutine to get an scalar r_k float variable from a netCDF file unit
1236
1237	USE netcdf
1238
1239	IMPLICIT NONE
1240
1241	INTEGER, INTENT(in) :: ncid
1242	CHARACTER(LEN=*), INTENT(in) :: vname
1243	REAL, INTENT(out) :: vals
1244
1245	! Local
1246	INTEGER :: rcode, varid
1247	LOGICAL :: vfound
1248
1249	!!!!!!! Variables
1250	! ncid: netCDF file identifier
1251	! vals: values to get
1252	! vname: name of the variable to get
1253
1254	fname = 'get_varRK0D_ncunit'
1255
1256	vfound = isin_ncunit(ncid, vname)
1257
1258	IF (.NOT.vfound) THEN
1259	msg = "Unit file does not have variable '" // TRIM(vname) // "'"
1260	CALL ErrMsg(msg, fname, -1)
1261	END IF
1262
1263	rcode = nf90_inq_varid(ncid, vname, varid)
1264	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1265
1266	rcode = nf90_get_var(ncid, varid, vals)
1267	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1268
1269	END SUBROUTINE get_varRK0D_ncunit
1270
1271	SUBROUTINE get_varRK1D_ncunit(ncid, d1, vname, vals)
1272	! Subroutine to get a 1D r_k float variable from a netCDF file unit
1273
1274	USE netcdf
1275
1276	IMPLICIT NONE
1277
1278	INTEGER, INTENT(in) :: ncid, d1
1279	CHARACTER(LEN=*), INTENT(in) :: vname
1280	REAL, DIMENSION(d1), INTENT(out) :: vals
1281
1282	! Local
1283	INTEGER :: rcode, varid
1284	LOGICAL :: vfound
1285
1286	!!!!!!! Variables
1287	! ncid: netCDF file identifier
1288	! d1: shape of the matrix
1289	! vals: values to get
1290	! vname: name of the variable to get
1291
1292	fname = 'get_varRK1D_ncunit'
1293
1294	vfound = isin_ncunit(ncid, vname)
1295
1296	IF (.NOT.vfound) THEN
1297	msg = "Unit file does not have variable '" // TRIM(vname) // "'"
1298	CALL ErrMsg(msg, fname, -1)
1299	END IF
1300
1301	rcode = nf90_inq_varid(ncid, vname, varid)
1302	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1303
1304	rcode = nf90_get_var(ncid, varid, vals)
1305	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1306
1307	END SUBROUTINE get_varRK1D_ncunit
1308
1309	SUBROUTINE get_varRK2D_ncunit(ncid, d1, d2, vname, vals)
1310	! Subroutine to get a 2D r_k float variable from a netCDF file unit
1311
1312	USE netcdf
1313
1314	IMPLICIT NONE
1315
1316	INTEGER, INTENT(in) :: ncid, d1, d2
1317	CHARACTER(LEN=*), INTENT(in) :: vname
1318	REAL, DIMENSION(d1,d2), INTENT(out) :: vals
1319
1320	! Local
1321	INTEGER :: rcode, varid
1322	LOGICAL :: vfound
1323
1324	!!!!!!! Variables
1325	! ncid: netCDF file identifier
1326	! d1,d2: shape of the matrix
1327	! vals: values to get
1328	! vname: name of the variable to get
1329
1330	fname = 'get_varRK2D_ncunit'
1331
1332	vfound = isin_ncunit(ncid, vname)
1333
1334	IF (.NOT.vfound) THEN
1335	msg = "Unit file does not have variable '" // TRIM(vname) // "'"
1336	CALL ErrMsg(msg, fname, -1)
1337	END IF
1338
1339	rcode = nf90_inq_varid(ncid, vname, varid)
1340	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1341
1342	rcode = nf90_get_var(ncid, varid, vals)
1343	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1344
1345	END SUBROUTINE get_varRK2D_ncunit
1346
1347	SUBROUTINE get_varRK3D_ncunit(ncid, d1, d2, d3, vname, vals)
1348	! Subroutine to get a 3D r_k float variable from a netCDF file unit
1349
1350	USE netcdf
1351
1352	IMPLICIT NONE
1353
1354	INTEGER, INTENT(in) :: ncid, d1, d2, d3
1355	CHARACTER(LEN=*), INTENT(in) :: vname
1356	REAL, DIMENSION(d1,d2,d3), INTENT(out) :: vals
1357
1358	! Local
1359	INTEGER :: rcode, varid
1360	LOGICAL :: vfound
1361
1362	!!!!!!! Variables
1363	! ncid: netCDF file identifier
1364	! d1,d2,d3: shape of the matrix
1365	! vals: values to get
1366	! vname: name of the variable to get
1367
1368	fname = 'get_varRK3D_ncunit'
1369
1370	vfound = isin_ncunit(ncid, vname)
1371
1372	IF (.NOT.vfound) THEN
1373	msg = "Unit file does not have variable '" // TRIM(vname) // "'"
1374	CALL ErrMsg(msg, fname, -1)
1375	END IF
1376
1377	rcode = nf90_inq_varid(ncid, vname, varid)
1378	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1379
1380	rcode = nf90_get_var(ncid, varid, vals)
1381	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1382
1383	END SUBROUTINE get_varRK3D_ncunit
1384
1385	SUBROUTINE get_varRK4D_ncunit(ncid, d1, d2, d3, d4, vname, vals)
1386	! Subroutine to get a 4D r_k float variable from a netCDF file unit
1387
1388	USE netcdf
1389
1390	IMPLICIT NONE
1391
1392	INTEGER, INTENT(in) :: ncid, d1, d2, d3, d4
1393	CHARACTER(LEN=*), INTENT(in) :: vname
1394	REAL, DIMENSION(d1,d2,d3,d4), INTENT(out) :: vals
1395
1396	! Local
1397	INTEGER :: rcode, varid
1398	LOGICAL :: vfound
1399
1400	!!!!!!! Variables
1401	! ncid: netCDF file identifier
1402	! d1,d2,d3,d4: shape of the matrix
1403	! vals: values to get
1404	! vname: name of the variable to get
1405
1406	fname = 'get_varRK4D_ncunit'
1407
1408	vfound = isin_ncunit(ncid, vname)
1409
1410	IF (.NOT.vfound) THEN
1411	msg = "Unit file does not have variable '" // TRIM(vname) // "'"
1412	CALL ErrMsg(msg, fname, -1)
1413	END IF
1414
1415	rcode = nf90_inq_varid(ncid, vname, varid)
1416	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1417
1418	rcode = nf90_get_var(ncid, varid, vals)
1419	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1420
1421	END SUBROUTINE get_varRK4D_ncunit
1422
1423	END MODULE module_NCgeneric

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format