wrfv2_fire/tools/misc.c

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