source: trunk/WRF.COMMON/WRFV3/share/module_io_domain.F @ 3026

Last change on this file since 3026 was 2759, checked in by aslmd, 3 years ago

adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 34.1 KB
RevLine 
[2759]1!WRF:MEDIATION_LAYER:IO
2!
3
4MODULE module_io_domain
5USE module_io
6USE module_io_wrf
7USE module_wrf_error
8USE module_date_time
9USE module_configure
10USE module_domain
11
12CONTAINS
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
733END MODULE module_io_domain
734
735! move outside module so callable without USE of module
736SUBROUTINE 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
747END SUBROUTINE construct_filename1
748
749SUBROUTINE 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
761END SUBROUTINE construct_filename2
762
763! this version looks for <date> and <domain> in the basename and replaces with the arguments
764
765SUBROUTINE 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
788END SUBROUTINE construct_filename2a
789
790SUBROUTINE 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
802END SUBROUTINE construct_filename
803
804SUBROUTINE 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
817END SUBROUTINE construct_filename3
818
819SUBROUTINE construct_filename4( result , basename , fld1 , len1 , date_char , io_form )
820  USE module_state_description
821  IMPLICIT NONE
822  CHARACTER*(*) :: result
823  CHARACTER*(*) :: basename
824  CHARACTER*(*) :: date_char
825
826  INTEGER, EXTERNAL :: use_package
827  INTEGER , INTENT(IN) :: fld1 , len1 , io_form
828  CHARACTER*64         :: t1, zeros
829  CHARACTER*4          :: ext
830  CALL zero_pad ( t1 , fld1 , len1 )
831  IF      ( use_package(io_form) .EQ. IO_INTIO ) THEN
832     ext = '.int'
833  ELSE IF ( use_package(io_form) .EQ. IO_NETCDF ) THEN
834     ext = '.nc '
835  ELSE IF ( use_package(io_form) .EQ. IO_PNETCDF ) THEN
836    ext = '.nc '
837  ELSE IF ( use_package(io_form) .EQ. IO_GRIB1 ) THEN
838     ext = '.gb '
839  ELSE
840     CALL wrf_error_fatal ('improper io_form')
841  END IF
842  result = TRIM(basename) // ".d" // TRIM(t1) // "." // TRIM(date_char) // TRIM(ext)
843  CALL maybe_remove_colons(result)
844  RETURN
845END SUBROUTINE construct_filename4
846
847! this version looks for <date> and <domain> in the basename and replaces with the arguments
848
849SUBROUTINE construct_filename4a( result , basename , fld1 , len1 , date_char , io_form )
850  USE module_state_description
851  IMPLICIT NONE
852  CHARACTER*(*) :: result
853  CHARACTER*(*) :: basename
854  CHARACTER*(*) :: date_char
855
856  INTEGER, EXTERNAL :: use_package
857  INTEGER , INTENT(IN) :: fld1 , len1 , io_form
858  CHARACTER*64         :: t1, zeros
859  CHARACTER*4          :: ext
860  INTEGER   i, j, l
861  result=basename
862  CALL zero_pad ( t1 , fld1 , len1 )
863  IF      ( use_package(io_form) .EQ. IO_INTIO ) THEN
864     ext = '.int'
865  ELSE IF ( use_package(io_form) .EQ. IO_NETCDF ) THEN
866     ext = '.nc '
867  ELSE IF ( use_package(io_form) .EQ. IO_PNETCDF ) THEN
868    ext = '.nc '
869  ELSE IF ( use_package(io_form) .EQ. IO_GRIB1 ) THEN
870     ext = '.gb '
871  ELSE
872     CALL wrf_error_fatal ('improper io_form')
873  END IF
874  l = len(trim(basename))
875  result = basename(1:l) // TRIM(ext)
876  i = index( result , '<domain>' )
877  l = len(trim(result))
878  IF ( i .GT. 0 ) THEN
879    result = result(1:i-1) // TRIM(t1) // result(i+8:l)
880  ENDIF
881  i = index( result , '<date>' )
882  l = len(trim(result))
883  IF ( i .GT. 0 ) THEN
884    result = result(1:i-1) // TRIM(date_char) // result(i+6:l)
885  ENDIF
886  CALL maybe_remove_colons(result)
887  RETURN
888END SUBROUTINE construct_filename4a
889
890SUBROUTINE append_to_filename ( result , basename , fld1 , len1 )
891  IMPLICIT NONE
892  CHARACTER*(*) :: result
893  CHARACTER*(*) :: basename
894  INTEGER , INTENT(IN) :: fld1 , len1
895  CHARACTER*64         :: t1, zeros
896 
897  CALL zero_pad ( t1 , fld1 , len1 )
898  result = TRIM(basename) // "_" // TRIM(t1)
899  CALL maybe_remove_colons(result)
900  RETURN
901END SUBROUTINE append_to_filename
902
903SUBROUTINE zero_pad ( result , fld1 , len1 )
904  IMPLICIT NONE
905  CHARACTER*(*) :: result
906  INTEGER , INTENT (IN)      :: fld1 , len1
907  INTEGER                    :: d , x
908  CHARACTER*64         :: t2, zeros
909  x = fld1 ; d = 0
910  DO WHILE ( x > 0 )
911    x = x / 10
912    d = d + 1
913  END DO
914  write(t2,'(I9)')fld1
915  zeros = '0000000000000000000000000000000'
916  result = zeros(1:len1-d) // t2(9-d+1:9)
917  RETURN
918END SUBROUTINE zero_pad
919
920SUBROUTINE init_wrfio
921   USE module_io
922   IMPLICIT NONE
923   INTEGER ierr
924   CALL wrf_ioinit(ierr)
925END SUBROUTINE init_wrfio
926
927!<DESCRIPTION>
928! This routine figures out the nearest previous time instant
929! that corresponds to a multiple of the input time interval.
930! Example use is to give the time instant that corresponds to
931! an I/O interval, even when the current time is a little bit
932! past that time when, for example, the number of model time
933! steps does not evenly divide the I/O interval. JM 20051013
934!</DESCRIPTION>
935!
936SUBROUTINE adjust_io_timestr ( TI, CT, ST, timestr )
937   USE module_io_domain
938   IMPLICIT NONE
939! Args
940   TYPE(WRFU_Time), INTENT(IN)            :: ST,CT    ! domain start and current time
941   TYPE(WRFU_TimeInterval), INTENT(IN)    :: TI       ! interval
942   CHARACTER*(*), INTENT(INOUT)           :: timestr  ! returned string
943! Local
944   TYPE(WRFU_Time)                        :: OT
945   TYPE(WRFU_TimeInterval)                :: IOI
946   INTEGER                                :: n
947
948   IOI = CT-ST                               ! length of time since starting
949   n = WRFU_TimeIntervalDIVQuot( IOI , TI )  ! number of whole time intervals
950   IOI = TI * n                              ! amount of time since starting in whole time intervals
951   OT = ST + IOI                             ! previous nearest time instant
952   CALL wrf_timetoa( OT, timestr )           ! generate string
953   RETURN
954END SUBROUTINE adjust_io_timestr
955
956! Modify the filename to remove things like ':' from the file name
957! unless it is a drive number. Convert to '_' instead.
958
959SUBROUTINE maybe_remove_colons( FileName )
960  USE module_configure
961  CHARACTER*(*) FileName
962  CHARACTER c, d
963  INTEGER i, l
964  LOGICAL nocolons
965  l = LEN(TRIM(FileName))
966! do not change first two characters (naive way of dealing with
967! possiblity of drive name in a microsoft path
968  CALL nl_get_nocolons(1,nocolons)
969  IF ( nocolons ) THEN
970    DO i = 3, l
971      IF ( FileName(i:i) .EQ. ':' ) THEN
972        FileName(i:i) = '_'
973      ENDIF
974    ENDDO
975  ENDIF
976  RETURN
977END
978
979
980
Note: See TracBrowser for help on using the repository browser.