LCOV - code coverage report
Current view: | top level - hemco - hco_cam_exports.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 0 | 152 | 0.0 %
Date: | 2024-12-17 17:57:11 |  | Functions: | 0 | 8 | 0.0 %

              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

Generated by: LCOV version 1.14