-
Notifications
You must be signed in to change notification settings - Fork 1
/
conn.F90
319 lines (285 loc) · 11.5 KB
/
conn.F90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
!==============================================================================
! Earth System Modeling Framework
! Copyright 2002-2018, University Corporation for Atmospheric Research,
! Massachusetts Institute of Technology, Geophysical Fluid Dynamics
! Laboratory, University of Michigan, National Centers for Environmental
! Prediction, Los Alamos National Laboratory, Argonne National Laboratory,
! NASA Goddard Space Flight Center.
! Licensed under the University of Illinois-NCSA License.
!==============================================================================
module CON
!-----------------------------------------------------------------------------
! Connector Component.
!-----------------------------------------------------------------------------
! Enabling the followng macro, i.e. setting it to WITHSTATEUSE_on,
! will activate sections of code that demonstrate how
! the "state" member inside the NUOPC_Connector is used. The
! example creates an FieldBundle that's a duplicate of dstFields inside the
! connector, and precomputes two RouteHandles. The first is a Regrid, while
! the second is simply an identity operation using FieldRedist() to show the
! principle.
#define WITHSTATEUSE_on
use ESMF
use NUOPC
use NUOPC_Connector, only: &
con_routine_SS => SetServices, &
#ifdef WITHSTATEUSE_on
con_label_ExecuteRH => label_ExecuteRouteHandle, &
con_label_ReleaseRH => label_ReleaseRouteHandle, &
#endif
con_label_ComputeRH => label_ComputeRouteHandle, &
NUOPC_ConnectorGet, NUOPC_ConnectorSet
implicit none
private
public SetServices
!-----------------------------------------------------------------------------
contains
!-----------------------------------------------------------------------------
subroutine SetServices(connector, rc)
type(ESMF_CplComp) :: connector
integer, intent(out) :: rc
rc = ESMF_SUCCESS
! the NUOPC connector component will register the generic methods
call NUOPC_CompDerive(connector, con_routine_SS, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
! attach specializing method to compute the connection RouteHandle
call NUOPC_CompSpecialize(connector, specLabel=con_label_ComputeRH, &
specRoutine=ComputeRH, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
#ifdef WITHSTATEUSE_on
call NUOPC_CompSpecialize(connector, specLabel=con_label_ExecuteRH, &
specRoutine=ExecuteRH, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
call NUOPC_CompSpecialize(connector, specLabel=con_label_ReleaseRH, &
specRoutine=ReleaseRH, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
#endif
end subroutine
!-----------------------------------------------------------------------------
subroutine ComputeRH(connector, rc)
type(ESMF_CplComp) :: connector
integer, intent(out) :: rc
! local variables
integer :: localrc
type(ESMF_State) :: state
type(ESMF_FieldBundle) :: dstFields, srcFields
#ifdef WITHSTATEUSE_on
type(ESMF_FieldBundle) :: interDstFields
type(ESMF_Field), allocatable :: fields(:)
integer :: fieldCount, i
type(ESMF_Grid) :: Grid
type(ESMF_TypeKind_Flag) :: typekind
type(ESMF_Field) :: field
type(ESMF_RouteHandle) :: rh1, rh2
#else
type(ESMF_RouteHandle) :: rh
#endif
rc = ESMF_SUCCESS
call NUOPC_ConnectorGet(connector, srcFields=srcFields, &
dstFields=dstFields, state=state, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
#ifdef WITHSTATEUSE_on
! replicate dstFields FieldBundle in order to provide intermediate Fields
call ESMF_FieldBundleGet(dstFields, fieldCount=fieldCount, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
allocate(fields(fieldCount))
call ESMF_FieldBundleGet(dstFields, fieldList=fields, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
interDstFields = ESMF_FieldBundleCreate(name="interDstFields", rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
do i=1, fieldCount
call ESMF_FieldGet(fields(i), grid=grid, typekind=typekind, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
field = ESMF_FieldCreate(grid, typekind, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
call ESMF_FieldBundleAdd(interDstFields, (/field/), rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
enddo
! add interDstFields to the state member
call ESMF_StateAdd(state, (/interDstFields/), rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
! compute the first RouteHandle for srcFields->interDstFields (Regrid)
! TAR NEAREST FIELD point used in remapping
call ESMF_FieldBundleRegridStore(srcFields, interDstFields, &
regridmethod=ESMF_REGRIDMETHOD_NEAREST_STOD, &
unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, routehandle=rh1, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
call ESMF_RouteHandleSet(rh1, name="src2interDstRH", rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
! compute the second RouteHandle for interDstFields->dstFields (Redist)
call ESMF_FieldBundleRedistStore(interDstFields, dstFields, &
routehandle=rh2, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
call ESMF_RouteHandleSet(rh2, name="interDst2dstRH", rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
! add rh1, rh2 to the state member
call ESMF_StateAdd(state, (/rh1, rh2/), rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
#else
! specialize with Redist, instead of the default Regrid
call ESMF_FieldBundleRedistStore(srcFields, dstFields, &
routehandle=rh, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
call NUOPC_ConnectorSet(connector, rh=rh, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
#endif
end subroutine
!-----------------------------------------------------------------------------
#ifdef WITHSTATEUSE_on
subroutine ExecuteRH(connector, rc)
type(ESMF_CplComp) :: connector
integer, intent(out) :: rc
! local variables
integer :: localrc
type(ESMF_FieldBundle) :: interDstFields
type(ESMF_RouteHandle) :: rh1, rh2
type(ESMF_State) :: state
type(ESMF_FieldBundle) :: dstFields, srcFields
rc = ESMF_SUCCESS
call NUOPC_ConnectorGet(connector, srcFields=srcFields, &
dstFields=dstFields, state=state, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
! retrieve interDstFields FieldBundle from state member
call ESMF_StateGet(state, "interDstFields", interDstFields, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
! retrieve rh1 from state member
call ESMF_StateGet(state, "src2interDstRH", rh1, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
! retrieve rh2 from state member
call ESMF_StateGet(state, "interDst2dstRH", rh2, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
! apply rh1
call ESMF_FieldBundleRegrid(srcFields, interDstFields, &
routehandle=rh1, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
! apply rh2
call ESMF_FieldBundleRedist(interDstFields, dstFields, &
routehandle=rh2, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
end subroutine
!-----------------------------------------------------------------------------
subroutine ReleaseRH(connector, rc)
type(ESMF_CplComp) :: connector
integer, intent(out) :: rc
! local variables
integer :: localrc
type(ESMF_State) :: state
type(ESMF_FieldBundle) :: interDstFields
type(ESMF_RouteHandle) :: rh1, rh2
rc = ESMF_SUCCESS
call NUOPC_ConnectorGet(connector, state=state, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
! retrieve interDstFields FieldBundle from state member
call ESMF_StateGet(state, "interDstFields", interDstFields, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
! retrieve rh1 from state member
call ESMF_StateGet(state, "src2interDstRH", rh1, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
! retrieve rh2 from state member
call ESMF_StateGet(state, "interDst2dstRH", rh2, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
! release rh1
call ESMF_FieldBundleRegridRelease(rh1, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
! release rh2
call ESMF_FieldBundleRegridRelease(rh2, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
return ! bail out
! Could destroy intermediate Fields and interDstFields FieldBundle here,
! but it is more convenient to let ESMF automatic garbage collection take
! care of them.
end subroutine
#endif
end module