source: lmdz_wrf/WRFV3/tools/gen_scalar_derefs.c @ 1

Last change on this file since 1 was 1, checked in by lfita, 10 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 2.4 KB
Line 
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
15int
16gen_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
25int
26scalar_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
60int
61scalar_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
Note: See TracBrowser for help on using the repository browser.