Context Navigation

libUN.f

Last change on this file was 6, checked in by vancop, 8 years ago
initial import of v3.20 /Users/ioulianikolskaia/Boulot/CODES/LIM1D/ARCHIVE/TMP/LIM1D_v3.20/
File size: 106.9 KB

Line
1	C--VERSION:2005.04.08
2	C modified by Martin Vancoppenolle for use with LIM1D
3	C read of forcing
4
5	C -----------------------------------------------------------------------
6	C libUN : User level NetCDF READ / WRITE routines
7	C
8	C by Philippe Marbaix and Xavier Fettweis
9	C
10	C Compatible with NetCDF version 3.x (or above).
11	C -----------------------------------------------------------------------
12
13	C User-frendly interface :
14	C ------------------------
15
16	c CF_INI_FILE : Initialization of the netcf file
17	c CF_CREATE_DIM : Create axis/dimensions
18	c CF_CREATE_VAR : Create variables
19	c CF_CREATE_FILE: Write the netcdf file
20	c CF_WRITE : Write variables
21	c CF_READ3D/2D : Read variables
22	c CF_OPEN : Open netcdf file
23	c CF_CLOSE : Close netcdf file
24
25	C Main routines :
26	C ---------------
27
28	c UNscreate : General file creation routine,
29	c defining multiple dimensions + attributes
30
31	c UNwrite : General variables writting routine
32	c (also updates 'range' attribute and variable if present)
33	c Note: Use UNlwrite to write 2D planes in 3D variables
34
35	c UN(s)read : Reading routine (grid coordinates + variable)
36
37	C Complementary routines :
38	C ------------------------
39
40	c UNparam : set optional parameters of libUN functions
41	c UNwopen : re-open file for writting
42	c UNropen : open file for reading
43	c UNgtime : Find time index for a given time value
44	c UNgindx : Generalization of UNgtime: find value in any 1D data.
45	c UNfindx : modified version of UNgindx safe for non-monotonic data
46	c UNclose : close the NetCDF file
47	c UNwratt : Real attributes writting
48	c UNwcatt : Characters attributes creation & writing
49
50	C Double Precision :
51	C ------------------
52
53	c To be in double precision, type this
54	c > sed "s/REAL\4/REAL\8/g" libUN.f > libUN1.f
55	c > sed "s/\_REAL/\_DOUBLE/g" libUN1.f > libUN2.f
56	c > sed "s/NF\_FLOAT/NF\_DOUBLE/g" libUN2.f > libUNd.f
57	c > rm -f libUN1.f libUN2.f
58
59	C -----------------------------------------------------------------------
60
61
62	C +---------------------------+---------------------------------------+
63	C + Subroutine CD_INI_FILE : + Initialize the netcdf file +
64	C +---------------------------+---------------------------------------+
65
66	SUBROUTINE CF_INI_FILE (filename, filetitle)
67
68	c Input :
69	c =======
70
71	c filename = name of the netcdf file
72	c filetitle = title in the netcdf file
73
74	IMPLICIT NONE
75
76	INCLUDE 'libUN.inc'
77
78	CHARACTER () filename,filetitle
79
80	CF_attnam(1) = 'actual_range'
81	CF_attnum(1) = 2
82
83	CF_varnbrtot = 0 ! Initialization
84	CF_dimnbrtot = -1 ! Initialization
85
86	CF_filenam = filename
87	CF_filetit = filetitle
88
89	END SUBROUTINE CF_INI_FILE
90
91
92	C +-----------------------------+-------------------------------------+
93	C + Subroutine CF_CREATE_DIM : + Create dimensions/axis +
94	C +-----------------------------+-------------------------------------+
95
96	SUBROUTINE CF_CREATE_DIM (dimname,dimunits,dimdim,vallues)
97
98	c Input :
99	c =======
100
101	c dimname = name of the axis/dimension
102	c dimunits = units of the axis/dimension
103	c dimdim = dimensions of the axis/dimension
104	c vallues = vallues of the axis/dimension
105
106	IMPLICIT NONE
107
108	INCLUDE 'libUN.inc'
109
110	CHARACTER () dimname,dimunits
111
112	INTEGER dimdim,i
113	REAL*4 vallues(dimdim)
114
115	CF_dimnbrtot = CF_dimnbrtot + 1
116
117	CF_dimnbrtot = max(0,CF_dimnbrtot)
118
119	CF_dimnam(CF_dimnbrtot) = dimname
120	CF_dimnamuni(CF_dimnbrtot) = dimunits
121	CF_dim(CF_dimnbrtot) = dimdim
122
123	do i = 1,dimdim
124	CF_dimval(i,CF_dimnbrtot) = vallues(i)
125	enddo
126
127	END SUBROUTINE CF_CREATE_DIM
128
129	C +-----------------------------+-------------------------------------+
130	C + Subroutine CF_CREATE_VAR : + Create variables +
131	C +-----------------------------+-------------------------------------+
132
133	SUBROUTINE CF_CREATE_VAR (varname,vartitle,varunits,varaxe4,
134	. varaxe1,varaxe2,varaxe3)
135
136	c Input :
137	c =======
138
139	c varname = name of the variable
140	c vartitle = title of the variable
141	c varunits = units of the variable
142	c varaxeX = axes used by the variable (T,X,Y,Z)
143
144	IMPLICIT NONE
145
146	INCLUDE 'libUN.inc'
147
148	CHARACTER () varname,vartitle,varunits
149	CHARACTER () varaxe1,varaxe2,varaxe3,varaxe4
150
151	CF_varnbrtot = max (0,CF_varnbrtot + 1)
152
153	CF_varnam(CF_varnbrtot) = varname
154	CF_varnamdim(1,CF_varnbrtot) = varaxe1
155	CF_varnamdim(2,CF_varnbrtot) = varaxe2
156	CF_varnamdim(3,CF_varnbrtot) = varaxe3
157	CF_varnamdim(4,CF_varnbrtot) = varaxe4
158	CF_varnamuni(CF_varnbrtot) = varunits
159	CF_vardes(CF_varnbrtot) = vartitle
160
161	END SUBROUTINE CF_CREATE_VAR
162
163	C +--------------------------------------+----------------------------+
164	C + Subroutine CF_CREATE_VAR_VIA_FILE : + Create variables +
165	C +--------------------------------------+----------------------------+
166
167	SUBROUTINE CF_CREATE_VAR_VIA_FILE (filename)
168
169	c Input :
170	c =======
171
172	c filename = name of the file containing informations
173	c about the variables
174
175	IMPLICIT NONE
176
177	INCLUDE 'libUN.inc'
178
179	CHARACTER*200 filename
180
181	CHARACTER*120 tmpvar
182
183	OPEN(unit=999,status='old',file=filename)
184
185	980 CONTINUE
186	READ (999,'(A120)',end=990) tmpvar
187
188	IF (tmpvar(1:4).eq.' ') THEN
189	CF_varnbrtot = max (0,CF_varnbrtot + 1)
190	READ (tmpvar,'(4x,5A9,A12,A50)')
191	. CF_varnam(CF_varnbrtot),
192	. CF_varnamdim(1,CF_varnbrtot),
193	. CF_varnamdim(2,CF_varnbrtot),
194	. CF_varnamdim(3,CF_varnbrtot),
195	. CF_varnamdim(4,CF_varnbrtot),
196	. CF_varnamuni(CF_varnbrtot),
197	. CF_vardes(CF_varnbrtot)
198	ENDIF
199
200	GOTO 980
201	990 CONTINUE
202
203	END SUBROUTINE CF_CREATE_VAR_VIA_FILE
204
205	C +------------------------------+------------------------------------+
206	C + Subroutine CF_CREATE_FILE : + Create the netcdf file +
207	C +------------------------------+------------------------------------+
208
209	SUBROUTINE CF_CREATE_FILE (filename)
210
211	c Input :
212	c =======
213
214	c filename = name of the netcdf file
215
216	IMPLICIT NONE
217
218	INCLUDE 'libUN.inc'
219
220	CHARACTER () filename
221
222	INTEGER i,j,id
223
224	INTEGER UN1_dim(0:CF_dimnbrtot)
225
226	REAL UN1_dimval(CF_dimmaxlen,0:CF_dimnbrtot)
227
228	CHARACTER*31 UN1_dimnam(0:CF_dimnbrtot),
229	. UN1_dimnamuni(0:CF_dimnbrtot)
230
231	if(filename.ne.CF_filenam)then
232	write(6,*) "ERROR: not "//CF_filenam
233	stop
234	endif
235
236	DO i=0,CF_dimnbrtot
237	UN1_dim(i) = CF_dim(i)
238	UN1_dimnam(i) = CF_dimnam(i)
239	UN1_dimnamuni(i) = CF_dimnamuni(i)
240	DO j=1,CF_dim(i)
241	UN1_dimval(j,i) = CF_dimval(j,i)
242	END DO
243	END DO
244
245	call UNscreate (CF_filenam,CF_filetit,CF_dimnbrtot,UN1_dim,
246	. CF_dimmaxlen, UN1_dimnam ,UN1_dimnamuni,
247	. UN1_dimval,
248	. CF_varmaxnbr,CF_varnbrtot,CF_varnam,
249	. CF_varnamdim,CF_varnamuni,CF_vardes,
250	. CF_attnbr,CF_attnam,CF_attnum,id)
251
252	call UNclose (id)
253
254
255	END SUBROUTINE CF_CREATE_FILE
256
257	C +------------------------+------------------------------------------+
258	C + Subroutine CF_WRITE : + Writes variables +
259	C +------------------------+------------------------------------------+
260
261
262	SUBROUTINE CF_WRITE (FILEname, VARname , itime,
263	& Ni, Nj, Nlev, var)
264
265	c Input :
266	c =======
267
268	c FILEname = name of the netcdf file
269	c VARname = name of variables
270	c itime = index on time axis
271	c Ni,Nj,Nlev = X,Y,Z dimension
272	c var = array of vallues of the variable
273
274	IMPLICIT NONE
275
276	INCLUDE 'libUN.inc'
277
278	CHARACTER () FILEname,VARname
279	INTEGER itime
280	INTEGER Ni, Nj, Nlev,fileid
281	REAL*4 var(Ni, Nj, Nlev)
282
283	if(CF_filenamopened.ne.FILEname) then
284	CALL UNwopen (FILEname,fileid)
285	else
286	fileid = CF_fileidopened
287	endif
288
289	CALL UNwrite (fileid,VARname ,itime,Ni, Nj, Nlev, var)
290
291	if(CF_filenamopened.ne.FILEname) then
292	call UNclose (fileid)
293	endif
294
295	END SUBROUTINE CF_WRITE
296
297	C** +-------------------------+-----------------------------------------+
298	C** + Subroutine CF_READ1D : + Read variables +
299	C** +-------------------------+-----------------------------------------+
300
301	SUBROUTINE CF_READ1D (FILEname, VARname , itime,
302	. N, var)
303	! routine added by martin vancoppenolle to read 1D arrays
304
305	c Input :
306	c =======
307
308	c FILEname = name of the netcdf file
309	c VARname = name of variables
310	c itime = index on time axis
311	c N = X dimension
312
313	c Output :
314	c ========
315
316	c var = array of values of the variable
317
318	IMPLICIT NONE
319
320	INCLUDE 'libUN.inc'
321
322	CHARACTER () FILEname,VARname
323	CHARACTER*31 var_units,filetitle
324	INTEGER N, itime,level
325	REAL*4 var(N)
326
327	INTEGER i,j,fileid
328
329	if(CF_filenamopened.ne.FILEname) then
330	CALL UNropen (FILEname,fileid,filetitle)
331	else
332	fileid = CF_fileidopened
333	endif
334
335	CALL UNsread (fileid, VARname, itime, 1, 1, 1,
336	& N , 1 , 1,var_units, var)
337
338	if(CF_filenamopened.ne.FILEname) then
339	call UNclose (fileid)
340	endif
341
342	END SUBROUTINE CF_READ1D
343
344	C** +-------------------------+-----------------------------------------+
345	C** + Subroutine CF_READ2D : + Read variables +
346	C** +-------------------------+-----------------------------------------+
347
348	SUBROUTINE CF_READ2D (FILEname, VARname , itime,
349	. Ni, Nj, Nlev, var)
350
351
352	c Input :
353	c =======
354
355	c FILEname = name of the netcdf file
356	c VARname = name of variables
357	c itime = index on time axis
358	c Ni,Nj,Nlev = X,Y,Z dimension
359
360	c Output :
361	c ========
362
363	c var = array of vallues of the variable
364
365	IMPLICIT NONE
366
367	INCLUDE 'libUN.inc'
368
369	CHARACTER () FILEname,VARname
370	CHARACTER*31 var_units,filetitle
371	INTEGER Ni, Nj, Nlev,itime,level
372	REAL*4 var(Ni, Nj)
373
374	INTEGER i,j,fileid
375
376	if(CF_filenamopened.ne.FILEname) then
377	CALL UNropen (FILEname,fileid,filetitle)
378	else
379	fileid = CF_fileidopened
380	endif
381
382	CALL UNsread (fileid, VARname, itime, Nlev, 1, 1,
383	& Ni , Nj , 1,var_units, var)
384
385	if(CF_filenamopened.ne.FILEname) then
386	call UNclose (fileid)
387	endif
388
389	END SUBROUTINE CF_READ2D
390
391	C +-------------------------+-----------------------------------------+
392	C + Subroutine CF_READ3D : + Read variables +
393	C +-------------------------+-----------------------------------------+
394
395
396	SUBROUTINE CF_READ3D (FILEname, VARname , itime,
397	. Ni, Nj, Nlev, var)
398
399	c Input :
400	c =======
401
402	c FILEname = name of the netcdf file
403	c VARname = name of variables
404	c itime = index on time axis
405	c Ni,Nj,Nlev = X,Y,Z dimension
406
407	c Output :
408	c ========
409
410	c var = array of vallues of the variable
411
412	IMPLICIT NONE
413
414	INCLUDE 'libUN.inc'
415
416	CHARACTER () FILEname,VARname
417	CHARACTER*31 var_units,filetitle
418	INTEGER Ni, Nj, Nlev,itime,level
419	REAL*4 var(Ni, Nj,Nlev)
420
421	INTEGER i,j,fileid
422
423	if(CF_filenamopened.ne.FILEname) then
424	CALL UNropen (FILEname,fileid,filetitle)
425	else
426	fileid = CF_fileidopened
427	endif
428
429	CALL UNsread (fileid, VARname, itime, 0, 1, 1,
430	& Ni , Nj , Nlev,var_units, var)
431
432	if(CF_filenamopened.ne.FILEname) then
433	call UNclose (fileid)
434	endif
435
436	END SUBROUTINE CF_READ3D
437
438	C** +------------------------+------------------------------------------+
439	C** + Subroutine CF_CLOSE : + Close the file +
440	C** +------------------------+------------------------------------------+
441
442	SUBROUTINE CF_CLOSE (FILEname)
443
444	IMPLICIT NONE
445
446	INCLUDE 'libUN.inc'
447
448	CHARACTER() FILEname
449
450	if(FILEname.eq.CF_filenamopened)then
451	call UNclose (CF_fileidopened)
452	else
453	print *,FILEname//" not opened"
454	endif
455
456	CF_filenamopened = ""
457	CF_fileidopened = 0
458
459	END SUBROUTINE CF_CLOSE
460
461	C** +-----------------------+-------------------------------------------+
462	C** + Subroutine CF_OPEN : + open the file +
463	C** +-----------------------+-------------------------------------------+
464
465	SUBROUTINE CF_OPEN (FILEname,FILEid)
466
467	IMPLICIT NONE
468
469	INCLUDE 'libUN.inc'
470
471	INTEGER FILEid
472
473	CHARACTER() FILEname
474
475	call UNwopen (FILEname,FILEid)
476
477	CF_filenamopened = FILEname
478
479	CF_fileidopened = FILEid
480
481	END SUBROUTINE CF_OPEN
482
483	C** +-------------------------+-----------------------------------------+
484	C** + Subroutine UNscreate : + +
485	C** +-------------------------+ +
486	C** + * Purpose : +
487	C** + Create a NetCDF file, general version. +
488	C** + (Staggered grids + other extensions to UNcreate) +
489	C** + +
490	C** + * How it works : calling routine must provide +
491	C** + -a list of dimensions +
492	C** + (size of each dimens., names, units and values of coordinates)+
493	C** + -a list of variables +
494	C** + (units, number of dimensions, names of selected dimensions) +
495	C** + +
496	C** + INPUT : +
497	C** + ------- +
498	C** + +
499	C** + General : +
500	C** + FILEnam [char]: Name of the file to be created. +
501	C** + title [char]: Title attribute +
502	C** + +
503	C** + Dimensions: +
504	C** + TND : Total Number of SPATIAL dimensions +
505	C** + Notice : Set "time" to dimension No 0 +
506	C** + DFdim(0:TND) : # discrete values for each dimension +
507	C** + Notice : DFdim(0).eq.0 +
508	C** + -> UNLIMITED TIME (coord. not defined) +
509	C** + WARNING: In this case, the NetCDF +
510	C** + use a temporary space to duplicate +
511	C** + the file -> NOT RECOMMENDED +
512	C** + MXdim : Maximum value of DFdim, = arrays size +
513	C** + NAMdim(0:TND) [char]: Name of dimensions, except time +
514	C** + UNIdim(0:TND) [char]: Units of dimensions (attribute) +
515	C** + VALdim(MXdim,0:TND)[R4]: Values of coordinate for each dimension+
516	C** + +
517	C** + Variables: +
518	C** + Dvs : Variable's definitions array sizes, +
519	C** + Nvs : Number of defined variables(Nvs.le.Dvs)+
520	C** + name_vs (Dvs) [char]: name of variable. +
521	C** + unit_vs (Dvs) [char]: physical units of variable (attribute) +
522	C** + Sdim_vs (4,Dvs) [char]: name of Selected dims (in above list) +
523	C** + Blanked or '-' elements = not used +
524	C** + lnam_vs (Dvs) [char]: Long_name attribute (descript. of var.)+
525	C** + +
526	C** + List of real attributes to all variables: +
527	C** + Nra : Number of Real Attributes (.ge.1 !) +
528	C** + NAMrat(Nra) [char]: NAMes of Real ATtributes (''=none) +
529	C** + (initial value= 0; set it with UNwratt)+
530	C** + Nvals(Nra) : Number of values of these attributes. +
531	C** + ! Currently limited to 1 value (scalar) or 2 (2 elements vector)+
532	C** + ! EXCEPTION: Setting the last attribute name to '[var]_range' +
533	C** + does create a variable (!) for level-by-level range+
534	C** + (very usefull for 3D + time fields) +
535	C** + +
536	C** + NB : [char] variables may have any length. +
537	C** + blanks characters are NOT ALLOWED in any variable, +
538	C** + except the "title". +
539	C** + and the NetCDF variables defined here are always real*4 +
540	C** + +
541	C** + OUTPUT : +
542	C** + -------- +
543	C** + FILEid : Index of the NetCDF file (remains open)+
544	C** +-------------------------------------------------------------------+
545
546	SUBROUTINE UNscreate (FILEnam, title,
547	& TND, DFdim, MXdim, NAMdim, UNIdim, VALdim,
548	& Dvs, Nvs, name_vs, Sdim_vs, unit_vs, lnam_vs,
549	& Nra, NAMrat, Nvals,
550	& FILEid )
551
552	C +
553	IMPLICIT NONE
554
555	INCLUDE 'libUN.inc'
556
557	C +
558	INTEGER icheck, MXND
559	C ** Maximum number of dimensions
560	parameter (MXND = 100)
561
562	C + INPUT:
563	C + - - -
564	CHARACTER () FILEnam
565	CHARACTER () title
566
567	INTEGER TND, DFdim(0:TND), MXdim
568	CHARACTER () NAMdim(0:TND)
569	CHARACTER () UNIdim(0:TND)
570	REAL*4 VALdim(MXdim,0:TND)
571
572	INTEGER Nvs, Dvs
573	CHARACTER () name_vs(Dvs)
574	CHARACTER () Sdim_vs(4,Dvs)
575	CHARACTER () unit_vs(Dvs)
576	CHARACTER () lnam_vs(Dvs)
577
578	INTEGER Nra
579	CHARACTER () NAMrat(Nra)
580	CHARACTER*24 Host,Fdate
581	CHARACTER*200 tmpchar
582	INTEGER Nvals(Nra)
583
584	C + OUTPUT:
585	C + - - - -
586	INTEGER FILEid
587
588	C + LOCAL:
589	C + - - -
590	INTEGER VARSIZE
591	EXTERNAL VARSIZE
592	CHARACTER*(30) tmpchr
593	INTEGER dimDID(0:MXND)
594	INTEGER dimVID(0:MXND), vsVID, vrVID
595	INTEGER dID(4), start(4), count(4), rdID(2)
596	INTEGER mimaID
597	INTEGER stride(4),imap(4)
598	INTEGER Ndim_vs
599	INTEGER ivs, igd, idi, ira, itmp
600	INTEGER Nlen
601	INTEGER dNlen(0:MXND)
602	INTEGER Ierro, TTerr, ii,jj
603	REAL*4 zero1(1), zero2(2)
604
605	icheck= 0 !Debugging level
606
607
608	C* 0. Initialisations
609	C ------------------
610	IF (icheck.ge.1) WRITE(,) 'UNscreate : Begin'
611
612	C + Routines which opens a file must reset libUN internals:
613	CALL UNparam('RESET_PARAMS_',0.0)
614
615	DO ii = 1,4
616	stride(ii) = 1
617	ENDDO
618	zero1(1) = 0.
619	zero2(1) = 0.
620	zero2(2) = 0.
621	TTerr = 0 !Total of error flags
622
623	IF (TND .gt. MXND) THEN
624	write(,)'UNscreate - Error: so much dimensions ?',TND
625	END IF
626
627	C Create a NetCDF file and enter define mode :
628	C --------------------------------------------
629	IF (icheck.ge.2) WRITE(,) 'FILEnam :', FILEnam
630
631	C ** getting FILEnam [char] size :
632	Nlen = VARSIZE(FILEnam)
633
634	Ierro=NF_CREATE(FILEnam(1:Nlen), NF_CLOBBER , FILEid)
635	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNscreate', Ierro)
636	C ** identif. =>overwrite =error
637
638	C* Time coordinate definition.
639	C ---------------------------
640
641	C ** Define dimension :
642	IF (icheck.ge.3) WRITE(,) '# time iters.:', DFdim(0)
643	IF (DFdim(0).eq.0.) THEN
644	Ierro=NF_DEF_DIM(FILEid , 'time', NF_UNLIMITED, dimDID(0))
645	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNscreate', Ierro)
646	TTerr = TTerr + ABS(Ierro)
647	ELSE
648	Ierro=NF_DEF_DIM(FILEid , 'time', DFdim(0), dimDID(0))
649	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNscreate', Ierro)
650	TTerr = TTerr + ABS(Ierro)
651	END IF
652	dNlen(0)= 4 ! 4 characters in the name 'time'...
653	IF (NAMdim(0)(1:4).ne.'time') THEN
654	WRITE(,) 'Sorry, NAMdim(0) must be ''time'' .'
655	STOP
656	END IF
657
658	C ** Define variable for the time coordinate values :
659	dID(1) = dimDID(0)
660	Ierro=NF_DEF_VAR(FILEid , 'time', NF_FLOAT,1 , dID, dimVID(0))
661	C ** ^^^^^^^^^^ FILEid var name type dims DIMid VARid
662	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNscreate', Ierro)
663	TTerr = TTerr + ABS(Ierro)
664
665
666	C Spatial coordinates definitions : DIMS and VARs (locations).
667	C ------------------------------------------------------------
668	C
669	DO igd = 1,TND !** BEGIN LOOP over all spatial dims
670	IF (icheck.ge.3) WRITE(,) ' spatial dim:', NAMdim(igd)
671
672	C ** getting NAMdim [char] size :
673	Nlen = VARSIZE(NAMdim(igd))
674	dNlen(igd) = Nlen !For further use of NAMdim
675
676	Ierro=NF_DEF_DIM(FILEid , NAMdim(igd)(1:Nlen),
677	& DFdim(igd),dimDID(igd))
678	C **line1 ^^^^^^^^^^ FILEid \| dim name
679	C **line2 # values \| VARid
680	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNscreate', Ierro)
681	TTerr = TTerr + ABS(Ierro)
682
683	dID(1) = dimDID(igd)
684	Ierro=NF_DEF_VAR(FILEid , NAMdim(igd)(1:Nlen),
685	& NF_FLOAT , 1 , dID ,dimVID(igd))
686	C **line1 ^^^^^^^^^^ FILEid \| dim name
687	C **line2 type \| #dims \| dimsIDs \| VARid
688	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNscreate', Ierro)
689	TTerr = TTerr + ABS(Ierro)
690
691	END DO !** END LOOP over all spatial dims
692
693	C Special coordinate definition: MinMax (for [var]_range)
694	C -------------------------------------------------------
695	IF (NAMrat(Nra)(1:11).eq.'[var]_range') THEN
696
697	Ierro=NF_DEF_DIM(FILEid, 'MinMax', 2, mimaID)
698	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNscreate', Ierro)
699	ENDIF
700
701	C Define the fields.
702	C ------------------
703
704	DO ivs = 1,Nvs !**BEGIN LOOP on var. num.
705	IF (icheck.ge.3)
706	& WRITE (,) 'Defining variable ',name_vs(ivs)
707
708
709	C Set space and time dimensions
710	C - - - - - - - - - - - - - - -
711	C ** Initialise number of dimensions :
712	Ndim_vs= 0
713
714	DO idi = 1, 4 !** BEGIN LOOP on var dims.
715	IF (Sdim_vs(idi,ivs)(1:1).ne.' '
716	& .and.Sdim_vs(idi,ivs)(1:1).ne.'-') THEN !**skip undefined.
717
718	C ** getting Sdim_vs [char] size :
719	Nlen = VARSIZE(Sdim_vs(idi,ivs))
720
721	C ** Searching for the dimension index from its name (Sdim_vs)
722	igd = 0
723	DO WHILE (Sdim_vs(idi,ivs)(1:Nlen)
724	& .ne. NAMdim(igd)(1:dNlen(igd)) )
725	IF (igd.eq.TND) THEN
726	write(,)'UNscreate-ERROR: Dimension not found:',
727	& Sdim_vs(idi,ivs)(1:Nlen)
728	STOP
729	END IF
730	igd = igd + 1
731	END DO
732	C ** Construct the dimensions id's for that variable (ivs):
733	IF (icheck.ge.3)
734	& WRITE (,) 'using dimension ',NAMdim(igd), dimDID(igd)
735	Ndim_vs = Ndim_vs + 1
736	dID(Ndim_vs) = dimDID(igd)
737
738	END IF
739	END DO !** END LOOP on var dims.
740
741	C Define our special [var]_range field for 4D variables
742	C - - - - - - - - - - - - - - - - - - - - - - - - - - -
743	IF (Ndim_vs.eq.4
744	& .and.NAMrat(Nra)(1:11).eq.'[var]_range') THEN
745
746	Nlen = VARSIZE(name_vs(ivs))
747	rdID(1) = dID (3) !(4D variable, 3th dim = level)
748	rdID(2) = mimaID !(for min, max)
749	tmpchr = name_vs(ivs)(1:Nlen)//'_range'
750	itmp = Nlen + 6
751	Ierro = NF_DEF_VAR(FILEid,tmpchr(1:itmp),
752	& NF_FLOAT, 2, rdID, vrVID)
753	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNscreate', Ierro)
754	TTerr = TTerr + ABS(Ierro)
755
756	ENDIF
757
758	C Define fields :
759	C - - - - - - - -
760	Nlen = VARSIZE(name_vs(ivs))
761	Ierro=NF_DEF_VAR(FILEid , name_vs(ivs)(1:Nlen),
762	& NF_FLOAT, Ndim_vs, dID , vsVID)
763	C **line1 ^^^^^^^^^^ FILEid \| variable name
764	C **line2 type \| #dims \| dimsIDs \| VARid
765	IF (Ierro.NE.NF_NOERR)
766	& CALL HANDLE_ERR('UNscreate (field)', Ierro)
767	TTerr = TTerr + ABS(Ierro)
768
769
770	C Set the variable's attributes :
771	C -------------------------------
772
773	C ** Units:
774	C - - - - -
775	C ** getting unit_vs [char] size :
776	Nlen = VARSIZE(unit_vs(ivs))
777
778	Ierro= NF_PUT_ATT_TEXT(FILEid , vsVID ,'units',
779	& Nlen ,unit_vs(ivs)(1:Nlen))
780	c **line1 ^^^^^^^^^^^^^^^ FILEid \|var.id \| attr.name
781	C **line2 length \| attr.value
782	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNscreate', Ierro)
783	TTerr = TTerr + ABS(Ierro)
784
785	C ** Special case : units = sigma
786	C - - - - - - - - - - - - - - - -
787	C In this case, CV convention advises to write the following
788	C attribute : positive = down
789	C
790	Nlen = VARSIZE(lnam_vs(ivs))
791
792	IF ( unit_vs(ivs)(1:Nlen) .EQ. '[sigma]'
793	& .OR. unit_vs(ivs)(1:Nlen) .EQ. 'sigma_level' ) THEN
794	IF (icheck.ge.3) THEN
795	WRITE(,) 'Unit = sigma -> setting positive attr'
796	ENDIF
797
798	Ierro= NF_PUT_ATT_TEXT(FILEid , vsVID ,'positive',
799	& 4 ,'down')
800	c **line1 ^^^^^^^^^^^^^^^ FILEid \|var.id \| attr.name
801	C **line2 length \| attr.value
802	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNscreate', Ierro)
803	ENDIF
804
805	C ** "long_name":
806	C - - - - - - - -
807	Nlen = VARSIZE(lnam_vs(ivs))
808
809	IF (icheck.ge.3)
810	& WRITE (,) 'Write long_name ',lnam_vs(ivs)(1:Nlen)
811
812	Ierro=NF_PUT_ATT_TEXT(FILEid , vsVID ,'long_name',
813	& Nlen ,lnam_vs(ivs)(1:Nlen) )
814
815	do jj=1,Nlen
816	if(lnam_vs(ivs)(jj:jj).eq." ") lnam_vs(ivs)(jj:jj)="_"
817	if(lnam_vs(ivs)(jj:jj).eq.".") lnam_vs(ivs)(jj:jj)="_"
818	if(lnam_vs(ivs)(jj:jj).eq."(") lnam_vs(ivs)(jj:jj)="_"
819	if(lnam_vs(ivs)(jj:jj).eq.")") lnam_vs(ivs)(jj:jj)="_"
820	if(lnam_vs(ivs)(jj:jj).eq."/") lnam_vs(ivs)(jj:jj)="_"
821	enddo
822
823	Ierro=NF_PUT_ATT_TEXT(FILEid , vsVID ,'standard_name',
824	& Nlen ,lnam_vs(ivs)(1:Nlen) )
825
826	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNscreate', Ierro)
827	TTerr = TTerr + ABS(Ierro)
828
829
830	C ** From the list of real attributes (input argument) :
831	C - - - - - - - - - - - - - - - - - - - - - - - - - - -
832	C
833	DO ira = 1, Nra
834	IF (NAMrat(ira)(1:1).ne.' ') THEN
835	IF (NAMrat(ira)(1:11).eq.'valid_range') THEN
836
837	C ** The "valid_range" special attribute :
838	Ierro=NF_PUT_ATT_REAL(FILEid ,vsVID ,'valid_range' ,
839	& NF_FLOAT,2 , ValRange)
840	TTerr = TTerr + ABS(Ierro)
841
842	ELSE IF (NAMrat(ira)(1:11).ne.'[var]_range') THEN
843
844	C ** All "regular" attributes :
845	Nlen = VARSIZE(NAMrat(ira))
846	IF (Nvals(ira).eq.1) THEN
847	Ierro=NF_PUT_ATT_REAL(FILEid,vsVID,NAMrat(ira)(1:Nlen),
848	& NF_FLOAT, Nvals , zero1 )
849	TTerr = TTerr + ABS(Ierro)
850	ELSE IF (Nvals(ira).eq.2) THEN
851	Ierro=NF_PUT_ATT_REAL(FILEid,vsVID,NAMrat(ira)(1:Nlen),
852	& NF_FLOAT, Nvals , zero2 )
853	TTerr = TTerr + ABS(Ierro)
854	c
855	END IF
856	END IF
857	END IF
858	END DO
859
860	END DO ! **END LOOP on var. num.
861
862	C Set 'unit' attribute for the dimensions:
863	C ----------------------------------------
864
865	DO igd = 0,TND !** BEGIN LOOP over all spatial dims
866
867	C ** getting NAMdim [char] size :
868	Nlen = VARSIZE(UNIdim(igd))
869
870	Ierro=NF_PUT_ATT_TEXT(FILEid , dimVID(igd),'units',
871	& Nlen , UNIdim(igd) )
872
873	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNscreate', Ierro)
874
875	Nlen = VARSIZE(NAMdim(igd))
876
877	Ierro=NF_PUT_ATT_TEXT(FILEid , dimVID(igd),'long_name',
878	& Nlen , NAMdim(igd) )
879
880	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNscreate', Ierro)
881
882	Ierro=NF_PUT_ATT_TEXT(FILEid , dimVID(igd),'standard_name',
883	& Nlen , NAMdim(igd) )
884
885	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNscreate', Ierro)
886	TTerr = TTerr + ABS(Ierro)
887
888	ENDDO
889
890	C Global attribute(s).
891	C --------------------
892
893	C ** Title (some general file descriptor) :
894	C ** getting unit_vs [char] size :
895
896	Nlen = VARSIZE(title)
897
898	Ierro=NF_PUT_ATT_TEXT(FILEid ,NF_GLOBAL,'title',
899	& Nlen ,title(1:Nlen) )
900
901	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNscreate', Ierro)
902
903
904	Nlen = VARSIZE(CF_institution)
905
906	Ierro=NF_PUT_ATT_TEXT(FILEid ,NF_GLOBAL,'institution',
907	& Nlen ,CF_institution)
908
909	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNscreate', Ierro)
910
911	c CALL HostNm(Host, Ierro)
912
913	tmpchar="libUN ("//CF_libUN_version//") - "//FDate()
914	c & " - "//Host
915
916	Nlen = VARSIZE(tmpchar)
917
918	Ierro=NF_PUT_ATT_TEXT(FILEid ,NF_GLOBAL,'history',
919	& Nlen ,tmpchar)
920
921	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNscreate', Ierro)
922
923
924	Nlen = VARSIZE(NF_INQ_LIBVERS())
925
926	Ierro=NF_PUT_ATT_TEXT(FILEid ,NF_GLOBAL,'netcdf',
927	& Nlen ,NF_INQ_LIBVERS())
928
929
930	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNscreate', Ierro)
931	TTerr = TTerr + ABS(Ierro)
932
933
934	C Leave define mode (!file remains open )
935	C ---------------------------------------
936	Ierro=NF_ENDDEF(FILEid)
937	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNscreate', Ierro)
938	TTerr = TTerr + ABS(Ierro)
939
940
941	C Writing of dimensions coordinates.
942	C ----------------------------------
943
944	C ** Time :
945	C - - - - -
946
947	start(1)= 1 !Vector of starting indexes values
948	count(1)= DFdim(0) !Vector of total # indexes values
949	IF (icheck.ge.3)
950	& WRITE (,) 'Write coords for ',NAMdim(0),count(1)
951
952	C ** Set 'imap' to write with NCVPTG; NCVPT could be enough ?
953	C ** (imap tells NetCDF about the memory locations of var,
954	C ** we choose NCVPTG because
955	C ** only a portion of VALdim is written.)
956	imap(1) = 1
957	imap(2) = 0 ! Not used : write only 1 coord.
958
959	Ierro=NF_PUT_VARM_REAL(FILEid ,dimVID(0), start , count,
960	& stride , imap , VALdim(1,0) )
961	C **line 1 ^^^^^^^^^^^^^^^ ID file\| id var. \|read from... \|#data
962	C **line 2 step \|re-arrang\|variable(beg.)
963	C ** (^^^^stride is not used)
964	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNscreate', Ierro)
965
966
967	C ** Space coordinates :
968	C - - - - - - - - - - - -
969
970	DO igd = 1,TND !** BEGIN LOOP over all spatial dims
971
972	start(1)= 1
973	count(1)= DFdim(igd)
974	IF (icheck.ge.3)
975	& WRITE (,) 'Write coords for ',NAMdim(igd),count(1)
976
977
978	Ierro=NF_PUT_VARM_REAL(FILEid ,dimVID(igd),start , count,
979	& stride , imap ,VALdim(1,igd))
980	C ** ^^^^^^^^^^^^^^^^ see above
981	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNscreate', Ierro)
982
983	TTerr = TTerr + ABS(Ierro)
984
985	END DO !** END LOOP over all spatial dims
986
987	C Stop if an error occured.
988	C -------------------------
989
990	IF (TTerr.ne.0) THEN
991	STOP 'UNscreate : Sorry, an error occured.'
992	ENDIF
993
994	C +
995	RETURN
996	END SUBROUTINE UNscreate
997
998	C** +-------------------------+-----------------------------------------+
999	C** + Subroutine UNwrite : + +
1000	C** +-------------------------+ +
1001	C** + * Writes a variable into a NetCDF file, +
1002	C** + (the NetCDF file must have been created (or re-opened) and +
1003	C** + closed after all writing operations). +
1004	C** + * Automatically updates attribute 'actual_range' if available +
1005	C** + " " special var. '[var]_range' " +
1006	C** + +
1007	C** + INPUT : +
1008	C** + FILEid : input file identifier (from UNcreate OR NetCDF open) +
1009	C** + VARname : name given to the variable to write (must be in file)+
1010	C** + itime : No of time step to write to +
1011	C** + Ni,Nj,Nlev: dimensions of 'var' +
1012	C** + ! Nlev= 1 for 2D and 1D input variables. +
1013	C** + Nj = 1 for 1D input variables. +
1014	C** + NB: can not write 1 level of 3D var only (->UNlwrite)+
1015	C** + +
1016	C** + var : The variable to be writen +
1017	C** + +
1018	C** + REMARK : +
1019	C** + Truncation of input data is permited: +
1020	C** + If the dim of "var" > dim in the NetCDF file, +
1021	C** + "var" is automatically truncted. However, this => WARNING +
1022	C** + message, UNLESS a specific truncation was "announced" +
1023	C** + in var: +
1024	C** + To truncate the first dim to Li, let var(Ni,1,1) = Li +
1025	C** + To truncate the 2nd dim to Lj, let var(1,Nj,1) = Lj +
1026	C** + ... (this has no effect exept cancel the "WARNING" message) +
1027	C** +-------------------------------------------------------------------+
1028
1029	SUBROUTINE UNwrite (FILEid , VARname , itime,
1030	& Ni, Nj, Nlev, var)
1031
1032	IMPLICIT NONE
1033
1034	INCLUDE 'libUN.inc'
1035
1036	INTEGER icheck
1037
1038	INTEGER Lvnam
1039	PARAMETER (Lvnam=20)
1040
1041	C ** input
1042	INTEGER FILEid
1043	INTEGER itime
1044	INTEGER Ni, Nj, Nlev
1045	CHARACTER () VARname
1046	REAL*4 var(Ni, Nj, Nlev)
1047
1048	C ** local :
1049	INTEGER MXlv
1050	PARAMETER (MXlv=500)
1051	C ^^^^Maximal # levels for a special output
1052	INTEGER VARSIZE
1053	EXTERNAL VARSIZE
1054	INTEGER NVRi, NVRj, NVRlev
1055	INTEGER Ierro, TTerr, Nvatts, vtype
1056	INTEGER dimID(4), dimSIZ(4), count(4)
1057	INTEGER start(4),stride(4),imap(4)
1058	CHARACTER*(Lvnam) dimNAM(4)
1059	CHARACTER*(Lvnam) recname
1060	CHARACTER*(30) tmpchr
1061	INTEGER varVID
1062	INTEGER VNlen, NDIMvar, NSDIvar, tiDI, itmp
1063	INTEGER iz, ii, jj, ll
1064	INTEGER iUNLIMDIM
1065	REAL*4 chkdim
1066	REAL*4 Arange(2),sValRange(2)
1067	REAL*4 Srange(MXlv,2)
1068	LOGICAL OkRange
1069
1070	icheck= 0 !** 'debugging' level
1071	TTerr = 0 !** 'total number of errors
1072
1073	IF (icheck.ge.1) WRITE(,) 'UNwrite : Begin'
1074
1075	C* 1. Get the variable field and dims IDs
1076	C ----------------------------------------
1077
1078	IF (icheck.ge.2) WRITE(,) 'FILEid :', FILEid
1079
1080	C ** getting VARname size :
1081	VNlen = VARSIZE (VARname)
1082	IF (icheck.ge.3) WRITE(,) 'VNlen :', VNlen
1083	IF (icheck.ge.2) WRITE(,) 'VARname :', VARname (1:VNlen)
1084
1085	C ** variable field ID :
1086	Ierro=NF_INQ_VARID (FILEid, VARname (1:VNlen), varVID)
1087
1088	C ** Cancel writing if an error occured : variable undefined ?
1089	IF (Ierro.ne.0.and.icheck.ge.1) THEN
1090	WRITE(,) 'UNwrite Info : Variable ',VARname(1:VNlen)
1091	& ,' not found -> not written.'
1092	END IF
1093	IF (Ierro.ne.0) GOTO 9999 !** UNwrite_end
1094
1095
1096	C ** Inquire about the number of dimensions in var :
1097	C **
1098	Ierro=NF_INQ_VAR(FILEid , varVID, recname, vtype,
1099	& NDIMvar, dimID, Nvatts)
1100	C ** line1 id/file id/var var name var type
1101	C ** line2 # dims id/dims #attributes
1102	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNwrite', Ierro)
1103
1104	IF (icheck.ge.2) WRITE(,) 'Ierro1. ', Ierro
1105
1106
1107	C* 2. Dimensions : inquire about file + compare with input data.
1108	C -------------------------------------------------------------
1109
1110	C 2.1 Inquire dimensions names and sizes :
1111	C + - - - - - - - - - - - - - - - - - - - - -
1112	DO iz = 1,4
1113	dimSIZ(iz)=0
1114	dimNAM(iz)=' '
1115	C ** Set any unused dimension to "0" size / no name
1116	END DO
1117	DO iz = 1,NDIMvar
1118	Ierro=NF_INQ_DIM(FILEid , dimID(iz), dimNAM(iz), dimSIZ(iz))
1119	C ** id/file id/dim dimname dimsize
1120	C ** !output output
1121	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNwrite', Ierro)
1122	END DO
1123	IF (icheck.ge.3) WRITE(,) 'NDIMvar ',NDIMvar
1124	IF (icheck.ge.3) WRITE(,) 'Ierro 2.0',Ierro
1125
1126	C 2.2 Set writing region according to field dimension : 2D or 3D
1127	C + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1128	C ** Set horizontal dimensions (default, for most data) :
1129	count(1) = Ni
1130	count(2) = Nj
1131	C + ** Other default values:
1132	count(3) = 0
1133	count(4) = 0
1134	start(1) = 1
1135	start(2) = 1
1136	start(3) = 1
1137	start(4) = 1
1138
1139	C +- ------3D+time variable in file-----------
1140	IF (NDIMvar.eq.4) THEN
1141	C ** 3D space + time:
1142	NSDIvar = 3 ! # space dims
1143	tiDI = 4 ! No. of the time dim
1144	C ** write 3D space:
1145	start(3) = 1 ! Start of index 3 in var (here = vert. levs)
1146	count(3) = Nlev ! # values of index 3 in var
1147	C ** write one time step:
1148	start(4) = itime
1149	count(4) = 1
1150	C +- ------3D OR 2D+time var in file--------
1151	ELSE IF (NDIMvar.eq.3) THEN
1152	IF (Nlev.EQ.1) THEN
1153	C ** 2D space + time (standard use of UNlib):
1154	NSDIvar = 2
1155	tiDI = 3
1156	C ** ...write one time step:
1157	start(3) = itime
1158	count(3) = 1
1159	ELSE
1160	C ** 3D (no time slice):
1161	NSDIvar = 3
1162	tiDI = 0
1163	C ** ...write 3rd dimension:
1164	start(3) = 1
1165	count(3) = Nlev
1166	ENDIF
1167	C +- ------2D OR 1D+time var in file--------
1168	ELSE IF (NDIMvar.eq.2) THEN
1169	IF (Nj.EQ.1 .AND. dimNAM(2)(1:4).EQ.'time') THEN
1170	C ** Write a 1D vector at time= itime:
1171	NSDIvar = 1
1172	tiDI = 2
1173	start(2) = itime
1174	count(2) = 1
1175	ELSE
1176	C ** Usual MAR 2D space (no time):
1177	NSDIvar = 2
1178	tiDI = 0
1179	END IF
1180	C +- ------1D OR 0D+time var in file--------
1181	ELSE IF (NDIMvar.eq.1) THEN
1182	C ** 1D space or time
1183	IF (Ni.eq.1) THEN
1184	C ** Write a single element (at itime)
1185	start(1) = itime
1186	count(1) = 1
1187	count(2) = 0
1188	NSDIvar = 0
1189	tiDI = 1
1190	ELSE
1191	C ** Write a vector (use only "space" dim 1)
1192	NSDIvar = 1
1193	tiDI = 0
1194	count(2)= 0
1195	END IF
1196	ELSE
1197	WRITE(,) 'UNwrite ERROR : data field dimension ?'
1198	STOP
1199	END IF
1200
1201	C 2.3 Compare file dimensions to input data.
1202	C + - - - - - - - - - - - - - - - - - - - - - -
1203	C ** Save variable size for use as "valid" size (-> range):
1204	NVRi = Ni
1205	NVRj = Nj
1206	NVRlev = Nlev
1207	C ** Space dimensions :
1208	IF (NSDIvar.GT.0) THEN
1209	DO iz = 1,NSDIvar
1210	IF (dimSIZ(iz).gt.count(iz)) THEN
1211	write(,) 'UNwrite - WARNING: '
1212	write(,) ' Your field ',VARname,' has an empty part.'
1213	write(,) ' (for the dimension:',dimNAM(iz),')'
1214	ELSE IF (dimSIZ(iz).lt.count(iz)) THEN
1215	C ** Do display "warning" only if truncation
1216	C was not "correctly announced" (see header)
1217	C (NVR... => stop here when updating the range attribute)
1218	IF (iz.EQ.1) THEN
1219	chkdim = var(Ni,1,1)
1220	NVRi = dimSIZ(1)
1221	ELSE IF (iz.EQ.2) THEN
1222	chkdim = var(1,Nj,1)
1223	NVRj = dimSIZ(2)
1224	ELSE IF (iz.EQ.3) THEN
1225	chkdim = var(1,1,Nlev)
1226	NVRlev = dimSIZ(3)
1227	ELSE
1228	chkdim = 0.0
1229	ENDIF
1230	Ierro= NF_INQ_UNLIMDIM (FILEid, iUNLIMDIM)
1231	IF (dimID(iz).NE.iUNLIMDIM) THEN
1232	IF (ABS(chkdim-dimSIZ(iz)).GT. 0.1 ) THEN
1233	write(,) 'UNwrite - WARNING: '
1234	write(,) ' Your field ',VARname,' will be truncated.'
1235	write(,) ' (for the dimension:',dimNAM(iz),')'
1236	ENDIF
1237	count(iz) = dimSIZ(iz)
1238	ENDIF
1239	END IF
1240	END DO
1241	END IF
1242
1243	C ** Time dimension (when defined):
1244	IF (tiDI.ne.0) THEN
1245	IF (itime.gt.dimSIZ(tiDI)) THEN
1246	IF (icheck.ge.1) WRITE(,) 'Time limit, ID', dimID(tiDI)
1247	Ierro= NF_INQ_UNLIMDIM (FILEid, iUNLIMDIM)
1248	IF (dimID(tiDI).NE.iUNLIMDIM) THEN
1249	WRITE(,) 'UNwrite - ERROR: '
1250	WRITE(,) ' Time index out of range '
1251	STOP
1252	ENDIF
1253	END IF
1254	END IF
1255
1256	IF (icheck.ge.2) WRITE(,) 'Ierro2. ', Ierro
1257	IF (icheck.ge.2) WRITE(,) 'Dimension names :',dimNAM
1258	IF (icheck.ge.2) WRITE(,) 'dimSIZ :',dimSIZ
1259	IF (icheck.ge.2) WRITE(,) 'count :',count
1260	IF (icheck.ge.2) WRITE(,) 'start :',start
1261	IF (icheck.ge.2) WRITE(,) 'dimID :',dimID
1262
1263	C* 3. Write variable.
1264	C ------------------
1265
1266	C ** Set 'imap' and WRITE with NCVPTG:
1267	C ** NOTE : since the arrays (grid_*) may be over-dimensionned,
1268	C ** we use the 'generalised' writing routine NCVPTG
1269	C ** (imap tells NetCDF about the memory locations of var)
1270	imap(1) = 1
1271	imap(2) = imap(1) * Ni ! 1st dim of var = Ni
1272	imap(3) = imap(2) * Nj ! 2nd dim of var = Nj
1273	imap(4) = 0 ! (not used: 0 or 1 time step)
1274	DO iz=1,4
1275	stride(iz)=1
1276	END DO
1277	C ** NOTE: stride is not used.
1278
1279	Ierro=NF_PUT_VARM_REAL(FILEid , varVID , start , count,
1280	& stride , imap , var(1,1,1) )
1281	C ** line1: id/file \| id/var \|read from...\|#data
1282	C ** line2: step \|re-arrang\|variable(beg.)
1283	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNwrite', Ierro)
1284
1285	IF (icheck.ge.2) WRITE(,) 'Ierro3.2', Ierro
1286
1287	C* 4a. Update 'actual_range' attribute.
1288	C ------------------------------------
1289
1290	C If 'actual_range' available, get its current value:
1291	C - - - - - - - - - - - - - - - - - - - - - - - - - -
1292
1293	C ** Get the old min and max values:
1294	Ierro=NF_GET_ATT_REAL(FILEid ,varVID ,'actual_range' ,
1295	& Arange )
1296	c **line1 ^^^^^^^^^^^^^^ FILEid \|var.id \| attr.name
1297	C **line2 value
1298
1299	C ** Cancel if an error occured : attribute undefined ?
1300	IF (Ierro.ne.0.and.icheck.ge.1) THEN
1301	WRITE(,) 'UNwrite Info : attribute actual_range '
1302	& ,' not found -> not written.'
1303	END IF
1304	IF (Ierro.ne.0) GOTO 9990 !** Next section
1305
1306	C If 'valid_range' available, get its current value:
1307	C - - - - - - - - - - - - - - - - - - - - - - - - - -
1308
1309	C ** Get the min/max valid range (outside = missing val):
1310	Ierro=NF_GET_ATT_REAL(FILEid ,varVID ,'valid_range' ,
1311	& sValRange)
1312	IF (Ierro.ne.0) THEN
1313	sValRange(1)=ValRange(1)
1314	sValRange(2)=ValRange(2)
1315	END IF
1316
1317	C Update the min an max
1318	C - - - - - - - - - - -
1319
1320	C **If this is the first pass, initialise min and max:
1321	IF ( Arange(1).EQ. NF_FILL_REAL
1322	. .OR. (Arange(1).EQ. 0.0 .AND. Arange(2).EQ. 0.0) ) THEN
1323	OkRange = .false.
1324	ELSE
1325	OkRange = .true.
1326	ENDIF
1327
1328	DO ll=1, NVRlev
1329	DO jj=1, NVRj
1330	DO ii=1, NVRi
1331	IF ( var(ii,jj,ll).GE.sValRange(1)
1332	& .AND. var(ii,jj,ll).LE.sValRange(2)) THEN
1333	IF (OkRange) THEN
1334	Arange(1) = MIN(Arange(1), var(ii,jj,ll))
1335	Arange(2) = MAX(Arange(2), var(ii,jj,ll))
1336	ELSE
1337	Arange(1) = var(ii,jj,ll)
1338	Arange(2) = var(ii,jj,ll)
1339	OkRange = .true.
1340	ENDIF
1341	ENDIF
1342	ENDDO
1343	ENDDO
1344	ENDDO
1345	IF (icheck.ge.2) WRITE(,) 'Arange',Arange
1346
1347	C Set attribute.
1348	C - - - - - - - -
1349
1350	Ierro=NF_PUT_ATT_REAL(FILEid ,varVID ,'actual_range' ,
1351	& NF_FLOAT,2 ,Arange)
1352	c **line1 ^^^^^^^^^^^^^^^ FILEid \|var.id \| attr.name
1353	C **line2 type \|len \| attr.value
1354	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNwrite', Ierro)
1355	TTerr = TTerr + ABS(Ierro)
1356
1357	C ** Next section:
1358	9990 CONTINUE
1359
1360	C* 5. Update the optional '[var]_range' special variable.
1361	C ------------------------------------------------------
1362	IF (NDIMvar.eq.4.and.Nlev.lt.MXlv) THEN
1363
1364	C If '[var]_range' available, get its current value:
1365	C - - - - - - - - - - - - - - - - - - - - - - - - - -
1366
1367	C ** Get ID of variable [var]_range :
1368	tmpchr = VARname(1:VNlen)//'_range'
1369	itmp = VNlen + 6
1370	Ierro=NF_INQ_VARID(FILEid, tmpchr(1:itmp), varVID)
1371
1372	C ** Cancel if an error occured : undefined ?
1373	IF (Ierro.ne.0.and.icheck.ge.1) THEN
1374	WRITE(,) 'UNwrite Info : [var]_range '
1375	& ,' not found -> not written.'
1376	END IF
1377	IF (Ierro.ne.0) GOTO 9999 !** UNwrite_end
1378
1379	C ** Get the old min and max values:
1380	C ** NOTE :
1381	C ** we use the 'generalised' reading routine NCVGTG
1382	C ** (imap tells NetCDF about the memory locations of var)
1383	imap(1) = 1
1384	imap(2) = imap(1) * MXlv
1385	start(1)= 1
1386	start(2)= 1
1387	count(1)= Nlev
1388	count(2)= 2
1389
1390	C ** (See UNread for explanations about NCVGTG)
1391	Ierro=NF_GET_VARM_REAL(FILEid, varVID, start, count,
1392	& stride, imap , Srange(1,1) )
1393	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNwrite', Ierro)
1394
1395	C Update the min an max
1396	C - - - - - - - - - - -
1397	C **If this is the first pass, initialise min and max:
1398	C **(Constant fields shall not be accounted for)
1399	DO ll=1, Nlev
1400	IF (Srange(ll,1).eq.Srange(ll,2)) THEN
1401	Srange(ll,1) = var(1,1,ll)
1402	Srange(ll,2) = var(1,1,ll)
1403	ENDIF
1404	ENDDO
1405
1406	DO jj=1, NVRj
1407	DO ii=1, NVRi
1408	DO ll=1, NVRlev
1409	Srange(ll,1) = MIN(Srange(ll,1), var(ii,jj,ll))
1410	Srange(ll,2) = MAX(Srange(ll,2), var(ii,jj,ll))
1411	ENDDO
1412	ENDDO
1413	ENDDO
1414	IF (icheck.ge.4) WRITE(,) 'Srange',Srange
1415
1416
1417	C Set special variable [var]_range
1418	C - - - - - - - - - - - - - - - - -
1419	C **(See UNread for explanations abtout NCVPTG)
1420
1421	Ierro=NF_PUT_VARM_REAL(FILEid , varVID , start, count,
1422	& stride , imap , Srange(1,1) )
1423	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNwrite', Ierro)
1424
1425	ENDIF ! End Section 5.
1426
1427	C UNwrite_end
1428	C -----------
1429	IF (icheck.ge.2) WRITE(,) 'Errors count:',TTerr
1430	IF (icheck.ge.2) WRITE(,) 'UNwrite : End'
1431	9999 CONTINUE
1432	RETURN
1433	END
1434	C**
1435	C** +-------------------------+-----------------------------------------+
1436	C** + Subroutine UNlwrite : + +
1437	C** +-------------------------+ +
1438	C** + * Writes a 2D horizontal LEVEL into a 3D+time NetCDF variable +
1439	C** + OR a 1D vector into a 2D+time +
1440	C** + -- ---- -- +
1441	C** + (SEE ALSO : UNwrite, for all dimensions - this a pecular case +
1442	C** + Note: 1D vectors are writen in the 1st dim of 2D+time) +
1443	C** + +
1444	C** + * Automatically updates attribute 'actual_range' if available +
1445	C** + " " special var. '[var]_range' " +
1446	C** + +
1447	C** + INPUT : +
1448	C** + FILEid : input file identifier (from UNcreate OR NetCDF open) +
1449	C** + VARname : name given to the variable to write (must be in file)+
1450	C** + itime : No of time step to write to +
1451	C** + level : No of level to write to +
1452	C** + Ni, Nj : dimensions of 'var'... +
1453	C** + var : A 2D variable to be writen +
1454	C** +-------------------------------------------------------------------+
1455
1456	SUBROUTINE UNlwrite (FILEid , VARname , itime,
1457	& ilev, Ni, Nj, var)
1458
1459	IMPLICIT NONE
1460
1461	INCLUDE 'libUN.inc'
1462
1463	INTEGER icheck
1464
1465	INTEGER Lvnam
1466	PARAMETER (Lvnam=20)
1467
1468	C ** input
1469	INTEGER FILEid
1470	INTEGER itime, ilev
1471	INTEGER Ni, Nj
1472	CHARACTER () VARname
1473	REAL*4 var(Ni, Nj)
1474
1475	C ** local :
1476	INTEGER VARSIZE
1477	EXTERNAL VARSIZE
1478	INTEGER Ierro, TTerr, Nvatts, vtype
1479	INTEGER dimID(4), dimSIZ(4), count(4)
1480	INTEGER start(4),stride(4),imap(4)
1481	INTEGER iUNLIMDIM
1482	CHARACTER*(Lvnam) dimNAM(4)
1483	CHARACTER*(Lvnam) recname
1484	CHARACTER*(30) tmpchr
1485	INTEGER varVID
1486	INTEGER VNlen, NDIMvar, NSDIvar, tiDI, ilDI, itmp
1487	INTEGER iz, ii, jj
1488	LOGICAL OkRange
1489	REAL*4 Arange(2), sValRange(2)
1490	REAL*4 Srange(2)
1491
1492	icheck= 0 !** 'debugging' level
1493	TTerr = 0 !** 'total numbe of errors
1494
1495	IF (icheck.ge.1) WRITE(,) 'UNlwrite : Begin'
1496
1497	C* 1. Get the variable field and dims IDs
1498	C ----------------------------------------
1499
1500	IF (icheck.ge.2) WRITE(,) 'FILEid :', FILEid
1501
1502	C ** getting VARname size :
1503	VNlen = VARSIZE (VARname)
1504	IF (icheck.ge.3) WRITE(,) 'VNlen :',VNlen
1505	IF (icheck.ge.2) WRITE(,) 'VARname :', VARname (1:VNlen)
1506
1507	C ** variable field ID :
1508	Ierro=NF_INQ_VARID (FILEid, VARname (1:VNlen), varVID)
1509
1510	C ** Cancel writing if an error occured : variable undefined ?
1511	IF (Ierro.ne.0.and.icheck.ge.1) THEN
1512	WRITE(,) 'UNlwrite Info : Variable ',VARname(1:VNlen)
1513	& ,' not found -> not written.'
1514	END IF
1515	IF (Ierro.ne.0) GOTO 9999 !** UNlwrite_end
1516
1517
1518	C ** Inquire about the number of dimensions in var :
1519	C **
1520	Ierro=NF_INQ_VAR(FILEid , varVID, recname, vtype,
1521	& NDIMvar, dimID, Nvatts)
1522	C ** line1 id/file id/var var name var type
1523	C ** line2 # dims id/dims #attributes
1524	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNlwrite', Ierro)
1525
1526	IF (icheck.ge.2) WRITE(,) 'Ierro1. ', Ierro
1527
1528
1529	C* 2. Dimensions : inquire about file + compare with input data.
1530	C -------------------------------------------------------------
1531
1532	C 2.1 Inquire dimensions names and sizes :
1533	C + - - - - - - - - - - - - - - - - - - - - -
1534	DO iz = 1,4
1535	dimSIZ(iz)=0
1536	dimNAM(iz)=' '
1537	C ** Set any unused dimension to "0" size / no name
1538	END DO
1539
1540	DO iz = 1,NDIMvar
1541	Ierro=NF_INQ_DIM(FILEid , dimID(iz), dimNAM(iz), dimSIZ(iz))
1542	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNlwrite', Ierro)
1543	C ** id/file id/dim dimname dimsize error
1544	C ** !output output
1545	END DO
1546	IF (icheck.ge.3) WRITE(,) 'NDIMvar ',NDIMvar
1547	IF (icheck.ge.3) WRITE(,) 'Ierro 2.0',Ierro
1548
1549	C 2.2 Set writing region according to field dimension : 3D
1550	C + - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1551	C ** Set horizontal dimensions (all field dims):
1552	count(1) = Ni
1553	count(2) = Nj
1554	start(1) = 1
1555	start(2) = 1
1556	C +- ------ 3D+time var in file--------
1557	IF (NDIMvar.eq.4) THEN
1558	NSDIvar = 2 ! # input space dims (for a 2D level)
1559	tiDI = 4 ! No. of the time dim
1560	C ** write one level (set the level No) :
1561	start(3) = ilev ! Start of index 3 in var
1562	count(3) = 1 ! # values of index 3 in var
1563	ilDI = 3
1564	C ** write one time step:
1565	start(4) = itime
1566	count(4) = 1
1567	C +- ------ 2D+time var in file--------
1568	ELSE IF (NDIMvar.eq.3) THEN
1569	NSDIvar = 1 ! # input space dims (for a 1D vector)
1570	tiDI = 3 ! No. of the time dim
1571	C ** write one "level" - here a 1D vector in the 1st dim.
1572	start(2) = ilev ! Start of index 2 in var
1573	count(2) = 1 ! # values of index 3 in var
1574	ilDI = 2
1575	C ** write one time step:
1576	start(3) = itime
1577	count(3) = 1
1578	ELSE
1579	WRITE(,) 'UNlwrite ERROR : data field dimension ?'
1580	WRITE(,) ' NB: UNlwrite = only for (2 or) 3D +time.'
1581	STOP
1582	END IF
1583
1584	C 2.3 Compare file dimensions to input data.
1585	C + - - - - - - - - - - - - - - - - - - - - - -
1586	C ** Space dimensions :
1587	DO iz = 1,NSDIvar
1588	IF (dimSIZ(iz).gt.count(iz)) THEN
1589	write(,) 'UNlwrite - WARNING: '
1590	write(,) ' Your field ',VARname,' has an empty part.'
1591	write(,) ' (for the dimension:',dimNAM(iz),')'
1592	ELSE IF (dimSIZ(iz).lt.count(iz)) THEN
1593	write(,) 'UNlwrite - WARNING: '
1594	write(,) ' Your field ',VARname,' will be truncated.'
1595	write(,) ' (for the dimension:',dimNAM(iz),')'
1596	count(iz) = dimSIZ(iz)
1597	END IF
1598	END DO
1599
1600	C ** Space dimensions - check if requested level exists:
1601	IF (dimSIZ(ilDI).lt.ilev) THEN
1602	write(,) 'UNlwrite - ERROR: '
1603	write(,) ' The requested level =',ilev
1604	write(,) ' does not exist in the field ',VARname
1605	write(,) ' (for the dimension:',dimNAM(ilDI),')'
1606	STOP
1607	END IF
1608
1609	C ** Time dimension (when defined):
1610	IF (tiDI.ne.0) THEN
1611	IF (itime.gt.dimSIZ(tiDI)) THEN
1612	IF (icheck.ge.1) WRITE(,) 'Time limit, ID', dimID(tiDI)
1613	Ierro= NF_INQ_UNLIMDIM (FILEid, iUNLIMDIM)
1614	IF (dimID(tiDI).NE.iUNLIMDIM) THEN
1615	WRITE(,) 'UNlwrite - ERROR: '
1616	WRITE(,) ' Time index out of range '
1617	STOP
1618	ENDIF
1619	END IF
1620	END IF
1621
1622	IF (icheck.ge.2) WRITE(,) 'Ierro2. ', Ierro
1623	IF (icheck.ge.2) WRITE(,) 'Dimension names :',dimNAM
1624	IF (icheck.ge.3) WRITE(,) 'dimSIZ :',dimSIZ
1625	IF (icheck.ge.3) WRITE(,) 'count :',count
1626	IF (icheck.ge.3) WRITE(,) 'start :',start
1627	IF (icheck.ge.3) WRITE(,) 'dimID :',dimID
1628
1629	C* 3. Write variable.
1630	C ------------------
1631
1632	C ** Set 'imap' and WRITE with NCVPTG:
1633	C ** NOTE : since the arrays (grid_*) may be over-dimensionned,
1634	C ** we use the 'generalised' writing routine NCVPTG
1635	C ** (imap tells NetCDF about the memory locations of var)
1636	imap(1) = 1
1637	imap(2) = imap(1) * Ni ! 1st dim of var = Ni
1638	imap(3) = imap(2) * Nj ! (not used: 1 level...)
1639	imap(4) = 0 ! (not used: 0 or 1 time step)
1640	DO iz=1,4
1641	stride(iz)=1
1642	END DO
1643	C ** NOTE: stride is not used.
1644
1645	Ierro=NF_PUT_VARM_REAL (FILEid , varVID , start , count,
1646	& stride , imap , var(1,1) )
1647	C ** line1: id/file \| id/var \|read from...\|#data
1648	C ** line2: step \|re-arrang\|variable(beg.)
1649	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNlwrite', Ierro)
1650
1651	IF (icheck.ge.2) WRITE(,) 'Ierro3.2', Ierro
1652
1653	C* 4a. Update 'actual_range' attribute.
1654	C ------------------------------------
1655
1656	C If 'actual_range' available, get its current value:
1657	C - - - - - - - - - - - - - - - - - - - - - - - - - -
1658
1659	C ** Get the old min and max values:
1660	Ierro=NF_GET_ATT_REAL(FILEid ,varVID ,'actual_range' ,
1661	& Arange )
1662	c **line1 ^^^^^^^^^^^^^^^ FILEid \|var.id \| attr.name
1663	C **line2 value
1664
1665	C ** Cancel if an error occured : attribute undefined ?
1666	IF (Ierro.ne.0.and.icheck.ge.1) THEN
1667	WRITE(,) 'UNlwrite Info : attribute actual_range '
1668	& ,' not found -> not written.'
1669	END IF
1670	IF (Ierro.ne.0) GOTO 9990 !** Next section
1671
1672	C If 'valid_range' available, get its current value:
1673	C - - - - - - - - - - - - - - - - - - - - - - - - - -
1674
1675	C ** Get the min/max valid range (outside = missing val):
1676	Ierro=NF_GET_ATT_REAL(FILEid ,varVID ,'valid_range' ,
1677	& sValRange)
1678	IF (Ierro.ne.0) THEN
1679	sValRange(1)=ValRange(1)
1680	sValRange(1)=ValRange(2)
1681	END IF
1682
1683	C Update the min an max
1684	C - - - - - - - - - - -
1685
1686	C **If this is the first pass, initialise min and max:
1687	IF ( Arange(1).EQ. NF_FILL_REAL
1688	. .OR. (Arange(1).EQ. 0.0 .AND. Arange(2).EQ. 0.0) ) THEN
1689	OkRange = .false.
1690	ELSE
1691	OkRange = .true.
1692	ENDIF
1693
1694	DO jj=1, Nj
1695	DO ii=1, Ni
1696	IF ( var(ii,jj).GE.sValRange(1)
1697	& .AND. var(ii,jj).LE.sValRange(2)) THEN
1698	IF (OkRange) THEN
1699	Arange(1) = MIN(Arange(1), var(ii,jj))
1700	Arange(2) = MAX(Arange(2), var(ii,jj))
1701	ELSE
1702	Arange(1) = var(ii,jj)
1703	Arange(2) = var(ii,jj)
1704	OkRange = .true.
1705	ENDIF
1706	ENDIF
1707	ENDDO
1708	ENDDO
1709	IF (icheck.ge.2) WRITE(,) 'Arange',Arange
1710
1711	C Set attribute.
1712	C - - - - - - - -
1713
1714	Ierro=NF_PUT_ATT_REAL(FILEid ,varVID ,'actual_range' ,
1715	& NF_FLOAT,2 ,Arange )
1716	c **line1 ^^^^^^^^^^^^^^^ FILEid \|var.id \| attr.name
1717	C **line2 type \|len \| attr.value
1718	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNlwrite', Ierro)
1719	TTerr = TTerr + ABS(Ierro)
1720
1721	C ** Next section:
1722	9990 CONTINUE
1723
1724
1725	C* 5. Update the optional '[var]_range' special variable.
1726	C ------------------------------------------------------
1727	IF (NDIMvar.eq.4) THEN
1728
1729	C If '[var]_range' available, get its current value:
1730	C - - - - - - - - - - - - - - - - - - - - - - - - - -
1731
1732	C ** Get ID of variable [var]_range :
1733	tmpchr = VARname(1:VNlen)//'_range'
1734	itmp = VNlen + 6
1735	Ierro=NF_INQ_VARID (FILEid, tmpchr(1:itmp), varVID)
1736
1737	C ** Cancel if an error occured : undefined ?
1738	IF (Ierro.ne.0.and.icheck.ge.1) THEN
1739	WRITE(,) 'UNlwrite Info : [var]_range '
1740	& ,' not found -> not written.'
1741	END IF
1742	IF (Ierro.ne.0) GOTO 9999 !** UNlwrite_end
1743
1744	C ** Get the old min and max values:
1745	C ** NOTE :
1746	C ** we use the 'generalised' reading routine NCVGTG
1747	C ** (imap tells NetCDF about the memory locations of var)
1748	imap(1) = 1
1749	imap(2) = 0 ! Not used (write only 1 lev)
1750	start(1)= ilev
1751	count(1)= 1
1752	start(2)= 1
1753	count(2)= 2
1754
1755	C ** (See UNread for explanations abtout NCVGTG)
1756	Ierro=NF_GET_VARM_REAL(FILEid, varVID, start ,count,
1757	& stride, imap , Srange(1) )
1758	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNlwrite', Ierro)
1759
1760	C Update the min an max
1761	C - - - - - - - - - - -
1762	C **If this is the first pass, initialise min and max:
1763	C **(Constant fields shall not be accounted for)
1764	IF (Srange(1).eq.Srange(2)) THEN
1765	Srange(1) = var(1,1)
1766	Srange(2) = var(1,1)
1767	ENDIF
1768
1769	DO jj=1, Nj
1770	DO ii=1, Ni
1771	Srange(1) = MIN(Srange(1), var(ii,jj))
1772	Srange(2) = MAX(Srange(2), var(ii,jj))
1773	ENDDO
1774	ENDDO
1775	IF (icheck.ge.4) WRITE(,) 'Srange',Srange
1776
1777
1778	C Set special variable [var]_range
1779	C - - - - - - - - - - - - - - - - -
1780	C **(See UNread for explanations abtout NCVPTG)
1781
1782	Ierro=NF_PUT_VARM_REAL(FILEid , varVID , start , count,
1783	& stride , imap , Srange(1) )
1784	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNlwrite', Ierro)
1785
1786	ENDIF ! End Section 5.
1787
1788	C UNlwrite_end
1789	C -----------
1790	IF (icheck.ge.2) WRITE(,) 'Errors count:',TTerr
1791	IF (icheck.ge.2) WRITE(,) 'UNlwrite : End'
1792	9999 CONTINUE
1793	RETURN
1794	END
1795	C**
1796	C** +-------------------------+-----------------------------------------+
1797	C** + Subroutine UNread : + +
1798	C** +-------------------------+ +
1799	C** + * Reads a model variable from a NetCDF file, +
1800	C** + and reads the coordinates of the grid upon wich it is defined. +
1801	C** + (the NetCDF file must have been opened and must be closed +
1802	C** + after all reading operations). May read an x-y subregion. +
1803	C** + +
1804	C** + INPUT : +
1805	C** + FILEid : input file identifier (from NetCDF open) +
1806	C** + VARname : name of the requested variable. +
1807	C** + time : [integer*4] is the time index of the data field to read +
1808	C** + level: [integer*4] (usefull for 3D-space fields only) : +
1809	C** + if not=0 --> = no of the level +
1810	C** + -> output is 2D (l_dim = 1) +
1811	C** + if =0 --> read ALL levels +
1812	C** + -> output is 3D +
1813	C** + i_dbeg, j_dbeg : horizontal indexes of requested region +
1814	C** + in input data file +
1815	C** + i_dim, j_dim, l_dim : ...the dimensions of 'var', +
1816	C** + = the dimensions of the sub-region to read +
1817	C** + ! l_dim = 1 if level not=0 +
1818	C** + ! j_dim = 1 if var is 1D +
1819	C** + OUTPUT : +
1820	C** + varax1[i_dim] (real ) +
1821	C** + varax2[j_dim]: Horizontal coordinates in the file (lat/lon,...)+
1822	C** + varlev[l_dim]: vertical coordinate of the levels +
1823	C** + (! when level not=0, only varlev(1) is defined) +
1824	C** + var_units : physical units of var. +
1825	C** + var[i_dim,j_dim,l_dim] : +
1826	C** + data field values +
1827	C** + (var must be defined, and is REAL ) +
1828	C** + +
1829	C** +-------------------------------------------------------------------+
1830
1831	SUBROUTINE UNread
1832	& (FILEid , VARname , time, level, i_dbeg, j_dbeg,
1833	& i_dim , j_dim , l_dim ,
1834	& varax1 , varax2 , varlev,
1835	& var_units, var)
1836
1837	IMPLICIT NONE
1838	INCLUDE 'libUN.inc'
1839
1840	INTEGER icheck
1841
1842	INTEGER Lvnam
1843	PARAMETER (Lvnam=20)
1844
1845	C ** input
1846	INTEGER FILEid
1847	INTEGER time, level, i_dbeg, j_dbeg
1848	INTEGER i_dim, j_dim, l_dim
1849	CHARACTER () VARname
1850
1851	C ** output
1852	REAL*4 varax1(i_dim), varax2(j_dim), varlev(l_dim)
1853	CHARACTER () var_units
1854	REAL*4 var (i_dim, j_dim, l_dim)
1855
1856	C ** local :
1857	INTEGER VARSIZE
1858	EXTERNAL VARSIZE
1859	REAL*4 varmin,varmax
1860	INTEGER Ierro, Nvatts, vtype
1861	INTEGER dimID(4), dimSIZ(4), dimREG(4)
1862	INTEGER start(4),begREG(4),count(4),stride(4),imap(4)
1863	CHARACTER*(Lvnam) dimNAM(4)
1864	CHARACTER*(Lvnam) dNAMver, dNAMtim
1865	CHARACTER*(Lvnam) recname
1866	CHARACTER*(10) Routine
1867	INTEGER ax1VID, ax2VID, verVID, timVID, varVID
1868	INTEGER VNlen, varNUMDIM
1869	INTEGER ii,jj,ll,z
1870
1871	icheck= 0
1872	C* 0. Initialisations
1873	C ------------------
1874	Routine= 'UNread'
1875	IF (icheck.ge.1) WRITE(,) 'UNread : Begin'
1876
1877	DO ii = 1,4
1878	stride(ii) = 1
1879	begREG(ii) = 1
1880	start (ii) = 1
1881	ENDDO
1882
1883	C* 1. Get the variable field and dims IDs
1884	C ----------------------------------------
1885
1886	IF (icheck.ge.3) WRITE(,) 'FILEid :', FILEid
1887
1888	C ** getting VARname size :
1889	VNlen = VARSIZE(VARname)
1890	IF (icheck.ge.3) WRITE(,) 'VNlen :',VNlen
1891	IF (icheck.ge.2) WRITE(,) 'VARname :', VARname (1:VNlen)
1892
1893	C ** variable field ID :
1894	Ierro=NF_INQ_VARID (FILEid, VARname (1:VNlen), varVID)
1895
1896	C* 1b. Handle non-existing variables
1897	C ---------------------------------
1898	IF (Ierro.NE.NF_NOERR) THEN
1899	IF (Ierro.EQ.NF_ENOTVAR .AND. iVarWarn.LE.1) THEN
1900	IF (iVarWarn.EQ.1) THEN
1901	write(,) 'WARNING (UNsread): variable not found:'
1902	write(,) ' ',varName
1903	ENDIF
1904	DO ll=1,l_dim
1905	DO jj=1,j_dim
1906	DO ii=1,i_dim
1907	var (ii,jj,ll)=VarRepl
1908	ENDDO
1909	ENDDO
1910	ENDDO
1911	RETURN ! EXIT SUBROUTINE, read nothing
1912	ENDIF
1913	WRITE(,) 'Error reading variable: ', VARname(1:VNlen)
1914	CALL HANDLE_ERR('UNsread',Ierro)
1915	ENDIF
1916
1917	C 1c. Inquire about the number of dimensions in var
1918	C -------------------------------------------------
1919
1920	Ierro=NF_INQ_VAR(FILEid , varVID, recname, vtype,
1921	& varNUMDIM, dimID, Nvatts )
1922	C ** line1 id/file id/var var name var type
1923	C ** line2 # dims id/dims #attributes
1924	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNsread', Ierro)
1925
1926	IF (icheck.ge.3) WRITE(,) 'Ierro1. ', Ierro
1927
1928	C* 2. Dimensions : in the reading region and in the file.
1929	C ------------------------------------------------------
1930
1931	C ** inquire dimensions names and sizes :
1932	DO z = 1,varNUMDIM
1933	Ierro=NF_INQ_DIM(FILEid , dimID(z), dimNAM(z), dimSIZ(z))
1934	C ** id/file id/dim dimname dimsize
1935	C ** !output output
1936	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR(Routine, Ierro)
1937	END DO
1938
1939	C ** In this version, we read only a xy subregion of the file :
1940	dimREG(1) = i_dim
1941	dimREG(2) = j_dim
1942	begREG(1) = i_dbeg
1943	begREG(2) = j_dbeg
1944	IF (begREG(1).lt.1) begREG(1) = 1
1945	IF (begREG(2).lt.1) begREG(2) = 1
1946
1947	C ** Set reading region according to field dimension : 2D or 3D
1948	IF (varNUMDIM.eq.4) THEN
1949	C ** for 3D fields :
1950	IF (level.gt.0) THEN
1951	C ** one level is read :
1952	dimREG(3) = 1
1953	begREG(3) = level
1954	dNAMver = dimNAM(3)
1955	ELSE
1956	C ** all levels are read :
1957	dimREG(3) = l_dim
1958	begREG(3) = 1
1959	dNAMver = dimNAM(3)
1960	END IF
1961	C ** one time step is read:
1962	dimREG(4) = 1
1963	begREG(4) = time
1964	dNAMtim = dimNAM(4)
1965	ELSE IF (varNUMDIM.eq.3) THEN
1966	C ** for 2D space fields + time:
1967	C ** one time step is read:
1968	dimREG(3) = 1
1969	begREG(3) = time
1970	dNAMtim = dimNAM(3)
1971	dimREG(4) = 0
1972	begREG(4) = 0
1973	dimNAM(4) = 'none'
1974	ELSE IF (varNUMDIM.eq.2) THEN
1975	C ** for 2D fields :
1976	C ** no time step is read:
1977	dimREG(3) = 0
1978	begREG(3) = 0
1979	dNAMtim = 'none'
1980	dimNAM(3) = 'none'
1981	dimREG(4) = 0
1982	begREG(4) = 0
1983	dimNAM(4) = 'none'
1984	ELSE IF (varNUMDIM.eq.1) THEN
1985	C ** for 1D variable :
1986	C ** not assumed to be on a XYZ grid,
1987	C ** just read a vector
1988	dimREG(1) = 1 ! this was added by Martin Vancop for 1d vectors
1989	begREG(1) = time ! this was added by Martin Vancop for 1d vectors
1990	dimREG(2) = 0
1991	begREG(2) = 0
1992	dimNAM(2) = 'none'
1993	dimREG(3) = 0
1994	begREG(3) = 0
1995	dimNAM(3) = 'none'
1996	dNAMtim = 'none'
1997	dimREG(4) = 0
1998	begREG(4) = 0
1999	dimNAM(4) = 'none'
2000	ELSE
2001	WRITE(,) 'UNread ERROR : data field dimension ?'
2002	STOP
2003	END IF
2004
2005	DO z = 1,varNUMDIM
2006	IF (begREG(z).gt.dimSIZ(z)) THEN
2007	write(,) 'UNread - ERROR : requested area out '
2008	write(,) ' of file area. '
2009	write(,) ' (for the dimension:' , dimNAM(z) , ')'
2010	STOP
2011	END IF
2012	IF (dimSIZ(z).lt.(dimREG(z)+begREG(z)- 1) ) THEN
2013	write(,) 'UNread - WARNING : empty portion in field, '
2014	write(,) ' requested region > file contents '
2015	write(,) ' (for the dimension:' , dimNAM(z) , ')'
2016	dimREG(z) = dimSIZ(z) - begREG(z) + 1
2017	END IF
2018	END DO
2019
2020	IF (icheck.ge.3) WRITE(,) 'Ierro2. ', Ierro
2021	IF (icheck.ge.2) WRITE(,) 'Dimension names :',dimNAM
2022	IF (icheck.ge.2) WRITE(,) 'dimSIZ :',dimSIZ
2023	IF (icheck.ge.2) WRITE(,) 'dimREG :',dimREG
2024	IF (icheck.ge.2) WRITE(,) 'begREG :',begREG
2025	IF (icheck.ge.3) WRITE(,) 'dimID :',dimID
2026
2027	C* 3. Get the variables IDs for the grid points locations.
2028	C -------------------------------------------------------
2029
2030	IF (varNUMDIM.ge.2) THEN
2031	Ierro=NF_INQ_VARID (FILEid, dimNAM(1), ax1VID)
2032	IF (Ierro.NE.NF_NOERR) THEN
2033	IF (Ierro.EQ.NF_ENOTVAR) THEN
2034	WRITE(,) 'Coordinate values not found:',dimNAM(1)
2035	ENDIF
2036	CALL HANDLE_ERR(Routine, Ierro)
2037	ENDIF
2038	Ierro=NF_INQ_VARID (FILEid, dimNAM(2), ax2VID)
2039	IF (Ierro.NE.NF_NOERR) THEN
2040	IF (Ierro.EQ.NF_ENOTVAR) THEN
2041	WRITE(,) 'Coordinate values not found:',dimNAM(2)
2042	ENDIF
2043	CALL HANDLE_ERR(Routine, Ierro)
2044	ENDIF
2045	ENDIF
2046	IF (varNUMDIM.ge.3) THEN
2047	Ierro=NF_INQ_VARID (FILEid, dNAMtim, timVID)
2048	IF (Ierro.NE.NF_NOERR) THEN
2049	IF (Ierro.EQ.NF_ENOTVAR) THEN
2050	WRITE(,) 'Coordinate values not found:',dNAMtim
2051	ENDIF
2052	CALL HANDLE_ERR(Routine, Ierro)
2053	ENDIF
2054	END IF
2055	IF (varNUMDIM.eq.4) THEN
2056	Ierro=NF_INQ_VARID (FILEid, dNAMver, verVID)
2057	IF (Ierro.NE.NF_NOERR) THEN
2058	IF (Ierro.EQ.NF_ENOTVAR) THEN
2059	WRITE(,) 'Coordinate values not found:',dNAMver
2060	ENDIF
2061	CALL HANDLE_ERR(Routine, Ierro)
2062	ENDIF
2063	END IF
2064	C ** id/file name id/var
2065
2066	IF (icheck.ge.3) WRITE(,) 'Ierro3. ', Ierro
2067
2068	C* 4. Get attributes.
2069	C ------------------
2070
2071	IF (varNUMDIM.ge.2) THEN !Not for 1D vectors (special case)
2072	C ** units attribute
2073	Ierro=NF_GET_ATT_TEXT (FILEid , varVID, 'units',
2074	& var_units)
2075	IF (Ierro.NE.NF_NOERR) THEN
2076	IF (Ierro.EQ.NF_ENOTATT) THEN
2077	write(,) 'Note (UNread): units not found for'
2078	write(,) ' ',varName
2079	var_units=' '
2080	ELSE
2081	CALL HANDLE_ERR('UNread',Ierro)
2082	ENDIF
2083	ENDIF
2084
2085	IF (icheck.ge.2) WRITE(,) 'var_units :', var_units
2086	ENDIF
2087
2088	C* 5. Get values.
2089	C --------------
2090	C* 5.1 ...for the grid points locations.
2091	C -------------------------------------
2092
2093	C ** Horizontal : always read, except for 1D vectors
2094	IF (varNUMDIM.ge.2) THEN
2095	count(1)=dimREG(1)
2096	start(1)=begREG(1)
2097	Ierro=NF_GET_VARA_REAL(FILEid ,ax1VID,start,count,varax1)
2098	C ** id/file id/var from #data data
2099	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR(Routine, Ierro)
2100	count(1)=dimREG(2)
2101	start(1)=begREG(2)
2102	Ierro=NF_GET_VARA_REAL(FILEid ,ax2VID,start,count,varax2)
2103	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR(Routine, Ierro)
2104	ENDIF
2105
2106	C ** vertical : only for 3D fields.
2107	IF (varNUMDIM.eq.4) THEN
2108	start(1) =begREG(3)
2109	count(1) =dimREG(3)
2110	Ierro = NF_GET_VARA_REAL(FILEid ,verVID,start,count,varlev)
2111	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR(Routine, Ierro)
2112	END IF
2113
2114	IF (icheck.ge.3) WRITE(,) 'Ierro5.1', Ierro
2115
2116	C* 5.2 ...for the the variable.
2117	C ----------------------------
2118
2119	C ** Set 'imap' and READ with NCVGTG:
2120	C ** NOTE :
2121	C ** we use the 'generalised' reading routine NCVGTG
2122	C ** (imap tells NetCDF about the memory locations of var)
2123	imap(1) = 1
2124	imap(2) = imap(1) * i_dim ! 1st dim of var = i_dim
2125	imap(3) = imap(2) * j_dim ! 2nd dim of var = j_dim
2126	imap(4) = 0 ! Should NEVER be used
2127	Ierro=NF_GET_VARM_REAL(FILEid , varVID ,begREG , dimREG,
2128	& stride , imap ,var(1,1,1) )
2129	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR(Routine, Ierro)
2130
2131	IF (icheck.ge.3) WRITE(,) 'Ierro5.2', Ierro
2132
2133	C* 6. Check data
2134	C -------------
2135	IF (ireadchk.GE.1) THEN
2136	varmax = var (1,1,1)
2137	varmin = var (1,1,1)
2138	DO ll=1,l_dim
2139	DO jj=1,j_dim
2140	DO ii=1,i_dim
2141	var(ii,jj,ll)=var(ii,jj,ll)+0.0E0
2142	C This fixes underflow values but must compile with -fpe1
2143	varmax = MAX(var (ii,jj,ll),varmax)
2144	varmin = MIN(var (ii,jj,ll),varmin)
2145	ENDDO
2146	ENDDO
2147	ENDDO
2148	IF (varmin.LT.vReadMin .OR. varmax.GT.vReadMax) THEN
2149	write(,) 'WARNING (UNread): variable ', VARname
2150	write(,) ' is out of specified bounds;'
2151	write(,) ' min is:', varmin
2152	write(,) ' max is:', varmax
2153	ENDIF
2154	ENDIF
2155
2156	IF (icheck.ge.2) WRITE(,) 'UNread : End'
2157
2158	END SUBROUTINE UNread
2159
2160	C**
2161	C** +-------------------------+-----------------------------------------+
2162	C** + Subroutine UNsread : + +
2163	C** +-------------------------+ +
2164	C** + * Reads a model variable from a NetCDF file, +
2165	C** + SIMPLIFIED VERSION of UNread : does NOT read coordinates. +
2166	C** + +
2167	C** + +
2168	C** + INPUT : +
2169	C** + FILEid : input file identifier (from NetCDF open) +
2170	C** + VARname : name of the requested variable. +
2171	C** + time : [integer*4] is the time index of the data field to read +
2172	C** + level: [integer*4] (usefull for 3D-space fields only) : +
2173	C** + if not=0 --> = no of the level +
2174	C** + -> output is 2D (l_dim = 1) +
2175	C** + if =0 --> read ALL levels +
2176	C** + -> output is 3D +
2177	C** + i_dbeg, j_dbeg : horizontal indexes of requested region +
2178	C** + in input data file +
2179	C** + i_dim, j_dim, l_dim : ...the dimensions of 'var', +
2180	C** + = the dimensions of the sub-region to read +
2181	C** + ! l_dim = 1 if level not=0 +
2182	C** + ! j_dim = 1 if var is 1D +
2183	C** + OUTPUT : +
2184	C** + var_units : physical units of var. +
2185	C** + var[i_dim,j_dim,l_dim] : +
2186	C** + data field values +
2187	C** + (var must be defined, and is REAL ) +
2188	C** + +
2189	C** +-------------------------------------------------------------------+
2190
2191	SUBROUTINE UNsread
2192	& (FILEid, VARname, time, level, i_dbeg, j_dbeg,
2193	& i_dim , j_dim , l_dim,
2194	& var_units, var)
2195
2196
2197
2198	IMPLICIT NONE
2199
2200	C ** input
2201	INTEGER FILEid
2202	INTEGER time, level, i_dbeg, j_dbeg
2203	INTEGER i_dim, j_dim, l_dim
2204	CHARACTER () VARname
2205
2206	C ** output
2207	CHARACTER () var_units
2208	REAL*4 var (i_dim, j_dim, l_dim)
2209	REAL*4 varax1(i_dim), varax2(j_dim), varlev(l_dim)
2210
2211	call UNread (FILEid , VARname , time, level, i_dbeg, j_dbeg,
2212	& i_dim , j_dim , l_dim ,
2213	& varax1 , varax2 , varlev,
2214	& var_units, var)
2215
2216
2217	END SUBROUTINE UNsread
2218
2219	C** +-------------------------+-----------------------------------------+
2220	C** + Subroutine UNwcatt : + +
2221	C** +-------------------------+ +
2222	C** + *Character Attributes creation and (over)writing +
2223	C** + (the NetCDF file must be open, in data mode) +
2224	C** + *WARNING: this routine (may?) use a temporary disk space +
2225	C** + equal to the file length (duplicate the file) +
2226	C** + +
2227	C** + INPUT : +
2228	C** + FILEid : input file identifier (from UNcreate OR NetCDF open) +
2229	C** + varnam : name of variable to which attribute shall be attached+
2230	C** + or 'GLOBAL_ATT' +
2231	C** + attnam : name of writen attribute. +
2232	C** + attval : string to be assigned to attribute. +
2233	C** + (never inclulde more than 3 consecutive blanks !) +
2234	c** + +
2235	C** + Note : all arguments except FILEid are strings of any length +
2236	C** +-------------------------------------------------------------------+
2237
2238	SUBROUTINE UNwcatt (FILEid , varnam, attnam, attval)
2239
2240	INCLUDE 'libUN.inc'
2241
2242	C **Input:
2243
2244	INTEGER FILEid
2245	CHARACTER() varnam
2246	CHARACTER() attnam
2247	CHARACTER() attval
2248
2249	C **Local:
2250	INTEGER VARSIZE
2251	EXTERNAL VARSIZE
2252	INTEGER Nlen, Ierro, varVID, Vlen, TTerr
2253	INTEGER icheck
2254	icheck= 0 !** 'debugging' level
2255
2256	IF (icheck.ge.1) WRITE(,) 'UNwcatt : Begin'
2257
2258	C* Get the variable ID
2259	C -------------------
2260
2261	IF (icheck.ge.2) WRITE(,) 'FILEid :', FILEid
2262
2263	C ** getting varnam size :
2264	Nlen = VARSIZE(varnam)
2265
2266	C ** Case of global attributes:
2267	IF (varnam(1:Nlen).EQ.'GLOBAL_ATT') THEN
2268	varVID=NF_GLOBAL
2269
2270	ELSE
2271
2272	C ** Get variable ID to which att is attached to:
2273	Ierro=NF_INQ_VARID (FILEid , varnam(1:Nlen), varVID)
2274	TTerr = ABS(Ierro)
2275
2276	C ** Cancel writing if an error occured : variable undefined ?
2277	IF (Ierro.ne.0) THEN
2278	WRITE(,) 'UNwcatt -ERROR : Variable ',varnam(1:Nlen)
2279	& ,' not found -> not written.'
2280	END IF
2281	IF (Ierro.ne.0) RETURN !** UNwcatt_end
2282
2283	ENDIF
2284
2285	C Switch to Define Mode,
2286	C because attribute may be created or change size.
2287	C --------------------------------------------------
2288	Ierro=NF_REDEF (FILEid)
2289	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNwcatt', Ierro)
2290
2291	C Set attribute.
2292	C --------------
2293
2294	C ** getting attnam [char] size :
2295	Nlen = VARSIZE(attnam)
2296	C ** getting attval [char] size :
2297	Vlen = VARSIZE(attval)
2298
2299	Ierro=NF_PUT_ATT_TEXT(FILEid ,varVID ,attnam(1:Nlen),
2300	& Vlen ,attval(1:Vlen) )
2301	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNwcatt', Ierro)
2302	c **line1^^^^ FILEid \|var.id \| attr.name
2303	C **line2 type \| len \| attr.value \| flag
2304	TTerr = TTerr + ABS(Ierro)
2305
2306
2307	C Leave define mode (!file remains open )
2308	C ---------------------------------------
2309	Ierro=NF_ENDDEF(FILEid )
2310	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNwcatt', Ierro)
2311
2312	RETURN
2313	END
2314
2315	C** +-------------------------+-----------------------------------------+
2316	C** + Subroutine UNwratt : + +
2317	C** +-------------------------+ +
2318	C** + *Real attributes writing - ! Can not create new attrib ! +
2319	C** + (the NetCDF file must be open) +
2320	C** + +
2321	C** + INPUT : +
2322	C** + FILEid : input file identifier (from UNcreate OR NetCDF open) +
2323	C** + varnam : name given to the variable to write (must be in file)+
2324	C** + attnam : name of treated attribute. +
2325	c** + Nvals : Number of values of that attribute +
2326	C** + atvalsi(Nvals) : Real vector of values for attribute. +
2327	c** + +
2328	C** +-------------------------------------------------------------------+
2329
2330	C WARNING: this routine uses a temporary disk space
2331	C equal to the file length (duplicate the file)
2332	C (its use is NOT recommended)
2333
2334	SUBROUTINE UNwratt (FILEid , varnam, attnam, Nvals, atvals)
2335
2336	INCLUDE 'libUN.inc'
2337
2338	C **Input:
2339
2340	INTEGER FILEid , Nvals
2341	CHARACTER() varnam
2342	CHARACTER() attnam
2343	REAL*4 atvals(Nvals)
2344
2345	C **Local:
2346	INTEGER VARSIZE
2347	EXTERNAL VARSIZE
2348	INTEGER Nlen, Ierro, varVID
2349	INTEGER icheck, TTerr
2350	icheck= 0 !** 'debugging' level
2351	TTerr = 0
2352
2353	IF (icheck.ge.1) WRITE(,) 'UNwratt : Begin'
2354
2355	C* Get the variable ID
2356	C -------------------
2357	IF (icheck.ge.2) WRITE(,) 'FILEid :', FILEid
2358
2359	C ** getting varnam size :
2360	Nlen = VARSIZE(varnam)
2361
2362	C ** variable ID :
2363	Ierro=NF_INQ_VARID(FILEid , varnam(1:Nlen), varVID)
2364	TTerr = TTerr + ABS(Ierro)
2365
2366	C ** Cancel writing if an error occured : variable undefined ?
2367	IF (Ierro.ne.0) THEN
2368	WRITE(,) 'UNwratt -ERROR : Variable ',varnam(1:Nlen)
2369	& ,' not found -> not written.'
2370	END IF
2371	IF (Ierro.ne.0) GOTO 9999 !** UNwratt_end
2372
2373
2374	C Set attribute.
2375	C --------------
2376
2377	C ** getting attnam [char] size :
2378	Nlen = VARSIZE(attnam)
2379
2380	Ierro=NF_PUT_ATT_REAL(FILEid ,varVID ,attnam(1:Nlen),
2381	& NF_FLOAT,nvals ,atvals )
2382	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNwratt', Ierro)
2383	c **line1^^^^FILEid \|var.id \| attr.name
2384	C **line2 type \| attr.value \| flag
2385	TTerr = TTerr + ABS(Ierro)
2386
2387
2388	9999 continue
2389	RETURN
2390	END
2391
2392	C** +-------------------------+-----------------------------------------+
2393	C** + Subroutine UNwopen : + libUN (0896) +
2394	C** +-------------------------+-----------------------------------------+
2395	C** + * Open a NetCDF file for writing. +
2396	C** + +
2397	C** + INPUT : +
2398	C** + FILEnam : file name +
2399	C** + +
2400	C** + OUTPUT : +
2401	C** + FILEid : NetCDF file identifier ('logical unit') +
2402	C** +---------------------------------------------------------------7++++
2403
2404	SUBROUTINE UNwopen (FILEnam, FILEid )
2405
2406	IMPLICIT NONE
2407	INCLUDE 'libUN.inc'
2408
2409	C ** input
2410	CHARACTER() FILEnam
2411
2412	C ** output
2413	INTEGER FILEid
2414
2415	C ** local :
2416	INTEGER Ierro
2417	INTEGER icheck
2418
2419	icheck=0
2420
2421	C + Routines which opens a file must reset libUN internals:
2422	CALL UNparam('RESET_PARAMS_',0.0)
2423
2424	C ** Open NetCDF file, for read-only:
2425	C -----------------------------------
2426	Ierro=NF_OPEN(FILEnam,NF_WRITE,FILEid)
2427	IF (Ierro.NE.NF_NOERR) THEN
2428	WRITE(,) 'Error opening file: ', FILEnam
2429	CALL HANDLE_ERR('UNwopen', Ierro)
2430	ENDIF
2431
2432
2433	9999 continue
2434	RETURN
2435	END
2436
2437
2438
2439	C** +-------------------------+-----------------------------------------+
2440	C** + Subroutine UNropen : + libUN (0896) +
2441	C** +-------------------------+-----------------------------------------+
2442	C** + * Open a NetCDF file for reading, +
2443	C** + +
2444	C** + INPUT : +
2445	C** + FILEnam : file name +
2446	C** + +
2447	C** + OUTPUT : +
2448	C** + FILEid : NetCDF file identifier ('logical unit') +
2449	C** + FILEtit : title of the NetCDF file +
2450	C** + ! [CHAR], must be defined (length > length(title) !) +
2451	C** +---------------------------------------------------------------7++++
2452
2453	SUBROUTINE UNropen (FILEnam, FILEid , FILEtit)
2454
2455	IMPLICIT NONE
2456	INCLUDE 'libUN.inc'
2457
2458	C ** input
2459	CHARACTER() FILEnam
2460
2461	C ** output
2462	INTEGER FILEid
2463	CHARACTER() FILEtit
2464
2465	C ** local :
2466	INTEGER Ierro
2467	INTEGER icheck
2468
2469	icheck=0
2470
2471	IF (icheck.ge.2) WRITE(,) 'UNropen: Begin'
2472	IF (icheck.ge.2) WRITE(,) 'FILEnam: ', FILEnam
2473
2474	C + Routines which opens a file must reset libUN internals:
2475	CALL UNparam('RESET_PARAMS_',0.0)
2476
2477	C ** Open NetCDF file, for read-only:
2478	C -----------------------------------
2479	Ierro=NF_OPEN(FILEnam,NF_NOWRITE,FILEid)
2480	IF (Ierro.NE.NF_NOERR) THEN
2481	WRITE(,) 'Error opening file: ', FILEnam
2482	CALL HANDLE_ERR('UNropen', Ierro)
2483	ENDIF
2484
2485
2486	C ** Read title attribute,
2487	C ------------------------
2488
2489	C ** Read attribute:
2490	Ierro=NF_GET_ATT_TEXT(FILEid, NF_GLOBAL, 'title',
2491	& FILEtit)
2492
2493	C ** Display message if an error occured :
2494	C ** no title or title too long ?
2495	IF (Ierro.ne.0) THEN
2496	WRITE(,) 'UNropen WARNING: no title or title too long'
2497	END IF
2498	IF (icheck.ge.2) WRITE(,) 'UNropen: End'
2499
2500	9999 continue
2501	RETURN
2502	END
2503
2504	C** +-------------------------+-----------------------------------------+
2505	C** + Subroutine UNgtime : + libUN (0896) +
2506	C** +-------------------------+-----------------------------------------+
2507	C** + * From a given value of desired 'time' coordinate, +
2508	C** + gets the coordinate index ('iteration no') + found time value +
2509	C** + +
2510	C** + INPUT : +
2511	C** + FILEid : NetCDF file identifier (from UNropen) +
2512	C** + RQtime : ReQuested time +
2513	C** + +
2514	C** + OUTPUT : +
2515	C** + RDtime : The last time for wich RDtime .le. RQtime +
2516	C** + Ftime : The next time value Following RDtime +
2517	C** + (-1 if it would be after end-of-file) +
2518	C** + it : The time index : RDtime = time(it) +
2519	C** +---------------------------------------------------------------7++++
2520
2521	SUBROUTINE UNgtime (FILEid, RQtime, RDtime, Ftime, it)
2522
2523	IMPLICIT NONE
2524	INCLUDE 'libUN.inc'
2525
2526	INTEGER Lvnam
2527	PARAMETER (Lvnam=20)
2528
2529	C ** input
2530	INTEGER FILEid
2531	REAL*4 RQtime
2532
2533	C ** output
2534	REAL*4 RDtime, Ftime
2535	INTEGER it
2536
2537	C ** local :
2538	INTEGER Ierro, timVID
2539	INTEGER timDID
2540	REAL*4 gtim
2541	INTEGER K, KHI, KLO, Kmax
2542	INTEGER Mindex(1)
2543	INTEGER icheck
2544	CHARACTER*(Lvnam) dimNAM(1)
2545
2546	icheck= 0
2547
2548	C ** Kmax= nb pas de temps dans le fichier, = dim(time):
2549	C ** - - - - - - - - - - - - - - - - - - - - - - - - - -
2550	C
2551	Ierro=NF_INQ_DIMID(FILEid, 'time', timDID)
2552	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNgtime', Ierro)
2553	C **^^ Dimension'time' NetCDF index
2554
2555	Ierro=NF_INQ_DIM(FILEid, timDID , dimNAM, Kmax )
2556	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNgtime', Ierro)
2557	C ** id/file id/dim dimname dimsize error
2558	C ** !output output
2559
2560	C ** Read/Search the requested time step.
2561	C ** - - - - - - - - - - - - - - - - - - -
2562
2563	Ierro=NF_INQ_VARID(FILEid, 'time',timVID)
2564	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNgtime', Ierro)
2565	C **^^ Variable 'time' NetCDF index
2566
2567	KLO=1
2568	KHI=Kmax
2569
2570	1 IF (KHI-KLO.GT.1) THEN
2571	K=(KHI+KLO)/2
2572
2573	C ** Set the position of the needed time step:
2574	Mindex(1)= K
2575	C ** Get 1 time value (gtim = time(K)):
2576	Ierro=NF_GET_VAR1_REAL(FILEid, timVID, Mindex, gtim)
2577	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNgtime', Ierro)
2578
2579	IF(gtim.GT.RQtime)THEN
2580	KHI=K
2581	ELSE
2582	KLO=K
2583	ENDIF
2584	GOTO 1
2585	ENDIF
2586	it= KLO
2587	C ** read RDtime= time(KLO)
2588	Mindex(1)= KLO
2589	Ierro=NF_GET_VAR1_REAL(FILEid, timVID, Mindex, RDtime)
2590	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNgtime', Ierro)
2591	C ** read Ftime= time(KHI)
2592	Mindex(1)= KHI
2593	Ierro=NF_GET_VAR1_REAL(FILEid, timVID, Mindex, Ftime)
2594	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNgtime', Ierro)
2595
2596	C ** IF the last available time step is before
2597	C ** the requested time, then KHI and KLO are the
2598	C ** two last available time step. Correct this :
2599	IF (RQtime.ge.Ftime) THEN
2600	RDtime= Ftime
2601	it = KHI
2602	Ftime= -1.0
2603	ENDIF
2604
2605	RETURN
2606	END
2607
2608	C** +-------------------------+-----------------------------------------+
2609	C** + Subroutine UNgindx : + libUN (0199) +
2610	C** +-------------------------+-----------------------------------------+
2611	C** + * From a given value of a desired coordinate, +
2612	C** + gets the coordinate index + found the coresp. coordinate value +
2613	C** + +
2614	C** + INPUT : +
2615	C** + FILEid : NetCDF file identifier (from UNropen) +
2616	C** + Cname : The name of the coordinate +
2617	C** + RQval : The requested value for that coordinate +
2618	C** + +
2619	C** + OUTPUT : +
2620	C** + RDval : The last value for wich RDval .le. RQval +
2621	C** + Fval : The next val value Following RDval +
2622	C** + (-1 if it would be after end-of-file) +
2623	C** + indx : The val index : RDval = value_of_Cname(it) +
2624	C** +---------------------------------------------------------------7++++
2625
2626	SUBROUTINE UNgindx (FILEid, Cname, RQval, RDval, Fval, indx)
2627
2628	IMPLICIT NONE
2629	INCLUDE 'libUN.inc'
2630
2631	INTEGER Lvnam
2632	PARAMETER (Lvnam=20)
2633
2634	C ** input
2635	INTEGER FILEid
2636	CHARACTER () Cname
2637	REAL*4 RQval
2638
2639	C ** output
2640	REAL*4 RDval, Fval
2641	INTEGER indx
2642
2643	C ** local :
2644	INTEGER VARSIZE
2645	EXTERNAL VARSIZE
2646	REAL*4 gval
2647	INTEGER Ierro
2648	INTEGER varDID, VNlen, varVID, varNUMDIM
2649	INTEGER Nvatts, vtype
2650	INTEGER K, KHI, KLO, Kmax
2651	INTEGER Mindex(1), dimID(4)
2652	INTEGER icheck
2653	CHARACTER*(Lvnam) dimNAM(4)
2654	CHARACTER*13 recname
2655
2656	icheck= 0
2657
2658	C ** Kmax= nb pas de temps dans le fichier, = dim(val):
2659	C ** - - - - - - - - - - - - - - - - - - - - - - - - - -
2660	C ** get Cname string size :
2661	VNlen = VARSIZE (Cname)
2662	C
2663	C ** get variable ID :
2664	Ierro=NF_INQ_VARID(FILEid , Cname (1:VNlen), varVID)
2665	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNgindex', Ierro)
2666	C
2667	C ** Inquire about the id of the dimension:
2668	C **
2669	Ierro=NF_INQ_VAR(FILEid , varVID, recname, vtype,
2670	& varNUMDIM, dimID , Nvatts)
2671	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNgindex', Ierro)
2672	C ** line1 id/file id/var var name var type
2673	C ** line2 # dims id/dims #attributes
2674	varDID = dimID(1)
2675	C ^^^At last, the id of the relevant dimension.
2676
2677	Ierro=NF_INQ_DIM(FILEid, varDID , dimNAM, Kmax )
2678	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNgindex', Ierro)
2679	C ** id/file id/dim dimname dimsize error
2680	C ** !output output
2681	C ** (Kmax is what we needed: size of the dimension)
2682
2683	C ** Read/Search the requested val step.
2684	C ** - - - - - - - - - - - - - - - - - - -
2685
2686	KLO=1
2687	KHI=Kmax
2688
2689	1 IF (KHI-KLO.GT.1) THEN
2690	K=(KHI+KLO)/2
2691
2692	C ** Set the position of the needed val step:
2693	Mindex(1)= K
2694	C ** Get 1 val value (gval = val(K)):
2695	Ierro=NF_GET_VAR1_REAL(FILEid, varVID, Mindex, gval)
2696	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNgindex', Ierro)
2697
2698	IF(gval.GT.RQval)THEN
2699	KHI=K
2700	ELSE
2701	KLO=K
2702	ENDIF
2703	GOTO 1
2704	ENDIF
2705	indx= KLO
2706	C ** read RDval= val(KLO)
2707	Mindex(1)= KLO
2708	Ierro=NF_GET_VAR1_REAL(FILEid, varVID, Mindex, RDval)
2709	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNgindex', Ierro)
2710	C ** read Fval= val(KHI)
2711	Mindex(1)= KHI
2712	Ierro=NF_GET_VAR1_REAL(FILEid, varVID, Mindex, Fval)
2713	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNgindex', Ierro)
2714
2715	C ** IF the last available val step is before
2716	C ** the requested val, then KHI and KLO are the
2717	C ** two last available val step. Correct this :
2718	IF (RQval.ge.Fval) THEN
2719	RDval= Fval
2720	indx = KHI
2721	Fval= -1.0
2722	ENDIF
2723
2724	RETURN
2725	END
2726
2727	C** +-------------------------+-----------------------------------------+
2728	C** + Subroutine UNfindx : + (libUN 2003)+
2729	C** +-------------------------+-----------------------------------------+
2730	C** + * Intended to replace UNgindx or UNgtime +
2731	C** + From a given value of a desired coordinate, +
2732	C** + gets the coordinate index + the coresp. coordinate value +
2733	C** + This version solves the issue of Dates at year change +
2734	C** + occuring because 1 jan is < 31 dec. Not optimised. +
2735	C** + +
2736	C** + INPUT : +
2737	C** + FILEid : NetCDF file identifier (from UNropen) +
2738	C** + Cname : The name of the coordinate +
2739	C** + RQval : The requested value for that coordinate +
2740	C** + +
2741	C** + OUTPUT : +
2742	C** + RDval : The file value closest to RQval +
2743	C** + Fval : The next value in the file +
2744	C** + (-1 if after file end) +
2745	C** + (This is mainly for compatibility with older version)+
2746	C** + indx : The val index : RDval = value_of_Cname(it) +
2747	C** + (-1 may be returned if the value can't be found) +
2748	C** +---------------------------------------------------------------7++++
2749
2750	SUBROUTINE UNfindx (FILEid, Cname, RQval, RDval, Fval, indx)
2751
2752	IMPLICIT NONE
2753	INCLUDE 'libUN.inc'
2754
2755	INTEGER Lvnam
2756	PARAMETER (Lvnam=20)
2757
2758	C ** input
2759	INTEGER FILEid
2760	CHARACTER () Cname
2761	REAL*4 RQval
2762
2763	C ** output
2764	REAL*4 RDval, Fval
2765	INTEGER indx
2766
2767	C ** local :
2768	INTEGER VARSIZE
2769	EXTERNAL VARSIZE
2770	REAL*4 gval, bmatch, gdist
2771	INTEGER Ierro
2772	INTEGER varDID, VNlen, varVID, varNUMDIM
2773	INTEGER Nvatts, vtype
2774	INTEGER K, KHI, KLO, Kmax
2775	INTEGER Mindex(1), dimID(4)
2776	INTEGER icheck
2777	CHARACTER*(Lvnam) dimNAM(4)
2778	CHARACTER*13 recname
2779
2780	icheck= 0
2781
2782	C ** Kmax= nb pas de temps dans le fichier, = dim(val):
2783	C ** - - - - - - - - - - - - - - - - - - - - - - - - - -
2784	C ** get Cname string size :
2785	VNlen = VARSIZE (Cname)
2786	C
2787	C ** get variable ID :
2788	Ierro=NF_INQ_VARID(FILEid , Cname (1:VNlen), varVID)
2789	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNfindex', Ierro)
2790	C
2791	C ** Inquire about the id of the dimension:
2792	C **
2793	Ierro=NF_INQ_VAR(FILEid , varVID, recname, vtype,
2794	& varNUMDIM, dimID , Nvatts)
2795	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNfindex', Ierro)
2796	C ** line1 id/file id/var var name var type
2797	C ** line2 # dims id/dims #attributes
2798	varDID = dimID(1)
2799	C ^^^At last, the id of the relevant dimension.
2800
2801	Ierro=NF_INQ_DIM(FILEid, varDID , dimNAM, Kmax )
2802	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNfindex', Ierro)
2803	C ** id/file id/dim dimname dimsize error
2804	C ** !output output
2805	C ** (Kmax is what we needed: size of the dimension)
2806
2807	C ** Read/Search the requested val step.
2808	C ** - - - - - - - - - - - - - - - - - - -
2809
2810	C This is a workaround, not optimised as stated above.
2811	C We simply look at all values sequencially.
2812	C
2813	bmatch=1.E10
2814	KLO=-1
2815
2816	DO K=1,KMAX
2817
2818	C ** Get 1 val value (gval = val(K)):
2819	Mindex(1)= K
2820	Ierro=NF_GET_VAR1_REAL(FILEid, varVID, Mindex, gval)
2821	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNfindex', Ierro)
2822
2823	gdist=ABS(gval-RQval)
2824	IF (gdist.LT.bmatch) THEN
2825
2826	bmatch=gdist
2827	KLO=K
2828
2829	ENDIF
2830
2831	ENDDO
2832
2833	indx= KLO
2834
2835	KHI = min((KLO+1),KMAX)
2836
2837	C ** read values...
2838
2839	Mindex(1)= KLO
2840	Ierro=NF_GET_VAR1_REAL(FILEid, varVID, Mindex, RDval)
2841	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNfindex', Ierro)
2842	C ** read Fval= val(KHI)
2843	Mindex(1)= KHI
2844	Ierro=NF_GET_VAR1_REAL(FILEid, varVID, Mindex, Fval)
2845	IF (Ierro.NE.NF_NOERR) CALL HANDLE_ERR('UNfindex', Ierro)
2846
2847	IF (KHI.EQ.KLO) THEN
2848	Fval= -1.0
2849	ENDIF
2850
2851	IF (bmatch.GT.1.E9) THEN
2852	Fval= -1.0
2853	indx= -1
2854	ENDIF
2855
2856	RETURN
2857	END
2858
2859	C** +-------------------------+-----------------------------------------+
2860	C** + Subroutine UNclose : + libUN (0300) +
2861	C** +-------------------------+-----------------------------------------+
2862	C** + * Close the desired file +
2863	C** + Created to suppress the need the directly call a netcdf +
2864	C** + routine from a program +
2865	C** + +
2866	C** + INPUT : +
2867	C** + FILEid : NetCDF file identifier (from UNropen) +
2868	C** +---------------------------------------------------------------7++++
2869
2870	SUBROUTINE UNCLOSE(FILEid)
2871
2872	IMPLICIT NONE
2873	INCLUDE 'libUN.inc'
2874
2875	integer Ierro, FILEid
2876
2877	Ierro=NF_CLOSE(FILEid)
2878	IF (Ierro.NE.NF_NOERR) THEN
2879	CALL HANDLE_ERR('UNclose', Ierro)
2880	ENDIF
2881
2882	END
2883
2884	C** +-------------------------+-----------------------------------------+
2885	C** + Subroutine UNparam : + libUN (0202) +
2886	C** +-------------------------+-----------------------------------------+
2887	C** + Changes some global libUN parameters +
2888	C** + NB: default values are set at first libUN call +
2889	C** + +
2890	C** + +
2891	C** + INPUT : pname name of the parameters to set +
2892	C** + pvalue the requested new value +
2893	C** + +
2894	C** +---------------------------------------------------------------7++++
2895
2896	SUBROUTINE UNparam(pname,pvalue)
2897
2898	IMPLICIT NONE
2899
2900	INCLUDE 'libUN.inc'
2901
2902	CHARACTER() pname
2903	REAL*4 pvalue
2904
2905	LOGICAL Lstart
2906	SAVE Lstart
2907	DATA Lstart /.true./
2908
2909	IF (pname.EQ.'RESET_PARAMS_') THEN
2910	IF (Lstart.OR.pvalue.GT.0.5) THEN
2911	vMissVal= 1.0E21 ! for missing values
2912	VarRepl = vMissVal ! for missing VARIABLES
2913	ValRange(1)= -vMissVal/10.
2914	ValRange(2)= vMissVal/10.
2915	iVarWarn= 2
2916	vReadMin = 0.0
2917	vReadMax = 0.0
2918	ireadchk = 0
2919	Lstart = .false.
2920	ENDIF
2921
2922	ELSE IF (pname.EQ.'NOVAR_REPLACE') THEN
2923	VarRepl = pvalue
2924
2925	ELSE IF (pname.EQ.'NOVAR_WARNING') THEN
2926	iVarWarn= NINT(pvalue)
2927
2928	ELSE IF (pname.EQ.'VALID_RANGE_MIN') THEN
2929	ValRange(1) = pvalue
2930
2931	ELSE IF (pname.EQ.'VALID_RANGE_MAX') THEN
2932	ValRange(2) = pvalue
2933
2934	ELSE IF (pname.EQ.'READOVER_WARN') THEN
2935	vReadMin = - pvalue
2936	vReadMax = pvalue
2937	ireadchk = 1
2938
2939	ELSE IF (pname.EQ.'READ_MIN_WARN') THEN
2940	vReadMin = pvalue
2941	ireadchk = 1
2942
2943	ELSE IF (pname.EQ.'READ_MAX_WARN') THEN
2944	vReadMax = pvalue
2945	ireadchk = 1
2946
2947	ELSE
2948	write(,) 'UNparam (libUN) Error: '
2949	write(,) ' parameter undefined:', pname
2950
2951	ENDIF
2952
2953	END
2954
2955	C** +-------------------------+-----------------------------------------+
2956	SUBROUTINE UNversion(UNver,NCDFver)
2957	C** +-------------------------+-----------------------------------------+
2958
2959	IMPLICIT NONE
2960	INCLUDE 'libUN.inc'
2961
2962	CHARACTER*80 UNver,NCDFver
2963
2964	UNver = '2005.03.31'
2965	NCDFver= NF_INQ_LIBVERS()
2966
2967	END
2968
2969	C** +-------------------------------------------------------------------+
2970	FUNCTION VARSIZE(CHAvar)
2971	C** +-------------------------------------------------------------------+
2972	IMPLICIT NONE
2973	integer maxcha,iz,VARSIZE
2974	parameter (maxcha=512)
2975	character() CHAvar
2976	character*(maxcha) CHAtmp
2977
2978	WRITE(CHAtmp,'(A)') CHAvar
2979	iz = 0
2980	do while ((CHAtmp(iz+1:iz+3).ne.' ').and.(iz+3.le.maxcha))
2981	iz = iz + 1
2982	end do
2983	VARSIZE = iz
2984
2985	RETURN
2986	END
2987
2988
2989	C** +-------------------------------------------------------------------+
2990	SUBROUTINE HANDLE_ERR(LOCATION, STATUS)
2991	C** +-------------------------------------------------------------------+
2992	IMPLICIT NONE
2993
2994	INCLUDE 'libUN.inc'
2995
2996	character() LOCATION
2997	integer STATUS
2998	IF (STATUS.NE.NF_NOERR) THEN
2999	WRITE(,) 'IN ROUTINE ', LOCATION
3000	WRITE(,) NF_STRERROR(STATUS)
3001	STOP 'Stopped'
3002	ENDIF
3003	END
3004
3005	C UN library: history of fixed bugs and updates.
3006	C ----------------------------------------------
3007	C
3008	C 961206 - UNgtime, trouble at end-of-file
3009	C 961218 - - all -, display 'artificial' errors
3010	C 970318 - again, display 'artificial' errors
3011	C 971028 - (3 sub),'syntax'error on Cray computer
3012	C 971105 - Allowed variable "imap(1)", =8 for Cray
3013	C 980705 - "single element" extension to UNwrite.
3014	C 980709 - bug fixes (start) in UNwrite & UNlwrite
3015	C ("DATA" statement incorrectly used).
3016	C 980825 - Changed default "stride" to 1 for v3.x
3017	C 981222 - bug fix: allow UNwrite for unlim dims.
3018	C note that this should be tested.
3019	C 990110 - Added "UNgindx" = general. of UNgtime
3020	C - Removed all "DATA" and all "//" in write
3021	C (the later should improve compatibility)
3022	C 990128 - UNwrite: added a "no warning" option.
3023	C 990323 - UNwrite: added 1D+time capability.
3024	C 990807 - UNwrite: added 3D-notime capability.
3025	C -----------------------------------------------------------------------
3026	C 000404 - Major upgrade: compatibility with
3027	C NetCDF v3.4
3028	C - NOTE: Types other than REAL may be
3029	C accepted in UNread, but not tested
3030	C -----------------------------------------------------------------------
3031	C 000614 - Bug fixes: uninitialised error count
3032	C in UNwcatt, bug in UNclose.
3033	C 000620 - Bug fix: UNropen (args. of get title fn)
3034	C 000713 - Bug fix: UNgtime (missing arg in a call)
3035	C (last tree caused by 000404 upgrade)
3036	C -----------------------------------------------------------------------
3037	C 000928 - UNlwrite: added 2D+time capability.
3038	C 001008 - All: CHARACTER() declaration for units
3039	C and longer strings for intern. variables
3040	C 010417 - UNread: added var not found info
3041	C UNropen: added file not found info
3042	C 010715 - UNwrite + UNlwrite:
3043	C fixed bug / unlimited time dim
3044	C 0107xx - UNwrite:
3045	C missing values -> not in "range"
3046	C 020130 - All:
3047	C .removed obsolete warnings about
3048	C double precision in files.
3049	C .added a version (libUN_dbl) with
3050	C REAL*8 as arguments - but still
3051	C creates REAL*4 in files.
3052	C 020526 - Added UNparam function,
3053	C which provide optional features such
3054	C as missing variable behavior control
3055	C 020808 - Very simple fix for underflows while
3056	C reading some files; must use -fpe1
3057	C Fixed a bug -> out of range msg
3058	C 030121 - Enabled some non-standard NetCDF files
3059	C (missing units...) -> new warnings
3060	C rather then program stop.
3061	C 030215 - Added UNfindx for non-monotonic data
3062	C 030215 - Removed warning related to UNLIM dims
3063	C 030311 - Added VALID_RANGE attribute (option)
3064	C (if set, the range is accounted for
3065	C in the min/max set while writing vars)
3066	C 040902 - Improvements to "valid_range" attribute
3067	C - Added attribute "positive=down"
3068	C if units are sigma or sigma_level
3069	C 050331 - Added "user friendly" interfaces

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

Context Navigation

source: branches/2017/dev_v3.20_2017_transport_max/SOURCES/source_3.20/libUN.f

Download in other formats: