Context Navigation

module_generic.f90 @ 1661

Last change on this file since 1661 was 1660, checked in by lfita, 8 years ago
Working copy of the trajectories!
File size: 58.8 KB

Line
1	MODULE module_generic
2	! Module with generic functions
3
4	!!!!!!! Subroutines/Functions
5	! freeunit: provides the number of a free unit in which open a file
6	! GetInNamelist: Subroutine to get a paramter from a namelistfile
7	! index_list_coordsI: Function to provide the index of a given coordinate within a list of integer coordinates
8	! Index1DArrayI: Function to provide the first index of a given value inside a 1D integer array
9	! Index1DArrayR: Function to provide the first index of a given value inside a 1D real array
10	! Index1DArrayR_K: Function to provide the first index of a given value inside a 1D real(r_k) array
11	! Index2DArrayR: Function to provide the first index of a given value inside a 2D real array
12	! Index2DArrayR_K: Function to provide the first index of a given value inside a 2D real(r_k) array
13	! Nvalues_2DArrayI: Number of different values of a 2D integer array
14	! mat2DPosition: Function to provide the i, j indices of a given value inside a 2D matrix
15	! RangeI: Function to provide a range of d1 values from 'iniv' to 'endv', of integer values in a vector
16	! RangeR: Function to provide a range of d1 values from 'iniv' to 'endv', of real values in a vector
17	! RangeR_K: Function to provide a range of d1 from 'iniv' to 'endv', of real(r_k) values in a vector
18	! stoprun: Subroutine to stop running and print a message
19	! netCDF related
20	!!!
21	! create_NCfile: Subroutine to create a netCDF file
22	! handle_err: Subroutine to provide the error message when something with netCDF went wrong
23	! handle_errf: Subroutine to provide the error message when something with netCDF went wrong (including fname)
24	! isin_file: Function to tell if a given variable is inside a file
25	! isin_ncunit: Function to tell if a given variable is inside a netcdf file unit
26	! get_var2dims_file: Function to get the dimensions of a given 2D variable inside a file
27	! get_var3dims_file: Function to get the dimensions of a given 3D variable inside a file
28	! get_var4dims_file: Function to get the dimensions of a given 4D variable inside a file
29	! get_var1dims_ncunit: Function to get the dimensions of a given 1D variable inside a unit of a netCDF file
30	! get_var2dims_ncunit: Function to get the dimensions of a given 2D variable inside a unit of a netCDF file
31	! get_var3dims_ncunit: Function to get the dimensions of a given 3D variable inside a unit of a netCDF file
32	! get_varNdims_file: Function to get the number of dimensions of a given variable inside a file
33	! get_varNdims_ncunit: Function to get the number of dimensions of a given variable inside a unit of a netCDF file
34	! get_varI1D_ncunit: Subroutine to get a 1D integer variable from a netCDF file unit
35	! get_varI2D_ncunit: Subroutine to get a 2D integer variable from a netCDF file unit
36	! get_varRK0D_ncunit: Subroutine to get an scalar r_k float variable from a netCDF file unit
37	! get_varRK1D_ncunit: Subroutine to get a 1D r_k float variable from a netCDF file unit
38	! get_varRK2D_ncunit: Subroutine to get a 2D r_k float variable from a netCDF file unit
39	! get_varRK3D_ncunit: Subroutine to get a 3D r_k float variable from a netCDF file unit
40	! get_varRK2D_ncunit: Subroutine to get a 4D r_k float variable from a netCDF file unit
41	! put_var1D: Subroutine to write on a netCDF file a 1D float variable
42	! put_var2D: Subroutine to write on a netCDF file a 2D float variable
43	! put_var3D: Subroutine to write on a netCDF file a 3D float variable
44	! put_var1Dt: Subroutine to write on a netCDF file a 1D float variable at a given time-step
45	! put_var2Dt: Subroutine to write on a netCDF file a 2D float variable at a given time-step
46	! put_var3Dt: Subroutine to write on a netCDF file a 3D float variable at a given time-step
47
48	USE module_definitions
49	USE module_basic
50
51	CONTAINS
52
53	SUBROUTINE Nvalues_2DArrayI(dx, dy, dxy, mat2DI, Nvals, vals)
54	! Subroutine to give the number of different values of a 2D integer array
55
56	IMPLICIT NONE
57
58	INTEGER, INTENT(in) :: dx, dy, dxy
59	INTEGER, DIMENSION(dx,dy), INTENT(in) :: mat2DI
60	INTEGER, INTENT(out) :: Nvals
61	INTEGER, DIMENSION(dxy), INTENT(out) :: vals
62
63	! Local
64	INTEGER :: i, j, ij
65
66	!!!!!!! Variables
67	! dx, dy: size of the 2D space
68	! mat2DI: 2D integer matrix
69	! Nvals: number of different values
70	! vals: vector with the different values
71
72	fname = 'Nvalues_2DArrayI'
73
74	vals = 0
75
76	Nvals = 1
77	vals(1) = mat2DI(1,1)
78	DO i=1,dx
79	DO j=1,dy
80	IF (Index1DArrayI(vals, Nvals, mat2DI(i,j)) == -1) THEN
81	Nvals = Nvals + 1
82	vals(Nvals) = mat2DI(i,j)
83	END IF
84	END DO
85	END DO
86
87	RETURN
88
89	END SUBROUTINE Nvalues_2DArrayI
90
91	INTEGER FUNCTION index_list_coordsI(Ncoords, coords, icoord)
92	! Function to provide the index of a given coordinate within a list of integer coordinates
93
94	IMPLICIT NONE
95
96	INTEGER, INTENT(in) :: Ncoords
97	INTEGER, DIMENSION(Ncoords,2), INTENT(in) :: coords
98	INTEGER, DIMENSION(2), INTENT(in) :: icoord
99
100	! Local
101	INTEGER, DIMENSION(Ncoords) :: dist
102	INTEGER :: i,mindist
103	INTEGER, DIMENSION(1) :: iloc
104
105	!!!!!!! Variables
106	! Ncoords: number of coordinates in the list
107	! coords: list of coordinates
108	! icoord: coordinate to find
109
110	fname = 'index_list_coordsI'
111
112	dist = (coords(:,1)-icoord(1))2+(coords(:,2)-icoord(2))2
113
114	IF (ANY(dist == 0)) THEN
115	iloc = MINLOC(dist)
116	index_list_coordsI = iloc(1)
117	ELSE
118	index_list_coordsI = -1
119	END IF
120
121	END FUNCTION index_list_coordsI
122
123	INTEGER FUNCTION Index1DArrayI(array1D, d1, val)
124	! Function to provide the first index of a given value inside a 1D integer array
125
126	IMPLICIT NONE
127
128	INTEGER, INTENT(in) :: d1
129	INTEGER, INTENT(in) :: val
130	INTEGER, DIMENSION(d1), INTENT(in) :: array1D
131
132	! Local
133	INTEGER :: i
134
135	fname = 'Index1DArrayI'
136
137	Index1DArrayI = -1
138
139	DO i=1,d1
140	IF (array1d(i) == val) THEN
141	Index1DArrayI = i
142	EXIT
143	END IF
144	END DO
145
146	END FUNCTION Index1DArrayI
147
148	INTEGER FUNCTION Index1DArrayR(array1D, d1, val)
149	! Function to provide the first index of a given value inside a 1D real array
150
151	IMPLICIT NONE
152
153	INTEGER, INTENT(in) :: d1
154	REAL, INTENT(in) :: val
155	REAL, DIMENSION(d1), INTENT(in) :: array1D
156
157	! Local
158	INTEGER :: i
159
160	fname = 'Index1DArrayR'
161
162	Index1DArrayR = -1
163
164	DO i=1,d1
165	IF (array1d(i) == val) THEN
166	Index1DArrayR = i
167	EXIT
168	END IF
169	END DO
170
171	END FUNCTION Index1DArrayR
172
173	INTEGER FUNCTION Index1DArrayR_K(array1D, d1, val)
174	! Function to provide the first index of a given value inside a 1D real(r_k) array
175
176	IMPLICIT NONE
177
178	INTEGER, INTENT(in) :: d1
179	REAL(r_k), INTENT(in) :: val
180	REAL(r_k), DIMENSION(d1), INTENT(in) :: array1D
181
182	! Local
183	INTEGER :: i
184
185	fname = 'Index1DArrayR_K'
186
187	Index1DArrayR_K = -1
188
189	DO i=1,d1
190	IF (array1d(i) == val) THEN
191	Index1DArrayR_K = i
192	EXIT
193	END IF
194	END DO
195
196	END FUNCTION Index1DArrayR_K
197
198	FUNCTION Index2DArrayR(array2D, d1, d2, val)
199	! Function to provide the first index of a given value inside a 2D real array
200
201	IMPLICIT NONE
202
203	INTEGER, INTENT(in) :: d1, d2
204	REAL, INTENT(in) :: val
205	REAL, DIMENSION(d1,d2), INTENT(in) :: array2D
206	INTEGER, DIMENSION(2) :: Index2DArrayR
207
208	! Local
209	INTEGER :: i, j
210
211	fname = 'Index2DArrayR'
212
213	Index2DArrayR = -1
214
215	DO i=1,d1
216	DO j=1,d2
217	IF (array2d(i,j) == val) THEN
218	Index2DArrayR(1) = i
219	Index2DArrayR(2) = j
220	EXIT
221	END IF
222	END DO
223	END DO
224
225	END FUNCTION Index2DArrayR
226
227	FUNCTION Index2DArrayR_K(array2D, d1, d2, val)
228	! Function to provide the first index of a given value inside a 2D real array
229
230	IMPLICIT NONE
231
232	INTEGER, INTENT(in) :: d1, d2
233	REAL(r_k), INTENT(in) :: val
234	REAL(r_k), DIMENSION(d1,d2), INTENT(in) :: array2D
235	INTEGER, DIMENSION(2) :: Index2DArrayR_K
236
237	! Local
238	INTEGER :: i, j
239
240	fname = 'Index2DArrayR_K'
241
242	Index2DArrayR_K = -1
243
244	DO i=1,d1
245	DO j=1,d2
246	IF (array2d(i,j) == val) THEN
247	Index2DArrayR_K(1) = i
248	Index2DArrayR_K(2) = j
249	EXIT
250	END IF
251	END DO
252	END DO
253
254	END FUNCTION Index2DArrayR_K
255
256	FUNCTION RangeI(d1, iniv, endv)
257	! Function to provide a range of d1 values from 'iniv' to 'endv', of integer values in a vector
258
259	IMPLICIT NONE
260
261	INTEGER, INTENT(in) :: d1, iniv, endv
262	INTEGER, DIMENSION(d1) :: RangeI
263
264	! Local
265	INTEGER :: i, intv
266
267	fname = 'RangeI'
268
269	intv = (endv - iniv) / (d1*1 - 1)
270
271	RangeI(1) = iniv
272	DO i=2,d1
273	RangeI(i) = RangeI(i-1) + intv
274	END DO
275
276	END FUNCTION RangeI
277
278	FUNCTION RangeR(d1, iniv, endv)
279	! Function to provide a range of d1 from 'iniv' to 'endv', of real values in a vector
280
281	IMPLICIT NONE
282
283	INTEGER, INTENT(in) :: d1
284	REAL, INTENT(in) :: iniv, endv
285	REAL, DIMENSION(d1) :: RangeR
286
287	! Local
288	INTEGER :: i
289	REAL :: intv
290
291	fname = 'RangeR'
292
293	intv = (endv - iniv) / (d1*1. - 1.)
294
295	RangeR(1) = iniv
296	DO i=2,d1
297	RangeR(i) = RangeR(i-1) + intv
298	END DO
299
300	END FUNCTION RangeR
301
302	FUNCTION RangeR_K(d1, iniv, endv)
303	! Function to provide a range of d1 from 'iniv' to 'endv', of real(r_k) values in a vector
304
305	IMPLICIT NONE
306
307	INTEGER, INTENT(in) :: d1
308	REAL(r_k), INTENT(in) :: iniv, endv
309	REAL(r_k), DIMENSION(d1) :: RangeR_K
310
311	! Local
312	INTEGER :: i
313	REAL(r_k) :: intv
314
315	fname = 'RangeR_K'
316
317	intv = (endv - iniv) / (d1*oneRK-oneRK)
318
319	RangeR_K(1) = iniv
320	DO i=2,d1
321	RangeR_K(i) = RangeR_K(i-1) + intv
322	END DO
323
324	END FUNCTION RangeR_K
325
326	INTEGER FUNCTION freeunit()
327	! provides the number of a free unit in which open a file
328
329	IMPLICIT NONE
330
331	LOGICAL :: is_used
332
333	is_used = .true.
334	DO freeunit=10,100
335	INQUIRE(unit=freeunit, opened=is_used)
336	IF (.not. is_used) EXIT
337	END DO
338
339	RETURN
340
341	END FUNCTION freeunit
342
343	SUBROUTINE GetInNamelist(namelistfile, param, kindparam, Ival, Rval, Lval, Sval)
344	! Subroutine to get a paramter from a namelistfile
345
346	IMPLICIT NONE
347
348	CHARACTER(LEN=*), INTENT(IN) :: namelistfile, param
349	CHARACTER(LEN=1), INTENT(IN) :: kindparam
350	INTEGER, OPTIONAL, INTENT(OUT) :: Ival
351	REAL, OPTIONAL, INTENT(OUT) :: Rval
352	LOGICAL, OPTIONAL, INTENT(OUT) :: Lval
353	CHARACTER(LEN=200), OPTIONAL, INTENT(OUT) :: Sval
354
355	! Local
356	INTEGER :: i, funit, ios
357	INTEGER :: Lparam, posparam
358	LOGICAL :: is_used
359	CHARACTER(LEN=1000) :: line, message
360	CHARACTER(LEN=200), DIMENSION(2) :: lvals
361	CHARACTER(LEN=200) :: pval
362
363	!!!!!!! Variables
364	! namelistfile: name of the namelist file
365	! param: parameter to get
366	! paramkind: kind of the parameter (I: Integer, L: boolean, R: Real, S: String)
367
368	fname = 'GetInNamelist'
369
370	! Reading dimensions file and defining dimensions
371	is_used = .true.
372	DO funit=10,100
373	INQUIRE(unit=funit, opened=is_used)
374	IF (.not. is_used) EXIT
375	END DO
376
377	OPEN(funit, FILE=TRIM(namelistfile), STATUS='old', FORM='formatted', IOSTAT=ios)
378	IF ( ios /= 0 ) CALL stoprun(message, fname)
379
380	Lparam = LEN_TRIM(param)
381
382	DO i=1,10000
383	READ(funit,"(A200)",END=100)line
384	posparam = INDEX(TRIM(line), TRIM(param))
385	IF (posparam /= 0) EXIT
386
387	END DO
388	100 CONTINUE
389
390	IF (posparam == 0) THEN
391	message = "namelist '" // TRIM(namelistfile) // "' does not have parameter '" // TRIM(param) // &
392	"' !!"
393	CALL stoprun(message, fname)
394	END IF
395
396	CLOSE(UNIT=funit)
397
398	CALL split(line, '=', 2, lvals)
399	IF (kindparam /= 'S') THEN
400	CALL RemoveNonNum(lvals(2), pval)
401	END IF
402
403	! L. Fita, LMD. October 2015
404	! Up to now, only getting scalar values
405	kparam: SELECT CASE (kindparam)
406	CASE ('I')
407	Ival = StoI(pval)
408	! PRINT *,TRIM(param),'= ', Ival
409	CASE ('L')
410	Lval = StoL(pval)
411	! PRINT *,TRIM(param),'= ', Lval
412	CASE ('R')
413	Rval = StoR(pval)
414	! PRINT *,TRIM(param),'= ', Rval
415	CASE ('S')
416	Sval = lvals(2)
417
418	CASE DEFAULT
419	message = "type of parameter '" // kindparam // "' not ready !!"
420	CALL stoprun(message, fname)
421
422	END SELECT kparam
423
424	END SUBROUTINE GetInNamelist
425
426	SUBROUTINE stoprun(msg, fname)
427	! Subroutine to stop running and print a message
428
429	IMPLICIT NONE
430
431	CHARACTER(LEN=*), INTENT(IN) :: fname
432	CHARACTER(LEN=*), INTENT(IN) :: msg
433
434	! local
435	CHARACTER(LEN=50) :: errmsg, warnmsg
436
437	errmsg = 'ERROR -- error -- ERROR -- error'
438
439	PRINT *, TRIM(errmsg)
440	PRINT *, ' ' // TRIM(fname) // ': ' // TRIM(msg)
441	STOP -1
442
443	END SUBROUTINE stoprun
444
445	!!!!!!! !!!!!! !!!!! !!!! !!! !! !
446	! Netcdf derived
447
448	! From UNIDATA: https://www.unidata.ucar.edu/software/netcdf/docs/netcdf-f90.html
449	SUBROUTINE handle_err(st)
450	! Subroutine to provide the error message when something with netCDF went wrong
451
452	USE netcdf
453
454	INTEGER, INTENT(in) :: st
455
456	!!!!!!! Variables
457	! fn: function name from which it is used
458
459	IF (st /= nf90_noerr) THEN
460	PRINT *, TRIM(emsg)
461	PRINT *, ' ' // TRIM(nf90_strerror(st))
462	STOP "Stopped"
463	END IF
464
465	END SUBROUTINE handle_err
466
467	! From UNIDATA: https://www.unidata.ucar.edu/software/netcdf/docs/netcdf-f90.html
468	SUBROUTINE handle_errf(st, fn)
469	! Subroutine to provide the error message when something with netCDF went wrong (including fname)
470
471	USE netcdf
472
473	INTEGER, INTENT(in) :: st
474	CHARACTER(len=*), INTENT(in) :: fn
475
476	!!!!!!! Variables
477	! st: netCDF status number
478	! fn: function name from which it is used
479
480	IF (st /= nf90_noerr) THEN
481	PRINT *, TRIM(emsg)
482	PRINT *, ' ' // TRIM(fn) // ': ' // TRIM(nf90_strerror(st))
483	STOP "Stopped"
484	END IF
485
486	END SUBROUTINE handle_errf
487
488	SUBROUTINE create_NCfile(filename, dimsfile, namelistfile, varsfile, ncid)
489	! Subroutine to create a netCDF file
490
491	USE netcdf
492
493	IMPLICIT NONE
494
495	INCLUDE 'netcdf.inc'
496
497	CHARACTER(LEN=*), INTENT(IN) :: filename, dimsfile, namelistfile, varsfile
498	INTEGER, INTENT(OUT) :: ncid
499
500	! Local
501	INTEGER :: i, j, k, idimnew
502	INTEGER :: rcode, funit, funit2, ios
503	INTEGER :: Nvals, dimsize, dimid, iddimnew, Ntotdims
504	INTEGER :: idvarnew, vartype
505	CHARACTER(LEN=200) :: message, vd, vs, vdd, val
506	CHARACTER(LEN=200) :: vname, Lvname, vunits, coornames
507	CHARACTER(LEN=200), DIMENSION(:), ALLOCATABLE :: valsline, dimsizes
508	CHARACTER(LEN=1000) :: line, dimsline
509	INTEGER, DIMENSION(:), ALLOCATABLE :: dimsvar
510	INTEGER :: Ldimsize, Ldimsvar, dvarL
511	CHARACTER(LEN=1) :: dvarn
512
513	!!!!!!! Variables
514	! filename: name of the file to create
515	! dimsfile: ASCII file with the name of the dimensions to create with ('#' for comentaries)
516	! [dim name]\| [dim orig in WRF]\| [dim orig in namelist]\| ['unlimited' also, 'namelist' (from namelist parameter)]
517	! namelistfile: name of the Namelist file
518	! varsfile: ASCII file with the name of the variables to create with ('#' for comentaries)
519	! [WRFvarname]\| [var name]\| [long var name]\| [var units]\| [var dimensions]
520	! ncid: number assigned to the file
521
522	fname = 'create_NCfile'
523
524	! Opening creation status
525	rcode = nf90_create(TRIM(filename), NF90_NETCDF4, ncid)
526	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
527
528	! Reading dimensions file
529	funit = freeunit()
530	OPEN(funit, FILE=TRIM(dimsfile), STATUS='old', FORM='formatted', IOSTAT=ios)
531	message = "Problems to open varibales file '" // TRIM(varsfile) // "' IOSTAT = "// &
532	TRIM(ItoS(ios)) // " !!"
533	IF ( ios /= 0 ) CALL stoprun(message, fname)
534
535	Nvals = 4
536	IF (ALLOCATED(valsline)) DEALLOCATE(valsline)
537	ALLOCATE (valsline(Nvals))
538
539	! Creation of dimensions
540	idimnew = 3
541	dimsline = ''
542	Ntotdims = 0
543	DO i=1,1000
544	READ(funit, '(A1000)', END=100)line
545	IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
546	CALL split(line,'\|',Nvals,valsline)
547	CALL removeChar(valsline(4),' ')
548	IF (TRIM(valsline(4)) == 'unlimited') THEN
549	idimnew = idimnew + 1
550	dimsize = NF90_UNLIMITED
551	dimid = idimnew
552	ELSE IF (TRIM(valsline(4)) == 'namelist') THEN
553	CALL GetInNamelist(namelistfile, valsline(3), 'I', Ival=dimsize)
554	SELECT CASE (TRIM(valsline(2)))
555	CASE ('i')
556	dimid = 1
557	CASE ('j')
558	dimid = 2
559	CASE ('k')
560	dimid = 3
561	CASE ('t')
562	dimid = 4
563	dimsize = NF90_UNLIMITED
564	CASE DEFAULT
565	idimnew = idimnew + 1
566	dimid = idimnew
567	END SELECT
568	END IF
569	rcode = nf90_def_dim(ncid, TRIM(valsline(1)), dimsize, dimid)
570	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
571	vs = valsline(2)
572	CALL removeChar(vs, ' ')
573	CALL attachString(dimsline, TRIM(vs) // ':' // TRIM(ItoS(dimid)) // ';')
574	Ntotdims = Ntotdims + 1
575	END IF
576	END DO
577
578	100 CONTINUE
579	CLOSE(funit)
580
581	! Sort of python dictionary for [dimn]:[dimsize]...
582	IF (ALLOCATED(dimsizes)) DEALLOCATE(dimsizes)
583	ALLOCATE(dimsizes(Ntotdims))
584	CALL split(dimsline,';',Ntotdims,dimsizes)
585
586	! Reading variables file
587	funit = freeunit()
588	OPEN(funit, FILE=TRIM(varsfile), STATUS='old', FORM='formatted', IOSTAT=ios)
589
590	message = "Problems to open varibales file '" // TRIM(varsfile) // "' IOSTAT = "// &
591	TRIM(ItoS(ios)) // " !!"
592	IF ( ios /= 0 ) CALL stoprun(message, fname)
593
594	Nvals = 6
595	IF (ALLOCATED(valsline)) DEALLOCATE(valsline)
596	ALLOCATE (valsline(Nvals))
597
598	! Defining variables
599	idvarnew = 1
600	DO i=1,1000
601	READ(funit, '(A1000)', END=150)line
602	IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
603	CALL split(line,'\|',Nvals,valsline)
604	vtype: SELECT CASE (TRIM(valsline(6)))
605	CASE ('B')
606	vartype = NF_BYTE
607	CASE ('C')
608	vartype = NF_CHAR
609	CASE ('I')
610	vartype = NF_SHORT
611	CASE ('I16')
612	vartype = NF_INT
613	CASE ('R')
614	vartype = NF_FLOAT
615	CASE ('R16')
616	vartype = NF_DOUBLE
617	END SELECT vtype
618
619	vd = valsline(5)
620	CALL removeChar(vd, ' ')
621	Ldimsvar = LEN_TRIM(vd)
622	IF (ALLOCATED(dimsvar)) DEALLOCATE(dimsvar)
623	ALLOCATE(dimsvar(Ldimsvar))
624
625	! Variable's dimensions
626	coornames = ''
627	DO j=1, Ldimsvar
628	DO k=1, Ntotdims
629	IF (dimsizes(k)(1:1) == vd(j:j)) THEN
630	Ldimsize = LEN_TRIM(dimsizes(k))
631	vdd = dimsizes(k)(3:Ldimsize)
632	dimsvar(j) = StoI(vdd)
633	! Too complicated to assign dimvarname... (or too lazy)
634	! coornames = coornames //
635	CYCLE
636	END IF
637	END DO
638	END DO
639	vname = valsline(2)
640	CALL removeChar(vname, ' ')
641	vartype = 5
642
643	rcode = nf90_def_var(ncid, vname, vartype, dimsvar, idvarnew)
644	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
645
646	! Adding attributes
647	rcode = nf90_put_att(ncid, idvarnew, 'standard_name', TRIM(valsline(2)))
648	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
649	rcode = nf90_put_att(ncid, idvarnew, 'long_name', TRIM(valsline(3)))
650	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
651	rcode = nf90_put_att(ncid, idvarnew, 'units', TRIM(valsline(4)))
652	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
653
654	idvarnew = idvarnew + 1
655	END IF
656	END DO
657
658	150 CONTINUE
659	CLOSE(funit)
660
661	rcode = NF90_ENDDEF(ncid)
662	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
663
664	DEALLOCATE(valsline)
665	DEALLOCATE(dimsizes)
666
667	END SUBROUTINE create_NCfile
668
669	FUNCTION get_var2dims_file(filename, varname)
670	! Function to get the dimensions of a given 2D variable inside a file
671
672	USE netcdf
673
674	IMPLICIT NONE
675
676	CHARACTER(LEN=*), INTENT(in) :: filename, varname
677	! Following: http://stackoverflow.com/questions/3828094/function-returning-an-array-in-fortran
678	INTEGER, DIMENSION(2) :: get_var2dims_file
679
680	! Local
681	INTEGER :: nid, vid, Ndims
682	INTEGER :: rcode
683	INTEGER, DIMENSION(2) :: dimsid
684
685	!!!!!!! Variables
686	! filename: name of the file to open
687	! varname: name of the variable
688
689	fname = 'get_var2dims_file'
690	!PRINT *,TRIM(fname)
691
692	! Opening creation status
693	rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
694	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
695
696	rcode = nf90_inq_varid(nid, varname, vid)
697	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
698
699	rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
700	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
701
702	IF (Ndims /= 2) THEN
703	msg = "variable '" // TRIM(varname) // "' has not 2 dimensions!!"
704	CALL stoprun(msg, fname)
705	END IF
706
707	rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
708	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
709
710	rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = get_var2dims_file(1))
711	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
712
713	rcode = nf90_inquire_dimension(nid, dimsid(2), LEN = get_var2dims_file(2))
714	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
715
716	rcode = NF90_CLOSE(nid)
717	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
718
719	END FUNCTION get_var2dims_file
720
721	FUNCTION get_var3dims_file(filename, varname)
722	! Function to get the dimensions of a given 3D variable inside a file
723
724	USE netcdf
725
726	IMPLICIT NONE
727
728	CHARACTER(LEN=*), INTENT(in) :: filename, varname
729	! Following: http://stackoverflow.com/questions/3828094/function-returning-an-array-in-fortran
730	INTEGER, DIMENSION(3) :: get_var3dims_file
731
732	! Local
733	INTEGER :: nid, vid, Ndims
734	INTEGER :: rcode
735	INTEGER, DIMENSION(3) :: dimsid
736
737
738	!!!!!!! Variables
739	! filename: name of the file to open
740	! varname: name of the variable
741
742	fname = 'get_var3dims_file'
743	!PRINT *,TRIM(fname)
744
745	! Opening creation status
746	rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
747	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
748
749	rcode = nf90_inq_varid(nid, varname, vid)
750	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
751
752	rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
753	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
754
755	IF (Ndims /= 3) THEN
756	msg = "variable '" // TRIM(varname) // "' has not 3 dimensions!!"
757	CALL stoprun(msg, fname)
758	END IF
759
760	rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
761	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
762
763	rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = get_var3dims_file(1))
764	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
765
766	rcode = nf90_inquire_dimension(nid, dimsid(2), LEN = get_var3dims_file(2))
767	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
768
769	rcode = nf90_inquire_dimension(nid, dimsid(3), LEN = get_var3dims_file(3))
770	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
771
772	rcode = NF90_CLOSE(nid)
773	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
774
775	END FUNCTION get_var3dims_file
776
777	FUNCTION get_var1dims_ncunit(nid, varname)
778	! Function to get the dimensions of a given 1D variable inside a unit of a netCDF file
779
780	USE netcdf
781
782	IMPLICIT NONE
783
784	INTEGER, INTENT(in) :: nid
785	CHARACTER(LEN=*), INTENT(in) :: varname
786	! Following: http://stackoverflow.com/questions/3828094/function-returning-an-array-in-fortran
787	INTEGER, DIMENSION(1) :: get_var1dims_ncunit
788
789	! Local
790	INTEGER :: vid, Ndims
791	INTEGER :: rcode
792	INTEGER, DIMENSION(1) :: dimsid
793
794
795	!!!!!!! Variables
796	! filename: name of the file to open
797	! varname: name of the variable
798
799	fname = 'get_var1dims_ncunit'
800	!PRINT *,TRIM(fname)
801
802	rcode = nf90_inq_varid(nid, varname, vid)
803	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
804
805	rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
806	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
807
808	IF (Ndims /= 1) THEN
809	msg = "variable '" // TRIM(varname) // "' has not 1 dimensions!!"
810	CALL stoprun(msg, fname)
811	END IF
812
813	rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
814	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
815
816	rcode = nf90_inquire_dimension(nid, dimsid(1), name=msg)
817
818	rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = get_var1dims_ncunit(1))
819	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
820
821	END FUNCTION get_var1dims_ncunit
822
823	FUNCTION get_var2dims_ncunit(nid, varname)
824	! Function to get the dimensions of a given 2D variable inside a unit of a netCDF file
825
826	USE netcdf
827
828	IMPLICIT NONE
829
830	INTEGER, INTENT(in) :: nid
831	CHARACTER(LEN=*), INTENT(in) :: varname
832	! Following: http://stackoverflow.com/questions/3828094/function-returning-an-array-in-fortran
833	INTEGER, DIMENSION(2) :: get_var2dims_ncunit
834
835	! Local
836	INTEGER :: vid, Ndims
837	INTEGER :: rcode
838	INTEGER, DIMENSION(2) :: dimsid
839
840
841	!!!!!!! Variables
842	! filename: name of the file to open
843	! varname: name of the variable
844
845	fname = 'get_var2dims_ncunit'
846	!PRINT *,TRIM(fname)
847
848	rcode = nf90_inq_varid(nid, varname, vid)
849	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
850
851	rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
852	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
853
854	IF (Ndims /= 2) THEN
855	msg = "variable '" // TRIM(varname) // "' has not 2 dimensions!!"
856	CALL stoprun(msg, fname)
857	END IF
858
859	rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
860	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
861
862	rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = get_var2dims_ncunit(1))
863	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
864
865	rcode = nf90_inquire_dimension(nid, dimsid(2), LEN = get_var2dims_ncunit(2))
866	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
867
868	END FUNCTION get_var2dims_ncunit
869
870	FUNCTION get_var3dims_ncunit(nid, varname)
871	! Function to get the dimensions of a given 3D variable inside a unit of a netCDF file
872
873	USE netcdf
874
875	IMPLICIT NONE
876
877	INTEGER, INTENT(in) :: nid
878	CHARACTER(LEN=*), INTENT(in) :: varname
879	! Following: http://stackoverflow.com/questions/3828094/function-returning-an-array-in-fortran
880	INTEGER, DIMENSION(3) :: get_var3dims_ncunit
881
882	! Local
883	INTEGER :: vid, Ndims
884	INTEGER :: rcode
885	INTEGER, DIMENSION(3) :: dimsid
886
887
888	!!!!!!! Variables
889	! filename: name of the file to open
890	! varname: name of the variable
891
892	fname = 'get_var3dims_ncunit'
893	!PRINT *,TRIM(fname)
894
895	rcode = nf90_inq_varid(nid, varname, vid)
896	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
897
898	rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
899	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
900
901	IF (Ndims /= 3) THEN
902	msg = "variable '" // TRIM(varname) // "' has not 3 dimensions!!"
903	CALL stoprun(msg, fname)
904	END IF
905
906	rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
907	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
908
909	rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = get_var3dims_ncunit(1))
910	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
911
912	rcode = nf90_inquire_dimension(nid, dimsid(2), LEN = get_var3dims_ncunit(2))
913	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
914
915	rcode = nf90_inquire_dimension(nid, dimsid(3), LEN = get_var3dims_ncunit(3))
916	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
917
918	END FUNCTION get_var3dims_ncunit
919
920	FUNCTION get_var4dims_file(filename, varname)
921	! Function to get the dimensions of a given 4D variable inside a file
922
923	USE netcdf
924
925	IMPLICIT NONE
926
927	CHARACTER(LEN=*), INTENT(in) :: filename, varname
928	! Following: http://stackoverflow.com/questions/3828094/function-returning-an-array-in-fortran
929	INTEGER, DIMENSION(4) :: get_var4dims_file
930
931	! Local
932	INTEGER :: nid, vid, Ndims
933	INTEGER :: rcode
934	INTEGER, DIMENSION(4) :: dimsid
935
936
937	!!!!!!! Variables
938	! filename: name of the file to open
939	! varname: name of the variable
940
941	fname = 'get_var4dims_file'
942	!PRINT *,TRIM(fname)
943
944	! Opening creation status
945	rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
946	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
947
948	rcode = nf90_inq_varid(nid, varname, vid)
949	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
950
951	rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
952	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
953
954	IF (Ndims /= 4) THEN
955	msg = "variable '" // TRIM(varname) // "' has not 4 dimensions!!"
956	CALL stoprun(msg, fname)
957	END IF
958
959	rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
960	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
961
962	rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = get_var4dims_file(1))
963	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
964
965	rcode = nf90_inquire_dimension(nid, dimsid(2), LEN = get_var4dims_file(2))
966	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
967
968	rcode = nf90_inquire_dimension(nid, dimsid(3), LEN = get_var4dims_file(3))
969	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
970
971	rcode = nf90_inquire_dimension(nid, dimsid(4), LEN = get_var4dims_file(4))
972	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
973
974	rcode = NF90_CLOSE(nid)
975	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
976
977	END FUNCTION get_var4dims_file
978
979	INTEGER FUNCTION get_varNdims_file(filename, varname)
980	! Function to get the number of dimensions of a given variable inside a file
981
982	USE netcdf
983
984	IMPLICIT NONE
985
986	CHARACTER(LEN=*), INTENT(in) :: filename, varname
987
988	! Local
989	INTEGER :: nid, vid
990	INTEGER :: rcode
991
992	!!!!!!! Variables
993	! filename: name of the file to open
994	! varname: name of the variable
995
996	fname = 'get_varNdims_file'
997	!PRINT *,TRIM(fname)
998
999	! Opening creation status
1000	rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
1001	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1002
1003	rcode = nf90_inq_varid(nid, varname, vid)
1004	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1005
1006	rcode = nf90_inquire_variable(nid, vid, NDIMS = get_varNdims_file)
1007	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1008
1009	rcode = NF90_CLOSE(nid)
1010	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1011
1012	END FUNCTION get_varNdims_file
1013
1014	INTEGER FUNCTION get_varNdims_ncunit(nid, varname)
1015	! Function to get the number of dimensions of a given variable inside a unit of a netCDF file
1016
1017	USE netcdf
1018
1019	IMPLICIT NONE
1020
1021	INTEGER, INTENT(in) :: nid
1022	CHARACTER(LEN=*), INTENT(in) :: varname
1023
1024	! Local
1025	INTEGER :: vid
1026	INTEGER :: rcode
1027
1028	!!!!!!! Variables
1029	! filename: name of the file to open
1030	! varname: name of the variable
1031
1032	fname = 'get_varNdims_ncunit'
1033	!PRINT *,TRIM(fname)
1034
1035	rcode = nf90_inq_varid(nid, varname, vid)
1036	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1037
1038	rcode = nf90_inquire_variable(nid, vid, NDIMS = get_varNdims_ncunit)
1039	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1040
1041	END FUNCTION get_varNdims_ncunit
1042
1043	LOGICAL FUNCTION isin_file(filename, varname)
1044	! Function to tell if a given variable is inside a file
1045
1046	USE netcdf
1047
1048	IMPLICIT NONE
1049
1050	CHARACTER(LEN=*), INTENT(in) :: filename, varname
1051
1052	! Local
1053	INTEGER :: nid, vid, Ndims, Nvars
1054	INTEGER :: iv, rcode
1055	CHARACTER(LEN=1000) :: varinfile
1056
1057	!!!!!!! Variables
1058	! filename: name of the file to open
1059	! varname: name of the variable
1060
1061	fname = 'isin_file'
1062
1063	! Opening creation status
1064	rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
1065	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1066
1067	rcode = nf90_inquire(nid, Ndims, Nvars)
1068	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1069
1070	DO iv=1, Nvars
1071	rcode = nf90_inquire_variable(nid, iv, name=varinfile)
1072	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1073	IF (TRIM(varinfile) == TRIM(varname)) THEN
1074	isin_file = .TRUE.
1075	EXIT
1076	ELSE
1077	isin_file = .FALSE.
1078	END IF
1079	END DO
1080
1081	rcode = NF90_CLOSE(nid)
1082	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1083
1084	END FUNCTION isin_file
1085
1086	LOGICAL FUNCTION isin_ncunit(nid, varname)
1087	! Function to tell if a given variable is inside a netcdf file unit
1088
1089	USE netcdf
1090
1091	IMPLICIT NONE
1092
1093	INTEGER, INTENT(in) :: nid
1094	CHARACTER(LEN=*), INTENT(in) :: varname
1095
1096	! Local
1097	INTEGER :: vid, Ndims, Nvars
1098	INTEGER :: iv, rcode
1099	CHARACTER(LEN=1000) :: varinfile
1100
1101	!!!!!!! Variables
1102	! nid: number of the opened netCDF
1103	! varname: name of the variable
1104
1105	fname = 'isin_ncunit'
1106
1107	rcode = nf90_inquire(nid, Ndims, Nvars)
1108	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1109
1110	DO iv=1, Nvars
1111	rcode = nf90_inquire_variable(nid, iv, name=varinfile)
1112	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1113	IF (TRIM(varinfile) == TRIM(varname)) THEN
1114	isin_ncunit = .TRUE.
1115	EXIT
1116	ELSE
1117	isin_ncunit = .FALSE.
1118	END IF
1119	END DO
1120
1121	END FUNCTION isin_ncunit
1122
1123	SUBROUTINE put_var1D(ncid, d1, vals, vname, filevarn)
1124	! Subroutine to write on a netCDF file a 1D float variable
1125
1126	USE netcdf
1127
1128	IMPLICIT NONE
1129
1130	INTEGER, INTENT(IN) :: ncid, d1
1131	REAL, DIMENSION(d1), INTENT(IN) :: vals
1132	CHARACTER(LEN=*), INTENT(IN) :: vname, filevarn
1133
1134	! Local
1135	INTEGER :: funit, i, idvarnew, ios
1136	INTEGER :: Nvals, rcode, varid
1137	CHARACTER(LEN=50) :: ncvarname
1138	CHARACTER(LEN=1000) :: line
1139	CHARACTER(LEN=200), DIMENSION(6) :: valsline
1140	LOGICAL :: vfound
1141
1142	!!!!!!! Variables
1143	! ncid: netCDF file identifier
1144	! d1: shape of the matrix
1145	! vals: values to include
1146	! vname: name of the variable in the model to be included
1147	! filevarn: name of the ASCII file with the information about the variables
1148	fname = 'put_var1D'
1149
1150	! Reading variables file
1151	funit = freeunit()
1152	OPEN(funit, FILE=TRIM(filevarn), STATUS='old', FORM='formatted', IOSTAT=ios)
1153	msg = "Problems to open variables file '" // TRIM(filevarn) // "' IOSTAT = "// &
1154	TRIM(ItoS(ios)) // " !!"
1155	IF ( ios /= 0 ) CALL stoprun(msg, fname)
1156
1157	Nvals = 6
1158
1159	idvarnew = 1
1160	vfound = .FALSE.
1161	DO i=1,1000
1162	READ(funit, '(A1000)', END=150)line
1163	IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
1164	CALL split(line,'\|',Nvals,valsline)
1165	IF (TRIM(vname) == TRIM(valsline(1))) THEN
1166	ncvarname = TRIM(valsline(2))
1167	CALL removeChar(ncvarname, ' ')
1168	rcode = nf90_inq_varid(ncid, ncvarname, varid)
1169	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1170
1171	rcode = nf90_put_var(ncid, varid, vals)
1172	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1173	vfound = .TRUE.
1174	CYCLE
1175	END IF
1176	END IF
1177	END DO
1178
1179	150 CONTINUE
1180
1181	CLOSE(funit)
1182	IF (.NOT.vfound) THEN
1183	msg = "variables file '" // TRIM(filevarn) // "' does not have varible '" // TRIM(vname) // &
1184	"' !!"
1185	CALL stoprun(msg, fname)
1186	END IF
1187
1188	END SUBROUTINE put_var1D
1189
1190	SUBROUTINE put_var2D(ncid, d1, d2, vals, vname, filevarn)
1191	! Subroutine to write on a netCDF file a 2D float variable
1192
1193	USE netcdf
1194
1195	IMPLICIT NONE
1196
1197	INTEGER, INTENT(IN) :: ncid, d1, d2
1198	REAL, DIMENSION(d1,d2), INTENT(IN) :: vals
1199	CHARACTER(LEN=*), INTENT(IN) :: vname, filevarn
1200
1201	! Local
1202	INTEGER :: funit, i, idvarnew, ios
1203	INTEGER :: Nvals, rcode, varid
1204	CHARACTER(LEN=50) :: ncvarname
1205	CHARACTER(LEN=1000) :: line
1206	CHARACTER(LEN=200), DIMENSION(6) :: valsline
1207	LOGICAL :: vfound
1208
1209	!!!!!!! Variables
1210	! ncid: netCDF file identifier
1211	! d1,d2: shape of the matrix
1212	! vals: values to include
1213	! vname: name of the variable in the model to be included
1214	! filevarn: name of the ASCII file with the information about the variables
1215	fname = 'put_var2D'
1216
1217	! Reading variables file
1218	funit = freeunit()
1219	OPEN(funit, FILE=TRIM(filevarn), STATUS='old', FORM='formatted', IOSTAT=ios)
1220	msg = "Problems to open variables file '" // TRIM(filevarn) // "' IOSTAT = "// &
1221	TRIM(ItoS(ios)) // " !!"
1222	IF ( ios /= 0 ) CALL stoprun(msg, fname)
1223
1224	Nvals = 6
1225
1226	idvarnew = 1
1227	vfound = .FALSE.
1228	DO i=1,1000
1229	READ(funit, '(A1000)', END=150)line
1230	IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
1231	CALL split(line,'\|',Nvals,valsline)
1232	IF (TRIM(vname) == TRIM(valsline(1))) THEN
1233	ncvarname = TRIM(valsline(2))
1234	CALL removeChar(ncvarname, ' ')
1235	rcode = nf90_inq_varid(ncid, ncvarname, varid)
1236	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1237
1238	rcode = nf90_put_var(ncid, varid, vals)
1239	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1240	vfound = .TRUE.
1241	CYCLE
1242	END IF
1243	END IF
1244	END DO
1245
1246	150 CONTINUE
1247
1248	CLOSE(funit)
1249	IF (.NOT.vfound) THEN
1250	msg = "variables file '" // TRIM(filevarn) // "' does not have varible '" // TRIM(vname) // &
1251	"' !!"
1252	CALL stoprun(msg, fname)
1253	END IF
1254
1255	END SUBROUTINE put_var2D
1256
1257	SUBROUTINE put_var3D(ncid, d1, d2, d3, vals, vname, filevarn)
1258	! Subroutine to write on a netCDF file a 3D float variable
1259
1260	USE netcdf
1261
1262	IMPLICIT NONE
1263
1264	INTEGER, INTENT(IN) :: ncid, d1, d2, d3
1265	REAL, DIMENSION(d1,d2,d3), INTENT(IN) :: vals
1266	CHARACTER(LEN=*), INTENT(IN) :: vname, filevarn
1267
1268	! Local
1269	INTEGER :: funit, i, idvarnew, ios
1270	INTEGER :: Nvals, rcode, varid
1271	CHARACTER(LEN=50) :: ncvarname
1272	CHARACTER(LEN=1000) :: line
1273	CHARACTER(LEN=200), DIMENSION(6) :: valsline
1274	LOGICAL :: vfound
1275
1276	!!!!!!! Variables
1277	! ncid: netCDF file identifier
1278	! d1,d2,d3: shape of the matrix
1279	! vals: values to include
1280	! vname: name of the variable in the model to be included
1281	! filevarn: name of the ASCII file with the information about the variables
1282	fname = 'put_var3D'
1283
1284	! Reading variables file
1285	funit = freeunit()
1286	OPEN(funit, FILE=TRIM(filevarn), STATUS='old', FORM='formatted', IOSTAT=ios)
1287	msg = "Problems to open variables file '" // TRIM(filevarn) // "' IOSTAT = "// &
1288	TRIM(ItoS(ios)) // " !!"
1289	IF ( ios /= 0 ) CALL stoprun(msg, fname)
1290
1291	Nvals = 6
1292
1293	idvarnew = 1
1294	vfound = .FALSE.
1295	DO i=1,1000
1296	READ(funit, '(A1000)', END=150)line
1297	IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
1298	CALL split(line,'\|',Nvals,valsline)
1299	IF (TRIM(vname) == TRIM(valsline(1))) THEN
1300	ncvarname = TRIM(valsline(2))
1301	CALL removeChar(ncvarname, ' ')
1302	rcode = nf90_inq_varid(ncid, ncvarname, varid)
1303	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1304
1305	rcode = nf90_put_var(ncid, varid, vals)
1306	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1307	vfound = .TRUE.
1308	CYCLE
1309	END IF
1310	END IF
1311	END DO
1312
1313	150 CONTINUE
1314	CLOSE(funit)
1315
1316	IF (.NOT.vfound) THEN
1317	msg = "variables file '" // TRIM(filevarn) // "' does not have varible '" // TRIM(vname) // &
1318	"' !!"
1319	CALL stoprun(msg, fname)
1320	END IF
1321
1322	END SUBROUTINE put_var3D
1323
1324	SUBROUTINE put_var1Dt(ncid, d1, vals, vname, filevarn, it)
1325	! Subroutine to write on a netCDF file a 1D float variable at a given time-step
1326
1327	USE netcdf
1328
1329	IMPLICIT NONE
1330
1331	INTEGER, INTENT(IN) :: ncid, d1, it
1332	REAL, DIMENSION(d1), INTENT(IN) :: vals
1333	CHARACTER(LEN=*), INTENT(IN) :: vname, filevarn
1334
1335	! Local
1336	INTEGER :: funit, i, idvarnew, ios
1337	INTEGER :: Nvals, rcode, varid
1338	CHARACTER(LEN=50) :: ncvarname
1339	CHARACTER(LEN=1000) :: line
1340	CHARACTER(LEN=200), DIMENSION(6) :: valsline
1341	LOGICAL :: vfound
1342
1343	!!!!!!! Variables
1344	! ncid: netCDF file identifier
1345	! d1: shape of the matrix
1346	! vals: values to include
1347	! vname: name of the variable in the model to be included
1348	! filevarn: name of the ASCII file with the information about the variables
1349	! it: time-step to add
1350
1351	fname = 'put_var1Dt'
1352
1353	! Reading variables file
1354	funit = freeunit()
1355	OPEN(funit, FILE=TRIM(filevarn), STATUS='old', FORM='formatted', IOSTAT=ios)
1356	msg = "Problems to open variables file '" // TRIM(filevarn) // "' IOSTAT = "// &
1357	TRIM(ItoS(ios)) // " !!"
1358	IF ( ios /= 0 ) CALL stoprun(msg, fname)
1359
1360	Nvals = 6
1361
1362	idvarnew = 1
1363	vfound = .FALSE.
1364	DO i=1,1000
1365	READ(funit, '(A1000)', END=150)line
1366	IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
1367	CALL split(line,'\|',Nvals,valsline)
1368	IF (TRIM(vname) == TRIM(valsline(1))) THEN
1369	ncvarname = TRIM(valsline(2))
1370	CALL removeChar(ncvarname, ' ')
1371	rcode = nf90_inq_varid(ncid, ncvarname, varid)
1372	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1373
1374	rcode = nf90_put_var(ncid, varid, vals, start=(/1,it/), count=(/d1,1/))
1375	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1376	vfound = .TRUE.
1377	CYCLE
1378	END IF
1379	END IF
1380	END DO
1381
1382	150 CONTINUE
1383
1384	CLOSE(funit)
1385	IF (.NOT.vfound) THEN
1386	msg = "variables file '" // TRIM(filevarn) // "' does not have varible '" // TRIM(vname) // &
1387	"' !!"
1388	CALL stoprun(msg, fname)
1389	END IF
1390
1391	END SUBROUTINE put_var1Dt
1392
1393	SUBROUTINE put_var2Dt(ncid, d1, d2, vals, vname, filevarn, it)
1394	! Subroutine to write on a netCDF file a 2D float variable at a given time-step
1395
1396	USE netcdf
1397
1398	IMPLICIT NONE
1399
1400	INTEGER, INTENT(IN) :: ncid, d1, d2, it
1401	REAL, DIMENSION(d1), INTENT(IN) :: vals
1402	CHARACTER(LEN=*), INTENT(IN) :: vname, filevarn
1403
1404	! Local
1405	INTEGER :: funit, i, idvarnew, ios
1406	INTEGER :: Nvals, rcode, varid
1407	CHARACTER(LEN=50) :: ncvarname
1408	CHARACTER(LEN=1000) :: line
1409	CHARACTER(LEN=200), DIMENSION(6) :: valsline
1410	LOGICAL :: vfound
1411
1412	!!!!!!! Variables
1413	! ncid: netCDF file identifier
1414	! d1: shape of the matrix
1415	! vals: values to include
1416	! vname: name of the variable in the model to be included
1417	! filevarn: name of the ASCII file with the information about the variables
1418	! it: time-step to add
1419
1420	fname = 'put_var2Dt'
1421
1422	! Reading variables file
1423	funit = freeunit()
1424	OPEN(funit, FILE=TRIM(filevarn), STATUS='old', FORM='formatted', IOSTAT=ios)
1425	msg = "Problems to open variables file '" // TRIM(filevarn) // "' IOSTAT = "// &
1426	TRIM(ItoS(ios)) // " !!"
1427	IF ( ios /= 0 ) CALL stoprun(msg, fname)
1428
1429	Nvals = 6
1430
1431	idvarnew = 1
1432	vfound = .FALSE.
1433	DO i=1,1000
1434	READ(funit, '(A1000)', END=150)line
1435	IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
1436	CALL split(line,'\|',Nvals,valsline)
1437	IF (TRIM(vname) == TRIM(valsline(1))) THEN
1438	ncvarname = TRIM(valsline(2))
1439	CALL removeChar(ncvarname, ' ')
1440	rcode = nf90_inq_varid(ncid, ncvarname, varid)
1441	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1442
1443	rcode = nf90_put_var(ncid, varid, vals, start=(/1,1,it/), count=(/d1,d2,1/))
1444	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1445	vfound = .TRUE.
1446	CYCLE
1447	END IF
1448	END IF
1449	END DO
1450
1451	150 CONTINUE
1452
1453	CLOSE(funit)
1454	IF (.NOT.vfound) THEN
1455	msg = "variables file '" // TRIM(filevarn) // "' does not have varible '" // TRIM(vname) // &
1456	"' !!"
1457	CALL stoprun(msg, fname)
1458	END IF
1459
1460	END SUBROUTINE put_var2Dt
1461
1462	SUBROUTINE put_var3Dt(ncid, d1, d2, d3, vals, vname, filevarn, it)
1463	! Subroutine to write on a netCDF file a 3D float variable at a given time-step
1464
1465	USE netcdf
1466
1467	IMPLICIT NONE
1468
1469	INTEGER, INTENT(IN) :: ncid, d1, d2, d3, it
1470	REAL, DIMENSION(d1), INTENT(IN) :: vals
1471	CHARACTER(LEN=*), INTENT(IN) :: vname, filevarn
1472
1473	! Local
1474	INTEGER :: funit, i, idvarnew, ios
1475	INTEGER :: Nvals, rcode, varid
1476	CHARACTER(LEN=50) :: ncvarname
1477	CHARACTER(LEN=1000) :: line
1478	CHARACTER(LEN=200), DIMENSION(6) :: valsline
1479	LOGICAL :: vfound
1480
1481	!!!!!!! Variables
1482	! ncid: netCDF file identifier
1483	! d1,d2,d3: shape of the matrix
1484	! vals: values to include
1485	! vname: name of the variable in the model to be included
1486	! filevarn: name of the ASCII file with the information about the variables
1487	! it: time-step to add
1488
1489	fname = 'put_var3Dt'
1490
1491	! Reading variables file
1492	funit = freeunit()
1493	OPEN(funit, FILE=TRIM(filevarn), STATUS='old', FORM='formatted', IOSTAT=ios)
1494	msg = "Problems to open variables file '" // TRIM(filevarn) // "' IOSTAT = "// &
1495	TRIM(ItoS(ios)) // " !!"
1496	IF ( ios /= 0 ) CALL stoprun(msg, fname)
1497
1498	Nvals = 6
1499
1500	idvarnew = 1
1501	vfound = .FALSE.
1502	DO i=1,1000
1503	READ(funit, '(A1000)', END=150)line
1504	IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
1505	CALL split(line,'\|',Nvals,valsline)
1506	IF (TRIM(vname) == TRIM(valsline(1))) THEN
1507	ncvarname = TRIM(valsline(2))
1508	CALL removeChar(ncvarname, ' ')
1509	rcode = nf90_inq_varid(ncid, ncvarname, varid)
1510	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1511
1512	rcode = nf90_put_var(ncid, varid, vals, start=(/1,1,1,it/), count=(/d1,d2,d3,1/))
1513	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1514	vfound = .TRUE.
1515	CYCLE
1516	END IF
1517	END IF
1518	END DO
1519
1520	150 CONTINUE
1521
1522	CLOSE(funit)
1523	IF (.NOT.vfound) THEN
1524	msg = "variables file '" // TRIM(filevarn) // "' does not have varible '" // TRIM(vname) // &
1525	"' !!"
1526	CALL stoprun(msg, fname)
1527	END IF
1528
1529	END SUBROUTINE put_var3Dt
1530
1531	SUBROUTINE get_varI1D_ncunit(ncid, d1, vname, vals)
1532	! Subroutine to get a 1D integer variable from a netCDF file unit
1533
1534	USE netcdf
1535
1536	IMPLICIT NONE
1537
1538	INTEGER, INTENT(in) :: ncid, d1
1539	CHARACTER(LEN=*), INTENT(in) :: vname
1540	INTEGER, DIMENSION(d1), INTENT(out) :: vals
1541
1542	! Local
1543	INTEGER :: rcode, varid
1544	LOGICAL :: vfound
1545
1546	!!!!!!! Variables
1547	! ncid: netCDF file identifier
1548	! d1: shape of the matrix
1549	! vals: values to get
1550	! vname: name of the variable to getÂºÂº
1551
1552	fname = 'get_varI1D_ncunit'
1553
1554	vfound = isin_ncunit(ncid, vname)
1555
1556	IF (.NOT.vfound) THEN
1557	msg = "Unit file does not have variable '" // TRIM(vname) // "'"
1558	CALL ErrMsg(msg, fname, -1)
1559	END IF
1560
1561	rcode = nf90_inq_varid(ncid, vname, varid)
1562	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1563
1564	rcode = nf90_get_var(ncid, varid, vals)
1565	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1566
1567	END SUBROUTINE get_varI1D_ncunit
1568
1569	SUBROUTINE get_varI2D_ncunit(ncid, d1, d2, vname, vals)
1570	! Subroutine to get a 2D integer variable from a netCDF file unit
1571
1572	USE netcdf
1573
1574	IMPLICIT NONE
1575
1576	INTEGER, INTENT(in) :: ncid, d1, d2
1577	CHARACTER(LEN=*), INTENT(in) :: vname
1578	INTEGER, DIMENSION(d1,d2), INTENT(out) :: vals
1579
1580	! Local
1581	INTEGER :: rcode, varid
1582	LOGICAL :: vfound
1583
1584	!!!!!!! Variables
1585	! ncid: netCDF file identifier
1586	! d1: shape of the matrix
1587	! vals: values to get
1588	! vname: name of the variable to get
1589
1590	fname = 'get_varI2D_ncunit'
1591
1592	vfound = isin_ncunit(ncid, vname)
1593
1594	IF (.NOT.vfound) THEN
1595	msg = "Unit file does not have variable '" // TRIM(vname) // "'"
1596	CALL ErrMsg(msg, fname, -1)
1597	END IF
1598
1599	rcode = nf90_inq_varid(ncid, vname, varid)
1600	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1601
1602	rcode = nf90_get_var(ncid, varid, vals)
1603	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1604
1605	END SUBROUTINE get_varI2D_ncunit
1606
1607	SUBROUTINE get_varI3D_ncunit(ncid, d1, d2, d3, vname, vals)
1608	! Subroutine to get a 2D integer variable from a netCDF file unit
1609
1610	USE netcdf
1611
1612	IMPLICIT NONE
1613
1614	INTEGER, INTENT(in) :: ncid, d1, d2, d3
1615	CHARACTER(LEN=*), INTENT(in) :: vname
1616	INTEGER, DIMENSION(d1,d2,d3), INTENT(out) :: vals
1617
1618	! Local
1619	INTEGER :: rcode, varid
1620	LOGICAL :: vfound
1621
1622	!!!!!!! Variables
1623	! ncid: netCDF file identifier
1624	! d1: shape of the matrix
1625	! vals: values to get
1626	! vname: name of the variable to get
1627
1628	fname = 'get_varI3D_ncunit'
1629
1630	vfound = isin_ncunit(ncid, vname)
1631
1632	IF (.NOT.vfound) THEN
1633	msg = "Unit file does not have variable '" // TRIM(vname) // "'"
1634	CALL ErrMsg(msg, fname, -1)
1635	END IF
1636
1637	rcode = nf90_inq_varid(ncid, vname, varid)
1638	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1639
1640	rcode = nf90_get_var(ncid, varid, vals)
1641	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1642
1643	END SUBROUTINE get_varI3D_ncunit
1644
1645	SUBROUTINE get_varRK0D_ncunit(ncid, vname, vals)
1646	! Subroutine to get an scalar r_k float variable from a netCDF file unit
1647
1648	USE netcdf
1649
1650	IMPLICIT NONE
1651
1652	INTEGER, INTENT(in) :: ncid
1653	CHARACTER(LEN=*), INTENT(in) :: vname
1654	REAL, INTENT(out) :: vals
1655
1656	! Local
1657	INTEGER :: rcode, varid
1658	LOGICAL :: vfound
1659
1660	!!!!!!! Variables
1661	! ncid: netCDF file identifier
1662	! vals: values to get
1663	! vname: name of the variable to get
1664
1665	fname = 'get_varRK0D_ncunit'
1666
1667	vfound = isin_ncunit(ncid, vname)
1668
1669	IF (.NOT.vfound) THEN
1670	msg = "Unit file does not have variable '" // TRIM(vname) // "'"
1671	CALL ErrMsg(msg, fname, -1)
1672	END IF
1673
1674	rcode = nf90_inq_varid(ncid, vname, varid)
1675	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1676
1677	rcode = nf90_get_var(ncid, varid, vals)
1678	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1679
1680	END SUBROUTINE get_varRK0D_ncunit
1681
1682	SUBROUTINE get_varRK1D_ncunit(ncid, d1, vname, vals)
1683	! Subroutine to get a 1D r_k float variable from a netCDF file unit
1684
1685	USE netcdf
1686
1687	IMPLICIT NONE
1688
1689	INTEGER, INTENT(in) :: ncid, d1
1690	CHARACTER(LEN=*), INTENT(in) :: vname
1691	REAL, DIMENSION(d1), INTENT(out) :: vals
1692
1693	! Local
1694	INTEGER :: rcode, varid
1695	LOGICAL :: vfound
1696
1697	!!!!!!! Variables
1698	! ncid: netCDF file identifier
1699	! d1: shape of the matrix
1700	! vals: values to get
1701	! vname: name of the variable to get
1702
1703	fname = 'get_varRK1D_ncunit'
1704
1705	vfound = isin_ncunit(ncid, vname)
1706
1707	IF (.NOT.vfound) THEN
1708	msg = "Unit file does not have variable '" // TRIM(vname) // "'"
1709	CALL ErrMsg(msg, fname, -1)
1710	END IF
1711
1712	rcode = nf90_inq_varid(ncid, vname, varid)
1713	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1714
1715	rcode = nf90_get_var(ncid, varid, vals)
1716	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1717
1718	END SUBROUTINE get_varRK1D_ncunit
1719
1720	SUBROUTINE get_varRK2D_ncunit(ncid, d1, d2, vname, vals)
1721	! Subroutine to get a 2D r_k float variable from a netCDF file unit
1722
1723	USE netcdf
1724
1725	IMPLICIT NONE
1726
1727	INTEGER, INTENT(in) :: ncid, d1, d2
1728	CHARACTER(LEN=*), INTENT(in) :: vname
1729	REAL, DIMENSION(d1,d2), INTENT(out) :: vals
1730
1731	! Local
1732	INTEGER :: rcode, varid
1733	LOGICAL :: vfound
1734
1735	!!!!!!! Variables
1736	! ncid: netCDF file identifier
1737	! d1,d2: shape of the matrix
1738	! vals: values to get
1739	! vname: name of the variable to get
1740
1741	fname = 'get_varRK2D_ncunit'
1742
1743	vfound = isin_ncunit(ncid, vname)
1744
1745	IF (.NOT.vfound) THEN
1746	msg = "Unit file does not have variable '" // TRIM(vname) // "'"
1747	CALL ErrMsg(msg, fname, -1)
1748	END IF
1749
1750	rcode = nf90_inq_varid(ncid, vname, varid)
1751	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1752
1753	rcode = nf90_get_var(ncid, varid, vals)
1754	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1755
1756	END SUBROUTINE get_varRK2D_ncunit
1757
1758	SUBROUTINE get_varRK3D_ncunit(ncid, d1, d2, d3, vname, vals)
1759	! Subroutine to get a 3D r_k float variable from a netCDF file unit
1760
1761	USE netcdf
1762
1763	IMPLICIT NONE
1764
1765	INTEGER, INTENT(in) :: ncid, d1, d2, d3
1766	CHARACTER(LEN=*), INTENT(in) :: vname
1767	REAL, DIMENSION(d1,d2,d3), INTENT(out) :: vals
1768
1769	! Local
1770	INTEGER :: rcode, varid
1771	LOGICAL :: vfound
1772
1773	!!!!!!! Variables
1774	! ncid: netCDF file identifier
1775	! d1,d2,d3: shape of the matrix
1776	! vals: values to get
1777	! vname: name of the variable to get
1778
1779	fname = 'get_varRK3D_ncunit'
1780
1781	vfound = isin_ncunit(ncid, vname)
1782
1783	IF (.NOT.vfound) THEN
1784	msg = "Unit file does not have variable '" // TRIM(vname) // "'"
1785	CALL ErrMsg(msg, fname, -1)
1786	END IF
1787
1788	rcode = nf90_inq_varid(ncid, vname, varid)
1789	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1790
1791	rcode = nf90_get_var(ncid, varid, vals)
1792	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1793
1794	END SUBROUTINE get_varRK3D_ncunit
1795
1796	SUBROUTINE get_varRK4D_ncunit(ncid, d1, d2, d3, d4, vname, vals)
1797	! Subroutine to get a 4D r_k float variable from a netCDF file unit
1798
1799	USE netcdf
1800
1801	IMPLICIT NONE
1802
1803	INTEGER, INTENT(in) :: ncid, d1, d2, d3, d4
1804	CHARACTER(LEN=*), INTENT(in) :: vname
1805	REAL, DIMENSION(d1,d2,d3,d4), INTENT(out) :: vals
1806
1807	! Local
1808	INTEGER :: rcode, varid
1809	LOGICAL :: vfound
1810
1811	!!!!!!! Variables
1812	! ncid: netCDF file identifier
1813	! d1,d2,d3,d4: shape of the matrix
1814	! vals: values to get
1815	! vname: name of the variable to get
1816
1817	fname = 'get_varRK4D_ncunit'
1818
1819	vfound = isin_ncunit(ncid, vname)
1820
1821	IF (.NOT.vfound) THEN
1822	msg = "Unit file does not have variable '" // TRIM(vname) // "'"
1823	CALL ErrMsg(msg, fname, -1)
1824	END IF
1825
1826	rcode = nf90_inq_varid(ncid, vname, varid)
1827	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1828
1829	rcode = nf90_get_var(ncid, varid, vals)
1830	IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
1831
1832	END SUBROUTINE get_varRK4D_ncunit
1833
1834	END MODULE module_generic

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

Download in other formats:

Original Format