13 int gen_streams( char * dirname
)
18 if ( dirname
== NULL
) return(1) ;
20 fn
= "module_io_domain_defs.inc" ;
21 if ( strlen(dirname
) > 0 ) { sprintf(fname
,"%s/%s",dirname
,fn
) ; }
22 else { sprintf(fname
,"%s",fn
) ; }
23 if ((fp
= fopen( fname
, "w" )) == NULL
) return(1) ;
24 print_warning(fp
,fname
) ;
25 gen_io_domain_defs( fp
) ;
26 close_the_file( fp
) ;
28 fn
= "set_timekeeping_defs.inc" ;
29 if ( strlen(dirname
) > 0 ) { sprintf(fname
,"%s/%s",dirname
,fn
) ; }
30 else { sprintf(fname
,"%s",fn
) ; }
31 if ((fp
= fopen( fname
, "w" )) == NULL
) return(1) ;
32 print_warning(fp
,fname
) ;
33 gen_set_timekeeping_defs( fp
) ;
34 close_the_file( fp
) ;
36 fn
= "set_timekeeping_alarms.inc" ;
37 if ( strlen(dirname
) > 0 ) { sprintf(fname
,"%s/%s",dirname
,fn
) ; }
38 else { sprintf(fname
,"%s",fn
) ; }
39 if ((fp
= fopen( fname
, "w" )) == NULL
) return(1) ;
40 print_warning(fp
,fname
) ;
41 gen_set_timekeeping_alarms( fp
) ;
42 close_the_file( fp
) ;
44 fn
= "io_form_for_dataset.inc" ;
45 if ( strlen(dirname
) > 0 ) { sprintf(fname
,"%s/%s",dirname
,fn
) ; }
46 else { sprintf(fname
,"%s",fn
) ; }
47 if ((fp
= fopen( fname
, "w" )) == NULL
) return(1) ;
48 print_warning(fp
,fname
) ;
49 gen_io_form_for_dataset( fp
) ;
50 close_the_file( fp
) ;
52 fn
= "io_form_for_stream.inc" ;
53 if ( strlen(dirname
) > 0 ) { sprintf(fname
,"%s/%s",dirname
,fn
) ; }
54 else { sprintf(fname
,"%s",fn
) ; }
55 if ((fp
= fopen( fname
, "w" )) == NULL
) return(1) ;
56 print_warning(fp
,fname
) ;
57 gen_io_form_for_stream( fp
) ;
58 close_the_file( fp
) ;
60 fn
= "switches_and_alarms.inc" ;
61 if ( strlen(dirname
) > 0 ) { sprintf(fname
,"%s/%s",dirname
,fn
) ; }
62 else { sprintf(fname
,"%s",fn
) ; }
63 if ((fp
= fopen( fname
, "w" )) == NULL
) return(1) ;
64 print_warning(fp
,fname
) ;
65 gen_switches_and_alarms( fp
) ;
66 close_the_file( fp
) ;
68 fn
= "check_auxstream_alarms.inc" ;
69 if ( strlen(dirname
) > 0 ) { sprintf(fname
,"%s/%s",dirname
,fn
) ; }
70 else { sprintf(fname
,"%s",fn
) ; }
71 if ((fp
= fopen( fname
, "w" )) == NULL
) return(1) ;
72 print_warning(fp
,fname
) ;
73 gen_check_auxstream_alarms( fp
) ;
74 close_the_file( fp
) ;
76 fn
= "fine_stream_input.inc" ;
77 if ( strlen(dirname
) > 0 ) { sprintf(fname
,"%s/%s",dirname
,fn
) ; }
78 else { sprintf(fname
,"%s",fn
) ; }
79 if ((fp
= fopen( fname
, "w" )) == NULL
) return(1) ;
80 print_warning(fp
,fname
) ;
81 gen_fine_stream_input( fp
) ;
82 close_the_file( fp
) ;
84 fn
= "med_auxinput_in.inc" ;
85 if ( strlen(dirname
) > 0 ) { sprintf(fname
,"%s/%s",dirname
,fn
) ; }
86 else { sprintf(fname
,"%s",fn
) ; }
87 if ((fp
= fopen( fname
, "w" )) == NULL
) return(1) ;
88 print_warning(fp
,fname
) ;
89 gen_med_auxinput_in( fp
) ;
90 close_the_file( fp
) ;
92 fn
= "med_hist_out_opens.inc" ;
93 if ( strlen(dirname
) > 0 ) { sprintf(fname
,"%s/%s",dirname
,fn
) ; }
94 else { sprintf(fname
,"%s",fn
) ; }
95 if ((fp
= fopen( fname
, "w" )) == NULL
) return(1) ;
96 print_warning(fp
,fname
) ;
97 gen_med_hist_out_opens( fp
) ;
98 close_the_file( fp
) ;
100 fn
= "med_hist_out_closes.inc" ;
101 if ( strlen(dirname
) > 0 ) { sprintf(fname
,"%s/%s",dirname
,fn
) ; }
102 else { sprintf(fname
,"%s",fn
) ; }
103 if ((fp
= fopen( fname
, "w" )) == NULL
) return(1) ;
104 print_warning(fp
,fname
) ;
105 gen_med_hist_out_closes( fp
) ;
106 close_the_file( fp
) ;
108 fn
= "med_auxinput_in_closes.inc" ;
109 if ( strlen(dirname
) > 0 ) { sprintf(fname
,"%s/%s",dirname
,fn
) ; }
110 else { sprintf(fname
,"%s",fn
) ; }
111 if ((fp
= fopen( fname
, "w" )) == NULL
) return(1) ;
112 print_warning(fp
,fname
) ;
113 gen_med_auxinput_in_closes( fp
) ;
114 close_the_file( fp
) ;
116 fn
= "med_last_solve_io.inc" ;
117 if ( strlen(dirname
) > 0 ) { sprintf(fname
,"%s/%s",dirname
,fn
) ; }
118 else { sprintf(fname
,"%s",fn
) ; }
119 if ((fp
= fopen( fname
, "w" )) == NULL
) return(1) ;
120 print_warning(fp
,fname
) ;
121 gen_med_last_solve_io( fp
) ;
122 close_the_file( fp
) ;
124 fn
= "med_open_esmf_calls.inc" ;
125 if ( strlen(dirname
) > 0 ) { sprintf(fname
,"%s/%s",dirname
,fn
) ; }
126 else { sprintf(fname
,"%s",fn
) ; }
127 if ((fp
= fopen( fname
, "w" )) == NULL
) return(1) ;
128 print_warning(fp
,fname
) ;
129 gen_med_open_esmf_calls( fp
) ;
130 close_the_file( fp
) ;
132 fn
= "med_find_esmf_coupling.inc" ;
133 if ( strlen(dirname
) > 0 ) { sprintf(fname
,"%s/%s",dirname
,fn
) ; }
134 else { sprintf(fname
,"%s",fn
) ; }
135 if ((fp
= fopen( fname
, "w" )) == NULL
) return(1) ;
136 print_warning(fp
,fname
) ;
137 gen_med_find_esmf_coupling( fp
) ;
138 close_the_file( fp
) ;
140 fn
= "shutdown_closes.inc" ;
141 if ( strlen(dirname
) > 0 ) { sprintf(fname
,"%s/%s",dirname
,fn
) ; }
142 else { sprintf(fname
,"%s",fn
) ; }
143 if ((fp
= fopen( fname
, "w" )) == NULL
) return(1) ;
144 print_warning(fp
,fname
) ;
145 gen_shutdown_closes( fp
) ;
146 close_the_file( fp
) ;
152 gen_io_domain_defs ( FILE * fp
)
154 char * dir
, * aux
, *streamtype
, streamno
[5] ;
157 for ( j
= 0 ; j
< 2 ; j
++ ) {
158 if ( j
== 0 ) dir
= "output" ;
160 for ( i
= 0 ; i
< 2*MAX_HISTORY
; i
++ )
162 if ( i
% MAX_HISTORY
== 0 ) { aux
= "" ; streamno
[0] = '\0' ; }
163 else { aux
="aux" ; sprintf(streamno
,"%d",i
%MAX_HISTORY
) ; }
164 if ( i
< MAX_HISTORY
) { streamtype
= "input" ; }
165 else { streamtype
= ( i
%MAX_HISTORY
== 0 )?"history":"hist" ; }
167 fprintf(fp
,"SUBROUTINE %s_%s%s%s ( fid , grid , config_flags , ierr )\n",dir
,aux
,streamtype
,streamno
) ;
168 fprintf(fp
," IMPLICIT NONE\n") ;
169 fprintf(fp
," TYPE(domain) :: grid\n") ;
170 fprintf(fp
," TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags\n") ;
171 fprintf(fp
," INTEGER, INTENT(IN) :: fid\n") ;
172 fprintf(fp
," INTEGER, INTENT(INOUT) :: ierr\n") ;
173 fprintf(fp
," IF ( config_flags%%io_form_%s%s%s .GT. 0 ) THEN\n", aux
,streamtype
,streamno
) ;
174 fprintf(fp
," CALL %s_wrf( fid, grid, config_flags, %s%s%s_only, ierr ) ;\n",dir
,aux
,streamtype
,streamno
) ;
175 fprintf(fp
," ENDIF\n") ;
176 fprintf(fp
," RETURN\n") ;
177 fprintf(fp
,"END SUBROUTINE %s_%s%s%s\n",dir
,aux
,streamtype
,streamno
) ;
183 gen_set_timekeeping_defs ( FILE *fp
)
185 char * aux
, *streamtype
, streamno
[5] ;
187 for ( i
= 0 ; i
< 2*MAX_HISTORY
; i
++ )
189 if ( i
% MAX_HISTORY
== 0 ) { aux
= "" ; streamno
[0] = '\0' ; }
190 else { aux
="aux" ; sprintf(streamno
,"%d",i
%MAX_HISTORY
) ; }
191 if ( i
< MAX_HISTORY
) { streamtype
= "input" ; }
192 else { streamtype
= ( i
%MAX_HISTORY
== 0 )?"history":"hist" ; }
194 fprintf(fp
," INTEGER :: %s%s%s_interval , &\n",aux
,streamtype
,streamno
) ;
195 fprintf(fp
," %s%s%s_interval_d, &\n",aux
,streamtype
,streamno
) ;
196 fprintf(fp
," %s%s%s_interval_h, &\n",aux
,streamtype
,streamno
) ;
197 fprintf(fp
," %s%s%s_interval_m, &\n",aux
,streamtype
,streamno
) ;
198 fprintf(fp
," %s%s%s_interval_s \n",aux
,streamtype
,streamno
) ;
199 fprintf(fp
," INTEGER :: %s%s%s_begin , &\n",aux
,streamtype
,streamno
) ;
200 fprintf(fp
," %s%s%s_begin_y, &\n",aux
,streamtype
,streamno
) ;
201 fprintf(fp
," %s%s%s_begin_d, &\n",aux
,streamtype
,streamno
) ;
202 fprintf(fp
," %s%s%s_begin_h, &\n",aux
,streamtype
,streamno
) ;
203 fprintf(fp
," %s%s%s_begin_m, &\n",aux
,streamtype
,streamno
) ;
204 fprintf(fp
," %s%s%s_begin_s \n",aux
,streamtype
,streamno
) ;
205 fprintf(fp
," INTEGER :: %s%s%s_end , &\n",aux
,streamtype
,streamno
) ;
206 fprintf(fp
," %s%s%s_end_y, &\n",aux
,streamtype
,streamno
) ;
207 fprintf(fp
," %s%s%s_end_d, &\n",aux
,streamtype
,streamno
) ;
208 fprintf(fp
," %s%s%s_end_h, &\n",aux
,streamtype
,streamno
) ;
209 fprintf(fp
," %s%s%s_end_m, &\n",aux
,streamtype
,streamno
) ;
210 fprintf(fp
," %s%s%s_end_s \n",aux
,streamtype
,streamno
) ;
216 gen_set_timekeeping_alarms ( FILE * fp
)
218 char * dir
, * aux
, *streamtype
, streamno
[5] ;
221 for ( i
= 0 ; i
< 2*MAX_HISTORY
; i
++ )
223 if ( i
% MAX_HISTORY
== 0 ) { aux
= "" ; streamno
[0] = '\0' ; }
224 else { aux
="aux" ; sprintf(streamno
,"%d",i
%MAX_HISTORY
) ; }
225 if ( i
< MAX_HISTORY
) { streamtype
= "input" ; }
226 else { streamtype
= ( i
%MAX_HISTORY
== 0 )?"history":"hist" ; }
227 if ( i
== 0 ) continue ; /* skip just input */
229 fprintf(fp
,"! %s%s%s INTERVAL\n",aux
,streamtype
,streamno
) ;
230 fprintf(fp
," CALL nl_get_%s%s%s_interval( grid%%id, %s%s%s_interval ) ! same as minutes\n",aux
,streamtype
,streamno
,aux
,streamtype
,streamno
) ;
231 fprintf(fp
," CALL nl_get_%s%s%s_interval_d( grid%%id, %s%s%s_interval_d )\n",aux
,streamtype
,streamno
,aux
,streamtype
,streamno
) ;
232 fprintf(fp
," CALL nl_get_%s%s%s_interval_h( grid%%id, %s%s%s_interval_h )\n",aux
,streamtype
,streamno
,aux
,streamtype
,streamno
) ;
233 fprintf(fp
," CALL nl_get_%s%s%s_interval_m( grid%%id, %s%s%s_interval_m )\n",aux
,streamtype
,streamno
,aux
,streamtype
,streamno
) ;
234 fprintf(fp
," CALL nl_get_%s%s%s_interval_s( grid%%id, %s%s%s_interval_s )\n",aux
,streamtype
,streamno
,aux
,streamtype
,streamno
) ;
235 fprintf(fp
," IF ( %s%s%s_interval_m .EQ. 0 ) %s%s%s_interval_m = %s%s%s_interval\n",aux
,streamtype
,streamno
,aux
,streamtype
,streamno
,aux
,streamtype
,streamno
) ;
236 fprintf(fp
," IF ( MAX( %s%s%s_interval_d, &\n",aux
,streamtype
,streamno
) ;
237 fprintf(fp
," %s%s%s_interval_h, %s%s%s_interval_m , %s%s%s_interval_s ) .GT. 0 ) THEN\n",aux
,streamtype
,streamno
,aux
,streamtype
,streamno
,aux
,streamtype
,streamno
) ;
238 fprintf(fp
," CALL WRFU_TimeIntervalSet( interval, D=%s%s%s_interval_d, &\n",aux
,streamtype
,streamno
) ;
239 fprintf(fp
," H=%s%s%s_interval_h, M=%s%s%s_interval_m, S=%s%s%s_interval_s, rc=rc )\n",aux
,streamtype
,streamno
,aux
,streamtype
,streamno
,aux
,streamtype
,streamno
) ;
240 fprintf(fp
," CALL wrf_check_error( WRFU_SUCCESS, rc, &\n") ;
241 fprintf(fp
," 'WRFU_TimeIntervalSet(%s%s%s_interval) FAILED', &\n",aux
,streamtype
,streamno
) ;
242 fprintf(fp
," __FILE__ , &\n") ;
243 fprintf(fp
," __LINE__ )\n") ;
244 fprintf(fp
," ELSE\n") ;
246 fprintf(fp
," interval = run_length + padding_interval\n") ;
248 fprintf(fp
," interval = padding_interval\n") ;
250 fprintf(fp
," ENDIF\n") ;
251 fprintf(fp
," CALL nl_get_%s%s%s_begin ( grid%%id, %s%s%s_begin )\n",aux
,streamtype
,streamno
,aux
,streamtype
,streamno
) ;
252 fprintf(fp
," CALL nl_get_%s%s%s_begin_y( grid%%id, %s%s%s_begin_y )\n",aux
,streamtype
,streamno
,aux
,streamtype
,streamno
) ;
253 fprintf(fp
," CALL nl_get_%s%s%s_begin_d( grid%%id, %s%s%s_begin_d )\n",aux
,streamtype
,streamno
,aux
,streamtype
,streamno
) ;
254 fprintf(fp
," CALL nl_get_%s%s%s_begin_h( grid%%id, %s%s%s_begin_h )\n",aux
,streamtype
,streamno
,aux
,streamtype
,streamno
) ;
255 fprintf(fp
," CALL nl_get_%s%s%s_begin_m( grid%%id, %s%s%s_begin_m )\n",aux
,streamtype
,streamno
,aux
,streamtype
,streamno
) ;
256 fprintf(fp
," CALL nl_get_%s%s%s_begin_s( grid%%id, %s%s%s_begin_s )\n",aux
,streamtype
,streamno
,aux
,streamtype
,streamno
) ;
257 fprintf(fp
," IF ( %s%s%s_begin_m .EQ. 0 ) %s%s%s_begin_m = %s%s%s_begin\n",aux
,streamtype
,streamno
,aux
,streamtype
,streamno
,aux
,streamtype
,streamno
) ;
258 fprintf(fp
," IF ( MAX( %s%s%s_begin_y, %s%s%s_begin_d, &\n",aux
,streamtype
,streamno
,aux
,streamtype
,streamno
) ;
259 fprintf(fp
," %s%s%s_begin_h, %s%s%s_begin_m , %s%s%s_begin_s ) .GT. 0 ) THEN\n",aux
,streamtype
,streamno
,aux
,streamtype
,streamno
,aux
,streamtype
,streamno
) ;
260 fprintf(fp
," CALL WRFU_TimeIntervalSet( begin_time , D=%s%s%s_begin_d, &\n",aux
,streamtype
,streamno
) ;
261 fprintf(fp
," H=%s%s%s_begin_h, M=%s%s%s_begin_m, S=%s%s%s_begin_s, rc=rc )\n",aux
,streamtype
,streamno
,aux
,streamtype
,streamno
,aux
,streamtype
,streamno
) ;
262 fprintf(fp
," CALL wrf_check_error( WRFU_SUCCESS, rc, &\n") ;
263 fprintf(fp
," 'WRFU_TimeIntervalSet(%s%s%s_begin) FAILED', &\n",aux
,streamtype
,streamno
) ;
264 fprintf(fp
," __FILE__ , &\n") ;
265 fprintf(fp
," __LINE__ )\n") ;
266 fprintf(fp
," ELSE\n") ;
267 fprintf(fp
," begin_time = zero_time\n") ;
268 fprintf(fp
," ENDIF\n") ;
269 fprintf(fp
," CALL nl_get_%s%s%s_end( grid%%id, %s%s%s_end )\n",aux
,streamtype
,streamno
,aux
,streamtype
,streamno
) ;
270 fprintf(fp
," CALL nl_get_%s%s%s_end_y( grid%%id, %s%s%s_end_y )\n",aux
,streamtype
,streamno
,aux
,streamtype
,streamno
) ;
271 fprintf(fp
," CALL nl_get_%s%s%s_end_d( grid%%id, %s%s%s_end_d )\n",aux
,streamtype
,streamno
,aux
,streamtype
,streamno
) ;
272 fprintf(fp
," CALL nl_get_%s%s%s_end_h( grid%%id, %s%s%s_end_h )\n",aux
,streamtype
,streamno
,aux
,streamtype
,streamno
) ;
273 fprintf(fp
," CALL nl_get_%s%s%s_end_m( grid%%id, %s%s%s_end_m )\n",aux
,streamtype
,streamno
,aux
,streamtype
,streamno
) ;
274 fprintf(fp
," CALL nl_get_%s%s%s_end_s( grid%%id, %s%s%s_end_s )\n",aux
,streamtype
,streamno
,aux
,streamtype
,streamno
) ;
275 fprintf(fp
," IF ( %s%s%s_end_m .EQ. 0 ) %s%s%s_end_m = %s%s%s_end\n",aux
,streamtype
,streamno
,aux
,streamtype
,streamno
,aux
,streamtype
,streamno
) ;
276 fprintf(fp
," IF ( MAX( %s%s%s_end_y, %s%s%s_end_d, &\n",aux
,streamtype
,streamno
,aux
,streamtype
,streamno
) ;
277 fprintf(fp
," %s%s%s_end_h, %s%s%s_end_m , %s%s%s_end_s ) .GT. 0 ) THEN\n",aux
,streamtype
,streamno
,aux
,streamtype
,streamno
,aux
,streamtype
,streamno
) ;
278 fprintf(fp
," CALL WRFU_TimeIntervalSet( end_time , D=%s%s%s_end_d, &\n",aux
,streamtype
,streamno
) ;
279 fprintf(fp
," H=%s%s%s_end_h, M=%s%s%s_end_m, S=%s%s%s_end_s, rc=rc )\n",aux
,streamtype
,streamno
,aux
,streamtype
,streamno
,aux
,streamtype
,streamno
) ;
280 fprintf(fp
," CALL wrf_check_error( WRFU_SUCCESS, rc, &\n") ;
281 fprintf(fp
," 'WRFU_TimeIntervalSet(%s%s%s_end) FAILED', &\n",aux
,streamtype
,streamno
) ;
282 fprintf(fp
," __FILE__ , &\n") ;
283 fprintf(fp
," __LINE__ )\n") ;
284 fprintf(fp
," ELSE\n") ;
285 fprintf(fp
," end_time = run_length + padding_interval\n") ;
286 fprintf(fp
," ENDIF\n") ;
287 fprintf(fp
," CALL domain_alarm_create( grid, %s%s%s_ALARM, interval, begin_time, end_time )\n",aux
,streamtype
,streamno
) ;
289 fprintf(fp
," IF ( interval .NE. run_length + padding_interval .AND. begin_time .EQ. zero_time ) THEN\n") ;
291 fprintf(fp
," IF ( interval .NE. padding_interval .AND. begin_time .EQ. zero_time ) THEN\n") ;
293 fprintf(fp
," CALL WRFU_AlarmRingerOn( grid%%alarms( %s%s%s_ALARM ), rc=rc )\n",aux
,streamtype
,streamno
) ;
294 fprintf(fp
," CALL wrf_check_error( WRFU_SUCCESS, rc, &\n") ;
295 fprintf(fp
," 'WRFU_AlarmRingerOn(%s%s%s_ALARM) FAILED', &\n",aux
,streamtype
,streamno
) ;
296 fprintf(fp
," __FILE__ , &\n") ;
297 fprintf(fp
," __LINE__ )\n") ;
298 fprintf(fp
," ENDIF\n") ;
303 gen_io_form_for_dataset ( FILE *fp
)
305 char * aux
, *streamtype
, streamno
[5] ;
308 fprintf(fp
," IF ( DataSet .eq. 'RESTART' ) THEN\n") ;
309 fprintf(fp
," CALL nl_get_io_form_restart( 1, io_form )\n") ;
310 fprintf(fp
," ELSE IF ( DataSet .eq. 'INPUT' ) THEN\n") ;
311 fprintf(fp
," CALL nl_get_io_form_input( 1, io_form )\n") ;
312 fprintf(fp
," ELSE IF ( DataSet .eq. 'HISTORY' ) THEN\n") ;
313 fprintf(fp
," CALL nl_get_io_form_history( 1, io_form )\n") ;
314 fprintf(fp
," ELSE IF ( DataSet .eq. 'BOUNDARY' ) THEN\n") ;
315 fprintf(fp
," CALL nl_get_io_form_boundary( 1, io_form )\n") ;
316 for ( i
= 1 ; i
< MAX_HISTORY
; i
++ )
318 sprintf(streamno
,"%d",i
) ;
319 fprintf(fp
," ELSE IF ( DataSet .eq. 'AUXINPUT%s' ) THEN\n", streamno
) ;
320 fprintf(fp
," CALL nl_get_io_form_auxinput%s( 1, io_form )\n", streamno
) ;
321 fprintf(fp
," ELSE IF ( DataSet .eq. 'AUXHIST%s' ) THEN\n", streamno
) ;
322 fprintf(fp
," CALL nl_get_io_form_auxhist%s( 1, io_form )\n", streamno
) ;
324 fprintf(fp
," ELSE ! default if nothing is set in SysDepInfo; use history\n") ;
325 fprintf(fp
," CALL nl_get_io_form_history( 1, io_form )\n") ;
326 fprintf(fp
," ENDIF\n") ;
330 gen_io_form_for_stream ( FILE *fp
)
332 char * aux
, *streamtype
, streamno
[5] ;
335 fprintf(fp
," IF ( stream .eq. restart_only ) THEN\n") ;
336 fprintf(fp
," CALL nl_get_io_form_restart( 1, io_form )\n") ;
337 fprintf(fp
," ELSE IF ( stream .eq. input_only ) THEN\n") ;
338 fprintf(fp
," CALL nl_get_io_form_input( 1, io_form )\n") ;
339 fprintf(fp
," ELSE IF ( stream .eq. history_only ) THEN\n") ;
340 fprintf(fp
," CALL nl_get_io_form_history( 1, io_form )\n") ;
341 fprintf(fp
," ELSE IF ( stream .eq. boundary_only ) THEN\n") ;
342 fprintf(fp
," CALL nl_get_io_form_boundary( 1, io_form )\n") ;
343 for ( i
= 1 ; i
< MAX_HISTORY
; i
++ )
345 sprintf(streamno
,"%d",i
) ;
346 fprintf(fp
," ELSE IF ( stream .eq. auxinput%s_only ) THEN\n", streamno
) ;
347 fprintf(fp
," CALL nl_get_io_form_auxinput%s( 1, io_form )\n", streamno
) ;
348 fprintf(fp
," ELSE IF ( stream .eq. auxhist%s_only ) THEN\n", streamno
) ;
349 fprintf(fp
," CALL nl_get_io_form_auxhist%s( 1, io_form )\n", streamno
) ;
351 fprintf(fp
," ELSE ! if no match then do the old service representative schtick\n") ;
352 fprintf(fp
," CALL wrf_error_fatal('internal error: please contact wrfhelp@ucar.edu: io_form_for_stream.inc -- invalid stream number')\n") ;
353 fprintf(fp
," ENDIF\n") ;
357 gen_switches_and_alarms ( FILE *fp
)
359 char * aux
, *streamtype
, streamno
[5] ;
362 fprintf(fp
,"INTEGER, PARAMETER :: history_only = 1\n") ;
363 fprintf(fp
,"INTEGER, PARAMETER :: HISTORY_ALARM = history_only\n") ;
364 fprintf(fp
,"INTEGER, PARAMETER :: input_only = %d\n",MAX_HISTORY
+1) ;
365 fprintf(fp
,"INTEGER, PARAMETER :: INPUT_ALARM = input_only ! not used\n") ;
366 for ( i
= 1 ; i
< MAX_HISTORY
; i
++ )
368 fprintf(fp
,"INTEGER, PARAMETER :: auxhist%d_only = %d\n",i
,i
+1) ;
369 fprintf(fp
,"INTEGER, PARAMETER :: AUXHIST%d_ALARM = %d\n",i
,i
+1) ;
370 fprintf(fp
,"INTEGER, PARAMETER :: auxinput%d_only = %d\n",i
,MAX_HISTORY
+i
+1) ;
371 fprintf(fp
,"INTEGER, PARAMETER :: AUXINPUT%d_ALARM = %d\n",i
,MAX_HISTORY
+i
+1) ;
376 gen_check_auxstream_alarms ( FILE *fp
)
378 char * aux
, *streamtype
, streamno
[5] ;
381 fprintf(fp
,"! - AUX HISTORY OUTPUT\n") ;
382 for ( i
= 1 ; i
< MAX_HISTORY
; i
++ )
384 fprintf(fp
,"#ifndef DISABLE_ALARM_AUXHIST%d\n",i
) ;
385 fprintf(fp
," IF( WRFU_AlarmIsRinging( grid%%alarms( AUXHIST%d_ALARM ), rc=rc ) ) THEN\n",i
) ;
386 fprintf(fp
," CALL med_hist_out ( grid , %d, config_flags )\n",i
) ;
387 fprintf(fp
," CALL WRFU_AlarmRingerOff( grid%%alarms( AUXHIST%d_ALARM ), rc=rc )\n",i
) ;
388 fprintf(fp
," ENDIF\n") ;
389 fprintf(fp
,"#endif\n") ;
391 fprintf(fp
,"! - AUX INPUT INPUT\n") ;
392 for ( i
= 1 ; i
< MAX_HISTORY
; i
++ )
394 fprintf(fp
,"#ifndef DISABLE_ALARM_AUXINPUT%d\n",i
) ;
395 fprintf(fp
," IF( WRFU_AlarmIsRinging( grid%%alarms( AUXINPUT%d_ALARM ), rc=rc ) ) THEN\n",i
) ;
396 fprintf(fp
," CALL med_auxinput%d_in ( grid , config_flags )\n",i
) ;
397 fprintf(fp
," WRITE ( message , FMT='(A,A,A,i3)' ) 'Input data processed for ' , &\n") ;
398 fprintf(fp
," TRIM(config_flags%%auxinput%d_inname) , ' for domain ',grid%%id\n",i
) ;
399 fprintf(fp
," CALL wrf_debug ( 0 , message )\n") ;
400 fprintf(fp
," CALL WRFU_AlarmRingerOff( grid%%alarms( AUXINPUT%d_ALARM ), rc=rc )\n",i
) ;
401 fprintf(fp
," ENDIF\n") ;
402 fprintf(fp
,"#endif\n") ;
407 gen_fine_stream_input ( FILE *fp
)
409 char * aux
, *streamtype
, streamno
[5] ;
411 fprintf(fp
,"IF ( ( grid%%id .EQ. 1 ) .OR. ( config_flags%%fine_input_stream .EQ. 0 ) ) THEN\n") ;
412 fprintf(fp
," CALL wrf_debug ( 0 , 'med_initialdata_input: calling input_input' )\n") ;
413 fprintf(fp
," CALL input_input ( fid , grid , config_flags , ierr )\n") ;
414 fprintf(fp
," CALL wrf_debug ( 100 , 'med_initialdata_input: back from input_input' )\n") ;
415 for ( i
= 1 ; i
< MAX_HISTORY
; i
++ )
417 fprintf(fp
,"ELSE IF ( config_flags%%fine_input_stream .EQ. %d ) THEN\n",i
) ;
418 fprintf(fp
," CALL wrf_debug ( 0 , 'med_initialdata_input: calling input_auxinput%d' )\n",i
) ;
419 fprintf(fp
," CALL input_auxinput%d ( fid , grid , config_flags , ierr )\n",i
) ;
420 fprintf(fp
," CALL wrf_debug ( 100 , 'med_initialdata_input: back from input_auxinput%d' )\n",i
) ;
422 fprintf(fp
,"ELSE\n") ;
423 fprintf(fp
," WRITE( message , '(\"med_initialdata_input: bad fine_input_stream = \",I4)') config_flags%%fine_input_stream\n") ;
424 fprintf(fp
," CALL WRF_ERROR_FATAL ( message )\n") ;
425 fprintf(fp
,"END IF\n") ;
429 gen_med_auxinput_in ( FILE *fp
)
431 char * aux
, *streamtype
, streamno
[5] ;
433 for ( i
= 1 ; i
< MAX_HISTORY
; i
++ )
435 fprintf(fp
," CASE ( AUXINPUT%d_ALARM )\n",i
) ;
436 fprintf(fp
," CALL open_aux_u( grid, config_flags, stream, AUXINPUT%d_ALARM, &\n",i
) ;
437 fprintf(fp
," config_flags%%auxinput%d_inname, grid%%auxinput%d_oid, &\n",i
,i
) ;
438 fprintf(fp
," input_auxinput%d, ierr )\n",i
) ;
439 fprintf(fp
," CALL input_auxinput%d ( grid%%auxinput%d_oid, grid , config_flags , ierr )\n",i
,i
) ;
444 gen_med_hist_out_opens ( FILE *fp
)
446 char * aux
, *streamtype
, streamno
[5] ;
448 for ( i
= 1 ; i
< MAX_HISTORY
; i
++ )
450 fprintf(fp
," CASE ( AUXHIST%d_ALARM )\n",i
) ;
451 fprintf(fp
," CALL open_hist_w( grid, config_flags, stream, AUXHIST%d_ALARM, &\n",i
) ;
452 fprintf(fp
," config_flags%%auxhist%d_outname, grid%%auxhist%d_oid, &\n",i
,i
) ;
453 fprintf(fp
," output_auxhist%d, fname, n2, ierr )\n",i
) ;
454 fprintf(fp
," CALL output_auxhist%d ( grid%%auxhist%d_oid, grid , config_flags , ierr )\n",i
,i
) ;
459 gen_med_hist_out_closes ( FILE *fp
)
461 char * aux
, *streamtype
, streamno
[5] ;
463 for ( i
= 1 ; i
< MAX_HISTORY
; i
++ )
465 fprintf(fp
," CASE ( AUXHIST%d_ALARM )\n",i
) ;
466 fprintf(fp
," IF ( grid%%nframes(stream) >= config_flags%%frames_per_auxhist%d ) THEN\n",i
) ;
467 fprintf(fp
," CALL close_dataset ( grid%%auxhist%d_oid , config_flags , n2 )\n",i
) ;
468 fprintf(fp
," grid%%auxhist%d_oid = 0\n",i
) ;
469 fprintf(fp
," grid%%nframes(stream) = 0\n") ;
470 fprintf(fp
," ENDIF\n") ;
475 gen_med_auxinput_in_closes ( FILE *fp
)
477 char * aux
, *streamtype
, streamno
[5] ;
479 for ( i
= 1 ; i
< MAX_HISTORY
; i
++ ) /* the number of history is the same as the number of input and MAX_INPUT collides with system definitions */
481 fprintf(fp
," CASE ( AUXINPUT%d_ALARM )\n",i
) ;
482 fprintf(fp
," IF ( grid%%nframes(stream) >= config_flags%%frames_per_auxinput%d ) THEN\n",i
) ;
483 fprintf(fp
," CALL close_dataset ( grid%%auxinput%d_oid , config_flags , \"DATASET=AUXINPUT%d\" )\n",i
,i
) ;
484 fprintf(fp
," grid%%auxinput%d_oid = 0\n",i
) ;
485 fprintf(fp
," grid%%nframes(stream) = 0\n") ;
486 fprintf(fp
," ENDIF\n") ;
491 gen_med_last_solve_io ( FILE *fp
)
493 char * aux
, *streamtype
, streamno
[5] ;
495 for ( i
= 1 ; i
< MAX_HISTORY
; i
++ )
497 fprintf(fp
," IF( WRFU_AlarmIsRinging( grid%%alarms( AUXHIST%d_ALARM ), rc=rc ) ) THEN\n",i
) ;
498 fprintf(fp
," CALL med_hist_out ( grid , AUXHIST%d_ALARM , config_flags )\n",i
) ;
499 fprintf(fp
," ENDIF\n") ;
504 gen_shutdown_closes ( FILE *fp
)
506 char * aux
, *streamtype
, streamno
[5] ;
508 for ( i
= 1 ; i
< MAX_HISTORY
; i
++ )
510 fprintf(fp
,"IF( grid%%auxhist%d_oid > 0 ) CALL close_dataset ( grid%%auxhist%d_oid, config_flags, 'DATASET=AUXHIST%d' )\n",i
,i
,i
) ;
514 /* generate the calls that main/wrf_ESMFMod.F uses in wrf_state_populate() */
515 gen_med_open_esmf_calls ( FILE *fp
)
518 for ( i
= 1 ; i
< MAX_HISTORY
; i
++ )
520 fprintf(fp
,"CALL nl_get_io_form_auxinput%d( 1, io_form )\n",i
) ;
521 fprintf(fp
,"IF ( use_package( io_form ) == IO_ESMF ) THEN\n") ;
522 fprintf(fp
," stream = first_auxinput + %d\n",i
-1) ;
523 fprintf(fp
," CALL open_aux_u( grid, config_flags, stream, AUXINPUT%d_ALARM, &\n",i
) ;
524 fprintf(fp
," config_flags%%auxinput%d_inname, grid%%auxinput%d_oid, &\n",i
,i
) ;
525 fprintf(fp
," input_auxinput%d, ierr )\n",i
) ;
526 fprintf(fp
," IF ( ierr /= 0 ) RETURN\n") ;
527 fprintf(fp
,"ENDIF\n") ;
530 for ( i
= 1 ; i
< MAX_HISTORY
; i
++ )
532 fprintf(fp
,"CALL nl_get_io_form_auxhist%d( 1, io_form )\n",i
) ;
533 fprintf(fp
,"IF ( use_package( io_form ) == IO_ESMF ) THEN\n") ;
534 fprintf(fp
," stream = first_auxhist + %d\n",i
-1) ;
535 fprintf(fp
," CALL open_hist_w( grid, config_flags, stream, AUXHIST%d_ALARM, &\n",i
) ;
536 fprintf(fp
," config_flags%%auxhist%d_outname, grid%%auxhist%d_oid, &\n",i
,i
) ;
537 fprintf(fp
," output_auxhist%d, fname, n2, ierr )\n",i
) ;
538 fprintf(fp
," IF ( ierr /= 0 ) RETURN\n") ;
539 fprintf(fp
,"ENDIF\n") ;
543 /* generate the calls that main/wrf_ESMFMod.F uses in wrf_state_populate() */
544 gen_med_find_esmf_coupling ( FILE *fp
)
547 for ( i
= 1 ; i
< MAX_HISTORY
; i
++ )
549 fprintf(fp
,"IF ( .NOT. foundcoupling ) THEN\n") ;
550 fprintf(fp
," CALL nl_get_io_form_auxinput%d( 1, io_form )\n",i
) ;
551 fprintf(fp
," IF ( use_package( io_form ) == IO_ESMF ) THEN\n") ;
552 fprintf(fp
," CALL ESMF_AlarmGet( head_grid%%alarms( AUXINPUT%d_ALARM ), &\n",i
) ;
553 fprintf(fp
," RingInterval=couplingInterval, rc=rc )\n") ;
554 fprintf(fp
," IF ( rc /= ESMF_SUCCESS ) THEN\n") ;
555 fprintf(fp
," CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ESMF_AlarmGet(AUXINPUT%d_ALARM) failed' )\n",i
) ;
556 fprintf(fp
," ENDIF\n") ;
557 fprintf(fp
," foundcoupling = .TRUE.\n") ;
558 fprintf(fp
," ENDIF\n") ;
559 fprintf(fp
,"ENDIF\n") ;
560 fprintf(fp
,"IF ( .NOT. foundcoupling ) THEN\n") ;
561 fprintf(fp
," CALL nl_get_io_form_auxhist%d( 1, io_form )\n",i
) ;
562 fprintf(fp
," IF ( use_package( io_form ) == IO_ESMF ) THEN\n") ;
563 fprintf(fp
," CALL ESMF_AlarmGet( head_grid%%alarms( AUXHIST%d_ALARM ), &\n",i
) ;
564 fprintf(fp
," RingInterval=couplingInterval, rc=rc )\n") ;
565 fprintf(fp
," IF ( rc /= ESMF_SUCCESS ) THEN\n") ;
566 fprintf(fp
," CALL wrf_error_fatal ( 'wrf_findCouplingInterval: ESMF_AlarmGet(AUXHIST%d_ALARM) failed' )\n",i
) ;
567 fprintf(fp
," ENDIF\n") ;
568 fprintf(fp
," foundcoupling = .TRUE.\n") ;
569 fprintf(fp
," ENDIF\n") ;
570 fprintf(fp
,"ENDIF\n") ;
576 This one is special; it gets called before the registry actually runs and produces a file
577 that defines a lot of per-stream variables, mostly rconfig but also the oid state variables
578 for each stream. This file is then included by the registry.io_boilerplate file when the
579 registry actually runs. As with the other mods above, this allows a variable, compile-time
580 number of io streams. Note that this one is self contained and dirname is hard-coded.
583 gen_io_boilerplate ()
586 char * dirname
= "Registry" ;
587 char fname
[NAMELEN
] ;
589 char * aux
, *streamtype
, streamno
[5] ;
590 char * howset
= "namelist,time_control" ;
591 char * maxd
= "max_domains" ;
594 fn
= "io_boilerplate_temporary.inc" ;
595 if ( strlen(dirname
) > 0 ) { sprintf(fname
,"%s/%s",dirname
,fn
) ; }
596 else { sprintf(fname
,"%s",fn
) ; }
597 if ((fp
= fopen( fname
, "w" )) == NULL
) return(1) ;
598 print_warning(fp
,fname
) ;
600 fprintf(fp
,"rconfig logical override_restart_timers namelist,time_control 1 .false.\n") ;
601 for ( j
= 0 ; j
< 2 ; j
++ ) { /* j=0 is hist, j=1 is input */
602 streamtype
= (j
==0)?"hist":"input" ;
603 for ( i
= 1 ; i
< MAX_HISTORY
; i
++ )
605 fprintf(fp
,"state integer aux%s%d_oid - - - - - \"\" \"\" \"\"\n",streamtype
,i
) ;
606 fprintf(fp
,"rconfig character aux%s%d_inname %s %s \"aux%s%d_d<domain>_<date>\"\n",streamtype
,i
,howset
,"1",streamtype
,i
) ;
607 fprintf(fp
,"rconfig character aux%s%d_outname %s %s \"aux%s%d_d<domain>_<date>\"\n",streamtype
,i
,howset
,"1",streamtype
,i
) ;
608 fprintf(fp
,"rconfig integer aux%s%d_interval_y %s %s 0\n",streamtype
,i
,howset
,maxd
) ;
609 fprintf(fp
,"rconfig integer aux%s%d_interval_d %s %s 0\n",streamtype
,i
,howset
,maxd
) ;
610 fprintf(fp
,"rconfig integer aux%s%d_interval_h %s %s 0\n",streamtype
,i
,howset
,maxd
) ;
611 fprintf(fp
,"rconfig integer aux%s%d_interval_m %s %s 0\n",streamtype
,i
,howset
,maxd
) ;
612 fprintf(fp
,"rconfig integer aux%s%d_interval_s %s %s 0\n",streamtype
,i
,howset
,maxd
) ;
613 fprintf(fp
,"rconfig integer aux%s%d_interval %s %s 0\n",streamtype
,i
,howset
,maxd
) ;
614 fprintf(fp
,"rconfig integer aux%s%d_begin_y %s %s 0\n",streamtype
,i
,howset
,maxd
) ;
615 fprintf(fp
,"rconfig integer aux%s%d_begin_d %s %s 0\n",streamtype
,i
,howset
,maxd
) ;
616 fprintf(fp
,"rconfig integer aux%s%d_begin_h %s %s 0\n",streamtype
,i
,howset
,maxd
) ;
617 fprintf(fp
,"rconfig integer aux%s%d_begin_m %s %s 0\n",streamtype
,i
,howset
,maxd
) ;
618 fprintf(fp
,"rconfig integer aux%s%d_begin_s %s %s 0\n",streamtype
,i
,howset
,maxd
) ;
619 fprintf(fp
,"rconfig integer aux%s%d_begin %s %s 0\n",streamtype
,i
,howset
,maxd
) ;
620 fprintf(fp
,"rconfig integer aux%s%d_end_y %s %s 0\n",streamtype
,i
,howset
,maxd
) ;
621 fprintf(fp
,"rconfig integer aux%s%d_end_d %s %s 0\n",streamtype
,i
,howset
,maxd
) ;
622 fprintf(fp
,"rconfig integer aux%s%d_end_h %s %s 0\n",streamtype
,i
,howset
,maxd
) ;
623 fprintf(fp
,"rconfig integer aux%s%d_end_m %s %s 0\n",streamtype
,i
,howset
,maxd
) ;
624 fprintf(fp
,"rconfig integer aux%s%d_end_s %s %s 0\n",streamtype
,i
,howset
,maxd
) ;
625 fprintf(fp
,"rconfig integer aux%s%d_end %s %s 0\n",streamtype
,i
,howset
,maxd
) ;
626 fprintf(fp
,"rconfig integer io_form_aux%s%d %s %s 0\n",streamtype
,i
,howset
,"1") ;
627 fprintf(fp
,"rconfig integer frames_per_aux%s%d %s %s 999999\n",streamtype
,i
,howset
,maxd
) ;
631 close_the_file( fp
) ;