source: trunk/WRF.COMMON/WRFV3/tools/gen_args.c @ 3094

Last change on this file since 3094 was 2759, checked in by aslmd, 2 years ago

adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size

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