Line data Source code
1 : #define VERIFY_(A) if(.not.HCO_ESMF_VRFY(A,subname,__LINE__)) stop -1
2 : #define ASSERT_(A) if(.not.HCO_ESMF_ASRT(A,subname,__LINE__)) stop -1
3 : !------------------------------------------------------------------------------
4 : ! Harmonized Emissions Component (HEMCO) !
5 : !------------------------------------------------------------------------------
6 : !BOP
7 : !
8 : ! !MODULE: hco_cam_exports
9 : !
10 : ! !DESCRIPTION: Module HCO\_CAM\_EXPORTS manages interfaces to CAM for exporting
11 : ! fields calculated by the HEMCO emissions component. It contains use of both
12 : ! the CAM history output (for diagnostic output of fluxes calculated and debug)
13 : ! and the physics buffer (for internal passing to chemistry packages)
14 : !\\
15 : !\\
16 : ! !INTERFACE:
17 : !
18 : module hco_cam_exports
19 : !
20 : ! !USES:
21 : !
22 : ! ESMF function wrappers
23 : use hco_esmf_wrappers
24 : use ESMF, only: ESMF_SUCCESS
25 :
26 : use shr_kind_mod, only: r8 => shr_kind_r8
27 : use physics_buffer, only: dtype_r8
28 :
29 : ! Controls
30 : use cam_abortutils, only: endrun ! fatal terminator
31 : use cam_logfile, only: iulog ! output log handle
32 :
33 : ! HEMCO grid information (for registering with CAM)
34 : use hco_esmf_grid, only: my_IS, my_IE, my_JS, my_JE, my_IM, my_JM
35 : use hco_esmf_grid, only: my_ID, nPET ! mytid, ntask
36 : use hco_esmf_grid, only: my_CE ! # of CAM ncols on this task (total sum of ncols_p)
37 : use hco_esmf_grid, only: IM, JM, LM, XMid, YMid ! nlat/lon/lev, glat/lon
38 :
39 : ! History output
40 : use cam_history, only: addfld ! Add field for history output
41 : use cam_history, only: outfld ! output field to history
42 :
43 : ! Physics buffer
44 : use physics_buffer, only: physics_buffer_desc
45 :
46 : implicit none
47 : private
48 : !
49 : ! !PUBLIC MEMBER FUNCTIONS:
50 : !
51 : public :: HCO_Exports_Init
52 : public :: HCO_Export_History_HCO3D
53 : public :: HCO_Export_History_CAM2D
54 : public :: HCO_Export_History_CAM3D
55 :
56 : public :: HCO_Export_Pbuf_QueryField
57 : public :: HCO_Export_Pbuf_AddField
58 : public :: HCO_Export_Pbuf_CAM3D
59 : public :: HCO_Export_Pbuf_CAM2D
60 : !
61 : ! !REMARKS:
62 : ! This module should NOT be aware of particular chemical constituents. It should
63 : ! only do export functions and the field names must be passed in from a higher-
64 : ! -level interface, for cleaniness.
65 : !
66 : ! The workflow is usually to register the grid here and hemco_interface will
67 : ! initialize the fields (into both history and pbuf as necessary)
68 : ! The fields are written into by hemco_interface through the run gridcomp,
69 : ! usually after regridding back to the physics chunk so it fits in pbuf format.
70 : !
71 : ! History output doesn't need regrid as we register the HCO grid with cam_history
72 : ! at initialization here. (Will it work? We will see) (No it does not, hplin 4/10/20)
73 : !
74 : ! For Pbuf-based output (to pass to other components):
75 : ! - pbuf_idx_map() is a fixed-size array to store species-ID-to-pbuf-ID mapping.
76 : ! However, not all data HEMCO reads in are species. In this case, the idx_map will not
77 : ! be used (pass hcoID=-1), and we will attempt to look up the field through pbuf_get_field
78 : ! as usual. This may be slow, but always reliable. pbuf_idx_map is a convenience tool.
79 : ! - All pbuf exports are on the CAM grid. Regrid data before passing in.
80 : !
81 : ! !REVISION HISTORY:
82 : ! 25 Feb 2020 - H.P. Lin - Initial version
83 : ! 10 Apr 2020 - H.P. Lin - Added pbuf functionality
84 : ! 25 Feb 2021 - H.P. Lin - Added pbuf 2-D export and query functionality
85 : !EOP
86 : !------------------------------------------------------------------------------
87 : !BOC
88 : !
89 : ! !PUBLIC TYPES:
90 : !
91 : type(physics_buffer_desc), &
92 : public, pointer :: hco_pbuf2d(:,:) ! Pointer to the pbuf
93 : !
94 : ! !PRIVATE TYPES:
95 : !
96 : integer :: pbuf_idx_map(1024) ! Mapping of species IDX to pbuf ID
97 : contains
98 : !EOC
99 : !------------------------------------------------------------------------------
100 : ! Harmonized Emissions Component (HEMCO) !
101 : !------------------------------------------------------------------------------
102 : !BOP
103 : !
104 : ! !IROUTINE: HCO_Exports_Init
105 : !
106 : ! !DESCRIPTION: Initializes the exports module (after grid initialization)
107 : !\\
108 : !\\
109 : ! !INTERFACE:
110 : !
111 0 : subroutine HCO_Exports_Init()
112 : !
113 : ! !USES:
114 : !
115 : use spmd_utils, only: masterproc
116 :
117 : ! Register history output grid
118 : use cam_grid_support, only: cam_grid_register
119 : use cam_grid_support, only: horiz_coord_create
120 : use cam_grid_support, only: horiz_coord_t, iMap
121 : !
122 : ! !INPUT PARAMETERS:
123 : !
124 :
125 : !
126 : ! !REMARKS:
127 : ! Only registers HCO grid with CAM history for now
128 : !
129 : ! !REVISION HISTORY:
130 : ! 25 Feb 2020 - H.P. Lin - Initial version
131 : !EOP
132 : !------------------------------------------------------------------------------
133 : !BOC
134 : !
135 : ! !LOCAL VARIABLES:
136 : !
137 : character(len=*), parameter :: subname = 'HCO_Exports_Init'
138 :
139 : integer, parameter :: hco_decomp = 233 ! Unique within CAM
140 : type(horiz_coord_t), pointer :: lon_coord => null()
141 : type(horiz_coord_t), pointer :: lat_coord => null()
142 : integer(iMap), pointer :: grid_map(:,:) => null()
143 : integer(iMap), pointer :: coord_map(:) => null()
144 :
145 : integer :: I, J, ind
146 :
147 : !-----------------------------------------------------------------------
148 : ! Create "hco_grid" HEMCO Grid for CAM HISTORY export
149 : ! HISTORY is used for diagnostic purposes
150 : !-----------------------------------------------------------------------
151 0 : allocate(grid_map(4, ((my_IE - my_IS + 1) * (my_JE - my_JS + 1))))
152 0 : ind = 0
153 0 : do J = my_JS, my_JE
154 0 : do I = my_IS, my_IE
155 0 : ind = ind + 1
156 0 : grid_map(1, ind) = I
157 0 : grid_map(2, ind) = J
158 0 : grid_map(3, ind) = I
159 0 : grid_map(4, ind) = J
160 : enddo
161 : enddo
162 :
163 : ! FIXME: This part does not support curvilinear coords (assuming rectilinear here)
164 : ! (hplin, 3/2/2020)
165 0 : allocate(coord_map(my_JE - my_JS + 1))
166 0 : coord_map = (/(J, J = my_JS, my_JE)/)
167 : lat_coord => horiz_coord_create('YMid', '', my_JM, 'latitude', &
168 0 : 'degrees_north', my_JS, my_JE, YMid(1,my_JS:my_JE), &
169 0 : map = coord_map)
170 0 : deallocate(coord_map)
171 : nullify(coord_map)
172 :
173 0 : allocate(coord_map(my_IE - my_IS + 1))
174 0 : coord_map = (/(I, I = my_IS, my_IE)/)
175 : lon_coord => horiz_coord_create('XMid', '', my_IM, 'longitude', &
176 0 : 'degrees_east', my_IS, my_IE, XMid(my_IS:my_IE,1), &
177 0 : map = coord_map)
178 0 : deallocate(coord_map)
179 : nullify(coord_map)
180 :
181 : call cam_grid_register('hco_grid', hco_decomp, lat_coord, lon_coord, &
182 0 : grid_map, unstruct = .false.)
183 0 : deallocate(grid_map)
184 : nullify(grid_map)
185 :
186 0 : if(masterproc) then
187 0 : write(iulog,*) ">> Registered HEMCO hco_grid in CAM for history exports"
188 : endif
189 :
190 : !-----------------------------------------------------------------------
191 : ! Set pbuf_idx_map to magic number indicating that this buffer
192 : ! is unassigned
193 : !-----------------------------------------------------------------------
194 0 : pbuf_idx_map(:) = -233
195 :
196 0 : end subroutine HCO_Exports_Init
197 : !EOC
198 : !------------------------------------------------------------------------------
199 : ! Harmonized Emissions Component (HEMCO) !
200 : !------------------------------------------------------------------------------
201 : !BOP
202 : !
203 : ! !IROUTINE: HCO_Export_History_HCO3D
204 : !
205 : ! !DESCRIPTION: Writes to CAM history a 3-D field in the HEMCO array. This uses
206 : ! the HEMCO lat-lon grid.
207 : !\\
208 : !\\
209 : ! !INTERFACE:
210 : !
211 0 : subroutine HCO_Export_History_HCO3D(fldname, array)
212 : !
213 : ! !USES:
214 : !
215 0 : use cam_history, only: hist_fld_active, outfld
216 : !
217 : ! !INPUT PARAMETERS:
218 : !
219 : character(len=*), intent(in) :: fldname ! Field name
220 : real(r8), intent(in) :: array(my_IS:my_IE,my_JS:my_JE,1:LM)
221 : !
222 : ! !REMARKS:
223 : ! Remember fields need to be declared via addfld in CAM before history export.
224 : !
225 : ! For a native (physics mesh) variant, use HCO_Export_History_CAM3D.
226 : !
227 : ! Based off the convoluted savefld_waccm in the ionos WACCMx interface. Notably,
228 : ! (1) outfld accepts arguments in (fname, field, idim, c, avg_subcol_field) order,
229 : ! where field is a 2-D array (idim,*) containing field values, and c is a
230 : ! very mythical index.
231 : ! (2) If you are outputting to lat-lon, c is the LATITUDE index of your output, so "j",
232 : ! and outfld needs to be called in loops over the lat index.
233 : ! (3) ... this is to accommodate that in the physics mesh, you have only (k,i) idxes,
234 : ! which means that the data is passed in (fname, field, pcols, lchnk), field(i, k)
235 : ! where pcols is the number of columns in the mesh, and lchnk is a loop index over
236 : ! begchunk, endchunk (ppgrid). i is 1, ncol from ncol = get_ncols_p(lchnk).
237 : !
238 : ! At the time this code was written (3/3/2020) I absolutely understand none of the way
239 : ! the physics mesh data is written, hence the rant above.
240 : !
241 : ! OK now I get it. See the note below in the CAM3D variant.
242 : !
243 : ! The below code has nothing to do with the rant above,
244 : ! as HCO_Export_History_HCO3D is operating on the HEMCO lat-lon grid.
245 : !
246 : ! !REVISION HISTORY:
247 : ! 25 Feb 2020 - H.P. Lin - Initial version
248 : !EOP
249 : !------------------------------------------------------------------------------
250 : !BOC
251 : !
252 : ! !LOCAL VARIABLES:
253 : !
254 : character(len=*), parameter :: subname = 'HCO_Export_History_HCO3D'
255 : integer :: I, J, K
256 0 : real(r8) :: tmpfld_ik(my_IS:my_IE, 1:LM) ! lon-lev by lat
257 :
258 0 : if(.not. hist_fld_active(fldname)) then
259 : ! This routine is ALWAYS called but may fail silently if this history field
260 : ! is not to be outputted.
261 : return
262 : endif
263 :
264 : ! Not the most efficient; can probably use slicing. This will do for now (hplin, 3/3/20)
265 0 : do J = my_JS, my_JE
266 0 : do I = my_IS, my_IE
267 0 : do K = 1, LM
268 0 : tmpfld_ik(I, K) = array(I, J, K)
269 : enddo
270 : enddo
271 0 : call outfld(fldname, tmpfld_ik, my_IE - my_IS + 1, J) ! By lat convert to lon glob idx
272 : enddo
273 0 : end subroutine HCO_Export_History_HCO3D
274 : !EOC
275 : !------------------------------------------------------------------------------
276 : ! Harmonized Emissions Component (HEMCO) !
277 : !------------------------------------------------------------------------------
278 : !BOP
279 : !
280 : ! !IROUTINE: HCO_Export_History_CAM3D
281 : !
282 : ! !DESCRIPTION: Writes to CAM history a 3-D field in the CAM array format. This
283 : ! uses the CAM physics mesh (physgrid).
284 : !\\
285 : !\\
286 : ! !INTERFACE:
287 : !
288 0 : subroutine HCO_Export_History_CAM3D(fldname, array)
289 : !
290 : ! !USES:
291 : !
292 0 : use cam_history, only: hist_fld_active, outfld
293 : use ppgrid, only: pcols, pver
294 : use phys_grid, only: get_ncols_p
295 : use ppgrid, only: begchunk, endchunk
296 :
297 : use spmd_utils, only: iam, masterproc
298 : !
299 : ! !INPUT PARAMETERS:
300 : !
301 : character(len=*), intent(in) :: fldname ! Field name
302 : real(r8), intent(in) :: array(1:LM, 1:my_CE)
303 : !
304 : ! !REMARKS:
305 : ! Remember fields need to be declared via addfld in CAM before history export.
306 : ! See rant above.
307 : !
308 : ! my_CE is the sum of get_ncols_p(lchnk) over begchunk, endchunk, called blksize
309 : ! in the ionos code. It is the TOTAL number of columns on this PET.
310 : !
311 : ! The columns on this PET are divided into "chunks", lchnk = begchunk, endchunk.
312 : ! The chunks each contain (up to) pcols each, specific number is from get_ncols_p.
313 : !
314 : ! This means that while the physics array is sized (1:LM, 1:my_CE) = (pver, blksize)
315 : ! when they are written back, you have to account for putting them back into chunks
316 : ! and writing using format outfld(..., array(1:pcols, 1:LM), pcols, lchnk)
317 : ! where the data is sized 1:pcols, filled to 1:get_ncols_p(lchnk) and rest zeroed,
318 : ! and the data is ordered in (i, k) called with pcols, lchnk as dim'ls.
319 : !
320 : !
321 : !
322 : ! !REVISION HISTORY:
323 : ! 03 Mar 2020 - H.P. Lin - Initial version
324 : !EOP
325 : !------------------------------------------------------------------------------
326 : !BOC
327 : !
328 : ! !LOCAL VARIABLES:
329 : !
330 : character(len=*), parameter :: subname = 'HCO_Export_History_CAM3D'
331 : integer :: lchnk, ncol
332 : integer :: I, K, J
333 :
334 : real(r8) :: tmpfld_ik(pcols, pver) ! Temporary array for per-column data (i, k)
335 :
336 0 : if(.not. hist_fld_active(trim(fldname))) then
337 : ! This routine is ALWAYS called but may fail silently if this history field
338 : ! is not to be outputted.
339 : ! if(masterproc) write(iulog,*) "HCO_Export_History_CAM3D: Cannot export", trim(fldname), " (not active)"
340 0 : return
341 : endif
342 :
343 : ! For all chunks on this PET
344 0 : J = 0
345 0 : do lchnk = begchunk, endchunk
346 0 : ncol = get_ncols_p(lchnk)
347 : ! For all columns in each chunk, organize the data
348 0 : do I = 1, ncol
349 0 : J = J + 1 ! Advance one column in the physics mesh array
350 0 : do K = 1, pver
351 0 : tmpfld_ik(I, K) = array(K, J)
352 : enddo
353 : enddo
354 :
355 : ! Write to outfld chunk by chunk
356 : ! write(6,*) "hco_cam_exports before writing ncol, lchnk, ", ncol, lchnk
357 0 : call outfld(trim(fldname), tmpfld_ik(:ncol, :), ncol, lchnk)
358 : ! write(6,*) "hco_cam_exports writing ncol, lchnk, ", ncol, lchnk
359 : enddo
360 :
361 0 : end subroutine HCO_Export_History_CAM3D
362 : !EOC
363 : !------------------------------------------------------------------------------
364 : ! Harmonized Emissions Component (HEMCO) !
365 : !------------------------------------------------------------------------------
366 : !BOP
367 : !
368 : ! !IROUTINE: HCO_Export_History_CAM2D
369 : !
370 : ! !DESCRIPTION: Writes to CAM history a 2-D field in the CAM array format. This
371 : ! uses the CAM physics mesh (physgrid).
372 : !\\
373 : !\\
374 : ! !INTERFACE:
375 : !
376 0 : subroutine HCO_Export_History_CAM2D(fldname, array)
377 : !
378 : ! !USES:
379 : !
380 0 : use cam_history, only: hist_fld_active, outfld
381 : use ppgrid, only: pcols
382 : use phys_grid, only: get_ncols_p
383 : use ppgrid, only: begchunk, endchunk
384 :
385 : use spmd_utils, only: iam, masterproc
386 : !
387 : ! !INPUT PARAMETERS:
388 : !
389 : character(len=*), intent(in) :: fldname ! Field name
390 : real(r8), intent(in) :: array(1:my_CE)
391 : !
392 : ! !REMARKS:
393 : ! Remember fields need to be declared via addfld in CAM before history export.
394 : ! Refer to the 3-D field export subroutine for further documentation.
395 : !
396 : ! !REVISION HISTORY:
397 : ! 26 Feb 2021 - H.P. Lin - Initial version
398 : !EOP
399 : !------------------------------------------------------------------------------
400 : !BOC
401 : !
402 : ! !LOCAL VARIABLES:
403 : !
404 : character(len=*), parameter :: subname = 'HCO_Export_History_CAM2D'
405 : integer :: lchnk, ncol
406 : integer :: I, J
407 :
408 : real(r8) :: tmpfld_i(pcols) ! Temporary array for per-column data (i, k)
409 :
410 0 : if(.not. hist_fld_active(trim(fldname))) then
411 : ! This routine is ALWAYS called but may fail silently if this history field
412 : ! is not to be outputted.
413 : ! if(masterproc) write(iulog,*) "HCO_Export_History_CAM2D: Cannot export", trim(fldname), " (not active)"
414 0 : return
415 : endif
416 :
417 : ! For all chunks on this PET
418 0 : J = 0
419 0 : do lchnk = begchunk, endchunk
420 0 : ncol = get_ncols_p(lchnk)
421 : ! For all columns in each chunk, organize the data
422 0 : do I = 1, ncol
423 0 : J = J + 1 ! Advance one column in the physics mesh array
424 0 : tmpfld_i(I) = array(J)
425 : enddo
426 :
427 : ! Write to outfld chunk by chunk
428 : ! write(6,*) "hco_cam_exports before writing ncol, lchnk, ", ncol, lchnk
429 0 : call outfld(trim(fldname), tmpfld_i(:ncol), ncol, lchnk)
430 : ! write(6,*) "hco_cam_exports writing ncol, lchnk, ", ncol, lchnk
431 : enddo
432 :
433 0 : end subroutine HCO_Export_History_CAM2D
434 : !EOC
435 : !------------------------------------------------------------------------------
436 : ! Harmonized Emissions Component (HEMCO) !
437 : !------------------------------------------------------------------------------
438 : !BOP
439 : !
440 : ! !IROUTINE: HCO_Export_Pbuf_QueryField
441 : !
442 : ! !DESCRIPTION: Query the physics buffer for whether a field exists
443 : !\\
444 : !\\
445 : ! !INTERFACE:
446 : !
447 0 : subroutine HCO_Export_Pbuf_QueryField(fldname, dims, result, hcoID)
448 : !
449 : ! !USES:
450 : !
451 0 : use ppgrid, only: pcols, pver
452 : use physics_buffer, only: pbuf_get_index
453 :
454 : use spmd_utils, only: iam, masterproc
455 : !
456 : ! !INPUT PARAMETERS:
457 : !
458 : character(len=*), intent(in) :: fldname ! Field name
459 : integer, intent(in) :: dims ! 2 or 3 dimensions data?
460 : integer, intent(in), optional:: hcoID ! Species ID
461 :
462 : logical, intent(out) :: result ! Is field present?
463 : !
464 : ! !REMARKS:
465 : ! Persistence is 'physpkg' for now, which means the fields are alloc/dealloc at
466 : ! the beginning/end of each physics time step.
467 : !
468 : ! It may be necessary to allocate some fields for 'global' to pass data from
469 : ! chemistry back
470 : !
471 : ! !REVISION HISTORY:
472 : ! 25 Feb 2021 - H.P. Lin - Initial version
473 : !EOP
474 : !------------------------------------------------------------------------------
475 : !BOC
476 : !
477 : ! !LOCAL VARIABLES:
478 : !
479 : character(len=*), parameter :: subname = 'HCO_Export_Pbuf_QueryField'
480 : character(len=255) :: fldname_ns
481 :
482 : integer :: spcID, tmpIdx
483 : integer :: RC
484 :
485 : ! Create field name and verify IDs
486 0 : fldname_ns = 'HCO_' // trim(fldname)
487 0 : if(present(hcoID)) then
488 0 : spcID = hcoID
489 : else
490 : spcID = -1
491 : endif
492 :
493 : ! Not found by default
494 0 : result = .false.
495 :
496 : ! Verify if slot occupied
497 0 : if(spcID /= -1) then
498 0 : if(pbuf_idx_map(spcID) /= -233) then
499 0 : result = .true.
500 : endif
501 : else
502 0 : tmpIdx = pbuf_get_index(fldname_ns, RC)
503 0 : if(tmpIdx >= 0) then
504 0 : result = .true.
505 : endif
506 : endif
507 :
508 0 : end subroutine HCO_Export_Pbuf_QueryField
509 : !EOC
510 : !------------------------------------------------------------------------------
511 : ! Harmonized Emissions Component (HEMCO) !
512 : !------------------------------------------------------------------------------
513 : !BOP
514 : !
515 : ! !IROUTINE: HCO_Export_Pbuf_AddField
516 : !
517 : ! !DESCRIPTION: Adds to the physics buffer a HEMCO field for export to the chem-
518 : ! istry. We wrap this here so we can control the persistence and add a prefix.
519 : !\\
520 : !\\
521 : ! !INTERFACE:
522 : !
523 0 : subroutine HCO_Export_Pbuf_AddField(fldname, dims, hcoID)
524 : !
525 : ! !USES:
526 : !
527 0 : use ppgrid, only: pcols, pver
528 : use physics_buffer, only: pbuf_add_field
529 : use physics_buffer, only: pbuf_get_chunk, pbuf_get_field, pbuf_get_index
530 :
531 : use spmd_utils, only: iam, masterproc
532 : !
533 : ! !INPUT PARAMETERS:
534 : !
535 : character(len=*), intent(in) :: fldname ! Field name
536 : integer, intent(in) :: dims ! 2 or 3 dimensions data?
537 : integer, intent(in), optional:: hcoID ! Species ID
538 : !
539 : ! !REMARKS:
540 : ! Persistence is 'physpkg' for now, which means the fields are alloc/dealloc at
541 : ! the beginning/end of each physics time step.
542 : !
543 : ! We add a prefix hco_ to all the fields, to prevent namespace clashing.
544 : !
545 : ! All fields are exported in CAM grid format, either 2D or 3D.
546 : !
547 : ! Now playing: Lemon
548 : ! "Ima demo anata wa watashi no hikari" / Even now you are still my light
549 : !
550 : ! !REVISION HISTORY:
551 : ! 10 Apr 2020 - H.P. Lin - Initial version
552 : !EOP
553 : !------------------------------------------------------------------------------
554 : !BOC
555 : !
556 : ! !LOCAL VARIABLES:
557 : !
558 : character(len=*), parameter :: subname = 'HCO_Export_Pbuf_AddField'
559 : character(len=255) :: fldname_ns
560 :
561 : integer :: spcID, tmpIdx
562 :
563 : ! Create field name and verify IDs
564 0 : fldname_ns = 'HCO_' // trim(fldname)
565 0 : if(present(hcoID)) then
566 0 : spcID = hcoID
567 : else
568 0 : spcID = -1
569 : endif
570 :
571 : ! Verify if slot free
572 0 : if(spcID /= -1) then
573 0 : ASSERT_(pbuf_idx_map(spcID) == -233)
574 : endif
575 :
576 : ! Add to pbuf field
577 0 : if(dims == 2) then
578 : call pbuf_add_field(trim(fldname_ns), 'physpkg', dtype_r8, &
579 0 : (/pcols/), tmpIdx)
580 0 : elseif(dims == 3) then
581 : call pbuf_add_field(trim(fldname_ns), 'physpkg', dtype_r8, &
582 0 : (/pcols,pver/), tmpIdx)
583 : else
584 0 : ASSERT_(.false.)
585 : endif
586 :
587 : ! Save field to mapping
588 0 : if(spcID /= -1) then
589 0 : pbuf_idx_map(spcID) = tmpIdx
590 : endif
591 :
592 : ! Log
593 0 : if(masterproc) write(iulog,*) "Added field " // trim(fldname_ns) // " to physpkg pbuf, idx", tmpidx, "spcID", spcID, "dim'l", dims
594 :
595 0 : end subroutine HCO_Export_Pbuf_AddField
596 : !EOC
597 : !------------------------------------------------------------------------------
598 : ! Harmonized Emissions Component (HEMCO) !
599 : !------------------------------------------------------------------------------
600 : !BOP
601 : !
602 : ! !IROUTINE: HCO_Export_Pbuf_CAM3D
603 : !
604 : ! !DESCRIPTION: Adds to the physics buffer a HEMCO field for export to the chem-
605 : ! istry. We wrap this here so we can control the persistence and add a prefix.
606 : !\\
607 : !\\
608 : ! !INTERFACE:
609 : !
610 0 : subroutine HCO_Export_Pbuf_CAM3D(fldname, hcoID, array)
611 : !
612 : ! !USES:
613 : !
614 : use ppgrid, only: pcols, pver
615 : use phys_grid, only: get_ncols_p
616 0 : use ppgrid, only: begchunk, endchunk
617 : use physics_buffer, only: pbuf_get_chunk, pbuf_get_field, pbuf_get_index
618 :
619 : use spmd_utils, only: iam, masterproc
620 : !
621 : ! !INPUT PARAMETERS:
622 : !
623 : character(len=*), intent(in) :: fldname ! Field name
624 : integer, intent(in), optional:: hcoID ! Species ID
625 : real(r8), intent(in) :: array(1:LM, 1:my_CE)
626 : !
627 : ! !REMARKS:
628 : ! pcols: maximum number of columns in a chunk
629 : ! each pbuf is independent in each chunk, so write chunk-by-chunk, column-by-column
630 : !
631 : ! The pointer copy of pbuf2d is right there at the top of the module.
632 : ! It is updated at every time step by hemco_interface::HCOI_Chunk_Run, for lack of a
633 : ! better method to propagate it to inside the gridded component.
634 : !
635 : ! !REVISION HISTORY:
636 : ! 10 Apr 2020 - H.P. Lin - Initial version
637 : !EOP
638 : !------------------------------------------------------------------------------
639 : !BOC
640 : !
641 : ! !LOCAL VARIABLES:
642 : !
643 : character(len=*), parameter :: subname = 'HCO_Export_Pbuf_CAM3D'
644 : character(len=255) :: fldname_ns
645 :
646 : integer :: spcID, tmpIdx
647 :
648 : integer :: lchnk, ncol
649 : integer :: I, K, J
650 : integer :: RC
651 0 : type(physics_buffer_desc), pointer :: pbuf_chnk(:) ! slice of pbuf in chnk
652 0 : real(r8), pointer :: pbuf_ik(:,:) ! Pointer to pbuf data (/pcols,pver/)
653 :
654 : ! Create field name and verify IDs
655 0 : fldname_ns = 'HCO_' // trim(fldname)
656 0 : if(present(hcoID)) then
657 0 : spcID = hcoID
658 : else
659 0 : spcID = -1
660 : endif
661 :
662 : ! Verify if slot occupied
663 0 : if(spcID /= -1) then
664 0 : if(pbuf_idx_map(spcID) == -233) then
665 0 : if(masterproc) write(iulog,*) "HCO_Export_Pbuf_CAM3D: Field not found", spcID, fldname_ns
666 0 : return
667 : endif
668 0 : tmpIdx = pbuf_idx_map(spcID)
669 : else
670 0 : tmpIdx = pbuf_get_index(fldname_ns, RC)
671 0 : if(tmpIdx < 0) then
672 0 : if(masterproc) write(iulog,*) "HCO_Export_Pbuf_CAM3D: Field not found", spcID, fldname_ns
673 0 : return
674 : endif
675 : endif
676 :
677 : ! For all chunks on this PET
678 0 : J = 0
679 0 : do lchnk = begchunk, endchunk
680 0 : ncol = get_ncols_p(lchnk)
681 0 : pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, lchnk) ! slice of pbuf for this chnk
682 :
683 : ! Get this pointer from pbuf
684 0 : call pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_ik)
685 :
686 0 : if(.not. associated(pbuf_ik)) then
687 : ! Uh-oh, potentially fatal. Throw a tantrum
688 0 : write(6,*) "HCO_Export_Pbuf_CAM3D: FATAL at lchnk", lchnk, " unassoc pbuf_get_field" // trim(fldname_ns) // " idx:", tmpIdx
689 0 : ASSERT_(.false.)
690 : endif
691 :
692 : ! For all columns in each chunk, organize the data
693 0 : do I = 1, ncol
694 0 : J = J + 1 ! Advance one column in the physics mesh array
695 0 : do K = 1, pver
696 0 : pbuf_ik(I, K) = array(K, J)
697 : enddo
698 : enddo
699 :
700 : ! Nullify the field to prevent dangling stuff
701 0 : nullify(pbuf_ik)
702 : enddo
703 0 : end subroutine HCO_Export_Pbuf_CAM3D
704 : !EOC
705 : !------------------------------------------------------------------------------
706 : ! Harmonized Emissions Component (HEMCO) !
707 : !------------------------------------------------------------------------------
708 : !BOP
709 : !
710 : ! !IROUTINE: HCO_Export_Pbuf_CAM2D
711 : !
712 : ! !DESCRIPTION: Adds to the physics buffer a HEMCO field for export to the chem-
713 : ! istry. We wrap this here so we can control the persistence and add a prefix.
714 : !\\
715 : !\\
716 : ! !INTERFACE:
717 : !
718 0 : subroutine HCO_Export_Pbuf_CAM2D(fldname, hcoID, array)
719 : !
720 : ! !USES:
721 : !
722 : use ppgrid, only: pcols, pver
723 : use phys_grid, only: get_ncols_p
724 0 : use ppgrid, only: begchunk, endchunk
725 : use physics_buffer, only: pbuf_get_chunk, pbuf_get_field, pbuf_get_index
726 :
727 : use spmd_utils, only: iam, masterproc
728 : !
729 : ! !INPUT PARAMETERS:
730 : !
731 : character(len=*), intent(in) :: fldname ! Field name
732 : integer, intent(in), optional:: hcoID ! Species ID
733 : real(r8), intent(in) :: array(1:my_CE)
734 : !
735 : ! !REMARKS:
736 : ! Read remarks at the CAM3D subroutine. This is the 2-D version (1-D in CAM speak)
737 : !
738 : ! !REVISION HISTORY:
739 : ! 25 Feb 2021 - H.P. Lin - Initial version
740 : !EOP
741 : !------------------------------------------------------------------------------
742 : !BOC
743 : !
744 : ! !LOCAL VARIABLES:
745 : !
746 : character(len=*), parameter :: subname = 'HCO_Export_Pbuf_CAM2D'
747 : character(len=255) :: fldname_ns
748 :
749 : integer :: spcID, tmpIdx
750 :
751 : integer :: lchnk, ncol
752 : integer :: I, J
753 : integer :: RC
754 0 : type(physics_buffer_desc), pointer :: pbuf_chnk(:) ! slice of pbuf in chnk
755 0 : real(r8), pointer :: pbuf_i(:) ! Pointer to pbuf data (/pcols/)
756 :
757 : ! Create field name and verify IDs
758 0 : fldname_ns = 'HCO_' // trim(fldname)
759 0 : if(present(hcoID)) then
760 0 : spcID = hcoID
761 : else
762 0 : spcID = -1
763 : endif
764 :
765 : ! Verify if slot occupied
766 0 : if(spcID /= -1) then
767 0 : if(pbuf_idx_map(spcID) == -233) then
768 0 : if(masterproc) write(iulog,*) "HCO_Export_Pbuf_CAM2D: Field not found", spcID, fldname_ns
769 0 : return
770 : endif
771 0 : tmpIdx = pbuf_idx_map(spcID)
772 : else
773 0 : tmpIdx = pbuf_get_index(fldname_ns, RC)
774 0 : if(tmpIdx < 0) then
775 0 : if(masterproc) write(iulog,*) "HCO_Export_Pbuf_CAM2D: Field not found", spcID, fldname_ns
776 0 : return
777 : endif
778 : endif
779 :
780 : ! For all chunks on this PET
781 0 : J = 0
782 0 : do lchnk = begchunk, endchunk
783 0 : ncol = get_ncols_p(lchnk)
784 0 : pbuf_chnk => pbuf_get_chunk(hco_pbuf2d, lchnk) ! slice of pbuf for this chnk
785 :
786 : ! Get this pointer from pbuf
787 0 : call pbuf_get_field(pbuf_chnk, tmpIdx, pbuf_i)
788 :
789 0 : if(.not. associated(pbuf_i)) then
790 : ! Uh-oh, potentially fatal. Throw a tantrum
791 0 : write(6,*) "HCO_Export_Pbuf_CAM2D: FATAL at lchnk", lchnk, " unassoc pbuf_get_field" // trim(fldname_ns) // " idx:", tmpIdx
792 0 : ASSERT_(.false.)
793 : endif
794 :
795 : ! For all columns in each chunk, organize the data
796 0 : do I = 1, ncol
797 0 : J = J + 1 ! Advance one column in the physics mesh array
798 0 : pbuf_i(I) = array(J)
799 : enddo
800 :
801 : ! Nullify the field to prevent dangling stuff
802 0 : nullify(pbuf_i)
803 : enddo
804 0 : end subroutine HCO_Export_Pbuf_CAM2D
805 : !EOC
806 : end module hco_cam_exports
|
