mediation_wrfmain.F
References to this file elsewhere.
1 !WRF:MEDIATION_LAYER:
2 !
3
4 SUBROUTINE med_initialdata_input_ptr ( grid , config_flags )
5 USE module_domain
6 USE module_configure
7 IMPLICIT NONE
8 TYPE (domain) , POINTER :: grid
9 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
10 INTERFACE
11 SUBROUTINE med_initialdata_input ( grid , config_flags )
12 USE module_domain
13 USE module_configure
14 TYPE (domain) :: grid
15 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
16 END SUBROUTINE med_initialdata_input
17 END INTERFACE
18 CALL med_initialdata_input ( grid , config_flags )
19
20
21 END SUBROUTINE med_initialdata_input_ptr
22
23 SUBROUTINE med_initialdata_input ( grid , config_flags )
24 ! Driver layer
25 USE module_domain
26 USE module_io_domain
27 USE module_timing
28 use module_io
29 ! Model layer
30 USE module_configure
31 USE module_bc_time_utilities
32 USE module_utility
33
34 IMPLICIT NONE
35
36 ! Interface
37 INTERFACE
38 SUBROUTINE start_domain ( grid , allowed_to_read ) ! comes from module_start in appropriate dyn_ directory
39 USE module_domain
40 TYPE (domain) grid
41 LOGICAL, INTENT(IN) :: allowed_to_read
42 END SUBROUTINE start_domain
43 END INTERFACE
44
45 ! Arguments
46 TYPE(domain) :: grid
47 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
48 ! Local
49 INTEGER :: fid , ierr , myproc
50 CHARACTER (LEN=80) :: inpname , rstname, timestr
51 CHARACTER (LEN=80) :: message
52 LOGICAL :: restart
53
54 CALL nl_get_restart( 1, restart )
55 IF ( .NOT. restart ) THEN
56 ! Initialize the mother domain.
57 grid%input_from_file = .true.
58 IF ( grid%input_from_file ) THEN
59
60 CALL wrf_debug ( 1 , 'wrf main: calling open_r_dataset for wrfinput' )
61
62 ! typically <date> will not be part of input_inname but allow for it
63 CALL domain_clock_get( grid, current_timestr=timestr )
64 CALL construct_filename2a ( inpname , config_flags%input_inname , grid%id , 2 , timestr )
65
66 CALL open_r_dataset ( fid, TRIM(inpname) , grid , config_flags , "DATASET=INPUT", ierr )
67 IF ( ierr .NE. 0 ) THEN
68 WRITE( wrf_err_message , * ) 'program wrf: error opening ',TRIM(inpname),' for reading ierr=',ierr
69 CALL WRF_ERROR_FATAL ( wrf_err_message )
70 ENDIF
71 IF ( ( grid%id .EQ. 1 ) .OR. ( config_flags%fine_input_stream .EQ. 0 ) ) THEN
72 CALL wrf_debug ( 0 , 'med_initialdata_input: calling input_model_input' )
73 CALL input_model_input ( fid , grid , config_flags , ierr )
74 CALL wrf_debug ( 100 , 'med_initialdata_input: back from input_model_input' )
75 ELSE IF ( config_flags%fine_input_stream .EQ. 1 ) THEN
76 CALL wrf_debug ( 0 , 'med_initialdata_input: calling input_aux_model_input1' )
77 CALL input_aux_model_input1 ( fid , grid , config_flags , ierr )
78 CALL wrf_debug ( 100 , 'med_initialdata_input: back from input_aux_model_input1' )
79 ELSE IF ( config_flags%fine_input_stream .EQ. 2 ) THEN
80 CALL wrf_debug ( 0 , 'med_initialdata_input: calling input_aux_model_input2' )
81 CALL input_aux_model_input2 ( fid , grid , config_flags , ierr )
82 CALL wrf_debug ( 100 , 'med_initialdata_input: back from input_aux_model_input2' )
83 ELSE IF ( config_flags%fine_input_stream .EQ. 3 ) THEN
84 CALL wrf_debug ( 0 , 'med_initialdata_input: calling input_aux_model_input3' )
85 CALL input_aux_model_input3 ( fid , grid , config_flags , ierr )
86 CALL wrf_debug ( 100 , 'med_initialdata_input: back from input_aux_model_input3' )
87 ELSE IF ( config_flags%fine_input_stream .EQ. 4 ) THEN
88 CALL wrf_debug ( 0 , 'med_initialdata_input: calling input_aux_model_input4' )
89 CALL input_aux_model_input4 ( fid , grid , config_flags , ierr )
90 CALL wrf_debug ( 100 , 'med_initialdata_input: back from input_aux_model_input4' )
91 ELSE IF ( config_flags%fine_input_stream .EQ. 5 ) THEN
92 CALL wrf_debug ( 0 , 'med_initialdata_input: calling input_aux_model_input5' )
93 CALL input_aux_model_input5 ( fid , grid , config_flags , ierr )
94 CALL wrf_debug ( 100 , 'med_initialdata_input: back from input_aux_model_input5' )
95 ELSE IF ( config_flags%fine_input_stream .EQ. 6 ) THEN
96 CALL wrf_debug ( 0 , 'med_initialdata_input: calling input_aux_model_input6' )
97 CALL input_aux_model_input6 ( fid , grid , config_flags , ierr )
98 CALL wrf_debug ( 100 , 'med_initialdata_input: back from input_aux_model_input6' )
99 ELSE IF ( config_flags%fine_input_stream .EQ. 7 ) THEN
100 CALL wrf_debug ( 0 , 'med_initialdata_input: calling input_aux_model_input7' )
101 CALL input_aux_model_input7 ( fid , grid , config_flags , ierr )
102 CALL wrf_debug ( 100 , 'med_initialdata_input: back from input_aux_model_input7' )
103 ELSE IF ( config_flags%fine_input_stream .EQ. 8 ) THEN
104 CALL wrf_debug ( 0 , 'med_initialdata_input: calling input_aux_model_input8' )
105 CALL input_aux_model_input8 ( fid , grid , config_flags , ierr )
106 CALL wrf_debug ( 100 , 'med_initialdata_input: back from input_aux_model_input8' )
107 ELSE IF ( config_flags%fine_input_stream .EQ. 9 ) THEN
108 CALL wrf_debug ( 0 , 'med_initialdata_input: calling input_aux_model_input9' )
109 CALL input_aux_model_input9 ( fid , grid , config_flags , ierr )
110 CALL wrf_debug ( 100 , 'med_initialdata_input: back from input_aux_model_input9' )
111 ELSE IF ( config_flags%fine_input_stream .EQ. 10 ) THEN
112 CALL wrf_debug ( 0 , 'med_initialdata_input: calling input_aux_model_input10' )
113 CALL input_aux_model_input10 ( fid , grid , config_flags , ierr )
114 CALL wrf_debug ( 100 , 'med_initialdata_input: back from input_aux_model_input10' )
115 ELSE IF ( config_flags%fine_input_stream .EQ. 11 ) THEN
116 CALL wrf_debug ( 0 , 'med_initialdata_input: calling input_aux_model_input11' )
117 CALL input_aux_model_input11 ( fid , grid , config_flags , ierr )
118 CALL wrf_debug ( 100 , 'med_initialdata_input: back from input_aux_model_input11' )
119 ELSE
120 WRITE( message , '("med_initialdata_input: bad fine_input_stream = ",I4)') config_flags%fine_input_stream
121 CALL WRF_ERROR_FATAL ( message )
122 END IF
123 CALL close_dataset ( fid , config_flags , "DATASET=INPUT" )
124 #ifdef MOVE_NESTS
125 grid%nest_pos = grid%ht
126 where ( grid%nest_pos .gt. 0 ) grid%nest_pos = grid%nest_pos + 500. ! make a cliff
127 #endif
128 ENDIF
129 grid%imask_nostag = 1
130 grid%imask_xstag = 1
131 grid%imask_ystag = 1
132 grid%imask_xystag = 1
133 CALL start_domain ( grid , .TRUE. )
134 ELSE
135 CALL domain_clock_get( grid, current_timestr=timestr )
136 CALL construct_filename2a ( rstname , config_flags%rst_inname , grid%id , 2 , timestr )
137
138 WRITE(message,*)'RESTART run: opening ',TRIM(rstname),' for reading'
139 CALL wrf_message ( message )
140 CALL open_r_dataset ( fid , TRIM(rstname) , grid , config_flags , "DATASET=RESTART", ierr )
141 IF ( ierr .NE. 0 ) THEN
142 WRITE( message , '("program wrf: error opening ",A32," for reading")') TRIM(rstname)
143 CALL WRF_ERROR_FATAL ( message )
144 ENDIF
145 CALL input_restart ( fid, grid , config_flags , ierr )
146 CALL close_dataset ( fid , config_flags , "DATASET=RESTART" )
147 grid%imask_nostag = 1
148 grid%imask_xstag = 1
149 grid%imask_ystag = 1
150 grid%imask_xystag = 1
151 CALL start_domain ( grid , .TRUE. )
152 ENDIF
153
154 RETURN
155 END SUBROUTINE med_initialdata_input
156
157 SUBROUTINE med_shutdown_io ( grid , config_flags )
158 ! Driver layer
159 USE module_domain
160 USE module_io_domain
161 ! Model layer
162 USE module_configure
163
164 IMPLICIT NONE
165
166 ! Arguments
167 TYPE(domain) :: grid
168 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
169 ! Local
170 CHARACTER (LEN=80) :: message
171 INTEGER :: ierr
172
173 IF ( grid%oid > 0 ) CALL close_dataset ( grid%oid , config_flags , "DATASET=HISTORY" )
174 IF ( grid%auxhist1_oid > 0 ) CALL close_dataset ( grid%auxhist1_oid , config_flags , "DATASET=AUXHIST1" )
175 IF ( grid%auxhist2_oid > 0 ) CALL close_dataset ( grid%auxhist2_oid , config_flags , "DATASET=AUXHIST2" )
176 IF ( grid%auxhist3_oid > 0 ) CALL close_dataset ( grid%auxhist3_oid , config_flags , "DATASET=AUXHIST3" )
177 IF ( grid%auxhist4_oid > 0 ) CALL close_dataset ( grid%auxhist4_oid , config_flags , "DATASET=AUXHIST4" )
178 IF ( grid%auxhist5_oid > 0 ) CALL close_dataset ( grid%auxhist5_oid , config_flags , "DATASET=AUXHIST5" )
179 #if 0
180 IF ( grid%auxhist6_oid > 0 ) CALL close_dataset ( grid%auxhist6_oid , config_flags , "DATASET=AUXHIST6" )
181 IF ( grid%auxhist7_oid > 0 ) CALL close_dataset ( grid%auxhist7_oid , config_flags , "DATASET=AUXHIST7" )
182 IF ( grid%auxhist8_oid > 0 ) CALL close_dataset ( grid%auxhist8_oid , config_flags , "DATASET=AUXHIST8" )
183 IF ( grid%auxhist9_oid > 0 ) CALL close_dataset ( grid%auxhist9_oid , config_flags , "DATASET=AUXHIST9" )
184 IF ( grid%auxhist10_oid > 0 ) CALL close_dataset ( grid%auxhist10_oid , config_flags , "DATASET=AUXHIST10" )
185 IF ( grid%auxhist11_oid > 0 ) CALL close_dataset ( grid%auxhist11_oid , config_flags , "DATASET=AUXHIST11" )
186 #endif
187
188 IF ( grid%lbc_fid > 0 ) CALL close_dataset ( grid%lbc_fid , config_flags , "DATASET=BOUNDARY" )
189
190 CALL wrf_ioexit( ierr ) ! shut down the quilt I/O
191
192 RETURN
193
194 END SUBROUTINE med_shutdown_io
195
196 SUBROUTINE med_add_config_info_to_grid ( grid )
197
198 USE module_domain
199 USE module_configure
200
201 IMPLICIT NONE
202
203 ! Input data.
204
205 TYPE(domain) , TARGET :: grid
206
207 #define SOURCE_RECORD model_config_rec %
208 #define SOURCE_REC_DEX (grid%id)
209 #define DEST_RECORD grid %
210 #include <config_assigns.inc>
211
212 RETURN
213
214 END SUBROUTINE med_add_config_info_to_grid
215