Add comments to old c preproc / m4 processing since gfortran is unable to
[WRF.git] / tools / registry.c
blob79f7983ed7c1de5f3c498c1da368f96a8047c703
1 #include <stdio.h>
2 #include <stdlib.h>
3 #ifdef _WIN32
4 # include <io.h>
5 # define rindex(X,Y) strrchr(X,Y)
6 # define index(X,Y) strchr(X,Y)
7 #else
8 # include <sys/time.h>
9 # include <sys/resource.h>
10 # include <unistd.h>
11 # include <string.h>
12 # include <strings.h>
13 #endif
15 #define DEFINE_GLOBALS
16 #include "protos.h"
17 #include "registry.h"
18 #include "data.h"
19 #include "sym.h"
21 /* SamT: bug fix: main returns int */
22 int
23 main( int argc, char *argv[], char *env[] )
25 char fname_in[NAMELEN], dir[NAMELEN], fname_tmp[NAMELEN], command[NAMELEN] ;
26 char fname_wrk[NAMELEN] ;
27 FILE * fp_in, *fp_tmp ;
28 char * thisprog ;
29 char *env_val ;
30 int mypid ;
31 int do_irr_diag ;
32 #ifndef _WIN32
33 struct rlimit rlim ;
34 #endif
36 mypid = (int) getpid() ;
37 strcpy( thiscom, argv[0] ) ;
38 argv++ ;
40 sw_deref_kludge = 0 ;
41 sw_io_deref_kludge = 0 ;
42 sw_3dvar_iry_kludge = 0 ;
43 sw_distrib_io_layer = 1 ;
44 sw_limit_args = 0 ; /* usually set -- except for GRAPS */
45 sw_dm_parallel = 0 ;
46 sw_all_x_staggered = 0 ;
47 sw_move = 0 ;
48 sw_all_y_staggered = 0 ;
49 sw_fort_kludge = 1 ; /* unconditionally true for v3 */
50 sw_dm_serial_in_only = 0 ; /* input and bdy data set is distributed by node 0,
51 other data streams are written to file per process */
52 sw_new_bdys = 0 ;
53 sw_unidir_shift_halo = 0 ;
55 strcpy( fname_in , "" ) ;
57 #ifndef _WIN32
58 rlim.rlim_cur = RLIM_INFINITY ;
59 rlim.rlim_max = RLIM_INFINITY ;
60 setrlimit ( RLIMIT_STACK , &rlim ) ;
61 #endif
63 sym_forget() ;
64 thisprog = *argv ;
65 while (*argv) {
66 if (*argv[0] == '-') { /* an option */
67 if (!strncmp(*argv,"-D",2)) {
68 char * p ;
69 p = *argv ;
70 sym_add(p+2) ;
73 if (!strcmp(*argv,"-DDEREF_KLUDGE")) {
74 sw_deref_kludge = 1 ;
76 if (!strcmp(*argv,"-DIO_DEREF_KLUDGE")) {
77 sw_io_deref_kludge = 1 ;
79 if (!strcmp(*argv,"-DLIMIT_ARGS")) {
80 sw_limit_args = 1 ;
82 if (!strcmp(*argv,"-DMOVE_NESTS")) {
83 sw_move = 1 ;
85 if (!strcmp(*argv,"-DMOVE_NL_OUTSIDE_MODULE_CONFIGURE")) {
86 sw_fort_kludge = 1 ;
88 if (!strcmp(*argv,"-DD3VAR_IRY_KLUDGE")) {
89 #if 0
90 sw_3dvar_iry_kludge = 1 ;
91 #else
92 fprintf(stderr,"WARNING: -DD3VAR_IRY_KLUDGE option obsolete (it is now disabled by default). Ignored.\n") ;
93 #endif
95 if (!strcmp(*argv,"-DALL_X_STAGGERED")) {
96 sw_all_x_staggered = 1 ;
98 if (!strcmp(*argv,"-DALL_Y_STAGGERED")) {
99 sw_all_y_staggered = 1 ;
101 if (!strcmp(*argv,"-DDM_PARALLEL")) {
102 sw_dm_parallel = 1 ;
104 if (!strcmp(*argv,"-DNEW_BDYS")) {
105 sw_new_bdys = 1 ;
107 if (!strcmp(*argv,"-DEM_CORE=1")) {
108 sw_unidir_shift_halo = 1 ;
110 if (!strcmp(*argv,"-DNEW_WITH_OLD_BDYS")) {
111 sw_new_with_old_bdys = 1 ;
113 if (!strcmp(*argv,"-DDISTRIB_IO_LAYER")) {
114 #if 0
115 sw_distrib_io_layer = 1 ;
116 #else
117 fprintf(stderr,"WARNING: -DDISTRIB_IO_LAYER option obsolete (it is now default). Ignored.\n") ;
118 #endif
120 if (!strcmp(*argv,"-DDM_SERIAL_IN_ONLY")) {
121 sw_dm_serial_in_only = 1 ;
123 if (!strncmp(*argv,"-h",2)) {
124 fprintf(stderr,"Usage: %s [-DDEREF_KLUDGE] [-DDM_PARALLEL] [-DDISTRIB_IO_LAYER] [-DDM_SERIAL_IN_ONLY] [-DD3VAR_IRY_KLUDGE] registryfile\n",thisprog) ;
125 exit(1) ;
128 else /* consider it an input file */
130 strcpy( fname_in , *argv ) ;
132 argv++ ;
135 gen_io_boilerplate() ; /* 20091213 jm. Generate the io_boilerplate_temporary.inc file */
137 init_parser() ;
138 init_type_table() ;
139 init_dim_table() ;
141 // possible IRR diagnostcis?
143 do_irr_diag = 0;
144 env_val = getenv( "WRF_CHEM" );
145 if( env_val != NULL && !strncmp( env_val, "1", 1 ) ) {
146 env_val = getenv( "WRF_KPP" );
147 if( env_val != NULL && !strncmp( env_val, "1", 1 ) ) do_irr_diag = 1;
149 if( do_irr_diag ) {
150 if( access( fname_in,F_OK ) ) {
151 fprintf(stderr,"Registry program %s does not exist. Ending.\n", fname_in ) ;
152 exit(2) ;
154 { char *e ;
155 strcpy( dir , fname_in ) ;
156 if ( ( e = rindex ( dir , '/' ) ) != NULL ) { *e = '\0' ; } else { strcpy( dir, "." ) ; }
157 sprintf( fname_wrk,"%s/Registry_irr_diag",dir ) ;
159 // fprintf(stderr,"Registry tmp file = %s\n",fname_wrk);
160 sprintf(command,"/bin/cp %s %s\n",fname_in,fname_wrk);
161 // fprintf(stderr,"Command = %s\n",command);
162 if( system( command ) ) {
163 fprintf(stderr,"Could not copy %s to %s\n",fname_in,fname_wrk);
164 exit(2) ;
166 if (( fp_tmp = fopen( fname_wrk , "a" )) == NULL )
168 fprintf(stderr,"Registry program cannot open %s for appending. Ending.\n", fname_tmp ) ;
169 exit(2) ;
171 if( !access( "Registry/registry.irr_diag",F_OK ) ) {
172 sprintf(command,"/bin/rm -f Registry/registry.irr_diag\n");
173 if( system( command ) ) {
174 fprintf(stderr,"Could not remove Registry/registry.irr_diag\n");
175 exit(2) ;
179 int ndx = 0;
180 int retcod;
181 retcod = AppendReg( "mozcart",ndx );
182 if( !retcod ) ndx++;
183 retcod = AppendReg( "t1_mozcart",ndx );
184 if( !retcod ) ndx++;
185 retcod = AppendReg( "mozart_mosaic_4bin",ndx );
186 if( !retcod ) ndx++;
187 retcod = AppendReg( "mozart_mosaic_4bin_aq",ndx );
190 fprintf(fp_tmp,"\n");
191 fprintf(fp_tmp,"include registry.irr_diag\n");
192 fclose(fp_tmp);
193 strcpy( fname_in,fname_wrk );
194 irr_diag_scalar_indices( "inc" );
195 // fprintf(stderr,"fname_in = %s\n",fname_in);
198 if ( !strcmp(fname_in,"") ) fp_in = stdin ;
199 else
200 if (( fp_in = fopen( fname_in , "r" )) == NULL )
202 fprintf(stderr,"Registry program cannot open %s for reading. Ending.\n", fname_in ) ;
203 exit(2) ;
206 sprintf( fname_tmp , "Registry_tmp.%d",mypid) ;
207 if (( fp_tmp = fopen( fname_tmp , "w" )) == NULL )
209 fprintf(stderr,"Registry program cannot open temporary %s for writing. Ending.\n", fname_tmp ) ;
210 exit(2) ;
213 { char *e ;
214 strcpy( dir , fname_in ) ;
215 if ( ( e = rindex ( dir , '/' ) ) != NULL ) { *e = '\0' ; } else { strcpy( dir, "." ) ; }
217 if ( pre_parse( dir, fp_in, fp_tmp ) ) {
218 fprintf(stderr,"Problem with Registry File %s\n", fname_in ) ;
219 goto cleanup ;
221 sym_forget() ;
223 fclose(fp_in) ;
224 fclose(fp_tmp) ;
226 if (( fp_tmp = fopen( fname_tmp , "r" )) == NULL )
228 fprintf(stderr,"Registry program cannot open %s for reading. Ending.\n", fname_tmp ) ;
229 goto cleanup ;
233 reg_parse(fp_tmp) ;
235 fclose(fp_tmp) ;
237 check_dimspecs() ;
239 gen_state_struct( "inc" ) ;
240 gen_state_subtypes( "inc" ) ;
241 gen_alloc( "inc" ) ;
242 /* gen_alloc_count( "inc" ) ; */
243 gen_dealloc( "inc" ) ;
244 gen_scalar_indices( "inc" ) ;
245 gen_module_state_description( "frame" ) ;
246 gen_actual_args( "inc" ) ;
247 gen_actual_args_new( "inc" ) ;
248 gen_dummy_args( "inc" ) ;
249 gen_dummy_args_new( "inc" ) ;
250 gen_dummy_decls( "inc" ) ;
251 gen_dummy_decls_new( "inc" ) ;
252 gen_i1_decls( "inc" ) ;
253 gen_namelist_statements("inc") ;
254 gen_namelist_defines ( "inc", 0 ) ; /* without dimension statements */
255 gen_namelist_defines ( "inc", 1 ) ; /* with dimension statements */
256 gen_namelist_defaults ( "inc" ) ;
257 gen_namelist_script ( "inc" ) ;
258 gen_get_nl_config( "inc" ) ;
259 gen_config_assigns( "inc" ) ;
260 gen_config_reads( "inc" ) ;
261 gen_wrf_io( "inc" ) ;
262 gen_model_data_ord( "inc" ) ;
263 gen_nest_interp( "inc" ) ;
264 gen_nest_v_interp( "inc") ; /*KAL added this for vertical interpolation*/
265 gen_scalar_derefs( "inc" ) ;
266 gen_streams("inc") ;
268 /* this has to happen after gen_nest_interp, which adds halos to the AST */
269 gen_comms( "inc" ) ; /* this is either package supplied (by copying a */
270 /* gen_comms.c file into this directory) or a */
271 /* stubs routine. */
273 cleanup:
274 #ifdef _WIN32
275 if( do_irr_diag ) {
276 sprintf(command,"del /F /Q %s\n",fname_wrk );
277 system( command ) ;
279 sprintf(command,"del /F /Q %s\n",fname_tmp );
280 #else
281 if( do_irr_diag ) {
282 sprintf(command,"/bin/rm -f %s\n",fname_wrk );
283 system( command ) ;
285 sprintf(command,"/bin/rm -f %s\n",fname_tmp );
286 #endif
287 return system( command ) ;