FV3-JEDI
ocn.F90
Go to the documentation of this file.
1 module ocn
2 
3  !-----------------------------------------------------------------------------
4  ! OCN Component.
5  !-----------------------------------------------------------------------------
6 
7  use esmf
8  use nuopc
9  use nuopc_model, &
10  model_routine_ss => setservices, &
11  model_label_setclock => label_setclock, &
12  model_label_advance => label_advance
13 
14  implicit none
15 
16  private
17 
18  public setservices
19 
20  !-----------------------------------------------------------------------------
21  contains
22  !-----------------------------------------------------------------------------
23 
24  subroutine setservices(model, rc)
25  type(esmf_gridcomp) :: model
26  integer, intent(out) :: rc
27 
28  rc = esmf_success
29 
30  ! the NUOPC model component will register the generic methods
31  call nuopc_compderive(model, model_routine_ss, rc=rc)
32  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
33  line=__line__, &
34  file=__file__)) &
35  return ! bail out
36 
37  ! set entry point for methods that require specific implementation
38  call nuopc_compsetentrypoint(model, esmf_method_initialize, &
39  phaselabellist=(/"IPDv00p1"/), userroutine=initializep1, rc=rc)
40  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
41  line=__line__, &
42  file=__file__)) &
43  return ! bail out
44  call nuopc_compsetentrypoint(model, esmf_method_initialize, &
45  phaselabellist=(/"IPDv00p2"/), userroutine=initializep2, rc=rc)
46  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
47  line=__line__, &
48  file=__file__)) &
49  return ! bail out
50 
51  ! attach specializing method(s)
52  call nuopc_compspecialize(model, speclabel=model_label_setclock, &
53  specroutine=setclock, rc=rc)
54  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
55  line=__line__, &
56  file=__file__)) &
57  return ! bail out
58  call nuopc_compspecialize(model, speclabel=model_label_advance, &
59  specroutine=modeladvance, rc=rc)
60  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
61  line=__line__, &
62  file=__file__)) &
63  return ! bail out
64 
65  end subroutine
66 
67  !-----------------------------------------------------------------------------
68 
69  subroutine initializep1(model, importState, exportState, clock, rc)
70  type(esmf_gridcomp) :: model
71  type(esmf_state) :: importState, exportState
72  type(esmf_clock) :: clock
73  integer, intent(out) :: rc
74 
75  rc = esmf_success
76 
77  ! importable field: air_pressure_at_sea_level
78  call nuopc_advertise(importstate, &
79  standardname="air_pressure_at_sea_level", name="pmsl", rc=rc)
80  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
81  line=__line__, &
82  file=__file__)) &
83  return ! bail out
84 
85  ! importable field: surface_net_downward_shortwave_flux
86  call nuopc_advertise(importstate, &
87  standardname="surface_net_downward_shortwave_flux", name="rsns", rc=rc)
88  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
89  line=__line__, &
90  file=__file__)) &
91  return ! bail out
92 
93  ! exportable field: sea_surface_temperature
94  call nuopc_advertise(exportstate, &
95  standardname="sea_surface_temperature", name="sst", rc=rc)
96  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
97  line=__line__, &
98  file=__file__)) &
99  return ! bail out
100 
101  end subroutine
102 
103  !-----------------------------------------------------------------------------
104 
105  subroutine initializep2(model, importState, exportState, clock, rc)
106  type(esmf_gridcomp) :: model
107  type(esmf_state) :: importState, exportState
108  type(esmf_clock) :: clock
109  integer, intent(out) :: rc
110 
111  ! local variables
112  type(esmf_timeinterval) :: stabilityTimeStep
113  type(esmf_field) :: field
114  type(esmf_grid) :: gridIn
115  type(esmf_grid) :: gridOut
116 
117  rc = esmf_success
118 
119  ! create a Grid object for Fields
120  gridin = esmf_gridcreatenoperidimufrm(maxindex=(/20, 100/), &
121  mincornercoord=(/10._esmf_kind_r8, 20._esmf_kind_r8/), &
122  maxcornercoord=(/100._esmf_kind_r8, 200._esmf_kind_r8/), &
123  coordsys=esmf_coordsys_cart, staggerloclist=(/esmf_staggerloc_center/), &
124  rc=rc)
125  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
126  line=__line__, &
127  file=__file__)) &
128  return ! bail out
129  gridout = gridin ! for now out same as in
130 
131  ! importable field: air_pressure_at_sea_level
132  field = esmf_fieldcreate(name="pmsl", grid=gridin, &
133  typekind=esmf_typekind_r8, rc=rc)
134  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
135  line=__line__, &
136  file=__file__)) &
137  return ! bail out
138  call nuopc_realize(importstate, field=field, rc=rc)
139  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
140  line=__line__, &
141  file=__file__)) &
142  return ! bail out
143 
144  ! importable field: surface_net_downward_shortwave_flux
145  field = esmf_fieldcreate(name="rsns", grid=gridin, &
146  typekind=esmf_typekind_r8, rc=rc)
147  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
148  line=__line__, &
149  file=__file__)) &
150  return ! bail out
151  call nuopc_realize(importstate, field=field, rc=rc)
152  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
153  line=__line__, &
154  file=__file__)) &
155  return ! bail out
156 
157  ! exportable field: sea_surface_temperature
158  field = esmf_fieldcreate(name="sst", grid=gridout, &
159  typekind=esmf_typekind_r8, rc=rc)
160  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
161  line=__line__, &
162  file=__file__)) &
163  return ! bail out
164  call nuopc_realize(exportstate, field=field, rc=rc)
165  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
166  line=__line__, &
167  file=__file__)) &
168  return ! bail out
169 
170  end subroutine
171 
172  !-----------------------------------------------------------------------------
173 
174  subroutine setclock(model, rc)
175  type(esmf_gridcomp) :: model
176  integer, intent(out) :: rc
177 
178  ! local variables
179  type(esmf_clock) :: clock
180  type(esmf_timeinterval) :: stabilityTimeStep
181 
182  rc = esmf_success
183 
184  ! query the Component for its clock, importState and exportState
185  call nuopc_modelget(model, modelclock=clock, rc=rc)
186  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
187  line=__line__, &
188  file=__file__)) &
189  return ! bail out
190 
191  ! initialize internal clock
192  ! here: parent Clock and stability timeStep determine actual model timeStep
193  !TODO: stabilityTimeStep should be read in from configuation
194  !TODO: or computed from internal Grid information
195  call esmf_timeintervalset(stabilitytimestep, m=15, rc=rc) ! 5 minute steps
196  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
197  line=__line__, &
198  file=__file__)) &
199  return ! bail out
200  call nuopc_compsetclock(model, clock, stabilitytimestep, rc=rc)
201  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
202  line=__line__, &
203  file=__file__)) &
204  return ! bail out
205 
206  end subroutine
207 
208  !-----------------------------------------------------------------------------
209 
210  subroutine modeladvance(model, rc)
211  type(esmf_gridcomp) :: model
212  integer, intent(out) :: rc
213 
214  ! local variables
215  type(esmf_clock) :: clock
216  type(esmf_state) :: importState, exportState
217  type(esmf_time) :: currTime
218  type(esmf_timeinterval) :: timeStep
219 
220  type (ESMF_Field) :: field
221  type(esmf_fieldstatus_flag) :: fieldStatus
222  real(8), pointer :: sst(:,:)
223  real(8), pointer :: pmsl(:,:)
224 
225  integer, save :: init = 0
226  integer :: LB(2), UB(2)
227 
228  rc = esmf_success
229 
230  ! query the Component for its clock, importState and exportState
231  call nuopc_modelget(model, modelclock=clock, importstate=importstate, &
232  exportstate=exportstate, rc=rc)
233  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
234  line=__line__, &
235  file=__file__)) &
236  return ! bail out
237 
238  ! HERE THE MODEL ADVANCES: currTime -> currTime + timeStep
239 
240  ! Because of the way that the internal Clock was set in SetClock(),
241  ! its timeStep is likely smaller than the parent timeStep. As a consequence
242  ! the time interval covered by a single parent timeStep will result in
243  ! multiple calls to the ModelAdvance() routine. Every time the currTime
244  ! will come in by one internal timeStep advanced. This goes until the
245  ! stopTime of the internal Clock has been reached.
246 
247  call esmf_clockprint(clock, options="currTime", &
248  prestring="------>Advancing OCN from: ", rc=rc)
249  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
250  line=__line__, &
251  file=__file__)) &
252  return ! bail out
253 
254  call esmf_clockget(clock, currtime=currtime, timestep=timestep, rc=rc)
255  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
256  line=__line__, &
257  file=__file__)) &
258  return ! bail out
259 
260  call esmf_timeprint(currtime + timestep, &
261  prestring="--------------------------------> to: ", rc=rc)
262  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
263  line=__line__, &
264  file=__file__)) &
265  return ! bail out
266 
267  !Psuedo operations on sst for testing purposes
268  !---------------------------------------------
269 
270  !pmsl
271  call esmf_stateget(importstate, "pmsl", field, rc=rc)
272  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
273  line=__line__, &
274  file=__file__)) &
275  return ! bail out
276  call esmf_fieldget(field, status=fieldstatus, rc=rc)
277  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
278  line=__line__, &
279  file=__file__)) &
280  return ! bail out
281  call esmf_fieldget(field, 0, pmsl, computationallbound=lb, computationalubound=ub, rc=rc)
282  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
283  line=__line__, &
284  file=__file__)) &
285  return ! bail out
286 
287  !sst
288  call esmf_stateget(exportstate, "sst", field, rc=rc)
289  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
290  line=__line__, &
291  file=__file__)) &
292  return ! bail out
293  call esmf_fieldget(field, status=fieldstatus, rc=rc)
294  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
295  line=__line__, &
296  file=__file__)) &
297  return ! bail out
298  call esmf_fieldget(field, 0, sst, computationallbound=lb, computationalubound=ub, rc=rc)
299  if (esmf_logfounderror(rctocheck=rc, msg=esmf_logerr_passthru, &
300  line=__line__, &
301  file=__file__)) &
302  return ! bail out
303 
304  sst = pmsl
305 
306  print*, "OCN-DATA sst", sst(lb(1),lb(2)), pmsl(lb(1),lb(2))
307 
308  nullify(sst,pmsl)
309 
310  end subroutine
311 
312 end module
ocn::initializep1
subroutine initializep1(model, importState, exportState, clock, rc)
Definition: ocn.F90:70
model
Definition: model.py:1
ocn::initializep2
subroutine initializep2(model, importState, exportState, clock, rc)
Definition: ocn.F90:106
ocn
Definition: ocn.F90:1
ocn::setclock
subroutine setclock(model, rc)
Definition: ocn.F90:175
ocn::setservices
subroutine, public setservices(model, rc)
Definition: ocn.F90:25
ocn::modeladvance
subroutine modeladvance(model, rc)
Definition: ocn.F90:211