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 | |
---|
13 | int |
---|
14 | gen_scalar_derefs ( char * dirname ) |
---|
15 | { |
---|
16 | scalar_derefs ( dirname ) ; |
---|
17 | return(0) ; |
---|
18 | } |
---|
19 | |
---|
20 | #define DIR_COPY_OUT 1 |
---|
21 | #define DIR_COPY_IN 2 |
---|
22 | |
---|
23 | int |
---|
24 | scalar_derefs ( char * dirname ) |
---|
25 | { |
---|
26 | FILE * fp ; |
---|
27 | char fname[NAMELEN] ; |
---|
28 | char * fn = "scalar_derefs.inc" ; |
---|
29 | char * p ; |
---|
30 | int linelen ; |
---|
31 | char outstr[64*4096] ; |
---|
32 | |
---|
33 | if ( dirname == NULL ) return(1) ; |
---|
34 | if ( strlen(dirname) > 0 ) |
---|
35 | { sprintf(fname,"%s/%s",dirname,fn) ; } |
---|
36 | else |
---|
37 | { sprintf(fname,"%s",fn) ; } |
---|
38 | |
---|
39 | if ((fp = fopen( fname , "w" )) == NULL ) return(1) ; |
---|
40 | print_warning(fp,fname) ; |
---|
41 | fprintf(fp,"! BEGIN SCALAR DEREFS\n") ; |
---|
42 | linelen = 0 ; |
---|
43 | if ( sw_limit_args ) { |
---|
44 | fprintf(fp,"#undef CPY\n") ; |
---|
45 | fprintf(fp,"#undef CPYC\n") ; |
---|
46 | fprintf(fp,"#ifdef COPY_OUT\n") ; |
---|
47 | scalar_derefs1 ( fp , &Domain, DIR_COPY_OUT ) ; |
---|
48 | fprintf(fp,"#else\n") ; |
---|
49 | scalar_derefs1 ( fp , &Domain, DIR_COPY_IN ) ; |
---|
50 | fprintf(fp,"#endif\n") ; |
---|
51 | } |
---|
52 | fprintf(fp,"! END SCALAR DEREFS\n") ; |
---|
53 | close_the_file( fp ) ; |
---|
54 | return(0) ; |
---|
55 | } |
---|
56 | |
---|
57 | int |
---|
58 | scalar_derefs1 ( FILE * fp , node_t * node, int direction ) |
---|
59 | { |
---|
60 | node_t * p ; |
---|
61 | int tag ; |
---|
62 | char fname[NAMELEN] ; |
---|
63 | |
---|
64 | if ( node == NULL ) return(1) ; |
---|
65 | for ( p = node->fields ; p != NULL ; p = p->next ) |
---|
66 | { |
---|
67 | if ( p->node_kind & I1 ) continue ; /* short circuit any field that is not state */ |
---|
68 | /* short circuit DERIVED types */ |
---|
69 | if ( p->type->type_type == DERIVED ) continue ; |
---|
70 | /* short circuit non-scalars */ |
---|
71 | if ( p->ndims > 0 ) continue ; |
---|
72 | |
---|
73 | if ( ( |
---|
74 | (p->node_kind & FIELD ) |
---|
75 | /* it is not a derived type -ajb */ |
---|
76 | || (p->node_kind & FIELD && (p->type->type_type != DERIVED) ) |
---|
77 | ) |
---|
78 | ) |
---|
79 | { |
---|
80 | for ( tag = 1 ; tag <= p->ntl ; tag++ ) |
---|
81 | { |
---|
82 | strcpy(fname,field_name(t4,p,(p->ntl>1)?tag:0)) ; |
---|
83 | /* generate deref */ |
---|
84 | if ( direction == DIR_COPY_OUT ) { |
---|
85 | fprintf(fp, " grid%%%s = %s\n",fname,fname ) ; |
---|
86 | } else { |
---|
87 | fprintf(fp, " %s = grid%%%s\n",fname,fname ) ; |
---|
88 | } |
---|
89 | } |
---|
90 | } |
---|
91 | } |
---|
92 | return(0) ; |
---|
93 | } |
---|
94 | |
---|