LCOV - code coverage report
Current view: | top level - physics/cam - dadadj_cam.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 35 | 46 | 76.1 %
Date: | 2025-01-13 21:54:50 |  | Functions: | 3 | 3 | 100.0 %

              Line data    Source code
           1             : module dadadj_cam
           2             :
           3             : ! CAM interfaces for the dry adiabatic adjustment parameterization
           4             :
           5             : use shr_kind_mod,    only: r8=>shr_kind_r8, cs=>shr_kind_cs, cm=>shr_kind_cm
           6             : use ppgrid,          only: pcols, pver, pverp
           7             : use constituents,    only: pcnst
           8             : use air_composition, only: cappav, cpairv
           9             : use physconst,       only: pi
          10             : use physics_types,   only: physics_state, physics_ptend, physics_ptend_init
          11             : use phys_control,    only: use_simple_phys
          12             : use cam_abortutils,  only: endrun
          13             : use cam_logfile,     only: iulog
          14             : use error_messages,  only: handle_errmsg
          15             :
          16             : use spmd_utils,      only: masterproc, masterprocid, mpicom, mpi_integer
          17             : use namelist_utils,  only: find_group_name
          18             : use units,           only: getunit, freeunit
          19             :
          20             : use dadadj,          only: dadadj_init, dadadj_run
          21             :
          22             : implicit none
          23             : private
          24             : save
          25             :
          26             : public :: &
          27             :    dadadj_readnl, &
          28             :    dadadj_cam_init, &
          29             :    dadadj_tend
          30             :
          31             : ! Namelist variables
          32             : integer :: dadadj_nlvdry = 3  ! number of layers from top of model to apply the adjustment
          33             : integer :: dadadj_niter = 15  ! number of iterations for convergence
          34             :
          35             : !===============================================================================
          36             : contains
          37             : !===============================================================================
          38             :
          39        1536 : subroutine dadadj_readnl(filein)
          40             :
          41             :    character(len=cs), intent(in) :: filein ! Input namelist filename
          42             :
          43             :    namelist /dadadj_nl/ dadadj_nlvdry, dadadj_niter
          44             :
          45             :    integer                            :: unitn, ierr
          46             :    integer                            :: errflg             ! CCPP physics scheme error flag
          47             :    character(len=512)                 :: errmsg             ! CCPP physics scheme error message
          48             :    character(len=*), parameter        :: sub='dadadj_readnl'
          49             :    !------------------------------------------------------------------
          50             :
          51             :    ! Read namelist
          52        1536 :    if (masterproc) then
          53           2 :       unitn = getunit()
          54           2 :       open(unitn, file=trim(filein), status='old')
          55           2 :       call find_group_name(unitn, 'dadadj_nl', status=ierr)
          56           2 :       if (ierr == 0) then
          57           0 :          read(unitn, dadadj_nl, iostat=ierr)
          58           0 :          if (ierr /= 0) then
          59           0 :             call endrun( sub//':: ERROR reading namelist')
          60             :          end if
          61             :       end if
          62           2 :       close(unitn)
          63           2 :       call freeunit(unitn)
          64             :    end if
          65             :
          66             : #ifdef SPMD
          67             :    ! Broadcast namelist variables
          68        1536 :    call mpibcast(dadadj_nlvdry, 1, mpi_integer, masterprocid, mpicom)
          69        1536 :    call mpibcast(dadadj_niter, 1, mpi_integer, masterprocid, mpicom)
          70             : #endif
          71             :
          72        1536 :    call dadadj_init(dadadj_nlvdry, dadadj_niter, pver, errmsg, errflg)
          73        1536 :    if (errflg /=0) then
          74           0 :       call endrun('dadadj_readnl: Error returned from dadadj_init: '//trim(errmsg))
          75             :    end if
          76             :
          77        1536 :    if (masterproc .and. .not. use_simple_phys) then
          78           2 :       write(iulog,*)'Dry adiabatic adjustment applied to top N layers; N=', &
          79           4 :            dadadj_nlvdry
          80           2 :       write(iulog,*)'Dry adiabatic adjustment number of iterations for convergence =', &
          81           4 :            dadadj_niter
          82             :    end if
          83             :
          84        1536 : end subroutine dadadj_readnl
          85             :
          86             :
          87             : !===============================================================================
          88             :
          89        1536 : subroutine dadadj_cam_init()
          90             :     use cam_history,   only: addfld
          91             :
          92        3072 :     call addfld('DADADJ_PD', (/ 'lev' /), 'A', 'probability', 'dry adiabatic adjustment probability')
          93             :
          94        1536 : end subroutine dadadj_cam_init
          95             :
          96             :
          97             : !===============================================================================
          98             :
          99     5981472 : subroutine dadadj_tend(dt, state, ptend)
         100        1536 :    use cam_history,   only: outfld
         101             :
         102             :    real(r8),                  intent(in)  :: dt         ! Time step [s]
         103             :    type(physics_state),       intent(in)  :: state      ! Physics state variables
         104             :    type(physics_ptend),       intent(out) :: ptend      ! parameterization tendencies
         105             :
         106             :    character(len=512)                     :: errstring  ! Error string
         107             :    character(len=512)                     :: errmsg     ! CCPP physics scheme error message
         108             :    character(len=64)                      :: scheme_name! CCPP physics scheme name (not used in CAM)
         109             :    integer                                :: icol_err
         110             :    integer                                :: lchnk
         111             :    integer                                :: ncol
         112             :    integer                                :: errflg     ! CCPP physics scheme error flag
         113             :    logical                                :: lq(pcnst)
         114             :    real(r8)                               :: dadpdf(pcols, pver)
         115             :
         116             :    !------------------------------------------------------------------
         117     1495368 :    ncol  = state%ncol
         118     1495368 :    lchnk = state%lchnk
         119     1495368 :    lq(:) = .FALSE.
         120     1495368 :    lq(1) = .TRUE.
         121     1495368 :    call physics_ptend_init(ptend, state%psetcols, 'dadadj', ls=.true., lq=lq)
         122             :
         123             :    !REMOVECAM - no longer need these when CAM is retired and pcols no longer exists
         124     1495368 :    dadpdf = 0._r8
         125   662448024 :    ptend%s = 0._r8
         126  1988839440 :    ptend%q = 0._r8
         127             :    !REMOVECAM_END
         128             :
         129             :    ! dadadj_run returns t tend, we are passing the ptend%s array to receive the t tendency and will convert it to s
         130             :    ! before it is returned to CAM..
         131             :    call dadadj_run( &
         132           0 :         ncol, pver, dt, state%pmid(:ncol,:), state%pint(:ncol,:), state%pdel(:ncol,:), &
         133           0 :         state%t(:ncol,:), state%q(:ncol,:,1), cappav(:ncol,:,lchnk), cpairv(:ncol,:,lchnk), ptend%s(:ncol,:), &
         134     1495368 :         ptend%q(:ncol,:,1), dadpdf(:ncol,:), scheme_name, errmsg, errflg)
         135             :
         136             :    ! error exit
         137     1495368 :    if (errflg /= 0) then
         138             :       ! If this is a Convergence error then output lat lon of problem column using column index (errflg)
         139           0 :       if(index('Convergence', errmsg) /= 0)then
         140           0 :          write(errstring, *) trim(adjustl(errmsg)),' lat:',state%lat(errflg)*180._r8/pi,' lon:', &
         141           0 :               state%lon(errflg)*180._r8/pi
         142             :       else
         143           0 :          errstring=trim(errmsg)
         144             :       end if
         145           0 :       call endrun('Error dadadj_tend:'//trim(errstring))
         146             :    end if
         147             :
         148   153698328 :    call outfld('DADADJ_PD',  dadpdf(:ncol,:),  ncol, lchnk)
         149             :
         150     1495368 : end subroutine dadadj_tend
         151             :
         152             : !===============================================================================
         153             : end module dadadj_cam

Generated by: LCOV version 1.14