« back to all changes in this revision
Viewing changes to src/nco++/ncoGrammer.g
- browse files at revision 15
- compare with another revision
- download diff
- download tarball
- view history from revision 15
- Committer: Package Import Robot
- Author(s): Francesco Paolo Lovergine
- Date: 2014-03-26 16:54:51 UTC
- mfrom: (5.1.8 sid)
- Revision ID: package-import@ubuntu.com-20140326165451-u9erq1ez71r248lt
Tags: 4.4.2-1
* New upstream release.
(closes: #611673)
* Added missing watch flle.
* Policy bumped to 3.9.5.
* Added build-dep on autotools-dev and update/clean step in debian/rules.
(closes: #727470)
* Changed Vcs-* url to canonicali ones.
* Debhelper level set to 9.
* Now nco.html is a single file.
(closes: #611673)
* Added missing watch flle.
* Policy bumped to 3.9.5.
* Added build-dep on autotools-dev and update/clean step in debian/rules.
(closes: #727470)
* Changed Vcs-* url to canonicali ones.
* Debhelper level set to 9.
* Now nco.html is a single file.
- files added:
- .pc
- bin
- doc/xmp
- obj
- qt
- qt/libnco
- qt/libnco_c++
- qt/ncap2
- qt/ncatted
- qt/ncbo
- qt/ncea
- qt/ncecat
- qt/ncflint
- qt/ncks
- qt/ncpdq
- qt/ncra
- qt/ncrcat
- qt/ncrename
- qt/ncwa
- qt/tst_nco_c++
- src/cuda
- files removed:
- configure.in
- files modified:
- INSTALL
added
removed
src/nco++/ncoGrammer.g
1
1
header {
2
/* $Header: /cvsroot/nco/nco/src/nco++/ncoGrammer.g,v 1.191 2012/02/13 17:42:00 hmb Exp $ */
2
/* $Header: /cvsroot/nco/nco/src/nco++/ncoGrammer.g,v 1.205 2014/02/17 23:12:39 zender Exp $ */
3
3
4
4
/* Purpose: ANTLR Grammar and support files for ncap2 */
5
5
6
/* Copyright (C) 2005--2012 Charlie Zender
6
/* Copyright (C) 2005--2012 Henry Butowsky and Charlie Zender
7
7
License: GNU General Public License (GPL) Version 3
8
8
See http://www.gnu.org/copyleft/gpl.html for full license text */
9
9
10
10
// C Standard Headers
11
11
#include <assert.h>
12
12
#include <ctype.h>
13
#include <malloc.h>
13
#include <stdlib.h>
14
14
#include <math.h>
15
15
#if !(defined __xlC__) && !(defined SGIMP64) // C++ compilers that do not allow stdint.h
16
16
#include <stdint.h> // Required by g++ for LLONG_MAX, ULLONG_MAX, by icpc for int64_t
73
73
ATAN2; //Used indirectly
74
74
WHERE_ASSIGN;
75
75
MISS2ZERO; //used only in VarOp -sets all missing values to zero
76
VSORT; // only used outside of grammer to sort in VarOp
76
VSORT; // ascending sort only used outside of grammer to sort in VarOp
77
VRSORT; // reverse sort only used outside of grammer to sort in VarOp
77
78
VABS; // imaginary token used in VarOp to return absolute value
78
79
VSQR2; // imaginary token used in VarOp to return square of number
79
80
80
}
81
81
{
82
82
83
83
public:
84
84
std::vector<std::string> inc_vtr;
85
86
85
}
87
86
88
87
program:
124
123
| PRINT^ LPAREN! (VAR_ID|ATT_ID|NSTRING) (COMMA! NSTRING)? RPAREN! SEMI!
125
124
// Code block
126
125
| block
127
128
126
;
129
127
130
131
132
128
// a bracketed block
133
129
block:
134
130
LCURL! (statement)* RCURL!
135
131
{ #block = #( [BLOCK, "block"], #block ); }
136
132
;
137
133
138
139
134
for_stmt:
140
135
FOR^ LPAREN! (e1:expr)? SEMI! (e2:expr)? SEMI! (e3:expr)? RPAREN! st:statement
141
136
/* { if(#e1==NULL) #e1 = #([ NULL_NODE, "null_stmt"]);
145
140
} */
146
141
;
147
142
148
149
143
lmt: (expr)? (COLON (expr)?)*
150
144
{ #lmt = #( [LMT, "lmt"], #lmt ); }
151
145
;
152
146
153
154
155
147
lmt_list: LPAREN! lmt (COMMA! lmt)* RPAREN!
156
148
{ #lmt_list = #( [LMT_LIST, "lmt_list"], #lmt_list ); }
157
149
;
158
150
159
160
151
// Use vars in dimension list so dims in [] can
161
152
// be used with or with out $ prefix. ie "$lon" or "lon"
162
153
// So parser is compatible with ncap1
192
183
193
184
/*************************************************************/
194
185
/* start expressions */
195
196
197
186
meth_exp: primary_exp (DOT^ FUNC func_arg)*
198
187
;
199
188
206
195
)?
207
196
;
208
197
209
210
198
// unary right association
211
199
/*
212
200
unary_exp: ( LNOT^| PLUS^| MINUS^ |INC^ | DEC^ | TIMES^ ) unary_exp
219
207
| unaryleft_exp
220
208
;
221
209
222
223
224
210
// right association
225
211
pow_exp: unary_exp (CARET^ pow_exp )?
226
212
;
290
276
| hyper_slb //remember this includes VAR_ID & ATT_ID
291
277
;
292
278
293
294
279
/* End expressions */
295
280
/*************************************************************/
296
297
281
298
282
imaginary_token
299
283
: NRootAST
301
285
302
286
class ncoLexer extends Lexer;
303
287
304
305
288
options {
306
289
k = 4;
307
290
308
309
310
291
defaultErrorHandler=false;
311
292
filter=BLASTOUT;
312
293
testLiterals=false;
313
294
charVocabulary = '\u0000'..'\u00FF';
314
315
295
}
316
296
317
318
297
tokens {
319
298
// token keywords
320
299
IF ="if";
338
317
SET_MISS="set_miss";
339
318
CH_MISS="change_miss";
340
319
*/
341
342
320
}
343
321
344
345
322
{
346
347
323
private:
348
324
prs_cls *prs_arg;
349
325
public:
370
346
selector.retry();
371
347
}
372
348
// else ANTLR_USE_NAMESPACE(std)cout << "Hit EOF of main file" << ANTLR_USE_NAMESPACE(std)endl;
373
374
349
}
375
376
377
350
}
378
351
379
380
352
ASSIGN options { paraphrase="="; } : '=';
381
353
382
354
PLUS_ASSIGN options { paraphrase="+="; } : "+=";
459
431
protected XPN: ( 'e' | 'E' ) ( '+' | '-' )? ('0'..'9')+ ;
460
432
protected VAR_NM_QT: (LPHDGT|'-'|'+'|'.'|'('|')'|':' )+ ;
461
433
462
463
464
434
protected BLASTOUT: .
465
435
{
466
436
// blast out of lexer & parser
477
447
throw ANTLR_USE_NAMESPACE(antlr)TokenStreamRecognitionException(re);
478
448
}
479
449
;
480
481
482
483
484
450
485
451
UNUSED_OPS: ( "%=" | "^=" | "&=" | "|=" ) {
486
452
493
459
}
494
460
;
495
461
496
497
462
// Whitespace -- ignored
498
463
WS options {paraphrase="white space"; }
499
464
: ( ' ' |'\t' { tab(); } | '\f' |'\n' { newline(); })
500
465
{ $setType(antlr::Token::SKIP);}
501
466
;
502
467
503
504
505
468
CXX_COMMENT options {paraphrase="a C++-style comment"; }
506
469
: "//" (~'\n')* '\n'
507
470
{ $setType(antlr::Token::SKIP); newline(); }
508
471
;
509
472
510
511
473
C_COMMENT options {paraphrase="a C-style comment"; }
512
474
:
513
475
"/*"
522
484
// Numbers like .123, .2e3 ,.123f, 0.23d
523
485
// csz: Treat "l" or "L" following decimal point as "long double" as per C++
524
486
NUMBER_DOT options {paraphrase="a floating point number"; }
525
:
487
:
526
488
'.' (DGT)+ (XPN)? { $setType(DOUBLE); }
527
489
( ('D'|'d')! { $setType(DOUBLE);}
528
490
|('F'|'f')! { $setType(FLOAT);}
548
510
)?
549
511
;
550
512
551
552
553
513
// Return var or att (var_nm@att_nm)
554
VAR_ATT options {testLiterals=true; paraphrase="variable or attribute identifier"; }
555
: (LPH)(LPH|DGT)*
514
VAR_ATT options {testLiterals=true; paraphrase="variable or function or attribute identifier"; }
515
: (LPH)(LPH|DGT)*
556
516
{
557
// check function/method vector
558
if( std::binary_search(prs_arg->fmc_vtr.begin(),prs_arg->fmc_vtr.end(),fmc_cls($getText)))
559
$setType(FUNC);
560
else
561
$setType(VAR_ID);
562
563
}
517
// try to intelligently guess the type to avoid un-necessary function search
518
bool bDoSearch;
519
switch( LA(1) ){
520
case ' ':
521
case '\t':
522
case '(':
523
bDoSearch=true;
524
$setType(VAR_ID);
525
break;
526
case '@':
527
bDoSearch=false;
528
$setType(ATT_ID);
529
break;
530
default:
531
bDoSearch=false;
532
$setType(VAR_ID);
533
break;
534
}
535
if(bDoSearch){
536
string fnc_nm=$getText;
537
std::vector<fmc_cls>::iterator we=std::lower_bound(prs_arg->fmc_vtr.begin(),prs_arg->fmc_vtr.end(),fmc_cls(fnc_nm));
538
if(we!=prs_arg->fmc_vtr.end() && we->fnm()==fnc_nm){
539
int idx=we-prs_arg->fmc_vtr.begin();
540
char buff[10];
541
sprintf(buff,"%d",idx);
542
// VERY IMPORTANT - append the index in fmc_vtr to the function name - (name#idx)
543
$setText(fnc_nm+"#"+buff);
544
$setType(FUNC);
545
}
546
}
547
}
564
548
('@'(LPH)(LPH|DGT)* {$setType(ATT_ID); })?
565
;
566
549
;
567
550
568
551
// Return a quoted var or att (var_nm@att_nm)
569
552
VAR_ATT_QT :( '\''!)
572
555
('\''!)
573
556
;
574
557
575
576
577
578
558
//Return a quoted dim
579
559
DIM_QT: ( '\''!)
580
560
('$'! VAR_NM_QT {$setType(DIM_ID);})
590
570
)?
591
571
;
592
572
593
594
595
// Shorthand for naming dims in method e.g $0,$1, $2 etc
573
// Shorthand for naming dims in method e.g., $0,$1, $2 etc
596
574
DIM_MTD_ID
597
575
options{paraphrase="dimension identifier";}
598
576
: '$'! (DGT)+
599
577
;
600
578
601
602
579
NSTRING
603
580
options{paraphrase="a string";}
604
581
: '"'! ( ~('"'|'\n'))* '"'!
606
583
('s'! {$setType(N4STRING);} )?
607
584
;
608
585
609
610
611
586
INCLUDE
612
587
: "#include" (WS)? f:NSTRING
613
588
{
640
615
}
641
616
;
642
617
643
644
618
class ncoTree extends TreeParser;
645
619
{
646
620
652
626
prs_cls *prs_arg;
653
627
ASTFactory myFactory;
654
628
655
656
657
658
629
//Structure to hold AST pointers to indices in hyperslabs -only temporary
659
630
typedef struct{
660
631
ANTLR_USE_NAMESPACE(antlr)RefAST ind[3];
701
672
hyp.ind[0]=ANTLR_USE_NAMESPACE(antlr)nullAST;
702
673
hyp.ind[1]=ANTLR_USE_NAMESPACE(antlr)nullAST;
703
674
hyp.ind[2]=ANTLR_USE_NAMESPACE(antlr)nullAST;
704
705
675
706
676
if(lRef->getType()!=LMT)
707
677
return 0;
752
722
lRef=lRef->getNextSibling();
753
723
}
754
724
return nbr_dmn;
755
756
725
}
757
726
758
727
int
763
732
int nbr_dmn;
764
733
int idx;
765
734
int jdx;
766
long lcl_ind[3];
767
768
var_sct *var_out;
769
735
lmt_sct *lmt_ptr;
770
736
RefAST aRef;
771
737
772
738
vector<ast_lmt_sct> ast_lmt_vtr;
773
739
774
775
740
// populate ast_lmt_vtr
776
741
nbr_dmn=lmt_init(lmt,ast_lmt_vtr);
777
742
778
743
for(idx=0 ; idx <nbr_dmn ; idx++){
779
744
780
781
lcl_ind[0]=-2; lcl_ind[1]=-2; lcl_ind[2]=0;
782
783
for(jdx=0 ; jdx <3 ; jdx++){
784
785
aRef=ast_lmt_vtr[idx].ind[jdx];
786
787
if(!aRef)
788
continue; //do nothing - use default lcl_ind values
789
else if( aRef->getType() == COLON){
790
if(jdx <2) lcl_ind[jdx]=-1;
791
}else{
792
// Calculate number using out()
793
var_out=out(aRef);
794
795
// convert result to type int
796
var_out=nco_var_cnf_typ(NC_INT,var_out);
797
(void)cast_void_nctype((nc_type)NC_INT,&var_out->val);
798
799
// only interested in the first value.
800
lcl_ind[jdx]=var_out->val.ip[0];
801
802
var_out=nco_var_free(var_out);
803
}
804
}// end jdx
805
806
745
// fill out lmt structure
807
746
// use same logic as nco_lmt_prs
808
747
lmt_ptr=(lmt_sct*)nco_calloc((size_t)1,sizeof(lmt_sct));
809
810
748
lmt_ptr->nm=NULL;
811
749
//lmt_ptr->lmt_typ=-1;
812
750
lmt_ptr->is_usr_spc_lmt=True; /* True if any part of limit is user-specified, else False */
815
753
lmt_ptr->srd_sng=NULL;
816
754
lmt_ptr->is_usr_spc_min=False;
817
755
lmt_ptr->is_usr_spc_max=False;
818
819
/* rec_skp_nsh_spf is used for record dimension in multi-file operators */
820
lmt_ptr->rec_skp_nsh_spf=0L; /* Number of records skipped in initial superfluous files */
821
822
/* Fill-in structure */
823
if( lcl_ind[0] >= 0){
824
lmt_ptr->is_usr_spc_min=True;
825
lmt_ptr->srt=lcl_ind[0];
826
}
827
828
/* Fill-in structure */
829
if( lcl_ind[1] >= 0) {
830
lmt_ptr->is_usr_spc_max=True;
831
lmt_ptr->end=lcl_ind[1];
832
}
833
834
/* Fill-in structure */
835
if( lcl_ind[2] > 0) {
836
lmt_ptr->srd_sng=strdup("~fill_in");
837
lmt_ptr->srd=lcl_ind[2];
838
}
839
756
/* rec_skp_ntl_spf is used for record dimension in multi-file operators */
757
lmt_ptr->rec_skp_ntl_spf=0L; /* Number of records skipped in initial superfluous files */
758
759
for(jdx=0 ; jdx <3 ; jdx++){
760
long ldx=0L;
761
var_sct *var_out;
762
763
aRef=ast_lmt_vtr[idx].ind[jdx];
764
765
if(aRef && aRef->getType() != COLON ){
766
// Calculate number using out()
767
var_out=out(aRef);
768
// convert result to type int
769
var_out=nco_var_cnf_typ(NC_INT,var_out);
770
(void)cast_void_nctype((nc_type)NC_INT,&var_out->val);
771
// only interested in the first value.
772
ldx=var_out->val.ip[0];
773
var_out=nco_var_free(var_out);
774
775
// switch jdx 0-srt,1-end,2-srd
776
switch(jdx){
777
case 0:
778
lmt_ptr->is_usr_spc_min=True;
779
lmt_ptr->srt=ldx;
780
break;
781
case 1: //end
782
lmt_ptr->is_usr_spc_max=True;
783
lmt_ptr->end=ldx;
784
break;
785
case 2: //srd
786
lmt_ptr->srd_sng=strdup("~fill_in");
787
lmt_ptr->srd=ldx;
788
break;
789
}
790
}
791
}// end jdx
792
840
793
/* need to deal with situation where only start is defined -- ie picking only a single value */
841
if(lcl_ind[0] >=0 && lcl_ind[1]==-2){
842
lmt_ptr->is_usr_spc_max=True;
843
lmt_ptr->end=lcl_ind[0];
794
if( lmt_ptr->is_usr_spc_min==True && lmt_ptr->is_usr_spc_max==False && lmt_ptr->srd_sng==NULL){
795
lmt_ptr->is_usr_spc_max=True;
796
lmt_ptr->end=lmt_ptr->srt;
844
797
}
845
798
846
799
lmt_vtr.push_back(lmt_ptr);
847
} // end idx
800
} // end idx
848
801
849
802
return nbr_dmn;
850
803
} /* end lmt_mk */
868
821
ncap_omp_exe(
869
822
std::vector< std::vector<RefAST> > &all_ast_vtr,
870
823
ncoTree** wlk_ptr,
871
int nbr_wlk);
824
int wlk_nbr);
872
825
873
826
if(tr== ANTLR_USE_NAMESPACE(antlr)nullAST)
874
827
err_prn("run_dbl"," REPORTS given a null AST Refrence\n");
914
867
goto end;
915
868
} //end if
916
869
917
918
919
870
small:
920
871
idx=0;
921
872
ntr=tr;
1001
952
}
1002
953
} // end native block
1003
954
1004
1005
1006
1007
955
// Return the number of dimensions in lmt subscript
1008
956
lmt_peek returns [int nbr_dmn=0]
1009
957
1018
966
}
1019
967
;
1020
968
1021
1022
1023
969
statements returns [int iret=0]
1024
970
{
1025
971
var_sct *var;
1049
995
// std::cout << "Modified assign "<<exp->toStringTree()<<std::endl;
1050
996
}
1051
997
}
1052
1053
998
1054
999
var=out(exp->getFirstChild());
1055
1000
if(var != (var_sct*)NULL)
1083
1028
iret=run_exe(stmt->getFirstChild(),lpp_vtr.size());
1084
1029
}else
1085
1030
iret=statements(stmt);
1086
1087
1031
}
1088
1032
1089
1033
// See if else stmt exists (3rd sibling)
1093
1037
iret=run_exe(stmt->getFirstChild(),lpp_vtr.size());
1094
1038
}else
1095
1039
iret=statements(stmt);
1096
1097
1040
}
1098
1041
1099
1042
var=NULL_CEWI;
1205
1148
1206
1149
if(iret==BREAK) break;
1207
1150
1208
1209
1151
if(b3){
1210
1152
var_f3=out(e3);
1211
1153
var_f3=nco_var_free(var_f3);
1212
1154
}
1213
1155
1214
1215
1156
if(b2){
1216
1157
var_f2=out(e2);
1217
1158
br=ncap_var_lgcl(var_f2);
1226
1167
1227
1168
} // end for action
1228
1169
1229
1230
1170
| ELSE { iret=ELSE;}
1231
1171
| BREAK { iret=BREAK;}
1232
1172
| CONTINUE {iret=CONTINUE;}
1244
1184
(void)ncap_def_dim(def->getText(),sz,prs_arg);
1245
1185
}
1246
1186
1247
1248
1187
// All the following functions have iret=0
1249
1188
| (#(PRINT VAR_ID))=> #(PRINT pvid:VAR_ID){
1250
1189
1254
1193
std::string va_nm(pvid->getText());
1255
1194
NcapVar *Nvar;
1256
1195
1257
1258
1196
if(prs_arg->ntl_scn) goto end2;
1259
1197
Nvar=prs_arg->var_vtr.find(va_nm);
1260
1198
1261
1262
1199
if(Nvar && Nvar->flg_mem){
1263
1200
wrn_prn(fnc_nm,"Cannot print out RAM variables at the moment!");
1264
1201
goto end2;
1291
1228
(void)nco_prn_var_val_lmt(fl_id,va_nm.c_str(),(lmt_sct*)NULL,0L,fmt_sng,prs_arg->FORTRAN_IDX_CNV,False,False);
1292
1229
1293
1230
if(fmt_sng) fmt_sng=(char*)nco_free(fmt_sng);
1294
1295
1231
1296
1232
end2: ;
1297
1298
1233
}
1299
1234
| (#(PRINT ATT_ID))=> #(PRINT patt:ATT_ID){
1300
1235
1358
1293
prn_sng=strdup(pstr->getText().c_str());
1359
1294
(void)sng_ascii_trn(prn_sng);
1360
1295
1361
fprintf(stdout,prn_sng);
1296
fprintf(stdout,"%s",prn_sng);
1362
1297
prn_sng=(char*)nco_free(prn_sng);
1363
1298
}
1364
1299
}
1372
1307
}
1373
1308
: (#(VAR_ID LMT_LIST ))=> #(vid:VAR_ID lmt:LMT_LIST){
1374
1309
1375
1376
1310
std::string var_nm;
1377
1311
var_sct *var_lhs;
1378
1312
var_sct *var_rhs;
1380
1314
1381
1315
var_nm=vid->getText();
1382
1316
1383
1384
1385
if(dbg_lvl_get() > 0)
1386
dbg_prn(fnc_nm,var_nm+"(limits)");
1317
if(nco_dbg_lvl_get() >= nco_dbg_scl) dbg_prn(fnc_nm,var_nm+"(limits)");
1387
1318
1388
1319
// evaluate rhs for side effects eg new dims or lvalues
1389
1320
var_rhs=out(vid->getNextSibling());
1390
1321
var_rhs=nco_var_free(var_rhs);
1391
1322
1392
1393
1323
var_lhs=prs_arg->ncap_var_init(var_nm,false);
1394
1324
if(var_lhs){
1395
1325
var=nco_var_dpl(var_lhs);
1396
1326
(void)prs_arg->ncap_var_write(var_lhs,bram);
1397
1327
} else {
1398
1399
1328
// set var to udf
1400
1329
var_lhs=ncap_var_udf(var_nm.c_str());
1401
1330
var=nco_var_dpl(var_lhs);
1417
1346
1418
1347
var_nm=vid1->getText();
1419
1348
1420
if(dbg_lvl_get() > 0)
1421
dbg_prn(fnc_nm,var_nm+"[dims]");
1422
1423
1349
if(nco_dbg_lvl_get() >= nco_dbg_var) dbg_prn(fnc_nm,var_nm+"[dims]");
1424
1350
1425
1351
// set class wide variables
1426
1352
bcst=true;
1444
1370
// return undef if dim missing
1445
1371
if( idx <str_vtr_sz){
1446
1372
var=NULL_CEWI;
1447
1448
1373
} else {
1449
1450
1374
// Cast is applied in VAR_ID action in function out()
1451
1375
var_cst=ncap_cst_mk(str_vtr,prs_arg);
1452
1376
1457
1381
var_cst=nco_var_cnf_typ(var1->type,var_cst);
1458
1382
var_cst->typ_dsk=var1->type;
1459
1383
var=nco_var_dpl(var_cst);
1460
1461
1384
}
1462
1385
var1=nco_var_free(var1);
1463
1386
}
1464
1387
1465
1466
1388
if(!var){
1467
1389
var1=ncap_var_udf(var_nm.c_str());
1468
1390
Nvar=new NcapVar(var1);
1479
1401
var_cst=nco_var_free(var_cst);
1480
1402
1481
1403
bcst=false;
1482
1483
1404
}
1484
1405
1485
1406
| vid2:VAR_ID {
1488
1409
1489
1410
var_nm=vid2->getText();
1490
1411
1491
1492
if(dbg_lvl_get() > 0)
1493
dbg_prn(fnc_nm,var_nm);
1494
1412
if(nco_dbg_lvl_get() >= nco_dbg_var) dbg_prn(fnc_nm,var_nm);
1495
1413
1496
1414
var_sct *var1;
1497
1415
1499
1417
bcst=false;
1500
1418
var_cst=NULL_CEWI;
1501
1419
1502
1503
1420
// get shape from RHS
1504
1421
var1=out(vid2->getNextSibling());
1505
1422
(void)nco_free(var1->nm);
1527
1444
var_sct *var1;
1528
1445
NcapVar *Nvar;
1529
1446
1530
if(dbg_lvl_get() > 0)
1531
dbg_prn(fnc_nm,att2->getText());
1532
1447
if(nco_dbg_lvl_get() > nco_dbg_var) dbg_prn(fnc_nm,att2->getText());
1533
1448
1534
1449
var1=ncap_var_udf(att2->getText().c_str());
1535
1450
1543
1458
1544
1459
; // end assign block
1545
1460
1546
1547
1461
assign [bool bram] returns [var_sct *var]
1548
1462
{
1549
1463
const std::string fnc_nm("assign");
1572
1486
1573
1487
var_nm=vid->getText();
1574
1488
1575
if(dbg_lvl_get() > 0)
1576
dbg_prn(fnc_nm,var_nm+"(limits)");
1577
1489
if(nco_dbg_lvl_get() >= nco_dbg_var) dbg_prn(fnc_nm,var_nm+"(limits)");
1578
1490
1579
1491
// check to see if we are dealing with a single
1580
1492
// index in limit -- i.e hyperslab a mult-dimensional var
1595
1507
// Overwrite bram possibly
1596
1508
if(Nvar)
1597
1509
bram=Nvar->flg_mem;
1598
1599
1510
1600
1511
// Deal with RAM variables
1601
1512
if(bram) {
1602
1603
1513
1604
1514
if(Nvar && Nvar->flg_stt==1){
1605
1515
var_sct *var_ini;
1613
1523
if(Nvar && Nvar->flg_stt==2)
1614
1524
var_lhs=Nvar->var;
1615
1525
1616
1617
1526
if(!Nvar)
1618
1527
var_lhs=prs_arg->ncap_var_init(var_nm,true);
1619
1620
1528
1621
1529
nbr_dmn=var_lhs->nbr_dim;
1622
1530
1624
1532
if( lmt_mk(lmt_Ref,lmt_vtr) == 0)
1625
1533
err_prn(fnc_nm,"Invalid hyperslab limits for variable "+ var_nm);
1626
1534
1627
1628
1535
if( lmt_vtr.size() != nbr_dmn)
1629
1536
err_prn(fnc_nm,"Number of hyperslab limits for variable "+ var_nm+" doesn't match number of dimensions");
1630
1631
1537
1632
1538
// add dim names to dimension list
1633
1539
for(idx=0 ; idx < nbr_dmn;idx++)
1634
1540
lmt_vtr[idx]->nm=strdup(var_lhs->dim[idx]->nm);
1635
1636
1541
1637
1542
slb_sz=1;
1638
1543
// fill out limit structure
1650
1555
if(var_rhs->sz == 1)
1651
1556
(void)ncap_att_stretch(var_rhs,slb_sz);
1652
1557
1653
1654
1558
// make sure var_lhs and var_rhs are the same size
1655
1559
// and that they are the same shape (ie they conform!!)
1656
1560
if(var_rhs->sz != slb_sz){
1660
1564
(void)nco_put_var_mem(var_rhs,var_lhs,lmt_vtr);
1661
1565
if(Nvar==NULL)
1662
1566
(void)prs_arg->ncap_var_write(var_lhs,true);
1663
1664
1665
1567
1666
1568
// deal with Regular Vars
1667
1569
} else {
1668
1570
1669
1670
1571
// if var undefined in O or defined but not populated
1671
1572
if(!Nvar || ( Nvar && Nvar->flg_stt==1)){
1672
1573
// if var isn't in ouptut then copy it there
1689
1590
if( lmt_mk(lmt_Ref,lmt_vtr) == 0)
1690
1591
err_prn(fnc_nm,"Invalid hyperslab limits for variable "+ var_nm);
1691
1592
1692
1693
1593
if( lmt_vtr.size() != nbr_dmn)
1694
1594
err_prn(fnc_nm,"Number of hyperslab limits for variable "+ var_nm+" doesn't match number of dimensions");
1695
1696
1595
1697
1596
// add dim names to dimension list
1698
1597
for(idx=0 ; idx < nbr_dmn;idx++)
1699
1598
lmt_vtr[idx]->nm=strdup(var_lhs->dim[idx]->nm);
1700
1701
1599
1702
1600
var_lhs->sz=1;
1703
1601
// fill out limit structure
1722
1620
if(var_rhs->sz != var_lhs->sz){
1723
1621
err_prn(fnc_nm, "Hyperslab for "+var_nm+" - number of elements on LHS(" +nbr2sng(var_lhs->sz) + ") doesn't equal number of elements on RHS(" +nbr2sng(var_rhs->sz) + ")");
1724
1622
}
1725
1726
1623
1727
1624
// swap values about
1728
1625
var_lhs->val.vp=var_rhs->val.vp;
1744
1641
1745
1642
} // end put block !!
1746
1643
1747
1748
1749
1644
} // end else if regular var
1750
1645
1751
1752
1646
var_rhs=nco_var_free(var_rhs);
1753
1647
1754
1755
1648
// Empty and free vector
1756
1649
for(idx=0 ; idx < nbr_dmn ; idx++)
1757
1650
(void)nco_lmt_free(lmt_vtr[idx]);
1762
1655
else
1763
1656
var=prs_arg->ncap_var_init(var_nm,true);
1764
1657
1765
1766
1658
} // end action
1767
1659
1768
1769
1660
// Deal with LHS casting
1770
1661
| (#(VAR_ID DMN_LIST ))=> #(vid1:VAR_ID dmn:DMN_LIST){
1771
1662
1776
1667
1777
1668
var_nm=vid1->getText();
1778
1669
1779
if(dbg_lvl_get() > 0)
1780
dbg_prn(fnc_nm,var_nm+"[dims]");
1781
1670
if(nco_dbg_lvl_get() >= nco_dbg_var) dbg_prn(fnc_nm,var_nm+"[dims]");
1782
1671
1783
1672
// set class wide variables
1784
1673
bcst=true;
1785
1674
var_cst=NULL_CEWI;
1786
1675
1787
1788
1676
//aRef=vid->getFirstChild()->getFirstChild();
1789
1677
aRef=dmn->getFirstChild();
1790
1678
1806
1694
// If the RHS has size one or is an attribute or an irregular hyperslab
1807
1695
// then we neet to use the var_cst as the shape of the written variable.
1808
1696
// It is possible for the cast on the LHS to have a size of one and the RHS
1809
// to have a size of one e.g if the dim(s) in the list have a size of one
1697
// to have a size of one e.g., if the dim(s) in the list have a size of one
1810
1698
bool br1=(var_cst->sz >=1 && var1->sz==1);
1811
1699
bool br2=(var_cst->sz==var1->sz && ( ncap_var_is_att(var1) ||var1->has_dpl_dmn==-1 ));
1812
1813
1814
1700
1815
1701
// The code rebuilds var1 with the shape from the casting variable
1816
1702
if( br1 || br2){
1832
1718
1833
1719
//blow out if vars not the same size
1834
1720
if(var1->sz != var_cst->sz)
1835
err_prn(fnc_nm, "LHS cast for "+var_nm+" - cannot make RHS "+ std::string(var1->nm) + " conform.");
1836
1721
err_prn(fnc_nm, "LHS cast for "+var_nm+" - cannot make RHS "+ std::string(var1->nm) + " conform.");
1837
1722
var1->nm=(char*)nco_free(var1->nm);
1838
1839
1723
var1->nm =strdup(var_nm.c_str());
1840
1724
1841
1842
1843
1725
// See If we have to return something
1844
1726
if(dmn->getNextSibling() && dmn->getNextSibling()->getType()==NORET)
1845
1727
var=NULL_CEWI;
1846
1728
else
1847
1729
var=nco_var_dpl(var1);
1848
1730
1849
1850
1851
1731
//call to nco_var_get() in ncap_var_init() uses this property
1852
1732
var1->typ_dsk=var1->type;
1853
1733
(void)prs_arg->ncap_var_write(var1,bram);
1855
1735
bcst=false;
1856
1736
var_cst=nco_var_free(var_cst);
1857
1737
1858
1859
1738
} // end action
1860
1739
1861
1740
| vid2:VAR_ID {
1866
1745
1867
1746
var_nm=vid2->getText();
1868
1747
1869
if(dbg_lvl_get() > 0)
1870
dbg_prn(fnc_nm,var_nm);
1871
1872
1748
if(nco_dbg_lvl_get() >= nco_dbg_var) dbg_prn(fnc_nm,var_nm);
1873
1749
1874
1750
bcst=false;
1875
1751
var_cst=NULL_CEWI;
1907
1783
(void)prs_arg->ncap_var_write(var1,bram);
1908
1784
//(void)ncap_var_write_omp(var1,bram,prs_arg);
1909
1785
1910
1911
1786
// See If we have to return something
1912
1787
if(vid2->getFirstChild() && vid2->getFirstChild()->getType()==NORET)
1913
1788
var=NULL_CEWI;
1914
1789
else
1915
1790
var=prs_arg->ncap_var_init(var_nm,true); ;
1916
1917
1791
1918
1792
} // end action
1919
1793
1928
1802
var_sct *var1;
1929
1803
string sa=att2->getText();
1930
1804
1931
if(dbg_lvl_get() > 0)
1932
dbg_prn(fnc_nm,sa);
1805
if(nco_dbg_lvl_get() >= nco_dbg_var) dbg_prn(fnc_nm,sa);
1933
1806
1934
1807
var1=out(att2->getNextSibling());
1935
1808
1950
1823
NcapVar *Nvar=new NcapVar(var1,sa);
1951
1824
prs_arg->var_vtr.push_ow(Nvar);
1952
1825
1953
1954
1826
// See If we have to return something
1955
1827
if(att2->getFirstChild() && att2->getFirstChild()->getType()==NORET)
1956
1828
var=NULL_CEWI;
1960
1832
} // end action
1961
1833
;
1962
1834
1963
1964
1835
out returns [var_sct *var]
1965
1836
{
1966
1837
const std::string fnc_nm("out");
1996
1867
{var=ncap_var_var_op(var1,var2, MOD);}
1997
1868
| #(CARET var1=out var2=out)
1998
1869
{var=ncap_var_var_op(var1,var2, CARET);}
1999
2000
1870
//unary Operators
2001
1871
| #(LNOT var1=out )
2002
1872
{ var=ncap_var_var_op(var1,NULL_CEWI, LNOT );}
2015
1885
| #(POST_DEC var1=out_asn ){
2016
1886
var=ncap_var_var_inc(var1,NULL_CEWI,POST_DEC,false,prs_arg);
2017
1887
}
2018
2019
1888
// Logical Operators
2020
1889
| #(LAND var1=out var2=out)
2021
1890
{ var=ncap_var_var_op(var1,var2, LAND );}
2034
1903
{ var=ncap_var_var_op(var1,var2, EQ );}
2035
1904
| #(NEQ var1=out var2=out)
2036
1905
{ var=ncap_var_var_op(var1,var2, NEQ );}
2037
2038
1906
// Fortran style Comparison Operators
2039
1907
| #(FLTHAN var1=out var2=out)
2040
1908
{ var=ncap_var_var_op(var1,var2, FLTHAN );}
2041
1909
| #(FGTHAN var1=out var2=out)
2042
1910
{ var=ncap_var_var_op(var1,var2, FGTHAN );}
2043
2044
1911
// Assign Operators
2045
1912
| #(PLUS_ASSIGN pls_asn:. var2=out) {
2046
1913
var1=out_asn(pls_asn);
2088
1955
err_prn(fnc_nm,serr );
2089
1956
}
2090
1957
2091
2092
2093
1958
if(prs_arg->ntl_scn)
2094
1959
var=assign_ntl(tr,bram);
2095
1960
else
2098
1963
}
2099
1964
| #(WHERE_ASSIGN wasn:. ) {
2100
1965
2101
2102
1966
}
2103
1967
2104
1968
//ternary Operator
2118
1982
}
2119
1983
var1=nco_var_free(var1);
2120
1984
}
2121
2122
1985
2123
1986
// Functions
2124
1987
| #(m:FUNC args:FUNC_ARG) {
2125
RefAST tr;
2126
std::string sfnm(m->getText());
2127
std::vector<fmc_cls>::iterator we=std::lower_bound(prs_arg->fmc_vtr.begin(),prs_arg->fmc_vtr.end(),fmc_cls(sfnm));
2128
// see if string found
2129
if( we->fnm() == sfnm){
2130
//Call function
2131
var=we->vfnc()->fnd(tr ,args, *we,*this);
2132
} else {
2133
std::cout << "Function " << sfnm << " not found" <<std::endl;
2134
exit(1);
2135
}
2136
}
1988
// The lexer has appended the index of the function to the function name m - (name#index)
1989
// the index is into fmc_vtr
1990
string sm(m->getText());
1991
string sdx(sm,sm.find("#")+1,sm.length()-1) ;
1992
int idx=atoi(sdx.c_str());
1993
RefAST tr;
1994
var=prs_arg->fmc_vtr[idx].vfnc()->fnd(tr ,args, prs_arg->fmc_vtr[idx],*this);
1995
}
2137
1996
2138
1997
// Deal with methods
2139
1998
| #(DOT mtd:. mfnc:FUNC margs:FUNC_ARG ){
2140
std::string sfnm(mfnc->getText());
2141
std::vector<fmc_cls>::iterator we=std::lower_bound(prs_arg->fmc_vtr.begin(),prs_arg->fmc_vtr.end(),fmc_cls(sfnm));
2142
// see if string found
2143
if( we->fnm() == sfnm){
2144
//Call function
2145
var=we->vfnc()->fnd(mtd ,margs, *we,*this);
2146
} else {
2147
std::cout << "Method " << sfnm << " not found" <<std::endl;
2148
exit(1);
2149
}
1999
// The lexer has appended the index of the function to the function name m - (name#index)
2000
// the index is into fmc_vtr
2001
string sm(mfnc->getText());
2002
string sdx(sm,sm.find("#")+1,sm.length()-1) ;
2003
int idx=atoi(sdx.c_str());
2004
var=prs_arg->fmc_vtr[idx].vfnc()->fnd(mtd ,margs, prs_arg->fmc_vtr[idx],*this);
2150
2005
}
2151
2006
2152
2007
| dval:DIM_ID_SIZE
2169
2024
#ifndef NC_MAX_INT
2170
2025
# define NC_MAX_INT 2147483647
2171
2026
#endif
2172
2173
2027
//Initial Scan
2174
2028
if(prs_arg->ntl_scn){
2175
2029
if( (dmn_fd==NULL_CEWI )|| (dmn_fd->sz <= NC_MAX_INT) )
2189
2043
var=ncap_sclr_var_mk(static_cast<std::string>("~dmn"),(nco_int64)dmn_fd->sz);
2190
2044
}
2191
2045
2192
2193
2194
2046
} // end action
2195
2047
2196
2048
// Variable with argument list
2222
2074
// apply cast only if sz >1
2223
2075
if(bcst && var->sz >1)
2224
2076
var=ncap_cst_do(var,var_cst,prs_arg->ntl_scn);
2225
2226
2227
2077
} /* end action */
2228
2078
2229
2079
// PLain attribute
2252
2102
if(prs_arg->ntl_scn && var==NULL_CEWI )
2253
2103
var=ncap_var_udf(att->getText().c_str());
2254
2104
2255
2256
2105
if(prs_arg->ntl_scn && var->val.vp !=NULL)
2257
2106
var->val.vp=(void*)nco_free(var->val.vp);
2258
2107
2286
2135
tsng=(char*)nco_free(tsng);
2287
2136
}
2288
2137
2289
2290
2138
| str1:N4STRING
2291
2139
{
2292
2140
char *tsng;
2293
2141
2294
2295
2142
tsng=strdup(str1->getText().c_str());
2296
2143
(void)sng_ascii_trn(tsng);
2297
2144
var=(var_sct *)nco_malloc(sizeof(var_sct));
2313
2160
var->val.sngp[0]=strdup(tsng);
2314
2161
2315
2162
(void)cast_nctype_void((nc_type)NC_STRING,&var->val);
2316
2317
2318
2163
}
2319
2164
tsng=(char*)nco_free(tsng);
2320
2165
}
2321
2166
2322
2323
2324
2167
// Naked numbers: Cast is not applied to these numbers
2325
2168
| val_float:FLOAT
2326
2169
{if(prs_arg->ntl_scn) var=ncap_sclr_var_mk(static_cast<std::string>("~float"),(nc_type)NC_FLOAT,false); else var=ncap_sclr_var_mk(static_cast<std::string>("~float"),static_cast<float>(std::strtod(val_float->getText().c_str(),(char **)NULL)));} // end FLOAT
2385
2228
nco_exit(EXIT_FAILURE);
2386
2229
}
2387
2230
2388
2389
2390
2231
} /* end action */
2391
2232
// Plain attribute
2392
2233
| att:ATT_ID {
2409
2250
else
2410
2251
var=ncap_att_init(att->getText(),prs_arg);
2411
2252
2412
2413
2253
if(!prs_arg->ntl_scn && var==NULL_CEWI ){
2414
2254
err_prn(fnc_nm,"Unable to locate attribute " +att->getText()+ " in input or output files.");
2415
2255
}
2417
2257
// if att not found return undefined
2418
2258
if(prs_arg->ntl_scn && var==NULL_CEWI )
2419
2259
var=ncap_var_udf(att->getText().c_str());
2420
2421
2260
2422
2261
if(prs_arg->ntl_scn && var->val.vp !=NULL)
2423
2262
var->val.vp=(void*)nco_free(var->val.vp);
2424
2263
2425
2426
2264
}// end action
2427
2265
;
2428
2266
2429
2430
2267
value_list returns [var_sct *var]
2431
2268
{
2432
2269
const std::string fnc_nm("value_list");
2438
2275
int nbr_lst;
2439
2276
int idx;
2440
2277
int tsz;
2441
2442
2278
2443
2279
nc_type type=NC_NAT;
2444
2280
var_sct *var_ret;
2460
2296
goto end_val;
2461
2297
}
2462
2298
2463
2464
2299
// find highest type
2465
2300
for(idx=0;idx <nbr_lst ;idx++)
2466
2301
type=ncap_typ_hgh(type,exp_vtr[idx]->type);
2467
2302
//(void)ncap_var_retype(exp_vtr[0], exp_vtr[idx]);
2468
2303
2469
2470
2304
// Inital Scan
2471
2305
if(prs_arg->ntl_scn){
2472
2306
2514
2348
cp=(char*)(var_ret->val.vp)+ (ptrdiff_t)(idx*tsz);
2515
2349
memcpy(cp,exp_vtr[idx]->val.vp,tsz);
2516
2350
}
2517
2518
2351
2519
2352
// Free vector
2520
2353
end_val: for(idx=0 ; idx < nbr_lst ; idx++)
2521
2354
(void)nco_var_free(exp_vtr[idx]);
2523
2356
var=var_ret;
2524
2357
2525
2358
} // end action
2526
2527
2359
;
2528
2360
2529
2530
2361
// Deal here with a value list of strings
2531
2362
// Called only from value_list
2532
2363
value_list_string[ std::vector<var_sct*> &exp_vtr] returns [var_sct *var]
2542
2373
nco_string *cp;
2543
2374
var_sct *var_ret;
2544
2375
2545
2546
2376
nbr_lst=exp_vtr.size();
2547
2548
2549
2377
var_ret=(var_sct *)nco_malloc(sizeof(var_sct));
2550
2378
/* Set defaults */
2551
2379
(void)var_dfl_set(var_ret);
2556
2384
var_ret->sz=nbr_lst;
2557
2385
var_ret->type=(nc_type)NC_STRING;
2558
2386
2559
2560
2561
2387
// Inital Scan
2562
2388
if(prs_arg->ntl_scn)
2563
2389
goto end_val;
2566
2392
for(idx=0; idx<nbr_lst ; idx++)
2567
2393
if( exp_vtr[idx]->type != NC_STRING)
2568
2394
err_prn(fnc_nm," error processing value list string: to successfully parse value list of strings all elements must be of type NC_STRING");
2569
2570
2395
2571
2396
// from here on deal with final scan
2572
2397
tsz=nco_typ_lng((nc_type)NC_STRING);
2573
2398
var_ret->val.vp=(void*)nco_malloc(nbr_lst*tsz);
2574
2575
2399
2576
2400
(void)cast_void_nctype((nc_type)NC_STRING,&var_ret->val);
2577
2401
cp=var_ret->val.sngp;
2586
2410
} // end loop
2587
2411
2588
2412
(void)cast_nctype_void((nc_type)NC_STRING,&var_ret->val);
2589
2590
2413
2591
2414
end_val: var=var_ret;
2592
2415
2593
2416
}// end action
2594
2595
2417
;
2596
2418
2597
2598
2419
//where calculate
2599
2420
where_assign [var_sct *var_msk] returns [bool bret]
2600
2421
{
2662
2483
bool b_vp=false;
2663
2484
char *mss_cp;
2664
2485
2665
2666
2486
sz=var_lhs->sz;
2667
2487
slb_sz=nco_typ_lng(var_lhs->type);
2668
2488
2723
2543
// free "local" copy of var_msk if necessary
2724
2544
if(bfr)
2725
2545
var_msk=nco_var_free(var_msk);
2726
2727
2546
2728
2547
// Do attribute propagation if LHS is new
2729
2548
Nvar=prs_arg->var_vtr.find(var_nm);
2734
2553
2735
2554
prs_arg->ncap_var_write(var_lhs,false);
2736
2555
bret=true;
2737
2738
2556
}
2739
2557
;
2740
2558
2741
2742
2559
//Calculate scalar hyperslab where there is a single limit for a possibly
2743
2560
// multi-dimensional variable
2744
2561
var_lmt_one returns [var_sct *var]
2753
2570
var_sct *var_rhs;
2754
2571
std::string var_nm;
2755
2572
2756
2757
2573
var_nm=vid->getText();
2758
2574
var_rhs=prs_arg->ncap_var_init(var_nm,false);
2759
2575
2762
2578
goto end0; // cannot use return var!!
2763
2579
}
2764
2580
2765
2766
2767
2581
if(prs_arg->ntl_scn){
2768
2582
var=ncap_sclr_var_mk(var_nm,(nc_type)(var_rhs->type),false);
2769
2583
}else{
2787
2601
srt=var_nbr->val.ip[0];
2788
2602
(void)cast_nctype_void(NC_INT,&var_nbr->val);
2789
2603
2790
2791
2604
// fortran index convention
2792
2605
if(prs_arg->FORTRAN_IDX_CNV)
2793
2606
srt--;
2794
2607
else if ( srt<0)
2608
srt+=var_rhs->sz-1; // deal with negative index
2609
2795
2610
// do some bounds checking
2796
2611
if(srt >= var_rhs->sz || srt<0 )
2797
2612
err_prn(fnc_nm,"Limit of "+ nbr2sng(srt) +" for variable \""+ var_nm+"\" with size="+nbr2sng(var_rhs->sz)+" is out of bounds\n");
2828
2643
fl_id=prs_arg->in_id;
2829
2644
}
2830
2645
2831
2832
2646
// convert srt into multiple indices
2833
2647
for(idx=0;idx<nbr_dim;idx++)
2834
2648
sz_dim*= var_rhs->cnt[idx];
2844
2658
2845
2659
// copy missing value if any over
2846
2660
nco_mss_val_cp(var_rhs,var);
2847
2848
2661
2849
2662
} // end else !prs_arg->ntl_scn
2850
2851
2852
2853
2663
2854
2664
end0: var_nbr=nco_var_free(var_nbr);
2855
2665
var_rhs=nco_var_free(var_rhs);
2856
2857
2666
}
2858
2859
2667
;
2860
2668
2861
2862
2863
2669
//Calculate scalar LHS hyperslab where there is a single limit for a possibly
2864
2670
// multi-dimensional variable
2865
2671
var_lmt_one_lhs[bool bram] returns [var_sct *var]
2879
2685
var_sct *var_lhs=NULL_CEWI;
2880
2686
var_sct *var_rhs=NULL_CEWI;
2881
2687
NcapVar *Nvar;
2882
2883
2688
2884
2689
var_nm=vid->getText();
2885
2690
2886
if(dbg_lvl_get() > 1)
2887
dbg_prn(fnc_nm,var_nm+"(limit)");
2691
if(nco_dbg_lvl_get() > nco_dbg_var) dbg_prn(fnc_nm,var_nm+"(limit)");
2888
2692
2889
2693
Nvar=prs_arg->var_vtr.find(var_nm);
2890
2694
2894
2698
srt=var_nbr->val.ip[0];
2895
2699
(void)cast_nctype_void(NC_INT,&var_nbr->val);
2896
2700
2897
// fortran index convention
2898
if(prs_arg->FORTRAN_IDX_CNV)
2899
srt--;
2900
2901
2902
2903
2701
// Overwrite bram possibly
2904
2702
if(Nvar)
2905
2703
bram=Nvar->flg_mem;
2906
2704
2907
2908
2705
// Deal with RAM variables
2909
2706
if(bram){
2910
2707
2924
2721
2925
2722
}else{
2926
2723
var_lhs=prs_arg->ncap_var_init(var_nm,true);
2927
}
2724
}
2928
2725
2929
2726
// fortran index convention
2727
if(prs_arg->FORTRAN_IDX_CNV)
2728
srt--;
2729
else if(srt<0) srt+=var_lhs->sz-1; //deal with negative index convention
2730
2930
2731
// do some bounds checking on single limits
2931
2732
if(srt >= var_lhs->sz || srt<0 )
2932
2733
err_prn(fnc_nm,"Limit of "+ nbr2sng(srt) +" for variable \""+ var_nm+"\" with size="+nbr2sng(var_lhs->sz)+" is out of bounds\n");
2948
2749
if(!Nvar)
2949
2750
(void)prs_arg->ncap_var_write(var_lhs,true);
2950
2751
2951
2952
2953
2752
// deal with regular vars
2954
2753
}else{
2955
2754
2964
2763
}
2965
2764
2966
2765
var_lhs=prs_arg->ncap_var_init(var_nm,false);
2967
2766
2767
// fortran index convention
2768
if(prs_arg->FORTRAN_IDX_CNV)
2769
srt--;
2770
else if(srt<0) srt+=var_lhs->sz-1; //deal with negative index convention
2968
2771
2969
2772
// do some bounds checking on single limits
2970
2773
if(srt >= var_lhs->sz || srt<0 )
2999
2802
srt1[idx]=srt/sz_dim;
3000
2803
srt-=srt1[idx]*sz_dim;
3001
2804
}
3002
3003
2805
3004
2806
for(idx=0;idx<nbr_dim;idx++){
3005
2807
var_lhs->srt[idx]=srt1[idx];
3006
2808
var_lhs->cnt[idx]=1L;
3007
2809
var_lhs->srd[idx]=1L;
3008
2810
} /* end loop over idx */
3009
3010
2811
3011
2812
// write slab to O contains call to Open MP critical region
3012
2813
// routine also frees up var_lhs
3017
2818
var_rhs=nco_var_free(var_rhs);
3018
2819
var_nbr=nco_var_free(var_nbr);
3019
2820
}
3020
3021
2821
;
3022
2822
3023
3024
2823
//Calculate var with limits
3025
2824
var_lmt returns [var_sct *var]
3026
2825
{
3045
2844
NcapVector<lmt_sct*> lmt_vtr;
3046
2845
NcapVector<dmn_sct*> dmn_vtr;
3047
2846
NcapVector<std::string> dmn_nrm_vtr; // list of dimension names
3048
3049
2847
3050
2848
var_nm=vid->getText();
3051
2849
var_rhs=prs_arg->ncap_var_init(var_nm,false);
3058
2856
nbr_dmn=var_rhs->nbr_dim;
3059
2857
lRef=lmt;
3060
2858
3061
3062
2859
if(prs_arg->ntl_scn){
3063
2860
// check limit only contains numbers or dim_id.size()
3064
2861
std::vector<std::string> str_vtr;
3078
2875
3079
2876
if( lmt_vtr.size() != nbr_dmn)
3080
2877
err_prn(fnc_nm,"Number of hyperslab limits for variable "+ var_nm+" doesn't match number of dimensions");
3081
3082
2878
3083
2879
// add dim names to dimension list
3084
2880
for(idx=0 ; idx < nbr_dmn;idx++)
3088
2884
for(idx=0 ; idx < nbr_dmn ;idx++)
3089
2885
(void)ncap_lmt_evl(var_rhs->nc_id,lmt_vtr[idx],prs_arg);
3090
2886
3091
3092
2887
// See if var can be normalized
3093
2888
for(idx=0; idx<nbr_dmn ; idx++){
3094
2889
if(lmt_vtr[idx]->cnt==1) continue;
3101
2896
3102
2897
bnrm= (idx==nbr_dmn ? true:false);
3103
2898
3104
3105
3106
2899
// deal more with inital scan
3107
2900
if(prs_arg->ntl_scn){
3108
2901
3118
2911
// apply LHS cast if necessary
3119
2912
if(var->sz>1 && bcst)
3120
2913
var=ncap_cst_do(var,var_cst,prs_arg->ntl_scn);
3121
3122
2914
}else{
3123
2915
var=ncap_var_udf("~rhs_undefined");
3124
2916
}
3125
3126
2917
goto end1;
3127
2918
}
3128
2919
3129
3130
2920
/**** From here on we are dealing with a final scan ****/
3131
3132
2921
// copy lmt_sct to dmn_sct;
3133
2922
for(idx=0 ;idx <nbr_dmn ; idx++){
3134
2923
dmn_sct *dmn_nw;
3153
2942
else
3154
2943
bram=false;
3155
2944
3156
3157
2945
// Ram variable -do an in memory get
3158
2946
if(bram){
3159
2947
var=prs_arg->ncap_var_init(var_nm,true);
3192
2980
3193
2981
} // end if(nbram)
3194
2982
3195
3196
2983
// copy missing value over
3197
2984
nco_mss_val_cp(var_rhs,var);
3198
3199
2985
3200
2986
/* a hack - we set var->has_dpl_dmn=-1 so we know we are dealing with
3201
a hyperslabed var and not a regular var -- It shouldn't cause
2987
a hyperslabbed var and not a regular var -- It shouldn't cause
3202
2988
any abberant behaviour!! */
3203
2989
var->has_dpl_dmn=-1;
3204
2990
3205
3206
3207
3208
2991
// if variable is scalar re-organize in a new var
3209
2992
// loose extraneous material so it looks like a
3210
2993
// plain scalar variable
3213
2996
var1=ncap_sclr_var_mk(var_nm,var->type,true);
3214
2997
(void)memcpy( (void*)var1->val.vp,var->val.vp,nco_typ_lng(var1->type));
3215
2998
3216
3217
2999
// copy missing value if any from var_rhs to var1
3218
3000
nco_mss_val_cp(var_rhs,var1);
3219
3001
3222
3004
3223
3005
var=var1;
3224
3006
3225
3226
3227
3228
3007
// if hyperslab -nomalizable
3229
3008
// nb the returned var is just like a regular var
3230
3009
}else if(bnrm) {
3233
3012
var1=ncap_cst_mk(dmn_nrm_vtr,prs_arg);
3234
3013
(void)nco_free(var1->nm);
3235
3014
3236
3237
3015
var1->nm=strdup(var_nm.c_str());
3238
3016
var1=nco_var_cnf_typ(var_rhs->type,var1);
3239
3017
3274
3052
var->dim[idx]=prs_arg->dmn_out_vtr.find(dmn_vtr[idx]->nm);
3275
3053
3276
3054
}
3277
3278
3279
3280
3055
3281
3056
//free vectors
3282
3283
3057
for(idx=0 ; idx < nbr_dmn ; idx++)
3284
3058
(void)nco_dmn_free(dmn_vtr[idx]);
3285
3059
;
3286
3287
3060
3288
3061
end1: ;
3289
3062
for(idx=0 ; idx < nbr_dmn ; idx++)
3290
3063
(void)nco_lmt_free(lmt_vtr[idx]);
3291
3064
3292
3293
3065
end2: var_rhs=nco_var_free(var_rhs);
3294
3295
3066
}
3296
3297
3067
;
Loggerhead is a web-based interface for Breezy
Version: 2.0.1