source: trunk/WRF.COMMON/WRFV3/share/mediation_force_domain.F

Last change on this file was 2759, checked in by aslmd, 2 years ago

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