source: trunk/WRF.COMMON/WRFV2/share/mediation_force_domain.F @ 3547

Last change on this file since 3547 was 11, checked in by aslmd, 14 years ago

spiga@svn-planeto:ajoute le modele meso-echelle martien
File size: 12.3 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!  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    CALL alloc_space_field ( grid, grid%id , 1 , 2 ,  .TRUE. ,    &
140                             grid%sd31, grid%ed31, grid%sd32, grid%ed32, grid%sd33, grid%ed33, &
141                             grid%sm31,  grid%em31,  grid%sm32,  grid%em32,  grid%sm33,  grid%em33, &
142                             grid%sm31x, grid%em31x, grid%sm32x, grid%em32x, grid%sm33x, grid%em33x, &   ! x-xpose
143                             grid%sm31y, grid%em31y, grid%sm32y, grid%em32y, grid%sm33y, grid%em33y  &   ! y-xpose
144      )
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 "em_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 "em_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     CALL interp_domain_em_part1 ( grid , nested_grid%intermediate_grid, nested_grid, config_flags   &
169!
170#         include "em_actual_new_args.inc"
171!
172                                    )
173     grid => nested_grid%intermediate_grid
174        ! perform 2nd part: run interpolation on the intermediate domain
175        ! and compute the values for the nest boundaries
176        ! note that this is all local (no communication)
177     CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
178     CALL force_domain_em_part2 ( grid, nested_grid, config_flags   &
179!
180#          include "em_actual_new_args.inc"
181!
182                                   )
183     ! uncouple the nest
184     grid => nested_grid
185     CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
186     CALL couple_or_uncouple_em ( grid , config_flags ,  .false.  &
187!
188#          include "em_actual_new_args.inc"
189!
190                                   )
191     ! uncouple the parent
192     grid => parent_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 "em_actual_new_args.inc"
197!
198                                )
199     IF ( nested_grid%first_force ) THEN
200        nested_grid%first_force = .FALSE.
201     ENDIF
202     nested_grid%dtbc = 0.
203!
204     grid => nested_grid%intermediate_grid
205     CALL dealloc_space_field ( grid )
206   ENDIF
207#endif
208#endif
209! ------------------------------------------------------
210!    End of Forcing calls for EM CORE.
211! ------------------------------------------------------
212! ------------------------------------------------------
213! ------------------------------------------------------
214!    Forcing calls for NMM. (Placeholder)
215! ------------------------------------------------------
216# if (NMM_CORE == 1 && NMM_NEST == 1)
217!=======================================================================
218!  Added for the NMM core. This is gopal's doing.
219!=======================================================================
220
221   CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
222   IF ( config_flags%dyn_opt == DYN_NMM ) THEN
223
224    grid => nested_grid%intermediate_grid
225!dusan orig    CALL alloc_space_field ( grid, grid%id , 1 , 2 ,  .TRUE. ,    &
226    CALL alloc_space_field ( grid, grid%id , 1 , 3 ,  .FALSE. ,    &
227                             grid%sd31, grid%ed31, grid%sd32, grid%ed32, grid%sd33, grid%ed33, &
228                             grid%sm31,  grid%em31,  grid%sm32,  grid%em32,  grid%sm33,  grid%em33, &
229                             grid%sm31x, grid%em31x, grid%sm32x, grid%em32x, grid%sm33x, grid%em33x, &   ! x-xpose
230                             grid%sm31y, grid%em31y, grid%sm32y, grid%em32y, grid%sm33y, grid%em33y  &   ! y-xpose
231      )
232
233     ! couple parent domain
234     grid => parent_grid
235     ! swich config_flags to point to parent rconfig info
236     CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
237#    include "deref_kludge.h"
238
239     ! on restart do not force the nest the first time since it has already been forced
240     ! prior to the writing of the restart file
241     IF ( .NOT. ( config_flags%restart .AND. nested_grid%first_force ) ) THEN
242        ! couple nested domain
243        grid => nested_grid
244        CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
245#       include "deref_kludge.h"
246        ! perform first part: transfer data from parent to intermediate domain
247        ! at the same resolution but on the same decomposition as the nest
248        ! note that this will involve communication on multiple DM procs
249        grid => parent_grid
250        CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
251#       include "deref_kludge.h"
252        CALL interp_domain_nmm_part1 ( grid , nested_grid%intermediate_grid, nested_grid, config_flags    &
253!
254#         include "nmm_actual_args.inc"
255!
256                                     )
257     ENDIF ! not restart and first force
258
259     grid => nested_grid%intermediate_grid
260     IF ( .NOT. ( config_flags%restart .AND. nested_grid%first_force ) ) THEN
261        ! perform 2nd part: run interpolation on the intermediate domain
262        ! and compute the values for the nest boundaries
263        ! note that this is all local (no communication)
264        CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
265#       include "deref_kludge.h"
266        CALL force_domain_nmm_part2 ( grid, nested_grid, config_flags    &
267!
268#         include "nmm_actual_args.inc"
269!
270                                    )
271     ENDIF ! not restart and first_force
272
273     IF ( nested_grid%first_force ) THEN
274        nested_grid%first_force = .FALSE.
275     ENDIF
276     nested_grid%dtbc = 0.
277!
278     grid => nested_grid%intermediate_grid
279     CALL dealloc_space_field ( grid )
280   ENDIF
281!=======================================================================
282!  End of gopal's doing.
283!=======================================================================
284# endif
285! ------------------------------------------------------
286!    End of Forcing calls for NMM.
287! ------------------------------------------------------
288! ------------------------------------------------------
289! ------------------------------------------------------
290!    Forcing calls for COAMPS. (Placeholder)
291! ------------------------------------------------------
292# if (COAMPS_CORE == 1)
293# endif
294! ------------------------------------------------------
295!    End of Forcing calls for COAMPS.
296! ------------------------------------------------------
297   RETURN
298END SUBROUTINE med_force_domain
299
300
Note: See TracBrowser for help on using the repository browser.