LCOV - code coverage report
Current view: | top level - control - cam_budget.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 17 | 135 | 12.6 %
Date: | 2025-01-13 21:54:50 |  | Functions: | 2 | 7 | 28.6 %

              Line data    Source code
           1             : module cam_budget
           2             :   !----------------------------------------------------------------------------
           3             :   !
           4             :   ! Adds support for energy and mass snapshots and budgets using cam_history api.
           5             :   !
           6             :   ! Public functions/subroutines:
           7             :   !
           8             :   ! cam_budget_init
           9             :   ! cam_budget_em_snapshot
          10             :   ! cam_budget_em_register
          11             :   ! cam_budget_get_global
          12             :   ! cam_budget_readnl
          13             :   ! budget_ind_byname
          14             :   ! is_cam_budget
          15             :   !-----------------------------------------------------------------------
          16             :
          17             :   use cam_abortutils,      only: endrun
          18             :   use cam_history,         only: addfld, add_default, horiz_only
          19             :   use cam_history_support, only: max_fieldname_len
          20             :   use cam_logfile,         only: iulog
          21             :   use cam_thermo,          only: thermo_budget_vars, thermo_budget_vars_descriptor, &
          22             :        thermo_budget_vars_unit, thermo_budget_vars_massv, thermo_budget_num_vars,teidx,wvidx,wlidx,wiidx
          23             :   use shr_kind_mod,        only: r8 => shr_kind_r8
          24             :   use shr_kind_mod,        only: cl => shr_kind_cl
          25             :   use spmd_utils,          only: masterproc, masterprocid, mpicom
          26             :
          27             :   implicit none
          28             :   private
          29             :   save
          30             :
          31             :   ! Public interfaces
          32             :   public :: &
          33             :        cam_budget_init,       &! initialize budget variables
          34             :        cam_budget_em_snapshot,   &! define a snapshot and add to history buffer
          35             :        cam_budget_em_register,     &! define a budget and add to history buffer
          36             :        cam_budget_get_global,     &! get global budget from history buffer
          37             :        cam_budget_readnl,         &! read budget namelist setting
          38             :        is_cam_budget               ! return logical if budget_defined
          39             :
          40             :   ! Private
          41             :   real(r8)                             :: dstepsize
          42             :   integer, parameter                   :: budget_array_max  = 500                 ! max number of budgets
          43             :   character*3                          :: budget_optype(budget_array_max)  = ''   ! allows 'dif' or 'sum'
          44             :   character*3                          :: budget_pkgtype(budget_array_max) = ''   ! allows 'phy' or 'dyn'
          45             :
          46             :   ! Public data
          47             :   integer,           public, protected :: budget_num     = 0                      ! current number of defined budgets.
          48             :   character(cl),     public, protected :: budget_name(budget_array_max)     = ''  ! budget names
          49             :   character(cl),     public, protected :: budget_longname(budget_array_max) = ''  ! descriptive name of budget
          50             :   character(cl),     public, protected :: budget_stagename(budget_array_max)= ''  ! shortname of both of the 3 char snapshot components
          51             :   character(cl),     public, protected :: budget_stg1name(budget_array_max) = ''  ! The 1st of 2 snapshots used to calculate a budget
          52             :   character(cl),     public, protected :: budget_stg2name(budget_array_max) = ''  ! The 2nd of 2 snapshots used to calculate a budget
          53             :
          54             :   integer,           public, protected :: thermo_budget_histfile_num = 1          ! The history tape number for budget fields
          55             :   logical,           public, protected :: thermo_budget_history = .false.         ! Turn budgeting on or off
          56             :
          57             :
          58             :   !==============================================================================================
          59             : CONTAINS
          60             :   !==============================================================================================
          61             :   !
          62             :   ! Read namelist variables.
          63        1536 :   subroutine cam_budget_readnl(nlfile)
          64             :     use dycore,          only: dycore_is
          65             :     use namelist_utils,  only: find_group_name
          66             :     use spmd_utils,      only: mpi_character, mpi_logical, mpi_integer, mpi_success
          67             :     use shr_string_mod,  only: shr_string_toUpper
          68             :     use string_utils,    only: int2str
          69             :
          70             :     ! Dummy argument: filepath for file containing namelist input
          71             :     character(len=*), intent(in) :: nlfile
          72             :
          73             :     ! Local variables
          74             :     integer                     :: unitn, ierr
          75             :     character(len=*), parameter :: subname = 'cam_budget_readnl :: '
          76             :
          77             :     namelist /thermo_budget_nl/  thermo_budget_history, thermo_budget_histfile_num
          78             :     !-----------------------------------------------------------------------
          79             :
          80        1536 :     if (masterproc) then
          81           2 :        open(newunit=unitn, file=trim(nlfile), status='old')
          82           2 :        call find_group_name(unitn, 'thermo_budget_nl', status=ierr)
          83           2 :        if (ierr == 0) then
          84           0 :           read(unitn, thermo_budget_nl, iostat=ierr)
          85           0 :           if (ierr /= 0) then
          86           0 :              call endrun(subname//'ERROR reading namelist, thermo_budget_nl, errcode = '//int2str(ierr))
          87             :           end if
          88             :        end if
          89           2 :        close(unitn)
          90             :     end if
          91             :
          92             :     ! Broadcast namelist variables
          93        1536 :     call mpi_bcast(thermo_budget_history         , 1  , mpi_logical  , masterprocid, mpicom, ierr)
          94        1536 :     if (ierr /= mpi_success) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_history")
          95        1536 :     call mpi_bcast(thermo_budget_histfile_num    , 1  , mpi_integer  , masterprocid, mpicom, ierr)
          96        1536 :     if (ierr /= mpi_success) call endrun(subname//": FATAL: mpi_bcast: thermo_budget_histfile_num")
          97             :
          98             :     ! Write out thermo_budget options
          99        1536 :     if (masterproc) then
         100           2 :        if (thermo_budget_history) then
         101           0 :           if (dycore_is('EUL').or.dycore_is('FV').or.dycore_is('FV3')) then
         102           0 :              call endrun(subname//'ERROR thermodynamic budgets not implemented for this dycore')
         103             :           else
         104           0 :              write(iulog,*)'Thermo budgets will be written to the log file and diagnostics saved to history file:',&
         105           0 :                thermo_budget_histfile_num
         106             :           end if
         107             :        end if
         108             :     end if
         109        1536 :   end subroutine cam_budget_readnl
         110             :
         111             :   !==============================================================================================
         112             :
         113        1536 :   subroutine cam_budget_init()
         114             :     use time_manager,         only:  get_step_size
         115             :
         116        1536 :     dstepsize=get_step_size()
         117             :
         118        1536 :   end subroutine cam_budget_init
         119             :
         120             :   !==============================================================================================
         121             :
         122           0 :   subroutine cam_budget_em_snapshot (name, pkgtype, longname)
         123        1536 :     use dycore,           only: dycore_is
         124             :     use cam_grid_support, only: cam_grid_id
         125             :
         126             :     character(len=*), intent(in)           :: &
         127             :          name      ! budget name used as variable name in history file output (8 char max)
         128             :     character(len=*), intent(in)           :: &
         129             :          pkgtype      ! budget type either phy or dyn
         130             :     character(len=*), intent(in)           :: &
         131             :          longname    ! value for long_name attribute in netcdf output (128 char max, defaults to name)
         132             :
         133             :     character (cl)                         :: errmsg
         134             :     character (len=max_fieldname_len)      :: name_str
         135             :     character (cl)                         :: desc_str, units_str
         136             :     character (cl)                         :: gridname
         137             :     integer                                :: ivars
         138             :     character(len=*), parameter            :: sub='cam_budget_em_snapshot'
         139             :     logical                                :: use_cslam        ! using cslam transport for mass tracers
         140             :     !-----------------------------------------------------------------------
         141             :
         142           0 :     if (thermo_budget_history) then
         143             :        ! FVM grid is only registered when using cslam
         144           0 :        use_cslam=cam_grid_id('FVM')>0
         145             :
         146           0 :        do ivars=1, thermo_budget_num_vars
         147           0 :           write(name_str,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(name))
         148           0 :           write(desc_str,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", &
         149           0 :                TRIM(ADJUSTL(longname))
         150           0 :           write(units_str,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars)))
         151             :
         152           0 :           if (budget_num < budget_array_max) then
         153           0 :              budget_num = budget_num + 1
         154             :           else
         155           0 :              write(errmsg, *) sub, ': Maximum number of budgets reached - increase budget_array_max parameter '
         156           0 :              call endrun(errmsg)
         157             :           end if
         158             :           ! set budget name and constants
         159           0 :           budget_name(budget_num) = trim(name_str)
         160           0 :           budget_longname(budget_num) = trim(desc_str)
         161             :
         162           0 :           budget_pkgtype(budget_num)=pkgtype
         163           0 :           budget_stagename(budget_num)= trim(name)
         164             :
         165           0 :           if (pkgtype=='phy') then
         166           0 :              gridname='physgrid'
         167             :           else
         168           0 :              if (dycore_is('SE')) then
         169           0 :                 if (use_cslam .and. thermo_budget_vars_massv(ivars)) then
         170           0 :                    gridname='FVM'
         171             :                 else
         172           0 :                    gridname='GLL'
         173             :                 end if
         174           0 :              else if (dycore_is('MPAS')) then
         175           0 :                  gridname='mpas_cell'
         176             :              else
         177           0 :                 write(errmsg, *) sub, ': budget_add is only supported for MPAS and SE dycores'
         178           0 :                 call endrun(errmsg)
         179             :              end if
         180             :           end if
         181             :           call addfld (TRIM(ADJUSTL(name_str)), horiz_only, 'N', TRIM(ADJUSTL(units_str)), &
         182           0 :                        TRIM(ADJUSTL(desc_str)), gridname=trim(gridname))
         183           0 :           call add_default(TRIM(ADJUSTL(name_str)), thermo_budget_histfile_num, 'N')
         184             :        end do
         185             :     end if
         186           0 :   end subroutine cam_budget_em_snapshot
         187             :
         188             :   !==============================================================================
         189             :
         190           0 :   subroutine cam_budget_em_register (name, stg1name, stg2name, pkgtype, optype, longname)
         191           0 :     use dycore,           only: dycore_is
         192             :     use cam_grid_support, only: cam_grid_id
         193             :
         194             :     ! Register a budget.
         195             :
         196             :     character(len=*), intent(in) :: &
         197             :          name,stg1name,stg2name   ! budget name used as variable name in history file output (8 char max)
         198             :
         199             :     character(len=*), intent(in) :: &
         200             :          pkgtype    ! budget type either phy or dyn
         201             :
         202             :     character(len=*), intent(in) :: &
         203             :          optype    !  dif (difference) or sum
         204             :
         205             :     character(len=*), intent(in) :: &
         206             :          longname    ! value for long_name attribute in netcdf output (128 char max, defaults to name)
         207             :
         208             :     character(len=*), parameter            :: sub='cam_budget_em_register'
         209             :     character(cl)                          :: errmsg
         210             :     character(len=1)                       :: opchar
         211             :     character (len=max_fieldname_len)      :: name_str
         212             :     character (cl)                         :: desc_str, units_str
         213             :     character (cl)                         :: gridname
         214             :     character (cl)                         :: strstg1, strstg2
         215             :     integer                                :: ivars
         216             :     logical                                :: use_cslam       ! true => use cslam to transport mass variables
         217             :     !-----------------------------------------------------------------------
         218             :
         219           0 :     if (thermo_budget_history) then
         220             :        ! the FVM gridname is only defined when use_cslam is true.
         221           0 :        use_cslam=cam_grid_id('FVM')>0
         222             :
         223             :        ! register history budget variables
         224           0 :        do ivars=1, thermo_budget_num_vars
         225           0 :           write(name_str,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(name))
         226           0 :           write(strstg1,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(stg1name))
         227           0 :           write(strstg2,*) TRIM(ADJUSTL(thermo_budget_vars(ivars))),"_",TRIM(ADJUSTL(stg2name))
         228           0 :           write(desc_str,*) TRIM(ADJUSTL(thermo_budget_vars_descriptor(ivars)))," ", &
         229           0 :                TRIM(ADJUSTL(longname))
         230           0 :           write(units_str,*) TRIM(ADJUSTL(thermo_budget_vars_unit(ivars)))
         231             :
         232           0 :           if (budget_num < budget_array_max) then
         233           0 :              budget_num = budget_num + 1
         234             :           else
         235           0 :              write(errmsg, *) sub, ': Maximum number of budgets reached - increase budget_array_max parameter '
         236           0 :              call endrun(errmsg)
         237             :           end if
         238           0 :           budget_pkgtype(budget_num)=pkgtype
         239             :
         240             :           ! set budget name and constants
         241           0 :           budget_name(budget_num) = trim(name_str)
         242           0 :           budget_longname(budget_num) = trim(desc_str)
         243             :
         244           0 :           if (optype=='dif') then
         245           0 :              opchar='-'
         246           0 :           else if (optype=='sum') then
         247           0 :              opchar='+'
         248             :           else
         249           0 :              write(errmsg,*) sub, ': FATAL: unknown operation type, expecting "sum" or "dif":', optype
         250           0 :              call endrun(errmsg)
         251             :           end if
         252           0 :           budget_stg1name(budget_num) = trim(adjustl(strstg1))
         253           0 :           budget_stg2name(budget_num) = trim(adjustl(strstg2))
         254           0 :           budget_stagename(budget_num)= trim(adjustl(strstg1))//trim(opchar)//trim(adjustl(strstg2))
         255           0 :           budget_optype(budget_num)=optype
         256             :
         257           0 :           if (pkgtype=='phy') then
         258           0 :             gridname='physgrid'
         259             :           else
         260           0 :              if (dycore_is('SE')) then
         261           0 :                 if (use_cslam .and. thermo_budget_vars_massv(ivars)) then
         262           0 :                    gridname='FVM'
         263             :                 else
         264           0 :                    gridname='GLL'
         265             :                 end if
         266           0 :              else if (dycore_is('MPAS')) then
         267           0 :                 gridname='mpas_cell'
         268             :              else
         269           0 :                 write(errmsg, *) sub, ': budget_add is only supported for MPAS and SE dycores'
         270           0 :                 call endrun(errmsg)
         271             :              end if
         272             :           end if
         273             :           call addfld (TRIM(ADJUSTL(name_str)),   horiz_only, 'N', TRIM(ADJUSTL(units_str)),TRIM(ADJUSTL(desc_str)), &
         274           0 :                gridname=gridname,optype=optype,op_f1name=TRIM(ADJUSTL(strstg1)),op_f2name=TRIM(ADJUSTL(strstg2)))
         275           0 :           call add_default(TRIM(ADJUSTL(name_str)), thermo_budget_histfile_num, 'N')
         276             :        end do
         277             :     end if
         278           0 :   end subroutine cam_budget_em_register
         279             :
         280             :   !==============================================================================
         281             :
         282           0 :   subroutine cam_budget_get_global (name, me_idx, global)
         283             :
         284           0 :     use cam_history,          only: get_field_properties
         285             :     use cam_history_support,  only: active_entry,ptapes
         286             :     use cam_thermo,           only: thermo_budget_vars_massv
         287             :
         288             :     ! Get the global integral of a budget. Endrun will be called
         289             :     ! when name is not found.
         290             :     !-----------------------------Arguments---------------------------------
         291             :     character(len=*),  intent(in)  :: name    ! budget name
         292             :     integer,           intent(in)  :: me_idx  ! mass energy variable index
         293             :     real(r8),          intent(out) :: global  ! global integral of the budget field
         294             :
         295             :     !---------------------------Local workspace-----------------------------
         296           0 :     type (active_entry), pointer   :: tape(:)                    ! history tapes
         297             :     character (len=max_fieldname_len) :: name_str
         298             :     character(cl)                  :: errmsg
         299             :     integer                        :: b_ind                      ! budget index
         300             :     integer                        :: h_ind(ptapes)              ! hentry index
         301             :     integer                        :: m_ind                      ! masterlist index
         302             :     integer                        :: idx,pidx,midx,uidx         ! substring index for sum dif char
         303             :     integer                        :: m                          ! budget index
         304             :     logical                        :: found                      ! true if global integral found
         305             :
         306             :     character(len=*), parameter    :: sub='cam_budget_get_global'
         307             :     !-----------------------------------------------------------------------
         308             :     ! Initialize tape pointer here to avoid initialization only on first invocation
         309           0 :     nullify(tape)
         310             :
         311           0 :     name_str=''
         312           0 :     write(name_str,*) TRIM(ADJUSTL(name))
         313             :
         314           0 :     midx=index(name_str, '-')
         315           0 :     pidx=index(name_str, '+')
         316           0 :     idx=midx+pidx
         317             :
         318             :     ! check for budget using stagename short format (stg1//op//stg2) where stg1 is name without thermo string appended
         319           0 :     if (idx /= 0 .and. (midx==0 .or. pidx==0)) then
         320           0 :        write(name_str,*) TRIM(ADJUSTL(thermo_budget_vars(me_idx)))//"_"//trim(adjustl(name_str(1:idx)))// &
         321           0 :             TRIM(ADJUSTL(thermo_budget_vars(me_idx)))//"_"//TRIM(ADJUSTL(name_str(idx+1:)))
         322             :     end if
         323             :
         324           0 :     uidx=index(name_str, '_')
         325           0 :     if (uidx == 0) then
         326             :        !This is a stage name need to append the type of thermo variable using input index
         327           0 :        write(name_str,*) TRIM(ADJUSTL(thermo_budget_vars(me_idx)))//"_"//trim(adjustl(name_str(1:)))
         328             :     end if
         329             :
         330           0 :     b_ind=budget_ind_byname(trim(adjustl(name_str)))
         331             :
         332           0 :     if (b_ind < 0) call endrun(sub//': FATAL field name '//name//' not found'//' looked for '//trim(adjustl(name_str)))
         333             :
         334           0 :     write(name_str,*) TRIM(ADJUSTL(budget_name(b_ind)))
         335             :
         336             :     ! Find budget name in list and return global value
         337           0 :     call get_field_properties(trim(adjustl(name_str)), found, tape_out=tape, ff_out=m_ind, f_out=h_ind)
         338             :
         339           0 :     if (found.and.h_ind(thermo_budget_histfile_num)>0) then
         340           0 :        call tape(thermo_budget_histfile_num)%hlist(h_ind(thermo_budget_histfile_num))%get_global(global)
         341           0 :        if (.not. thermo_budget_vars_massv(me_idx)) &
         342           0 :             global=global/dstepsize
         343             :     else
         344           0 :        write(errmsg,*) sub, ': FATAL: name not found: ', trim(name)
         345           0 :        call endrun(errmsg)
         346             :     end if
         347             :
         348             :   CONTAINS
         349           0 :     pure function budget_ind_byname (name)
         350             :       !
         351             :       ! Get the index of a budget.  Ret -1 for not found
         352             :       !-----------------------------Arguments---------------------------------
         353             :       character(len=*),  intent(in)  :: name  ! budget name
         354             :
         355             :       !---------------------------Local workspace-----------------------------
         356             :       integer                        :: budget_ind_byname   ! function return
         357             :       integer                        :: m                   ! budget index
         358             :       !-----------------------------------------------------------------------
         359             :       ! Find budget name in list
         360           0 :       budget_ind_byname  = -1
         361           0 :       do m = 1, budget_num
         362           0 :          if (trim(adjustl(name)) == trim(adjustl(budget_name(m))).or. &
         363           0 :              trim(adjustl(name)) == trim(adjustl(budget_stagename(m)))) then
         364           0 :             budget_ind_byname  = m
         365           0 :             return
         366             :          end if
         367             :       end do
         368           0 :     end function budget_ind_byname
         369             :   end subroutine cam_budget_get_global
         370             :   !==============================================================================
         371             :
         372           0 :   pure function is_cam_budget(name)
         373             :
         374             :     ! Get the index of a budget.
         375             :
         376             :     !-----------------------------Arguments---------------------------------
         377             :     character(len=*),  intent(in)  :: name  ! budget name
         378             :
         379             :     !---------------------------Local workspace-----------------------------
         380             :     logical                        :: is_cam_budget           ! function return
         381             :     integer                        :: m                   ! budget index
         382             :     !-----------------------------------------------------------------------
         383             :
         384             :     ! Find budget name in list of defined budgets
         385             :
         386           0 :     is_cam_budget = .false.
         387           0 :     do m = 1, budget_num
         388           0 :        if (trim(adjustl(name)) == trim(adjustl(budget_name(m))).or. &
         389           0 :            trim(adjustl(name)) == trim(adjustl(budget_stagename(m)))) then
         390           0 :           is_cam_budget = .true.
         391           0 :           return
         392             :        end if
         393             :     end do
         394           0 :   end function is_cam_budget
         395             :
         396             :   !===========================================================================
         397             :
         398             : end module cam_budget

Generated by: LCOV version 1.14