source: trunk/WRF.COMMON/WRFV2/tools/misc.c @ 3553

Last change on this file since 3553 was 11, checked in by aslmd, 14 years ago

spiga@svn-planeto:ajoute le modele meso-echelle martien

File size: 11.2 KB
Line 
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
10char *
11dimension_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 ( !strcmp( p->use , "_4d_bdy_array_" ) ) {
21      strcat( tmp, ":,:,:,:,:" ) ;  /* boundary array for 4d tracer array */
22    } else {
23      strcat( tmp, ":,:,:,:" ) ;  /* most always have four dimensions */
24    }
25  }
26  else
27  {
28    for ( i = 0 ; i < p->ndims ; i++ ) strcat(tmp,":,") ; 
29    if ( p->node_kind & FOURD ) strcat(tmp,":,") ;       /* add an extra for 4d arrays */
30    tmp[strlen(tmp)-1] = '\0' ;
31  }
32  if ( post != NULL ) strcat(tmp,post)  ;
33  return(tmp) ;
34}
35
36char *
37dimension_with_ones( char * pre , char * tmp , node_t * p , char * post )
38{
39  int i ;
40  char r[NAMELEN],s[NAMELEN],four_d[NAMELEN] ;
41  char *pp ;
42  if ( p == NULL ) return("") ;
43  if ( p->ndims <= 0 && ! p->boundary_array ) return("") ;
44  strcpy(tmp,"") ;
45  if ( pre != NULL ) strcat(tmp,pre) ;
46
47  if ( p->boundary_array )
48  {
49
50    if ( !strcmp( p->use , "_4d_bdy_array_" ) ) {   /* if a boundary array for a 4d tracer */
51      strcpy(s, p->name ) ;  /* copy the name and then remove everything after last underscore */
52      if ((pp=rindex( s, '_' )) != NULL ) *pp = '\0' ;
53      sprintf( four_d, "num_%s,", s  ) ;
54    } else {
55      strcpy( four_d, "" ) ;
56    }
57
58    if ( !strcmp( p->use , "_4d_bdy_array_" ) ) {
59      sprintf( r, "1,1,1,1,%s", four_d ) ;  /* boundary array for 4d tracer array */
60      strcat( tmp, r ) ;
61    } else {
62      strcat( tmp, "1,1,1,1," ) ;  /* most always have four dimensions */
63    }
64    tmp[strlen(tmp)-1] = '\0' ;
65  }
66  else
67  {
68    for ( i = 0 ; i < p->ndims ; i++ ) strcat(tmp,"1,") ;
69    if ( p->node_kind & FOURD ) strcat(tmp,"1,") ;       /* add an extra for 4d arrays */
70    tmp[strlen(tmp)-1] = '\0' ;
71  }
72  if ( post != NULL ) strcat(tmp,post)  ;
73  return(tmp) ;
74}
75
76char *
77dimension_with_ranges( char * refarg , char * pre ,
78                       char * tmp , node_t * p , char * post ,
79                       char * nlstructname  )   /* added 20020130;
80                                                   provides name (with %) of structure in
81                                                   which a namelist supplied dimension
82                                                   should be dereference from, or ""  */
83{
84  int i ;
85  char tx[NAMELEN] ;
86  char r[NAMELEN],s[NAMELEN],four_d[NAMELEN] ;
87  int   xdex, ydex, zdex ;
88  node_t *xdim, *ydim, *zdim ;
89  char *pp ;
90  if ( p == NULL ) return("") ;
91  if ( p->ndims <= 0 && !p->boundary_array ) return("") ;
92  strcpy(tmp,"") ;
93  if ( pre != NULL ) strcat(tmp,pre) ;
94  strcpy(r,"") ;
95  if ( refarg != NULL ) strcat(r,refarg) ;
96
97  if ( p->boundary_array )
98  {
99    if ( p->ndims > 0 )
100    {
101      xdim = get_dimnode_for_coord( p , COORD_X ) ;
102      ydim = get_dimnode_for_coord( p , COORD_Y ) ;
103      zdim = get_dimnode_for_coord( p , COORD_Z ) ;
104      if ( ydim == NULL )
105       { fprintf(stderr,"dimension_with_ranges: y dimension not specified for %s\n",p->name) ; return("") ; }
106      if ( xdim == NULL )
107       { fprintf(stderr,"dimension_with_ranges: x dimension not specified for %s\n",p->name) ; return("") ; }
108     
109      xdex = xdim->dim_order ;
110      ydex = ydim->dim_order ;
111
112      if ( !strcmp( p->use , "_4d_bdy_array_" ) ) {   /* if a boundary array for a 4d tracer */
113        strcpy(s, p->name ) ;  /* copy the name and then remove everything after last underscore */
114        if ((pp=rindex( s, '_' )) != NULL ) *pp = '\0' ;
115        sprintf( four_d, "num_%s,", s  ) ;
116      } else {
117        strcpy( four_d, "" ) ;
118      }
119
120      if ( zdim != NULL ) {
121        zdex = zdim->dim_order ;
122        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 ) ;
123      } else {
124        sprintf(tx,"max(%sed3%d,%sed3%d),1,%sspec_bdy_width,4,%s", r,xdex,r,ydex,r,four_d ) ;
125      }
126    }
127    else
128    {
129      sprintf(tx,"%sspec_bdy_width,",r ) ;
130    }
131    strcat(tmp,tx) ;
132  }
133  else
134  {
135    for ( i = 0 ; i < p->ndims ; i++ )
136    {
137      range_of_dimension( r, tx , i , p , nlstructname ) ;
138      strcat(tmp,tx) ;
139      strcat(tmp,",") ;
140    }
141  }
142  tmp[strlen(tmp)-1] = '\0' ;
143  if ( post != NULL ) strcat(tmp,post)  ;
144
145  return(tmp) ;
146}
147
148int
149range_of_dimension ( char * r , char * tx , int i , node_t * p , char * nlstructname )
150{
151   char s[NAMELEN], e[NAMELEN] ;
152
153   get_elem( r , nlstructname , s , i , p , 0 ) ;
154   get_elem( r , nlstructname , e , i , p , 1 ) ;
155   sprintf(tx,"%s:%s", s , e ) ;
156
157}
158
159char *
160index_with_firstelem( char * pre , char * dref , char * tmp , node_t * p , char * post )
161{
162  int i ;
163  char tx[NAMELEN] ;
164  char tmp2[NAMELEN] ;
165  if ( p == NULL ) return("") ;
166  if ( p->ndims <= 0 ) return("") ;
167  strcpy(tmp,"") ;
168  if ( pre != NULL ) strcat(tmp,pre) ;
169
170  if ( p->boundary_array )
171  {
172    if ( p->ndims > 0 )
173    {
174#if 0
175      for ( i = 0 ; i < p->ndims ; i++ )
176      {
177        sprintf(tx,"1,") ;
178        strcat(tmp,tx) ;
179      }
180#endif
181      if ( !strcmp( p->use , "_4d_bdy_array_" ) ) {
182        strcat(tmp,"1,1,1,1,1,") ;
183      } else {
184        strcat(tmp,"1,1,1,1,") ;
185      }
186    }
187    else
188    {
189      sprintf(tx,"1," ) ;
190      strcat(tmp,tx) ;
191    }
192  }
193  else
194  {
195    for ( i = 0 ; i < p->ndims ; i++ )
196    {
197      get_elem( dref, "", tx, i, p , 0 ) ;
198      strcat( tmp, tx ) ;
199      strcat(tmp,",") ;
200    }
201  }
202  tmp[strlen(tmp)-1] = '\0' ;  /* remove trailing comma */
203  if ( post != NULL ) strcat(tmp,post)  ;
204  return(tmp) ;
205}
206
207get_elem ( char * structname , char * nlstructname , char * tx , int i , node_t * p , int first_last )
208{
209   char dref[NAMELEN], nlstruct[NAMELEN] ;
210
211   if ( structname == NULL ) { strcpy( dref, "" ) ;}
212   else                      { strcpy( dref, structname ) ; }
213   if ( nlstructname == NULL ) { strcpy( nlstruct, "" ) ;}
214   else                        { strcpy( nlstruct, nlstructname ) ; }
215   if ( p->dims[i] != NULL )
216   {
217     switch ( p->dims[i]->len_defined_how )
218     {
219       case (DOMAIN_STANDARD) :
220         {
221         char *ornt ;
222         if      ( p->proc_orient == ALL_X_ON_PROC ) ornt = "x" ;
223         else if ( p->proc_orient == ALL_Y_ON_PROC ) ornt = "y" ;
224         else                                        ornt = "" ;
225           sprintf(tx,"%s%cm3%d%s",dref,first_last==0?'s':'e',p->dims[i]->dim_order,ornt) ;
226         }
227         break ;
228       case (NAMELIST) :
229         if ( first_last == 0 ) { if ( !strcmp( p->dims[i]->assoc_nl_var_s , "1" ) ) {
230                                    sprintf(tx,"%s",p->dims[i]->assoc_nl_var_s) ;
231                                  } else {
232                                    sprintf(tx,"%s%s%s",nlstructname,structname,p->dims[i]->assoc_nl_var_s) ; 
233                                  }
234                                }
235         else                   { sprintf(tx,"%s%s%s",nlstructname,structname,p->dims[i]->assoc_nl_var_e) ; }
236         break ;
237       case (CONSTANT) :
238         if ( first_last == 0 ) { sprintf(tx,"%d",p->dims[i]->coord_start) ; }
239         else                   { sprintf(tx,"%d",p->dims[i]->coord_end) ; }
240         break ;
241       default : break ;
242     }
243   }
244   else
245   {
246     fprintf(stderr,"WARNING: %s %d: something wrong with internal representation for dim %d\n",__FILE__,__LINE__,i) ;
247   }
248}
249
250char *
251declare_array_as_pointer( char * tmp , node_t * p )
252{
253  strcpy( tmp , "" ) ;
254  if ( p != NULL )
255    if ( p->ndims > 0 || p->boundary_array ) strcpy ( tmp, ",POINTER" ) ;
256  return(tmp);
257}
258
259char *
260field_type( char * tmp , node_t * p )
261{
262  if ( p == NULL ) {
263    strcpy( tmp , "" ) ;
264  } else if ( p->type == NULL ) {
265    strcpy( tmp , "" ) ;
266  } else if ( p->type->type_type == SIMPLE ) {
267    strcpy( tmp , p->type->name ) ;
268  } else {
269    sprintf( tmp , "TYPE(%s)", p->type->name ) ;
270  }
271  return( tmp ) ;
272}
273
274char *
275field_name( char * tmp , node_t * p , int tag )
276{
277  if ( p == NULL ) return("") ;
278  if ( tag < 1 )
279  {
280    strcpy(tmp,p->name) ;
281    if ( p->scalar_array_member ) strcpy(tmp,p->use) ;
282  }
283  else
284  {
285    sprintf(tmp,"%s_%d",p->name,tag) ;
286    if ( p->scalar_array_member ) sprintf(tmp,"%s_%d",p->use,tag) ;
287  }
288  return( tmp ) ;
289}
290
291int
292print_warning( FILE * fp , char * fname )
293{
294fprintf(fp,"!STARTOFREGISTRYGENERATEDINCLUDE '%s'\n", fname) ;
295fprintf(fp,"!\n") ;
296fprintf(fp,"! WARNING This file is generated automatically by use_registry\n") ;
297fprintf(fp,"! using the data base in the file named Registry.\n") ;
298fprintf(fp,"! Do not edit.  Your changes to this file will be lost.\n") ;
299fprintf(fp,"!\n") ;
300return(0) ;
301}
302
303close_the_file( FILE * fp )
304{
305fprintf(fp,"!ENDOFREGISTRYGENERATEDINCLUDE\n") ;
306fclose(fp) ;
307}
308
309int
310make_entries_uniq ( char * fname )
311{
312  char tempfile[NAMELEN] ;
313  char commline[4096] ;
314  sprintf(tempfile,"regtmp1%d",getpid()) ;
315  sprintf(commline,"%s < %s > %s ; %s %s %s ",
316          UNIQSORT,fname,tempfile,
317          MVCOMM,tempfile,fname ) ;
318  return(system(commline)) ;
319}
320
321int
322add_warning ( char * fname )
323{
324  FILE * fp ;
325  char tempfile[NAMELEN] ;
326  char tempfile1[NAMELEN] ;
327  char commline[4096] ;
328  sprintf(tempfile,"regtmp1%d",getpid()) ;
329  sprintf(tempfile1,"regtmp2%d",getpid()) ;
330  if (( fp = fopen( tempfile, "w" )) == NULL ) return(1) ;
331  print_warning(fp,tempfile) ; 
332  close_the_file(fp) ;
333  sprintf(commline,"%s %s %s > %s ; %s %s %s ; %s %s ",
334          CATCOMM,tempfile,fname,tempfile1,
335          MVCOMM,tempfile1,fname,
336          RMCOMM,tempfile) ;
337  return(system(commline)) ;
338}
339
340static int NumCores ;
341static char dyncores[MAX_DYNCORES][NAMELEN] ;
342
343int
344init_core_table()
345{
346  NumCores = 0 ;
347  return(0) ;
348}
349
350int
351get_num_cores()
352{
353  return( NumCores ) ;
354}
355
356char *
357get_corename_i(int i)
358{
359  if ( i >= 0 && i < NumCores ) return( dyncores[i] ) ;
360  return(NULL) ;
361}
362
363int
364add_core_name ( char * name )
365{
366  if ( name == NULL ) return(1) ;
367  if (get_core_name ( name ) == NULL )
368  {
369    if ( NumCores >= MAX_DYNCORES ) return(1) ;
370    strcpy( dyncores[NumCores++] , name ) ;
371  }
372  return(0) ;
373}
374
375char *
376get_core_name ( char * name )
377{
378  int i ;
379  if ( name == NULL ) return(NULL) ;
380  for ( i = 0 ; i < NumCores ; i++ )
381  {
382    if ( !strcmp(name,dyncores[i]) ) return( dyncores[i] ) ; 
383  }
384  return(NULL) ;
385}
386
387/* DESTRUCTIVE */
388char *
389make_upper_case ( char * str )
390{
391  char * p ;
392  if ( str == NULL ) return (NULL) ;
393  for ( p = str ; *p ; p++ ) *p = toupper(*p) ; 
394  return(str) ;
395}
396
397/* DESTRUCTIVE */
398char *
399make_lower_case ( char * str )
400{
401  char * p ;
402  if ( str == NULL ) return (NULL) ;
403  for ( p = str ; *p ; p++ ) *p = tolower(*p) ; 
404  return(str) ;
405}
406
407/* Routines for keeping typedef history  -ajb */
408
409static int NumTypeDefs ;
410static char typedefs[MAX_TYPEDEFS][NAMELEN] ;
411
412int
413init_typedef_history()
414{
415  NumTypeDefs = 0 ;
416  return(0) ;
417}
418
419int
420get_num_typedefs()
421{
422  return( NumTypeDefs ) ;
423}
424
425char *
426get_typename_i(int i)
427{
428  if ( i >= 0 && i < NumTypeDefs ) return( typedefs[i] ) ;
429  return(NULL) ;
430}
431
432int
433add_typedef_name ( char * name )
434{
435  if ( name == NULL ) return(1) ;
436  if ( get_typedef_name ( name ) == NULL )
437  {
438    if ( NumTypeDefs >= MAX_TYPEDEFS ) return(1) ;
439    strcpy( typedefs[NumTypeDefs++] , name ) ;
440  }
441  return(0) ;
442}
443
444char *
445get_typedef_name ( char * name )
446{
447  int i ;
448  if ( name == NULL ) return(NULL) ;
449  for ( i = 0 ; i < NumTypeDefs ; i++ )
450  {
451    if ( !strcmp(name,typedefs[i]) ) return( typedefs[i] ) ; 
452  }
453  return(NULL) ;
454}
Note: See TracBrowser for help on using the repository browser.