mediation_force_domain.F
References to this file elsewhere.
1 !
2 !WRF:MEDIATION_LAYER:NESTING
3 !
4 SUBROUTINE med_force_domain ( parent_grid , nested_grid )
5 USE module_domain
6 USE module_configure
7 IMPLICIT NONE
8 TYPE(domain), POINTER :: parent_grid , nested_grid
9 TYPE(domain), POINTER :: grid
10 INTEGER nlev, msize
11 #if !defined(MAC_KLUDGE)
12 TYPE (grid_config_rec_type) :: config_flags
13 #endif
14 ! see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
15 INTEGER :: sm31 , em31 , sm32 , em32 , sm33 , em33
16 INTEGER :: sm31x, em31x, sm32x, em32x, sm33x, em33x
17 INTEGER :: sm31y, em31y, sm32y, em32y, sm33y, em33y
18
19 ! ----------------------------------------------------------
20 ! ------------------------------------------------------
21 ! Interface blocks
22 ! ------------------------------------------------------
23 INTERFACE
24 ! ------------------------------------------------------
25 ! Interface definitions for EM CORE
26 ! ------------------------------------------------------
27 #if (EM_CORE == 1)
28 #if !defined(MAC_KLUDGE)
29 ! ------------------------------------------------------
30 ! These routines are supplied by module_dm.F from the
31 ! external communication package (e.g. external/RSL)
32 ! ------------------------------------------------------
33 SUBROUTINE interp_domain_em_part1 ( grid, intermediate_grid, ngrid, config_flags &
34 !
35 # include "em_dummy_new_args.inc"
36 !
37 )
38 USE module_domain
39 USE module_configure
40 TYPE(domain), POINTER :: grid ! name of the grid being dereferenced (must be "grid")
41 TYPE(domain), POINTER :: intermediate_grid
42 TYPE(domain), POINTER :: ngrid
43 TYPE (grid_config_rec_type) :: config_flags
44 # include <em_dummy_new_decl.inc>
45 END SUBROUTINE interp_domain_em_part1
46
47 SUBROUTINE force_domain_em_part2 ( grid, nested_grid, config_flags &
48 !
49 # include "em_dummy_new_args.inc"
50 !
51 )
52 USE module_domain
53 USE module_configure
54 TYPE(domain), POINTER :: grid ! name of the grid being dereferenced (must be "grid")
55 TYPE(domain), POINTER :: nested_grid
56 TYPE (grid_config_rec_type) :: config_flags
57 # include <em_dummy_new_decl.inc>
58 END SUBROUTINE force_domain_em_part2
59
60 ! ----------------------------------------------------------
61 ! This routine is supplied by dyn_em/couple_or_uncouple_em.F
62 ! ----------------------------------------------------------
63 SUBROUTINE couple_or_uncouple_em ( grid, config_flags , couple &
64 !
65 # include "em_dummy_new_args.inc"
66 !
67 )
68 USE module_domain
69 USE module_configure
70 TYPE(domain), INTENT(INOUT) :: grid
71 TYPE (grid_config_rec_type) :: config_flags
72 LOGICAL, INTENT( IN) :: couple
73 # include <em_dummy_new_decl.inc>
74 END SUBROUTINE couple_or_uncouple_em
75 #endif
76 #endif
77 ! ----------------------------------------------------------
78 ! Interface definitions for NMM (placeholder)
79 ! ----------------------------------------------------------
80 #if (NMM_CORE == 1 && NMM_NEST ==1)
81 !=======================================================================
82 ! Added for the NMM core. This is gopal's doing.
83 !=======================================================================
84
85 SUBROUTINE interp_domain_nmm_part1 ( grid, intermediate_grid, ngrid, config_flags &
86 !
87 # include "nmm_dummy_args.inc"
88 !
89 )
90 USE module_domain
91 USE module_configure
92 TYPE(domain), POINTER :: grid ! name of the grid being dereferenced (must be "grid")
93 TYPE(domain), POINTER :: intermediate_grid
94 TYPE(domain), POINTER :: ngrid
95 TYPE (grid_config_rec_type) :: config_flags
96 # include <nmm_dummy_decl.inc>
97 END SUBROUTINE interp_domain_nmm_part1
98
99 SUBROUTINE force_domain_nmm_part2 ( grid, nested_grid, config_flags &
100 !
101 # include "nmm_dummy_args.inc"
102 !
103 )
104 USE module_domain
105 USE module_configure
106 TYPE(domain), POINTER :: grid ! name of the grid being dereferenced (must be "grid")
107 TYPE(domain), POINTER :: nested_grid
108 TYPE (grid_config_rec_type) :: config_flags
109
110 # include <nmm_dummy_decl.inc>
111 END SUBROUTINE force_domain_nmm_part2
112 !=======================================================================
113 ! End of gopal's doing.
114 !=======================================================================
115 #endif
116 ! ----------------------------------------------------------
117 ! Interface definitions for COAMPS (placeholder)
118 ! ----------------------------------------------------------
119 #if (COAMPS_CORE == 1)
120 #endif
121 END INTERFACE
122 ! ----------------------------------------------------------
123 ! End of Interface blocks
124 ! ----------------------------------------------------------
125
126 ! ----------------------------------------------------------
127 ! ----------------------------------------------------------
128 ! Executable code
129 ! ----------------------------------------------------------
130 ! ----------------------------------------------------------
131 ! Forcing calls for EM CORE.
132 ! ----------------------------------------------------------
133 #if (EM_CORE == 1 && defined( DM_PARALLEL ))
134 #if !defined(MAC_KLUDGE)
135 CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
136 IF ( config_flags%dyn_opt == DYN_EM ) THEN
137
138 grid => nested_grid%intermediate_grid
139 #ifndef SGIALTIX
140 CALL alloc_space_field ( grid, grid%id , 1 , 2 , .TRUE. , &
141 grid%sd31, grid%ed31, grid%sd32, grid%ed32, grid%sd33, grid%ed33, &
142 grid%sm31, grid%em31, grid%sm32, grid%em32, grid%sm33, grid%em33, &
143 grid%sm31x, grid%em31x, grid%sm32x, grid%em32x, grid%sm33x, grid%em33x, & ! x-xpose
144 grid%sm31y, grid%em31y, grid%sm32y, grid%em32y, grid%sm33y, grid%em33y & ! y-xpose
145 )
146 #endif
147
148 ! couple parent domain
149 grid => parent_grid
150 ! swich config_flags to point to parent rconfig info
151 CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
152 CALL couple_or_uncouple_em ( grid , config_flags , .true. &
153 !
154 # include "em_actual_new_args.inc"
155 !
156 )
157 ! couple nested domain
158 grid => nested_grid
159 CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
160 CALL couple_or_uncouple_em ( grid , config_flags , .true. &
161 !
162 # include "em_actual_new_args.inc"
163 !
164 )
165 ! perform first part: transfer data from parent to intermediate domain
166 ! at the same resolution but on the same decomposition as the nest
167 ! note that this will involve communication on multiple DM procs
168 grid => parent_grid
169 CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
170 CALL interp_domain_em_part1 ( grid , nested_grid%intermediate_grid, nested_grid, config_flags &
171 !
172 # include "em_actual_new_args.inc"
173 !
174 )
175 grid => nested_grid%intermediate_grid
176 ! perform 2nd part: run interpolation on the intermediate domain
177 ! and compute the values for the nest boundaries
178 ! note that this is all local (no communication)
179 CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
180 CALL force_domain_em_part2 ( grid, nested_grid, config_flags &
181 !
182 # include "em_actual_new_args.inc"
183 !
184 )
185 ! uncouple the nest
186 grid => nested_grid
187 CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
188 CALL couple_or_uncouple_em ( grid , config_flags , .false. &
189 !
190 # include "em_actual_new_args.inc"
191 !
192 )
193 ! uncouple the parent
194 grid => parent_grid
195 CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
196 CALL couple_or_uncouple_em ( grid , config_flags , .false. &
197 !
198 # include "em_actual_new_args.inc"
199 !
200 )
201 IF ( nested_grid%first_force ) THEN
202 nested_grid%first_force = .FALSE.
203 ENDIF
204 nested_grid%dtbc = 0.
205 !
206 grid => nested_grid%intermediate_grid
207 #ifndef SGIALTIX
208 CALL dealloc_space_field ( grid )
209 #endif
210 ENDIF
211 #endif
212 #endif
213 ! ------------------------------------------------------
214 ! End of Forcing calls for EM CORE.
215 ! ------------------------------------------------------
216 ! ------------------------------------------------------
217 ! ------------------------------------------------------
218 ! Forcing calls for NMM. (Placeholder)
219 ! ------------------------------------------------------
220 # if (NMM_CORE == 1 && NMM_NEST == 1)
221 !=======================================================================
222 ! Added for the NMM core. This is gopal's doing.
223 !=======================================================================
224
225 CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
226 IF ( config_flags%dyn_opt == DYN_NMM ) THEN
227
228 grid => nested_grid%intermediate_grid
229 !dusan orig CALL alloc_space_field ( grid, grid%id , 1 , 2 , .TRUE. , &
230 #ifndef SGIALTIX
231 CALL alloc_space_field ( grid, grid%id , 1 , 3 , .FALSE. , &
232 grid%sd31, grid%ed31, grid%sd32, grid%ed32, grid%sd33, grid%ed33, &
233 grid%sm31, grid%em31, grid%sm32, grid%em32, grid%sm33, grid%em33, &
234 grid%sm31x, grid%em31x, grid%sm32x, grid%em32x, grid%sm33x, grid%em33x, & ! x-xpose
235 grid%sm31y, grid%em31y, grid%sm32y, grid%em32y, grid%sm33y, grid%em33y & ! y-xpose
236 )
237 #endif
238
239 ! couple parent domain
240 grid => parent_grid
241 ! swich config_flags to point to parent rconfig info
242 CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
243 # include "deref_kludge.h"
244
245 ! on restart do not force the nest the first time since it has already been forced
246 ! prior to the writing of the restart file
247 IF ( .NOT. ( config_flags%restart .AND. nested_grid%first_force ) ) THEN
248 ! couple nested domain
249 grid => nested_grid
250 CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
251 # include "deref_kludge.h"
252 ! perform first part: transfer data from parent to intermediate domain
253 ! at the same resolution but on the same decomposition as the nest
254 ! note that this will involve communication on multiple DM procs
255 grid => parent_grid
256 CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
257 # include "deref_kludge.h"
258 CALL interp_domain_nmm_part1 ( grid , nested_grid%intermediate_grid, nested_grid, config_flags &
259 !
260 # include "nmm_actual_args.inc"
261 !
262 )
263 ENDIF ! not restart and first force
264
265 grid => nested_grid%intermediate_grid
266 IF ( .NOT. ( config_flags%restart .AND. nested_grid%first_force ) ) THEN
267 ! perform 2nd part: run interpolation on the intermediate domain
268 ! and compute the values for the nest boundaries
269 ! note that this is all local (no communication)
270 CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
271 # include "deref_kludge.h"
272 CALL force_domain_nmm_part2 ( grid, nested_grid, config_flags &
273 !
274 # include "nmm_actual_args.inc"
275 !
276 )
277 ENDIF ! not restart and first_force
278
279 IF ( nested_grid%first_force ) THEN
280 nested_grid%first_force = .FALSE.
281 ENDIF
282 nested_grid%dtbc = 0.
283 !
284 grid => nested_grid%intermediate_grid
285 #ifndef SGIALTIX
286 CALL dealloc_space_field ( grid )
287 #endif
288 ENDIF
289 !=======================================================================
290 ! End of gopal's doing.
291 !=======================================================================
292 # endif
293 ! ------------------------------------------------------
294 ! End of Forcing calls for NMM.
295 ! ------------------------------------------------------
296 ! ------------------------------------------------------
297 ! ------------------------------------------------------
298 ! Forcing calls for COAMPS. (Placeholder)
299 ! ------------------------------------------------------
300 # if (COAMPS_CORE == 1)
301 # endif
302 ! ------------------------------------------------------
303 ! End of Forcing calls for COAMPS.
304 ! ------------------------------------------------------
305 RETURN
306 END SUBROUTINE med_force_domain
307
308