LCOV - code coverage report
Current view: | top level - chemistry/mozart - upper_bc_file.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 0 | 67 | 0.0 %
Date: | 2024-12-17 22:39:59 |  | Functions: | 0 | 4 | 0.0 %

              Line data    Source code
           1             : !-------------------------------------------------------------------------------
           2             : ! Manages reading Upper Boundary Conditions (UBCs) from file
           3             : !-------------------------------------------------------------------------------
           4             : module upper_bc_file
           5             :
           6             :   use shr_kind_mod,  only: r8 => shr_kind_r8
           7             :   use shr_kind_mod,  only: cx => shr_kind_cx ! 512
           8             :   use cam_logfile,   only: iulog
           9             :   use spmd_utils,    only: masterproc
          10             :   use cam_abortutils,only: endrun
          11             :   use cam_history,   only: addfld, horiz_only, outfld, fieldname_len
          12             :
          13             :   use tracer_data,   only: trfld,trfile,MAXTRCRS
          14             :
          15             :   implicit none
          16             :   private
          17             :
          18             :   public :: upper_bc_file_readnl ! read namelist options
          19             :   public :: upper_bc_file_init   ! initialize
          20             :   public :: upper_bc_file_adv    ! advance data reader
          21             :   public :: upper_bc_file_get    ! returns UBC values
          22             :   public :: upper_bc_file_specified ! TRUE if UBC file is specified
          23             :
          24             :   logical, protected :: upper_bc_file_specified = .false.
          25             :
          26             :   ! private data members
          27             :   character(len=cx) :: ubc_file_path = 'NONE'
          28             :   character(len=32) :: ubc_file_input_type = 'NONE'
          29             :   integer :: ubc_file_cycle_yr  = -huge(1)
          30             :   integer :: ubc_file_fixed_ymd = -huge(1)
          31             :   integer :: ubc_file_fixed_tod = -huge(1)
          32             :
          33             :   type(trfld), pointer :: fields(:) => null()
          34             :   type(trfile)         :: file
          35             :
          36             :   integer :: num_ubc_flds = 0
          37             :   real(r8), allocatable :: ubc_fact(:)
          38             :   character(len=fieldname_len), allocatable :: hist_names(:)
          39             :
          40             : contains
          41             :
          42             :   !---------------------------------------------------------------------------
          43             :   ! read namelist options
          44             :   !---------------------------------------------------------------------------
          45           0 :   subroutine upper_bc_file_readnl(nlfile)
          46             :     use namelist_utils, only : find_group_name
          47             :     use spmd_utils, only : mpicom, masterprocid, mpi_character, mpi_integer
          48             :
          49             :     character(len=*), intent(in) :: nlfile
          50             :
          51             :     integer :: unitn, ierr
          52             :     character(len=*), parameter :: prefix = 'upper_bc_file_readnl: '
          53             :
          54             :     namelist /upper_bc_file_opts/ ubc_file_path, ubc_file_input_type
          55             :     namelist /upper_bc_file_opts/ ubc_file_cycle_yr, ubc_file_fixed_ymd, ubc_file_fixed_tod
          56             :
          57           0 :     if (masterproc) then
          58             :        ! read namelist
          59           0 :        open( newunit=unitn, file=trim(nlfile), status='old' )
          60           0 :        call find_group_name(unitn, 'upper_bc_file_opts', status=ierr)
          61           0 :        if (ierr == 0) then
          62           0 :           read(unitn, upper_bc_file_opts, iostat=ierr)
          63           0 :           if (ierr /= 0) then
          64           0 :              call endrun(prefix//'upper_bc_file_opts: ERROR reading namelist')
          65             :           end if
          66             :        end if
          67           0 :        close(unitn)
          68             :     end if
          69             :
          70           0 :     call mpi_bcast(ubc_file_path, len(ubc_file_path), mpi_character, masterprocid, mpicom, ierr)
          71           0 :     if (ierr /= 0) call endrun(prefix//'mpi_bcast error : ubc_file_path')
          72           0 :     call mpi_bcast(ubc_file_input_type, len(ubc_file_input_type), mpi_character, masterprocid, mpicom, ierr)
          73           0 :     if (ierr /= 0) call endrun(prefix//'mpi_bcast error : ubc_file_input_type')
          74           0 :     call mpi_bcast(ubc_file_fixed_ymd, 1, mpi_integer, masterprocid, mpicom, ierr)
          75           0 :     if (ierr /= 0) call endrun(prefix//'mpi_bcast error : ubc_file_fixed_ymd')
          76           0 :     call mpi_bcast(ubc_file_fixed_tod, 1, mpi_integer, masterprocid, mpicom, ierr)
          77           0 :     if (ierr /= 0) call endrun(prefix//'mpi_bcast error : ubc_file_fixed_tod')
          78           0 :     call mpi_bcast(ubc_file_cycle_yr,  1, mpi_integer, masterprocid, mpicom, ierr)
          79           0 :     if (ierr /= 0) call endrun(prefix//'mpi_bcast error : ubc_file_cycle_yr')
          80             :
          81           0 :     upper_bc_file_specified = ubc_file_path /= 'NONE'
          82             :
          83           0 :     if (masterproc) then
          84           0 :        write(iulog,*) prefix,'upper_bc_file_specified: ',upper_bc_file_specified
          85           0 :        write(iulog,*) prefix,'ubc_file_path = '//trim(ubc_file_path)
          86           0 :        write(iulog,*) prefix,'ubc_file_input_type = '//trim(ubc_file_input_type)
          87           0 :        write(iulog,*) prefix,'ubc_file_cycle_yr = ',ubc_file_cycle_yr
          88           0 :        write(iulog,*) prefix,'ubc_file_fixed_ymd = ',ubc_file_fixed_ymd
          89           0 :        write(iulog,*) prefix,'ubc_file_fixed_tod = ',ubc_file_fixed_tod
          90             :     end if
          91             :
          92           0 :   end subroutine upper_bc_file_readnl
          93             :
          94             :   !---------------------------------------------------------------------------
          95             :   ! initialize
          96             :   !---------------------------------------------------------------------------
          97           0 :   subroutine upper_bc_file_init( flds_list )
          98             :     use tracer_data, only: trcdata_init
          99             :     use constituents,only: cnst_get_ind, cnst_mw
         100             :     use physconst,   only: mwdry
         101             :     use string_utils,only: to_lower
         102             :     use ref_pres,    only: do_molec_diff
         103             :
         104             :     character(len=*), intent(in) :: flds_list(:) ! flds specifier list
         105             :
         106             :     integer :: m, ndx, ierr
         107             :     character(len=*), parameter :: prefix = 'upper_bc_file_init: '
         108             :
         109           0 :     num_ubc_flds = size(flds_list)
         110           0 :     upper_bc_file_specified = upper_bc_file_specified .and. (num_ubc_flds>0)
         111             :
         112           0 :     if (.not.upper_bc_file_specified) return
         113             :
         114           0 :     allocate( ubc_fact(num_ubc_flds), stat=ierr )
         115           0 :     if (ierr /= 0) call endrun(prefix//'allocate error : ubc_fact')
         116           0 :     ubc_fact(:) = -huge(1._r8)
         117             :
         118           0 :     allocate(file%in_pbuf(num_ubc_flds), stat=ierr)
         119           0 :     if (ierr /= 0) call endrun(prefix//'allocate error : file%in_pbuf')
         120           0 :     file%in_pbuf(:) = .false.
         121             :
         122             :     call trcdata_init( flds_list, ubc_file_path, ' ', ' ', fields, file, .false., &
         123           0 :          ubc_file_cycle_yr, ubc_file_fixed_ymd, ubc_file_fixed_tod, ubc_file_input_type)
         124             :
         125           0 :     if (do_molec_diff) then
         126           0 :        file%top_bndry = .true.
         127             :     else
         128           0 :        file%top_layer = .true.
         129             :     endif
         130             :
         131           0 :     allocate(hist_names(num_ubc_flds), stat=ierr)
         132           0 :     if (ierr /= 0) call endrun(prefix//'allocate error : hist_names')
         133           0 :     hist_names = ' '
         134             :
         135           0 :     do m = 1,num_ubc_flds
         136             :
         137           0 :        call cnst_get_ind(trim(fields(m)%fldnam), ndx, abort=.true.)
         138             :
         139           0 :        select case ( to_lower(trim(fields(m)%units)) )
         140             :        case ('k','kg/kg','kg kg-1','mmr')
         141           0 :           ubc_fact(m) = 1._r8
         142             :        case ('mol/mol','mole/mole','mol mol-1','vmr')
         143           0 :           ubc_fact(m) = cnst_mw(ndx)/mwdry
         144             :        case default
         145           0 :           call endrun('upper_bc_file_get: units are not recognized')
         146             :        end select
         147             :
         148           0 :        hist_names(m) = trim(fields(m)%fldnam)//'_fubc'
         149           0 :        if ( to_lower(trim(fields(m)%units)) == 'k' ) then
         150           0 :           call addfld(hist_names(m), horiz_only, 'I', 'K', trim(fields(m)%fldnam)//' at upper boundary' )
         151             :        else
         152           0 :           call addfld(hist_names(m), horiz_only, 'I', 'kg/kg', trim(fields(m)%fldnam)//' at upper boundary' )
         153             :        end if
         154             :
         155             :     end do
         156             :
         157           0 :   end subroutine upper_bc_file_init
         158             :
         159             :   !---------------------------------------------------------------------------
         160             :   ! advance data reader
         161             :   !---------------------------------------------------------------------------
         162           0 :   subroutine upper_bc_file_adv(pbuf2d, state)
         163           0 :     use tracer_data,    only : advance_trcdata
         164             :     use physics_types,  only : physics_state
         165             :     use physics_buffer, only : physics_buffer_desc
         166             :
         167             :     ! args
         168             :     type(physics_state),    intent(in) :: state(:)
         169             :     type(physics_buffer_desc), pointer :: pbuf2d(:,:)
         170             :
         171           0 :     if (.not.upper_bc_file_specified) return
         172             :
         173           0 :     call advance_trcdata( fields, file, state, pbuf2d )
         174             :
         175           0 :   end subroutine upper_bc_file_adv
         176             :
         177             :   !---------------------------------------------------------------------------
         178             :   ! returns UBC values
         179             :   !---------------------------------------------------------------------------
         180           0 :   subroutine upper_bc_file_get(lchnk, ncol, val)
         181             :
         182             :     integer, intent(in) :: ncol, lchnk
         183             :     real(r8), intent(out) :: val(:,:)
         184             :
         185             :     integer :: m
         186             :
         187           0 :     if (.not.upper_bc_file_specified) return
         188             :
         189           0 :     do m = 1,num_ubc_flds
         190           0 :        val(:ncol,m) = ubc_fact(m)*fields(m)%data(:ncol,1,lchnk)
         191           0 :        call outfld( trim(hist_names(m)), val(:ncol,m), ncol, lchnk )
         192             :     enddo
         193             :
         194             :
         195           0 :   end subroutine upper_bc_file_get
         196             :
         197             : end module upper_bc_file

Generated by: LCOV version 1.14