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 * * 12 * This program is free software; you can redistribute it and/or modify * 13 * it under the terms of the GNU General Public License as published by * 14 * the Free Software Foundation; either version 2 of the License, or * 15 * (at your option) any later version. * 16 * * 17 ***************************************************************************/ 18 #ifdef HAVE_CONFIG_H 19 # include <config.h> 20 #else 21 // default: assume we have netCDF 22 # define USE_NETCDF 1 23 #endif 24 25 #ifdef USE_NETCDF 26 # include "includefirst.hpp" 27 # define HDF 1 28 29 # include <netcdf.h> 30 31 # include "datatypes.hpp" 32 # include "envt.hpp" 33 34 //# include "dpro.hpp" 35 //# include "dinterpreter.hpp" 36 # include "ncdf_cl.hpp" 37 38 39 //# define GDL_DEBUG 40 # undef GDL_DEBUG 41 42 namespace lib { 43 44 using namespace std; 45 using namespace antlr; 46 ncdf_att_handle_error(EnvT * e,int status,const char * function,T * data)47 template <typename T> void ncdf_att_handle_error(EnvT *e, int status, const char *function,T* data) // {{{ 48 { 49 if (data != NULL and status != NC_NOERR) delete[] data; 50 ncdf_handle_error(e, status, function); 51 } // }}} 52 ncdf_attname(EnvT * e)53 BaseGDL* ncdf_attname(EnvT* e) // {{{ 54 { 55 size_t nParam=e->NParam(2); 56 if (nParam ==3 && e->KeywordSet(0)) 57 e->Throw("Specifying both GLOBAL keyword an variable id not allowed"); 58 59 int status; 60 char att_name[NC_MAX_NAME]; 61 DLong cdfid, varid,attnum; 62 varid=0; 63 attnum=0; 64 65 DString attname; 66 e->AssureLongScalarPar(0, cdfid); 67 68 if (e->KeywordSet(0)) 69 { 70 e->AssureLongScalarPar(1, attnum); 71 varid = NC_GLOBAL; 72 } 73 else 74 { 75 // Check type of varid 76 BaseGDL* p1 = e->GetParDefined( 1); 77 if (p1->Type() != GDL_STRING) 78 { 79 // Numeric 80 e->AssureLongScalarPar(1, varid); 81 } else { 82 // String 83 DString var_name; 84 e->AssureScalarPar<DStringGDL>(1, var_name); 85 status=nc_inq_varid(cdfid, var_name.c_str(), &varid); 86 ncdf_handle_error(e,status,"NCDF_ATTNAME"); 87 } 88 e->AssureLongScalarPar(2, attnum); 89 } 90 91 //get the att_name variable. 92 status=nc_inq_attname(cdfid, varid, attnum, att_name); 93 94 if (status == NC_ENOTATT) 95 { 96 Warning("NCDF_ATTNAME: Attribute " + i2s(attnum) + " not found."); 97 return new DStringGDL(""); 98 } 99 100 //handle the error 101 ncdf_handle_error(e,status,"NCDF_ATTNAME"); 102 103 return new DStringGDL(att_name); 104 105 } // }}} 106 ncdf_attinq(EnvT * e)107 BaseGDL* ncdf_attinq(EnvT* e) // {{{ 108 { 109 size_t nParam=e->NParam(2); 110 if(nParam ==3 && e->KeywordSet(0)) 111 { 112 throw GDLException(e->CallingNode(), 113 "NCDF_ATTINQ: The error is Global + varid, not allowed, proper text to come."); 114 115 } else{ 116 117 int status; 118 119 nc_type att_type; 120 size_t length; 121 DString attname; 122 DLong cdfid, varid; 123 124 varid=0; 125 e->AssureLongScalarPar(0, cdfid); 126 127 if(e->KeywordSet(0)) 128 { 129 e->AssureStringScalarPar(1, attname); 130 varid=NC_GLOBAL; 131 132 } else { 133 // Check type of varid 134 BaseGDL* p1 = e->GetParDefined( 1); 135 if (p1->Type() != GDL_STRING) { 136 // Numeric 137 e->AssureLongScalarPar(1, varid); 138 } else { 139 // String 140 DString var_name; 141 e->AssureScalarPar<DStringGDL>(1, var_name); 142 status=nc_inq_varid(cdfid, var_name.c_str(), &varid); 143 ncdf_handle_error(e,status,"NCDF_ATTNAME"); 144 } 145 146 e->AssureStringScalarPar(2, attname); 147 } 148 149 150 //get the attinq data 151 152 status=nc_inq_att(cdfid, 153 varid, 154 attname.c_str(), 155 &att_type, 156 &length); 157 158 159 160 //handle the error 161 ncdf_handle_error(e,status,"NCDF_ATTNAME"); 162 163 // $ is necessary here (see dstructgdl.cpp) 164 DStructDesc* ncdf_attinq=new DStructDesc("$truct"); 165 SpDLong aLong; 166 SpDString aString; 167 ncdf_attinq->AddTag("DATATYPE", &aString); 168 ncdf_attinq->AddTag("LENGTH", &aLong); 169 170 // never for unnamed structs: //structList.push_back(ncdf_attinq); 171 DStructGDL* inq=new DStructGDL(ncdf_attinq,dimension()); 172 173 inq->InitTag("DATATYPE",ncdf_gdl_typename(att_type)); 174 inq->InitTag("LENGTH", DLongGDL(length)); 175 176 return inq; 177 } 178 } // }}} 179 ncdf_attget(EnvT * e)180 void ncdf_attget(EnvT* e) // {{{ 181 { 182 size_t nParam=e->NParam(2); 183 if (nParam >3 && e->KeywordSet(0)) 184 e->Throw("The error is Global + varid, not allowed, proper text to come."); 185 186 int status; 187 nc_type att_type; 188 size_t length; 189 DString attname; 190 DLong cdfid, varid; 191 e->AssureLongScalarPar(0, cdfid); 192 193 if (e->KeywordSet(0)) 194 { 195 e->AssureStringScalarPar(1, attname); 196 varid = NC_GLOBAL; 197 } else { 198 // Check type of varid 199 BaseGDL* p1 = e->GetParDefined( 1); 200 if (p1->Type() != GDL_STRING) { 201 // Numeric 202 e->AssureLongScalarPar(1, varid); 203 } else { 204 // String 205 DString var_name; 206 e->AssureScalarPar<DStringGDL>(1, var_name); 207 status=nc_inq_varid(cdfid, var_name.c_str(), &varid); 208 ncdf_handle_error(e,status,"NCDF_ATTGET"); 209 } 210 e->AssureStringScalarPar(2, attname); 211 } 212 //attname, varid, cdfid are set up 213 214 //get the attinq data 215 status=nc_inq_att(cdfid, varid, attname.c_str(), &att_type, &length); 216 217 //handle the error 218 ncdf_handle_error(e,status,"NCDF_ATTGET"); 219 220 if (att_type == NC_CHAR) { 221 DByteGDL* temp = new DByteGDL(dimension(length)); 222 status = nc_get_att_text(cdfid, varid, attname.c_str(), (char*)(&((*temp)[0]))); 223 ncdf_handle_error(e, status, "NCDF_ATTGET"); 224 delete e->GetParGlobal(nParam-1); 225 e->GetParGlobal(nParam-1)=temp; 226 } 227 else 228 { 229 dimension dim(length); 230 BaseGDL* temp; 231 switch (att_type) 232 { 233 case NC_INT : 234 { 235 int *ip = new int[length]; 236 status=nc_get_att_int(cdfid, varid, attname.c_str(), ip); 237 ncdf_att_handle_error(e, status, "NCDF_ATTGET", ip); 238 temp = length == 1 ? new DLongGDL(BaseGDL::NOZERO) : new DLongGDL(dim, BaseGDL::NOZERO); 239 memcpy(&(*static_cast<DLongGDL*>(temp))[0], &(*ip), length * sizeof(int)); 240 delete[] ip; 241 break; 242 } 243 case NC_SHORT : 244 { 245 short *sp = new short[length]; 246 status = nc_get_att_short(cdfid, varid, attname.c_str(), sp); 247 ncdf_att_handle_error(e, status, "NCDF_ATTGET", sp); 248 temp = length == 1 ? new DIntGDL(BaseGDL::NOZERO) : new DIntGDL(dim, BaseGDL::NOZERO); 249 memcpy(&(*static_cast<DIntGDL*>(temp))[0], &(*sp), length * sizeof(DInt)); 250 delete[] sp; 251 break; 252 } 253 case NC_FLOAT : 254 { 255 float *fp = new float[length]; 256 status=nc_get_att_float(cdfid, varid, attname.c_str(), fp); 257 ncdf_att_handle_error(e,status,"NCDF_ATTGET",fp); 258 temp = length == 1 ? new DFloatGDL(BaseGDL::NOZERO) : new DFloatGDL(dim, BaseGDL::NOZERO); 259 memcpy(&(*static_cast<DFloatGDL*>(temp))[0], &(*fp), length * sizeof(DFloat)); 260 delete[] fp; 261 break; 262 } 263 case NC_DOUBLE : 264 { 265 double *dp = new double[length]; 266 status = nc_get_att_double(cdfid, varid, attname.c_str(), dp); 267 ncdf_att_handle_error(e, status, "NCDF_ATTGET", dp); 268 temp = length == 1 ? new DDoubleGDL(BaseGDL::NOZERO) : new DDoubleGDL(dim, BaseGDL::NOZERO); 269 memcpy(&(*static_cast<DDoubleGDL*>(temp))[0], &(*dp), length * sizeof(DDouble)); 270 delete[] dp; 271 break; 272 } 273 case NC_BYTE : 274 { 275 unsigned char *bp = new unsigned char[length]; 276 status = nc_get_att_uchar(cdfid, varid, attname.c_str(), bp); 277 ncdf_att_handle_error(e, status, "NCDF_ATTGET", bp); 278 temp = length == 1 ? new DByteGDL(BaseGDL::NOZERO) : new DByteGDL(dim, BaseGDL::NOZERO); 279 memcpy(&(*static_cast<DByteGDL*>(temp))[0], &(*bp), length * sizeof(DByte)); 280 delete[] bp; 281 break; 282 } 283 } 284 GDLDelete(e->GetParGlobal(nParam - 1)); 285 e->GetParGlobal(nParam - 1) = temp; 286 } 287 288 } // }}} 289 ncdf_attput(EnvT * e)290 void ncdf_attput(EnvT* e) // {{{ 291 { 292 // size_t N_Params=e->NParam(3); 293 int status, val_num; 294 nc_type xtype; 295 296 // BaseGDL* at;//name 297 DString attname; 298 BaseGDL* val;//value; 299 300 //get the cdfid, which must be given. 301 302 DLong cdfid, varid; 303 e->AssureLongScalarPar(0, cdfid); 304 varid=0; 305 306 if(e->KeywordSet(0)) 307 { 308 e->AssureStringScalarPar(1, attname); 309 val=e->GetParDefined(2); 310 val_num=2; 311 varid=NC_GLOBAL; 312 } else { 313 // Check type of varid 314 BaseGDL* p1 = e->GetParDefined( 1); 315 if (p1->Type() != GDL_STRING) { 316 // Numeric 317 e->AssureLongScalarPar(1, varid); 318 } else { 319 // String 320 DString var_name; 321 e->AssureScalarPar<DStringGDL>(1, var_name); 322 status=nc_inq_varid(cdfid, var_name.c_str(), &varid); 323 ncdf_handle_error(e,status,"NCDF_ATTPUT"); 324 } 325 e->AssureStringScalarPar(2, attname); 326 327 val=e->GetParDefined(3); 328 val_num=3; 329 } 330 331 //we have the cdfid, varid, attname, attval here 332 333 //determine default data type 334 xtype = NC_FLOAT; 335 if (val->Type() == GDL_BYTE) xtype=NC_BYTE; 336 if (val->Type() == GDL_STRING) xtype=NC_CHAR; 337 if (val->Type() == GDL_INT) xtype=NC_SHORT; 338 if (val->Type() == GDL_LONG) xtype=NC_INT; 339 if (val->Type() == GDL_FLOAT) xtype=NC_FLOAT; 340 if (val->Type() == GDL_DOUBLE) xtype=NC_DOUBLE; 341 // SA: TODO: GDL_UINT, GDL_ULONG, GDL_COMPLEX, GDL_PTR... 342 343 if(e->KeywordSet(2)) //GDL_BYTE 344 xtype=NC_BYTE; 345 else if(e->KeywordSet(3)) //CHAR 346 xtype=NC_CHAR; 347 else if(e->KeywordSet(4)) //GDL_DOUBLE 348 xtype=NC_DOUBLE; 349 else if(e->KeywordSet(5)) //GDL_FLOAT 350 xtype=NC_FLOAT; 351 else if(e->KeywordSet(6)) //GDL_LONG 352 xtype=NC_INT; 353 else if(e->KeywordSet(7)) //SHORT 354 xtype=NC_SHORT; 355 356 // LENGTH keyword support 357 DLong length; 358 if (val->Type() != GDL_STRING) 359 { 360 length = val->N_Elements(); 361 e->AssureLongScalarKWIfPresent(1, length); 362 if (length > val->N_Elements()) e->Throw("LENGTH keyword value (" + i2s(length) + 363 ") exceedes the data length (" + i2s(val->N_Elements()) + ")"); 364 } 365 366 367 if(val->Type() == GDL_BYTE) 368 { 369 370 DByteGDL * bvar=static_cast<DByteGDL*>(val); 371 status=nc_put_att_uchar(cdfid,varid, 372 attname.c_str(),xtype, 373 (size_t)length, 374 (const unsigned char *)&(*bvar)[0]); 375 } 376 else if(val->Type() == GDL_STRING) 377 { 378 DString cvar; 379 e->AssureScalarPar<DStringGDL>(val_num,cvar); 380 381 length = cvar.length(); 382 e->AssureLongScalarKWIfPresent(1, length); 383 if (length > cvar.length()) e->Throw("LENGTH keyword value (" + i2s(length) + 384 ") exceedes the data length (" + i2s(cvar.length()) + ")"); 385 if (length < cvar.length()) cvar.resize(length); 386 387 status=nc_put_att_text(cdfid,varid, attname.c_str(), 388 cvar.length(), (char *)cvar.c_str()); 389 } 390 else if(val->Type() == GDL_INT) 391 { 392 DIntGDL * ivar=static_cast<DIntGDL*>(val); 393 status=nc_put_att_short(cdfid,varid, 394 attname.c_str(), xtype, 395 (size_t)length, &(*ivar)[0]); 396 } 397 else if(val->Type() == GDL_LONG) 398 { 399 DLongGDL * lvar=static_cast<DLongGDL*>(val); 400 status=nc_put_att_int(cdfid,varid, 401 attname.c_str(),xtype, 402 (size_t)length, &(*lvar)[0]); 403 } 404 else if(val->Type() == GDL_FLOAT) 405 { 406 DFloatGDL * fvar=static_cast<DFloatGDL*>(val); 407 status=nc_put_att_float(cdfid,varid, 408 attname.c_str(),xtype, 409 (size_t)length, &(*fvar)[0]); 410 } 411 else if(val->Type() == GDL_DOUBLE) 412 { 413 DDoubleGDL * dvar=static_cast<DDoubleGDL*>(val); 414 status=nc_put_att_double(cdfid,varid, 415 attname.c_str(),xtype, 416 (size_t)length, &(*dvar)[0]); 417 } 418 419 ncdf_handle_error(e, status,"NCDF_ATTPUT"); 420 421 return; 422 423 424 } // }}} 425 ncdf_attcopy(EnvT * e)426 BaseGDL* ncdf_attcopy(EnvT* e) // {{{ 427 { 428 429 size_t nParam=e->NParam(3); 430 431 int status,add; 432 //incdf 433 DLong incdf,outcdf,invar,outvar; 434 e->AssureLongScalarPar(0, incdf); 435 436 add=0; 437 438 if(e->KeywordSet(0)) //in_global 439 invar=NC_GLOBAL; 440 441 if(e->KeywordSet(1)) //out_global 442 outvar=NC_GLOBAL; 443 444 445 if(e->KeywordSet(0) && e->KeywordSet(1) && nParam > 3) 446 { 447 throw GDLException(e->CallingNode(), 448 "NCDF_ATTCOPY: Too many variables error 1"); 449 } 450 else if((e->KeywordSet(0) || e->KeywordSet(1)) && nParam > 4) 451 { 452 throw GDLException(e->CallingNode(), 453 "NCDF_ATTCOPY: Too many variables error 2"); 454 } 455 else if(e->KeywordSet(0) && !e->KeywordSet(1) && nParam == 4) 456 { 457 e->AssureLongScalarPar(2, outcdf); 458 459 // Check type of varid 460 BaseGDL* p3 = e->GetParDefined( 3); 461 if (p3->Type() != GDL_STRING) { 462 // Numeric 463 e->AssureLongScalarPar(3, outvar); 464 } else { 465 // String 466 DString var_name; 467 e->AssureScalarPar<DStringGDL>(3, var_name); 468 status=nc_inq_varid(outcdf, var_name.c_str(), &outvar); 469 ncdf_handle_error(e,status,"NCDF_ATTCOPY"); 470 } 471 } 472 else if(!e->KeywordSet(0) && e->KeywordSet(1) && nParam == 4) 473 { 474 // Check type of varid 475 BaseGDL* p1 = e->GetParDefined( 1); 476 if (p1->Type() != GDL_STRING) { 477 // Numeric 478 e->AssureLongScalarPar(1, invar); 479 } else { 480 // String 481 DString var_name; 482 e->AssureScalarPar<DStringGDL>(1, var_name); 483 status=nc_inq_varid(incdf, var_name.c_str(), &invar); 484 ncdf_handle_error(e,status,"NCDF_ATTCOPY"); 485 } 486 } 487 else if(!e->KeywordSet(0) && !e->KeywordSet(1) && nParam == 5) 488 { 489 e->AssureLongScalarPar(3, outcdf); 490 491 // Check type of varid 492 BaseGDL* p1 = e->GetParDefined( 1); 493 if (p1->Type() != GDL_STRING) { 494 // Numeric 495 e->AssureLongScalarPar(1, invar); 496 } else { 497 // String 498 DString var_name; 499 e->AssureScalarPar<DStringGDL>(1, var_name); 500 status=nc_inq_varid(incdf, var_name.c_str(), &invar); 501 ncdf_handle_error(e,status,"NCDF_ATTCOPY"); 502 } 503 504 // Check type of varid 505 BaseGDL* p4 = e->GetParDefined( 4); 506 if (p4->Type() != GDL_STRING) { 507 // Numeric 508 e->AssureLongScalarPar(4, outvar); 509 } else { 510 // String 511 DString var_name; 512 e->AssureScalarPar<DStringGDL>(4, var_name); 513 status=nc_inq_varid(outcdf, var_name.c_str(), &outvar); 514 ncdf_handle_error(e,status,"NCDF_ATTCOPY"); 515 } 516 } 517 518 519 //Here, 520 //we have, incdf, invar, outvar 521 522 523 DString name; 524 if(!e->KeywordSet(0)) add=1; 525 e->AssureStringScalarPar(1+add, name); 526 527 //name 528 529 //outcdf 530 e->AssureLongScalarPar(2+add, outcdf); 531 532 //All variables are done. 533 534 status=nc_copy_att(incdf,invar, 535 name.c_str(), 536 outcdf,outvar); 537 538 ncdf_handle_error(e, status,"NCDF_ATTCOPY"); 539 540 if(status == NC_NOERR) return new DIntGDL(outvar); 541 return new DIntGDL(-1); 542 } // }}} 543 ncdf_attdel(EnvT * e)544 void ncdf_attdel(EnvT* e) // {{{ 545 { 546 size_t nParam=e->NParam(2); 547 int status; 548 549 // BaseGDL* at;//name 550 DString attname; 551 // BaseGDL* val;//value; 552 553 554 //get the cdfid, which must be given. 555 DLong cdfid, varid; 556 e->AssureLongScalarPar(0, cdfid); 557 varid=0; 558 559 if(e->KeywordSet(0) && nParam == 3) 560 { 561 throw GDLException(e->CallingNode(), 562 "NCDF_ATTDEL: Too many variables error 1"); 563 } 564 else if(!e->KeywordSet(0) && nParam == 2) 565 { 566 throw GDLException(e->CallingNode(), 567 "NCDF_ATTDEL: Not enough variables error 2"); 568 } 569 else if(e->KeywordSet(0)) //global 570 { 571 e->AssureStringScalarPar(1, attname); 572 varid=NC_GLOBAL; 573 574 } else { 575 BaseGDL* p1 = e->GetParDefined( 1); 576 if (p1->Type() != GDL_STRING) { 577 // Numeric 578 e->AssureLongScalarPar(1, varid); 579 } else { 580 // String 581 DString var_name; 582 e->AssureScalarPar<DStringGDL>(1, var_name); 583 status=nc_inq_varid(cdfid, var_name.c_str(), &varid); 584 ncdf_handle_error(e,status,"NCDF_ATTNAME"); 585 } 586 e->AssureStringScalarPar(2, attname); 587 } 588 //we have the cdfid, varid, attname 589 590 status=nc_del_att(cdfid,varid,attname.c_str()); 591 592 ncdf_handle_error(e, status,"NCDF_ATTDEL"); 593 594 return; 595 } // }}} 596 ncdf_attrename(EnvT * e)597 void ncdf_attrename(EnvT* e) // {{{ 598 { 599 size_t nParam=e->NParam(3); 600 int status; 601 602 // BaseGDL* at;//name 603 DString attname; 604 DString newname; 605 // BaseGDL* val;//value; 606 607 608 //get the cdfid, which must be given. 609 DLong cdfid, varid; 610 e->AssureLongScalarPar(0, cdfid); 611 612 varid=0; 613 614 if(e->KeywordSet(0) && nParam == 4) 615 { 616 throw GDLException(e->CallingNode(), 617 "NCDF_ATTRENAME: Too many variables error 1"); 618 } 619 else if(!e->KeywordSet(0) && nParam == 3) 620 { 621 throw GDLException(e->CallingNode(), 622 "NCDF_ATTRENAME: Not enough variables error 2"); 623 } 624 else if(e->KeywordSet(0)) //global 625 { 626 e->AssureStringScalarPar(1, attname); 627 e->AssureStringScalarPar(2, newname); 628 varid=NC_GLOBAL; 629 630 } else { 631 // Check type of varid 632 BaseGDL* p1 = e->GetParDefined( 1); 633 if (p1->Type() != GDL_STRING) { 634 // Numeric 635 e->AssureLongScalarPar(1, varid); 636 } else { 637 // String 638 DString var_name; 639 e->AssureScalarPar<DStringGDL>(1, var_name); 640 status=nc_inq_varid(cdfid, var_name.c_str(), &varid); 641 ncdf_handle_error(e,status,"NCDF_ATTNAME"); 642 } 643 e->AssureStringScalarPar(2, attname); 644 e->AssureStringScalarPar(3, newname); 645 } 646 //we have the cdfid, varid, attname,newname 647 648 status=nc_rename_att(cdfid,varid, 649 attname.c_str(), 650 newname.c_str()); 651 652 ncdf_handle_error(e, status,"NCDF_ATTRENAME"); 653 654 return; 655 } // }}} 656 657 } 658 #endif 659