tools/misc.c

   1 #include <stdio.h>
   2 #include <stdlib.h>
   3 #include <string.h>
   4 #ifdef _WIN32
   5 # define rindex(X,Y) strrchr(X,Y)
   6 # define index(X,Y) strchr(X,Y)
   7 #else
   8 # include <strings.h>
   9 #endif
  10
  11 #include "protos.h"
  12 #include "registry.h"
  13 #include "data.h"
  14
  15 char *
  16 dimension_with_colons( char * pre , char * tmp , node_t * p , char * post )
  17 {
  18   int i ;
  19   if ( p == NULL ) return("") ;
  20   if ( p->ndims <= 0 && ! p->boundary_array ) return("") ;
  21   strcpy(tmp,"") ;
  22   if ( pre != NULL ) strcat(tmp,pre) ;
  23   if ( p->boundary_array )
  24   {
  25     if ( ! sw_new_bdys ) { strcat( tmp,":,") ; }
  26     if ( !strcmp( p->use , "_4d_bdy_array_" ) ) {
  27       strcat( tmp, ":,:,:,:" ) ;  /* boundary array for 4d tracer array */
  28     } else {
  29       strcat( tmp, ":,:,:" ) ;  /* most always have four dimensions */
  30     }
  31   }
  32   else
  33   {
  34     for ( i = 0 ; i < p->ndims ; i++ ) strcat(tmp,":,") ;
  35     if ( p->node_kind & FOURD ) strcat(tmp,":,") ;       /* add an extra for 4d arrays */
  36     tmp[strlen(tmp)-1] = '\0' ;
  37   }
  38   if ( post != NULL ) strcat(tmp,post)  ;
  39   return(tmp) ;
  40 }
  41
  42 char *
  43 dimension_with_ones( char * pre , char * tmp , node_t * p , char * post )
  44 {
  45   int i ;
  46   char r[NAMELEN],s[NAMELEN],four_d[NAMELEN] ;
  47   char *pp ;
  48   if ( p == NULL ) return("") ;
  49   if ( p->ndims <= 0 && ! p->boundary_array ) return("") ;
  50   strcpy(tmp,"") ;
  51   if ( pre != NULL ) strcat(tmp,pre) ;
  52
  53   if ( p->boundary_array )
  54   {
  55     if ( ! sw_new_bdys ) { strcpy( tmp,"(1,") ; }
  56     if ( !strcmp( p->use , "_4d_bdy_array_" ) ) {   /* if a boundary array for a 4d tracer */
  57       strcpy(s, p->name ) ;  /* copy the name and then remove everything after last underscore */
  58       if ((pp=rindex( s, '_' )) != NULL ) *pp = '\0' ;
  59       sprintf( four_d, "num_%s,", s  ) ;
  60     } else {
  61       strcpy( four_d, "" ) ;
  62     }
  63
  64     if ( !strcmp( p->use , "_4d_bdy_array_" ) ) {
  65       sprintf( r, "1,1,1,%s", four_d ) ;  /* boundary array for 4d tracer array */
  66       strcat( tmp, r ) ;
  67     } else {
  68       strcat( tmp, "1,1,1," ) ;
  69     }
  70     tmp[strlen(tmp)-1] = '\0' ;
  71   }
  72   else
  73   {
  74     for ( i = 0 ; i < p->ndims ; i++ ) strcat(tmp,"1,") ;
  75     if ( p->node_kind & FOURD ) strcat(tmp,"1,") ;       /* add an extra for 4d arrays */
  76     tmp[strlen(tmp)-1] = '\0' ;
  77   }
  78   if ( post != NULL ) strcat(tmp,post)  ;
  79   return(tmp) ;
  80 }
  81
  82 char *
  83 dimension_with_ranges( char * refarg , char * pre ,
  84                        int bdy , /* as defined in data.h */
  85                        char * tmp , node_t * p , char * post ,
  86                        char * nlstructname  )   /* added 20020130;
  87                                                    provides name (with %) of structure in
  88                                                    which a namelist supplied dimension
  89                                                    should be dereference from, or ""  */
  90 {
  91   int i ;
  92   char tx[NAMELEN] ;
  93   char r[NAMELEN],s[NAMELEN],four_d[NAMELEN] ;
  94   int   bdex, xdex, ydex, zdex ;
  95   node_t *xdim, *ydim, *zdim ;
  96   char *pp ;
  97   if ( p == NULL ) return("") ;
  98   if ( p->ndims <= 0 && !p->boundary_array ) return("") ;
  99   strcpy(tmp,"") ;
 100   if ( pre != NULL ) strcat(tmp,pre) ;
 101   strcpy(r,"") ;
 102   if ( refarg != NULL ) strcat(r,refarg) ;
 103
 104   if ( p->boundary_array )
 105   {
 106     if ( p->ndims > 0 )
 107     {
 108       xdim = get_dimnode_for_coord( p , COORD_X ) ;
 109       ydim = get_dimnode_for_coord( p , COORD_Y ) ;
 110       zdim = get_dimnode_for_coord( p , COORD_Z ) ;
 111       if ( ydim == NULL )
 112        { fprintf(stderr,"dimension_with_ranges: y dimension not specified for %s\n",p->name) ; return("") ; }
 113       if ( xdim == NULL )
 114        { fprintf(stderr,"dimension_with_ranges: x dimension not specified for %s\n",p->name) ; return("") ; }
 115
 116       xdex = xdim->dim_order ;
 117       ydex = ydim->dim_order ;
 118
 119       if ( !strcmp( p->use , "_4d_bdy_array_" ) ) {   /* if a boundary array for a 4d tracer */
 120         strcpy(s, p->name ) ;  /* copy the name and then remove everything after last underscore */
 121         if ((pp=rindex( s, '_' )) != NULL ) *pp = '\0' ;
 122         sprintf( four_d, "num_%s,", s  ) ;
 123       } else {
 124         strcpy( four_d, "" ) ;
 125       }
 126       if ( sw_new_bdys ) {
 127         if      ( bdy == P_XSB || bdy == P_XEB ) { bdex = ydex ; }
 128         else if ( bdy == P_YSB || bdy == P_YEB ) { bdex = xdex ; }
 129         else { fprintf(stderr,"REGISTRY WARNING: internal error %s %d, bdy=%d,%s,%d \n",__FILE__,__LINE__,bdy,p->name,p->boundary) ; }
 130         if ( zdim != NULL ) {
 131           zdex = zdim->dim_order ;
 132           sprintf(tx,"%ssm3%d:%sem3%d,%ssm3%d:%sem3%d,%sspec_bdy_width,%s", r,bdex,r,bdex,r,zdex,r,zdex,r,four_d ) ;
 133         } else {
 134           sprintf(tx,"%ssm3%d:%sem3%d,1,%sspec_bdy_width,%s", r,bdex,r,bdex,r,four_d ) ;
 135         }
 136       } else {
 137         if ( zdim != NULL ) {
 138           zdex = zdim->dim_order ;
 139           sprintf(tx,"max(%sed3%d,%sed3%d),%ssd3%d:%sed3%d,%sspec_bdy_width,4,%s", r,xdex,r,ydex,r,zdex,r,zdex,r,four_d ) ;
 140         } else {
 141           sprintf(tx,"max(%sed3%d,%sed3%d),1,%sspec_bdy_width,4,%s", r,xdex,r,ydex,r,four_d ) ;
 142         }
 143       }
 144     }
 145     else
 146     {
 147       sprintf(tx,"%sspec_bdy_width,",r ) ;
 148     }
 149     strcat(tmp,tx) ;
 150   }
 151   else
 152   {
 153     for ( i = 0 ; i < p->ndims ; i++ )
 154     {
 155       range_of_dimension( r, tx , i , p , nlstructname ) ;
 156       strcat(tmp,tx) ;
 157       strcat(tmp,",") ;
 158     }
 159   }
 160   tmp[strlen(tmp)-1] = '\0' ;
 161   if ( post != NULL ) strcat(tmp,post)  ;
 162
 163   return(tmp) ;
 164 }
 165
 166 int
 167 range_of_dimension ( char * r , char * tx , int i , node_t * p , char * nlstructname )
 168 {
 169    char s[NAMELEN], e[NAMELEN] ;
 170
 171    get_elem( r , nlstructname , s , i , p , 0 ) ;
 172    get_elem( r , nlstructname , e , i , p , 1 ) ;
 173    sprintf(tx,"%s:%s", s , e ) ;
 174    return 0; /* SamT: bug fix: return a value */
 175 }
 176
 177 char *
 178 index_with_firstelem( char * pre , char * dref , int bdy ,  /* as defined in data.h */
 179                       char * tmp , node_t * p , char * post )
 180 {
 181   int i ;
 182   char tx[NAMELEN] ;
 183   char tmp2[NAMELEN] ;
 184   /* SamT: bug fix: zdex is used but never set */
 185   int  bdex, xdex, ydex, zdex=-999 ;
 186   node_t *xdim, *ydim, *zdim ;
 187   char r[NAMELEN] ;
 188
 189   if ( p == NULL ) return("") ;
 190   if ( p->ndims <= 0 ) return("") ;
 191   strcpy(tmp,"") ;
 192   if ( pre != NULL ) strcat(tmp,pre) ;
 193
 194   strcpy(r,"") ;
 195   if ( dref != NULL ) strcat(r,dref) ;
 196
 197   if ( p->boundary_array )
 198   {
 199     if ( sw_new_bdys ) {
 200
 201       xdim = get_dimnode_for_coord( p , COORD_X ) ;
 202       ydim = get_dimnode_for_coord( p , COORD_Y ) ;
 203       zdim = get_dimnode_for_coord( p , COORD_Z ) ;
 204       if ( ydim == NULL )
 205        { fprintf(stderr,"dimension_with_ranges: y dimension not specified for %s\n",p->name) ; return("") ; }
 206       if ( xdim == NULL )
 207        { fprintf(stderr,"dimension_with_ranges: x dimension not specified for %s\n",p->name) ; return("") ; }
 208
 209       xdex = xdim->dim_order ;
 210       ydex = ydim->dim_order ;
 211
 212       if      ( bdy == P_XSB || bdy == P_XEB ) { bdex = ydex ; }
 213       else if ( bdy == P_YSB || bdy == P_YEB ) { bdex = xdex ; }
 214       else { fprintf(stderr,"REGISTRY WARNING: internal error %s %d \n",__FILE__,__LINE__) ; }
 215       if ( p->ndims > 0 )
 216       {
 217         if ( !strcmp( p->use , "_4d_bdy_array_" ) ) {
 218           sprintf(tmp,"%ssm3%d,%ssm3%d,1,1", r,bdex,r,zdex ) ;
 219         } else {
 220           sprintf(tmp,"%ssm3%d,%ssm3%d,1", r,bdex,r,zdex ) ;
 221         }
 222       }
 223       else
 224       {
 225         sprintf(tx,"1," ) ;
 226         strcat(tmp,tx) ;
 227       }
 228
 229     } else {
 230       if ( p->ndims > 0 )
 231       {
 232         if ( !strcmp( p->use , "_4d_bdy_array_" ) ) {
 233           strcat(tmp,"1,1,1,1,1,") ;
 234         } else {
 235           strcat(tmp,"1,1,1,1,") ;
 236         }
 237       }
 238       else
 239       {
 240         sprintf(tx,"1," ) ;
 241         strcat(tmp,tx) ;
 242       }
 243     }
 244   }
 245   else
 246   {
 247     for ( i = 0 ; i < p->ndims ; i++ )
 248     {
 249       get_elem( dref, "", tx, i, p , 0 ) ;
 250       strcat( tmp, tx ) ;
 251       strcat(tmp,",") ;
 252     }
 253   }
 254   tmp[strlen(tmp)-1] = '\0' ;  /* remove trailing comma */
 255   if ( post != NULL ) strcat(tmp,post)  ;
 256   return(tmp) ;
 257 }
 258
 259 int
 260 get_elem ( char * structname , char * nlstructname , char * tx , int i , node_t * p , int first_last )
 261 {
 262    char dref[NAMELEN], nlstruct[NAMELEN] ;
 263    char d, d1 ;
 264
 265    if ( structname == NULL ) { strcpy( dref, "" ) ;}
 266    else                      { strcpy( dref, structname ) ; }
 267    if ( nlstructname == NULL ) { strcpy( nlstruct, "" ) ;}
 268    else                        { strcpy( nlstruct, nlstructname ) ; }
 269    if ( p->dims[i] != NULL )
 270    {
 271      switch ( p->dims[i]->len_defined_how )
 272      {
 273        case (DOMAIN_STANDARD) :
 274          {
 275            char *ornt ;
 276            if      ( p->proc_orient == ALL_X_ON_PROC ) ornt = "x" ;
 277            else if ( p->proc_orient == ALL_Y_ON_PROC ) ornt = "y" ;
 278            else                                        ornt = "" ;
 279
 280            switch( p->dims[i]->coord_axis )
 281            {
 282            case(COORD_X) : d = 'i' ;  d1 = 'x' ; break ;
 283            case(COORD_Y) : d = 'j' ;  d1 = 'y' ; break ;
 284            case(COORD_Z) : d = 'k' ;  d1 = 'z' ; break ;
 285            default :  break ;
 286            }
 287
 288            if ( p->dims[i]->subgrid )
 289            {
 290              if ( first_last == 0 ) { /*first*/
 291                sprintf(tx,"(%ssm3%d%s-1)*%ssr_%c+1",dref,p->dims[i]->dim_order,ornt,dref,d1) ;
 292              }else{                   /*last*/
 293                sprintf(tx,"%sem3%d%s*%ssr_%c"      ,dref,p->dims[i]->dim_order,ornt,dref,d1) ;
 294              }
 295            }
 296            else
 297            {
 298              sprintf(tx,"%s%cm3%d%s",dref,first_last==0?'s':'e',p->dims[i]->dim_order,ornt) ;
 299            }
 300          }
 301          break ;
 302        case (NAMELIST) :
 303          if ( first_last == 0 ) { if ( !strcmp( p->dims[i]->assoc_nl_var_s , "1" ) ) {
 304                                     sprintf(tx,"%s",p->dims[i]->assoc_nl_var_s) ;
 305                                   } else {
 306                                     sprintf(tx,"%s%s%s",nlstructname,structname,p->dims[i]->assoc_nl_var_s) ;
 307                                   }
 308                                 }
 309          else                   { sprintf(tx,"%s%s%s",nlstructname,structname,p->dims[i]->assoc_nl_var_e) ; }
 310          break ;
 311        case (CONSTANT) :
 312          if ( first_last == 0 ) { sprintf(tx,"%d",p->dims[i]->coord_start) ; }
 313          else                   { sprintf(tx,"%d",p->dims[i]->coord_end) ; }
 314          break ;
 315        default : break ;
 316      }
 317    }
 318    else
 319    {
 320      fprintf(stderr,"WARNING: %s %d: something wrong with internal representation for dim %d\n",__FILE__,__LINE__,i) ;
 321    }
 322    return 0; /* SamT: bug fix: return a value */
 323 }
 324
 325 char *
 326 declare_array_as_pointer( char * tmp , node_t * p )
 327 {
 328   strcpy( tmp , "" ) ;
 329   if ( p != NULL ) {
 330 #ifdef USE_ALLOCATABLES
 331     if ( p->ndims > 0 || p->boundary_array ) strcpy ( tmp, ",ALLOCATABLE" ) ;
 332 #else
 333     if ( p->ndims > 0 || p->boundary_array ) strcpy ( tmp, ",POINTER" ) ;
 334 #endif
 335   }
 336   return(tmp);
 337 }
 338
 339 char *
 340 field_type( char * tmp , node_t * p )
 341 {
 342   if ( p == NULL ) {
 343     strcpy( tmp , "" ) ;
 344   } else if ( p->type == NULL ) {
 345     strcpy( tmp , "" ) ;
 346   } else if ( p->type->type_type == SIMPLE ) {
 347     strcpy( tmp , p->type->name ) ;
 348   } else {
 349     sprintf( tmp , "TYPE(%s)", p->type->name ) ;
 350   }
 351   return( tmp ) ;
 352 }
 353
 354 char *
 355 field_name( char * tmp , node_t * p , int tag  )
 356 {
 357   if ( p == NULL ) return("") ;
 358   if ( tag < 1 )
 359   {
 360     strcpy(tmp,p->name) ;
 361     if ( p->scalar_array_member ) strcpy(tmp,p->use) ;
 362   }
 363   else
 364   {
 365     sprintf(tmp,"%s_%d",p->name,tag) ;
 366     if ( p->scalar_array_member ) sprintf(tmp,"%s_%d",p->use,tag) ;
 367   }
 368   return( tmp ) ;
 369 }
 370
 371 char *
 372 field_name_bdy( char * tmp , node_t * p , int tag, int bdy  )
 373 {
 374   if ( p == NULL ) return("") ;
 375   if ( tag < 1 )
 376   {
 377     strcpy(tmp,p->name) ;
 378     if ( p->scalar_array_member ) strcpy(tmp,p->use) ;
 379     if ( p->boundary_array ) strcat(tmp,bdy_indicator(bdy)) ;
 380   }
 381   else
 382   {
 383     sprintf(tmp,"%s_%d",p->name,tag) ;
 384     if ( p->scalar_array_member ) sprintf(tmp,"%s_%d",p->use,tag) ;
 385     if ( p->boundary_array ) strcat(tmp,bdy_indicator(bdy)) ;
 386   }
 387   return( tmp ) ;
 388 }
 389
 390 static char *emp_str = "" ;
 391 static char *xs_str = "xs" ;
 392 static char *xe_str = "xe" ;
 393 static char *ys_str = "ys" ;
 394 static char *ye_str = "ye" ;
 395
 396 char *
 397 bdy_indicator( int bdy )
 398 {
 399   char * res ;
 400   res = emp_str ;
 401   if      ( bdy == P_XSB ) { res = xs_str ; }
 402   else if ( bdy == P_XEB ) { res = xe_str ; }
 403   else if ( bdy == P_YSB ) { res = ys_str ; }
 404   else if ( bdy == P_YEB ) { res = ye_str ; }
 405   return(res) ;
 406 }
 407
 408 int
 409 print_warning( FILE * fp , char * fname )
 410 {
 411 fprintf(fp,"!STARTOFREGISTRYGENERATEDINCLUDE '%s'\n", fname) ;
 412 fprintf(fp,"!\n") ;
 413 fprintf(fp,"! WARNING This file is generated automatically by use_registry\n") ;
 414 fprintf(fp,"! using the data base in the file named Registry.\n") ;
 415 fprintf(fp,"! Do not edit.  Your changes to this file will be lost.\n") ;
 416 fprintf(fp,"!\n") ;
 417 return(0) ;
 418 }
 419
 420 int
 421 close_the_file( FILE * fp )
 422 {
 423 fprintf(fp,"!ENDOFREGISTRYGENERATEDINCLUDE\n") ;
 424 fclose(fp) ;
 425 return 0; /* SamT: bug fix: return a value */
 426 }
 427
 428 int
 429 make_entries_uniq ( char * fname )
 430 {
 431   char tempfile[NAMELEN] ;
 432   /* Had to increase size for SOA from 4096 to 7000 */
 433   char commline[7000] ;
 434   sprintf(tempfile,"regtmp1%d",getpid()) ;
 435   sprintf(commline,"%s < %s > %s ; %s %s %s ",
 436           UNIQSORT,fname,tempfile,
 437           MVCOMM,tempfile,fname ) ;
 438   return(system(commline)) ;
 439 }
 440
 441 int
 442 add_warning ( char * fname )
 443 {
 444   FILE * fp ;
 445   char tempfile[NAMELEN] ;
 446   char tempfile1[NAMELEN] ;
 447   /* Had to increase size for SOA from 4096 to 7000 */
 448   char commline[7000] ;
 449   sprintf(tempfile,"regtmp1%d",getpid()) ;
 450   sprintf(tempfile1,"regtmp2%d",getpid()) ;
 451   if (( fp = fopen( tempfile, "w" )) == NULL ) return(1) ;
 452   print_warning(fp,tempfile) ;
 453   close_the_file(fp) ;
 454   sprintf(commline,"%s %s %s > %s ; %s %s %s ; %s %s ",
 455           CATCOMM,tempfile,fname,tempfile1,
 456           MVCOMM,tempfile1,fname,
 457           RMCOMM,tempfile) ;
 458   return(system(commline)) ;
 459 }
 460
 461 /* DESTRUCTIVE */
 462 char *
 463 make_upper_case ( char * str )
 464 {
 465   char * p ;
 466   if ( str == NULL ) return (NULL) ;
 467   for ( p = str ; *p ; p++ ) *p = toupper(*p) ;
 468   return(str) ;
 469 }
 470
 471 /* DESTRUCTIVE */
 472 char *
 473 make_lower_case ( char * str )
 474 {
 475   char * p ;
 476   if ( str == NULL ) return (NULL) ;
 477   for ( p = str ; *p ; p++ ) *p = tolower(*p) ;
 478   return(str) ;
 479 }
 480
 481 /* Routines for keeping typedef history  -ajb */
 482
 483 static int NumTypeDefs ;
 484 static char typedefs[MAX_TYPEDEFS][NAMELEN] ;
 485
 486 int
 487 init_typedef_history()
 488 {
 489   NumTypeDefs = 0 ;
 490   return(0) ;
 491 }
 492
 493 int
 494 get_num_typedefs()
 495 {
 496   return( NumTypeDefs ) ;
 497 }
 498
 499 char *
 500 get_typename_i(int i)
 501 {
 502   if ( i >= 0 && i < NumTypeDefs ) return( typedefs[i] ) ;
 503   return(NULL) ;
 504 }
 505
 506 int
 507 add_typedef_name ( char * name )
 508 {
 509   if ( name == NULL ) return(1) ;
 510   if ( get_typedef_name ( name ) == NULL )
 511   {
 512     if ( NumTypeDefs >= MAX_TYPEDEFS ) return(1) ;
 513     strcpy( typedefs[NumTypeDefs++] , name ) ;
 514   }
 515   return(0) ;
 516 }
 517
 518 char *
 519 get_typedef_name ( char * name )
 520 {
 521   int i ;
 522   if ( name == NULL ) return(NULL) ;
 523   for ( i = 0 ; i < NumTypeDefs ; i++ )
 524   {
 525     if ( !strcmp(name,typedefs[i]) ) return( typedefs[i] ) ;
 526   }
 527   return(NULL) ;
 528 }
 529
 530 int
 531 associated_with_4d_array( node_t * p )
 532 {
 533   int res = 0 ;
 534   node_t * possble ;
 535   char * last_underscore ;
 536   char name_copy[128] ;
 537   if ( p != NULL )
 538   {
 539     /* check this variable and see if it is a boundary variable that is associated with a 4d array */
 540     strcpy( name_copy, p->name ) ;
 541     if (( last_underscore = rindex( name_copy , '_' )) != NULL ) {
 542       if ( !strcmp( last_underscore , "_b" ) || !strcmp( last_underscore , "_bt" ) ) {
 543         *last_underscore = '\0' ;
 544         if (( possble = get_entry( name_copy , Domain.fields )) != NULL ) {
 545           res = possble->node_kind & FOURD ;
 546         }
 547       }
 548     }
 549   }
 550   return(res) ;
 551 }
 552
 553 char *
 554 array_size_expression ( char * refarg , char * pre ,
 555                        int bdy , /* as defined in data.h */
 556                        char * tmp , node_t * p , char * post ,
 557                        char * nlstructname  )   /* provides name (with %) of structure in
 558                                                    which a namelist supplied dimension
 559                                                    should be dereference from, or ""  */
 560 {
 561   int i ;
 562   char tx[NAMELEN] ;
 563   char r[NAMELEN],s[NAMELEN],four_d[NAMELEN] ;
 564   int   bdex, xdex, ydex, zdex ;
 565   node_t *xdim, *ydim, *zdim ;
 566   char *pp ;
 567   if ( p == NULL ) return("") ;
 568   if ( p->ndims <= 0 && !p->boundary_array ) return("") ;
 569   strcpy(tmp,"") ;
 570   if ( pre != NULL ) strcat(tmp,pre) ;
 571   strcpy(r,"") ;
 572   if ( refarg != NULL ) strcat(r,refarg) ;
 573
 574   if ( p->boundary_array )
 575   {
 576     if ( p->ndims > 0 )
 577     {
 578       xdim = get_dimnode_for_coord( p , COORD_X ) ;
 579       ydim = get_dimnode_for_coord( p , COORD_Y ) ;
 580       zdim = get_dimnode_for_coord( p , COORD_Z ) ;
 581       if ( ydim == NULL )
 582        { fprintf(stderr,"dimension_with_ranges: y dimension not specified for %s\n",p->name) ; return("") ; }
 583       if ( xdim == NULL )
 584        { fprintf(stderr,"dimension_with_ranges: x dimension not specified for %s\n",p->name) ; return("") ; }
 585
 586       xdex = xdim->dim_order ;
 587       ydex = ydim->dim_order ;
 588
 589       if ( !strcmp( p->use , "_4d_bdy_array_" ) ) {   /* if a boundary array for a 4d tracer */
 590         strcpy(s, p->name ) ;  /* copy the name and then remove everything after last underscore */
 591         if ((pp=rindex( s, '_' )) != NULL ) *pp = '\0' ;
 592         sprintf( four_d, "*num_%s,", s  ) ;
 593       } else {
 594         strcpy( four_d, "" ) ;
 595       }
 596       if ( sw_new_bdys ) {
 597         if      ( bdy == P_XSB || bdy == P_XEB ) { bdex = ydex ; }
 598         else if ( bdy == P_YSB || bdy == P_YEB ) { bdex = xdex ; }
 599         else { fprintf(stderr,"REGISTRY WARNING: internal error %s %d, bdy=%d,%s,%d \n",__FILE__,__LINE__,bdy,p->name,p->boundary) ; }
 600         if ( zdim != NULL ) {
 601           zdex = zdim->dim_order ;
 602           sprintf(tx,"(%sem3%d-%ssm3%d+1)*(%sem3%d-%ssm3%d+1)*(%sspec_bdy_width)%s", r,bdex,r,bdex,r,zdex,r,zdex,r,four_d ) ;
 603         } else {
 604           sprintf(tx,"(%sem3%d-%ssm3%d+1)*(%sspec_bdy_width)%s", r,bdex,r,bdex,r,four_d ) ;
 605         }
 606       } else {
 607         if ( zdim != NULL ) {
 608           zdex = zdim->dim_order ;
 609           sprintf(tx,"max(%sed3%d,%sed3%d)*(%sed3%d-%ssd3%d+1)*%sspec_bdy_width*4*%s", r,xdex,r,ydex,r,zdex,r,zdex,r,four_d ) ;
 610         } else {
 611           sprintf(tx,"max(%sed3%d,%sed3%d)*%sspec_bdy_width*4*%s", r,xdex,r,ydex,r,four_d ) ;
 612         }
 613         if ( tx[strlen(tx)-1] == '*' ) tx[strlen(tx)-1] = '\0' ;  /* chop trailing * if four_d is "" */
 614       }
 615     }
 616     else
 617     {
 618       sprintf(tx,"%sspec_bdy_width,",r ) ;
 619     }
 620     strcat(tmp,tx) ;
 621   }
 622   else
 623   {
 624     for ( i = 0 ; i < p->ndims ; i++ )
 625     {
 626       dimension_size_expression( r, tx , i , p , nlstructname ) ;
 627       strcat(tmp,tx) ;
 628       strcat(tmp,")*(") ;
 629     }
 630   }
 631   if ( tmp[strlen(tmp)-1] == '(' ) {
 632      tmp[strlen(tmp)-3] = '\0' ;  /* get rid of trailing )*( */
 633   } else if ( tmp[strlen(tmp)-1] == ',' ) {
 634      tmp[strlen(tmp)-1] = '\0' ;
 635   }
 636   if ( post != NULL ) strcat(tmp,post)  ;
 637
 638   return(tmp) ;
 639 }
 640
 641 int
 642 dimension_size_expression ( char * r , char * tx , int i , node_t * p , char * nlstructname )
 643 {
 644    char s[NAMELEN], e[NAMELEN] ;
 645
 646    get_elem( r , nlstructname , s , i , p , 0 ) ;
 647    get_elem( r , nlstructname , e , i , p , 1 ) ;
 648    sprintf(tx,"((%s)-(%s)+1)", e , s ) ;
 649    return 0; /* SamT: bug fix: return a value */
 650 }
 651
 652 void
 653 reset_mask ( unsigned int * mask , int e )
 654 {
 655    int w ;
 656    unsigned int m, n ;
 657
 658    w = e / (8*sizeof(int)-1) ;
 659    n = 1 ;
 660    m = ~( n << e % (8*sizeof(int)-1) ) ;
 661    if ( w >= 0 && w < IO_MASK_SIZE ) {
 662      mask[w] &= m ;
 663    }
 664 }
 665
 666 void
 667 set_mask ( unsigned int * mask , int e )
 668 {
 669    int w ;
 670    unsigned int m, n ;
 671
 672    w = e / (8*sizeof(int)-1) ;
 673    n = 1 ;
 674    m = ( n << e % (8*sizeof(int)-1) ) ;
 675    if ( w >= 0 && w < IO_MASK_SIZE ) {
 676      mask[w] |= m ;
 677    }
 678 }
 679
 680 int
 681 get_mask ( unsigned int * mask , int e )
 682 {
 683    int w ;
 684    unsigned int m, n ;
 685
 686    w = e / (8*sizeof(int)-1) ;   /* 8 is number of bits per byte */
 687    if ( w >= 0 && w < IO_MASK_SIZE ) {
 688      m = mask[w] ;
 689      n =  ( 1 << e % (8*sizeof(int)-1) ) ;;
 690      return ( (m & n) != 0 ) ;
 691    } else {
 692      return(0) ;
 693    }
 694 }
 695
 696 int dims_ikj_inner(node_t * field_struct) {
 697   return field_struct->ndims>=3
 698     && !strcmp(field_struct->dims[0]->dim_name,"i")
 699     && !strcmp(field_struct->dims[1]->dim_name,"k")
 700     && !strcmp(field_struct->dims[2]->dim_name,"j");
 701 }
 702
 703 int dims_ij_inner(node_t * field_struct) {
 704   return field_struct->ndims>=2
 705     && !strcmp(field_struct->dims[0]->dim_name,"i")
 706     && !strcmp(field_struct->dims[1]->dim_name,"j");
 707 }
 708
 709 #if 0
 710 main()
 711 {
 712    unsigned int m[5] ;
 713    int i, ii ;
 714
 715    for ( i = 0 ; i < 5*32 ; i++ ) {
 716      for ( ii = 0 ; ii < 5 ; ii++ ) { m[ii] = 0xffffffff ; }
 717      reset_mask( m, i ) ;
 718      for ( ii = 4 ; ii >= 0 ; ii-- ) { printf(" %08x ", m[ii]) ; }
 719      printf("\n") ;
 720    }
 721
 722    for ( i = 0 ; i < 5*32 ; i++ ) {
 723      for ( ii = 0 ; ii < 5 ; ii++ ) { m[ii] = 0x0 ; }
 724      set_mask( m, i ) ;
 725      for ( ii = 4 ; ii >= 0 ; ii-- ) { printf(" %08x ", m[ii]) ; }
 726      printf("\n") ;
 727    }
 728
 729    for ( ii = 0 ; ii < 5 ; ii++ ) { m[ii] = 0x0 ; }
 730    set_mask( m, 82 ) ;
 731    for ( i = 0 ; i < 5*32 ; i++ ) {
 732      printf("%d %0d\n",i,get_mask(m,i) ) ;
 733    }
 734 }
 735 #endif