1 | #include <stdio.h> |
---|
2 | #include <stdlib.h> |
---|
3 | #include <string.h> |
---|
4 | #ifndef _WIN32 |
---|
5 | # include <strings.h> |
---|
6 | #endif |
---|
7 | |
---|
8 | #include "protos.h" |
---|
9 | #include "registry.h" |
---|
10 | #include "data.h" |
---|
11 | |
---|
12 | #define DUMMY 1 |
---|
13 | #define ACTUAL 2 |
---|
14 | |
---|
15 | int |
---|
16 | gen_scalar_derefs ( char * dirname ) |
---|
17 | { |
---|
18 | scalar_derefs ( dirname ) ; |
---|
19 | return(0) ; |
---|
20 | } |
---|
21 | |
---|
22 | #define DIR_COPY_OUT 1 |
---|
23 | #define DIR_COPY_IN 2 |
---|
24 | |
---|
25 | int |
---|
26 | scalar_derefs ( char * dirname ) |
---|
27 | { |
---|
28 | FILE * fp ; |
---|
29 | char fname[NAMELEN] ; |
---|
30 | char * fn = "scalar_derefs.inc" ; |
---|
31 | char * p ; |
---|
32 | int linelen ; |
---|
33 | /* Had to increase size for SOA from 64*4096 to 64*7000, Manish Shrivastava 2010 */ |
---|
34 | char outstr[64*7000] ; |
---|
35 | |
---|
36 | if ( dirname == NULL ) return(1) ; |
---|
37 | if ( strlen(dirname) > 0 ) |
---|
38 | { sprintf(fname,"%s/%s",dirname,fn) ; } |
---|
39 | else |
---|
40 | { sprintf(fname,"%s",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 , &Domain, DIR_COPY_OUT ) ; |
---|
51 | fprintf(fp,"#else\n") ; |
---|
52 | scalar_derefs1 ( fp , &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 | |
---|
60 | int |
---|
61 | scalar_derefs1 ( FILE * fp , 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 | (p->node_kind & FIELD ) |
---|
78 | /* it is not a derived type -ajb */ |
---|
79 | || (p->node_kind & FIELD && (p->type->type_type != DERIVED) ) |
---|
80 | ) |
---|
81 | ) |
---|
82 | { |
---|
83 | for ( tag = 1 ; tag <= p->ntl ; tag++ ) |
---|
84 | { |
---|
85 | strcpy(fname,field_name(t4,p,(p->ntl>1)?tag:0)) ; |
---|
86 | /* generate deref */ |
---|
87 | if ( direction == DIR_COPY_OUT ) { |
---|
88 | fprintf(fp, " grid%%%s = %s\n",fname,fname ) ; |
---|
89 | } else { |
---|
90 | fprintf(fp, " %s = grid%%%s\n",fname,fname ) ; |
---|
91 | } |
---|
92 | } |
---|
93 | } |
---|
94 | } |
---|
95 | return(0) ; |
---|
96 | } |
---|
97 | |
---|