?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
updated top-level README and version_decl for V4.5 (#1847)
[WRF.git] / tools / gen_wrf_io.c
blob87c539b6e0256631f86fc3d7afe2ff2db203b971
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
16 static 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
29 int
30 gen_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
47 int
48 gen_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 #if ( WRFPLUS == 1 )
122 /* adjoint and perturbation variables should not be inputed*/
123 if (( !strncmp( p->name, "a_", 2) || !strncmp( p->name, "g_", 2) ) && sw_io == GEN_INPUT ) continue ;
124 /* only adjoint variables should be output*/
125 if ( strncmp( p->name, "a_", 2) && sw_io == GEN_OUTPUT ) continue ;
126 #endif
127
128 /* check for the existence of a fourd boundary array */
129 sprintf(fourd_bnd,"%s_b",p->name) ;
130 if (( fourd_bound_array = get_entry( fourd_bnd ,Domain.fields)) != NULL ) {
131
132 for ( i = 0 ; i < 3 ; i++ ) strcpy(dimname[i],"") ;
133 strcpy( dimname[2] , "bdy_width" ) ;
134 ds3 = "1" ; de3 = "config_flags%spec_bdy_width" ;
135 ms3 = "1" ; me3 = "config_flags%spec_bdy_width" ;
136 ps3 = "1" ; pe3 = "config_flags%spec_bdy_width" ;
137 if (( dimnode = get_dimnode_for_coord( p , COORD_Z )) != NULL )
138 { if ( p->stag_z ) { sprintf( dimname[1] ,"%s_stag", dimnode->dim_data_name) ; }
139 else { strcpy( dimname[1], dimnode->dim_data_name) ; }
140 if ( p->stag_z ) { zdomainend = "kde" ; }
141 else { zdomainend = "(kde-1)" ; }
142 ds2 = "kds" ; de2 = zdomainend ;
143 ms2 = "kds" ; me2 = "kde" ; /* 20020924 */
144 ps2 = "kds" ; pe2 = zdomainend ;
145 }
146 else
147 {
148 fprintf(stderr,"REGISTRY WARNING: 4D ARRAYS MUST HAVE VERT DIMENSION\n") ;
149 }
150 for ( pass = 0 ; pass < 2 ; pass++ ) {
151 fprintf(fp,"DO itrace = PARAM_FIRST_SCALAR , num_%s\n",p->name ) ;
152 /*fprintf(fp," IF (BTEST(%s_stream_table(grid%%id, itrace ) , switch )) THEN\n",p->name) ; */
153 fprintf(fp," IF ( %s_boundary_table(grid%%id, itrace ) ) THEN\n",p->name) ;
154 for ( ibdy = 1 ; ibdy <= 4 ; ibdy++ )
155 {
156 if ( pass == 0 && ibdy == 1 ) { bdytag = "_BXS" ; /* west bdy */
157 } else if ( pass == 0 && ibdy == 2 ) { bdytag = "_BXE" ; /* east bdy */
158 } else if ( pass == 0 && ibdy == 3 ) { bdytag = "_BYS" ; /* south bdy */
159 } else if ( pass == 0 && ibdy == 4 ) { bdytag = "_BYE" ; /* north bdy */
160 } else if ( pass == 1 && ibdy == 1 ) { bdytag = "_BTXS" ; /* west bdy */
161 } else if ( pass == 1 && ibdy == 2 ) { bdytag = "_BTXE" ; /* east bdy */
162 } else if ( pass == 1 && ibdy == 3 ) { bdytag = "_BTYS" ; /* south bdy */
163 } else if ( pass == 1 && ibdy == 4 ) { bdytag = "_BTYE" ; /* north bdy */
164 }
165 if ( ibdy == 1 || ibdy == 2 ) {
166 if (( dimnode = get_dimnode_for_coord( p , COORD_Y )) != NULL )
167 {
168 idx = get_index_for_coord( p , COORD_Y ) ;
169 if ( p->stag_y ) { ydomainend = "jde" ; } else { ydomainend = "(jde-1)" ; }
170 ds1 = "1" ; de1 = ydomainend ;
171 ms1 = "1" ; me1 = "MAX( ide , jde )" ;
172 if ( sw_new_bdys ) { /* 20070207 */
173 if ( ! sw_new_with_old_bdys ) { ms1 = "jms" ; me1 = "jme" ; }
174 if ( sw_io == GEN_INPUT ) {
175 ps1 = "MAX(jms,jds)" ;
176 sprintf(t2,"MIN(jme,%s)",ydomainend) ; pe1 = t2 ;
177 } else if ( sw_io == GEN_OUTPUT ) {
178 ps1 = pdim[idx][0] ; pe1 = pdim[idx][1] ;
179 }
180 } else {
181 if ( sw_io == GEN_INPUT ) {
182 ps1 = "1" ; pe1 = ydomainend ;
183 } else if ( sw_io == GEN_OUTPUT ) {
184 ps1 = pdim[idx][0] ; pe1 = pdim[idx][1] ;
185 }
186 }
187 if ( p->stag_y ) { sprintf( dimname[0] ,"%s_stag", dimnode->dim_data_name) ; }
188 else { strcpy( dimname[0], dimnode->dim_data_name) ; }
189 }
190 }
191 if ( ibdy == 3 || ibdy == 4 ) {
192 if (( dimnode = get_dimnode_for_coord( p , COORD_X )) != NULL )
193 {
194 idx = get_index_for_coord( p , COORD_X ) ;
195 if ( p->stag_x ) { xdomainend = "ide" ; } else { xdomainend = "(ide-1)" ; }
196 ds1 = "1" ; de1 = xdomainend ;
197 ms1 = "1" ; me1 = "MAX( ide , jde )" ;
198 if ( sw_new_bdys ) { /* 20070207 */
199 if ( ! sw_new_with_old_bdys ) { ms1 = "ims" ; me1 = "ime" ; }
200 if ( sw_io == GEN_INPUT ) {
201 ps1 = "MAX(ims,ids)" ;
202 sprintf(t2,"MIN(ime,%s)",xdomainend) ; pe1 = t2 ;
203 } else if ( sw_io == GEN_OUTPUT ) {
204 ps1 = pdim[idx][0] ; pe1 = pdim[idx][1] ;
205 }
206 } else {
207 if ( sw_io == GEN_INPUT ) {
208 ps1 = "1" ; pe1 = xdomainend ;
209 } else if ( sw_io == GEN_OUTPUT ) {
210 ps1 = pdim[idx][0] ; pe1 = pdim[idx][1] ;
211 }
212 }
213 if ( p->stag_x ) { sprintf( dimname[0] ,"%s_stag", dimnode->dim_data_name) ; }
214 else { strcpy( dimname[0], dimnode->dim_data_name) ; }
215 }
216 }
217 if ( p->ndims == 3 ) sprintf(memord,"%sZ",bdytag+2+pass ) ;
218 else if ( p->ndims == 2 ) sprintf(memord,"%s",bdytag+2+pass ) ;
219 else sprintf(memord,"0") ;
220 fprintf(fp," CALL wrf_ext_%s_field ( &\n", (sw_io == GEN_INPUT)?"read":"write" ) ;
221 fprintf(fp," fid , & ! DataHandle\n") ;
222 fprintf(fp," current_date(1:19) , & ! DateStr\n") ;
223 fprintf(fp," TRIM(%s_dname_table( grid%%id, itrace )) // '%s', & !data name\n",p->name,bdytag) ;
224 if ( ok_to_collect_distribute ) {
225 fprintf(fp," globbuf_%s , & ! Field \n",p->members->type->name ) ;
226 } else {
227 strcpy(bdytag2,"") ;
228 strncat(bdytag2,bdytag, pass+2) ;
229 if ( sw_new_bdys && ! sw_new_with_old_bdys ) { /* 20070207 */
230 fprintf(fp," grid%%%s%s(%s,kds,1,itrace) , & ! Field\n",p->name,bdytag, ms1) ;
231 } else {
232 fprintf(fp," grid%%%s%s(1,kds,1,%d,itrace) , & ! Field\n",p->name,bdytag2, ibdy) ;
233 }
234 }
235 if (!strncmp(p->members->type->name,"real",4)) {
236 fprintf(fp," WRF_FLOAT , & ! FieldType \n") ;
237 } else {
238 fprintf(fp," WRF_%s , & ! FieldType \n" , p->members->type->name ) ;
239 }
240 fprintf(fp," grid , & ! grid\n") ;
241 fprintf(fp," grid%%domdesc , & ! Comm\n") ;
242 fprintf(fp," grid%%bdy_mask , & ! bdy_mask\n") ;
243 if ( sw_io == GEN_OUTPUT ) {
244 fprintf(fp," dryrun , & ! flag\n") ;
245 }
246 fprintf(fp," '%s' , & ! MemoryOrder\n",memord) ;
247 strcpy(stagstr, "") ;
248 if ( p->members->stag_x ) strcat(stagstr, "X") ;
249 if ( p->members->stag_y ) strcat(stagstr, "Y") ;
250 if ( p->members->stag_z ) strcat(stagstr, "Z") ;
251 fprintf(fp," '%s' , & ! Stagger\n",stagstr) ;
252 if ( sw_io == GEN_OUTPUT ) {
253 fprintf(fp," '%s' , & ! Dimname 1 \n",dimname[0] ) ;
254 fprintf(fp," '%s' , & ! Dimname 2 \n",dimname[1] ) ;
255 fprintf(fp," '%s' , & ! Dimname 3 \n",dimname[2] ) ;
256 fprintf(fp," %s_desc_table( grid%%id, itrace ), & ! Desc\n",p->name) ;
257 fprintf(fp," %s_units_table( grid%%id, itrace ), & ! Units\n",p->name) ;
258 }
259 fprintf(fp,"'%s ext_write_field '//TRIM(%s_dname_table( grid%%id, itrace ))//' memorder %s' , & ! Debug message\n", fname, p->name,memord ) ;
260 fprintf(fp,"%s, %s, %s, %s, %s, %s, &\n",ds1,de1,ds2,de2,ds3,de3 ) ;
261 fprintf(fp,"%s, %s, %s, %s, %s, %s, &\n",ms1,me1,ms2,me2,ms3,me3 ) ;
262 fprintf(fp,"%s, %s, %s, %s, %s, %s, &\n",ps1,pe1,ps2,pe2,ps3,pe3 ) ;
263 fprintf(fp," ierr )\n" ) ;
264 }
265 fprintf(fp, " ENDIF\n" ) ;
266 fprintf(fp, "ENDDO\n") ;
267 }
268 }
269 } /* if fourd bound array associated with this tracer */
270 }
271 else if ( p->type != NULL )
272 {
273
274 if ( p->type->type == SIMPLE )
275 {
276
277 /* //////// BOUNDARY ///////////////////// */
278
279 if ( p->boundary && strcmp( p->use, "_4d_bdy_array_" ) || ( p->boundary && fourdname ) )
280 {
281 int ibdy ;
282 int idx ;
283 char *bdytag, *xdomainend, *ydomainend, *zdomainend ;
284 char *ds1,*de1,*ds2,*de2,*ds3,*de3,*ms1,*me1,*ms2,*me2,*ms3,*me3,*ps1,*pe1,*ps2,*pe2,*ps3,*pe3 ;
285 char t1[64], t2[64] ;
286
287 #if ( WRFPLUS == 1 )
288 /* adjoint and perturbation variables should not be input*/
289 if (( !strncmp( p->name, "a_", 2) || !strncmp( p->name, "g_", 2) ) && sw_io == GEN_INPUT ) continue ;
290 /* only adjoint variables should be output*/
291 if ( strncmp( p->name, "a_", 2) && sw_io == GEN_OUTPUT ) continue ;
292 #endif
293
294 for ( i = 0 ; i < 3 ; i++ ) strcpy(dimname[i],"") ;
295 strcpy( dimname[2] , "bdy_width" ) ;
296 ds3 = "1" ; de3 = "config_flags%spec_bdy_width" ;
297 ms3 = "1" ; me3 = "config_flags%spec_bdy_width" ;
298 ps3 = "1" ; pe3 = "config_flags%spec_bdy_width" ;
299
300 if (( dimnode = get_dimnode_for_coord( p , COORD_Z )) != NULL )
301 { if ( p->stag_z ) { sprintf( dimname[1] ,"%s_stag", dimnode->dim_data_name) ; }
302 else { strcpy( dimname[1], dimnode->dim_data_name) ; }
303 if ( p->stag_z ) { zdomainend = "kde" ; }
304 else { zdomainend = "(kde-1)" ; }
305 ds2 = "kds" ; de2 = zdomainend ;
306 ms2 = "kds" ; me2 = "kde" ; /* 20020924 */
307 ps2 = "kds" ; pe2 = zdomainend ;
308 }
309 else
310 { strcpy(dimname[1],dimname[2]) ;
311 strcpy(dimname[2],"one_element") ;
312 ds2 = ds3 ; de2 = de3 ;
313 ms2 = ms3 ; me2 = me3 ;
314 ps2 = ps3 ; pe2 = pe3 ;
315 ds3 = "1" ; de3 = "1" ;
316 ms3 = "1" ; me3 = "1" ;
317 ps3 = "1" ; pe3 = "1" ;
318 }
319
320 if ( strlen(p->dname) < 1 ) {
321 fprintf(stderr,"gen_wrf_io.c: Registry WARNING: no data name for %s \n",p->name) ;
322 }
323
324 for ( ibdy = 1 ; ibdy <= 4 ; ibdy++ )
325 {
326 if ( ibdy == 1 ) { bdytag = "XS" ; /* west bdy */
327 } else if ( ibdy == 2 ) { bdytag = "XE" ; /* east bdy */
328 } else if ( ibdy == 3 ) { bdytag = "YS" ; /* south bdy */
329 } else if ( ibdy == 4 ) { bdytag = "YE" ; /* north bdy */
330 }
331 if ( strlen(p->dname)==0 || !strcmp(p->dname,"-") ) { sprintf(dname,"%s%s",p->name,bdytag) ; }
332 else { sprintf(dname,"%s%s",p->dname,bdytag) ; }
333
334 make_upper_case(dname) ;
335
336 if ( ibdy == 1 || ibdy == 2 ) {
337 if (( dimnode = get_dimnode_for_coord( p , COORD_Y )) != NULL )
338 {
339 idx = get_index_for_coord( p , COORD_Y ) ;
340 if ( p->stag_y ) { ydomainend = "jde" ; } else { ydomainend = "(jde-1)" ; }
341 ds1 = "1" ; de1 = ydomainend ;
342 ms1 = "1" ; me1 = "MAX( ide , jde )" ;
343 if ( sw_new_bdys ) { /* 20070207 */
344 if ( ! sw_new_with_old_bdys ) { ms1 = "jms" ; me1 = "jme" ; }
345 if ( sw_io == GEN_INPUT ) {
346 ps1 = "MAX(jms,jds)" ;
347 sprintf(t2,"MIN(jme,%s)",ydomainend) ; pe1 = t2 ;
348 } else if ( sw_io == GEN_OUTPUT ) {
349 ps1 = pdim[idx][0] ; pe1 = pdim[idx][1] ;
350 }
351 } else {
352 if ( sw_io == GEN_INPUT ) {
353 ps1 = "1" ; pe1 = ydomainend ;
354 } else if ( sw_io == GEN_OUTPUT ) {
355 ps1 = pdim[idx][0] ; pe1 = pdim[idx][1] ;
356 }
357 }
358 if ( p->stag_y ) { sprintf( dimname[0] ,"%s_stag", dimnode->dim_data_name) ; }
359 else { strcpy( dimname[0], dimnode->dim_data_name) ; }
360 }
361 }
362 if ( ibdy == 3 || ibdy == 4 ) {
363 if (( dimnode = get_dimnode_for_coord( p , COORD_X )) != NULL )
364 {
365 idx = get_index_for_coord( p , COORD_X ) ;
366 if ( p->stag_x ) { xdomainend = "ide" ; } else { xdomainend = "(ide-1)" ; }
367 ds1 = "1" ; de1 = xdomainend ;
368 ms1 = "1" ; me1 = "MAX( ide , jde )" ;
369 if ( sw_new_bdys ) { /* 20070207 */
370 if ( ! sw_new_with_old_bdys ) { ms1 = "ims" ; me1 = "ime" ; }
371 if ( sw_io == GEN_INPUT ) {
372 ps1 = "MAX(ims,ids)" ;
373 sprintf(t2,"MIN(ime,%s)",xdomainend) ; pe1 = t2 ;
374 } else if ( sw_io == GEN_OUTPUT ) {
375 ps1 = pdim[idx][0] ; pe1 = pdim[idx][1] ;
376 }
377 } else {
378 ms1 = "1" ; me1 = "MAX( ide , jde )" ;
379 if ( sw_io == GEN_INPUT ) {
380 ps1 = "1" ; pe1 = xdomainend ;
381 } else if ( sw_io == GEN_OUTPUT ) {
382 ps1 = pdim[idx][0] ; pe1 = pdim[idx][1] ;
383 }
384 }
385 if ( p->stag_x ) { sprintf( dimname[0] ,"%s_stag", dimnode->dim_data_name) ; }
386 else { strcpy( dimname[0], dimnode->dim_data_name) ; }
387 }
388 }
389 if ( p->ndims == 3 ) sprintf(memord,"%sZ",bdytag ) ;
390 else if ( p->ndims == 2 ) sprintf(memord,"%s",bdytag ) ;
391 else sprintf(memord,"0") ;
392
393 passes = 1 ;
394 if ( fourdname != NULL ) passes = 2 ;
395 for ( pass = 0 ; pass < passes ; pass++ ) {
396 tend_tag = ( pass == 0 ) ? "_B" : "_BT" ;
397 if ( sw_io == GEN_INPUT )
398 {
399 if ( ok_to_collect_distribute )
400 fprintf(fp,"IF ( wrf_dm_on_monitor() ) THEN\n") ;
401 fprintf(fp,"CALL wrf_ext_read_field ( &\n") ;
402 fprintf(fp," fid , & ! DataHandle \n" ) ;
403 fprintf(fp," current_date(1:19) , & ! DateStr \n" ) ;
404 if ( fourdname == NULL ) {
405 fprintf(fp," '%s' , & ! Data Name \n", dname ) ;
406 if ( sw_new_bdys && ! sw_new_with_old_bdys ) { /* 20070207 */
407 fprintf(fp," %s%s%s(%s,kds,1) , & ! Field \n" , structname , p->name, bdy_indicator(ibdy), ms1 ) ;
408 } else {
409 fprintf(fp," %s%s(1,kds,1,%d) , & ! Field \n" , structname , p->name, ibdy ) ;
410 }
411 } else {
412 if ( strlen(p->dname)==0 || !strcmp(p->dname,"-") ) { sprintf(dname,"%s%s%s",p->name,tend_tag,bdytag) ; }
413 else { sprintf(dname,"%s%s%s",p->dname,tend_tag,bdytag) ; }
414 fprintf(fp," '%s' , & ! Data Name \n", dname ) ;
415 if ( sw_new_bdys && ! sw_new_with_old_bdys ) { /* 20070207 */
416 fprintf(fp," %s%s%s%s(%s,kds,1,P_%s) , & ! Field \n" ,
417 structname , fourdname, tend_tag, bdy_indicator(ibdy), ms1, p->name ) ;
418 } else {
419 fprintf(fp," %s%s%s(1,kds,1,%d,P_%s) , & ! Field \n" ,
420 structname , fourdname, tend_tag, ibdy, p->name ) ;
421 }
422 }
423 if (!strncmp(p->type->name,"real",4)) {
424 fprintf(fp," WRF_FLOAT , & ! FieldType \n") ;
425 } else {
426 fprintf(fp," WRF_%s , & ! FieldType \n" , p->type->name ) ;
427 }
428 fprintf(fp," grid , & ! grid\n") ;
429 fprintf(fp," grid%%domdesc , & ! Comm\n") ;
430 fprintf(fp," grid%%bdy_mask , & ! bdy_mask\n" ) ;
431 fprintf(fp," '%s' , & ! MemoryOrder\n",memord ) ;
432 fprintf(fp," '%s' , & ! Stagger\n",stagstr ) ;
433 fprintf(fp,"'%s ext_read_field %s memorder %s' , & ! Debug message\n",fname,dname,memord ) ;
434 /* global dimensions */
435 fprintf(fp,"%s, %s, %s, %s, %s, %s, &\n",ds1,de1,ds2,de2,ds3,de3 ) ;
436 fprintf(fp,"%s, %s, %s, %s, %s, %s, &\n",ms1,me1,ms2,me2,ms3,me3 ) ;
437 fprintf(fp,"%s, %s, %s, %s, %s, %s, &\n",ps1,pe1,ps2,pe2,ps3,pe3 ) ;
438 fprintf(fp," ierr )\n") ;
439 if ( ok_to_collect_distribute )
440 {
441 fprintf(fp,"ENDIF\n") ;
442 fprintf(fp,"CALL wrf_dm_bcast_%s ( %s%s ( 1, 1 , 1 , %d ) , &\n",p->type->name, structname , p->name, ibdy) ;
443 fprintf(fp," ((%s)-(%s)+1)*((%s)-(%s)+1)*((%s)-(%s)+1) )\n",me1,ms1,me2,ms2,me3,ms3) ;
444 }
445 }
446 else if ( sw_io == GEN_OUTPUT )
447 {
448 if ( ok_to_collect_distribute )
449 fprintf(fp,"IF ( wrf_dm_on_monitor() ) THEN\n") ;
450 fprintf(fp,"CALL wrf_ext_write_field ( &\n") ;
451 fprintf(fp," fid , & ! DataHandle \n" ) ;
452 fprintf(fp," current_date(1:19) , & ! DateStr \n" ) ;
453 if ( fourdname == NULL ) {
454 fprintf(fp," '%s' , & ! Data Name \n", dname ) ;
455 if ( sw_new_bdys && ! sw_new_with_old_bdys ) { /* 20070207 */
456 fprintf(fp," %s%s%s(%s,kds,1) , & ! Field \n" , structname , p->name, bdy_indicator(ibdy), ms1 ) ;
457 } else {
458 fprintf(fp," %s%s(1,kds,1,%d) , & ! Field \n" , structname , p->name, ibdy ) ;
459 }
460 } else {
461 if ( strlen(p->dname)==0 || !strcmp(p->dname,"-") ) { sprintf(dname,"%s%s%s",p->name,tend_tag,bdytag) ; }
462 else { sprintf(dname,"%s%s%s",p->dname,tend_tag,bdytag) ; }
463 fprintf(fp," '%s' , & ! Data Name \n", dname ) ;
464 if ( sw_new_bdys && ! sw_new_with_old_bdys ) { /* 20070207 */
465 fprintf(fp," %s%s%s(%s,kds,1,P_%s) , & ! Field \n" ,
466 structname , fourdname, tend_tag, ms1, bdy_indicator(ibdy) ) ;
467 } else {
468 fprintf(fp," %s%s%s(1,kds,1,%d,P_%s) , & ! Field \n" ,
469 structname , fourdname, tend_tag, ibdy, bdy_indicator(ibdy) ) ;
470 }
471 }
472 if (!strncmp(p->type->name,"real",4)) {
473 fprintf(fp," WRF_FLOAT , & ! FieldType \n") ;
474 } else {
475 fprintf(fp," WRF_%s , & ! FieldType \n" , p->type->name ) ;
476 }
477 fprintf(fp," grid , & ! grid\n") ;
478 fprintf(fp," grid%%domdesc , & ! Comm\n") ;
479 fprintf(fp," grid%%bdy_mask , & ! bdy_mask\n" ) ;
480 fprintf(fp," dryrun , & ! flag\n" ) ;
481 fprintf(fp," '%s' , & ! MemoryOrder\n",memord ) ;
482 fprintf(fp," '%s' , & ! Stagger\n",stagstr ) ;
483 fprintf(fp," '%s' , & ! Dimname 1 \n",dimname[0] ) ;
484 fprintf(fp," '%s' , & ! Dimname 2 \n",dimname[1] ) ;
485 fprintf(fp," '%s' , & ! Dimname 3 \n",dimname[2] ) ;
486 fprintf(fp," '%s' , & ! Desc \n",p->descrip ) ;
487 fprintf(fp," '%s' , & ! Units \n",p->units ) ;
488 fprintf(fp,"'%s ext_write_field %s memorder %s' , & ! Debug message\n",fname,dname,memord ) ;
489 /* global dimensions */
490 fprintf(fp,"%s, %s, %s, %s, %s, %s, &\n",ds1,de1,ds2,de2,ds3,de3 ) ;
491 fprintf(fp,"%s, %s, %s, %s, %s, %s, &\n",ms1,me1,ms2,me2,ms3,me3 ) ;
492 fprintf(fp,"%s, %s, %s, %s, %s, %s, &\n",ps1,pe1,ps2,pe2,ps3,pe3 ) ;
493 fprintf(fp," ierr )\n") ;
494 if ( ok_to_collect_distribute )
495 fprintf(fp,"ENDIF\n") ;
496 }
497 }
498 }
499 }
500
501 }
502
503 }
504 }
505 return(0) ;
506 }
507
Mirror of the official repository at https://github.com/wrf-model/WRF