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