source: lmdz_wrf/trunk/WRFV3/share/mediation_force_domain.F @ 1422

Last change on this file since 1422 was 1, checked in by lfita, 10 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 12.8 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_new_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_new_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_new_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_new_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%sp31,  grid%ep31,  grid%sp32,  grid%ep32,  grid%sp33,  grid%ep33, &
139                            grid%sp31x, grid%ep31x, grid%sp32x, grid%ep32x, grid%sp33x, grid%ep33x,&
140                            grid%sp31y, grid%ep31y, grid%sp32y, grid%ep32y, grid%sp33y, grid%ep33y,&
141                            grid%sm31x, grid%em31x, grid%sm32x, grid%em32x, grid%sm33x, grid%em33x, &   ! x-xpose
142                            grid%sm31y, grid%em31y, grid%sm32y, grid%em32y, grid%sm33y, grid%em33y  &   ! y-xpose
143     )
144#  endif
145
146   ! couple parent domain
147   grid => parent_grid
148   ! swich config_flags to point to parent rconfig info
149   CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
150   CALL couple_or_uncouple_em ( grid , config_flags ,  .true. &
151!
152#         include "actual_new_args.inc"
153!
154                                )
155   ! couple nested domain
156   grid => nested_grid
157   CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
158   CALL couple_or_uncouple_em ( grid , config_flags ,  .true. &
159!
160#         include "actual_new_args.inc"
161!
162                                   )
163   ! perform first part: transfer data from parent to intermediate domain
164   ! at the same resolution but on the same decomposition as the nest
165   ! note that this will involve communication on multiple DM procs
166   grid => parent_grid
167   CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
168   !
169   ! Added following line to handle adaptive time step.  This should probably
170   !   go somewhere else, but I'm not sure where.
171   !   
172   ! T. Hutchinson, WSI  1/23/07
173   !
174   nested_grid%intermediate_grid%dt = grid%dt
175
176   CALL interp_domain_em_part1 ( grid , nested_grid%intermediate_grid, nested_grid, config_flags  &
177!
178#         include "actual_new_args.inc"
179!
180                                    )
181   grid => nested_grid%intermediate_grid
182      ! perform 2nd part: run interpolation on the intermediate domain
183      ! and compute the values for the nest boundaries
184      ! note that this is all local (no communication)
185   CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
186   CALL force_domain_em_part2 ( grid, nested_grid, config_flags   &
187!
188#          include "actual_new_args.inc"
189!
190                                   )
191   ! uncouple the nest
192   grid => nested_grid
193   CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
194   CALL couple_or_uncouple_em ( grid , config_flags ,  .false.  &
195!
196#          include "actual_new_args.inc"
197!
198                                   )
199   ! uncouple the parent
200   grid => parent_grid
201   CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
202   CALL couple_or_uncouple_em ( grid , config_flags ,  .false.  &
203!
204#          include "actual_new_args.inc"
205!
206                                )
207   IF ( nested_grid%first_force ) THEN
208      nested_grid%first_force = .FALSE.
209   ENDIF
210   nested_grid%dtbc = 0.
211!
212   grid => nested_grid%intermediate_grid
213#  if defined(MOVE_NESTS) || (!defined(SGIALTIX))
214   CALL dealloc_space_field ( grid )
215#  endif
216# endif
217#endif
218! ------------------------------------------------------
219!    End of Forcing calls for EM CORE.
220! ------------------------------------------------------
221! ------------------------------------------------------
222! ------------------------------------------------------
223!    Forcing calls for NMM. (Placeholder)
224! ------------------------------------------------------
225# if (NMM_CORE == 1 && NMM_NEST == 1)
226!=======================================================================
227!  Added for the NMM core. This is gopal's doing.
228!=======================================================================
229
230   CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
231
232   grid => nested_grid%intermediate_grid
233!dusan orig    CALL alloc_space_field ( grid, grid%id , 1 , 2 ,  .TRUE. ,    &
234#if defined(MOVE_NESTS) || (!defined(SGIALTIX))
235#   if defined(HWRF)
236   CALL ensure_space_field &
237#   else
238   CALL alloc_space_field &
239#   endif
240                          ( grid, grid%id , 1 , 3 ,  .FALSE. ,    &
241                            grid%sd31, grid%ed31, grid%sd32, grid%ed32, grid%sd33, grid%ed33, &
242                            grid%sm31,  grid%em31,  grid%sm32,  grid%em32,  grid%sm33,  grid%em33, &
243                            grid%sp31,  grid%ep31,  grid%sp32,  grid%ep32,  grid%sp33,  grid%ep33, &
244                            grid%sp31x, grid%ep31x, grid%sp32x, grid%ep32x, grid%sp33x, grid%ep33x,&
245                            grid%sp31y, grid%ep31y, grid%sp32y, grid%ep32y, grid%sp33y, grid%ep33y,&
246                            grid%sm31x, grid%em31x, grid%sm32x, grid%em32x, grid%sm33x, grid%em33x, &   ! x-xpose
247                            grid%sm31y, grid%em31y, grid%sm32y, grid%em32y, grid%sm33y, grid%em33y  &   ! y-xpose
248      )
249#endif
250
251    ! couple parent domain
252    grid => parent_grid
253    ! swich config_flags to point to parent rconfig info
254    CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
255
256    ! on restart do not force the nest the first time since it has already been forced
257    ! prior to the writing of the restart file
258    IF ( .NOT. ( config_flags%restart .AND. nested_grid%first_force ) ) THEN
259       ! couple nested domain
260       grid => nested_grid
261       CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
262       ! perform first part: transfer data from parent to intermediate domain
263       ! at the same resolution but on the same decomposition as the nest
264       ! note that this will involve communication on multiple DM procs
265       grid => parent_grid
266       CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
267       CALL interp_domain_nmm_part1 ( grid , nested_grid%intermediate_grid, nested_grid, config_flags    &
268!
269#         include "actual_new_args.inc"
270!
271                                     )
272    ENDIF ! not restart and first force
273
274    grid => nested_grid%intermediate_grid
275    IF ( .NOT. ( config_flags%restart .AND. nested_grid%first_force ) ) THEN
276       ! perform 2nd part: run interpolation on the intermediate domain
277       ! and compute the values for the nest boundaries
278       ! note that this is all local (no communication)
279       CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
280       CALL force_domain_nmm_part2 ( grid, nested_grid, config_flags    &
281!
282#         include "actual_new_args.inc"
283!
284                                    )
285    ENDIF ! not restart and first_force
286
287    IF ( nested_grid%first_force ) THEN
288       nested_grid%first_force = .FALSE.
289    ENDIF
290    nested_grid%dtbc = 0.
291!
292    grid => nested_grid%intermediate_grid
293#if defined(MOVE_NESTS) || (!defined(SGIALTIX))
294#if !defined(HWRF)
295    CALL dealloc_space_field ( grid )
296#endif
297#endif
298!=======================================================================
299!  End of gopal's doing.
300!=======================================================================
301# endif
302! ------------------------------------------------------
303!    End of Forcing calls for NMM.
304! ------------------------------------------------------
305! ------------------------------------------------------
306! ------------------------------------------------------
307!    Forcing calls for COAMPS. (Placeholder)
308! ------------------------------------------------------
309# if (COAMPS_CORE == 1)
310# endif
311! ------------------------------------------------------
312!    End of Forcing calls for COAMPS.
313! ------------------------------------------------------
314   RETURN
315END SUBROUTINE med_force_domain
316
317
Note: See TracBrowser for help on using the repository browser.