mediation_feedback_domain.F

References to this file elsewhere.
1 !
2 !WRF:MEDIATION_LAYER:NESTING
3 !
4 SUBROUTINE med_feedback_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 ! Interface blocks
21 ! ------------------------------------------------------
22    INTERFACE
23 ! ------------------------------------------------------
24 !    Interface definitions for EM CORE
25 ! ------------------------------------------------------
26 #if (EM_CORE == 1)
27 #if !defined(MAC_KLUDGE)
28 ! ------------------------------------------------------
29 !    These routines are supplied by module_dm.F from the
30 !    external communication package (e.g. external/RSL)
31 ! ------------------------------------------------------
32       SUBROUTINE feedback_domain_em_part1 ( grid, nested_grid, config_flags   &
33 !
34 #          include "em_dummy_new_args.inc"
35 !
36                                           )
37          USE module_domain
38          USE module_configure
39          TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
40          TYPE(domain), POINTER :: nested_grid
41          TYPE (grid_config_rec_type)            :: config_flags
42 #        include <em_dummy_new_decl.inc>
43       END SUBROUTINE feedback_domain_em_part1
44       SUBROUTINE feedback_domain_em_part2 ( grid, intermediate_grid , nested_grid, config_flags   &
45 !
46 #          include "em_dummy_new_args.inc"
47 !
48                                           )
49          USE module_domain
50          USE module_configure
51          TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
52          TYPE(domain), POINTER :: intermediate_grid
53          TYPE(domain), POINTER :: nested_grid
54          TYPE (grid_config_rec_type)            :: config_flags
55 #        include <em_dummy_new_decl.inc>
56       END SUBROUTINE feedback_domain_em_part2
57       SUBROUTINE update_after_feedback_em ( grid  &
58 !
59 #          include "em_dummy_new_args.inc"
60 !
61                                           )
62          USE module_domain
63          USE module_configure
64          TYPE(domain), TARGET :: grid          ! name of the grid being dereferenced (must be "grid")
65 #        include <em_dummy_new_decl.inc>
66       END SUBROUTINE update_after_feedback_em
67 #endif
68 #endif
69 ! ----------------------------------------------------------
70 !    Interface definitions for NMM (placeholder)
71 ! ----------------------------------------------------------
72 #if (NMM_CORE == 1 && NMM_NEST == 1)
73 ! ------------------------------------------------------
74 !    These routines are supplied by module_dm.F from the
75 !    external communication package (e.g. external/RSL)
76 !    This is gopal's extension for the NMM core
77 ! ------------------------------------------------------
78       SUBROUTINE feedback_domain_nmm_part1 ( grid, nested_grid, config_flags   &
79 !
80 #          include "nmm_dummy_args.inc"
81 !
82                                           )
83          USE module_domain
84          USE module_configure
85          TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
86          TYPE(domain), POINTER :: nested_grid
87          TYPE (grid_config_rec_type)            :: config_flags
88 #        include <nmm_dummy_decl.inc>
89       END SUBROUTINE feedback_domain_nmm_part1
90 !
91       SUBROUTINE feedback_domain_nmm_part2 ( grid, intermediate_grid , nested_grid, config_flags   &
92 !
93 #          include "nmm_dummy_args.inc"
94 !
95                                           )
96          USE module_domain
97          USE module_configure
98          TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
99          TYPE(domain), POINTER :: intermediate_grid
100          TYPE(domain), POINTER :: nested_grid
101          TYPE (grid_config_rec_type)            :: config_flags
102 #        include <nmm_dummy_decl.inc>
103 
104       END SUBROUTINE feedback_domain_nmm_part2
105 #endif
106 ! ----------------------------------------------------------
107 !    Interface definitions for COAMPS (placeholder)
108 ! ----------------------------------------------------------
109 #if (COAMPS_CORE == 1 )
110 #endif
111    END INTERFACE
112 ! ----------------------------------------------------------
113 ! End of Interface blocks
114 ! ----------------------------------------------------------
115 ! ----------------------------------------------------------
116 ! ----------------------------------------------------------
117 ! Executable code
118 ! ----------------------------------------------------------
119 ! ----------------------------------------------------------
120 !    Feedback calls for EM CORE.
121 ! ----------------------------------------------------------
122 #if (EM_CORE == 1 && defined( DM_PARALLEL ))
123 #if !defined(MAC_KLUDGE)
124    CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
125    IF ( config_flags%dyn_opt == DYN_EM ) THEN
126      parent_grid%ht_coarse = parent_grid%ht
127      grid => nested_grid%intermediate_grid
128 #ifndef SGIALTIX
129      CALL alloc_space_field ( grid, grid%id , 1 , 2 , .TRUE. ,     &
130                               grid%sd31, grid%ed31, grid%sd32, grid%ed32, grid%sd33, grid%ed33, &
131                               grid%sm31,  grid%em31,  grid%sm32,  grid%em32,  grid%sm33,  grid%em33, &
132                               grid%sm31x, grid%em31x, grid%sm32x, grid%em32x, grid%sm33x, grid%em33x, &   ! x-xpose
133                               grid%sm31y, grid%em31y, grid%sm32y, grid%em32y, grid%sm33y, grid%em33y  &   ! y-xpose
134        )
135 #endif
136      grid => nested_grid%intermediate_grid
137 #    include "deref_kludge.h"
138      CALL feedback_domain_em_part1 ( grid, nested_grid, config_flags   &
139 !
140 #      include "em_actual_new_args.inc"
141 !
142                                    )
143      grid => parent_grid
144 #    include "deref_kludge.h"
145 
146      grid%nest_mask = 0.
147      CALL feedback_domain_em_part2 ( grid , nested_grid%intermediate_grid, nested_grid , config_flags   &
148 !
149 #      include "em_actual_new_args.inc"
150 
151                                    )
152      WHERE   ( grid%nest_pos .NE. 9021000.  ) grid%ht = grid%ht_coarse
153      CALL update_after_feedback_em ( grid  &
154 !
155 #      include "em_actual_new_args.inc"
156 !
157                                    )
158      grid => nested_grid%intermediate_grid
159 #ifndef SGIALTIX
160      CALL dealloc_space_field ( grid )
161 #endif
162    ENDIF
163 #endif
164 #endif
165 ! ------------------------------------------------------
166 !    End of Feedback calls for EM CORE.
167 ! ------------------------------------------------------
168 ! ------------------------------------------------------
169 ! ------------------------------------------------------
170 !    Feedback calls for NMM. (Placeholder)
171 ! ------------------------------------------------------
172 #if (NMM_CORE == 1 && NMM_NEST == 1)
173 ! ------------------------------------------------------
174 !    This is gopal's extension for the NMM core
175 ! ------------------------------------------------------
176 
177    CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
178    IF ( config_flags%dyn_opt == DYN_NMM ) THEN
179 
180      grid => nested_grid%intermediate_grid
181 !dusan orig     CALL alloc_space_field ( grid, grid%id , 1 , 2 , .TRUE. ,     &
182 #ifndef SGIALTIX
183      CALL alloc_space_field ( grid, grid%id , 1 , 3 , .FALSE. ,     &
184                               grid%sd31, grid%ed31, grid%sd32, grid%ed32, grid%sd33, grid%ed33, &
185                               grid%sm31,  grid%em31,  grid%sm32,  grid%em32,  grid%sm33,  grid%em33, &
186                               grid%sm31x, grid%em31x, grid%sm32x, grid%em32x, grid%sm33x, grid%em33x, &   ! x-xpose
187                               grid%sm31y, grid%em31y, grid%sm32y, grid%em32y, grid%sm33y, grid%em33y  &   ! y-xpose
188        )
189 #endif
190 
191      grid => nested_grid%intermediate_grid
192 #    include "deref_kludge.h"
193      CALL feedback_domain_nmm_part1 ( grid, nested_grid, config_flags    &
194 !
195 #      include "nmm_actual_args.inc"
196 !
197                                    )
198      grid => parent_grid
199 #    include "deref_kludge.h"
200 
201 !
202      CALL feedback_domain_nmm_part2 ( grid , nested_grid%intermediate_grid, nested_grid , config_flags    &
203 !
204 #      include "nmm_actual_args.inc"
205 !
206                                    )
207      grid => nested_grid%intermediate_grid
208 #ifndef SGIALTIX
209      CALL dealloc_space_field ( grid )
210 #endif
211    ENDIF
212 #endif
213 ! ------------------------------------------------------
214 !    End of Feedback calls for NMM.
215 ! ------------------------------------------------------
216 ! ------------------------------------------------------
217 ! ------------------------------------------------------
218 !    Feedback calls for COAMPS. (Placeholder)
219 ! ------------------------------------------------------
220 #if (COAMPS_CORE == 1)
221 #endif
222 ! ------------------------------------------------------
223 !    End of Feedback calls for COAMPS.
224 ! ------------------------------------------------------
225    RETURN
226 END SUBROUTINE med_feedback_domain
227 
228