source: lmdz_wrf/trunk/WRFV3/tools/gen_wrf_io.c @ 1372

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

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 23.3 KB
Line 
1#include <stdio.h>
2#include <stdlib.h>
3#include <string.h>
4#ifdef _WIN32
5# define rindex(X,Y) strrchr(X,Y)
6# define index(X,Y) strchr(X,Y)
7#else
8# include <strings.h>
9#endif
10
11#include "protos.h"
12#include "registry.h"
13#include "data.h"
14#include "sym.h"
15
16static FILE * fp ;
17
18#define GEN_INPUT  1
19#define GEN_OUTPUT 2
20
21#define OP_F(A,B) \
22  fn = B ; \
23  if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s",dirname,fn) ; } \
24  else                       { sprintf(fname,"%s",fn) ; } \
25  if ((A = fopen( fname , "w" )) == NULL ) return(1) ; \
26  print_warning(A,fname) ; \
27  sym_forget() ;
28
29int
30gen_wrf_io ( char * dirname )
31{
32  char  fname[NAMELEN], *fn ;
33
34  if ( dirname == NULL ) return(1) ;
35
36  OP_F(fp,"wrf_bdyout.inc") ;
37  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , GEN_OUTPUT ) ;
38  close_the_file(fp) ;
39
40  OP_F(fp,"wrf_bdyin.inc") ;
41  gen_wrf_io2 ( fp , fname, "grid%" , NULL, Domain.fields , GEN_INPUT ) ;
42  close_the_file(fp) ;
43
44  return(0) ;
45}
46
47int
48gen_wrf_io2 ( FILE * fp , char * fname, char * structname , char * fourdname, node_t * node , int sw_io )
49{
50  node_t * p ;
51  int i , ii  ;
52  char x[NAMELEN], tag[NAMELEN], dexes[NAMELEN] ;
53  char dname[NAMELEN], dname_tmp[NAMELEN] ; 
54  char vname[NAMELEN], vname_x[NAMELEN],vname_1[NAMELEN], vname_2[NAMELEN], memord[NAMELEN] ;
55  char ddim[3][2][NAMELEN] ;
56  char mdim[3][2][NAMELEN] ;
57  char pdim[3][2][NAMELEN] ;
58  char ddim_no[3][2][NAMELEN] ;
59  char mdim_no[3][2][NAMELEN] ;
60  char pdim_no[3][2][NAMELEN] ;
61  char dimname[3][NAMELEN] ;
62  char stagstr[NAMELEN] ;
63  char * tend_tag ;
64
65  char post[NAMELEN] ;
66  char indices[NAMELEN] ;
67
68  int pass, passes, stagx, stagy, stagz ;
69  int xi, yi, zi ;
70  node_t * dimnode ;
71  int ok_to_collect_distribute ;
72
73/* set a flag according to what the stream is, if we're running on dm processors, if the
74   io layer cannot handle distributed data, and if we're selectively turning off the
75   collect/distribute message passing so that history and restart I/O is to separate files
76   but input and boundary I/O is unaffected */
77
78  ok_to_collect_distribute = !sw_distrib_io_layer && sw_dm_parallel  ;
79
80  if ( node == NULL ) return(1) ;
81  if ( structname == NULL ) return(1) ;
82  if ( fp == NULL ) return(1) ;
83
84  for ( p = node ; p != NULL ; p = p->next )
85  {
86
87
88    if ( p->ndims > 3 && ! p->node_kind & FOURD ) continue ; /* short circuit anything with more than 3 dims, (not counting 4d arrays) */
89
90    if ( p->node_kind & I1 ) continue ;  /* short circuit anything that's not a state var */
91
92    set_dim_strs( p, ddim, mdim, pdim , "", 0 ) ;           /* dimensions with staggering */
93    set_dim_strs( p, ddim_no, mdim_no, pdim_no , "", 1 ) ;  /* dimensions ignoring staggering */
94
95    strcpy(stagstr, "") ;
96    if ( p->stag_x ) strcat(stagstr, "X") ;
97    if ( p->stag_y ) strcat(stagstr, "Y") ;
98    if ( p->stag_z ) strcat(stagstr, "Z") ;
99
100
101    if ( !strcmp(p->name,"-") ) continue ;
102
103    if ( p->node_kind & FOURD )
104    {
105      node_t * nd , *pp ;
106      char p1[NAMELEN], sv[NAMELEN], tl[25] ;
107
108
109      set_dim_strs( p->members, ddim, mdim, pdim , "", 0 ) ;           /* dimensions with staggering */
110      set_dim_strs( p->members, ddim_no, mdim_no, pdim_no , "", 1 ) ;  /* dimensions ignoring staggering */
111
112
113/* BOUNDARY FOR 4-D TRACER */
114      {
115        int ibdy ;
116        int idx ;
117        node_t *fourd_bound_array ;
118        char *bdytag, *xdomainend, *ydomainend, *zdomainend, bdytag2[10],fourd_bnd[NAMELEN] ;
119        char *ds1,*de1,*ds2,*de2,*ds3,*de3,*ms1,*me1,*ms2,*me2,*ms3,*me3,*ps1,*pe1,*ps2,*pe2,*ps3,*pe3 ;
120
121/* check for the existence of a fourd boundary array */
122        sprintf(fourd_bnd,"%s_b",p->name) ;
123        if (( fourd_bound_array = get_entry( fourd_bnd  ,Domain.fields)) != NULL ) {
124
125          for ( i = 0 ; i < 3 ; i++ ) strcpy(dimname[i],"") ;
126          strcpy( dimname[2] , "bdy_width" ) ;
127          ds3 = "1" ; de3 = "config_flags%spec_bdy_width" ;
128          ms3 = "1" ; me3 = "config_flags%spec_bdy_width" ;
129          ps3 = "1" ; pe3 = "config_flags%spec_bdy_width" ;
130          if (( dimnode = get_dimnode_for_coord( p , COORD_Z )) != NULL )
131           { if ( p->stag_z ) { sprintf( dimname[1] ,"%s_stag", dimnode->dim_data_name) ; }
132             else             { strcpy(  dimname[1], dimnode->dim_data_name) ; }
133             if ( p->stag_z ) { zdomainend = "kde" ; }
134             else             { zdomainend = "(kde-1)" ; }
135             ds2 = "kds" ; de2 = zdomainend ;
136             ms2 = "kds" ; me2 = "kde" ;   /* 20020924 */
137             ps2 = "kds" ; pe2 = zdomainend ;
138           }
139          else
140           {
141             fprintf(stderr,"REGISTRY WARNING: 4D ARRAYS MUST HAVE VERT DIMENSION\n") ;
142           }
143          for ( pass = 0 ; pass < 2 ; pass++ ) {
144fprintf(fp,"DO itrace = PARAM_FIRST_SCALAR , num_%s\n",p->name ) ;
145/*fprintf(fp,"  IF (BTEST(%s_stream_table(grid%%id, itrace ) , switch )) THEN\n",p->name) ; */
146fprintf(fp,"  IF ( %s_boundary_table(grid%%id, itrace ) ) THEN\n",p->name) ;
147          for ( ibdy = 1 ; ibdy <= 4 ; ibdy++ )
148          {
149            if        ( pass == 0 && ibdy == 1 ) { bdytag = "_BXS" ;      /* west bdy   */
150            } else if ( pass == 0 && ibdy == 2 ) { bdytag = "_BXE" ;      /* east bdy   */
151            } else if ( pass == 0 && ibdy == 3 ) { bdytag = "_BYS" ;      /* south bdy   */
152            } else if ( pass == 0 && ibdy == 4 ) { bdytag = "_BYE" ;      /* north bdy   */
153            } else if ( pass == 1 && ibdy == 1 ) { bdytag = "_BTXS" ;      /* west bdy   */
154            } else if ( pass == 1 && ibdy == 2 ) { bdytag = "_BTXE" ;      /* east bdy   */
155            } else if ( pass == 1 && ibdy == 3 ) { bdytag = "_BTYS" ;      /* south bdy   */
156            } else if ( pass == 1 && ibdy == 4 ) { bdytag = "_BTYE" ;      /* north bdy   */
157            }
158            if ( ibdy == 1 || ibdy == 2 ) {
159              if (( dimnode = get_dimnode_for_coord( p , COORD_Y )) != NULL )
160              {
161                idx = get_index_for_coord( p , COORD_Y  ) ;
162                if ( p->stag_y ) { ydomainend = "jde" ; } else { ydomainend = "(jde-1)" ; }
163                ds1 = "1" ; de1 = ydomainend ;
164                ms1 = "1" ; me1 = "MAX( ide , jde )" ;
165                if ( sw_new_bdys ) {  /* 20070207 */
166                  if ( ! sw_new_with_old_bdys ) { ms1 = "jms" ; me1 = "jme" ; }
167                  if        ( sw_io == GEN_INPUT ) {
168                    ps1 = "MAX(jms,jds)" ;
169                    sprintf(t2,"MIN(jme,%s)",ydomainend) ; pe1 = t2 ;
170                  } else if ( sw_io == GEN_OUTPUT ) {
171                    ps1 = pdim[idx][0] ; pe1 = pdim[idx][1] ;
172                  }
173                } else {
174                  if        ( sw_io == GEN_INPUT ) {
175                    ps1 = "1" ; pe1 = ydomainend ;
176                  } else if ( sw_io == GEN_OUTPUT ) {
177                    ps1 = pdim[idx][0] ; pe1 = pdim[idx][1] ;
178                  }
179                }
180                if ( p->stag_y ) { sprintf( dimname[0] ,"%s_stag", dimnode->dim_data_name) ; }
181                else                   { strcpy( dimname[0], dimnode->dim_data_name) ; }
182              }
183            }
184            if ( ibdy == 3 || ibdy == 4 ) {
185              if (( dimnode = get_dimnode_for_coord( p , COORD_X )) != NULL )
186              {
187                idx = get_index_for_coord( p , COORD_X  ) ;
188                if ( p->stag_x ) { xdomainend = "ide" ; } else { xdomainend = "(ide-1)" ; }
189                ds1 = "1" ; de1 = xdomainend ;
190                ms1 = "1" ; me1 = "MAX( ide , jde )" ;
191                if ( sw_new_bdys ) {  /* 20070207 */
192                  if ( ! sw_new_with_old_bdys ) { ms1 = "ims" ; me1 = "ime" ; }
193                  if        ( sw_io == GEN_INPUT ) {
194                    ps1 = "MAX(ims,ids)" ;
195                    sprintf(t2,"MIN(ime,%s)",xdomainend) ; pe1 = t2 ;
196                  } else if ( sw_io == GEN_OUTPUT ) {
197                    ps1 = pdim[idx][0] ; pe1 = pdim[idx][1] ;
198                  }
199                } else {
200                  if        ( sw_io == GEN_INPUT ) {
201                    ps1 = "1" ; pe1 = xdomainend ;
202                  } else if ( sw_io == GEN_OUTPUT ) {
203                    ps1 = pdim[idx][0] ; pe1 = pdim[idx][1] ;
204                  }
205                }
206                if ( p->stag_x ) { sprintf( dimname[0] ,"%s_stag", dimnode->dim_data_name) ; }
207                else             { strcpy( dimname[0], dimnode->dim_data_name) ; }
208              }
209            }
210            if      ( p->ndims == 3 ) sprintf(memord,"%sZ",bdytag+2+pass ) ;
211            else if ( p->ndims == 2 ) sprintf(memord,"%s",bdytag+2+pass ) ;
212            else                      sprintf(memord,"0") ;
213fprintf(fp,"    CALL wrf_ext_%s_field (  &\n", (sw_io == GEN_INPUT)?"read":"write" ) ;
214fprintf(fp,"          fid                             , &  ! DataHandle\n") ;
215fprintf(fp,"          current_date(1:19)              , &  ! DateStr\n") ; 
216fprintf(fp,"          TRIM(%s_dname_table( grid%%id, itrace )) // '%s', & !data name\n",p->name,bdytag) ;
217            if ( ok_to_collect_distribute ) {
218fprintf(fp,"                       globbuf_%s               , &  ! Field \n",p->members->type->name ) ;
219            } else {
220              strcpy(bdytag2,"") ;
221              strncat(bdytag2,bdytag, pass+2) ;
222if ( sw_new_bdys && ! sw_new_with_old_bdys ) { /* 20070207 */
223  fprintf(fp,"          grid%%%s%s(%s,kds,1,itrace)  , &  ! Field\n",p->name,bdytag, ms1) ;
224} else {
225  fprintf(fp,"          grid%%%s%s(1,kds,1,%d,itrace)  , &  ! Field\n",p->name,bdytag2, ibdy) ;
226}
227            }
228            if (!strncmp(p->members->type->name,"real",4)) {
229              fprintf(fp,"                       WRF_FLOAT             , &  ! FieldType \n") ;
230            } else {
231              fprintf(fp,"                       WRF_%s             , &  ! FieldType \n" , p->members->type->name ) ;
232            }
233fprintf(fp,"          grid%%communicator  , &  ! Comm\n") ;
234fprintf(fp,"          grid%%iocommunicator  , &  ! Comm\n") ;
235fprintf(fp,"          grid%%domdesc       , &  ! Comm\n") ;
236fprintf(fp,"          grid%%bdy_mask       , &  ! bdy_mask\n") ;
237            if ( sw_io == GEN_OUTPUT ) {
238fprintf(fp,"          dryrun             , &  ! flag\n") ;
239            }
240fprintf(fp,"          '%s'               , &  ! MemoryOrder\n",memord) ;
241            strcpy(stagstr, "") ;
242            if ( p->members->stag_x ) strcat(stagstr, "X") ;
243            if ( p->members->stag_y ) strcat(stagstr, "Y") ;
244            if ( p->members->stag_z ) strcat(stagstr, "Z") ;
245fprintf(fp,"          '%s'                , &  ! Stagger\n",stagstr) ;
246            if ( sw_io == GEN_OUTPUT ) {
247fprintf(fp,"                       '%s'               , &  ! Dimname 1 \n",dimname[0] ) ;
248fprintf(fp,"                       '%s'               , &  ! Dimname 2 \n",dimname[1] ) ;
249fprintf(fp,"                       '%s'               , &  ! Dimname 3 \n",dimname[2] ) ;
250fprintf(fp,"          %s_desc_table( grid%%id, itrace  ), & ! Desc\n",p->name) ;
251fprintf(fp,"          %s_units_table( grid%%id, itrace  ), & ! Units\n",p->name) ;
252            }
253fprintf(fp,"'%s ext_write_field '//TRIM(%s_dname_table( grid%%id, itrace ))//' memorder %s' , & ! Debug message\n", fname, p->name,memord ) ;
254fprintf(fp,"%s, %s, %s, %s, %s, %s, &\n",ds1,de1,ds2,de2,ds3,de3 ) ;
255fprintf(fp,"%s, %s, %s, %s, %s, %s, &\n",ms1,me1,ms2,me2,ms3,me3 ) ;
256fprintf(fp,"%s, %s, %s, %s, %s, %s, &\n",ps1,pe1,ps2,pe2,ps3,pe3 ) ;
257fprintf(fp,"                         ierr )\n" ) ;
258          }
259fprintf(fp, "  ENDIF\n" ) ;
260fprintf(fp, "ENDDO\n") ;
261        }
262      }
263      } /* if fourd bound array associated with this tracer */
264    }
265    else if ( p->type != NULL )
266    {
267
268    if ( p->type->type == SIMPLE )
269    {
270
271/* ////////  BOUNDARY ///////////////////// */
272
273      if (  p->boundary && strcmp( p->use, "_4d_bdy_array_" ) || ( p->boundary && fourdname ) )
274      {
275        int ibdy ;
276        int idx ;
277        char *bdytag, *xdomainend, *ydomainend, *zdomainend ;
278        char *ds1,*de1,*ds2,*de2,*ds3,*de3,*ms1,*me1,*ms2,*me2,*ms3,*me3,*ps1,*pe1,*ps2,*pe2,*ps3,*pe3 ;
279        char t1[64], t2[64] ;
280
281        for ( i = 0 ; i < 3 ; i++ ) strcpy(dimname[i],"") ;
282        strcpy( dimname[2] , "bdy_width" ) ;
283        ds3 = "1" ; de3 = "config_flags%spec_bdy_width" ;
284        ms3 = "1" ; me3 = "config_flags%spec_bdy_width" ;
285        ps3 = "1" ; pe3 = "config_flags%spec_bdy_width" ;
286
287        if (( dimnode = get_dimnode_for_coord( p , COORD_Z )) != NULL )
288         { if ( p->stag_z ) { sprintf( dimname[1] ,"%s_stag", dimnode->dim_data_name) ; } 
289           else             { strcpy(  dimname[1], dimnode->dim_data_name) ; }
290           if ( p->stag_z ) { zdomainend = "kde" ; } 
291           else             { zdomainend = "(kde-1)" ; }
292           ds2 = "kds" ; de2 = zdomainend ;
293           ms2 = "kds" ; me2 = "kde" ;   /* 20020924 */
294           ps2 = "kds" ; pe2 = zdomainend ;
295         }
296        else
297         { strcpy(dimname[1],dimname[2]) ;
298           strcpy(dimname[2],"one_element") ; 
299           ds2 = ds3 ; de2 = de3 ;
300           ms2 = ms3 ; me2 = me3 ;
301           ps2 = ps3 ; pe2 = pe3 ;
302           ds3 = "1" ; de3 = "1" ;
303           ms3 = "1" ; me3 = "1" ;
304           ps3 = "1" ; pe3 = "1" ;
305         }
306
307        if ( strlen(p->dname) < 1 ) {
308          fprintf(stderr,"gen_wrf_io.c: Registry WARNING: no data name for %s \n",p->name) ;
309        }
310
311        for ( ibdy = 1 ; ibdy <= 4 ; ibdy++ )
312        {
313          if        ( ibdy == 1 ) { bdytag = "XS" ;      /* west bdy   */
314          } else if ( ibdy == 2 ) { bdytag = "XE" ;      /* east bdy   */
315          } else if ( ibdy == 3 ) { bdytag = "YS" ;      /* south bdy   */
316          } else if ( ibdy == 4 ) { bdytag = "YE" ;      /* north bdy   */
317          }
318          if ( strlen(p->dname)==0 || !strcmp(p->dname,"-") ) { sprintf(dname,"%s%s",p->name,bdytag)  ; }
319          else                                                { sprintf(dname,"%s%s",p->dname,bdytag) ; }
320
321          make_upper_case(dname) ;
322
323          if ( ibdy == 1 || ibdy == 2 ) { 
324            if (( dimnode = get_dimnode_for_coord( p , COORD_Y )) != NULL )
325            {
326              idx = get_index_for_coord( p , COORD_Y  ) ;
327              if ( p->stag_y ) { ydomainend = "jde" ; } else { ydomainend = "(jde-1)" ; }
328              ds1 = "1" ; de1 = ydomainend ;
329              ms1 = "1" ; me1 = "MAX( ide , jde )" ;
330              if ( sw_new_bdys ) {  /* 20070207 */
331                if ( ! sw_new_with_old_bdys ) { ms1 = "jms" ; me1 = "jme" ; }
332                if        ( sw_io == GEN_INPUT ) {
333                  ps1 = "MAX(jms,jds)" ;
334                  sprintf(t2,"MIN(jme,%s)",ydomainend) ; pe1 = t2 ;
335                } else if ( sw_io == GEN_OUTPUT ) {
336                  ps1 = pdim[idx][0] ; pe1 = pdim[idx][1] ;
337                }
338              } else {
339                if        ( sw_io == GEN_INPUT ) {
340                  ps1 = "1" ; pe1 = ydomainend ;
341                } else if ( sw_io == GEN_OUTPUT ) {
342                  ps1 = pdim[idx][0] ; pe1 = pdim[idx][1] ;
343                }
344              }
345              if ( p->stag_y ) { sprintf( dimname[0] ,"%s_stag", dimnode->dim_data_name) ; }
346              else                   { strcpy( dimname[0], dimnode->dim_data_name) ; }
347            }
348          }
349          if ( ibdy == 3 || ibdy == 4 ) {
350            if (( dimnode = get_dimnode_for_coord( p , COORD_X )) != NULL )
351            {
352              idx = get_index_for_coord( p , COORD_X  ) ;
353              if ( p->stag_x ) { xdomainend = "ide" ; } else { xdomainend = "(ide-1)" ; }
354              ds1 = "1" ; de1 = xdomainend ;
355              ms1 = "1" ; me1 = "MAX( ide , jde )" ;
356              if ( sw_new_bdys ) {  /* 20070207 */
357                if ( ! sw_new_with_old_bdys ) { ms1 = "ims" ; me1 = "ime" ; }
358                if        ( sw_io == GEN_INPUT ) {
359                  ps1 = "MAX(ims,ids)" ;
360                  sprintf(t2,"MIN(ime,%s)",xdomainend) ; pe1 = t2 ;
361                } else if ( sw_io == GEN_OUTPUT ) {
362                  ps1 = pdim[idx][0] ; pe1 = pdim[idx][1] ;
363                }
364              } else {
365                ms1 = "1" ; me1 = "MAX( ide , jde )" ;
366                if        ( sw_io == GEN_INPUT ) {
367                  ps1 = "1" ; pe1 = xdomainend ;
368                } else if ( sw_io == GEN_OUTPUT ) {
369                  ps1 = pdim[idx][0] ; pe1 = pdim[idx][1] ;
370                }
371              }
372              if ( p->stag_x ) { sprintf( dimname[0] ,"%s_stag", dimnode->dim_data_name) ; }
373              else             { strcpy( dimname[0], dimnode->dim_data_name) ; }
374            }
375          }
376          if      ( p->ndims == 3 ) sprintf(memord,"%sZ",bdytag ) ;
377          else if ( p->ndims == 2 ) sprintf(memord,"%s",bdytag ) ;
378          else                      sprintf(memord,"0") ;
379
380        passes = 1 ;
381        if ( fourdname != NULL ) passes = 2 ;
382        for ( pass = 0 ; pass < passes ; pass++ ) {
383          tend_tag = ( pass == 0 ) ? "_B" : "_BT" ;
384          if ( sw_io == GEN_INPUT )
385          {
386            if ( ok_to_collect_distribute )
387              fprintf(fp,"IF ( wrf_dm_on_monitor() ) THEN\n") ;
388            fprintf(fp,"CALL wrf_ext_read_field (  &\n") ;
389            fprintf(fp,"                       fid                , &  ! DataHandle \n" ) ;
390            fprintf(fp,"                       current_date(1:19) , &  ! DateStr \n" ) ;
391            if ( fourdname == NULL ) {
392              fprintf(fp,"                       '%s'               , &  ! Data Name \n", dname ) ;
393              if ( sw_new_bdys && ! sw_new_with_old_bdys ) { /* 20070207 */
394                fprintf(fp,"                       %s%s%s(%s,kds,1)     , &  ! Field \n" , structname , p->name, bdy_indicator(ibdy), ms1 ) ;
395              } else {
396                fprintf(fp,"                       %s%s(1,kds,1,%d)     , &  ! Field \n" , structname , p->name, ibdy ) ;
397              }
398            } else {
399              if ( strlen(p->dname)==0 || !strcmp(p->dname,"-") ) { sprintf(dname,"%s%s%s",p->name,tend_tag,bdytag)  ; }
400              else                                                { sprintf(dname,"%s%s%s",p->dname,tend_tag,bdytag) ; }
401              fprintf(fp,"                       '%s'               , &  ! Data Name \n", dname ) ;
402              if ( sw_new_bdys && ! sw_new_with_old_bdys ) { /* 20070207 */
403                fprintf(fp,"                       %s%s%s%s(%s,kds,1,P_%s)     , &  ! Field \n" , 
404                         structname , fourdname, tend_tag, bdy_indicator(ibdy), ms1, p->name ) ;
405              } else {
406                fprintf(fp,"                       %s%s%s(1,kds,1,%d,P_%s)     , &  ! Field \n" , 
407                         structname , fourdname, tend_tag, ibdy, p->name ) ;
408              }
409            }
410            if (!strncmp(p->type->name,"real",4)) {
411              fprintf(fp,"                       WRF_FLOAT             , &  ! FieldType \n") ;
412            } else {
413              fprintf(fp,"                       WRF_%s             , &  ! FieldType \n" , p->type->name ) ;
414            }
415            fprintf(fp,"                       grid%%communicator , &  ! Comm\n") ;
416            fprintf(fp,"                       grid%%iocommunicator , &  ! Comm\n") ;
417            fprintf(fp,"                       grid%%domdesc      , &  ! Comm\n") ;
418            fprintf(fp,"                       grid%%bdy_mask     , &  ! bdy_mask\n" ) ;
419            fprintf(fp,"                       '%s'               , &  ! MemoryOrder\n",memord ) ;
420            fprintf(fp,"                       '%s'               , &  ! Stagger\n",stagstr ) ;
421            fprintf(fp,"'%s ext_read_field %s memorder %s' , & ! Debug message\n",fname,dname,memord ) ;
422            /* global dimensions */
423            fprintf(fp,"%s, %s, %s, %s, %s, %s, &\n",ds1,de1,ds2,de2,ds3,de3 ) ;
424            fprintf(fp,"%s, %s, %s, %s, %s, %s, &\n",ms1,me1,ms2,me2,ms3,me3 ) ;
425            fprintf(fp,"%s, %s, %s, %s, %s, %s, &\n",ps1,pe1,ps2,pe2,ps3,pe3 ) ;
426            fprintf(fp,"                       ierr )\n") ;
427            if ( ok_to_collect_distribute )
428            {
429              fprintf(fp,"ENDIF\n") ;
430              fprintf(fp,"CALL wrf_dm_bcast_%s ( %s%s ( 1, 1 , 1 , %d ) , &\n",p->type->name, structname , p->name, ibdy) ;
431              fprintf(fp," ((%s)-(%s)+1)*((%s)-(%s)+1)*((%s)-(%s)+1)  )\n",me1,ms1,me2,ms2,me3,ms3)  ;
432            }
433          }
434          else if ( sw_io == GEN_OUTPUT )
435          {
436            if ( ok_to_collect_distribute )
437              fprintf(fp,"IF ( wrf_dm_on_monitor() ) THEN\n") ;
438            fprintf(fp,"CALL wrf_ext_write_field (  &\n") ;
439            fprintf(fp,"                       fid                , &  ! DataHandle \n" ) ;
440            fprintf(fp,"                       current_date(1:19) , &  ! DateStr \n" ) ;
441            if ( fourdname == NULL ) {
442              fprintf(fp,"                       '%s'               , &  ! Data Name \n", dname ) ;
443              if ( sw_new_bdys && ! sw_new_with_old_bdys ) { /* 20070207 */
444                fprintf(fp,"                       %s%s%s(%s,kds,1)     , &  ! Field \n" , structname , p->name, bdy_indicator(ibdy), ms1 ) ;
445              } else {
446                fprintf(fp,"                       %s%s(1,kds,1,%d)     , &  ! Field \n" , structname , p->name, ibdy ) ;
447              }
448            } else {
449              if ( strlen(p->dname)==0 || !strcmp(p->dname,"-") ) { sprintf(dname,"%s%s%s",p->name,tend_tag,bdytag)  ; }
450              else                                                { sprintf(dname,"%s%s%s",p->dname,tend_tag,bdytag) ; }
451              fprintf(fp,"                       '%s'               , &  ! Data Name \n", dname ) ;
452              if ( sw_new_bdys && ! sw_new_with_old_bdys ) { /* 20070207 */
453                fprintf(fp,"                       %s%s%s(%s,kds,1,P_%s)     , &  ! Field \n" , 
454                                       structname , fourdname, tend_tag, ms1, bdy_indicator(ibdy) ) ;
455              } else {
456                fprintf(fp,"                       %s%s%s(1,kds,1,%d,P_%s)     , &  ! Field \n" , 
457                                       structname , fourdname, tend_tag, ibdy, bdy_indicator(ibdy) ) ;
458              }
459            }
460            if (!strncmp(p->type->name,"real",4)) {
461              fprintf(fp,"                       WRF_FLOAT          , &  ! FieldType \n") ;
462            } else {
463              fprintf(fp,"                       WRF_%s             , &  ! FieldType \n" , p->type->name ) ;
464            }
465            fprintf(fp,"                       grid%%communicator , &  ! Comm\n") ;
466            fprintf(fp,"                       grid%%iocommunicator , &  ! Comm\n") ;
467            fprintf(fp,"                       grid%%domdesc      , &  ! Comm\n") ;
468            fprintf(fp,"                       grid%%bdy_mask     , &  ! bdy_mask\n" ) ;
469            fprintf(fp,"                       dryrun             , &  ! flag\n" ) ;
470            fprintf(fp,"                       '%s'               , &  ! MemoryOrder\n",memord ) ;
471            fprintf(fp,"                       '%s'               , &  ! Stagger\n",stagstr ) ;
472            fprintf(fp,"                       '%s'               , &  ! Dimname 1 \n",dimname[0] ) ;
473            fprintf(fp,"                       '%s'               , &  ! Dimname 2 \n",dimname[1] ) ;
474            fprintf(fp,"                       '%s'               , &  ! Dimname 3 \n",dimname[2] ) ;
475            fprintf(fp,"                       '%s'               , &  ! Desc  \n",p->descrip ) ;
476            fprintf(fp,"                       '%s'               , &  ! Units \n",p->units ) ;
477            fprintf(fp,"'%s ext_write_field %s memorder %s' , & ! Debug message\n",fname,dname,memord ) ;
478            /* global dimensions */
479            fprintf(fp,"%s, %s, %s, %s, %s, %s, &\n",ds1,de1,ds2,de2,ds3,de3 ) ;
480            fprintf(fp,"%s, %s, %s, %s, %s, %s, &\n",ms1,me1,ms2,me2,ms3,me3 ) ;
481            fprintf(fp,"%s, %s, %s, %s, %s, %s, &\n",ps1,pe1,ps2,pe2,ps3,pe3 ) ;
482            fprintf(fp,"                       ierr )\n") ;
483            if ( ok_to_collect_distribute )
484              fprintf(fp,"ENDIF\n") ;
485          }
486        }
487        }
488      }
489
490    }
491
492    }
493  }
494  return(0) ;
495}
496
Note: See TracBrowser for help on using the repository browser.