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