1 /***************************************************************************
2                           ncdf_cl.cpp  -  NetCDF GDL library function
3                              -------------------
4     begin                : March 24 2004
5     copyright            : (C) 2004 by Christopher Lee
6     email                : leec_gdl@publius.co.uk
7 ***************************************************************************/
8 
9 /***************************************************************************
10  *                                                                         *
11  *   This program is free software; you can redistribute it and/or modify  *
12  *   it under the terms of the GNU General Public License as published by  *
13  *   the Free Software Foundation; either version 2 of the License, or     *
14  *   (at your option) any later version.                                   *
15  *                                                                         *
16  ***************************************************************************/
17 #ifdef HAVE_CONFIG_H
18 #include <config.h>
19 #else
20 // default: assume we have netCDF
21 #define USE_NETCDF 1
22 #endif
23 
24 #ifdef USE_NETCDF
25 
26 #include "includefirst.hpp"
27 
28 #include <string>
29 #include <fstream>
30 #include <iostream>
31 
32 #include "datatypes.hpp"
33 #include "envt.hpp"
34 #include "dpro.hpp"
35 #include "dinterpreter.hpp"
36 
37 #include "ncdf_cl.hpp"
38 
39 #define GDL_DEBUG
40 //#undef GDL_DEBUG
41 
42 namespace lib {
43 
44   using namespace std;
45   using namespace antlr;
46   bool ncdf_verbose=true;
47 
48 
ncdf_gdl_typename(nc_type vartype)49   DStringGDL ncdf_gdl_typename(nc_type vartype)
50   {
51     switch (vartype)
52       {
53       case NC_BYTE:  return DStringGDL("BYTE");//8 bit
54       case NC_CHAR:  return DStringGDL("CHAR");//8 bit as string
55       case NC_SHORT: return DStringGDL("INT");//16 bit
56       case NC_INT:   return DStringGDL("LONG");//32 bit
57       case NC_FLOAT: return DStringGDL("FLOAT");//32 bit float
58       case NC_DOUBLE:return DStringGDL("DOUBLE");//64 bit double
59       }
60     return DStringGDL("UNKNOWN");
61   }
62 
ncdf_handle_error(EnvT * e,int status,const char * function)63   void ncdf_handle_error(EnvT *e, int status, const char *function)
64   {
65     // function is no more used ... can we used it for extra informational purpose ??
66     // cout << function << endl;
67 
68     if(status != NC_NOERR)
69       {
70 	string error;
71 	//error=function;
72 	//error+=": ";
73 	DString s;
74 
75 	if(status==NC_EBADID)	/* Not a netcdf id */
76 	  {
77             DLong id;
78             e->AssureLongScalarPar( 0, id);
79 	    error += i2s(id);
80 	    error += " is not a valid cdfid. ";
81 	    error+="(NC_ERROR=-33)";
82 	  }
83 	else if(status==NC_ENFILE)	/* Too many netcdfs open */
84 	  {
85 	    error+="Too many NetCDF files open. (NC_ERROR=-34)";
86 	  }
87 	else if(status==NC_EEXIST) 	/* netcdf file exists && NC_NOCLOBBER */
88 	  {
89 	    e->AssureScalarPar<DStringGDL>(0, s);
90 	    error+="Unable to create the file \""  + s + "\". ";
91 	    error+="(NC_ERROR=-35)";
92 	  }
93 	else if(status==NC_EINVAL) 	/* Invalid Argument */
94 	  {
95 	    error+="(NC_ERROR=-36)";
96 	  }
97 	else if(status==NC_EPERM) 	/* Write to read only */
98 	  {
99 	    error+="Write permission not enabled. ";
100 	    error+="(NC_ERROR=-37)";
101 	  }
102       	else if(status==NC_ENOTINDEFINE) /* Operation not allowed in data mode */
103 	  {
104 	    error+=" Unable to define variable, not in define mode. ";
105 	    error+="(NC_ERROR=-38)";
106 	  }
107 	else if(status== NC_EINDEFINE) 	/* Operation not allowed in define mode */
108 	  {
109 	    error+=" Cannot acces data in DEFINE mode. ";
110 	    error+="(NC_ERROR=-39)";
111 	  }
112 	else if(status==NC_EINVALCOORDS) /* Index exceeds dimension bound */
113 	  {
114 	    //this error should never be triggered
115 	    error+="GDL INTERNAL ERROR, PLEASE REPORT TO CODE MAINTAINER ";
116 	    error+="(NC_ERROR=-40)";
117 	  }
118 	else if(status==NC_EMAXDIMS) 	/* NC_MAX_DIMS exceeded */
119 	  {
120 	    error+="Unable to define variable, maximum number of attributes exceeded. ";
121 	    error+="(NC_ERROR=-41)";
122 	  }
123 	else if(status==NC_ENAMEINUSE) 	/* String match to name in use */
124 	  {
125 	    error+="(NC_ERROR=-42)";
126 	  }
127       	else if(status==NC_ENOTATT) /* Attribute not found */
128 	  {
129 	    error+="Attribute enquiry failed. ";
130 	    error+="(NC_ERROR=-43)";
131 	  }
132 	else if(status==NC_EMAXATTS) 	/* NC_MAX_ATTRS exceeded */
133 	  {
134 	    error+="Attribute write failed, maximum number of attributes exceeded. ";
135 	    error+="(NC_ERROR=-44)";
136 	  }
137       	else if(status==NC_EBADTYPE) 	/* Not a netcdf data type */
138 	  {
139 	    error+="(NC_ERROR=-45)";
140 	  }
141 	else if(status==NC_EBADDIM)  	/* Invalid dimension id or name */
142 	  {
143 	    size_t nParam=e->NParam();
144 
145 	    if(nParam >= 3)
146 	      {
147 		BaseGDL* v=e->GetParDefined(2);
148 		DIntGDL* dim_in=static_cast<DIntGDL*>(v->Convert2(GDL_INT, BaseGDL::COPY));
149 		Guard<DIntGDL> dim_in_guard( dim_in);
150 		int var_ndims=dim_in->N_Elements();
151 		if(var_ndims > NC_MAX_VAR_DIMS)
152 		  e->Throw("NCDF internal error in error handler (too many dimension IDs).");
153 		error += "No Dimension with ID = ";
154 		for (int i=0; i<var_ndims;++i)
155 		  error += i2s((*dim_in)[i]) + " ";
156 		error += "found. ";
157 	      }
158 	    else
159 	      {
160 		DLong id;
161 		e->AssureLongScalarPar( 0, id);
162 
163 		error += "Invalid dimension or name.  ID = ";
164 
165 		error += i2s(id) + " ";
166 	      }
167 	    error+="(NC_ERROR=-46)";
168 	  }
169 	else if(status==NC_EUNLIMPOS) 	/* NC_UNLIMITED in the wrong index */
170 	  {
171 	    error+="(NC_ERROR=-47)";
172 	  }
173       	else if(status==NC_EMAXVARS) 	/* NC_MAX_VARS exceeded */
174 	  {
175 	    error+="Unable to define variable, maximum number of attributes exceeded. ";
176 	    error+="(NC_ERROR=-48)";
177 	  }
178 	else if(status==NC_ENOTVAR) 	/* Variable not found */
179 	  {
180 	    error += "Variable enquiry failed, ";
181             if (e->GetPar(1)->Type() == GDL_STRING)
182 	      {
183 		DString id;
184 		e->AssureStringScalarPar( 1, id);
185 		error += "\"" + id + "\"";
186 	      }
187             else
188 	      {
189 		DLong id;
190 		e->AssureLongScalarPar( 1, id);
191 		error += i2s(id);
192 	      }
193 	    error += " is not a valid variable id. ";
194 	    error += "(NC_ERROR=-49)";
195 	  }
196       	else if(status==NC_EGLOBAL) 	/* Action prohibited on NC_GLOBAL varid */
197 	  {
198 	    error+="(NC_ERROR=-50)";
199 	  }
200 	else if(status==NC_ENOTNC)  	/* Not a netcdf file */
201 	  {
202 	    e->AssureScalarPar<DStringGDL>(0, s);
203 	    error+="Unable to open the file \""+s+ "\". ";
204 	    error+="(NC_ERROR=-51)";
205 	  }
206 	else if(status==NC_ESTS)  	/* In Fortran, string too short */
207 	  {
208 	    error+="(NC_ERROR=-52)";
209 	  }
210       	else if(status==NC_EMAXNAME)  	/* NC_MAX_NAME exceeded */
211 	  {
212 	    error+="(NC_ERROR=-53)";
213 	  }
214 	else if(status==NC_EUNLIMIT)  	/* NC_UNLIMITED size already in use */
215 	  {
216 	    error+="Unable to create dimension, NC_UNLIMITED dimension alread in use. ";
217 
218 	    error+="(NC_ERROR=-54)";
219 	  }
220 	else if(status==NC_ENORECVARS) 	/* nc_rec op when there are no record vars */
221 	  {
222 	    error+="(NC_ERROR=-55)";
223 	  }
224 	else if(status==NC_ECHAR)   	/* Attempt to convert between text & numbers */
225 	  {
226 	    error+="(NC_ERROR=-56)";
227 	  }
228 	else if(status==NC_EEDGE)   	/* Edge+start exceeds dimension bound */
229 	  {
230 	    error+="Dimension bound exceeded. ";
231 	    error+="(NC_ERROR=-57)";
232 	  }
233 	else if(status==NC_ESTRIDE) 	/* Illegal stride */
234 	  {
235 	    error+="(NC_ERROR=-58)";
236 	  }
237 	else if(status==NC_EBADNAME)	/* Attribute or variable name
238 					   contains illegal characters */
239 	  {
240 	    error+="(NC_ERROR=-59)";
241 	  }
242 	else if(status==NC_ERANGE)  	/* Math result not representable */
243 	  {
244 	    error+="(NC_ERROR=-60)";
245 	  }
246 	else if(status==NC_ENOMEM)	/* Memory allocation (malloc) failure */
247 	  {
248 	    error+="(NC_ERROR=-61)";
249 	  }
250 	else if(status==2)
251 	  {
252 	    e->AssureScalarPar<DStringGDL>(0, s);
253 	    error+="Unable to open the file \""+s+ "\". (NC_ERROR = 2)";
254 	  }
255 	else
256 	  {
257 	    /*unknown error*/
258 	    error+=nc_strerror(status);
259 	    error+=" (NC_ERROR="+i2s(status)+")";
260 	  }
261 
262 	e->Throw(error);
263 
264       }
265 
266   }
267 
268   // a way to test status of local file
is_readable(const std::string & file)269   bool is_readable( const std::string & file )
270   {
271     std::ifstream fichier( file.c_str() );
272     return !fichier.fail();
273   }
274 
275   //open the ncdf file of given filename OR an URL+filename
ncdf_open(EnvT * e)276   BaseGDL * ncdf_open(EnvT * e)
277   {
278     size_t nParam=e->NParam(1);
279     if(nParam != 1) e->Throw("Wrong number of arguments.");
280 
281     DString s;
282     e->AssureScalarPar<DStringGDL>(0, s);
283     WordExp(s);
284 
285     int cdfid,status;
286 
287     if(e->KeywordSet(0) //"WRITE"
288       &&!e->KeywordSet(1)) //NOWRITE
289       {
290 	status=nc_open(s.c_str(), NC_WRITE, &cdfid);
291       }
292     else
293       {
294 	status=nc_open(s.c_str(), NC_NOWRITE, &cdfid);
295       }
296 
297     bool debug=FALSE;
298     if (debug) {
299       cout << "NCDF_OPEN: filename (or url) : " << s << endl;
300       cout << "NCDF_OPEN: status : " << status << endl;
301     }
302 
303     // we try to add few extra informations to help to understand why the
304     // file or link was not opened
305 
306     if (status != 0) {
307 
308       if ((status == -31) | (status == 2))
309 	{
310 	  // before any NetCDF stuff, we check whether the file exists ...
311 	  if (!is_readable(s))
312 	    {
313 	      Warning("NCDF_OPEN: file not found or not readable");
314 	      e->Throw("Unable to open the file \""+s+"\". (NC_ERROR="+i2s(status)+")");
315 	    }
316 	}
317 
318       if (status == -51)
319 	{
320 	  Warning("NCDF_OPEN: file exists but not in NetCDF format(s)");
321 #ifndef USE_NETCDF4
322 	  Warning("NCDF_OPEN: GDL was compiled without support to new NetCDF-4 format(s)");
323 #endif
324 	  e->Throw("Unable to open the file \""+s+"\". (NC_ERROR=-51)");
325 	}
326 
327       ncdf_handle_error(e,status,"NCDF_OPEN");
328     }
329     return new DLongGDL(cdfid);
330   }
331 
332   //close the NetCDF file
ncdf_close(EnvT * e)333   void ncdf_close(EnvT* e)
334   {
335     size_t nParam=e->NParam(1);
336     DLong cdfid;
337     e->AssureLongScalarPar( 0, cdfid);
338     int status = nc_close(cdfid);
339     ncdf_handle_error(e, status, "NCDF_CLOSE");
340   }
341 
342 
343   //ncdf inquire, returns the struct {NDIMS: 0L,NVARS:0L,NGATTS:0L, RECDIM:0L}
ncdf_inquire(EnvT * e)344   BaseGDL* ncdf_inquire(EnvT* e)
345   {
346     size_t nParam=e->NParam(1);
347 
348     int status, ndims,nvars,ngatts,unlimdimid;
349 
350     DLong cdfid;
351     e->AssureLongScalarPar( 0, cdfid);
352 
353     status = nc_inq(cdfid, &ndims, &nvars, &ngatts, &unlimdimid);
354 
355     ncdf_handle_error(e,status,"NCDF_INQUIRE");
356 
357     DStructDesc* ncdf_inq=new DStructDesc( "NCDF_INQ");
358     SpDLong aLong;
359     ncdf_inq->AddTag("NDIMS", &aLong);
360     ncdf_inq->AddTag("NVARS", &aLong);
361     ncdf_inq->AddTag("NGATTS",  &aLong);
362     ncdf_inq->AddTag("RECDIM",  &aLong);
363 
364     structList.push_back(ncdf_inq);
365 
366     DStructGDL* inq=new DStructGDL( "NCDF_INQ");
367     inq->InitTag("NDIMS",DLongGDL(ndims));
368     inq->InitTag("NVARS",DLongGDL(nvars));
369     inq->InitTag("NGATTS",DLongGDL(ngatts));
370     inq->InitTag("RECDIM",DLongGDL(unlimdimid));
371 
372     return inq;
373 
374   }
375 
376 
377   //Create the ncdf file of given filename
ncdf_create(EnvT * e)378   BaseGDL * ncdf_create(EnvT * e)
379   {
380     size_t nParam=e->NParam(1);
381 
382     DString s;
383     e->AssureScalarPar<DStringGDL>(0, s);
384 
385     int format;
386     format = NC_FORMAT_CLASSIC;
387 
388     enum { CLOBBER, NOCLOBBER,NETCDF3_64BIT,NETCDF4_FORMAT };
389 
390     if (e->KeywordSet(NETCDF3_64BIT))
391       {
392 	Warning("keyword NETCDF3_64BIT not ready.");
393 	format= NC_FORMAT_64BIT;
394       }
395     if (e->KeywordSet(NETCDF4_FORMAT))
396       {
397 #ifndef USE_NETCDF4
398 	e->Throw("GDL was compiled without support to new NetCDF-4 format(s)");
399 #endif
400 	Warning("keyword NETCDF4_FORMAT experimental.");
401 	format=NC_FORMAT_NETCDF4;
402       }
403 
404     int cdfid,status;
405 
406     status=nc_set_default_format(format, NULL);
407 
408     if(e->KeywordSet(CLOBBER) &&!e->KeywordSet(NOCLOBBER))
409       {
410 	status=nc_create(s.c_str(),
411 			 NC_CLOBBER,
412 			 &cdfid);
413       } else {
414       status=nc_create(s.c_str(),
415 		       NC_NOCLOBBER,
416 		       &cdfid);
417 
418       if (status == -35) {
419 	Warning("NCDF_CREATE: the file already exists, use /CLOBBER to (try to) overwrite !");
420       }
421     }
422 
423     ncdf_handle_error(e,status,"NCDF_CREATE");
424 
425     return new DLongGDL(cdfid);
426   }
427 
ncdf_control(EnvT * e)428   void ncdf_control(EnvT* e)
429   {
430     /*keywords
431       0   ABORT = restores or deletes file
432       1   ENDEF = ends define mode, starts data mode
433       2   FILL = fills the netcdf file with certain values
434       3   NOFILL = opposite of FILL
435       4   VERBOSE = verbose error messages, hmm
436       5   NOVERBOSE = opposite of verbose
437       6   OLDFILL=variable ->result of last fill
438       7   REDEF = puts file into define mode
439       8   SYNC = update the file on disk
440     */
441     size_t nParam=e->NParam(1);
442     int status,omode;
443 
444     DLong cdfid;
445     e->AssureLongScalarPar( 0, cdfid);
446 
447     int total=e->KeywordSet(0)+      e->KeywordSet(1)+
448       e->KeywordSet(2)+      e->KeywordSet(3)+
449       e->KeywordSet(4)+      e->KeywordSet(5)+
450       e->KeywordSet(7)+      e->KeywordSet(8);
451 
452     if (total == 0) return;
453     if (total != 1) e->Throw("Only one control may be selected per call.");
454 
455     status=NC_NOERR;
456     if(e->KeywordSet(0))//ABORT
457       status=nc_abort(cdfid);
458     else if(e->KeywordSet(1))//ENDEF
459       status=nc_enddef(cdfid);
460     else if(e->KeywordSet(2))//FILL
461       status=nc_set_fill(cdfid,NC_FILL,&omode);
462     else if(e->KeywordSet(3))//NOFILL
463       status=nc_set_fill(cdfid,NC_NOFILL,&omode);
464     else if(e->KeywordSet(4))//VERBOSE
465       ncdf_verbose=true;
466     else if(e->KeywordSet(5))//NOVERBOSE
467       ncdf_verbose=false;
468     else if(e->KeywordSet(7))//REDEF
469       status=nc_redef(cdfid);
470     else if(e->KeywordSet(8))//SYNC
471       status=nc_sync(cdfid);
472 
473     if(e->KeywordSet(7) && status==NC_EPERM)
474       throw GDLException(e->CallingNode(),"NCDF_CONTROL: Attempt to reenter define mode (REDEF) failed, no write permission to the file.");
475 
476     else
477       ncdf_handle_error(e, status, "NCDF_CONTROL");
478 
479     if((e->KeywordSet(2) || e->KeywordSet(3)) &&e->KeywordPresent(6))
480       {
481 	e->AssureGlobalKW(6);
482 	GDLDelete(e->GetKW(6));
483 	e->GetKW(6)=new DLongGDL(omode);
484       }
485 
486   }
487 
488 }
489 #endif
490