Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

module_NCgeneric.f90 @ 1967

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

Creation of:

`module_NCgeneric.f90': module with generic netcdf functions

File size: 47.1 KB

Rev	Line
[1663]	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