FV3-JEDI
med.F90
Go to the documentation of this file.
1 module med
2 
3  !-----------------------------------------------------------------------------
4  ! Mediator Component.
5  !-----------------------------------------------------------------------------
6 
7  use esmf
8  use nuopc
9  use nuopc_mediator, only: &
10  model_routine_ss => setservices, &
11  model_label_advance => label_advance
12 
13  implicit none
14 
15  private
16 
17  public setservices
18 
19  !-----------------------------------------------------------------------------
20  contains
21  !-----------------------------------------------------------------------------
22 
23  subroutine setservices(mediator, rc)
24  type(esmf_gridcomp) :: mediator
25  integer, intent(out) :: rc
26 
27  rc = esmf_success
28 
29  ! the NUOPC model component will register the generic methods
30  call nuopc_compderive(mediator, model_routine_ss, rc=rc)
31  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
32  line=__line__, &
33  file=__file__)) &
34  return ! bail out
35 
36  ! set entry point for methods that require specific implementation
37  call nuopc_compsetentrypoint(mediator, esmf_method_initialize, &
38  phaselabellist=(/"IPDv00p1"/), userroutine=initializep1, rc=rc)
39  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
40  line=__line__, &
41  file=__file__)) &
42  return ! bail out
43  call nuopc_compsetentrypoint(mediator, esmf_method_initialize, &
44  phaselabellist=(/"IPDv00p2"/), userroutine=initializep2, rc=rc)
45  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
46  line=__line__, &
47  file=__file__)) &
48  return ! bail out
49 
50  ! attach specializing method(s)
51  call nuopc_compspecialize(mediator, speclabel=model_label_advance, &
52  specroutine=mediatoradvance, rc=rc)
53  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
54  line=__line__, &
55  file=__file__)) &
56  return ! bail out
57 
58  end subroutine
59 
60  !-----------------------------------------------------------------------------
61 
62  subroutine initializep1(mediator, importState, exportState, clock, rc)
63  type(esmf_gridcomp) :: mediator
64  type(esmf_state) :: importState, exportState
65  type(esmf_clock) :: clock
66  integer, intent(out) :: rc
67 
68  rc = esmf_success
69 
70  ! importable field: sea_surface_temperature
71  call nuopc_advertise(importstate, &
72  standardname="sea_surface_temperature", name="sst", rc=rc)
73  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
74  line=__line__, &
75  file=__file__)) &
76  return ! bail out
77 
78  ! importable field: air_pressure_at_sea_level
79  call nuopc_advertise(importstate, &
80  standardname="air_pressure_at_sea_level", name="pmsl", rc=rc)
81  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
82  line=__line__, &
83  file=__file__)) &
84  return ! bail out
85 
86  ! importable field: surface_net_downward_shortwave_flux
87  call nuopc_advertise(importstate, &
88  standardname="surface_net_downward_shortwave_flux", name="rsns", rc=rc)
89  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
90  line=__line__, &
91  file=__file__)) &
92  return ! bail out
93 
94  ! exportable field: sea_surface_temperature
95  call nuopc_advertise(exportstate, &
96  standardname="sea_surface_temperature", name="sst", rc=rc)
97  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
98  line=__line__, &
99  file=__file__)) &
100  return ! bail out
101 
102  ! exportable field: air_pressure_at_sea_level
103  call nuopc_advertise(exportstate, &
104  standardname="air_pressure_at_sea_level", name="pmsl", rc=rc)
105  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
106  line=__line__, &
107  file=__file__)) &
108  return ! bail out
109 
110  ! exportable field: surface_net_downward_shortwave_flux
111  call nuopc_advertise(exportstate, &
112  standardname="surface_net_downward_shortwave_flux", name="rsns", rc=rc)
113  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
114  line=__line__, &
115  file=__file__)) &
116  return ! bail out
117 
118  end subroutine
119 
120  !-----------------------------------------------------------------------------
121 
122  subroutine initializep2(mediator, importState, exportState, clock, rc)
123  type(esmf_gridcomp) :: mediator
124  type(esmf_state) :: importState, exportState
125  type(esmf_clock) :: clock
126  integer, intent(out) :: rc
127 
128  ! local variables
129  type(esmf_field) :: field
130  type(esmf_grid) :: gridIn
131  type(esmf_grid) :: gridOut
132 
133  rc = esmf_success
134 
135  ! create a Grid object for Fields
136  gridin = esmf_gridcreatenoperidimufrm(maxindex=(/20, 100/), &
137  mincornercoord=(/10._esmf_kind_r8, 20._esmf_kind_r8/), &
138  maxcornercoord=(/100._esmf_kind_r8, 200._esmf_kind_r8/), &
139  coordsys=esmf_coordsys_cart, staggerloclist=(/esmf_staggerloc_center/), &
140  rc=rc)
141  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
142  line=__line__, &
143  file=__file__)) &
144  return ! bail out
145  gridout = gridin ! for now out same as in
146 
147  ! importable field: sea_surface_temperature
148  field = esmf_fieldcreate(name="sst", grid=gridin, &
149  typekind=esmf_typekind_r8, rc=rc)
150  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
151  line=__line__, &
152  file=__file__)) &
153  return ! bail out
154  call nuopc_realize(importstate, field=field, rc=rc)
155  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
156  line=__line__, &
157  file=__file__)) &
158  return ! bail out
159 
160  ! importable field: air_pressure_at_sea_level
161  field = esmf_fieldcreate(name="pmsl", grid=gridin, &
162  typekind=esmf_typekind_r8, rc=rc)
163  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
164  line=__line__, &
165  file=__file__)) &
166  return ! bail out
167  call nuopc_realize(importstate, field=field, rc=rc)
168  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
169  line=__line__, &
170  file=__file__)) &
171  return ! bail out
172 
173  ! importable field: surface_net_downward_shortwave_flux
174  field = esmf_fieldcreate(name="rsns", grid=gridin, &
175  typekind=esmf_typekind_r8, rc=rc)
176  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
177  line=__line__, &
178  file=__file__)) &
179  return ! bail out
180  call nuopc_realize(importstate, field=field, rc=rc)
181  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
182  line=__line__, &
183  file=__file__)) &
184  return ! bail out
185 
186  ! exportable field: sea_surface_temperature
187  field = esmf_fieldcreate(name="sst", grid=gridout, &
188  typekind=esmf_typekind_r8, rc=rc)
189  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
190  line=__line__, &
191  file=__file__)) &
192  return ! bail out
193  call nuopc_realize(exportstate, field=field, rc=rc)
194  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
195  line=__line__, &
196  file=__file__)) &
197  return ! bail out
198 
199  ! exportable field: air_pressure_at_sea_level
200  field = esmf_fieldcreate(name="pmsl", grid=gridout, &
201  typekind=esmf_typekind_r8, rc=rc)
202  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
203  line=__line__, &
204  file=__file__)) &
205  return ! bail out
206  call nuopc_realize(exportstate, field=field, rc=rc)
207  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
208  line=__line__, &
209  file=__file__)) &
210  return ! bail out
211 
212  ! exportable field: surface_net_downward_shortwave_flux
213  field = esmf_fieldcreate(name="rsns", grid=gridout, &
214  typekind=esmf_typekind_r8, rc=rc)
215  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
216  line=__line__, &
217  file=__file__)) &
218  return ! bail out
219  call nuopc_realize(exportstate, field=field, rc=rc)
220  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
221  line=__line__, &
222  file=__file__)) &
223  return ! bail out
224 
225  end subroutine
226 
227  !-----------------------------------------------------------------------------
228 
229  subroutine mediatoradvance(mediator, rc)
230  type(esmf_gridcomp) :: mediator
231  integer, intent(out) :: rc
232 
233  ! local variables
234  type(esmf_clock) :: clock
235  type(esmf_state) :: importState, exportState
236 
237  type (ESMF_Field) :: field
238  type(esmf_fieldstatus_flag) :: fieldStatus
239  real(8), pointer :: sst_im(:,:), pmsl_im(:,:)
240  real(8), pointer :: sst_ex(:,:), pmsl_ex(:,:)
241  integer :: LB(2), UB(2)
242 
243  logical, save :: first = .true.
244 
245  rc = esmf_success
246 
247  ! query the Component for its clock, importState and exportState
248  call esmf_gridcompget(mediator, clock=clock, importstate=importstate, &
249  exportstate=exportstate, rc=rc)
250  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
251  line=__line__, &
252  file=__file__)) &
253  return ! bail out
254 
255  ! HERE THE MEDIATOR does the mediation of Fields that come in on the
256  ! importState with a timestamp consistent to the currTime of the
257  ! mediators Clock.
258 
259  ! The Mediator uses the data on the import Fields to update the data
260  ! held by Fields in the exportState.
261 
262  ! After this routine returns the generic Mediator will correctly
263  ! timestamp the export Fields and update the Mediator Clock to:
264  !
265  ! currTime -> currTime + timeStep
266  !
267  ! Where the timeStep is equal to the parent timeStep.
268 
269  call esmf_clockprint(clock, options="currTime", &
270  prestring="-------->MED Advance() mediating for: ", rc=rc)
271  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
272  line=__line__, &
273  file=__file__)) &
274  return ! bail out
275 
276  call esmf_clockprint(clock, options="stopTime", &
277  prestring="----------------> model time step to: ", rc=rc)
278  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
279  line=__line__, &
280  file=__file__)) &
281  return ! bail out
282 
283  !sst_im
284  call esmf_stateget(importstate, "sst", field, rc=rc)
285  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
286  line=__line__, &
287  file=__file__)) &
288  return ! bail out
289  call esmf_fieldget(field, status=fieldstatus, rc=rc)
290  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
291  line=__line__, &
292  file=__file__)) &
293  return ! bail out
294  call esmf_fieldget(field, 0, sst_im, computationallbound=lb, computationalubound=ub, rc=rc)
295  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
296  line=__line__, &
297  file=__file__)) &
298  return ! bail out
299  !pmsl_im
300  call esmf_stateget(importstate, "pmsl", field, rc=rc)
301  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
302  line=__line__, &
303  file=__file__)) &
304  return ! bail out
305  call esmf_fieldget(field, status=fieldstatus, rc=rc)
306  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
307  line=__line__, &
308  file=__file__)) &
309  return ! bail out
310  call esmf_fieldget(field, 0, pmsl_im, computationallbound=lb, computationalubound=ub, rc=rc)
311  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
312  line=__line__, &
313  file=__file__)) &
314  return ! bail out
315 
316  !sst_ex
317  call esmf_stateget(exportstate, "sst", field, rc=rc)
318  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
319  line=__line__, &
320  file=__file__)) &
321  return ! bail out
322  call esmf_fieldget(field, status=fieldstatus, rc=rc)
323  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
324  line=__line__, &
325  file=__file__)) &
326  return ! bail out
327  call esmf_fieldget(field, 0, sst_ex, computationallbound=lb, computationalubound=ub, rc=rc)
328  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
329  line=__line__, &
330  file=__file__)) &
331  return ! bail out
332  !pmsl_ex
333  call esmf_stateget(exportstate, "pmsl", field, rc=rc)
334  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
335  line=__line__, &
336  file=__file__)) &
337  return ! bail out
338  call esmf_fieldget(field, status=fieldstatus, rc=rc)
339  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
340  line=__line__, &
341  file=__file__)) &
342  return ! bail out
343  call esmf_fieldget(field, 0, pmsl_ex, computationallbound=lb, computationalubound=ub, rc=rc)
344  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
345  line=__line__, &
346  file=__file__)) &
347  return ! bail out
348 
349  if (first) then
350  pmsl_im = 10.0
351  sst_im = 10.0
352  first = .false.
353  else
354  pmsl_im = pmsl_im + 0.1
355  sst_im = sst_im + 0.1
356  endif
357 
358  !Straight copy for now
359  sst_ex = sst_im
360  pmsl_ex = pmsl_im
361 
362  print*, "MED-DATA sst", sst_ex(lb(1),lb(2)), pmsl_ex(lb(1),lb(2))
363 
364  end subroutine
365 
366 end module
med::mediatoradvance
subroutine mediatoradvance(mediator, rc)
Definition: med.F90:230
med
Definition: med.F90:1
med::initializep2
subroutine initializep2(mediator, importState, exportState, clock, rc)
Definition: med.F90:123
med::setservices
subroutine, public setservices(mediator, rc)
Definition: med.F90:24
med::initializep1
subroutine initializep1(mediator, importState, exportState, clock, rc)
Definition: med.F90:63