source: trunk/WRF.COMMON/WRFV2/tools/gen_scalar_derefs.c @ 2756

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

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

File size: 3.4 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
10#define DUMMY 1
11#define ACTUAL 2
12
13int
14gen_scalar_derefs ( char * dirname )
15{
16  int i ;
17 
18  for ( i = 0 ; i < get_num_cores() ; i++ )
19    scalar_derefs ( dirname , get_corename_i(i) ) ; 
20  return(0) ;
21}
22
23#define DIR_COPY_OUT 1
24#define DIR_COPY_IN  2
25
26int
27scalar_derefs ( char * dirname , char * corename )
28{
29  FILE * fp ;
30  char  fname[NAMELEN] ;
31  char * fn = "_scalar_derefs.inc" ;
32  char * p ;
33  int linelen ;
34  char outstr[64*4096] ;
35
36  if ( dirname == NULL || corename == NULL ) return(1) ;
37  if ( strlen(dirname) > 0 ) 
38   { sprintf(fname,"%s/%s%s",dirname,corename, fn) ; }
39  else                       
40   { sprintf(fname,"%s%s",corename,fn) ; }
41
42  if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
43  print_warning(fp,fname) ;
44  fprintf(fp,"! BEGIN SCALAR DEREFS\n") ;
45  linelen = 0 ;
46  if ( sw_limit_args ) {
47    fprintf(fp,"#undef CPY\n") ;
48    fprintf(fp,"#undef CPYC\n") ;
49    fprintf(fp,"#ifdef COPY_OUT\n") ;
50    scalar_derefs1 ( fp , corename , &Domain, DIR_COPY_OUT ) ;
51    fprintf(fp,"#else\n") ;
52    scalar_derefs1 ( fp , corename , &Domain, DIR_COPY_IN ) ;
53    fprintf(fp,"#endif\n") ;
54  }
55  fprintf(fp,"! END SCALAR DEREFS\n") ;
56  close_the_file( fp ) ;
57  return(0) ;
58}
59
60int
61scalar_derefs1 ( FILE * fp , char * corename, node_t * node, int direction )
62{
63  node_t * p ;
64  int tag ;
65  char fname[NAMELEN] ;
66
67  if ( node == NULL ) return(1) ;
68  for ( p = node->fields ; p != NULL ; p = p->next )
69  {
70    if ( p->node_kind & I1 ) continue ;              /* short circuit any field that is not state */
71                                                     /* short circuit DERIVED types */
72    if ( p->type->type_type == DERIVED ) continue ;
73                                                     /* short circuit non-scalars */
74    if ( p->ndims > 0 ) continue ; 
75
76    if (                 (
77                                                   /* if it's a core specific field and we're doing that core or... */
78          (p->node_kind & FIELD && (!strncmp("dyn_",p->use,4)&&!strcmp(corename,p->use+4)))
79                                                   /* it is not a core specific field and it is not a derived type -ajb */
80       || (p->node_kind & FIELD && (p->type->type_type != DERIVED) && ( strncmp("dyn_",p->use,4)))
81#if 0
82                                                   /* it is a state variable */
83       || (p->node_kind & RCONFIG )
84#endif
85                         )
86       )
87    {
88      for ( tag = 1 ; tag <= p->ntl ; tag++ )
89      {
90        char * x ;
91        /* if this is a core-specific variable, prepend the name of the core to */
92        /* the variable at the driver level */
93        if (!strcmp( corename , p->use+4 )) { x = "C" ; } else { x = "" ; }
94        strcpy(fname,field_name(t4,p,(p->ntl>1)?tag:0)) ;
95        /* generate deref */
96        if ( direction == DIR_COPY_OUT ) {
97          if (!strcmp( corename , p->use+4 )) { fprintf(fp, " grid%%%s_%s = %s\n",corename,fname,fname) ; }
98          else                                { fprintf(fp, " grid%%%s    = %s\n",fname,fname ) ; }
99        } else {
100          if (!strcmp( corename , p->use+4 )) { fprintf(fp, " %s = grid%%%s_%s\n",fname,corename,fname) ; }
101          else                                { fprintf(fp, " %s = grid%%%s\n",fname,fname ) ; }
102        }
103      }
104    }
105  }
106  return(0) ;
107}
108
Note: See TracBrowser for help on using the repository browser.