module_io_domain.F
References to this file elsewhere.
1 !WRF:MEDIATION_LAYER:IO
2 !
3
4 MODULE module_io_domain
5 USE module_io
6 USE module_io_wrf
7 USE module_wrf_error
8 USE module_date_time
9 USE module_configure
10 USE module_domain
11
12 CONTAINS
13
14 SUBROUTINE open_r_dataset ( id , fname , grid , config_flags , sysdepinfo, ierr )
15 TYPE (domain) :: grid
16 CHARACTER*(*) :: fname
17 CHARACTER*(*) :: sysdepinfo
18 INTEGER , INTENT(INOUT) :: id , ierr
19 LOGICAL , EXTERNAL :: wrf_dm_on_monitor
20 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
21 CHARACTER*128 :: DataSet
22 LOGICAL :: anyway
23 CALL wrf_open_for_read ( fname , &
24 grid%communicator , &
25 grid%iocommunicator , &
26 sysdepinfo , &
27 id , &
28 ierr )
29 RETURN
30 END SUBROUTINE open_r_dataset
31
32 SUBROUTINE open_w_dataset ( id , fname , grid , config_flags , outsub , sysdepinfo, ierr )
33 TYPE (domain) :: grid
34 CHARACTER*(*) :: fname
35 CHARACTER*(*) :: sysdepinfo
36 INTEGER , INTENT(INOUT) :: id , ierr
37 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
38 LOGICAL , EXTERNAL :: wrf_dm_on_monitor
39 EXTERNAL outsub
40 CHARACTER*128 :: DataSet
41 LOGICAL :: anyway
42 CALL wrf_debug ( 100 , 'calling wrf_open_for_write_begin in open_w_dataset' )
43 CALL wrf_open_for_write_begin ( fname , &
44 grid%communicator , &
45 grid%iocommunicator , &
46 sysdepinfo , &
47 id , &
48 ierr )
49 IF ( ierr .LE. 0 ) THEN
50 CALL wrf_debug ( 100 , 'calling outsub in open_w_dataset' )
51 CALL outsub( id , grid , config_flags , ierr )
52 CALL wrf_debug ( 100 , 'back from outsub in open_w_dataset' )
53 ENDIF
54 IF ( ierr .LE. 0 ) THEN
55 CALL wrf_debug ( 100 , 'calling wrf_open_for_write_commit in open_w_dataset' )
56 CALL wrf_open_for_write_commit ( id , &
57 ierr )
58 CALL wrf_debug ( 100 , 'back from wrf_open_for_write_commit in open_w_dataset' )
59 ENDIF
60 END SUBROUTINE open_w_dataset
61
62 SUBROUTINE open_u_dataset ( id , fname , grid , config_flags , insub , sysdepinfo, ierr )
63 TYPE (domain) :: grid
64 CHARACTER*(*) :: fname
65 CHARACTER*(*) :: sysdepinfo
66 INTEGER , INTENT(INOUT) :: id , ierr
67 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
68 LOGICAL , EXTERNAL :: wrf_dm_on_monitor
69 EXTERNAL insub
70 CHARACTER*128 :: DataSet
71 LOGICAL :: anyway
72 CALL wrf_debug ( 100 , 'calling wrf_open_for_read_begin in open_u_dataset' )
73 CALL wrf_open_for_read_begin ( fname , &
74 grid%communicator , &
75 grid%iocommunicator , &
76 sysdepinfo , &
77 id , &
78 ierr )
79 IF ( ierr .LE. 0 ) THEN
80 CALL wrf_debug ( 100 , 'calling insub in open_u_dataset' )
81 CALL insub( id , grid , config_flags , ierr )
82 ENDIF
83 IF ( ierr .LE. 0 ) THEN
84 CALL wrf_debug ( 100 , 'calling wrf_open_for_read_commit in open_u_dataset' )
85 CALL wrf_open_for_read_commit ( id , &
86 ierr )
87 CALL wrf_debug ( 100 , 'back from wrf_open_for_read_commit in open_u_dataset' )
88 ENDIF
89 END SUBROUTINE open_u_dataset
90
91 SUBROUTINE close_dataset( id , config_flags, sysdepinfo )
92 IMPLICIT NONE
93 INTEGER id , ierr
94 LOGICAL , EXTERNAL :: wrf_dm_on_monitor
95 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
96 CHARACTER*(*) :: sysdepinfo
97 CHARACTER*128 :: DataSet
98 LOGICAL :: anyway
99 CALL wrf_ioclose( id , ierr )
100 END SUBROUTINE close_dataset
101
102
103 ! ------------ Output model input data sets
104
105 SUBROUTINE output_model_input ( fid , grid , config_flags , ierr )
106 IMPLICIT NONE
107 TYPE(domain) :: grid
108 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
109 INTEGER, INTENT(IN) :: fid
110 INTEGER, INTENT(INOUT) :: ierr
111 IF ( config_flags%io_form_input .GT. 0 ) THEN
112 CALL output_wrf ( fid , grid , config_flags , model_input_only , ierr )
113 ENDIF
114 RETURN
115 END SUBROUTINE output_model_input
116
117 SUBROUTINE output_aux_model_input1 ( fid , grid , config_flags , ierr )
118 IMPLICIT NONE
119 TYPE(domain) :: grid
120 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
121 INTEGER, INTENT(IN) :: fid
122 INTEGER, INTENT(INOUT) :: ierr
123 IF ( config_flags%io_form_auxinput1 .GT. 0 ) THEN
124 CALL output_wrf ( fid , grid , config_flags , aux_model_input1_only , ierr )
125 ENDIF
126 RETURN
127 END SUBROUTINE output_aux_model_input1
128
129 SUBROUTINE output_aux_model_input2 ( fid , grid , config_flags , ierr )
130 IMPLICIT NONE
131 TYPE(domain) :: grid
132 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
133 INTEGER, INTENT(IN) :: fid
134 INTEGER, INTENT(INOUT) :: ierr
135 IF ( config_flags%io_form_auxinput2 .GT. 0 ) THEN
136 CALL output_wrf ( fid , grid , config_flags , aux_model_input2_only , ierr )
137 ENDIF
138 RETURN
139 END SUBROUTINE output_aux_model_input2
140
141 SUBROUTINE output_aux_model_input3 ( fid , grid , config_flags , ierr )
142 IMPLICIT NONE
143 TYPE(domain) :: grid
144 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
145 INTEGER, INTENT(IN) :: fid
146 INTEGER, INTENT(INOUT) :: ierr
147 IF ( config_flags%io_form_auxinput3 .GT. 0 ) THEN
148 CALL output_wrf ( fid , grid , config_flags , aux_model_input3_only , ierr )
149 ENDIF
150 RETURN
151 END SUBROUTINE output_aux_model_input3
152
153 SUBROUTINE output_aux_model_input4 ( fid , grid , config_flags , ierr )
154 IMPLICIT NONE
155 TYPE(domain) :: grid
156 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
157 INTEGER, INTENT(IN) :: fid
158 INTEGER, INTENT(INOUT) :: ierr
159 IF ( config_flags%io_form_auxinput4 .GT. 0 ) THEN
160 CALL output_wrf ( fid , grid , config_flags , aux_model_input4_only , ierr )
161 ENDIF
162 RETURN
163 END SUBROUTINE output_aux_model_input4
164
165 SUBROUTINE output_aux_model_input5 ( fid , grid , config_flags , ierr )
166 IMPLICIT NONE
167 TYPE(domain) :: grid
168 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
169 INTEGER, INTENT(IN) :: fid
170 INTEGER, INTENT(INOUT) :: ierr
171 IF ( config_flags%io_form_auxinput5 .GT. 0 ) THEN
172 CALL output_wrf ( fid , grid , config_flags , aux_model_input5_only , ierr )
173 ENDIF
174 RETURN
175 END SUBROUTINE output_aux_model_input5
176
177 SUBROUTINE output_aux_model_input6 ( fid , grid , config_flags , ierr )
178 IMPLICIT NONE
179 TYPE(domain) :: grid
180 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
181 INTEGER, INTENT(IN) :: fid
182 INTEGER, INTENT(INOUT) :: ierr
183 IF ( config_flags%io_form_auxinput6 .GT. 0 ) THEN
184 CALL output_wrf ( fid , grid , config_flags , aux_model_input6_only , ierr )
185 ENDIF
186 RETURN
187 END SUBROUTINE output_aux_model_input6
188
189 SUBROUTINE output_aux_model_input7 ( fid , grid , config_flags , ierr )
190 IMPLICIT NONE
191 TYPE(domain) :: grid
192 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
193 INTEGER, INTENT(IN) :: fid
194 INTEGER, INTENT(INOUT) :: ierr
195 IF ( config_flags%io_form_auxinput7 .GT. 0 ) THEN
196 CALL output_wrf ( fid , grid , config_flags , aux_model_input7_only , ierr )
197 ENDIF
198 RETURN
199 END SUBROUTINE output_aux_model_input7
200
201 SUBROUTINE output_aux_model_input8 ( fid , grid , config_flags , ierr )
202 IMPLICIT NONE
203 TYPE(domain) :: grid
204 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
205 INTEGER, INTENT(IN) :: fid
206 INTEGER, INTENT(INOUT) :: ierr
207 IF ( config_flags%io_form_auxinput8 .GT. 0 ) THEN
208 CALL output_wrf ( fid , grid , config_flags , aux_model_input8_only , ierr )
209 ENDIF
210 RETURN
211 END SUBROUTINE output_aux_model_input8
212
213 SUBROUTINE output_aux_model_input9 ( fid , grid , config_flags , ierr )
214 IMPLICIT NONE
215 TYPE(domain) :: grid
216 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
217 INTEGER, INTENT(IN) :: fid
218 INTEGER, INTENT(INOUT) :: ierr
219 IF ( config_flags%io_form_auxinput9 .GT. 0 ) THEN
220 CALL output_wrf ( fid , grid , config_flags , aux_model_input9_only , ierr )
221 ENDIF
222 RETURN
223 END SUBROUTINE output_aux_model_input9
224
225 SUBROUTINE output_aux_model_input10 ( fid , grid , config_flags , ierr )
226 IMPLICIT NONE
227 TYPE(domain) :: grid
228 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
229 INTEGER, INTENT(IN) :: fid
230 INTEGER, INTENT(INOUT) :: ierr
231 IF ( config_flags%io_form_gfdda .GT. 0 ) THEN
232 CALL output_wrf ( fid , grid , config_flags , aux_model_input10_only , ierr )
233 ENDIF
234 RETURN
235 END SUBROUTINE output_aux_model_input10
236
237 SUBROUTINE output_aux_model_input11 ( fid , grid , config_flags , ierr )
238 IMPLICIT NONE
239 TYPE(domain) :: grid
240 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
241 INTEGER, INTENT(IN) :: fid
242 INTEGER, INTENT(INOUT) :: ierr
243 IF ( config_flags%io_form_auxinput11 .GT. 0 ) THEN
244 CALL output_wrf ( fid , grid , config_flags , aux_model_input11_only , ierr )
245 ENDIF
246 RETURN
247 END SUBROUTINE output_aux_model_input11
248
249 ! ------------ Output model history data sets
250
251 SUBROUTINE output_history ( fid , grid , config_flags , ierr )
252 IMPLICIT NONE
253 TYPE(domain) :: grid
254 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
255 INTEGER, INTENT(IN) :: fid
256 INTEGER, INTENT(INOUT) :: ierr
257 IF ( config_flags%io_form_history .GT. 0 ) THEN
258 CALL output_wrf ( fid , grid , config_flags , history_only , ierr )
259 ENDIF
260 RETURN
261 END SUBROUTINE output_history
262
263 SUBROUTINE output_aux_hist1 ( fid , grid , config_flags , ierr )
264 IMPLICIT NONE
265 TYPE(domain) :: grid
266 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
267 INTEGER, INTENT(IN) :: fid
268 INTEGER, INTENT(INOUT) :: ierr
269 IF ( config_flags%io_form_auxhist1 .GT. 0 ) THEN
270 CALL output_wrf ( fid , grid , config_flags , aux_hist1_only , ierr )
271 ENDIF
272 RETURN
273 END SUBROUTINE output_aux_hist1
274
275 SUBROUTINE output_aux_hist2 ( fid , grid , config_flags , ierr )
276 IMPLICIT NONE
277 TYPE(domain) :: grid
278 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
279 INTEGER, INTENT(IN) :: fid
280 INTEGER, INTENT(INOUT) :: ierr
281 IF ( config_flags%io_form_auxhist2 .GT. 0 ) THEN
282 CALL output_wrf ( fid , grid , config_flags , aux_hist2_only , ierr )
283 ENDIF
284 RETURN
285 END SUBROUTINE output_aux_hist2
286
287 SUBROUTINE output_aux_hist3 ( fid , grid , config_flags , ierr )
288 IMPLICIT NONE
289 TYPE(domain) :: grid
290 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
291 INTEGER, INTENT(IN) :: fid
292 INTEGER, INTENT(INOUT) :: ierr
293 IF ( config_flags%io_form_auxhist3 .GT. 0 ) THEN
294 CALL output_wrf ( fid , grid , config_flags , aux_hist3_only , ierr )
295 ENDIF
296 RETURN
297 END SUBROUTINE output_aux_hist3
298
299 SUBROUTINE output_aux_hist4 ( fid , grid , config_flags , ierr )
300 IMPLICIT NONE
301 TYPE(domain) :: grid
302 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
303 INTEGER, INTENT(IN) :: fid
304 INTEGER, INTENT(INOUT) :: ierr
305 IF ( config_flags%io_form_auxhist4 .GT. 0 ) THEN
306 CALL output_wrf ( fid , grid , config_flags , aux_hist4_only , ierr )
307 ENDIF
308 RETURN
309 END SUBROUTINE output_aux_hist4
310
311 SUBROUTINE output_aux_hist5 ( fid , grid , config_flags , ierr )
312 IMPLICIT NONE
313 TYPE(domain) :: grid
314 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
315 INTEGER, INTENT(IN) :: fid
316 INTEGER, INTENT(INOUT) :: ierr
317 IF ( config_flags%io_form_auxhist5 .GT. 0 ) THEN
318 CALL output_wrf ( fid , grid , config_flags , aux_hist5_only , ierr )
319 ENDIF
320 RETURN
321 END SUBROUTINE output_aux_hist5
322
323 SUBROUTINE output_aux_hist6 ( fid , grid , config_flags , ierr )
324 IMPLICIT NONE
325 TYPE(domain) :: grid
326 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
327 INTEGER, INTENT(IN) :: fid
328 INTEGER, INTENT(INOUT) :: ierr
329 IF ( config_flags%io_form_auxhist6 .GT. 0 ) THEN
330 CALL output_wrf ( fid , grid , config_flags , aux_hist6_only , ierr )
331 ENDIF
332 RETURN
333 END SUBROUTINE output_aux_hist6
334
335 SUBROUTINE output_aux_hist7 ( fid , grid , config_flags , ierr )
336 IMPLICIT NONE
337 TYPE(domain) :: grid
338 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
339 INTEGER, INTENT(IN) :: fid
340 INTEGER, INTENT(INOUT) :: ierr
341 IF ( config_flags%io_form_auxhist7 .GT. 0 ) THEN
342 CALL output_wrf ( fid , grid , config_flags , aux_hist7_only , ierr )
343 ENDIF
344 RETURN
345 END SUBROUTINE output_aux_hist7
346
347 SUBROUTINE output_aux_hist8 ( fid , grid , config_flags , ierr )
348 IMPLICIT NONE
349 TYPE(domain) :: grid
350 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
351 INTEGER, INTENT(IN) :: fid
352 INTEGER, INTENT(INOUT) :: ierr
353 IF ( config_flags%io_form_auxhist8 .GT. 0 ) THEN
354 CALL output_wrf ( fid , grid , config_flags , aux_hist8_only , ierr )
355 ENDIF
356 RETURN
357 END SUBROUTINE output_aux_hist8
358
359 SUBROUTINE output_aux_hist9 ( fid , grid , config_flags , ierr )
360 IMPLICIT NONE
361 TYPE(domain) :: grid
362 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
363 INTEGER, INTENT(IN) :: fid
364 INTEGER, INTENT(INOUT) :: ierr
365 IF ( config_flags%io_form_auxhist9 .GT. 0 ) THEN
366 CALL output_wrf ( fid , grid , config_flags , aux_hist9_only , ierr )
367 ENDIF
368 RETURN
369 END SUBROUTINE output_aux_hist9
370
371 SUBROUTINE output_aux_hist10 ( fid , grid , config_flags , ierr )
372 IMPLICIT NONE
373 TYPE(domain) :: grid
374 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
375 INTEGER, INTENT(IN) :: fid
376 INTEGER, INTENT(INOUT) :: ierr
377 IF ( config_flags%io_form_auxhist10 .GT. 0 ) THEN
378 CALL output_wrf ( fid , grid , config_flags , aux_hist10_only , ierr )
379 ENDIF
380 RETURN
381 END SUBROUTINE output_aux_hist10
382
383 SUBROUTINE output_aux_hist11 ( fid , grid , config_flags , ierr )
384 IMPLICIT NONE
385 TYPE(domain) :: grid
386 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
387 INTEGER, INTENT(IN) :: fid
388 INTEGER, INTENT(INOUT) :: ierr
389 IF ( config_flags%io_form_auxhist11 .GT. 0 ) THEN
390 CALL output_wrf ( fid , grid , config_flags , aux_hist11_only , ierr )
391 ENDIF
392 RETURN
393 END SUBROUTINE output_aux_hist11
394
395 ! ------------ Output model restart data sets
396
397 SUBROUTINE output_restart ( fid , grid , config_flags , ierr )
398 IMPLICIT NONE
399 TYPE(domain) :: grid
400 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
401 INTEGER, INTENT(IN) :: fid
402 INTEGER, INTENT(INOUT) :: ierr
403 IF ( config_flags%io_form_restart .GT. 0 ) THEN
404 CALL output_wrf ( fid , grid , config_flags , restart_only , ierr )
405 ENDIF
406 RETURN
407 END SUBROUTINE output_restart
408
409 ! ------------ Output model boundary data sets
410
411 SUBROUTINE output_boundary ( fid , grid , config_flags , ierr )
412 IMPLICIT NONE
413 TYPE(domain) :: grid
414 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
415 INTEGER, INTENT(IN) :: fid
416 INTEGER, INTENT(INOUT) :: ierr
417 IF ( config_flags%io_form_boundary .GT. 0 ) THEN
418 CALL output_wrf ( fid , grid , config_flags , boundary_only , ierr )
419 ENDIF
420 RETURN
421 END SUBROUTINE output_boundary
422
423 ! ------------ Input model input data sets
424
425 SUBROUTINE input_model_input ( fid , grid , config_flags , ierr )
426 IMPLICIT NONE
427 TYPE(domain) :: grid
428 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
429 INTEGER, INTENT(IN) :: fid
430 INTEGER, INTENT(INOUT) :: ierr
431 IF ( config_flags%io_form_input .GT. 0 ) THEN
432 CALL input_wrf ( fid , grid , config_flags , model_input_only , ierr )
433 ENDIF
434 RETURN
435 END SUBROUTINE input_model_input
436
437 SUBROUTINE input_aux_model_input1 ( fid , grid , config_flags , ierr )
438 IMPLICIT NONE
439 TYPE(domain) :: grid
440 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
441 INTEGER, INTENT(IN) :: fid
442 INTEGER, INTENT(INOUT) :: ierr
443 IF ( config_flags%io_form_auxinput1 .GT. 0 ) THEN
444 CALL input_wrf ( fid , grid , config_flags , aux_model_input1_only , ierr )
445 ENDIF
446 RETURN
447 END SUBROUTINE input_aux_model_input1
448
449 SUBROUTINE input_aux_model_input2 ( fid , grid , config_flags , ierr )
450 IMPLICIT NONE
451 TYPE(domain) :: grid
452 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
453 INTEGER, INTENT(IN) :: fid
454 INTEGER, INTENT(INOUT) :: ierr
455 IF ( config_flags%io_form_auxinput2 .GT. 0 ) THEN
456 CALL input_wrf ( fid , grid , config_flags , aux_model_input2_only , ierr )
457 ENDIF
458 RETURN
459 END SUBROUTINE input_aux_model_input2
460
461 SUBROUTINE input_aux_model_input3 ( fid , grid , config_flags , ierr )
462 IMPLICIT NONE
463 TYPE(domain) :: grid
464 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
465 INTEGER, INTENT(IN) :: fid
466 INTEGER, INTENT(INOUT) :: ierr
467 IF ( config_flags%io_form_auxinput3 .GT. 0 ) THEN
468 CALL input_wrf ( fid , grid , config_flags , aux_model_input3_only , ierr )
469 ENDIF
470 RETURN
471 END SUBROUTINE input_aux_model_input3
472
473 SUBROUTINE input_aux_model_input4 ( fid , grid , config_flags , ierr )
474 IMPLICIT NONE
475 TYPE(domain) :: grid
476 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
477 INTEGER, INTENT(IN) :: fid
478 INTEGER, INTENT(INOUT) :: ierr
479 IF ( config_flags%io_form_auxinput4 .GT. 0 ) THEN
480 CALL input_wrf ( fid , grid , config_flags , aux_model_input4_only , ierr )
481 ENDIF
482 RETURN
483 END SUBROUTINE input_aux_model_input4
484
485 SUBROUTINE input_aux_model_input5 ( fid , grid , config_flags , ierr )
486 IMPLICIT NONE
487 TYPE(domain) :: grid
488 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
489 INTEGER, INTENT(IN) :: fid
490 INTEGER, INTENT(INOUT) :: ierr
491 IF ( config_flags%io_form_auxinput5 .GT. 0 ) THEN
492 CALL input_wrf ( fid , grid , config_flags , aux_model_input5_only , ierr )
493 ENDIF
494 RETURN
495 END SUBROUTINE input_aux_model_input5
496
497 SUBROUTINE input_aux_model_input6 ( fid , grid , config_flags , ierr )
498 IMPLICIT NONE
499 TYPE(domain) :: grid
500 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
501 INTEGER, INTENT(IN) :: fid
502 INTEGER, INTENT(INOUT) :: ierr
503 IF ( config_flags%io_form_auxinput6 .GT. 0 ) THEN
504 CALL input_wrf ( fid , grid , config_flags , aux_model_input6_only , ierr )
505 ENDIF
506 RETURN
507 END SUBROUTINE input_aux_model_input6
508 SUBROUTINE input_aux_model_input7 ( fid , grid , config_flags , ierr )
509 IMPLICIT NONE
510 TYPE(domain) :: grid
511 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
512 INTEGER, INTENT(IN) :: fid
513 INTEGER, INTENT(INOUT) :: ierr
514 IF ( config_flags%io_form_auxinput7 .GT. 0 ) THEN
515 CALL input_wrf ( fid , grid , config_flags , aux_model_input7_only , ierr )
516 ENDIF
517 RETURN
518 END SUBROUTINE input_aux_model_input7
519 SUBROUTINE input_aux_model_input8 ( fid , grid , config_flags , ierr )
520 IMPLICIT NONE
521 TYPE(domain) :: grid
522 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
523 INTEGER, INTENT(IN) :: fid
524 INTEGER, INTENT(INOUT) :: ierr
525 IF ( config_flags%io_form_auxinput8 .GT. 0 ) THEN
526 CALL input_wrf ( fid , grid , config_flags , aux_model_input8_only , ierr )
527 ENDIF
528 RETURN
529 END SUBROUTINE input_aux_model_input8
530 SUBROUTINE input_aux_model_input9 ( fid , grid , config_flags , ierr )
531 IMPLICIT NONE
532 TYPE(domain) :: grid
533 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
534 INTEGER, INTENT(IN) :: fid
535 INTEGER, INTENT(INOUT) :: ierr
536 IF ( config_flags%io_form_auxinput9 .GT. 0 ) THEN
537 CALL input_wrf ( fid , grid , config_flags , aux_model_input9_only , ierr )
538 ENDIF
539 RETURN
540 END SUBROUTINE input_aux_model_input9
541 SUBROUTINE input_aux_model_input10 ( fid , grid , config_flags , ierr )
542 IMPLICIT NONE
543 TYPE(domain) :: grid
544 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
545 INTEGER, INTENT(IN) :: fid
546 INTEGER, INTENT(INOUT) :: ierr
547 IF ( config_flags%io_form_gfdda .GT. 0 ) THEN
548 CALL input_wrf ( fid , grid , config_flags , aux_model_input10_only , ierr )
549 ENDIF
550 RETURN
551 END SUBROUTINE input_aux_model_input10
552 SUBROUTINE input_aux_model_input11 ( fid , grid , config_flags , ierr )
553 IMPLICIT NONE
554 TYPE(domain) :: grid
555 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
556 INTEGER, INTENT(IN) :: fid
557 INTEGER, INTENT(INOUT) :: ierr
558 IF ( config_flags%io_form_auxinput11 .GT. 0 ) THEN
559 CALL input_wrf ( fid , grid , config_flags , aux_model_input11_only , ierr )
560 ENDIF
561 RETURN
562 END SUBROUTINE input_aux_model_input11
563
564 ! ------------ Input model history data sets
565
566 SUBROUTINE input_history ( fid , grid , config_flags , ierr )
567 IMPLICIT NONE
568 TYPE(domain) :: grid
569 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
570 INTEGER, INTENT(IN) :: fid
571 INTEGER, INTENT(INOUT) :: ierr
572 IF ( config_flags%io_form_history .GT. 0 ) THEN
573 CALL input_wrf ( fid , grid , config_flags , history_only , ierr )
574 ENDIF
575 RETURN
576 END SUBROUTINE input_history
577
578 SUBROUTINE input_aux_hist1 ( fid , grid , config_flags , ierr )
579 IMPLICIT NONE
580 TYPE(domain) :: grid
581 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
582 INTEGER, INTENT(IN) :: fid
583 INTEGER, INTENT(INOUT) :: ierr
584 IF ( config_flags%io_form_auxhist1 .GT. 0 ) THEN
585 CALL input_wrf ( fid , grid , config_flags , aux_hist1_only , ierr )
586 ENDIF
587 RETURN
588 END SUBROUTINE input_aux_hist1
589
590 SUBROUTINE input_aux_hist2 ( fid , grid , config_flags , ierr )
591 IMPLICIT NONE
592 TYPE(domain) :: grid
593 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
594 INTEGER, INTENT(IN) :: fid
595 INTEGER, INTENT(INOUT) :: ierr
596 IF ( config_flags%io_form_auxhist2 .GT. 0 ) THEN
597 CALL input_wrf ( fid , grid , config_flags , aux_hist2_only , ierr )
598 ENDIF
599 RETURN
600 END SUBROUTINE input_aux_hist2
601
602 SUBROUTINE input_aux_hist3 ( fid , grid , config_flags , ierr )
603 IMPLICIT NONE
604 TYPE(domain) :: grid
605 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
606 INTEGER, INTENT(IN) :: fid
607 INTEGER, INTENT(INOUT) :: ierr
608 IF ( config_flags%io_form_auxhist3 .GT. 0 ) THEN
609 CALL input_wrf ( fid , grid , config_flags , aux_hist3_only , ierr )
610 ENDIF
611 RETURN
612 END SUBROUTINE input_aux_hist3
613
614 SUBROUTINE input_aux_hist4 ( fid , grid , config_flags , ierr )
615 IMPLICIT NONE
616 TYPE(domain) :: grid
617 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
618 INTEGER, INTENT(IN) :: fid
619 INTEGER, INTENT(INOUT) :: ierr
620 IF ( config_flags%io_form_auxhist4 .GT. 0 ) THEN
621 CALL input_wrf ( fid , grid , config_flags , aux_hist4_only , ierr )
622 ENDIF
623 RETURN
624 END SUBROUTINE input_aux_hist4
625
626 SUBROUTINE input_aux_hist5 ( fid , grid , config_flags , ierr )
627 IMPLICIT NONE
628 TYPE(domain) :: grid
629 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
630 INTEGER, INTENT(IN) :: fid
631 INTEGER, INTENT(INOUT) :: ierr
632 IF ( config_flags%io_form_auxhist5 .GT. 0 ) THEN
633 CALL input_wrf ( fid , grid , config_flags , aux_hist5_only , ierr )
634 ENDIF
635 RETURN
636 END SUBROUTINE input_aux_hist5
637
638 SUBROUTINE input_aux_hist6 ( fid , grid , config_flags , ierr )
639 IMPLICIT NONE
640 TYPE(domain) :: grid
641 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
642 INTEGER, INTENT(IN) :: fid
643 INTEGER, INTENT(INOUT) :: ierr
644 IF ( config_flags%io_form_auxhist6 .GT. 0 ) THEN
645 CALL input_wrf ( fid , grid , config_flags , aux_hist6_only , ierr )
646 ENDIF
647 RETURN
648 END SUBROUTINE input_aux_hist6
649 SUBROUTINE input_aux_hist7 ( fid , grid , config_flags , ierr )
650 IMPLICIT NONE
651 TYPE(domain) :: grid
652 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
653 INTEGER, INTENT(IN) :: fid
654 INTEGER, INTENT(INOUT) :: ierr
655 IF ( config_flags%io_form_auxhist7 .GT. 0 ) THEN
656 CALL input_wrf ( fid , grid , config_flags , aux_hist7_only , ierr )
657 ENDIF
658 RETURN
659 END SUBROUTINE input_aux_hist7
660 SUBROUTINE input_aux_hist8 ( fid , grid , config_flags , ierr )
661 IMPLICIT NONE
662 TYPE(domain) :: grid
663 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
664 INTEGER, INTENT(IN) :: fid
665 INTEGER, INTENT(INOUT) :: ierr
666 IF ( config_flags%io_form_auxhist8 .GT. 0 ) THEN
667 CALL input_wrf ( fid , grid , config_flags , aux_hist8_only , ierr )
668 ENDIF
669 RETURN
670 END SUBROUTINE input_aux_hist8
671 SUBROUTINE input_aux_hist9 ( fid , grid , config_flags , ierr )
672 IMPLICIT NONE
673 TYPE(domain) :: grid
674 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
675 INTEGER, INTENT(IN) :: fid
676 INTEGER, INTENT(INOUT) :: ierr
677 IF ( config_flags%io_form_auxhist9 .GT. 0 ) THEN
678 CALL input_wrf ( fid , grid , config_flags , aux_hist9_only , ierr )
679 ENDIF
680 RETURN
681 END SUBROUTINE input_aux_hist9
682 SUBROUTINE input_aux_hist10 ( fid , grid , config_flags , ierr )
683 IMPLICIT NONE
684 TYPE(domain) :: grid
685 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
686 INTEGER, INTENT(IN) :: fid
687 INTEGER, INTENT(INOUT) :: ierr
688 IF ( config_flags%io_form_auxhist10 .GT. 0 ) THEN
689 CALL input_wrf ( fid , grid , config_flags , aux_hist10_only , ierr )
690 ENDIF
691 RETURN
692 END SUBROUTINE input_aux_hist10
693 SUBROUTINE input_aux_hist11 ( fid , grid , config_flags , ierr )
694 IMPLICIT NONE
695 TYPE(domain) :: grid
696 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
697 INTEGER, INTENT(IN) :: fid
698 INTEGER, INTENT(INOUT) :: ierr
699 IF ( config_flags%io_form_auxhist11 .GT. 0 ) THEN
700 CALL input_wrf ( fid , grid , config_flags , aux_hist11_only , ierr )
701 ENDIF
702 RETURN
703 END SUBROUTINE input_aux_hist11
704
705 ! ------------ Input model restart data sets
706
707 SUBROUTINE input_restart ( fid , grid , config_flags , ierr )
708 IMPLICIT NONE
709 TYPE(domain) :: grid
710 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
711 INTEGER, INTENT(IN) :: fid
712 INTEGER, INTENT(INOUT) :: ierr
713 IF ( config_flags%io_form_restart .GT. 0 ) THEN
714 CALL input_wrf ( fid , grid , config_flags , restart_only , ierr )
715 ENDIF
716 RETURN
717 END SUBROUTINE input_restart
718
719 ! ------------ Input model boundary data sets
720
721 SUBROUTINE input_boundary ( fid , grid , config_flags , ierr )
722 IMPLICIT NONE
723 TYPE(domain) :: grid
724 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
725 INTEGER, INTENT(IN) :: fid
726 INTEGER, INTENT(INOUT) :: ierr
727 IF ( config_flags%io_form_boundary .GT. 0 ) THEN
728 CALL input_wrf ( fid , grid , config_flags , boundary_only , ierr )
729 ENDIF
730 RETURN
731 END SUBROUTINE input_boundary
732
733 END MODULE module_io_domain
734
735 ! move outside module so callable without USE of module
736 SUBROUTINE construct_filename1( result , basename , fld1 , len1 )
737 IMPLICIT NONE
738 CHARACTER*(*) :: result
739 CHARACTER*(*) :: basename
740 INTEGER , INTENT(IN) :: fld1 , len1
741 CHARACTER*64 :: t1, zeros
742
743 CALL zero_pad ( t1 , fld1 , len1 )
744 result = TRIM(basename) // "_d" // TRIM(t1)
745 CALL maybe_remove_colons(result)
746 RETURN
747 END SUBROUTINE construct_filename1
748
749 SUBROUTINE construct_filename2( result , basename , fld1 , len1 , date_char )
750 IMPLICIT NONE
751 CHARACTER*(*) :: result
752 CHARACTER*(*) :: basename
753 CHARACTER*(*) :: date_char
754
755 INTEGER , INTENT(IN) :: fld1 , len1
756 CHARACTER*64 :: t1, zeros
757 CALL zero_pad ( t1 , fld1 , len1 )
758 result = TRIM(basename) // ".d" // TRIM(t1) // "." // TRIM(date_char)
759 CALL maybe_remove_colons(result)
760 RETURN
761 END SUBROUTINE construct_filename2
762
763 ! this version looks for <date> and <domain> in the basename and replaces with the arguments
764
765 SUBROUTINE construct_filename2a( result , basename , fld1 , len1 , date_char )
766 IMPLICIT NONE
767 CHARACTER*(*) :: result
768 CHARACTER*(*) :: basename
769 CHARACTER*(*) :: date_char
770
771 INTEGER , INTENT(IN) :: fld1 , len1
772 CHARACTER*64 :: t1, zeros
773 INTEGER i, j, l
774 result=basename
775 CALL zero_pad ( t1 , fld1 , len1 )
776 i = index( basename , '<domain>' )
777 l = len(trim(basename))
778 IF ( i .GT. 0 ) THEN
779 result = basename(1:i-1) // TRIM(t1) // basename(i+8:l)
780 ENDIF
781 i = index( result , '<date>' )
782 l = len(trim(result))
783 IF ( i .GT. 0 ) THEN
784 result = result(1:i-1) // TRIM(date_char) // result(i+6:l)
785 ENDIF
786 CALL maybe_remove_colons(result)
787 RETURN
788 END SUBROUTINE construct_filename2a
789
790 SUBROUTINE construct_filename ( result , basename , fld1 , len1 , fld2 , len2 )
791 IMPLICIT NONE
792 CHARACTER*(*) :: result
793 CHARACTER*(*) :: basename
794 INTEGER , INTENT(IN) :: fld1 , len1 , fld2 , len2
795 CHARACTER*64 :: t1, t2, zeros
796
797 CALL zero_pad ( t1 , fld1 , len1 )
798 CALL zero_pad ( t2 , fld2 , len2 )
799 result = TRIM(basename) // "_d" // TRIM(t1) // "_" // TRIM(t2)
800 CALL maybe_remove_colons(result)
801 RETURN
802 END SUBROUTINE construct_filename
803
804 SUBROUTINE construct_filename3 ( result , basename , fld1 , len1 , fld2 , len2, fld3, len3 )
805 IMPLICIT NONE
806 CHARACTER*(*) :: result
807 CHARACTER*(*) :: basename
808 INTEGER , INTENT(IN) :: fld1 , len1 , fld2 , len2, fld3, len3
809 CHARACTER*64 :: t1, t2, t3, zeros
810
811 CALL zero_pad ( t1 , fld1 , len1 )
812 CALL zero_pad ( t2 , fld2 , len2 )
813 CALL zero_pad ( t3 , fld3 , len3 )
814 result = TRIM(basename) // "_d" // TRIM(t1) // "_" // TRIM(t2) // "_" // TRIM(t3)
815 CALL maybe_remove_colons(result)
816 RETURN
817 END SUBROUTINE construct_filename3
818
819 SUBROUTINE construct_filename4( result , basename , fld1 , len1 , date_char , io_form )
820 IMPLICIT NONE
821 CHARACTER*(*) :: result
822 CHARACTER*(*) :: basename
823 CHARACTER*(*) :: date_char
824
825 INTEGER , INTENT(IN) :: fld1 , len1 , io_form
826 CHARACTER*64 :: t1, zeros
827 CHARACTER*4 :: ext
828 CALL zero_pad ( t1 , fld1 , len1 )
829 IF ( io_form .EQ. 1 ) THEN
830 ext = '.int'
831 ELSE IF ( io_form .EQ. 2 ) THEN
832 ext = '.nc '
833 ELSE IF ( io_form .EQ. 5 ) THEN
834 ext = '.gb '
835 ELSE
836 CALL wrf_error_fatal ('improper io_form')
837 END IF
838 result = TRIM(basename) // ".d" // TRIM(t1) // "." // TRIM(date_char) // TRIM(ext)
839 CALL maybe_remove_colons(result)
840 RETURN
841 END SUBROUTINE construct_filename4
842
843 ! this version looks for <date> and <domain> in the basename and replaces with the arguments
844
845 SUBROUTINE construct_filename4a( result , basename , fld1 , len1 , date_char , io_form )
846 IMPLICIT NONE
847 CHARACTER*(*) :: result
848 CHARACTER*(*) :: basename
849 CHARACTER*(*) :: date_char
850
851 INTEGER , INTENT(IN) :: fld1 , len1 , io_form
852 CHARACTER*64 :: t1, zeros
853 CHARACTER*4 :: ext
854 INTEGER i, j, l
855 result=basename
856 CALL zero_pad ( t1 , fld1 , len1 )
857 IF ( MOD(io_form,100) .EQ. 1 ) THEN
858 ext = '.int'
859 ELSE IF ( MOD(io_form,100) .EQ. 2 ) THEN
860 ext = '.nc '
861 ELSE IF ( MOD(io_form,100) .EQ. 5 ) THEN
862 ext = '.gb '
863 ELSE
864 CALL wrf_error_fatal ('improper io_form')
865 END IF
866 l = len(trim(basename))
867 result = basename(1:l) // TRIM(ext)
868 i = index( result , '<domain>' )
869 l = len(trim(result))
870 IF ( i .GT. 0 ) THEN
871 result = result(1:i-1) // TRIM(t1) // result(i+8:l)
872 ENDIF
873 i = index( result , '<date>' )
874 l = len(trim(result))
875 IF ( i .GT. 0 ) THEN
876 result = result(1:i-1) // TRIM(date_char) // result(i+6:l)
877 ENDIF
878 CALL maybe_remove_colons(result)
879 RETURN
880 END SUBROUTINE construct_filename4a
881
882 SUBROUTINE append_to_filename ( result , basename , fld1 , len1 )
883 IMPLICIT NONE
884 CHARACTER*(*) :: result
885 CHARACTER*(*) :: basename
886 INTEGER , INTENT(IN) :: fld1 , len1
887 CHARACTER*64 :: t1, zeros
888
889 CALL zero_pad ( t1 , fld1 , len1 )
890 result = TRIM(basename) // "_" // TRIM(t1)
891 CALL maybe_remove_colons(result)
892 RETURN
893 END SUBROUTINE append_to_filename
894
895 SUBROUTINE zero_pad ( result , fld1 , len1 )
896 IMPLICIT NONE
897 CHARACTER*(*) :: result
898 INTEGER , INTENT (IN) :: fld1 , len1
899 INTEGER :: d , x
900 CHARACTER*64 :: t2, zeros
901 x = fld1 ; d = 0
902 DO WHILE ( x > 0 )
903 x = x / 10
904 d = d + 1
905 END DO
906 write(t2,'(I9)')fld1
907 zeros = '0000000000000000000000000000000'
908 result = zeros(1:len1-d) // t2(9-d+1:9)
909 RETURN
910 END SUBROUTINE zero_pad
911
912 SUBROUTINE init_wrfio
913 USE module_io
914 IMPLICIT NONE
915 INTEGER ierr
916 CALL wrf_ioinit(ierr)
917 END SUBROUTINE init_wrfio
918
919 !<DESCRIPTION>
920 ! This routine figures out the nearest previous time instant
921 ! that corresponds to a multiple of the input time interval.
922 ! Example use is to give the time instant that corresponds to
923 ! an I/O interval, even when the current time is a little bit
924 ! past that time when, for example, the number of model time
925 ! steps does not evenly divide the I/O interval. JM 20051013
926 !</DESCRIPTION>
927 !
928 SUBROUTINE adjust_io_timestr ( TI, CT, ST, timestr )
929 USE module_io_domain
930 IMPLICIT NONE
931 ! Args
932 TYPE(WRFU_Time), INTENT(IN) :: ST,CT ! domain start and current time
933 TYPE(WRFU_TimeInterval), INTENT(IN) :: TI ! interval
934 CHARACTER*(*), INTENT(INOUT) :: timestr ! returned string
935 ! Local
936 TYPE(WRFU_Time) :: OT
937 TYPE(WRFU_TimeInterval) :: IOI
938 INTEGER :: n
939
940 IOI = CT-ST ! length of time since starting
941 n = WRFU_TimeIntervalDIVQuot( IOI , TI ) ! number of whole time intervals
942 IOI = TI * n ! amount of time since starting in whole time intervals
943 OT = ST + IOI ! previous nearest time instant
944 CALL wrf_timetoa( OT, timestr ) ! generate string
945 RETURN
946 END SUBROUTINE adjust_io_timestr
947
948 ! Modify the filename to remove things like ':' from the file name
949 ! unless it is a drive number. Convert to '_' instead.
950
951 SUBROUTINE maybe_remove_colons( FileName )
952 USE module_configure
953 CHARACTER*(*) FileName
954 CHARACTER c, d
955 INTEGER i, l
956 LOGICAL nocolons
957 l = LEN(TRIM(FileName))
958 ! do not change first two characters (naive way of dealing with
959 ! possiblity of drive name in a microsoft path
960 CALL nl_get_nocolons(1,nocolons)
961 IF ( nocolons ) THEN
962 DO i = 3, l
963 IF ( FileName(i:i) .EQ. ':' ) THEN
964 FileName(i:i) = '_'
965 ENDIF
966 ENDDO
967 ENDIF
968 RETURN
969 END
970
971
972