source: trunk/WRF.COMMON/WRFV2/tools/gen_args.c @ 3547

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

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

File size: 5.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
10#define DUMMY 1
11#define ACTUAL 2
12#define DUMMY_NEW 3
13#define ACTUAL_NEW 4
14
15int
16gen_actual_args ( char * dirname )
17{
18  int i ;
19 
20  for ( i = 0 ; i < get_num_cores() ; i++ )
21    gen_args ( dirname , get_corename_i(i) , ACTUAL ) ; 
22  return(0) ;
23}
24
25/* only generate actual args for the 4d arrays */
26int
27gen_actual_args_new ( char * dirname )
28{
29  int i ;
30
31  for ( i = 0 ; i < get_num_cores() ; i++ )
32    gen_args ( dirname , get_corename_i(i) , ACTUAL_NEW ) ;
33  return(0) ;
34}
35
36int
37gen_dummy_args ( char * dirname )
38{
39  int i ;
40 
41  for ( i = 0 ; i < get_num_cores() ; i++ )
42    gen_args ( dirname , get_corename_i(i) , DUMMY ) ;
43  return(0) ;
44}
45
46/* only generate dummy args for the 4d arrays */
47int
48gen_dummy_args_new ( char * dirname )
49{
50  int i ;
51
52  for ( i = 0 ; i < get_num_cores() ; i++ )
53    gen_args ( dirname , get_corename_i(i) , DUMMY_NEW ) ;
54  return(0) ;
55}
56
57int
58gen_args ( char * dirname , char * corename , int sw )
59{
60  FILE * fp ;
61  char  fname[NAMELEN] ;
62  char * fn = "_args.inc" ;
63  char * p ;
64  int linelen ;
65  char outstr[64*4096] ;
66
67  if ( dirname == NULL || corename == NULL ) return(1) ;
68  if ( strlen(dirname) > 0 ) 
69   { sprintf(fname,"%s/%s%s%s%s",dirname,corename,
70             (sw==ACTUAL||sw==ACTUAL_NEW)?"_actual":"_dummy",(sw==ACTUAL_NEW||sw==DUMMY_NEW)?"_new":"",fn) ; }
71  else                       
72   { sprintf(fname,"%s%s%s%s",corename,
73             (sw==ACTUAL||sw==ACTUAL_NEW)?"_actual":"_dummy",(sw==ACTUAL_NEW||sw==DUMMY_NEW)?"_new":"",fn) ; }
74
75  if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
76  print_warning(fp,fname) ;
77  linelen = 0 ;
78  strcpy(outstr,",") ;
79  gen_args1 ( fp , outstr, (sw==ACTUAL||sw==ACTUAL_NEW)?"grid%":"", corename ,
80              &Domain , &linelen , sw , 0 ) ;
81  /* remove trailing comma */
82  if ((p=rindex(outstr,','))!=NULL) *p = '\0' ;
83  fputs(outstr,fp);fputs(" &\n",fp) ;
84  close_the_file( fp ) ;
85  return(0) ;
86}
87
88int
89gen_args1 ( FILE * fp , char * outstr , char * structname , char * corename , 
90            node_t * node , int *linelen , int sw , int deep )
91{
92  node_t * p ;
93  int tag ;
94  char post[NAMELEN] ;
95  char fname[NAMELEN] ;
96  char x[NAMELEN], y[NAMELEN] ;
97  char indices[NAMELEN] ;
98  int lenarg ; 
99  int only4d = 0 ;
100
101  if ( sw == ACTUAL_NEW ) { sw = ACTUAL ; only4d = 1 ; }
102  if ( sw == DUMMY_NEW )  { sw = DUMMY  ; only4d = 1 ; }
103
104  if ( node == NULL ) return(1) ;
105  for ( p = node->fields ; p != NULL ; p = p->next )
106  {
107    if ( p->node_kind & I1 ) continue ;              /* short circuit any field that is not state */
108                                                     /* short circuit scalars; shortening argument lists */
109    if ( p->ndims == 0 && p->type->type_type != DERIVED && sw_limit_args ) continue ; 
110
111    if (                 (
112          (p->node_kind & FOURD)                   /* scalar arrays or... */
113                                                   /* if it's a core specific field and we're doing that core or... */
114       || (p->node_kind & FIELD && (!strncmp("dyn_",p->use,4)&&!strcmp(corename,p->use+4))) 
115                                                   /* it is not a core specific field and it is not a derived type -ajb */
116       || (p->node_kind & FIELD && (p->type->type_type != DERIVED) && ( strncmp("dyn_",p->use,4))) 
117#if 0
118                                                   /* it is a state variable */
119       || (p->node_kind & RCONFIG )
120#endif
121                         )
122       )
123    {
124      if ( !only4d || (p->node_kind & FOURD) || ( p->boundary_array ) ) {
125        if      ( p->node_kind & FOURD ) { sprintf(post,",1)") ; }
126        else if ( p->boundary_array )     { sprintf(post,")") ; }
127        else                              { sprintf(post,")") ; }
128        for ( tag = 1 ; tag <= p->ntl ; tag++ )
129        {
130          /* if this is a core-specific variable, prepend the name of the core to */
131          /* the variable at the driver level */
132          if (!strcmp( corename , p->use+4 ) && sw==ACTUAL)
133            sprintf(fname,"%s_%s",corename,field_name(t4,p,(p->ntl>1)?tag:0)) ;
134          else
135            strcpy(fname,field_name(t4,p,(p->ntl>1)?tag:0)) ;
136          strcpy(indices,"") ;
137          if ( sw_deref_kludge && sw==ACTUAL ) 
138            sprintf(indices, "%s",index_with_firstelem("(","",t2,p,post)) ;
139          /* generate argument */
140          strcpy(y,structname) ; strcat(y,fname) ; strcat(y,indices) ; strcat(y,",") ;
141          lenarg = strlen(y) ;
142          if ( lenarg+*linelen > MAX_ARGLINE ) { strcat(outstr," &\n") ; *linelen = 0 ; }
143          strcat(outstr,y) ;
144          *linelen += lenarg ;
145        }
146      }
147    }
148    if ( p->type != NULL )
149    {
150      if ( p->type->type_type == DERIVED && !only4d )
151      {
152        if ( deep )
153        {
154          sprintf(x,"%s%s%%",structname,p->name ) ;
155          gen_args1(fp, outstr, (sw==ACTUAL)?x:"", corename, p->type,linelen,sw,deep) ;
156        }
157        else
158        {
159          /* generate argument */
160          strcpy(y,structname) ; strcat(y,p->name) ; strcat(y,",") ;
161          lenarg = strlen(y) ;
162          if ( lenarg+*linelen > MAX_ARGLINE ) { strcat(outstr," &\n") ; *linelen = 0 ; }
163          strcat(outstr,y) ;
164          *linelen += lenarg ;
165          p->mark = 1 ;
166        }
167      }
168    }
169  }
170  return(0) ;
171}
172
Note: See TracBrowser for help on using the repository browser.