@@ -17,27 +17,29 @@ module module_cap_cpl
17
17
!- ----------------------------------------------------------------------------
18
18
19
19
subroutine diagnose_cplFields (gcomp , clock_fv3 , fcstpe , &
20
- statewrite_flag , stdiagnose_flag , state_tag )
20
+ statewrite_flag , stdiagnose_flag , state_tag , rc )
21
21
22
22
type (ESMF_GridComp), intent (in ) :: gcomp
23
23
type (ESMF_Clock),intent (in ) :: clock_fv3
24
24
logical , intent (in ) :: fcstpe
25
25
logical , intent (in ) :: statewrite_flag
26
26
integer , intent (in ) :: stdiagnose_flag
27
- character (len=* ), intent (in ) :: state_tag ! < Import or export.
27
+ character (len=* ), intent (in ) :: state_tag ! < "import" or "export".
28
+ integer , intent (out ) :: rc
28
29
29
30
character (len=* ),parameter :: subname= ' (module_cap_cpl:diagnose_cplFields)'
30
31
type (ESMF_Time) :: currTime
31
32
type (ESMF_State) :: state
32
- character (len = 240 ) :: timestr
33
- integer :: timeslice = 1
33
+ type (ESMF_TimeInterval ) :: timeStep
34
+ character (len = 240 ) :: import_timestr, export_timestr
34
35
character (len= 160 ) :: nuopcMsg
35
36
character (len= 160 ) :: filename
36
- integer :: rc
37
37
!
38
- call ESMF_ClockGet(clock_fv3, currTime= currTime, rc= rc)
38
+ call ESMF_ClockGet(clock_fv3, currTime= currTime, timeStep= timestep, rc= rc)
39
+ if (ESMF_LogFoundError(rcToCheck= rc, msg= ESMF_LOGERR_PASSTHRU, line= __LINE__, file= __FILE__)) return
40
+ call ESMF_TimeGet(currTime, timestring= import_timestr, rc= rc)
39
41
if (ESMF_LogFoundError(rcToCheck= rc, msg= ESMF_LOGERR_PASSTHRU, line= __LINE__, file= __FILE__)) return
40
- call ESMF_TimeGet(currTime, timestring= timestr , rc= rc)
42
+ call ESMF_TimeGet(currTime+ timestep , timestring= export_timestr , rc= rc)
41
43
if (ESMF_LogFoundError(rcToCheck= rc, msg= ESMF_LOGERR_PASSTHRU, line= __LINE__, file= __FILE__)) return
42
44
43
45
call ESMF_ClockPrint(clock_fv3, options= " currTime" , preString= " current time: " , unit= nuopcMsg)
@@ -53,8 +55,8 @@ subroutine diagnose_cplFields(gcomp, clock_fv3, fcstpe, &
53
55
54
56
! Dump Fields out
55
57
if (statewrite_flag) then
56
- write (filename,' (A)' ) ' fv3_cap_import_' // trim (timestr )// ' _ '
57
- call State_RWFields_tiles(state,trim (filename), timeslice, rc= rc)
58
+ write (filename,' (A)' ) ' fv3_cap_import_' // trim (import_timestr )// ' .tile*.nc '
59
+ call State_RWFields_tiles(state,trim (filename), rc= rc)
58
60
if (ESMF_LogFoundError(rcToCheck= rc, msg= ESMF_LOGERR_PASSTHRU, line= __LINE__, file= __FILE__)) return
59
61
end if
60
62
end if
@@ -69,8 +71,8 @@ subroutine diagnose_cplFields(gcomp, clock_fv3, fcstpe, &
69
71
70
72
! Dump Fields out
71
73
if (statewrite_flag) then
72
- write (filename,' (A)' ) ' fv3_cap_export_' // trim (timestr )// ' _ '
73
- call State_RWFields_tiles(state,trim (filename), timeslice, rc= rc)
74
+ write (filename,' (A)' ) ' fv3_cap_export_' // trim (export_timestr )// ' .tile*.nc '
75
+ call State_RWFields_tiles(state,trim (filename), rc= rc)
74
76
if (ESMF_LogFoundError(rcToCheck= rc, msg= ESMF_LOGERR_PASSTHRU, line= __LINE__, file= __FILE__)) return
75
77
end if
76
78
end if
@@ -80,28 +82,36 @@ end subroutine diagnose_cplFields
80
82
!- ----------------------------------------------------------------------------
81
83
82
84
! This subroutine requires ESMFv8 - for coupled FV3
83
- subroutine State_RWFields_tiles (state ,filename ,timeslice , rc )
85
+ subroutine State_RWFields_tiles (state ,filename ,rc )
84
86
85
87
type (ESMF_State), intent (in ) :: state
86
88
character (len=* ), intent (in ) :: fileName
87
- integer , intent (in ) :: timeslice
88
89
integer , intent (out ) :: rc
89
90
90
- ! local
91
- type (ESMF_Field) :: firstESMFFLD
92
- type (ESMF_Field),allocatable :: flds(:)
93
- type (ESMF_GridComp) :: IOComp
94
- type (ESMF_Grid) :: gridFv3
95
-
96
- character (len= 256 ) :: msgString
97
- integer :: i, icount, ifld
91
+ ! local variables
92
+ type (ESMF_Array) :: array
93
+ type (ESMF_Grid) :: grid
94
+ type (ESMF_FieldBundle) :: fieldbundle
95
+ type (ESMF_Field), allocatable :: flds(:)
96
+ type (ESMF_DistGrid) :: distgrid
97
+ integer :: i, icount, ifld, id
98
98
integer :: fieldcount, firstfld
99
+ integer :: fieldDimCount, gridDimCount, dimCount, tileCount, ungriddedDimCount
99
100
character (64 ), allocatable :: itemNameList(:), fldNameList(:)
100
101
type (ESMF_StateItem_Flag), allocatable :: typeList(:)
102
+ integer , allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:)
103
+ integer , allocatable :: ungriddedLBound(:), ungriddedUBound(:)
104
+ integer , allocatable :: fieldDimLen(:)
105
+ character (len= 32 ), allocatable :: gridded_dim_labels(:), ungridded_dim_labels(:)
101
106
102
- character (len=* ),parameter :: subname= ' (module_cap_cpl:State_RWFields_tiles)'
107
+ character (16 ), parameter :: convention = ' NetCDF'
108
+ character (16 ), parameter :: purpose = ' FV3'
103
109
104
- ! local variables
110
+ integer , parameter :: max_n_axes = 4
111
+ integer , parameter :: max_n_dim = 16
112
+ integer , dimension (max_n_axes, max_n_dim) :: axes_dimcount = 0
113
+
114
+ character (len=* ),parameter :: subname= ' (module_cap_cpl:State_RWFields_tiles)'
105
115
106
116
rc = ESMF_SUCCESS
107
117
! call ESMF_LogWrite(trim(subname)//trim(filename)//": called", ESMF_LOGMSG_INFO, rc=rc)
@@ -118,9 +128,6 @@ subroutine State_RWFields_tiles(state,filename,timeslice,rc)
118
128
if (typeList(i) == ESMF_STATEITEM_FIELD) firstfld = i
119
129
if (typeList(i) == ESMF_STATEITEM_FIELD) fieldcount = fieldcount + 1
120
130
enddo
121
- ! write(msgString,*) trim(subname)//' icount = ',icount," fieldcount =
122
- ! ",fieldcount," firstfld = ",firstfld
123
- ! call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc)
124
131
125
132
allocate (flds(fieldCount),fldNameList(fieldCount))
126
133
ifld = 1
@@ -131,37 +138,152 @@ subroutine State_RWFields_tiles(state,filename,timeslice,rc)
131
138
endif
132
139
enddo
133
140
134
- call ESMF_LogWrite(trim (subname)// " : write " // trim (filename)// " tile1-tile6" , ESMF_LOGMSG_INFO, rc= rc)
135
- ! get first field
136
- call ESMF_StateGet(state, itemName= itemNameList(firstfld), field= firstESMFFLD, rc= rc)
137
- if (ESMF_LogFoundError(rcToCheck= rc, msg= ESMF_LOGERR_PASSTHRU, &
138
- line= __LINE__, file= __FILE__)) return ! bail out
139
-
140
- call ESMF_FieldGet(firstESMFFLD, grid= gridFv3, rc= rc)
141
- if (ESMF_LogFoundError(rcToCheck= rc, msg= ESMF_LOGERR_PASSTHRU, &
142
- line= __LINE__, file= __FILE__)) return ! bail out
141
+ fieldbundle = ESMF_FieldBundleCreate(rc= rc)
142
+ if (ESMF_LogFoundError(rcToCheck= rc, msg= ESMF_LOGERR_PASSTHRU, line= __LINE__, file= __FILE__)) return
143
143
144
- IOComp = ESMFIO_Create(gridFv3, rc= rc)
145
- if (ESMF_LogFoundError(rcToCheck= rc, msg= ESMF_LOGERR_PASSTHRU, &
146
- line= __LINE__, file= __FILE__)) return ! bail out
144
+ call ESMF_LogWrite(trim (subname)// " : write " // trim (filename), ESMF_LOGMSG_INFO, rc= rc)
147
145
148
146
do ifld= 1 , fieldCount
149
147
call ESMF_StateGet(state, itemName= fldNameList(ifld), field= flds(ifld), rc= rc)
148
+ if (ESMF_LogFoundError(rcToCheck= rc, msg= ESMF_LOGERR_PASSTHRU, line= __LINE__, file= __FILE__)) return
149
+
150
+ call ESMF_FieldGet(flds(ifld), grid= grid, dimCount= fieldDimCount, array= array, rc= rc)
151
+ if (ESMF_LogFoundError(rcToCheck= rc, msg= ESMF_LOGERR_PASSTHRU, line= __LINE__, file= __FILE__)) return
152
+
153
+ if (fieldDimCount > 4 ) then
154
+ call ESMF_LogWrite(trim (subname)// " : fieldDimCount > 4 unsupported" , ESMF_LOGMSG_ERROR, rc= rc)
155
+ end if
156
+
157
+ call ESMF_GridGet(grid, dimCount= gridDimCount, rc= rc)
158
+ if (ESMF_LogFoundError(rcToCheck= rc, msg= ESMF_LOGERR_PASSTHRU, line= __LINE__, file= __FILE__)) return
159
+
160
+ if (gridDimCount > 2 ) then
161
+ call ESMF_LogWrite(trim (subname)// " : gridDimCount > 2 unsupported" , ESMF_LOGMSG_ERROR, rc= rc)
162
+ end if
163
+
164
+ call ESMF_ArrayGet(array, distgrid= distgrid, dimCount= dimCount, tileCount= tileCount, rc= rc)
165
+ if (ESMF_LogFoundError(rcToCheck= rc, msg= ESMF_LOGERR_PASSTHRU, line= __LINE__, file= __FILE__)) return
166
+
167
+ ! skip 'cpl_scalars' field because it has tileCount == 1, while all other fields have 6.
168
+ ! This causes the following error:
169
+ ! 20240705 134459.788 ERROR PET000 ESMCI_IO.C:1614 ESMCI::IO::checkNtiles() Wrong data value - New number of tiles (6) does not match previously-set number of tiles (1) for this IO object. All arrays handled by a given IO object must have the same number of tiles.
170
+ if (trim (fldNameList(ifld)) == ' cpl_scalars' ) then
171
+ cycle
172
+ endif
173
+
174
+ allocate (fieldDimLen(fieldDimCount))
175
+
176
+ allocate (minIndexPTile(dimCount, tileCount))
177
+ allocate (maxIndexPTile(dimCount, tileCount))
178
+ call ESMF_DistGridGet(distgrid, minIndexPTile= minIndexPTile, maxIndexPTile= maxIndexPTile, rc= rc)
179
+ if (ESMF_LogFoundError(rcToCheck= rc, msg= ESMF_LOGERR_PASSTHRU, line= __LINE__, file= __FILE__)) return
180
+
181
+ allocate (gridded_dim_labels(gridDimCount))
182
+ do i = 1 , gridDimCount
183
+ fieldDimLen(i) = maxIndexPTile(i,1 ) - minIndexPTile(i,1 ) + 1
184
+ id = find_axis_id_for_axis_count(i,fieldDimLen(i))
185
+ if (id < 1 ) then
186
+ call ESMF_LogWrite(trim (subname)// " : id < 1" , ESMF_LOGMSG_ERROR, rc= rc)
187
+ endif
188
+ if (i == 1 ) write (gridded_dim_labels(i),' (A,I0)' ) ' xaxis_' ,id
189
+ if (i == 2 ) write (gridded_dim_labels(i),' (A,I0)' ) ' yaxis_' ,id
190
+ end do
191
+
192
+ deallocate (minIndexPTile)
193
+ deallocate (maxIndexPTile)
194
+
195
+ ungriddedDimCount = fieldDimCount - gridDimCount
196
+ allocate (ungridded_dim_labels(ungriddedDimCount))
197
+ if (fieldDimCount > gridDimCount) then
198
+ allocate (ungriddedLBound(ungriddedDimCount))
199
+ allocate (ungriddedUBound(ungriddedDimCount))
200
+ call ESMF_FieldGet(flds(ifld), ungriddedLBound= ungriddedLBound, ungriddedUBound= ungriddedUBound, rc= rc)
201
+ if (ESMF_LogFoundError(rcToCheck= rc, msg= ESMF_LOGERR_PASSTHRU, line= __LINE__, file= __FILE__)) return
202
+
203
+ do i= 1 ,ungriddedDimCount
204
+ fieldDimLen(i+ gridDimCount) = ungriddedUBound(i) - ungriddedLBound(i) + 1
205
+ id = find_axis_id_for_axis_count(i+ gridDimCount, fieldDimLen(i+ gridDimCount))
206
+ if (id < 1 ) then
207
+ write (0 ,* )' stop error' , id, i, fieldDimLen(i+ gridDimCount)
208
+ endif
209
+ if (i== 1 ) write (ungridded_dim_labels(i),' (A,I0)' ) ' zaxis_' ,id
210
+ if (i== 2 ) write (ungridded_dim_labels(i),' (A,I0)' ) ' taxis_' ,id
211
+ end do
212
+ deallocate (ungriddedLBound)
213
+ deallocate (ungriddedUBound)
214
+ end if
215
+
216
+ call ESMF_AttributeAdd(grid, convention= convention, purpose= purpose, attrList= (/ ESMF_ATT_GRIDDED_DIM_LABELS / ), rc= rc)
217
+ if (ESMF_LogFoundError(rcToCheck= rc, msg= ESMF_LOGERR_PASSTHRU, line= __LINE__, file= __FILE__)) return
218
+
219
+ call ESMF_AttributeSet(grid, convention= convention, purpose= purpose, &
220
+ name= ESMF_ATT_GRIDDED_DIM_LABELS, valueList= gridded_dim_labels, rc= rc)
221
+ if (ESMF_LogFoundError(rcToCheck= rc, msg= ESMF_LOGERR_PASSTHRU, line= __LINE__, file= __FILE__)) return
222
+
223
+ if (ungriddedDimCount > 0 ) then
224
+ call ESMF_AttributeAdd(flds(ifld), convention= convention, purpose= purpose, &
225
+ attrList= (/ ESMF_ATT_UNGRIDDED_DIM_LABELS / ), rc= rc)
226
+ if (ESMF_LogFoundError(rcToCheck= rc, msg= ESMF_LOGERR_PASSTHRU, line= __LINE__, file= __FILE__)) return
227
+
228
+ call ESMF_AttributeSet(flds(ifld), convention= convention, purpose= purpose, &
229
+ name= ESMF_ATT_UNGRIDDED_DIM_LABELS, valueList= ungridded_dim_labels, rc= rc)
230
+ if (ESMF_LogFoundError(rcToCheck= rc, msg= ESMF_LOGERR_PASSTHRU, line= __LINE__, file= __FILE__)) return
231
+ end if
232
+
233
+ deallocate (fieldDimLen)
234
+ deallocate (gridded_dim_labels)
235
+ deallocate (ungridded_dim_labels)
236
+
237
+ call ESMF_FieldBundleAdd(fieldbundle, (/ flds(ifld)/ ), rc= rc)
238
+ if (ESMF_LogFoundError(rcToCheck= rc, msg= ESMF_LOGERR_PASSTHRU, line= __LINE__, file= __FILE__)) return
239
+
150
240
enddo
151
241
152
- call ESMFIO_Write(IOComp, filename, flds, filePath = ' ./ ' , rc = rc)
153
- if (ESMF_LogFoundError(rcToCheck = rc, msg = ESMF_LOGERR_PASSTHRU, &
154
- line= __LINE__, file= __FILE__)) return ! bail out
242
+ call ESMF_FieldBundleWrite(fieldbundle, fileName = trim ( filename), convention = convention, purpose = purpose, &
243
+ timeslice = 1 , overwrite = .true. , rc = rc)
244
+ if (ESMF_LogFoundError(rcToCheck = rc, msg = ESMF_LOGERR_PASSTHRU, line= __LINE__, file= __FILE__)) return
155
245
156
- ! -- Finalize ESMFIO
246
+ ! -- Finalize
157
247
deallocate (flds)
158
248
deallocate (fldNameList)
159
- call ESMFIO_Destroy(IOComp, rc = rc)
160
- if (ESMF_LogFoundError(rcToCheck = rc, msg = ESMF_LOGERR_PASSTHRU, &
161
- line= __LINE__, file= __FILE__)) call ESMF_Finalize()
249
+
250
+ call ESMF_FieldBundleDestroy(fieldbundle, rc = rc)
251
+ if (ESMF_LogFoundError(rcToCheck = rc, msg = ESMF_LOGERR_PASSTHRU, line= __LINE__, file= __FILE__)) return
162
252
163
253
! call ESMF_LogWrite(trim(subname)//trim(filename)//": finished", ESMF_LOGMSG_INFO, rc=rc)
164
254
255
+ contains
256
+
257
+ function find_axis_id_for_axis_count (axis , count ) result(id)
258
+ integer , intent (in ) :: axis, count
259
+
260
+ integer :: id
261
+ integer :: i
262
+
263
+ id = - 1 ! not found
264
+
265
+ if (axis > max_n_axes) then
266
+ call ESMF_LogWrite(' axis > max_n_axes. Increase max_n_axes in ' // trim (subname), ESMF_LOGMSG_ERROR)
267
+ return
268
+ end if
269
+
270
+ do i = 1 , max_n_dim
271
+ if (axes_dimcount(axis, i) == 0 ) then
272
+ axes_dimcount(axis, i) = count
273
+ id = i
274
+ return
275
+ else
276
+ if (axes_dimcount(axis, i) == count) then
277
+ id = i
278
+ return
279
+ end if
280
+ end if
281
+ end do
282
+
283
+ call ESMF_LogWrite(' Increase max_n_dim in ' // trim (subname), ESMF_LOGMSG_ERROR)
284
+
285
+ end function find_axis_id_for_axis_count
286
+
165
287
end subroutine State_RWFields_tiles
166
288
167
289
!- ----------------------------------------------------------------------------
0 commit comments